diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md index 9e404a836..5176792c3 100644 --- a/.github/pull_request_template.md +++ b/.github/pull_request_template.md @@ -8,12 +8,16 @@ - [ ] added corresponding entries in `CHANGELOG_UNRELEASED.md` - (do not edit former entries, only append new ones, be careful: - merge and rebase have a tendency to mess up `CHANGELOG_UNRELEASED.md`) + + + + - [ ] added corresponding documentation in the headers + ##### Automatic note to reviewers -Read [this Checklist](https://github.com/math-comp/math-comp/wiki/Checklist-for-following,-reviewing-and-playing-with-a-PR#checklist-for-reviewing-a-pr) and put a milestone if possible. +Read [this Checklist](https://github.com/math-comp/math-comp/wiki/Checklist-for-creating-and-review-PRs) and put a milestone if possible. diff --git a/.github/workflows/docker-action.yml b/.github/workflows/docker-action.yml deleted file mode 100644 index 21d64e133..000000000 --- a/.github/workflows/docker-action.yml +++ /dev/null @@ -1,46 +0,0 @@ -name: Docker CI - -on: - push: - branches: - - master - pull_request: - branches: - - '**' - -jobs: - build: - # the OS must be GNU/Linux to be able to use the docker-coq-action - runs-on: ubuntu-latest - strategy: - matrix: - image: - - 'mathcomp/mathcomp:1.13.0-coq-8.14' - - 'mathcomp/mathcomp:1.13.0-coq-8.15' - - 'mathcomp/mathcomp:1.14.0-coq-8.14' - - 'mathcomp/mathcomp:1.14.0-coq-8.15' - - 'mathcomp/mathcomp:1.15.0-coq-8.14' - - 'mathcomp/mathcomp:1.15.0-coq-8.15' - - 'mathcomp/mathcomp:1.15.0-coq-8.16' - - 'mathcomp/mathcomp-dev:coq-8.14' - - 'mathcomp/mathcomp-dev:coq-8.15' - - 'mathcomp/mathcomp-dev:coq-8.16' - - 'mathcomp/mathcomp-dev:coq-dev' - fail-fast: false - steps: - - uses: actions/checkout@v2 - - uses: coq-community/docker-coq-action@v1 - with: - opam_file: 'coq-mathcomp-analysis.opam' - custom_image: ${{ matrix.image }} - install: | - startGroup "Install dependencies" - opam pin add -n -y -k path coq-mathcomp-classical $WORKDIR - opam pin add -n -y -k path $PACKAGE $WORKDIR - opam update -y - opam install -y -j 2 coq-mathcomp-classical --deps-only - endGroup - -# See also: -# https://github.com/coq-community/docker-coq-action#readme -# https://github.com/erikmd/docker-coq-github-action-demo diff --git a/.github/workflows/nix-action-8.14.yml b/.github/workflows/nix-action-8.14.yml deleted file mode 100644 index 736f97871..000000000 --- a/.github/workflows/nix-action-8.14.yml +++ /dev/null @@ -1,172 +0,0 @@ -jobs: - coq: - needs: [] - runs-on: ubuntu-latest - steps: - - name: Determine which commit to test - run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ - \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ - \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ - \ | cut -f1)\n if [ -z \"$merge_commit\" ]; then\n echo \"tested_commit=${{\ - \ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo\ - \ \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - - name: Git checkout - uses: actions/checkout@v2 - with: - fetch-depth: 0 - ref: ${{ env.tested_commit }} - - name: Cachix install - uses: cachix/install-nix-action@v16 - with: - nix_path: nixpkgs=channel:nixpkgs-unstable - - name: Cachix setup math-comp - uses: cachix/cachix-action@v10 - with: - authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} - extraPullNames: coq, coq-community - name: math-comp - - id: stepCheck - name: Checking presence of CI target coq - run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ - \ bundle \"8.14\" --argstr job \"coq\" \\\n --dry-run 2>&1 > /dev/null)\n\ - echo $nb_dry_run\necho ::set-output name=status::$(echo $nb_dry_run | grep\ - \ \"built:\" | sed \"s/.*/built/\")\n" - - if: steps.stepCheck.outputs.status == 'built' - name: Building/fetching current CI target - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.14" --argstr - job "coq" - mathcomp-analysis: - needs: - - coq - runs-on: ubuntu-latest - steps: - - name: Determine which commit to test - run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ - \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ - \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ - \ | cut -f1)\n if [ -z \"$merge_commit\" ]; then\n echo \"tested_commit=${{\ - \ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo\ - \ \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - - name: Git checkout - uses: actions/checkout@v2 - with: - fetch-depth: 0 - ref: ${{ env.tested_commit }} - - name: Cachix install - uses: cachix/install-nix-action@v16 - with: - nix_path: nixpkgs=channel:nixpkgs-unstable - - name: Cachix setup math-comp - uses: cachix/cachix-action@v10 - with: - authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} - extraPullNames: coq, coq-community - name: math-comp - - id: stepCheck - name: Checking presence of CI target mathcomp-analysis - run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ - \ bundle \"8.14\" --argstr job \"mathcomp-analysis\" \\\n --dry-run 2>&1\ - \ > /dev/null)\necho $nb_dry_run\necho ::set-output name=status::$(echo $nb_dry_run\ - \ | grep \"built:\" | sed \"s/.*/built/\")\n" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: coq' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.14" --argstr - job "coq" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: mathcomp-classical' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.14" --argstr - job "mathcomp-classical" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: mathcomp-field' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.14" --argstr - job "mathcomp-field" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: mathcomp-bigenough' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.14" --argstr - job "mathcomp-bigenough" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: hierarchy-builder' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.14" --argstr - job "hierarchy-builder" - - if: steps.stepCheck.outputs.status == 'built' - name: Building/fetching current CI target - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.14" --argstr - job "mathcomp-analysis" - mathcomp-analysis-single: - needs: - - coq - runs-on: ubuntu-latest - steps: - - name: Determine which commit to test - run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ - \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ - \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ - \ | cut -f1)\n if [ -z \"$merge_commit\" ]; then\n echo \"tested_commit=${{\ - \ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo\ - \ \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - - name: Git checkout - uses: actions/checkout@v2 - with: - fetch-depth: 0 - ref: ${{ env.tested_commit }} - - name: Cachix install - uses: cachix/install-nix-action@v16 - with: - nix_path: nixpkgs=channel:nixpkgs-unstable - - name: Cachix setup math-comp - uses: cachix/cachix-action@v10 - with: - authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} - extraPullNames: coq, coq-community - name: math-comp - - id: stepCheck - name: Checking presence of CI target mathcomp-analysis-single - run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ - \ bundle \"8.14\" --argstr job \"mathcomp-analysis-single\" \\\n --dry-run\ - \ 2>&1 > /dev/null)\necho $nb_dry_run\necho ::set-output name=status::$(echo\ - \ $nb_dry_run | grep \"built:\" | sed \"s/.*/built/\")\n" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: coq' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.14" --argstr - job "coq" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: mathcomp-algebra' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.14" --argstr - job "mathcomp-algebra" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: mathcomp-finmap' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.14" --argstr - job "mathcomp-finmap" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: hierarchy-builder' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.14" --argstr - job "hierarchy-builder" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: mathcomp-field' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.14" --argstr - job "mathcomp-field" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: mathcomp-bigenough' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.14" --argstr - job "mathcomp-bigenough" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: hierarchy-builder' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.14" --argstr - job "hierarchy-builder" - - if: steps.stepCheck.outputs.status == 'built' - name: Building/fetching current CI target - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.14" --argstr - job "mathcomp-analysis-single" -name: Nix CI for bundle 8.14 -'on': - pull_request: - paths: - - .github/workflows/** - pull_request_target: - types: - - opened - - synchronize - - reopened - push: - branches: - - master diff --git a/.github/workflows/nix-action-8.15.yml b/.github/workflows/nix-action-8.15.yml deleted file mode 100644 index 277cf2319..000000000 --- a/.github/workflows/nix-action-8.15.yml +++ /dev/null @@ -1,172 +0,0 @@ -jobs: - coq: - needs: [] - runs-on: ubuntu-latest - steps: - - name: Determine which commit to test - run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ - \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ - \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ - \ | cut -f1)\n if [ -z \"$merge_commit\" ]; then\n echo \"tested_commit=${{\ - \ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo\ - \ \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - - name: Git checkout - uses: actions/checkout@v2 - with: - fetch-depth: 0 - ref: ${{ env.tested_commit }} - - name: Cachix install - uses: cachix/install-nix-action@v16 - with: - nix_path: nixpkgs=channel:nixpkgs-unstable - - name: Cachix setup math-comp - uses: cachix/cachix-action@v10 - with: - authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} - extraPullNames: coq, coq-community - name: math-comp - - id: stepCheck - name: Checking presence of CI target coq - run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ - \ bundle \"8.15\" --argstr job \"coq\" \\\n --dry-run 2>&1 > /dev/null)\n\ - echo $nb_dry_run\necho ::set-output name=status::$(echo $nb_dry_run | grep\ - \ \"built:\" | sed \"s/.*/built/\")\n" - - if: steps.stepCheck.outputs.status == 'built' - name: Building/fetching current CI target - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.15" --argstr - job "coq" - mathcomp-analysis: - needs: - - coq - runs-on: ubuntu-latest - steps: - - name: Determine which commit to test - run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ - \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ - \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ - \ | cut -f1)\n if [ -z \"$merge_commit\" ]; then\n echo \"tested_commit=${{\ - \ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo\ - \ \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - - name: Git checkout - uses: actions/checkout@v2 - with: - fetch-depth: 0 - ref: ${{ env.tested_commit }} - - name: Cachix install - uses: cachix/install-nix-action@v16 - with: - nix_path: nixpkgs=channel:nixpkgs-unstable - - name: Cachix setup math-comp - uses: cachix/cachix-action@v10 - with: - authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} - extraPullNames: coq, coq-community - name: math-comp - - id: stepCheck - name: Checking presence of CI target mathcomp-analysis - run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ - \ bundle \"8.15\" --argstr job \"mathcomp-analysis\" \\\n --dry-run 2>&1\ - \ > /dev/null)\necho $nb_dry_run\necho ::set-output name=status::$(echo $nb_dry_run\ - \ | grep \"built:\" | sed \"s/.*/built/\")\n" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: coq' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.15" --argstr - job "coq" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: mathcomp-classical' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.15" --argstr - job "mathcomp-classical" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: mathcomp-field' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.15" --argstr - job "mathcomp-field" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: mathcomp-bigenough' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.15" --argstr - job "mathcomp-bigenough" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: hierarchy-builder' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.15" --argstr - job "hierarchy-builder" - - if: steps.stepCheck.outputs.status == 'built' - name: Building/fetching current CI target - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.15" --argstr - job "mathcomp-analysis" - mathcomp-analysis-single: - needs: - - coq - runs-on: ubuntu-latest - steps: - - name: Determine which commit to test - run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ - \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ - \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ - \ | cut -f1)\n if [ -z \"$merge_commit\" ]; then\n echo \"tested_commit=${{\ - \ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo\ - \ \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - - name: Git checkout - uses: actions/checkout@v2 - with: - fetch-depth: 0 - ref: ${{ env.tested_commit }} - - name: Cachix install - uses: cachix/install-nix-action@v16 - with: - nix_path: nixpkgs=channel:nixpkgs-unstable - - name: Cachix setup math-comp - uses: cachix/cachix-action@v10 - with: - authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} - extraPullNames: coq, coq-community - name: math-comp - - id: stepCheck - name: Checking presence of CI target mathcomp-analysis-single - run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ - \ bundle \"8.15\" --argstr job \"mathcomp-analysis-single\" \\\n --dry-run\ - \ 2>&1 > /dev/null)\necho $nb_dry_run\necho ::set-output name=status::$(echo\ - \ $nb_dry_run | grep \"built:\" | sed \"s/.*/built/\")\n" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: coq' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.15" --argstr - job "coq" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: mathcomp-algebra' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.15" --argstr - job "mathcomp-algebra" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: mathcomp-finmap' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.15" --argstr - job "mathcomp-finmap" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: hierarchy-builder' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.15" --argstr - job "hierarchy-builder" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: mathcomp-field' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.15" --argstr - job "mathcomp-field" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: mathcomp-bigenough' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.15" --argstr - job "mathcomp-bigenough" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: hierarchy-builder' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.15" --argstr - job "hierarchy-builder" - - if: steps.stepCheck.outputs.status == 'built' - name: Building/fetching current CI target - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.15" --argstr - job "mathcomp-analysis-single" -name: Nix CI for bundle 8.15 -'on': - pull_request: - paths: - - .github/workflows/** - pull_request_target: - types: - - opened - - synchronize - - reopened - push: - branches: - - master diff --git a/.github/workflows/nix-action-8.16.yml b/.github/workflows/nix-action-8.16.yml index d3c559f45..84f8add67 100644 --- a/.github/workflows/nix-action-8.16.yml +++ b/.github/workflows/nix-action-8.16.yml @@ -3,24 +3,35 @@ jobs: needs: [] runs-on: ubuntu-latest steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ - \ | cut -f1)\n if [ -z \"$merge_commit\" ]; then\n echo \"tested_commit=${{\ - \ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo\ - \ \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" + \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ + \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ + \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ + \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ + \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout - uses: actions/checkout@v2 + uses: actions/checkout@v3 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install - uses: cachix/install-nix-action@v16 + uses: cachix/install-nix-action@v20 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp - uses: cachix/cachix-action@v10 + uses: cachix/cachix-action@v12 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community @@ -29,35 +40,130 @@ jobs: name: Checking presence of CI target coq run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ \ bundle \"8.16\" --argstr job \"coq\" \\\n --dry-run 2>&1 > /dev/null)\n\ - echo $nb_dry_run\necho ::set-output name=status::$(echo $nb_dry_run | grep\ - \ \"built:\" | sed \"s/.*/built/\")\n" + echo $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\" | sed \"\ + s/.*/built/\") >> $GITHUB_OUTPUT\n" - if: steps.stepCheck.outputs.status == 'built' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr job "coq" + mathcomp: + needs: + - coq + runs-on: ubuntu-latest + steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.target_commit }} + - name: Determine which commit to test + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ + \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ + \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ + \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ + \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ + \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ + \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.tested_commit }} + - name: Cachix install + uses: cachix/install-nix-action@v20 + with: + nix_path: nixpkgs=channel:nixpkgs-unstable + - name: Cachix setup math-comp + uses: cachix/cachix-action@v12 + with: + authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} + extraPullNames: coq, coq-community + name: math-comp + - id: stepCheck + name: Checking presence of CI target mathcomp + run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ + \ bundle \"8.16\" --argstr job \"mathcomp\" \\\n --dry-run 2>&1 > /dev/null)\n\ + echo $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\" | sed \"\ + s/.*/built/\") >> $GITHUB_OUTPUT\n" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: coq' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr + job "coq" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: coq-elpi' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr + job "coq-elpi" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: hierarchy-builder' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr + job "hierarchy-builder" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-ssreflect' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr + job "mathcomp-ssreflect" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-fingroup' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr + job "mathcomp-fingroup" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-algebra' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr + job "mathcomp-algebra" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-solvable' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr + job "mathcomp-solvable" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-field' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr + job "mathcomp-field" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-character' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr + job "mathcomp-character" + - if: steps.stepCheck.outputs.status == 'built' + name: Building/fetching current CI target + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr + job "mathcomp" mathcomp-analysis: needs: - coq runs-on: ubuntu-latest steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ - \ | cut -f1)\n if [ -z \"$merge_commit\" ]; then\n echo \"tested_commit=${{\ - \ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo\ - \ \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" + \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ + \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ + \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ + \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ + \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout - uses: actions/checkout@v2 + uses: actions/checkout@v3 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install - uses: cachix/install-nix-action@v16 + uses: cachix/install-nix-action@v20 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp - uses: cachix/cachix-action@v10 + uses: cachix/cachix-action@v12 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community @@ -66,8 +172,8 @@ jobs: name: Checking presence of CI target mathcomp-analysis run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ \ bundle \"8.16\" --argstr job \"mathcomp-analysis\" \\\n --dry-run 2>&1\ - \ > /dev/null)\necho $nb_dry_run\necho ::set-output name=status::$(echo $nb_dry_run\ - \ | grep \"built:\" | sed \"s/.*/built/\")\n" + \ > /dev/null)\necho $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"\ + built:\" | sed \"s/.*/built/\") >> $GITHUB_OUTPUT\n" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr @@ -95,26 +201,38 @@ jobs: mathcomp-analysis-single: needs: - coq + - mathcomp-finmap runs-on: ubuntu-latest steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ - \ | cut -f1)\n if [ -z \"$merge_commit\" ]; then\n echo \"tested_commit=${{\ - \ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo\ - \ \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" + \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ + \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ + \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ + \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ + \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout - uses: actions/checkout@v2 + uses: actions/checkout@v3 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install - uses: cachix/install-nix-action@v16 + uses: cachix/install-nix-action@v20 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp - uses: cachix/cachix-action@v10 + uses: cachix/cachix-action@v12 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community @@ -123,8 +241,8 @@ jobs: name: Checking presence of CI target mathcomp-analysis-single run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ \ bundle \"8.16\" --argstr job \"mathcomp-analysis-single\" \\\n --dry-run\ - \ 2>&1 > /dev/null)\necho $nb_dry_run\necho ::set-output name=status::$(echo\ - \ $nb_dry_run | grep \"built:\" | sed \"s/.*/built/\")\n" + \ 2>&1 > /dev/null)\necho $nb_dry_run\necho status=$(echo $nb_dry_run | grep\ + \ \"built:\" | sed \"s/.*/built/\") >> $GITHUB_OUTPUT\n" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr @@ -137,10 +255,6 @@ jobs: name: 'Building/fetching previous CI target: mathcomp-finmap' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr job "mathcomp-finmap" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: hierarchy-builder' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr - job "hierarchy-builder" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-field' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr @@ -157,6 +271,62 @@ jobs: name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr job "mathcomp-analysis-single" + mathcomp-finmap: + needs: + - coq + runs-on: ubuntu-latest + steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.target_commit }} + - name: Determine which commit to test + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ + \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ + \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ + \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ + \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ + \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ + \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.tested_commit }} + - name: Cachix install + uses: cachix/install-nix-action@v20 + with: + nix_path: nixpkgs=channel:nixpkgs-unstable + - name: Cachix setup math-comp + uses: cachix/cachix-action@v12 + with: + authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} + extraPullNames: coq, coq-community + name: math-comp + - id: stepCheck + name: Checking presence of CI target mathcomp-finmap + run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ + \ bundle \"8.16\" --argstr job \"mathcomp-finmap\" \\\n --dry-run 2>&1 >\ + \ /dev/null)\necho $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\"\ + \ | sed \"s/.*/built/\") >> $GITHUB_OUTPUT\n" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: coq' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr + job "coq" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-ssreflect' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr + job "mathcomp-ssreflect" + - if: steps.stepCheck.outputs.status == 'built' + name: Building/fetching current CI target + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr + job "mathcomp-finmap" name: Nix CI for bundle 8.16 'on': pull_request: @@ -170,3 +340,4 @@ name: Nix CI for bundle 8.16 push: branches: - master + - hierarchy-builder diff --git a/.github/workflows/nix-action-8.17.yml b/.github/workflows/nix-action-8.17.yml new file mode 100644 index 000000000..e8fc9f198 --- /dev/null +++ b/.github/workflows/nix-action-8.17.yml @@ -0,0 +1,345 @@ +jobs: + coq: + needs: [] + runs-on: ubuntu-latest + steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.target_commit }} + - name: Determine which commit to test + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ + \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ + \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ + \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ + \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ + \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ + \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.tested_commit }} + - name: Cachix install + uses: cachix/install-nix-action@v20 + with: + nix_path: nixpkgs=channel:nixpkgs-unstable + - name: Cachix setup math-comp + uses: cachix/cachix-action@v12 + with: + authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} + extraPullNames: coq, coq-community + name: math-comp + - id: stepCheck + name: Checking presence of CI target coq + run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ + \ bundle \"8.17\" --argstr job \"coq\" \\\n --dry-run 2>&1 > /dev/null)\n\ + echo $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\" | sed \"\ + s/.*/built/\") >> $GITHUB_OUTPUT\n" + - if: steps.stepCheck.outputs.status == 'built' + name: Building/fetching current CI target + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "coq" + mathcomp: + needs: + - coq + runs-on: ubuntu-latest + steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.target_commit }} + - name: Determine which commit to test + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ + \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ + \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ + \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ + \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ + \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ + \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.tested_commit }} + - name: Cachix install + uses: cachix/install-nix-action@v20 + with: + nix_path: nixpkgs=channel:nixpkgs-unstable + - name: Cachix setup math-comp + uses: cachix/cachix-action@v12 + with: + authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} + extraPullNames: coq, coq-community + name: math-comp + - id: stepCheck + name: Checking presence of CI target mathcomp + run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ + \ bundle \"8.17\" --argstr job \"mathcomp\" \\\n --dry-run 2>&1 > /dev/null)\n\ + echo $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\" | sed \"\ + s/.*/built/\") >> $GITHUB_OUTPUT\n" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: coq' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "coq" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: coq-elpi' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "coq-elpi" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: hierarchy-builder' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "hierarchy-builder" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-ssreflect' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "mathcomp-ssreflect" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-fingroup' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "mathcomp-fingroup" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-algebra' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "mathcomp-algebra" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-solvable' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "mathcomp-solvable" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-field' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "mathcomp-field" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-character' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "mathcomp-character" + - if: steps.stepCheck.outputs.status == 'built' + name: Building/fetching current CI target + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "mathcomp" + mathcomp-analysis: + needs: + - coq + runs-on: ubuntu-latest + steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.target_commit }} + - name: Determine which commit to test + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ + \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ + \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ + \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ + \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ + \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ + \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.tested_commit }} + - name: Cachix install + uses: cachix/install-nix-action@v20 + with: + nix_path: nixpkgs=channel:nixpkgs-unstable + - name: Cachix setup math-comp + uses: cachix/cachix-action@v12 + with: + authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} + extraPullNames: coq, coq-community + name: math-comp + - id: stepCheck + name: Checking presence of CI target mathcomp-analysis + run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ + \ bundle \"8.17\" --argstr job \"mathcomp-analysis\" \\\n --dry-run 2>&1\ + \ > /dev/null)\necho $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"\ + built:\" | sed \"s/.*/built/\") >> $GITHUB_OUTPUT\n" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: coq' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "coq" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-classical' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "mathcomp-classical" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-field' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "mathcomp-field" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-bigenough' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "mathcomp-bigenough" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: hierarchy-builder' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "hierarchy-builder" + - if: steps.stepCheck.outputs.status == 'built' + name: Building/fetching current CI target + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "mathcomp-analysis" + mathcomp-analysis-single: + needs: + - coq + - mathcomp-finmap + runs-on: ubuntu-latest + steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.target_commit }} + - name: Determine which commit to test + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ + \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ + \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ + \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ + \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ + \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ + \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.tested_commit }} + - name: Cachix install + uses: cachix/install-nix-action@v20 + with: + nix_path: nixpkgs=channel:nixpkgs-unstable + - name: Cachix setup math-comp + uses: cachix/cachix-action@v12 + with: + authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} + extraPullNames: coq, coq-community + name: math-comp + - id: stepCheck + name: Checking presence of CI target mathcomp-analysis-single + run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ + \ bundle \"8.17\" --argstr job \"mathcomp-analysis-single\" \\\n --dry-run\ + \ 2>&1 > /dev/null)\necho $nb_dry_run\necho status=$(echo $nb_dry_run | grep\ + \ \"built:\" | sed \"s/.*/built/\") >> $GITHUB_OUTPUT\n" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: coq' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "coq" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-algebra' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "mathcomp-algebra" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-finmap' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "mathcomp-finmap" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-field' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "mathcomp-field" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-bigenough' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "mathcomp-bigenough" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: hierarchy-builder' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "hierarchy-builder" + - if: steps.stepCheck.outputs.status == 'built' + name: Building/fetching current CI target + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "mathcomp-analysis-single" + mathcomp-finmap: + needs: + - coq + runs-on: ubuntu-latest + steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.target_commit }} + - name: Determine which commit to test + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ + \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ + \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ + \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ + \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ + \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ + \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.tested_commit }} + - name: Cachix install + uses: cachix/install-nix-action@v20 + with: + nix_path: nixpkgs=channel:nixpkgs-unstable + - name: Cachix setup math-comp + uses: cachix/cachix-action@v12 + with: + authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} + extraPullNames: coq, coq-community + name: math-comp + - id: stepCheck + name: Checking presence of CI target mathcomp-finmap + run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ + \ bundle \"8.17\" --argstr job \"mathcomp-finmap\" \\\n --dry-run 2>&1 >\ + \ /dev/null)\necho $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\"\ + \ | sed \"s/.*/built/\") >> $GITHUB_OUTPUT\n" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: coq' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "coq" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-ssreflect' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "mathcomp-ssreflect" + - if: steps.stepCheck.outputs.status == 'built' + name: Building/fetching current CI target + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "mathcomp-finmap" +name: Nix CI for bundle 8.17 +'on': + pull_request: + paths: + - .github/workflows/nix-action-8.17.yml + pull_request_target: + paths-ignore: + - .github/workflows/nix-action-8.17.yml + types: + - opened + - synchronize + - reopened + push: + branches: + - master + - hierarchy-builder diff --git a/.github/workflows/nix-action-8.18.yml b/.github/workflows/nix-action-8.18.yml new file mode 100644 index 000000000..c6a1329c0 --- /dev/null +++ b/.github/workflows/nix-action-8.18.yml @@ -0,0 +1,345 @@ +jobs: + coq: + needs: [] + runs-on: ubuntu-latest + steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.target_commit }} + - name: Determine which commit to test + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ + \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ + \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ + \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ + \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ + \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ + \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.tested_commit }} + - name: Cachix install + uses: cachix/install-nix-action@v20 + with: + nix_path: nixpkgs=channel:nixpkgs-unstable + - name: Cachix setup math-comp + uses: cachix/cachix-action@v12 + with: + authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} + extraPullNames: coq, coq-community + name: math-comp + - id: stepCheck + name: Checking presence of CI target coq + run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ + \ bundle \"8.18\" --argstr job \"coq\" \\\n --dry-run 2>&1 > /dev/null)\n\ + echo $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\" | sed \"\ + s/.*/built/\") >> $GITHUB_OUTPUT\n" + - if: steps.stepCheck.outputs.status == 'built' + name: Building/fetching current CI target + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "coq" + mathcomp: + needs: + - coq + runs-on: ubuntu-latest + steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.target_commit }} + - name: Determine which commit to test + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ + \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ + \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ + \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ + \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ + \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ + \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.tested_commit }} + - name: Cachix install + uses: cachix/install-nix-action@v20 + with: + nix_path: nixpkgs=channel:nixpkgs-unstable + - name: Cachix setup math-comp + uses: cachix/cachix-action@v12 + with: + authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} + extraPullNames: coq, coq-community + name: math-comp + - id: stepCheck + name: Checking presence of CI target mathcomp + run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ + \ bundle \"8.18\" --argstr job \"mathcomp\" \\\n --dry-run 2>&1 > /dev/null)\n\ + echo $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\" | sed \"\ + s/.*/built/\") >> $GITHUB_OUTPUT\n" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: coq' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "coq" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: coq-elpi' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "coq-elpi" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: hierarchy-builder' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "hierarchy-builder" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-ssreflect' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "mathcomp-ssreflect" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-fingroup' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "mathcomp-fingroup" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-algebra' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "mathcomp-algebra" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-solvable' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "mathcomp-solvable" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-field' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "mathcomp-field" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-character' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "mathcomp-character" + - if: steps.stepCheck.outputs.status == 'built' + name: Building/fetching current CI target + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "mathcomp" + mathcomp-analysis: + needs: + - coq + runs-on: ubuntu-latest + steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.target_commit }} + - name: Determine which commit to test + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ + \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ + \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ + \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ + \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ + \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ + \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.tested_commit }} + - name: Cachix install + uses: cachix/install-nix-action@v20 + with: + nix_path: nixpkgs=channel:nixpkgs-unstable + - name: Cachix setup math-comp + uses: cachix/cachix-action@v12 + with: + authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} + extraPullNames: coq, coq-community + name: math-comp + - id: stepCheck + name: Checking presence of CI target mathcomp-analysis + run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ + \ bundle \"8.18\" --argstr job \"mathcomp-analysis\" \\\n --dry-run 2>&1\ + \ > /dev/null)\necho $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"\ + built:\" | sed \"s/.*/built/\") >> $GITHUB_OUTPUT\n" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: coq' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "coq" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-classical' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "mathcomp-classical" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-field' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "mathcomp-field" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-bigenough' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "mathcomp-bigenough" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: hierarchy-builder' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "hierarchy-builder" + - if: steps.stepCheck.outputs.status == 'built' + name: Building/fetching current CI target + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "mathcomp-analysis" + mathcomp-analysis-single: + needs: + - coq + - mathcomp-finmap + runs-on: ubuntu-latest + steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.target_commit }} + - name: Determine which commit to test + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ + \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ + \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ + \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ + \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ + \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ + \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.tested_commit }} + - name: Cachix install + uses: cachix/install-nix-action@v20 + with: + nix_path: nixpkgs=channel:nixpkgs-unstable + - name: Cachix setup math-comp + uses: cachix/cachix-action@v12 + with: + authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} + extraPullNames: coq, coq-community + name: math-comp + - id: stepCheck + name: Checking presence of CI target mathcomp-analysis-single + run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ + \ bundle \"8.18\" --argstr job \"mathcomp-analysis-single\" \\\n --dry-run\ + \ 2>&1 > /dev/null)\necho $nb_dry_run\necho status=$(echo $nb_dry_run | grep\ + \ \"built:\" | sed \"s/.*/built/\") >> $GITHUB_OUTPUT\n" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: coq' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "coq" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-algebra' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "mathcomp-algebra" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-finmap' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "mathcomp-finmap" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-field' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "mathcomp-field" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-bigenough' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "mathcomp-bigenough" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: hierarchy-builder' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "hierarchy-builder" + - if: steps.stepCheck.outputs.status == 'built' + name: Building/fetching current CI target + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "mathcomp-analysis-single" + mathcomp-finmap: + needs: + - coq + runs-on: ubuntu-latest + steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.target_commit }} + - name: Determine which commit to test + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ + \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ + \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ + \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ + \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ + \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ + \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.tested_commit }} + - name: Cachix install + uses: cachix/install-nix-action@v20 + with: + nix_path: nixpkgs=channel:nixpkgs-unstable + - name: Cachix setup math-comp + uses: cachix/cachix-action@v12 + with: + authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} + extraPullNames: coq, coq-community + name: math-comp + - id: stepCheck + name: Checking presence of CI target mathcomp-finmap + run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ + \ bundle \"8.18\" --argstr job \"mathcomp-finmap\" \\\n --dry-run 2>&1 >\ + \ /dev/null)\necho $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\"\ + \ | sed \"s/.*/built/\") >> $GITHUB_OUTPUT\n" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: coq' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "coq" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-ssreflect' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "mathcomp-ssreflect" + - if: steps.stepCheck.outputs.status == 'built' + name: Building/fetching current CI target + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "mathcomp-finmap" +name: Nix CI for bundle 8.18 +'on': + pull_request: + paths: + - .github/workflows/nix-action-8.18.yml + pull_request_target: + paths-ignore: + - .github/workflows/nix-action-8.18.yml + types: + - opened + - synchronize + - reopened + push: + branches: + - master + - hierarchy-builder diff --git a/.github/workflows/nix-action-master.yml b/.github/workflows/nix-action-master.yml index 505db9e95..506c3a113 100644 --- a/.github/workflows/nix-action-master.yml +++ b/.github/workflows/nix-action-master.yml @@ -3,24 +3,35 @@ jobs: needs: [] runs-on: ubuntu-latest steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ - \ | cut -f1)\n if [ -z \"$merge_commit\" ]; then\n echo \"tested_commit=${{\ - \ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo\ - \ \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" + \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ + \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ + \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ + \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ + \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout - uses: actions/checkout@v2 + uses: actions/checkout@v3 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install - uses: cachix/install-nix-action@v16 + uses: cachix/install-nix-action@v20 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp - uses: cachix/cachix-action@v10 + uses: cachix/cachix-action@v12 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community @@ -29,8 +40,8 @@ jobs: name: Checking presence of CI target coq run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ \ bundle \"master\" --argstr job \"coq\" \\\n --dry-run 2>&1 > /dev/null)\n\ - echo $nb_dry_run\necho ::set-output name=status::$(echo $nb_dry_run | grep\ - \ \"built:\" | sed \"s/.*/built/\")\n" + echo $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\" | sed \"\ + s/.*/built/\") >> $GITHUB_OUTPUT\n" - if: steps.stepCheck.outputs.status == 'built' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" @@ -40,24 +51,35 @@ jobs: - coq runs-on: ubuntu-latest steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ - \ | cut -f1)\n if [ -z \"$merge_commit\" ]; then\n echo \"tested_commit=${{\ - \ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo\ - \ \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" + \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ + \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ + \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ + \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ + \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout - uses: actions/checkout@v2 + uses: actions/checkout@v3 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install - uses: cachix/install-nix-action@v16 + uses: cachix/install-nix-action@v20 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp - uses: cachix/cachix-action@v10 + uses: cachix/cachix-action@v12 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community @@ -66,8 +88,8 @@ jobs: name: Checking presence of CI target coq-elpi run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ \ bundle \"master\" --argstr job \"coq-elpi\" \\\n --dry-run 2>&1 > /dev/null)\n\ - echo $nb_dry_run\necho ::set-output name=status::$(echo $nb_dry_run | grep\ - \ \"built:\" | sed \"s/.*/built/\")\n" + echo $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\" | sed \"\ + s/.*/built/\") >> $GITHUB_OUTPUT\n" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" @@ -82,24 +104,35 @@ jobs: - coq-elpi runs-on: ubuntu-latest steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ - \ | cut -f1)\n if [ -z \"$merge_commit\" ]; then\n echo \"tested_commit=${{\ - \ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo\ - \ \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" + \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ + \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ + \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ + \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ + \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout - uses: actions/checkout@v2 + uses: actions/checkout@v3 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install - uses: cachix/install-nix-action@v16 + uses: cachix/install-nix-action@v20 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp - uses: cachix/cachix-action@v10 + uses: cachix/cachix-action@v12 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community @@ -108,8 +141,8 @@ jobs: name: Checking presence of CI target hierarchy-builder run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ \ bundle \"master\" --argstr job \"hierarchy-builder\" \\\n --dry-run 2>&1\ - \ > /dev/null)\necho $nb_dry_run\necho ::set-output name=status::$(echo $nb_dry_run\ - \ | grep \"built:\" | sed \"s/.*/built/\")\n" + \ > /dev/null)\necho $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"\ + built:\" | sed \"s/.*/built/\") >> $GITHUB_OUTPUT\n" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" @@ -125,26 +158,39 @@ jobs: mathcomp: needs: - coq + - coq-elpi + - hierarchy-builder runs-on: ubuntu-latest steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ - \ | cut -f1)\n if [ -z \"$merge_commit\" ]; then\n echo \"tested_commit=${{\ - \ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo\ - \ \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" + \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ + \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ + \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ + \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ + \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout - uses: actions/checkout@v2 + uses: actions/checkout@v3 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install - uses: cachix/install-nix-action@v16 + uses: cachix/install-nix-action@v20 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp - uses: cachix/cachix-action@v10 + uses: cachix/cachix-action@v12 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community @@ -153,12 +199,20 @@ jobs: name: Checking presence of CI target mathcomp run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ \ bundle \"master\" --argstr job \"mathcomp\" \\\n --dry-run 2>&1 > /dev/null)\n\ - echo $nb_dry_run\necho ::set-output name=status::$(echo $nb_dry_run | grep\ - \ \"built:\" | sed \"s/.*/built/\")\n" + echo $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"built:\" | sed \"\ + s/.*/built/\") >> $GITHUB_OUTPUT\n" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" --argstr job "coq" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: coq-elpi' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" + --argstr job "coq-elpi" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: hierarchy-builder' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" + --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-ssreflect' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" @@ -194,24 +248,35 @@ jobs: - hierarchy-builder runs-on: ubuntu-latest steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ - \ | cut -f1)\n if [ -z \"$merge_commit\" ]; then\n echo \"tested_commit=${{\ - \ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo\ - \ \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" + \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ + \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ + \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ + \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ + \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout - uses: actions/checkout@v2 + uses: actions/checkout@v3 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install - uses: cachix/install-nix-action@v16 + uses: cachix/install-nix-action@v20 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp - uses: cachix/cachix-action@v10 + uses: cachix/cachix-action@v12 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community @@ -220,8 +285,8 @@ jobs: name: Checking presence of CI target mathcomp-analysis run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ \ bundle \"master\" --argstr job \"mathcomp-analysis\" \\\n --dry-run 2>&1\ - \ > /dev/null)\necho $nb_dry_run\necho ::set-output name=status::$(echo $nb_dry_run\ - \ | grep \"built:\" | sed \"s/.*/built/\")\n" + \ > /dev/null)\necho $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"\ + built:\" | sed \"s/.*/built/\") >> $GITHUB_OUTPUT\n" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" @@ -250,29 +315,39 @@ jobs: needs: - coq - mathcomp-finmap - - hierarchy-builder - mathcomp-bigenough - hierarchy-builder runs-on: ubuntu-latest steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ - \ | cut -f1)\n if [ -z \"$merge_commit\" ]; then\n echo \"tested_commit=${{\ - \ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo\ - \ \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" + \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ + \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ + \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ + \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ + \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout - uses: actions/checkout@v2 + uses: actions/checkout@v3 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install - uses: cachix/install-nix-action@v16 + uses: cachix/install-nix-action@v20 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp - uses: cachix/cachix-action@v10 + uses: cachix/cachix-action@v12 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community @@ -281,8 +356,8 @@ jobs: name: Checking presence of CI target mathcomp-analysis-single run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ \ bundle \"master\" --argstr job \"mathcomp-analysis-single\" \\\n --dry-run\ - \ 2>&1 > /dev/null)\necho $nb_dry_run\necho ::set-output name=status::$(echo\ - \ $nb_dry_run | grep \"built:\" | sed \"s/.*/built/\")\n" + \ 2>&1 > /dev/null)\necho $nb_dry_run\necho status=$(echo $nb_dry_run | grep\ + \ \"built:\" | sed \"s/.*/built/\") >> $GITHUB_OUTPUT\n" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" @@ -295,10 +370,6 @@ jobs: name: 'Building/fetching previous CI target: mathcomp-finmap' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" --argstr job "mathcomp-finmap" - - if: steps.stepCheck.outputs.status == 'built' - name: 'Building/fetching previous CI target: hierarchy-builder' - run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" - --argstr job "hierarchy-builder" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-field' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" @@ -320,24 +391,35 @@ jobs: - coq runs-on: ubuntu-latest steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ - \ | cut -f1)\n if [ -z \"$merge_commit\" ]; then\n echo \"tested_commit=${{\ - \ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo\ - \ \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" + \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ + \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ + \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ + \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ + \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout - uses: actions/checkout@v2 + uses: actions/checkout@v3 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install - uses: cachix/install-nix-action@v16 + uses: cachix/install-nix-action@v20 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp - uses: cachix/cachix-action@v10 + uses: cachix/cachix-action@v12 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community @@ -346,8 +428,8 @@ jobs: name: Checking presence of CI target mathcomp-bigenough run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ \ bundle \"master\" --argstr job \"mathcomp-bigenough\" \\\n --dry-run 2>&1\ - \ > /dev/null)\necho $nb_dry_run\necho ::set-output name=status::$(echo $nb_dry_run\ - \ | grep \"built:\" | sed \"s/.*/built/\")\n" + \ > /dev/null)\necho $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"\ + built:\" | sed \"s/.*/built/\") >> $GITHUB_OUTPUT\n" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" @@ -365,24 +447,35 @@ jobs: - coq runs-on: ubuntu-latest steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@v3 + with: + fetch-depth: 0 + ref: ${{ env.target_commit }} - name: Determine which commit to test run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"tested_commit=${{\ \ github.sha }}\" >> $GITHUB_ENV\nelse\n merge_commit=$(git ls-remote ${{\ \ github.event.repository.html_url }} refs/pull/${{ github.event.number }}/merge\ - \ | cut -f1)\n if [ -z \"$merge_commit\" ]; then\n echo \"tested_commit=${{\ - \ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n else\n echo\ - \ \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" + \ | cut -f1)\n mergeable=$(git merge --no-commit --no-ff ${{ github.event.pull_request.base.sha\ + \ }} > /dev/null 2>&1; echo $?; git merge --abort > /dev/null 2>&1 || true)\n\ + \ if [ -z \"$merge_commit\" -o \"x$mergeable\" != \"x0\" ]; then\n echo\ + \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ + \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout - uses: actions/checkout@v2 + uses: actions/checkout@v3 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install - uses: cachix/install-nix-action@v16 + uses: cachix/install-nix-action@v20 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp - uses: cachix/cachix-action@v10 + uses: cachix/cachix-action@v12 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community @@ -391,8 +484,8 @@ jobs: name: Checking presence of CI target mathcomp-finmap run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ \ bundle \"master\" --argstr job \"mathcomp-finmap\" \\\n --dry-run 2>&1\ - \ > /dev/null)\necho $nb_dry_run\necho ::set-output name=status::$(echo $nb_dry_run\ - \ | grep \"built:\" | sed \"s/.*/built/\")\n" + \ > /dev/null)\necho $nb_dry_run\necho status=$(echo $nb_dry_run | grep \"\ + built:\" | sed \"s/.*/built/\") >> $GITHUB_OUTPUT\n" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: coq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" @@ -409,8 +502,10 @@ name: Nix CI for bundle master 'on': pull_request: paths: - - .github/workflows/** + - .github/workflows/nix-action-master.yml pull_request_target: + paths-ignore: + - .github/workflows/nix-action-master.yml types: - opened - synchronize @@ -418,3 +513,4 @@ name: Nix CI for bundle master push: branches: - master + - hierarchy-builder diff --git a/.nix/config.nix b/.nix/config.nix index 740431ef3..c747c2af3 100644 --- a/.nix/config.nix +++ b/.nix/config.nix @@ -31,23 +31,39 @@ ## select an entry to build in the following `bundles` set ## defaults to "default" - default-bundle = "8.15"; + default-bundle = "8.16"; ## write one `bundles.name` attribute set per ## alternative configuration ## When generating GitHub Action CI, one workflow file ## will be created per bundle - bundles."8.14".coqPackages.coq.override.version = "8.14"; - bundles."8.15".coqPackages.coq.override.version = "8.15"; - bundles."8.16".coqPackages.coq.override.version = "8.16"; + bundles."8.16".push-branches = [ "master" "hierarchy-builder" ]; + bundles."8.16".coqPackages = { + coq.override.version = "8.16"; + mathcomp.override.version = "mathcomp-2.0.0"; + mathcomp-finmap.override.version = "master"; + }; + bundles."8.17".push-branches = [ "master" "hierarchy-builder" ]; + bundles."8.17".coqPackages = { + coq.override.version = "8.17"; + mathcomp.override.version = "mathcomp-2.0.0"; + mathcomp-finmap.override.version = "master"; + }; + bundles."8.18".push-branches = [ "master" "hierarchy-builder" ]; + bundles."8.18".coqPackages = { + coq.override.version = "8.18"; + mathcomp.override.version = "mathcomp-2.0.0"; + mathcomp-finmap.override.version = "master"; + }; + bundles."master".push-branches = [ "master" "hierarchy-builder" ]; bundles."master".coqPackages = { coq.override.version = "master"; coq-elpi.override.version = "coq-master"; - hierarchy-builder.override.version = "coq-master"; + hierarchy-builder.override.version = "master"; mathcomp.override.version = "master"; mathcomp-bigenough.override.version = "1.0.1"; - mathcomp-finmap.override.version = "1.5.2"; + mathcomp-finmap.override.version = "master"; }; ## Cachix caches to use in CI @@ -55,17 +71,17 @@ cachix.coq = {}; cachix.math-comp.authToken = "CACHIX_AUTH_TOKEN"; cachix.coq-community = {}; - + ## If you have write access to one of these caches you can ## provide the auth token or signing key through a secret ## variable on GitHub. Then, you should give the variable ## name here. For instance, coq-community projects can use ## the following line instead of the one above: # cachix.coq-community.authToken = "CACHIX_AUTH_TOKEN"; - + ## Or if you have a signing key for a given Cachix cache: # cachix.my-cache.signingKey = "CACHIX_SIGNING_KEY" - + ## Note that here, CACHIX_AUTH_TOKEN and CACHIX_SIGNING_KEY ## are the names of secret variables. They are set in ## GitHub's web interface. diff --git a/.nix/coq-nix-toolbox.nix b/.nix/coq-nix-toolbox.nix index a965d3f83..b0c3834f0 100644 --- a/.nix/coq-nix-toolbox.nix +++ b/.nix/coq-nix-toolbox.nix @@ -1 +1 @@ -"cd64bd6bca24e9de1de19ecec8e2f47a97b0d20f" +"7e631f043d424ce82f3308824bf64fbfdee04c80" diff --git a/.nix/coq-overlays/mathcomp/default.nix b/.nix/coq-overlays/mathcomp/default.nix new file mode 100644 index 000000000..dbaf5872b --- /dev/null +++ b/.nix/coq-overlays/mathcomp/default.nix @@ -0,0 +1,122 @@ +############################################################################ +# This file mainly provides the `mathcomp` derivation, which is # +# essentially a meta-package containing all core mathcomp libraries # +# (ssreflect fingroup algebra solvable field character). They can be # +# accessed individually through the passthrough attributes of mathcomp # +# bearing the same names (mathcomp.ssreflect, etc). # +############################################################################ +# Compiling a custom version of mathcomp using `mathcomp.override`. # +# This is the replacement for the former `mathcomp_ config` function. # +# See the documentation at doc/languages-frameworks/coq.section.md. # +############################################################################ + +{ lib, ncurses, graphviz, lua, fetchzip, + coq-elpi, hierarchy-builder, + mkCoqDerivation, recurseIntoAttrs, withDoc ? false, single ? false, + coqPackages, coq, version ? null }@args: +with builtins // lib; +let + repo = "math-comp"; + owner = "math-comp"; + withDoc = single && (args.withDoc or false); + defaultVersion = with versions; switch coq.coq-version [ + { case = isGe "8.11"; out = "1.14.0"; } + { case = range "8.11" "8.15"; out = "1.13.0"; } + { case = range "8.10" "8.13"; out = "1.12.0"; } + { case = range "8.7" "8.12"; out = "1.11.0"; } + { case = range "8.7" "8.11"; out = "1.10.0"; } + { case = range "8.7" "8.11"; out = "1.9.0"; } + { case = range "8.7" "8.9"; out = "1.8.0"; } + { case = range "8.6" "8.9"; out = "1.7.0"; } + { case = range "8.5" "8.7"; out = "1.6.4"; } + ] null; + release = { + "1.14.0".sha256 = "07yamlp1c0g5nahkd2gpfhammcca74ga2s6qr7a3wm6y6j5pivk9"; + "1.13.0".sha256 = "0j4cz2y1r1aw79snkcf1pmicgzf8swbaf9ippz0vg99a572zqzri"; + "1.12.0".sha256 = "1ccfny1vwgmdl91kz5xlmhq4wz078xm4z5wpd0jy5rn890dx03wp"; + "1.11.0".sha256 = "06a71d196wd5k4wg7khwqb7j7ifr7garhwkd54s86i0j7d6nhl3c"; + "1.10.0".sha256 = "1b9m6pwxxyivw7rgx82gn5kmgv2mfv3h3y0mmjcjfypi8ydkrlbv"; + "1.9.0".sha256 = "0lid9zaazdi3d38l8042lczb02pw5m9wq0yysiilx891hgq2p81r"; + "1.8.0".sha256 = "07l40is389ih8bi525gpqs3qp4yb2kl11r9c8ynk1ifpjzpnabwp"; + "1.7.0".sha256 = "0wnhj9nqpx2bw6n1l4i8jgrw3pjajvckvj3lr4vzjb3my2lbxdd1"; + "1.6.4".sha256 = "09ww48qbjsvpjmy1g9yhm0rrkq800ffq21p6fjkbwd34qvd82raz"; + "1.6.1".sha256 = "1ilw6vm4dlsdv9cd7kmf0vfrh2kkzr45wrqr8m37miy0byzr4p9i"; + }; + releaseRev = v: "mathcomp-${v}"; + + # list of core mathcomp packages sorted by dependency order + packages = [ "ssreflect" "fingroup" "algebra" "solvable" "field" "character" "all" ]; + + mathcomp_ = package: let + mathcomp-deps = if package == "single" then [] + else map mathcomp_ (head (splitList (pred.equal package) packages)); + pkgpath = if package == "single" then "mathcomp" else "mathcomp/${package}"; + pname = if package == "single" then "mathcomp" else "mathcomp-${package}"; + pkgallMake = '' + echo "all.v" > Make + echo "-I ." >> Make + echo "-R . mathcomp.all" >> Make + ''; + derivation = mkCoqDerivation ({ + inherit version pname defaultVersion release releaseRev repo owner; + + mlPlugin = versions.isLe "8.6" coq.coq-version; + nativeBuildInputs = optionals withDoc [ graphviz lua ]; + buildInputs = [ ncurses ]; + propagatedBuildInputs = [ coq-elpi hierarchy-builder ] ++ mathcomp-deps; + + buildFlags = optional withDoc "doc"; + + preBuild = '' + if [[ -f etc/utils/ssrcoqdep ]] + then patchShebangs etc/utils/ssrcoqdep + fi + if [[ -f etc/buildlibgraph ]] + then patchShebangs etc/buildlibgraph + fi + '' + '' + cd ${pkgpath} + '' + optionalString (package == "all") pkgallMake; + + meta = { + homepage = "https://math-comp.github.io/"; + license = licenses.cecill-b; + maintainers = with maintainers; [ vbgl jwiegley cohencyril ]; + }; + } // optionalAttrs (package != "single") + { passthru = genAttrs packages mathcomp_; } + // optionalAttrs withDoc { + htmldoc_template = + fetchzip { + url = "https://github.com/math-comp/math-comp.github.io/archive/doc-1.12.0.zip"; + sha256 = "0y1352ha2yy6k2dl375sb1r68r1qi9dyyy7dyzj5lp9hxhhq69x8"; + }; + postBuild = '' + cp -rf _build_doc/* . + rm -r _build_doc + ''; + postInstall = + let tgt = "$out/share/coq/${coq.coq-version}/"; in + optionalString withDoc '' + mkdir -p ${tgt} + cp -r htmldoc ${tgt} + cp -r $htmldoc_template/htmldoc_template/* ${tgt}/htmldoc/ + ''; + buildTargets = "doc"; + extraInstallFlags = [ "-f Makefile.coq" ]; + }); + patched-derivation1 = derivation.overrideAttrs (o: + optionalAttrs (o.pname != null && o.pname == "mathcomp-all" && + o.version != null && o.version != "dev" && versions.isLt "1.7" o.version) + { preBuild = ""; buildPhase = ""; installPhase = "echo doing nothing"; } + ); + patched-derivation = patched-derivation1.overrideAttrs (o: + optionalAttrs (versions.isLe "8.7" coq.coq-version || + (o.version != "dev" && versions.isLe "1.7" o.version)) + { + installFlags = o.installFlags ++ [ "-f Makefile.coq" ]; + } + ); + in patched-derivation; +in +mathcomp_ (if single then "single" else "all") diff --git a/CHANGELOG.md b/CHANGELOG.md index d6673e1d6..bf0a8172d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,1421 @@ # Changelog -Lastest releases: [[0.6.0] - 2022-12-14](#060---2022-12-14) and [[0.5.4] - 2022-09-07](#055---2022-09-07) +Latest releases: [[0.7.0] - 2024-01-19](#070---2024-01-19) and [[0.6.7] - 2024-01-09](#067---2024-01-09) + +## [0.7.0] - 2024-01-19 + +### Added + +- in `mathcomp_extra.v`: + + lemmas `last_filterP`, + `path_lt_filter0`, `path_lt_filterT`, `path_lt_head`, `path_lt_last_filter`, + `path_lt_le_last` + +- new file `contra.v` + + lemma `assume_not` + + tactic `assume_not` + + lemma `absurd_not` + + tactics `absurd_not`, `contrapose` + + tactic notations `contra`, `contra : constr(H)`, `contra : ident(H)`, + `contra : { hyp_list(Hs) } constr(H)`, `contra : { hyp_list(Hs) } ident(H)`, + `contra : { - } constr(H)` + + lemma `absurd` + + tactic notations `absurd`, `absurd constr(P)`, `absurd : constr(H)`, + `absurd : ident(H)`, `absurd : { hyp_list(Hs) } constr(H)`, + `absurd : { hyp_list(Hs) } ident(H)` + +- in `topology.v`: + + lemma `filter_bigI_within` + + lemma `near_powerset_map` + + lemma `near_powerset_map_monoE` + + lemma `fst_open` + + lemma `snd_open` + + definition `near_covering_within` + + lemma `near_covering_withinP` + + lemma `compact_setM` + + lemma `compact_regular` + + lemma `fam_compact_nbhs` + + definition `compact_open`, notation `{compact-open, U -> V}` + + notation `{compact-open, F --> f}` + + definition `compact_openK` + + definition `compact_openK_nbhs` + + instance `compact_openK_nbhs_filter` + + definition `compact_openK_topological_mixin` + + canonicals `compact_openK_filter`, `compact_openK_topological`, + `compact_open_pointedType` + + definition `compact_open_topologicalType` + + canonicals `compact_open_filtered`, `compact_open_topological` + + lemma `compact_open_cvgP` + + lemma `compact_open_open` + + lemma `compact_closedI` + + lemma `compact_open_fam_compactP` + + lemma `compact_equicontinuous` + + lemma `uniform_regular` + + lemma `continuous_curry` + + lemma `continuous_uncurry_regular` + + lemma `continuous_uncurry` + + lemma `curry_continuous` + + lemma `uncurry_continuous` + +- in `ereal.v`: + + lemma `ereal_supy` + +- in file `normedtype.v`, + + new lemma `continuous_within_itvP`. + +- in file `realfun.v`, + + new definitions `itv_partition`, `itv_partitionL`, `itv_partitionR`, + `variation`, `variations`, `bounded_variation`, `total_variation`, + `neg_tv`, and `pos_tv`. + + + new lemmas `left_right_continuousP`, + `nondecreasing_funN`, `nonincreasing_funN` + + + new lemmas `itv_partition_nil`, `itv_partition_cons`, `itv_partition1`, + `itv_partition_size_neq0`, `itv_partitionxx`, `itv_partition_le`, + `itv_partition_cat`, `itv_partition_nth_size`, + `itv_partition_nth_ge`, `itv_partition_nth_le`, + `nondecreasing_fun_itv_partition`, `nonincreasing_fun_itv_partition`, + `itv_partitionLP`, `itv_partitionRP`, `in_itv_partition`, + `notin_itv_partition`, `itv_partition_rev`, + + + new lemmas `variation_zip`, `variation_prev`, `variation_next`, `variation_nil`, + `variation_ge0`, `variationN`, `variation_le`, `nondecreasing_variation`, + `nonincreasing_variation`, `variationD`, `variation_itv_partitionLR`, + `le_variation`, `variation_opp_rev`, `variation_rev_opp` + + + new lemmas `variations_variation`, `variations_neq0`, `variationsN`, `variationsxx` + + + new lemmas `bounded_variationxx`, `bounded_variationD`, `bounded_variationN`, + `bounded_variationl`, `bounded_variationr`, `variations_opp`, + `nondecreasing_bounded_variation` + + + new lemmas `total_variationxx`, `total_variation_ge`, `total_variation_ge0`, + `bounded_variationP`, `nondecreasing_total_variation`, `total_variationN`, + `total_variation_le`, `total_variationD`, `neg_tv_nondecreasing`, + `total_variation_pos_neg_tvE`, `fine_neg_tv_nondecreasing`, + `neg_tv_bounded_variation`, `total_variation_right_continuous`, + `neg_tv_right_continuous`, `total_variation_opp`, + `total_variation_left_continuous`, `total_variation_continuous` + +- in `lebesgue_stieltjes_measure.v`: + + `sigma_finite_measure` HB instance on `lebesgue_stieltjes_measure` + +- in `lebesgue_measure.v`: + + `sigma_finite_measure` HB instance on `lebesgue_measure` + +- in `lebesgue_integral.v`: + + `sigma_finite_measure` instance on product measure `\x` + +### Changed + +- in `topology.v`: + + lemmas `nbhsx_ballx` and `near_ball` take a parameter of type `R` instead of `{posnum R}` + + lemma `pointwise_compact_cvg` + +### Generalized + +- in `realfun.v`: + + lemmas `nonincreasing_at_right_cvgr`, `nonincreasing_at_left_cvgr` + + lemmas `nondecreasing_at_right_cvge`, `nondecreasing_at_right_is_cvge`, + `nonincreasing_at_right_cvge`, `nonincreasing_at_right_is_cvge` + +- in `realfun.v`: + + lemmas `nonincreasing_at_right_is_cvgr`, `nondecreasing_at_right_is_cvgr` + +## [0.6.7] - 2024-01-09 + +### Added + +- in `boolp.v`: + + tactic `eqProp` + + variant `BoolProp` + + lemmas `PropB`, `notB`, `andB`, `orB`, `implyB`, `decide_or`, `not_andE`, + `not_orE`, `orCA`, `orAC`, `orACA`, `orNp`, `orpN`, `or3E`, `or4E`, `andCA`, + `andAC`, `andACA`, `and3E`, `and4E`, `and5E`, `implyNp`, `implypN`, + `implyNN`, `or_andr`, `or_andl`, `and_orr`, `and_orl`, `exists2E`, + `inhabitedE`, `inhabited_witness` + +- in `topology.v`, + + new lemmas `perfect_set2`, and `ent_closure`. + + lemma `clopen_surj` + + lemma `nbhs_dnbhs_neq` + + lemma `dnbhs_ball` + +- in `constructive_ereal.v` + + lemma `lee_subgt0Pr` + +- in `ereal.v`: + + lemmas `ereal_sup_le`, `ereal_inf_le` + +- in `normedtype.v`: + + hints for `at_right_proper_filter` and `at_left_proper_filter` + + definition `lower_semicontinuous` + + lemma `lower_semicontinuousP` + + lemma `not_near_at_rightP` + + lemmas `withinN`, `at_rightN`, `at_leftN`, `cvg_at_leftNP`, `cvg_at_rightNP` + + lemma `dnbhsN` + + lemma `limf_esup_dnbhsN` + + definitions `limf_esup`, `limf_einf` + + lemmas `limf_esupE`, `limf_einfE`, `limf_esupN`, `limf_einfN` + +- in `sequences.v`: + + lemma `minr_cvg_0_cvg_0` + + lemma `mine_cvg_0_cvg_fin_num` + + lemma `mine_cvg_minr_cvg` + + lemma `mine_cvg_0_cvg_0` + + lemma `maxr_cvg_0_cvg_0` + + lemma `maxe_cvg_0_cvg_fin_num` + + lemma `maxe_cvg_maxr_cvg` + + lemma `maxe_cvg_0_cvg_0` + + lemmas `limn_esup_lim`, `limn_einf_lim` + +- in file `cantor.v`, + + new definitions `cantor_space`, `cantor_like`, `pointed_discrete`, and + `tree_of`. + + new lemmas `cantor_space_compact`, `cantor_space_hausdorff`, + `cantor_zero_dimensional`, `cantor_perfect`, `cantor_like_cantor_space`, + `tree_map_props`, `homeomorphism_cantor_like`, and + `cantor_like_finite_prod`. + + new theorem `cantor_surj`. + +- in `numfun.v`: + + lemma `patch_indic` + +- in `realfun.v`: + + notations `nondecreasing_fun`, `nonincreasing_fun`, + `increasing_fun`, `decreasing_fun` + + lemmas `cvg_addrl`, `cvg_addrr`, `cvg_centerr`, `cvg_shiftr`, + `nondecreasing_cvgr`, + `nonincreasing_at_right_cvgr`, + `nondecreasing_at_right_cvgr`, + `nondecreasing_cvge`, `nondecreasing_is_cvge`, + `nondecreasing_at_right_cvge`, `nondecreasing_at_right_is_cvge`, + `nonincreasing_at_right_cvge`, `nonincreasing_at_right_is_cvge` + + lemma `cvg_at_right_left_dnbhs` + + lemma `cvg_at_rightP` + + lemma `cvg_at_leftP` + + lemma `cvge_at_rightP` + + lemma `cvge_at_leftP` + + lemma `lime_sup` + + lemma `lime_inf` + + lemma `lime_supE` + + lemma `lime_infE` + + lemma `lime_infN` + + lemma `lime_supN` + + lemma `lime_sup_ge0` + + lemma `lime_inf_ge0` + + lemma `lime_supD` + + lemma `lime_sup_le` + + lemma `lime_inf_sup` + + lemma `lim_lime_inf` + + lemma `lim_lime_sup` + + lemma `lime_sup_inf_at_right` + + lemma `lime_sup_inf_at_left` + + lemmas `lime_sup_lim`, `lime_inf_lim` + +- in file `measure.v` + + add lemmas `ae_eq_subset`, `measure_dominates_ae_eq`. + +- in `lebesgue_measure.v` + + lemma `lower_semicontinuous_measurable` + +- in `lebesgue_integral.v`: + + definition `locally_integrable` + + lemmas `integrable_locally`, `locally_integrableN`, `locally_integrableD`, + `locally_integrableB` + + definition `iavg` + + lemmas `iavg0`, `iavg_ge0`, `iavg_restrict`, `iavgD` + + definitions `HL_maximal` + + lemmas `HL_maximal_ge0`, `HL_maximalT_ge0`, + `lower_semicontinuous_HL_maximal`, `measurable_HL_maximal`, + `maximal_inequality` + +- in `charge.v` + + definition `charge_of_finite_measure` (instance of `charge`) + + lemmas `dominates_cscalel`, `dominates_cscaler` + + definition `cpushforward` (instance of `charge`) + + lemma `dominates_pushforward` + + lemma `cjordan_posE` + + lemma `jordan_posE` + + lemma `cjordan_negE` + + lemma `jordan_negE` + + lemma `Radon_Nikodym_sigma_finite` + + lemma `Radon_Nikodym_fin_num` + + lemma `Radon_Nikodym_integral` + + lemma `ae_eq_Radon_Nikodym_SigmaFinite` + + lemma `Radon_Nikodym_change_of_variables` + + lemma `Radon_Nikodym_cscale` + + lemma `Radon_Nikodym_cadd` + + lemma `Radon_Nikodym_chain_rule` + +### Changed + +- in `boolp.v` + - lemmas `orC` and `andC` now use `commutative` + +- moved from `topology.v` to `mathcomp_extra.v` + + definition `monotonous` + +- in `normedtype.v`: + + lemmas `vitali_lemma_finite` and `vitali_lemma_finite_cover` now returns + duplicate-free lists of indices + +- in `sequences.v`: + + change the implicit arguments of `trivIset_seqDU` + + `limn_esup` now defined from `lime_sup` + + `limn_einf` now defined from `limn_esup` + +- moved from `lebesgue_integral.v` to `measure.v`: + + definition `ae_eq` + + lemmas + `ae_eq0`, + `ae_eq_comp`, + `ae_eq_funeposneg`, + `ae_eq_refl`, + `ae_eq_trans`, + `ae_eq_sub`, + `ae_eq_mul2r`, + `ae_eq_mul2l`, + `ae_eq_mul1l`, + `ae_eq_abse` + +- in `charge.v` + + definition `jordan_decomp` now uses `cadd` and `cscale` + + definition `Radon_Nikodym_SigmaFinite` now in a module `Radon_Nikodym_SigmaFinite` with + * definition `f` + * lemmas `f_ge0`, `f_fin_num`, `f_integrable`, `f_integral` + * lemma `change_of_variables` + * lemma `integralM` + * lemma `chain_rule` + +### Renamed + +- in `exp.v`: + + `lnX` -> `lnXn` + +- in `charge.v`: + + `dominates_caddl` -> `dominates_cadd` + +### Generalized + +- in `lebesgue_measure.v` + + an hypothesis of lemma `integral_ae_eq` is weakened + +- in `lebesgue_integral.v` + + `ge0_integral_bigsetU` generalized from `nat` to `eqType` + +### Removed + +- in `boolp.v`: + + lemma `pdegen` + +- in `forms.v`: + + lemmas `eq_map_mx`, `map_mx_id` + +## [0.6.6] - 2023-11-14 + +### Added + +- in `mathcomp_extra.v` + + lemmas `ge0_ler_normr`, `gt0_ler_normr`, `le0_ger_normr` and `lt0_ger_normr` + + lemma `leq_ltn_expn` + + lemma `onemV` + +- in `classical_sets.v`: + + lemma `set_cons1` + + lemma `trivIset_bigcup` + + definition `maximal_disjoint_subcollection` + + lemma `ex_maximal_disjoint_subcollection` + + lemmas `mem_not_I`, `trivIsetT_bigcup` + +- in `constructive_ereal.v`: + + lemmas `gt0_fin_numE`, `lt0_fin_numE` + + lemmas `le_er_map`, `er_map_idfun` + +- in `reals.v`: + + lemma `le_inf` + + lemmas `ceilN`, `floorN` + +- in `topology.v`: + + lemmas `closure_eq0`, `separated_open_countable` + +- in `normedtype.v`: + + lemmas `ball0`, `ball_itv`, `closed_ball0`, `closed_ball_itv` + + definitions `cpoint`, `radius`, `is_ball` + + definition `scale_ball`, notation notation ``` *` ``` + + lemmas `sub_scale_ball`, `scale_ball1`, `sub1_scale_ball` + + lemmas `ball_inj`, `radius0`, `cpoint_ball`, `radius_ball_num`, + `radius_ball`, `is_ballP`, `is_ball_ball`, `scale_ball_set0`, + `ballE`, `is_ball_closure`, `scale_ballE`, `cpoint_scale_ball`, + `radius_scale_ball` + + lemmas `vitali_lemma_finite`, `vitali_lemma_finite_cover` + + definition `vitali_collection_partition` + + lemmas `vitali_collection_partition_ub_gt0`, + `ex_vitali_collection_partition`, `cover_vitali_collection_partition`, + `disjoint_vitali_collection_partition` + + lemma `separate_closed_ball_countable` + + lemmas `vitali_lemma_infinite`, `vitali_lemma_infinite_cover` + + lemma `open_subball` + + lemma `closed_disjoint_closed_ball` + + lemma `is_scale_ball` + + lemmas `scale_ball0`, `closure_ball`, `bigcup_ballT` + +- in `sequences.v`: + + lemma `nneseries_tail_cvg` + +- in `exp.v`: + + definition `expeR` + + lemmas `expeR0`, `expeR_ge0`, `expeR_gt0` + + lemmas `expeR_eq0`, `expeRD`, `expeR_ge1Dx` + + lemmas `ltr_expeR`, `ler_expeR`, `expeR_inj`, `expeR_total` + + lemmas `mulr_powRB1`, `fin_num_poweR`, `poweRN`, `poweR_lty`, `lty_poweRy`, `gt0_ler_poweR` + + lemma `expRM` + +- in `measure.v`: + + lemmas `negligibleI`, `negligible_bigsetU`, `negligible_bigcup` + + lemma `probability_setC` + + lemma `measure_sigma_sub_additive_tail` + + lemma `outer_measure_sigma_subadditive_tail` + +- new `lebesgue_stieltjes_measure.v`: + + notation `right_continuous` + + lemmas `right_continuousW`, `nondecreasing_right_continuousP` + + mixin `isCumulative`, structure `Cumulative`, notation `cumulative` + + `idfun` instance of `Cumulative` + + `wlength`, `wlength0`, `wlength_singleton`, `wlength_setT`, `wlength_itv`, + `wlength_finite_fin_num`, `finite_wlength_itv`, `wlength_itv_bnd`, `wlength_infty_bnd`, + `wlength_bnd_infty`, `infinite_wlength_itv`, `wlength_itv_ge0`, `wlength_Rhull`, + `le_wlength_itv`, `le_wlength`, `wlength_semi_additive`, `wlength_ge0`, + `lebesgue_stieltjes_measure_unique` + + content instance of `hlength` + + `cumulative_content_sub_fsum`, + `wlength_sigma_sub_additive`, `wlength_sigma_finite` + + measure instance of `hlength` + + definition `lebesgue_stieltjes_measure` + +- in `lebesgue_measure.v`: + + lemma `lebesgue_measurable_ball` + + lemmas `measurable_closed_ball`, `lebesgue_measurable_closed_ball` + + definition `vitali_cover` + + lemma `vitali_theorem` + +- in `lebesgue_integral.v`: + + `mfun` instances for `expR` and `comp` + + lemma `abse_integralP` + +- in `charge.v`: + + factory `isCharge` + + Notations `.-negative_set`, `.-positive_set` + + lemmas `dominates_cscale`, `Radon_Nikodym_cscale` + + definition `cadd`, lemmas `dominates_caddl`, `Radon_Nikodym_cadd` + +- in `probability.v`: + + definition `mmt_gen_fun`, `chernoff` + +- in `hoelder.v`: + + lemmas `powR_Lnorm`, `minkowski` + +### Changed + +- in `normedtype.v`: + + order of arguments of `squeeze_cvgr` + +- moved from `derive.v` to `normedtype.v`: + + lemmas `cvg_at_rightE`, `cvg_at_leftE` + +- in `measure.v`: + + order of parameters changed in `semi_sigma_additive_is_additive`, + `isMeasure` + +- in `lebesgue_measure.v`: + + are now prefixed with `LebesgueMeasure`: + * `hlength`, `hlength0`, `hlength_singleton`, `hlength_setT`, `hlength_itv`, + `hlength_finite_fin_num`, `hlength_infty_bnd`, + `hlength_bnd_infty`, `hlength_itv_ge0`, `hlength_Rhull`, + `le_hlength_itv`, `le_hlength`, `hlength_ge0`, `hlength_semi_additive`, + `hlength_sigma_sub_additive`, `hlength_sigma_finite`, `lebesgue_measure` + * `finite_hlengthE` renamed to `finite_hlentgh_itv` + * `pinfty_hlength` renamed to `infinite_hlength_itv` + + `lebesgue_measure` now defined with `lebesgue_stieltjes_measure` + + `lebesgue_measure_itv` does not refer to `hlength` anymore + + remove one argument of `lebesgue_regularity_inner_sup` + +- moved from `lebesgue_measure.v` to `lebesgue_stieltjes_measure.v` + + notations `_.-ocitv`, `_.-ocitv.-measurable` + + definitions `ocitv`, `ocitv_display` + + lemmas `is_ocitv`, `ocitv0`, `ocitvP`, `ocitvD`, `ocitvI` + +- in `lebesgue_integral.v`: + + `integral_dirac` now uses the `\d_` notation + + order of arguments in the lemma `le_abse_integral` + +- in `hoelder.v`: + + definition `Lnorm` now `HB.lock`ed + +- in `probability.v`: + + `markov` now uses `Num.nneg` + +### Renamed + +- in `ereal.v`: + + `le_er_map` -> `le_er_map_in` + +- in `sequences.v`: + + `lim_sup` -> `limn_sup` + + `lim_inf` -> `limn_inf` + + `lim_infN` -> `limn_infN` + + `lim_supE` -> `limn_supE` + + `lim_infE` -> `limn_infE` + + `lim_inf_le_lim_sup` -> `limn_inf_sup` + + `cvg_lim_inf_sup` -> `cvg_limn_inf_sup` + + `cvg_lim_supE` -> `cvg_limn_supE` + + `le_lim_supD` -> `le_limn_supD` + + `le_lim_infD` -> `le_limn_infD` + + `lim_supD` -> `limn_supD` + + `lim_infD` -> `limn_infD` + + `LimSup.lim_esup` -> `limn_esup` + + `LimSup.lim_einf` -> `limn_einf` + + `lim_einf_shift` -> `limn_einf_shift` + + `lim_esup_le_cvg` -> `limn_esup_le_cvg` + + `lim_einfN` -> `limn_einfN` + + `lim_esupN` -> `limn_esupN` + + `lim_einf_sup` -> `limn_einf_sup` + + `cvgNy_lim_einf_sup` -> `cvgNy_limn_einf_sup` + + `cvg_lim_einf_sup` -> `cvg_limn_einf_sup` + + `is_cvg_lim_einfE` -> `is_cvg_limn_einfE` + + `is_cvg_lim_esupE` -> `is_cvg_limn_esupE` + + `ereal_nondecreasing_cvg` -> `ereal_nondecreasing_cvgn` + + `ereal_nondecreasing_is_cvg` -> `ereal_nondecreasing_is_cvgn` + + `ereal_nonincreasing_cvg` -> `ereal_nonincreasing_cvgn` + + `ereal_nonincreasing_is_cvg` -> `ereal_nonincreasing_is_cvgn` + + `ereal_nondecreasing_opp` -> `ereal_nondecreasing_oppn` + + `nonincreasing_cvg_ge` -> `nonincreasing_cvgn_ge` + + `nondecreasing_cvg_le` -> `nondecreasing_cvgn_le` + + `nonincreasing_cvg` -> `nonincreasing_cvgn` + + `nondecreasing_cvg` -> `nondecreasing_cvgn` + + `nonincreasing_is_cvg` -> `nonincreasing_is_cvgn` + + `nondecreasing_is_cvg` -> `nondecreasing_is_cvgn` + + `near_nonincreasing_is_cvg` -> `near_nonincreasing_is_cvgn` + + `near_nondecreasing_is_cvg` -> `near_nondecreasing_is_cvgn` + + `nondecreasing_dvg_lt` -> `nondecreasing_dvgn_lt` + +- in `lebesgue_measure.v`: + + `measurable_fun_lim_sup` -> `measurable_fun_limn_sup` + + `measurable_fun_lim_esup` -> `measurable_fun_limn_esup` + +- in `charge.v` + + `isCharge` -> `isSemiSigmaAdditive` + +### Generalized + +- in `classical_sets.v`: + + `set_nil` generalized to `eqType` + +- in `topology.v`: + + `ball_filter` generalized to `realDomainType` + +- in `lebesgue_integral.v`: + + weaken an hypothesis of `integral_ae_eq` + +### Removed + +- `lebesgue_measure_unique` (generalized to `lebesgue_stieltjes_measure_unique`) + +- in `sequences.v`: + + notations `elim_sup`, `elim_inf` + + `LimSup.lim_esup`, `LimSup.lim_einf` + + `elim_inf_shift` + + `elim_sup_le_cvg` + + `elim_infN` + + `elim_supN` + + `elim_inf_sup` + + `cvg_ninfty_elim_inf_sup` + + `cvg_ninfty_einfs` + + `cvg_ninfty_esups` + + `cvg_pinfty_einfs` + + `cvg_pinfty_esups` + + `cvg_elim_inf_sup` + + `is_cvg_elim_infE` + + `is_cvg_elim_supE` + +- in `lebesgue_measure.v`: + + `measurable_fun_elim_sup` + +## [0.6.5] - 2023-10-02 + +### Added + +- in `mathcomp_extra.v`: + + lemmas `le_bigmax_seq`, `bigmax_sup_seq` + + lemma `gerBl` +- in `classical_sets.v`: + + lemma `setU_id2r` +- in `ereal.v`: + + lemmas `uboundT`, `supremumsT`, `supremumT`, `ereal_supT`, `range_oppe`, + `ereal_infT` +- in `constructive_ereal.v`: + + lemma `eqe_pdivr_mull` + + lemma `bigmaxe_fin_num` +- in file `topology.v`, + + new definition `regular_space`. + + new lemma `ent_closure`. +- in `normedtype.v`: + + lemmas `open_itvoo_subset`, `open_itvcc_subset` + + new lemmas `normal_openP`, `uniform_regular`, + `regular_openP`, and `pseudometric_normal`. +- in `sequences.v`: + + lemma `cvge_harmonic` +- in `convex.v`: + + lemmas `conv_gt0`, `convRE` + + definition `convex_function` +- in `exp.v`: + + lemmas `concave_ln`, `conjugate_powR` + + lemmas `ln_le0`, `ger_powR`, `ler1_powR`, `le1r_powR`, `ger1_powR`, + `ge1r_powR`, `ge1r_powRZ`, `le1r_powRZ` + + lemma `gt0_ltr_powR` + + lemma `powR_injective` +- in `measure.v`: + + lemmas `outer_measure_subadditive`, `outer_measureU2` + + definition `ess_sup`, lemma `ess_sup_ge0` +- in `lebesgue_measure.v`: + + lemma `compact_measurable` + + declare `lebesgue_measure` as a `SigmaFinite` instance + + lemma `lebesgue_regularity_inner_sup` + + lemma `measurable_ball` + + lemma `measurable_mulrr` +- in `lebesgue_integral.v`, + + new lemmas `integral_le_bound`, `continuous_compact_integrable`, and + `lebesgue_differentiation_continuous`. + + new lemmas `simple_bounded`, `measurable_bounded_integrable`, + `compact_finite_measure`, `approximation_continuous_integrable` + + lemma `ge0_integral_count` +- in `kernel.v`: + + `kseries` is now an instance of `Kernel_isSFinite_subdef` +- new file `hoelder.v`: + + definition `Lnorm`, notations `'N[mu]_p[f]`, `'N_p[f]` + + lemmas `Lnorm1`, `Lnorm_ge0`, `eq_Lnorm`, `Lnorm_eq0_eq0` + + lemma `hoelder` + + lemmas `Lnorm_counting`, `hoelder2`, `convex_powR` + +### Changed + +- in `cardinality.v`: + + implicits of `fimfunP` +- in `constructive_ereal.v`: + + `lee_adde` renamed to `lee_addgt0Pr` and turned into a reflect + + `lee_dadde` renamed to `lee_daddgt0Pr` and turned into a reflect +- in `exp.v`: + + `gt0_ler_powR` now uses `Num.nneg` +- removed dependency in `Rstruct.v` on `normedtype.v`: +- added dependency in `normedtype.v` on `Rstruct.v`: +- `mnormalize` moved from `kernel.v` to `measure.v` and generalized +- in `measure.v`: + + implicits of `measurable_fst` and `measurable_snd` +- in `lebesgue_integral.v` + + rewrote `negligible_integral` to replace the positivity condition + with an integrability condition, and added `ge0_negligible_integral`. + + implicits of `integral_le_bound` + +### Renamed + +- in `constructive_ereal.v`: + + `lee_opp` -> `leeN2` + + `lte_opp` -> `lteN2` +- in `normedtype.v`: + + `normal_urysohnP` -> `normal_separatorP`. +- in `exp.v`: + + `gt0_ler_powR` -> `ge0_ler_powR` + +### Removed + +- in `signed.v`: + + specific notation for `2%:R`, + now subsumed by number notations in MC >= 1.15 + Note that when importing ssrint, `2` now denotes `2%:~R` rather than `2%:R`, + which are convertible but don't have the same head constant. + +## [0.6.4] - 2023-08-05 + +### Added + +- in `theories/Make` + + file `probability.v` (wasn't compiled in OPAM packages up to now) +- in `mathcomp_extra.v`: + + definition `min_fun`, notation `\min` + + new lemmas `maxr_absE`, `minr_absE` +- in file `boolp.v`, + + lemmas `notP`, `notE` + + new lemma `implyE`. + + new lemmas `contra_leP` and `contra_ltP` +- in `classical_sets.v`: + + lemmas `set_predC`, `preimage_true`, `preimage_false` + + lemmas `properW`, `properxx` + + lemma `Zorn_bigcup` + + lemmas `imsub1` and `imsub1P` + + lemma `bigcup_bigcup` +- in `constructive_ereal.v`: + + lemmas `lte_pmulr`, `lte_pmull`, `lte_nmulr`, `lte_nmull` + + lemmas `lte0n`, `lee0n`, `lte1n`, `lee1n` + + lemmas `fine0` and `fine1` +- in file `reals.v`: + + lemmas `sup_sumE`, `inf_sumE` +- in `signed.v`: + + lemmas `Posz_snum_subproof` and `Negz_snum_subproof` + + canonical instances `Posz_snum` and `Negz_snum` +- in file `topology.v`, + + new lemma `uniform_nbhsT`. + + new definition `set_nbhs`. + + new lemmas `filterI_iter_sub`, `filterI_iterE`, `finI_fromI`, + `filterI_iter_finI`, `smallest_filter_finI`, and `set_nbhsP`. + + lemma `bigsetU_compact` + + lemma `ball_symE` + + new lemma `pointwise_cvgP`. + + lemma `closed_bigcup` + + new definition `normal_space`. + + new lemmas `filter_inv`, and `countable_uniform_bounded`. +- in file `normedtype.v`, + + new definition `edist`. + + new lemmas `edist_ge0`, `edist_neqNy`, `edist_lt_ball`, + `edist_fin`, `edist_pinftyP`, `edist_finP`, `edist_fin_open`, + `edist_fin_closed`, `edist_pinfty_open`, `edist_sym`, `edist_triangle`, + `edist_continuous`, `edist_closeP`, and `edist_refl`. + + new definitions `edist_inf`, `uniform_separator`, and `Urysohn`. + + new lemmas `continuous_min`, `continuous_max`, `edist_closel`, + `edist_inf_ge0`, `edist_inf_neqNy`, `edist_inf_triangle`, + `edist_inf_continuous`, `edist_inf0`, `Urysohn_continuous`, + `Urysohn_range`, `Urysohn_sub0`, `Urysohn_sub1`, `Urysohn_eq0`, + `Urysohn_eq1`, `uniform_separatorW`, `normal_uniform_separator`, + `uniform_separatorP`, `normal_urysohnP`, and + `subset_closure_half`. +- in file `real_interval.v`, + + new lemma `bigcup_itvT`. +- in `sequences.v`: + + lemma `eseries_cond` + + lemmas `eseries_mkcondl`, `eseries_mkcondr` + + new lemmas `geometric_partial_tail`, and `geometric_le_lim`. +- in `exp.v`: + + lemmas `powRrM`, `gt0_ler_powR`, + `gt0_powR`, `norm_powR`, `lt0_norm_powR`, + `powRB` + + lemmas `poweRrM`, `poweRAC`, `gt0_poweR`, + `poweR_eqy`, `eqy_poweR`, `poweRD`, `poweRB` + + notation `` e `^?(r +? s) `` + + lemmas `expR_eq0`, `powRN` + + definition `poweRD_def` + + lemmas `poweRD_defE`, `poweRB_defE`, `add_neq0_poweRD_def`, + `add_neq0_poweRB_def`, `nneg_neq0_poweRD_def`, `nneg_neq0_poweRB_def` + + lemmas `powR_eq0`, `poweR_eq0` +- in file `numfun.v`, + + new lemma `continuous_bounded_extension`. +- in `measure.v`: + + lemma `lebesgue_regularity_outer` + + new lemmas `measureU0`, `nonincreasing_cvg_mu`, and `epsilon_trick0`. + + new lemmas `finite_card_sum`, and `measureU2`. +- in `lebesgue_measure.v`: + + lemma `closed_measurable` + + new lemmas `lebesgue_nearly_bounded`, and `lebesgue_regularity_inner`. + + new lemmas `pointwise_almost_uniform`, and + `ae_pointwise_almost_uniform`. + + lemmas `measurable_fun_ltr`, `measurable_minr` +- in file `lebesgue_integral.v`, + + new lemmas `lusin_simple`, and `measurable_almost_continuous`. + + new lemma `approximation_sfun_integrable`. + +### Changed + +- in `classical_sets.v`: + + `bigcup_bigcup_dep` renamed to `bigcup_setM_dep` and + equality in the statement reversed + + `bigcup_bigcup` renamed to `bigcup_setM` and + equality in the statement reversed +- in `sequences.v`: + + lemma `nneseriesrM` generalized and renamed to `nneseriesZl` +- in `exp.v`: + + lemmas `power_posD` (now `powRD`), `power_posB` (now `powRB`) + +- moved from `lebesgue_measure.v` to `real_interval.v`: + + lemmas `set1_bigcap_oc`, `itv_bnd_open_bigcup`, `itv_open_bnd_bigcup`, + `itv_bnd_infty_bigcup`, `itv_infty_bnd_bigcup` +- moved from `functions.v` to `classical_sets.v`: `subsetP`. +- moved from `normedtype.v` to `topology.v`: `Rhausdorff`. + +### Renamed + +- in `boolp.v`: + + `mextentionality` -> `mextensionality` + + `extentionality` -> `extensionality` +- in `classical_sets.v`: + + `bigcup_set_cond` -> `bigcup_seq_cond` + + `bigcup_set` -> `bigcup_seq` + + `bigcap_set_cond` -> `bigcap_seq_cond` + + `bigcap_set` -> `bigcap_seq` +- in `normedtype.v`: + + `nbhs_closedballP` -> `nbhs_closed_ballP` +- in `exp.v`: + + `expK` -> `expRK` + + `power_pos_eq0` -> `powR_eq0_eq0` + + `power_pos_inv` -> `powR_invn` + + `powere_pos_eq0` -> `poweR_eq0_eq0` + + `power_pos` -> `powR` + + `power_pos_ge0` -> `powR_ge0` + + `power_pos_gt0` -> `powR_gt0` + + `gt0_power_pos` -> `gt0_powR` + + `power_pos0` -> `powR0` + + `power_posr1` -> `powRr1` + + `power_posr0` -> `powRr0` + + `power_pos1` -> `powR1` + + `ler_power_pos` -> `ler_powR` + + `gt0_ler_power_pos` -> `gt0_ler_powR` + + `power_posM` -> `powRM` + + `power_posrM` -> `powRrM` + + `power_posAC` -> `powRAC` + + `power_posD` -> `powRD` + + `power_posN` -> `powRN` + + `power_posB` -> `powRB` + + `power_pos_mulrn` -> `powR_mulrn` + + `power_pos_inv1` -> `powR_inv1` + + `power_pos_intmul` -> `powR_intmul` + + `ln_power_pos` -> `ln_powR` + + `power12_sqrt` -> `powR12_sqrt` + + `norm_power_pos` -> `norm_powR` + + `lt0_norm_power_pos` -> `lt0_norm_powR` + + `powere_pos` -> `poweR` + + `powere_pos_EFin` -> `poweR_EFin` + + `powere_posyr` -> `poweRyr` + + `powere_pose0` -> `poweRe0` + + `powere_pose1` -> `poweRe1` + + `powere_posNyr` -> `poweRNyr` + + `powere_pos0r` -> `poweR0r` + + `powere_pos1r` -> `poweR1r` + + `fine_powere_pos` -> `fine_poweR` + + `powere_pos_ge0` -> `poweR_ge0` + + `powere_pos_gt0` -> `poweR_gt0` + + `powere_posM` -> `poweRM` + + `powere12_sqrt` -> `poweR12_sqrt` +- in `lebesgue_measure.v`: + + `measurable_power_pos` -> `measurable_powR` +- in `lebesgue_integral.v`: + + `ge0_integralM_EFin` -> `ge0_integralZl_EFin` + + `ge0_integralM` -> `ge0_integralZl` + + `integralM_indic` -> `integralZl_indic` + + `integralM_indic_nnsfun` -> `integralZl_indic_nnsfun` + + `integrablerM` -> `integrableZl` + + `integrableMr` -> `integrableZr` + + `integralM` -> `integralZl` + +### Generalized + +- in `sequences.v`: + + lemmas `is_cvg_nneseries_cond`, `is_cvg_npeseries_cond` + + lemmas `is_cvg_nneseries`, `is_cvg_npeseries` + + lemmas `nneseries_ge0`, `npeseries_le0` + + lemmas `eq_eseriesr`, `lee_nneseries` +- in `exp.v`: + + lemmas `convex_expR`, `ler_power_pos` (now `ler_powR`) + + lemma `ln_power_pos` (now `ln_powR`) + + lemma `ln_power_pos` +- in `measure.v`: + + lemmas `measureDI`, `measureD`, `measureUfinl`, `measureUfinr`, + `null_set_setU`, `measureU0` + (from measure to content) + + lemma `subset_measure0` (from `realType` to `realFieldType`) +- in file `lebesgue_integral.v`, updated `le_approx`. + +### Removed + +- in `topology.v`: + + lemma `my_ball_le` (use `ball_le` instead) +- in `signed.v`: + + lemma `nat_snum_subproof` + + canonical instance `nat_snum` (useless, there is already a default instance + pointing to the typ_snum mechanism (then identifying nats as >= 0)) + +## [0.6.3] - 2023-06-21 + +### Added + +- in `mathcomp_extra.v` + + definition `coefE` (will be in MC 2.1/1.18) + + lemmas `deg2_poly_canonical`, `deg2_poly_factor`, `deg2_poly_min`, + `deg2_poly_minE`, `deg2_poly_ge0`, `Real.deg2_poly_factor`, + `deg_le2_poly_delta_ge0`, `deg_le2_poly_ge0` + (will be in MC 2.1/1.18) + + lemma `deg_le2_ge0` +- in `classical_sets.v`: + + lemmas `set_eq_le`, `set_neq_lt`, + + new lemma `trivIset1`. + + lemmas `preimage_mem_true`, `preimage_mem_false` +- in `functions.v`: + + lemma `sumrfctE` +- in `set_interval.v`: + + lemma `set_lte_bigcup` +- in `topology.v`: + + lemma `globally0` + + new definitions `basis`, and `second_countable`. + + new lemmas `clopen_countable` and `compact_countable_base`. +- in `ereal.v`: + + lemmas `compreDr`, `compreN` +- in `constructive_ereal.v`: + + lemmas `lee_sqr`, `lte_sqr`, `lee_sqrE`, `lte_sqrE`, `sqre_ge0`, + `EFin_expe`, `sqreD`, `sqredD` +- in `normedtype.v`: + + lemma `lipschitz_set0`, `lipschitz_set1` +- in `sequences.v`: + + lemma `eq_eseriesl` +- in `measure.v`: + + new lemmas `measurable_subring`, and `semiring_sigma_additive`. + + added factory `Content_SubSigmaAdditive_isMeasure` + + lemma `measurable_fun_bigcup` + + definition `measure_dominates`, notation `` `<< `` + + lemma `measure_dominates_trans` + + defintion `mfrestr` + + lemmas `measurable_pair1`, `measurable_pair2` +- in `lebesgue_measure.v`: + + lemma `measurable_expR` +- in `lebesgue_integral.v`: + + lemmas `emeasurable_fun_lt`, `emeasurable_fun_le`, `emeasurable_fun_eq`, + `emeasurable_fun_neq` + + lemma `integral_ae_eq` + + lemma `integrable_sum` + + lemmas `integrableP`, `measurable_int` +- in file `kernel.v`, + + new definitions `kseries`, `measure_fam_uub`, `kzero`, `kdirac`, + `prob_pointed`, `mset`, `pset`, `pprobability`, `kprobability`, `kadd`, + `mnormalize`, `knormalize`, `kcomp`, and `mkcomp`. + + new lemmas `eq_kernel`, `measurable_fun_kseries`, `integral_kseries`, + `measure_fam_uubP`, `eq_sfkernel`, `kzero_uub`, + `sfinite_kernel`, `sfinite_kernel_measure`, `finite_kernel_measure`, + `measurable_prod_subset_xsection_kernel`, + `measurable_fun_xsection_finite_kernel`, + `measurable_fun_xsection_integral`, + `measurable_fun_integral_finite_kernel`, + `measurable_fun_integral_sfinite_kernel`, `lt0_mset`, `gt1_mset`, + `kernel_measurable_eq_cst`, `kernel_measurable_neq_cst`, `kernel_measurable_fun_eq_cst`, + `measurable_fun_kcomp_finite`, `mkcomp_sfinite`, + `measurable_fun_mkcomp_sfinite`, `measurable_fun_preimage_integral`, + `measurable_fun_integral_kernel`, and `integral_kcomp`. + + lemma `measurable_fun_mnormalize` +- in `probability.v` + + definition of `covariance` + + lemmas `expectation_sum`, `covarianceE`, `covarianceC`, + `covariance_fin_num`, `covariance_cst_l`, `covariance_cst_r`, + `covarianceZl`, `covarianceZr`, `covarianceNl`, `covarianceNr`, + `covarianceNN`, `covarianceDl`, `covarianceDr`, `covarianceBl`, + `covarianceBr`, `variance_fin_num`, `varianceZ`, `varianceN`, + `varianceD`, `varianceB`, `varianceD_cst_l`, `varianceD_cst_r`, + `varianceB_cst_l`, `varianceB_cst_r` + + lemma `covariance_le` + + lemma `cantelli` +- in `charge.v`: + + definition `measure_of_charge` + + definition `crestr0` + + definitions `jordan_neg`, `jordan_pos` + + lemmas `jordan_decomp`, `jordan_pos_dominates`, `jordan_neg_dominates` + + lemma `radon_nikodym_finite` + + definition `Radon_Nikodym`, notation `'d nu '/d mu` + + theorems `Radon_Nikodym_integrable`, `Radon_Nikodym_integral` + +### Changed + +- in `lebesgue_measure.v` + + `measurable_funrM`, `measurable_funN`, `measurable_fun_exprn` +- in `lebesgue_integral.v`: + + lemma `xsection_ndseq_closed` generalized from a measure to a family of measures + + locked `integrable` and put it in bool rather than Prop +- in `probability.v` + + `variance` is now defined based on `covariance` + +### Renamed + +- in `derive.v`: + + `Rmult_rev` -> `mulr_rev` + + `rev_Rmult` -> `rev_mulr` + + `Rmult_is_linear` -> `mulr_is_linear` + + `Rmult_linear` -> `mulr_linear` + + `Rmult_rev_is_linear` -> `mulr_rev_is_linear` + + `Rmult_rev_linear` -> `mulr_rev_linear` + + `Rmult_bilinear` -> `mulr_bilinear` + + `is_diff_Rmult` -> `is_diff_mulr` +- in `measure.v`: + + `measurable_fun_id` -> `measurable_id` + + `measurable_fun_cst` -> `measurable_cst` + + `measurable_fun_comp` -> `measurable_comp` + + `measurable_funT_comp` -> `measurableT_comp` + + `measurable_fun_fst` -> `measurable_fst` + + `measurable_fun_snd` -> `measurable_snd` + + `measurable_fun_swap` -> `measurable_swap` + + `measurable_fun_pair` -> `measurable_fun_prod` + + `isMeasure0` -> ``Content_isMeasure` + + `Hahn_ext` -> `measure_extension` + + `Hahn_ext_ge0` -> `measure_extension_ge0` + + `Hahn_ext_sigma_additive` -> `measure_extension_semi_sigma_additive` + + `Hahn_ext_unique` -> `measure_extension_unique` + + `RingOfSets_from_semiRingOfSets` -> `SemiRingOfSets_isRingOfSets` + + `AlgebraOfSets_from_RingOfSets` -> `RingOfSets_isAlgebraOfSets` + + `Measurable_from_algebraOfSets` -> `AlgebraOfSets_isMeasurable` + + `ring_sigma_additive` -> `ring_semi_sigma_additive` +- in `lebesgue_measure.v` + + `measurable_funN` -> `measurable_oppr` + + `emeasurable_fun_minus` -> `measurable_oppe` + + `measurable_fun_abse` -> `measurable_abse` + + `measurable_EFin` -> `measurable_image_EFin` + + `measurable_fun_EFin` -> `measurable_EFin` + + `measurable_fine` -> `measurable_image_fine` + + `measurable_fun_fine` -> `measurable_fine` + + `measurable_fun_normr` -> `measurable_normr` + + `measurable_fun_exprn` -> `measurable_exprn` + + `emeasurable_fun_max` -> `measurable_maxe` + + `emeasurable_fun_min` -> `measurable_mine` + + `measurable_fun_max` -> `measurable_maxr` + + `measurable_fun_er_map` -> `measurable_er_map` + + `emeasurable_fun_funepos` -> `measurable_funepos` + + `emeasurable_fun_funeneg` -> `measurable_funeneg` + + `measurable_funrM` -> `measurable_mulrl` +- in `lebesgue_integral.v`: + + `measurable_fun_indic` -> `measurable_indic` + +### Deprecated + +- in `lebesgue_measure.v`: + + lemma `measurable_fun_sqr` (use `measurable_exprn` instead) + + lemma `measurable_fun_opp` (use `measurable_oppr` instead) + +### Removed + +- in `normedtype.v`: + + instance `Proper_dnbhs_realType` +- in `measure.v`: + + instances `ae_filter_algebraOfSetsType`, `ae_filter_measurableType`, + `ae_properfilter_measurableType` +- in `lebesgue_measure.v`: + + lemma `emeasurable_funN` (use `measurableT_comp`) instead + + lemma `measurable_fun_prod1` (use `measurableT_comp` instead) + + lemma `measurable_fun_prod2` (use `measurableT_comp` instead) +- in `lebesgue_integral.v` + + lemma `emeasurable_funN` (was already in `lebesgue_measure.v`, use `measurableT_comp` instead) + +## [0.6.2] - 2023-04-21 + +### Added + +- in `mathcomp_extra.v`: + + lemma `ler_sqrt` + + lemma `lt_min_lt` +- in `classical_sets.v`: + + lemmas `ltn_trivIset`, `subsetC_trivIset` +- in `contructive_ereal.v`: + + lemmas `ereal_blatticeMixin`, `ereal_tblatticeMixin` + + canonicals `ereal_blatticeType`, `ereal_tblatticeType` + + lemmas `EFin_min`, `EFin_max` + + definition `sqrte` + + lemmas `sqrte0`, `sqrte_ge0`, `lee_sqrt`, `sqrteM`, `sqr_sqrte`, + `sqrte_sqr`, `sqrte_fin_num` +- in `ereal.v`: + + lemmas `compreBr`, `compre_scale` + + lemma `le_er_map` +- in `set_interval.v`: + + lemma `onem_factor` + + lemmas `in1_subset_itv`, `subset_itvW` +- in `topology.v`, + + new definitions `totally_disconnected`, and `zero_dimensional`. + + new lemmas `component_closed`, `zero_dimension_prod`, + `discrete_zero_dimension`, `zero_dimension_totally_disconnected`, + `totally_disconnected_cvg`, and `totally_disconnected_prod`. + + new definitions `split_sym`, `gauge`, `gauge_uniformType_mixin`, + `gauge_topologicalTypeMixin`, `gauge_filtered`, `gauge_topologicalType`, + `gauge_uniformType`, `gauge_pseudoMetric_mixin`, and + `gauge_pseudoMetricType`. + + new lemmas `iter_split_ent`, `gauge_ent`, `gauge_filter`, + `gauge_refl`, `gauge_inv`, `gauge_split`, `gauge_countable_uniformity`, and + `uniform_pseudometric_sup`. + + new definitions `discrete_ent`, `discrete_uniformType`, `discrete_ball`, + `discrete_pseudoMetricType`, and `pseudoMetric_bool`. + + new lemmas `finite_compact`, `discrete_ball_center`, `compact_cauchy_cvg` +- in `normedtype.v`: + + lemmas `cvg_at_right_filter`, `cvg_at_left_filter`, + `cvg_at_right_within`, `cvg_at_left_within` +- in `sequences.v`: + + lemma `seqDUIE` +- in `derive.v`: + + lemma `derivable_within_continuous` +- in `realfun.v`: + + definition `derivable_oo_continuous_bnd`, lemma `derivable_oo_continuous_bnd_within` +- in `exp.v`: + + lemma `ln_power_pos` + + definition `powere_pos`, notation ``` _ `^ _ ``` in `ereal_scope` + + lemmas `powere_pos_EFin`, `powere_posyr`, `powere_pose0`, + `powere_pose1`, `powere_posNyr` `powere_pos0r`, `powere_pos1r`, + `powere_posNyr`, `fine_powere_pos`, `powere_pos_ge0`, + `powere_pos_gt0`, `powere_pos_eq0`, `powere_posM`, `powere12_sqrt` + + lemmas `derive_expR`, `convex_expR` + + lemmas `power_pos_ge0`, `power_pos0`, `power_pos_eq0`, + `power_posM`, `power_posAC`, `power12_sqrt`, `power_pos_inv1`, + `power_pos_inv`, `power_pos_intmul` +- in `measure.v`: + + lemmas `negligibleU`, `negligibleS` + + definition `almost_everywhere_notation` + + instances `ae_filter_ringOfSetsType`, `ae_filter_algebraOfSetsType`, + `ae_filter_measurableType` + + instances `ae_properfilter_algebraOfSetsType`, `ae_properfilter_measurableType` +- in `lebesgue_measure.v`: + + lemma `emeasurable_itv` + + lemma `measurable_fun_er_map` + + lemmas `measurable_fun_ln`, `measurable_fun_power_pos` +- in `lebesgue_integral.v`: + + lemma `sfinite_Fubini` + + instance of `isMeasurableFun` for `normr` + + lemma `finite_measure_integrable_cst` + + lemma `ae_ge0_le_integral` + + lemma `ae_eq_refl` +- new file `convex.v`: + + mixin `isConvexSpace`, structure `ConvexSpace`, notations `convType`, + `_ <| _ |> _` + + lemmas `conv1`, `second_derivative_convex` +- new file `charge.v`: + + mixin `isAdditiveCharge`, structure `AdditiveCharge`, notations + `additive_charge`, `{additive_charge set T -> \bar R}` + + mixin `isCharge`, structure `Charge`, notations `charge`, + `{charge set T -> \bar R}` + + lemmas `charge0`, `charge_semi_additiveW`, `charge_semi_additive2E`, + `charge_semi_additive2`, `chargeU`, `chargeDI`, `chargeD`, + `charge_partition` + + definitions `crestr`, `cszero`, `cscale`, `positive_set`, `negative_set` + + lemmas `negative_set_charge_le0`, `negative_set0`, `bigcup_negative_set`, + `negative_setU`, `positive_negative0` + + definition `hahn_decomposition` + + lemmas `hahn_decomposition_lemma`, `Hahn_decomposition`, `Hahn_decomposition_uniq` +- new file `itv.v`: + + definition `wider_itv` + + module `Itv`: + * definitions `map_itv_bound`, `map_itv` + * lemmas `le_map_itv_bound`, `subitv_map_itv` + * definition `itv_cond` + * record `def` + * notation `spec` + * record `typ` + * definitions `mk`, `from`, `fromP` + + notations `{itv R & i}`, `{i01 R}`, `%:itv`, `[itv of _]`, `inum`, `%:inum` + + definitions `itv_eqMixin`, `itv_choiceMixin`, `itv_porderMixin` + + canonical `itv_subType`, `itv_eqType`, `itv_choiceType`, `itv_porderType` + + lemma `itv_top_typ_subproof` + + canonical `itv_top_typ` + + lemma `typ_inum_subproof` + + canonical `typ_inum` + + notation `unify_itv` + + lemma `itv_intro` + + definition `empty_itv` + + lemmas `itv_bottom`, `itv_gt0`, `itv_le0F`, `itv_lt0`, `itv_ge0F`, + `itv_ge0`, `lt0F`, `le0`, `gt0F`, `lt1`, `ge1F`, `le1`, `gt1F` + + lemma `widen_itv_subproof` + + definition `widen_itv` + + lemma `widen_itvE` + + notation `%:i01` + + lemma `zero_inum_subproof` + + canonical `zero_inum` + + lemma `one_inum_subproof` + + canonical `one_inum` + + definition `opp_itv_bound_subdef` + + lemmas `opp_itv_ge0_subproof`, `opp_itv_gt0_subproof`, `opp_itv_boundr_subproof`, + `opp_itv_le0_subproof`, `opp_itv_lt0_subproof`, `opp_itv_boundl_subproof` + + definition `opp_itv_subdef` + + lemma `opp_inum_subproof ` + + canonical `opp_inum` + + definitions `add_itv_boundl_subdef`, `add_itv_boundr_subdef`, `add_itv_subdef` + + lemma `add_inum_subproof` + + canonical `add_inum` + + definitions `itv_bound_signl`, `itv_bound_signr`, `interval_sign` + + variant `interval_sign_spec` + + lemma `interval_signP` + + definitions `mul_itv_boundl_subdef`, `mul_itv_boundr_subdef` + + lemmas `mul_itv_boundl_subproof`, `mul_itv_boundrC_subproof`, `mul_itv_boundr_subproof`, + `mul_itv_boundr'_subproof` + + definition `mul_itv_subdef` + + lemmas `map_itv_bound_min`, `map_itv_bound_max`, `mul_inum_subproof` + + canonical `mul_inum` + + lemmas `inum_eq`, `inum_le`, `inum_lt` +- new file `probability.v`: + + definition `random_variable`, notation `{RV _ >-> _}` + + lemmas `notin_range_measure`, `probability_range` + + definition `distribution`, instance of `isProbability` + + lemma `probability_distribution`, `integral_distribution` + + definition `expectation`, notation `'E_P[X]` + + lemmas `expectation_cst`, `expectation_indic`, `integrable_expectation`, + `expectationM`, `expectation_ge0`, `expectation_le`, `expectationD`, + `expectationB` + + definition `variance`, `'V_P[X]` + + lemma `varianceE` + + lemmas `variance_ge0`, `variance_cst` + + lemmas `markov`, `chebyshev`, + + mixin `MeasurableFun_isDiscrete`, structure `discreteMeasurableFun`, + notation `{dmfun aT >-> T}` + + definition `discrete_random_variable`, notation `{dRV _ >-> _}` + + definitions `dRV_dom_enum`, `dRV_dom`, `dRV_enum`, `enum_prob` + + lemmas `distribution_dRV_enum`, `distribution_dRV`, `sum_enum_prob`, + `dRV_expectation` + + definion `pmf`, lemma `expectation_pmf` + +### Changed + +- in `mathcomp_extra.v` + + lemmas `eq_bigmax`, `eq_bigmin` changed to respect `P` in the returned type. +- in `constructive_ereal.v`: + + `maxEFin` changed to `fine_max` + + `minEFin` changed to `fine_min` +- in `exp.v`: + + generalize `exp_fun` and rename to `power_pos` + + `exp_fun_gt0` has now a condition and is renamed to `power_pos_gt0` + + remove condition of `exp_funr0` and rename to `power_posr0` + + weaken condition of `exp_funr1` and rename to `power_posr1` + + weaken condition of `exp_fun_inv` and rename to `power_pos_inv` + + `exp_fun1` -> `power_pos1` + + rename `ler_exp_fun` to `ler_power_pos` + + `exp_funD` -> `power_posD` + + weaken condition of `exp_fun_mulrn` and rename to `power_pos_mulrn` + + the notation ``` `^ ``` has now scope `real_scope` + + weaken condition of `riemannR_gt0` and `dvg_riemannR` +- in `measure.v`: + + generalize `negligible` to `semiRingOfSetsType` + + definition `almost_everywhere` + +### Renamed + +- in `functions.v`: + + `IsFun` -> `isFun` +- in `set_interval.v`: + + `conv` -> `line_path` + + `conv_id` -> `line_path_id` + + `ndconv` -> `ndline_path` + + `convEl` -> `line_pathEl` + + `convEr` -> `line_pathEr` + + `conv10` -> `line_path10` + + `conv0` -> `line_path0` + + `conv1` -> `line_path1` + + `conv_sym` -> `line_path_sym` + + `conv_flat` -> `line_path_flat` + + `leW_conv` -> `leW_line_path` + + `ndconvE` -> `ndline_pathE` + + `convK` -> `line_pathK` + + `conv_inj` -> `line_path_inj` + + `conv_bij` -> `line_path_bij` + + `le_conv` -> `le_line_path` + + `lt_conv` -> `lt_line_path` + + `conv_itv_bij` -> `line_path_itv_bij` + + `mem_conv_itv` -> `mem_line_path_itv` + + `mem_conv_itvcc` -> `mem_line_path_itvcc` + + `range_conv` -> `range_line_path` +- in `topology.v`: + + `Topological.ax1` -> `Topological.nbhs_pfilter` + + `Topological.ax2` -> `Topological.nbhsE` + + `Topological.ax3` -> `Topological.openE` + + `entourage_filter` -> `entourage_pfilter` + + `Uniform.ax1` -> `Uniform.entourage_filter` + + `Uniform.ax2` -> `Uniform.entourage_refl` + + `Uniform.ax3` -> `Uniform.entourage_inv` + + `Uniform.ax4` -> `Uniform.entourage_split_ex` + + `Uniform.ax5` -> `Uniform.nbhsE` + + `PseudoMetric.ax1` -> `PseudoMetric.ball_center` + + `PseudoMetric.ax2` -> `PseudoMetric.ball_sym` + + `PseudoMetric.ax3` -> `PseudoMetric.ball_triangle` + + `PseudoMetric.ax4` -> `PseudoMetric.entourageE` +- in `measure.v`: + + `emeasurable_fun_bool` -> `measurable_fun_bool` +- in `lebesgue_measure.v`: + + `punct_eitv_bnd_pinfty` -> `punct_eitv_bndy` + + `punct_eitv_ninfty_bnd` -> `punct_eitv_Nybnd` + + `eset1_pinfty` -> `eset1y` + + `eset1_ninfty` -> `eset1Ny` + + `ErealGenOInfty.measurable_set1_ninfty` -> `ErealGenOInfty.measurable_set1Ny` + + `ErealGenOInfty.measurable_set1_pinfty` -> `ErealGenOInfty.measurable_set1y` + + `ErealGenCInfty.measurable_set1_ninfty` -> `ErealGenCInfty.measurable_set1Ny` + + `ErealGenCInfty.measurable_set1_pinfty` -> `ErealGenCInfty.measurable_set1y` + +### Deprecated + +- in `realsum.v`: + + `psumB`, `interchange_sup`, `interchange_psum` +- in `distr.v`: + + `dlet_lim`, `dlim_let`, `exp_split`, `exp_dlet`, + `dlet_dlet`, `dmargin_dlet`, `dlet_dmargin`, + `dfst_dswap`, `dsnd_dswap`, `dsndE`, `pr_dlet`, + `exp_split`, `exp_dlet` +- in `measure.v`: + + lemma `measurable_fun_ext` +- in `lebesgue_measure.v`: + + lemmas `emeasurable_itv_bnd_pinfty`, `emeasurable_itv_ninfty_bnd` + (use `emeasurable_itv` instead) + +### Removed + +- in `lebesgue_integral.v`: + + lemma `ae_eq_mul` + +## [0.6.1] - 2023-02-24 + +### Added + +- in `mathcomp_extra.v`: + + lemma `add_onemK` + + function `swap` +- in file `boolp.v`, + + new lemma `forallp_asboolPn2`. +- in `classical_sets.v`: + + canonical `unit_pointedType` + + lemmas `setT0`, `set_unit`, `set_bool` + + lemmas `xsection_preimage_snd`, `ysection_preimage_fst` + + lemma `trivIset_mkcond` + + lemmas `xsectionI`, `ysectionI` + + lemma `coverE` + + new lemma `preimage_range`. +- in `constructive_ereal.v`: + + lemmas `EFin_sum_fine`, `sumeN` + + lemmas `adde_defDr`, `adde_def_sum`, `fin_num_sumeN` + + lemma `fin_num_adde_defr`, `adde_defN` + + lemma `oppe_inj` + + lemmas `expeS`, `fin_numX` + + lemmas `adde_def_doppeD`, `adde_def_doppeB` + + lemma `fin_num_sume_distrr` +- in `functions.v`: + + lemma `countable_bijP` + + lemma `patchE` +- in `numfun.v`: + + lemmas `xsection_indic`, `ysection_indic` +- in file `topology.v`, + + new definition `perfect_set`. + + new lemmas `perfectTP`, `perfect_prod`, and `perfect_diagonal`. + + new definitions `countable_uniformity`, `countable_uniformityT`, + `sup_pseudoMetric_mixin`, `sup_pseudoMetricType`, and + `product_pseudoMetricType`. + + new lemmas `countable_uniformityP`, `countable_sup_ent`, and + `countable_uniformity_metric`. + + new definitions `quotient_topology`, and `quotient_open`. + + new lemmas `pi_continuous`, `quotient_continuous`, and + `repr_comp_continuous`. + + new definitions `hausdorff_accessible`, `separate_points_from_closed`, and + `join_product`. + + new lemmas `weak_sep_cvg`, `weak_sep_nbhsE`, `weak_sep_openE`, + `join_product_continuous`, `join_product_open`, `join_product_inj`, and + `join_product_weak`. + + new definition `clopen`. + + new lemmas `clopenI`, `clopenU`, `clopenC`, `clopen0`, `clopenT`, + `clopen_comp`, `connected_closure`, `clopen_separatedP`, and + `clopen_connectedP`. + + new lemmas `powerset_filter_fromP` and `compact_cluster_set1`. +- in `exp.v`: + + lemma `expR_ge0` +- in `measure.v`: + + mixin `isProbability`, structure `Probability`, type `probability` + + lemma `probability_le1` + + definition `discrete_measurable_unit` + + structures `sigma_finite_additive_measure` and `sigma_finite_measure` + + lemmas `measurable_curry`, `measurable_fun_fst`, `measurable_fun_snd`, + `measurable_fun_swap`, `measurable_fun_pair`, `measurable_fun_if_pair` + + lemmas `dirac0`, `diracT` + + lemma `fin_num_fun_sigma_finite` + + structure `FiniteMeasure`, notation `{finite_measure set _ -> \bar _}` + + definition `sfinite_measure_def` + + mixin `Measure_isSFinite_subdef`, structure `SFiniteMeasure`, + notation `{sfinite_measure set _ -> \bar _}` + + mixin `SigmaFinite_isFinite` with field `fin_num_measure`, structure `FiniteMeasure`, + notation `{finite_measure set _ -> \bar _}` + + lemmas `sfinite_measure_sigma_finite`, `sfinite_mzero`, `sigma_finite_mzero` + + factory `Measure_isFinite`, `Measure_isSFinite` + + defintion `sfinite_measure_seq`, lemma `sfinite_measure_seqP` + + mixin `FiniteMeasure_isSubProbability`, structure `SubProbability`, + notation `subprobability` + + factory `Measure_isSubProbability` + + factory `FiniteMeasure_isSubProbability` + + factory `Measure_isSigmaFinite` + + lemmas `fin_num_fun_lty`, `lty_fin_num_fun` + + definition `fin_num_fun` + + structure `FinNumFun` +- in `lebesgue_measure.v`: + + lemma `measurable_fun_opp` +- in `lebesgue_integral.v` + + lemmas `integral0_eq`, `fubini_tonelli` + + product measures now take `{measure _ -> _}` arguments and their + theory quantifies over a `{sigma_finite_measure _ -> _}`. + + notations `\x`, `\x^` for `product_measure1` and `product_measure2` + +### Changed + +- in `fsbigop.v`: + + implicits of `eq_fsbigr` +- in file `topology.v`, + + lemma `compact_near_coveringP` +- in `functions.v`: + + notation `mem_fun_` +- move from `lebesgue_integral.v` to `classical_sets.v` + + lemmas `trivIset_preimage1`, `trivIset_preimage1_in` +- move from `lebesgue_integral.v` to `numfun.v` + + lemmas `fimfunE`, `fimfunEord`, factory `FiniteDecomp` + + lemmas `fimfun_mulr_closed` + + canonicals `fimfun_mul`, `fimfun_ring`, `fimfun_ringType` + + defintion `fimfun_ringMixin` + + lemmas `fimfunM`, `fimfun1`, `fimfun_prod`, `fimfunX`, + `indic_fimfun_subproof`. + + definitions `indic_fimfun`, `scale_fimfun`, `fimfun_comRingMixin` + + canonical `fimfun_comRingType` + + lemma `max_fimfun_subproof` + + mixin `IsNonNegFun`, structure `NonNegFun`, notation `{nnfun _ >-> _}` +- in `measure.v`: + + order of arguments of `isContent`, `Content`, `measure0`, `isMeasure0`, + `Measure`, `isSigmaFinite`, `SigmaFiniteContent`, `SigmaFiniteMeasure` + +### Renamed + +- in `measurable.v`: + + `measurable_fun_comp` -> `measurable_funT_comp` +- in `numfun.v`: + + `IsNonNegFun` -> `isNonNegFun` +- in `lebesgue_integral.v`: + + `IsMeasurableFunP` -> `isMeasurableFun` +- in `measure.v`: + + `{additive_measure _ -> _}` -> `{content _ -> _}` + + `isAdditiveMeasure` -> `isContent` + + `AdditiveMeasure` -> `Content` + + `additive_measure` -> `content` + + `additive_measure_snum_subproof` -> `content_snum_subproof` + + `additive_measure_snum` -> `content_snum` + + `SigmaFiniteAdditiveMeasure` -> `SigmaFiniteContent` + + `sigma_finite_additive_measure` -> `sigma_finite_content` + + `{sigma_finite_additive_measure _ -> _}` -> `{sigma_finite_content _ -> _}` +- in `constructive_ereal.v`: + + `fin_num_adde_def` -> `fin_num_adde_defl` + + `oppeD` -> `fin_num_oppeD` + + `oppeB` -> `fin_num_oppeB` + + `doppeD` -> `fin_num_doppeD` + + `doppeB` -> `fin_num_doppeB` +- in `topology.v`: + + `finSubCover` -> `finite_subset_cover` +- in `sequences.v`: + + `eq_eseries` -> `eq_eseriesr` +- in `esum.v`: + + `summable_nneseries_esum` -> `summable_eseries_esum` + + `summable_nneseries` -> `summable_eseries` + +### Generalized + +- in `classical_sets.v`: + + `xsection_preimage_snd`, `ysection_preimage_fst` +- in `constructive_ereal.v`: + + `oppeD`, `oppeB` +- in `esum.v`: + + lemma `esum_esum` +- in `measure.v` + + lemma `measurable_fun_comp` + + lemma `measure_bigcup` generalized, + + lemma `eq_measure` + + `sigma_finite` generalized from `numFieldType` to `numDomainType` + + `fin_num_fun_sigma_finite` generalized from `measurableType` to `algebraOfSetsType` +- in `lebesgue_integral.v`: + + lemma `measurable_sfunP` + + lemma `integrable_abse` + +### Removed + +- in `esum.v`: + + lemma `fsbig_esum` ## [0.6.0] - 2022-12-14 diff --git a/CHANGELOG_UNRELEASED.md b/CHANGELOG_UNRELEASED.md index 8b32d2d7b..2d1ba5e50 100644 --- a/CHANGELOG_UNRELEASED.md +++ b/CHANGELOG_UNRELEASED.md @@ -4,115 +4,22 @@ ### Added -- in `classical_sets.v`: - + canonical `unit_pointedType` -- in `measure.v`: - + definition `finite_measure` - + mixin `isProbability`, structure `Probability`, type `probability` - + lemma `probability_le1` - + definition `discrete_measurable_unit` - + structures `sigma_finite_additive_measure` and `sigma_finite_measure` - -- in file `topology.v`, - + new definition `perfect_set`. - + new lemmas `perfectTP`, `perfect_prod`, and `perfect_diagonal`. - -- in `constructive_ereal.v`: - + lemma `oppe_inj` - -- in `mathcomp_extra.v`: - + lemma `add_onemK` - + function `swap` -- in `classical_sets.v`: - + lemmas `setT0`, `set_unit`, `set_bool` - + lemmas `xsection_preimage_snd`, `ysection_preimage_fst` -- in `exp.v`: - + lemma `expR_ge0` -- in `measure.v` - + lemmas `measurable_curry`, `measurable_fun_fst`, `measurable_fun_snd`, - `measurable_fun_swap`, `measurable_fun_pair`, `measurable_fun_if_pair` - + lemmas `dirac0`, `diracT` - + lemma `finite_measure_sigma_finite` -- in `lebesgue_measure.v`: - + lemma `measurable_fun_opp` -- in `lebesgue_integral.v` - + lemmas `integral0_eq`, `fubini_tonelli` - + product measures now take `{measure _ -> _}` arguments and their - theory quantifies over a `{sigma_finite_measure _ -> _}`. - -- in `classical_sets.v`: - + lemma `trivIset_mkcond` -- in `numfun.v`: - + lemmas `xsection_indic`, `ysection_indic` -- in `classical_sets.v`: - + lemmas `xsectionI`, `ysectionI` -- in `lebesgue_integral.v`: - + notations `\x`, `\x^` for `product_measure1` and `product_measure2` - -- in `constructive_ereal.v`: - + lemmas `expeS`, `fin_numX` - -- in `functions.v`: - + lemma `countable_bijP` - + lemma `patchE` +- in `cantor.v`: + + definitions `pointed_principal_filter`, + `pointed_discrete_topology` + + lemma `discrete_pointed` + + lemma `discrete_bool_compact` ### Changed -- in `fsbigop.v`: - + implicits of `eq_fsbigr` -- move from `lebesgue_integral.v` to `classical_sets.v` - + lemmas `trivIset_preimage1`, `trivIset_preimage1_in` -- move from `lebesgue_integral.v` to `numfun.v` - + lemmas `fimfunE`, `fimfunEord`, factory `FiniteDecomp` - + lemmas `fimfun_mulr_closed` - + canonicals `fimfun_mul`, `fimfun_ring`, `fimfun_ringType` - + defintion `fimfun_ringMixin` - + lemmas `fimfunM`, `fimfun1`, `fimfun_prod`, `fimfunX`, - `indic_fimfun_subproof`. - + definitions `indic_fimfun`, `scale_fimfun`, `fimfun_comRingMixin` - + canonical `fimfun_comRingType` - + lemma `max_fimfun_subproof` - + mixin `IsNonNegFun`, structure `NonNegFun`, notation `{nnfun _ >-> _}` - ### Renamed -- in `measurable.v`: - + `measurable_fun_comp` -> `measurable_funT_comp` -- in `numfun.v`: - + `IsNonNegFun` -> `isNonNegFun` -- in `lebesgue_integral.v`: - + `IsMeasurableFunP` -> `isMeasurableFun` -- in `measure.v`: - + `{additive_measure _ -> _}` -> `{content _ -> _}` - + `isAdditiveMeasure` -> `isContent` - + `AdditiveMeasure` -> `Content` - + `additive_measure` -> `content` - + `additive_measure_snum_subproof` -> `content_snum_subproof` - + `additive_measure_snum` -> `content_snum` - + `SigmaFiniteAdditiveMeasure` -> `SigmaFiniteContent` - + `sigma_finite_additive_measure` -> `sigma_finite_content` - + `{sigma_finite_additive_measure _ -> _}` -> `{sigma_finite_content _ -> _}` - ### Generalized -- in `esum.v`: - + lemma `esum_esum` -- in `measure.v` - + lemma `measurable_fun_comp` -- in `lebesgue_integral.v`: - + lemma `measurable_sfunP` -- in `measure.v`: - + lemma `measure_bigcup` generalized, -- in `classical_sets.v`: - + `xsection_preimage_snd`, `ysection_preimage_fst` - ### Deprecated ### Removed -- in `esum.v`: - + lemma `fsbig_esum` - ### Infrastructure ### Misc diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 97a6fb0a5..4b6aae5e2 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -1,4 +1,4 @@ -# Contribution Guide for the mathcomp-analysis library (WIP) +# Contribution Guide for the mathcomp-analysis library (WIP) The purpose of this file is to document coding styles to be used when contributing to mathcomp-analysis. It comes as an addition @@ -44,6 +44,24 @@ Landau notations can be written in four shapes: The outcome is an expression with the normal Leibniz equality `=` and term `'o_F` which is not parsable. See [this paper](https://doi.org/10.6092/issn.1972-5787/8124) for more explanation and the header of the file [landau.v](https://github.com/math-comp/analysis/blob/master/theories/landau.v). +## Deprecation + +Deprecations are introduced for breaking changes. For a simple renaming, the pattern is: +``` +#[deprecated(since="analysis X.Y.Z", note="Use new_definition instead.")] +Notation old_definition := new_definition (only parsing). +``` +Note that this needs to be at the top-level (i.e., not inside a section). + +When a lemma `lem` is scheduled for deletion, it ought better be renamed `__deprecated__lem` +(so that it can be blacklisted). The deprecation command then becomes: +``` +#[deprecated(since="analysis X.Y.Z", note="Use another_lemma instead.")] +Notation lem := __deprecated__lem (only parsing). +``` +The `(only parsing)` format is needed so that Coq does not print back the deprecated name +(for example when displaying error messages, that would be confusing). + ## Naming convention ### homo and mono notations @@ -65,22 +83,3 @@ short name, and the `{mono ...}` lemma gets the suffix `in`. - The construction `_ !=set0` corresponds to suffix `nonempty` - The construction `_ != set0` corresponds to suffix `neq0` - -## Idioms - -### How to introduce a positive real number? - -When introducing a positive real number, it is best to turn it into a -`posnum` whose type is equipped with better automation. There is an -idiomatic way to perform such an introduction. Given a goal of the -form -``` -========================== -forall e : R, 0 < e -> G -``` -the tactic `move=> _/posnumP[e]` performs the following introduction -``` -e : {posnum R} -========================== -G -``` diff --git a/INSTALL.md b/INSTALL.md index 94240d7fc..088565513 100644 --- a/INSTALL.md +++ b/INSTALL.md @@ -2,10 +2,11 @@ ## Requirements -- [The Coq Proof Assistant version ≥ 8.13](https://coq.inria.fr) -- [Mathematical Components version ≥ 1.13.0](https://github.com/math-comp/math-comp) +- [The Coq Proof Assistant version ≥ 8.15](https://coq.inria.fr) +- [Mathematical Components version ≥ 1.17.0](https://github.com/math-comp/math-comp) - [Finmap library version ≥ 1.5.1](https://github.com/math-comp/finmap) - [Hierarchy builder version >= 1.2.0](https://github.com/math-comp/hierarchy-builder) +- [bigenough >= 1.0.0](https://github.com/math-comp/bigenough) These requirements can be installed in a custom way, or through [opam](https://opam.ocaml.org/) (the recommended way) using @@ -47,7 +48,7 @@ $ opam install coq-mathcomp-analysis ``` To install a precise version, type, say ``` -$ opam install coq-mathcomp-analysis.0.6.0 +$ opam install coq-mathcomp-analysis.0.7.0 ``` 4. Everytime you want to work in this same context, you need to type ``` @@ -70,20 +71,20 @@ using [proof general for emacs](https://github.com/ProofGeneral/PG) ## Break-down of phase 3 of the installation procedure step by step -With the example of Coq 8.14.0 and MathComp 1.13.0. For other versions, update the +With the example of Coq 8.15.0 and MathComp 1.17.0. For other versions, update the version numbers accordingly. -1. Install Coq 8.14.0 +1. Install Coq 8.15.0 ``` -$ opam install coq.8.14.0 +$ opam install coq.8.15.0 ``` 2. Install the Mathematical Components ``` -$ opam install coq-mathcomp-ssreflect.1.13.0 -$ opam install coq-mathcomp-fingroup.1.13.0 -$ opam install coq-mathcomp-algebra.1.13.0 -$ opam install coq-mathcomp-solvable.1.13.0 -$ opam install coq-mathcomp-field.1.13.0 +$ opam install coq-mathcomp-ssreflect.1.17.0 +$ opam install coq-mathcomp-fingroup.1.17.0 +$ opam install coq-mathcomp-algebra.1.17.0 +$ opam install coq-mathcomp-solvable.1.17.0 +$ opam install coq-mathcomp-field.1.17.0 ``` 3. Install the Finite maps library ``` diff --git a/Makefile.common b/Makefile.common index b9161da0a..b91ceb5aa 100644 --- a/Makefile.common +++ b/Makefile.common @@ -117,9 +117,11 @@ doc: __always__ Makefile.coq # cd _build_doc && grep -v vio: .Makefile.coq.d > depend # cd _build_doc && cat depend | $(MATHCOMP)etc/buildlibgraph $(COQFILES) > htmldoc/depend.js cd _build_doc && $(COQBIN)coqdoc -t "MathComp Analysis" \ - -g --utf8 -R theories mathcomp.analysis \ + -g --utf8 -R classical mathcomp.classical -R theories mathcomp.analysis \ --parse-comments \ --multi-index $(COQFILES) -d htmldoc + . $(MATHCOMP)etc/utils/builddoc_lib.sh; \ + cd _build_doc && postprocess_html cp $(MATHCOMP)etc/artwork/coqdoc.css _build_doc/htmldoc doc-clean: diff --git a/NIX.md b/NIX.md deleted file mode 100644 index a70160224..000000000 --- a/NIX.md +++ /dev/null @@ -1,95 +0,0 @@ -# Developing math-comp/analysis with nix. - -1. Install nix: - - To install it on a single-user unix system where you have admin - rights, just type: - > sh <(curl -L https://nixos.org/nix/install) --no-daemon - - The `--no-daemon` option is for a single-user installation. - (See the [nix install manual](https://nixos.org/download.html#nix-install-linux) for alternatives.) - - You should run this under your usual user account, not as - root. The script will invoke `sudo` as needed. - - See [Troubleshooting](#error-when-installing-nix) in case of error. - - For other configurations (in particular if multiple users share - the machine) or for nix uninstallation, go to the - [appropriate section of the nix manual](https://nixos.org/nix/manual/#ch-installing-binary). - - - You need to set several environment variables before you proceed to step 2. - The simplest way to do so is to **log out from your session and log in again**. - - See [Troubleshooting](#source-without-logging-out) if you prefer - not to terminate your session. - - - Step 1. only need to be done once on a same machine. - -2. Open a new terminal. Navigate to the root of the mathcomp-analysis repository. Then type: - > nix-shell - - - This will download and build the required packages, wait until - you get a shell. - - You need to type this command every time you open a new terminal. - - You can call `nixEnv` after you start the nix shell to see your - work environemnet (or call `nix-shell` with option `--arg - print-env true`). - -3. You are now in the correct work environment. You can do - > make - - and do whatever you are accustomed to do with Coq. - - See [Troubleshooting](#error-when-executing-make) in case of error. - -4. In particular, you can edit files using `emacs` or `coqide`. - - - If you were already using emacs with proof general, make sure you - empty your `coq-prog-name` variables and any other proof general - options that used to be tied to a previous local installation of - Coq. - - Proof general will rely on the file `_CoqProject`, so you want to - make sure that your `.emacs` configuration has not overwritten - the `coq-project-filename` either. - - - If you do not have emacs installed, but want to use it, you can - go back to step 2. and call `nix-shell` with the following option - > nix-shell --arg withEmacs true - - in order to get a temporary installation of emacs and - proof-general. Make sure you add `(require 'proof-site)` to your - `$HOME/.emacs`. - -# Troubleshooting - -## Error when installing nix - -You may experience errors when installing nix. If the installation -stops with an error message similar to the following one - -> ... -> installing 'nix-2.2.2' -> error: cloning builder process: Operation not permitted -> error: unable to start build process -> ... - -it may be fixed by the following command (tested with Debian 9.9): - -> sudo sysctl kernel.unprivileged_userns_clone=1 - -## Error when executing make - -If the environment variable COQBIN is set, it is likely to point -to the wrong binaries. If set, do: - -> export COQBIN=$(which coqtop | xargs dirname)/ - -## Source without Logging out - -Nix needs the user to set several environment variables and -the nix installer appends a command for this purpose to the user's `.profile`. -The Nix environment variables can actually be set from within any -shell by sourcing the appropriate file: - -> . ${HOME}/.nix-profile/etc/profile.d/nix.sh diff --git a/README.md b/README.md index 18ce84bba..a0e4e9569 100644 --- a/README.md +++ b/README.md @@ -33,22 +33,22 @@ the Coq proof-assistant and using the Mathematical Components library. - Pierre-Yves Strub (initial) - Laurent Théry - License: [CeCILL-C](LICENSE) -- Compatible Coq versions: Coq 8.14 to 8.16 (or dev) +- Compatible Coq versions: Coq 8.14 to 8.18 (or dev) - Additional dependencies: - - [MathComp ssreflect 1.13 or later](https://math-comp.github.io) - - [MathComp fingroup 1.13 or later](https://math-comp.github.io) - - [MathComp algebra 1.13 or later](https://math-comp.github.io) - - [MathComp solvable 1.13 or later](https://math-comp.github.io) - - [MathComp field 1.13 or later](https://math-comp.github.io) + - [MathComp ssreflect 1.17 or later](https://math-comp.github.io) + - [MathComp fingroup 1.17 or later](https://math-comp.github.io) + - [MathComp algebra 1.17 or later](https://math-comp.github.io) + - [MathComp solvable 1.17 or later](https://math-comp.github.io) + - [MathComp field 1.17 or later](https://math-comp.github.io) - [MathComp finmap 1.5.1](https://github.com/math-comp/finmap) - [MathComp bigenough 1.0.0](https://github.com/math-comp/bigenough) - [Hierarchy Builder >= 1.2.0](https://github.com/math-comp/hierarchy-builder) - Coq namespace: `mathcomp.analysis` - Related publication(s): - - [Formalization Techniques for Asymptotic Reasoning in Classical Analysis](https://jfr.unibo.it/article/view/8124) doi:[10.6092/issn.1972-5787/8124](https://doi.org/10.6092/issn.1972-5787/8124) - - [Competing inheritance paths in dependent type theory---a case study in functional analysis](https://hal.inria.fr/hal-02463336) doi:[10.1007/978-3-030-51054-1_1](https://doi.org/10.1007/978-3-030-51054-1_1) - - [Formalisation Tools for Classical Analysis](http://www-sop.inria.fr/members/Damien.Rouhling/data/phd/thesis.pdf) - - [Measure Construction by Extension in Dependent Type Theory with Application to Integration](https://arxiv.org/pdf/2209.02345.pdf) + - [Formalization Techniques for Asymptotic Reasoning in Classical Analysis](https://jfr.unibo.it/article/view/8124) (2018) doi:[10.6092/issn.1972-5787/8124](https://doi.org/10.6092/issn.1972-5787/8124) + - [Formalisation Tools for Classical Analysis](http://www-sop.inria.fr/members/Damien.Rouhling/data/phd/thesis.pdf) (2019) + - [Competing inheritance paths in dependent type theory---a case study in functional analysis](https://hal.inria.fr/hal-02463336) (2020) doi:[10.1007/978-3-030-51054-1_1](https://doi.org/10.1007/978-3-030-51054-1_1) + - [Measure Construction by Extension in Dependent Type Theory with Application to Integration](https://arxiv.org/pdf/2209.02345.pdf) (2023) doi:[10.1007/s10817-023-09671-5](https://doi.org/10.1007/s10817-023-09671-5) ## Building and installation instructions @@ -79,7 +79,8 @@ own risk. ## Documentation -Each file is documented in its header. +Each file is documented in its header +([coqdoc presentation for the last version](https://math-comp.github.io/analysis/htmldoc_0_6_7/index.html)). Changes are documented in [CHANGELOG.md](CHANGELOG.md) and [CHANGELOG_UNRELEASED.md](CHANGELOG_UNRELEASED.md). @@ -88,7 +89,11 @@ Overview presentation: [Classical Analysis with Coq](https://perso.crans.org/coh See also "Related publication(s)" [above](https://github.com/math-comp/analysis#meta). -Other work using MathComp-Analysis: [A Formal Classical Proof of Hahn-Banach in Coq](https://lipn.univ-paris13.fr/~kerjean/slides/slidesTYPES19.pdf) (2019) +Other work using MathComp-Analysis: +- [A Formal Classical Proof of Hahn-Banach in Coq](https://lipn.univ-paris13.fr/~kerjean/slides/slidesTYPES19.pdf) (2019) +- [Semantics of Probabilistic Programs using s-Finite Kernels in Coq](https://hal.inria.fr/hal-03917948/document) (2023) +- [CoqQ: Foundational Verification of Quantum Programs](https://arxiv.org/pdf/2207.11350.pdf) (2023) +- [Experimenting with an intrinsically-typed probabilistic programming language in Coq](https://staff.aist.go.jp/reynald.affeldt/documents/syntax-aplas2023.pdf) (2023) ## Mathematical structures @@ -105,7 +110,7 @@ when one imports `numFieldNormedType.Exports`. [Detailed requirements and installation procedure](INSTALL.md) -[Developping with nix](NIX.md) +[Developping with nix](https://github.com/math-comp/math-comp/wiki/Using-nix) [Contributing](CONTRIBUTING.md) diff --git a/_CoqProject b/_CoqProject index 1a9dd0cdc..45e3d6e8b 100644 --- a/_CoqProject +++ b/_CoqProject @@ -8,7 +8,9 @@ -arg -w -arg -redundant-canonical-projection -arg -w -arg -projection-no-head-constant +classical/all_classical.v classical/boolp.v +classical/contra.v classical/classical_sets.v classical/mathcomp_extra.v classical/functions.v @@ -21,6 +23,7 @@ theories/reals.v theories/landau.v theories/Rstruct.v theories/topology.v +theories/cantor.v theories/prodnormedzmodule.v theories/normedtype.v theories/realfun.v @@ -31,13 +34,20 @@ theories/nsatz_realtype.v theories/esum.v theories/real_interval.v theories/lebesgue_measure.v +theories/lebesgue_stieltjes_measure.v theories/forms.v theories/derive.v theories/measure.v theories/numfun.v theories/lebesgue_integral.v +theories/hoelder.v +theories/probability.v theories/summability.v theories/signed.v +theories/itv.v +theories/convex.v +theories/charge.v +theories/kernel.v theories/altreals/xfinmap.v theories/altreals/discrete.v theories/altreals/realseq.v diff --git a/classical/Make b/classical/Make index 7cfc4142d..4d4fe74c8 100644 --- a/classical/Make +++ b/classical/Make @@ -8,9 +8,11 @@ -arg -w -arg -projection-no-head-constant boolp.v +contra.v classical_sets.v mathcomp_extra.v functions.v cardinality.v fsbigop.v set_interval.v +all_classical.v diff --git a/classical/all_classical.v b/classical/all_classical.v index 864c38126..9581e05ef 100644 --- a/classical/all_classical.v +++ b/classical/all_classical.v @@ -1,7 +1,8 @@ -Require Export boolp. -Require Export classical_sets. -Require Export mathcomp_extra. -Require Export functions. -Require Export cardinality. -Require Export fsbigop. -Require Export set_interval. +From mathcomp Require Export boolp. +From mathcomp Require Export contra. +From mathcomp Require Export classical_sets. +From mathcomp Require Export mathcomp_extra. +From mathcomp Require Export functions. +From mathcomp Require Export cardinality. +From mathcomp Require Export fsbigop. +From mathcomp Require Export set_interval. diff --git a/classical/boolp.v b/classical/boolp.v index 7ff24a1c8..0f5864740 100644 --- a/classical/boolp.v +++ b/classical/boolp.v @@ -4,21 +4,21 @@ (* Copyright (c) - 2015--2018 - Inria *) (* Copyright (c) - 2016--2018 - Polytechnique *) (* -------------------------------------------------------------------- *) - +From HB Require Import structures. From mathcomp Require Import all_ssreflect. -(******************************************************************************) -(* Classical Logic *) +(**md**************************************************************************) +(* # Classical Logic *) (* *) (* This file provides the axioms of classical logic and tools to perform *) (* classical reasoning in the Mathematical Compnent framework. The three *) (* axioms are taken from the standard library of Coq, more details can be *) (* found in Section 5 of *) -(* Reynald Affeldt, Cyril Cohen, Damien Rouhling: *) -(* Formalization Techniques for Asymptotic Reasoning in Classical Analysis. *) -(* Journal of Formalized Reasoning, 2018 *) +(* - R. Affeldt, C. Cohen, D. Rouhling. Formalization Techniques for *) +(* Asymptotic Reasoning in Classical Analysis. JFR 2018 *) (* *) -(* * Axioms *) +(* ## Axioms *) +(* ``` *) (* functional_extensionality_dep == functional extensionality (on dependently *) (* typed functions), i.e., functions that are pointwise *) (* equal are equal *) @@ -27,14 +27,19 @@ From mathcomp Require Import all_ssreflect. (* constructive_indefinite_description == existential in Prop (ex) implies *) (* existential in Type (sig) *) (* cid := constructive_indefinite_description (shortcut) *) -(* --> A number of properties are derived below from these axioms and are *) +(* ``` *) +(* *) +(* A number of properties are derived below from these axioms and are *) (* often more pratical to use than directly using the axioms. For instance *) (* propext, funext, the excluded middle (EM),... *) (* *) -(* * Boolean View of Prop *) +(* ## Boolean View of Prop *) +(* ``` *) (* `[< P >] == boolean view of P : Prop, see all lemmas about asbool *) +(* ``` *) (* *) -(* * Mathematical Components Structures *) +(* ## Mathematical Components Structures *) +(* ``` *) (* {classic T} == Endow T : Type with a canonical eqType/choiceType. *) (* This is intended for local use. *) (* E.g., T : Type |- A : {fset {classic T}} *) @@ -43,8 +48,9 @@ From mathcomp Require Import all_ssreflect. (* {eclassic T} == Endow T : eqType with a canonical choiceType. *) (* On the model of {classic _}. *) (* See also the lemmas Peq and eqPchoice. *) +(* ``` *) (* *) -(* --> Functions into a porderType (resp. latticeType) are equipped with *) +(* Functions into a porderType (resp. latticeType) are equipped with *) (* a porderType (resp. latticeType), (f <= g)%O when f x <= g x for all x, *) (* see lemma lefP. *) (******************************************************************************) @@ -56,8 +62,6 @@ Unset Printing Implicit Defensive. Declare Scope box_scope. Declare Scope quant_scope. -(* -------------------------------------------------------------------- *) - Axiom functional_extensionality_dep : forall (A : Type) (B : A -> Type) (f g : forall x : A, B x), (forall x : A, f x = g x) -> f = g. @@ -76,14 +80,13 @@ move=> PQA; suff: {x | P x /\ Q x} by move=> [a [*]]; exists a. by apply: cid; case: PQA => x; exists x. Qed. -(* -------------------------------------------------------------------- *) -Record mextentionality := { +Record mextensionality := { _ : forall (P Q : Prop), (P <-> Q) -> (P = Q); _ : forall {T U : Type} (f g : T -> U), (forall x, f x = g x) -> f = g; }. -Fact extentionality : mextentionality. +Fact extensionality : mextensionality. Proof. split. - exact: propositional_extensionality. @@ -91,10 +94,12 @@ split. Qed. Lemma propext (P Q : Prop) : (P <-> Q) -> (P = Q). -Proof. by have [propext _] := extentionality; apply: propext. Qed. +Proof. by have [propext _] := extensionality; apply: propext. Qed. + +Ltac eqProp := apply: propext; split. Lemma funext {T U : Type} (f g : T -> U) : (f =1 g) -> f = g. -Proof. by case: extentionality=> _; apply. Qed. +Proof. by case: extensionality=> _; apply. Qed. Lemma propeqE (P Q : Prop) : (P = Q) = (P <-> Q). Proof. by apply: propext; split=> [->|/propext]. Qed. @@ -161,10 +166,9 @@ Lemma Prop_irrelevance (P : Prop) (x y : P) : x = y. Proof. by move: x (x) y => /propT-> [] []. Qed. #[global] Hint Resolve Prop_irrelevance : core. -(* -------------------------------------------------------------------- *) Record mclassic := { _ : forall (P : Prop), {P} + {~P}; - _ : forall T, Choice.mixin_of T + _ : forall T, hasChoice T }. Lemma choice X Y (P : X -> Y -> Prop) : @@ -211,16 +215,12 @@ exists (fun (P : pred T) (n : nat) => by exists 0; case: pselect => // -[]; exists x. Qed. -Lemma gen_choiceMixin {T : Type} : Choice.mixin_of T. +Lemma gen_choiceMixin (T : Type) : hasChoice T. Proof. by case: classic. Qed. -Lemma pdegen (P : Prop): P = True \/ P = False. -Proof. by have [p|Np] := pselect P; [left|right]; rewrite propeqE. Qed. - Lemma lem (P : Prop): P \/ ~P. Proof. by case: (pselect P); tauto. Qed. -(* -------------------------------------------------------------------- *) Lemma trueE : true = True :> Prop. Proof. by rewrite propeqE; split. Qed. @@ -286,8 +286,7 @@ Proof. by rewrite propeqE; split => -[x [y]]; exists y, x. Qed. Lemma reflect_eq (P : Prop) (b : bool) : reflect P b -> P = b. Proof. by rewrite propeqE; exact: rwP. Qed. -Definition asbool (P : Prop) := - if pselect P then true else false. +Definition asbool (P : Prop) := if pselect P then true else false. Notation "`[< P >]" := (asbool P) : bool_scope. @@ -322,28 +321,23 @@ Proof. by move=> [] []; rewrite ?(trueE, falseE) ?propeqE; tauto. Qed. Definition gen_eq (T : Type) (u v : T) := `[]. Lemma gen_eqP (T : Type) : Equality.axiom (@gen_eq T). Proof. by move=> x y; apply: (iffP (asboolP _)). Qed. -Definition gen_eqMixin {T : Type} := EqMixin (@gen_eqP T). +Definition gen_eqMixin (T : Type) : hasDecEq T := + hasDecEq.Build T (@gen_eqP T). -Canonical arrow_eqType (T : Type) (T' : eqType) := - EqType (T -> T') gen_eqMixin. -Canonical arrow_choiceType (T : Type) (T' : choiceType) := - ChoiceType (T -> T') gen_choiceMixin. +HB.instance Definition _ (T : Type) (T' : T -> eqType) := + gen_eqMixin (forall t : T, T' t). -Definition dep_arrow_eqType (T : Type) (T' : T -> eqType) := - EqType (forall x : T, T' x) gen_eqMixin. -Definition dep_arrow_choiceClass (T : Type) (T' : T -> choiceType) := - Choice.Class (Equality.class (dep_arrow_eqType T')) gen_choiceMixin. -Definition dep_arrow_choiceType (T : Type) (T' : T -> choiceType) := - Choice.Pack (dep_arrow_choiceClass T'). +HB.instance Definition _ (T : Type) (T' : T -> choiceType) := + gen_choiceMixin (forall t : T, T' t). -Canonical Prop_eqType := EqType Prop gen_eqMixin. -Canonical Prop_choiceType := ChoiceType Prop gen_choiceMixin. +HB.instance Definition _ := gen_eqMixin Prop. +HB.instance Definition _ := gen_choiceMixin Prop. Section classicType. Variable T : Type. Definition classicType := T. -Canonical classicType_eqType := EqType classicType gen_eqMixin. -Canonical classicType_choiceType := ChoiceType classicType gen_choiceMixin. +HB.instance Definition _ := gen_eqMixin classicType. +HB.instance Definition _ := gen_choiceMixin classicType. End classicType. Notation "'{classic' T }" := (classicType T) (format "'{classic' T }") : type_scope. @@ -351,8 +345,8 @@ Notation "'{classic' T }" := (classicType T) Section eclassicType. Variable T : eqType. Definition eclassicType : Type := T. -Canonical eclassicType_eqType := EqType eclassicType (Equality.class T). -Canonical eclassicType_choiceType := ChoiceType eclassicType gen_choiceMixin. +HB.instance Definition _ := Equality.copy eclassicType T. +HB.instance Definition _ := gen_choiceMixin eclassicType. End eclassicType. Notation "'{eclassic' T }" := (eclassicType T) (format "'{eclassic' T }") : type_scope. @@ -362,21 +356,21 @@ Definition canonical_of T U (sort : U -> T) := forall (G : T -> Type), Notation canonical_ sort := (@canonical_of _ _ sort). Notation canonical T E := (@canonical_of T E id). -Lemma canon T U (sort : U -> T) : (forall x, exists y, sort y = x) -> canonical_ sort. +Lemma canon T U (sort : U -> T) : + (forall x, exists y, sort y = x) -> canonical_ sort. Proof. by move=> + G Gs x => /(_ x)/cid[x' <-]. Qed. Arguments canon {T U sort} x. Lemma Peq : canonical Type eqType. -Proof. by apply: canon => T; exists [eqType of {classic T}]. Qed. +Proof. by apply: canon => T; exists {classic T}. Qed. Lemma Pchoice : canonical Type choiceType. -Proof. by apply: canon => T; exists [choiceType of {classic T}]. Qed. +Proof. by apply: canon => T; exists {classic T}. Qed. Lemma eqPchoice : canonical eqType choiceType. -Proof. by apply: canon=> T; exists [choiceType of {eclassic T}]; case: T. Qed. +Proof. by apply: canon => T; exists {eclassic T}; case: T => //= T [?]//. Qed. Lemma not_True : (~ True) = False. Proof. exact/propext. Qed. Lemma not_False : (~ False) = True. Proof. by apply/propext; split=> _. Qed. -(* -------------------------------------------------------------------- *) Lemma asbool_equiv_eq {P Q : Prop} : (P <-> Q) -> `[

] = `[]. Proof. by rewrite -propeqE => ->. Qed. @@ -389,7 +383,6 @@ Proof. by move/asbool_equiv_eq->. Qed. Lemma asbool_eq_equiv {P Q : Prop} : `[

] = `[] -> (P <-> Q). Proof. by move=> eq; split=> /asboolP; rewrite (eq, =^~ eq) => /asboolP. Qed. -(* -------------------------------------------------------------------- *) Lemma and_asboolP (P Q : Prop) : reflect (P /\ Q) (`[< P >] && `[< Q >]). Proof. apply: (iffP idP); first by case/andP => /asboolP p /asboolP q. @@ -425,7 +418,6 @@ Proof. exact: (asbool_equiv_eqP (or_asboolP _ _)). Qed. Lemma asbool_and {P Q : Prop} : `[

] = `[

] && `[]. Proof. exact: (asbool_equiv_eqP (and_asboolP _ _)). Qed. -(* -------------------------------------------------------------------- *) Lemma imply_asboolP {P Q : Prop} : reflect (P -> Q) (`[

] ==> `[]). Proof. apply: (iffP implyP)=> [PQb /asboolP/PQb/asboolW //|]. @@ -442,7 +434,6 @@ by rewrite asbool_imply negb_imply -asbool_neg => /and_asboolP. by move/and_asboolP; rewrite asbool_neg -negb_imply asbool_imply. Qed. -(* -------------------------------------------------------------------- *) Lemma forall_asboolP {T : Type} (P : T -> Prop) : reflect (forall x, `[

]) (`[]). Proof. @@ -459,36 +450,53 @@ Qed. (* -------------------------------------------------------------------- *) -Lemma notT (P : Prop) : P = False -> ~ P. Proof. by move->. Qed. +Variant BoolProp : Prop -> Type := + | TrueProp : BoolProp True + | FalseProp : BoolProp False. + +Lemma PropB P : BoolProp P. +Proof. by case: (asboolP P) => [/propT-> | /propF->]; [left | right]. Qed. + +Lemma notB : ((~ True) = False) * ((~ False) = True). +Proof. by rewrite /not; split; eqProp. Qed. + +Lemma andB : left_id True and * right_id True and + * (left_zero False and * right_zero False and * idempotent and). +Proof. by do ![split] => /PropB[]; eqProp=> // -[]. Qed. + +Lemma orB : left_id False or * right_id False or + * (left_zero True or * right_zero True or * idempotent or). +Proof. do ![split] => /PropB[]; eqProp=> -[] //; by [left | right]. Qed. + +Lemma implyB : let imply (P Q : Prop) := P -> Q in + (imply False =1 fun=> True) * (imply^~ False =1 not) + * (left_id True imply * right_zero True imply * self_inverse True imply). +Proof. by do ![split] => /PropB[]; eqProp=> //; apply. Qed. + +Lemma decide_or P Q : P \/ Q -> {P} + {Q}. +Proof. by case/PropB: P; [left | rewrite orB; right]. Qed. + +(* -------------------------------------------------------------------- *) + +Lemma notT (P : Prop) : P = False -> ~ P. +Proof. by move->. Qed. Lemma contrapT P : ~ ~ P -> P. -Proof. -by move/asboolPn=> nnb; apply/asboolP; apply: contraR nnb => /asboolPn /asboolP. -Qed. +Proof. by case: (PropB P) => //; rewrite not_False. Qed. -Lemma notTE (P : Prop) : (~ P) -> P = False. -Proof. by case: (pdegen P)=> ->. Qed. +Lemma notTE (P : Prop) : (~ P) -> P = False. Proof. by case: (PropB P). Qed. Lemma notFE (P : Prop) : (~ P) = False -> P. -Proof. move/notT; exact: contrapT. Qed. +Proof. by move/notT; exact: contrapT. Qed. Lemma notK : involutive not. -Proof. -move=> P; case: (pdegen P)=> ->; last by apply: notTE; intuition. -by rewrite [~ True]notTE //; case: (pdegen (~ False)) => // /notFE. -Qed. +Proof. by case/PropB; rewrite !(not_False,not_True). Qed. Lemma contra_notP (Q P : Prop) : (~ Q -> P) -> ~ P -> Q. -Proof. -move=> cb /asboolPn nb; apply/asboolP. -by apply: contraR nb => /asboolP /cb /asboolP. -Qed. +Proof. by move: Q P => /PropB[] /PropB[]. Qed. Lemma contraPP (Q P : Prop) : (~ Q -> ~ P) -> P -> Q. -Proof. -move=> cb /asboolP hb; apply/asboolP. -by apply: contraLR hb => /asboolP /cb /asboolPn. -Qed. +Proof. by move: Q P => /PropB[] /PropB[]//; rewrite not_False not_True. Qed. Lemma contra_notT b (P : Prop) : (~~ b -> P) -> ~ P -> b. Proof. by move=> bP; apply: contra_notP => /negP. Qed. @@ -505,13 +513,28 @@ Proof. by move=> /contra_notP + /negP => /[apply]. Qed. Lemma contra_neqP (T : eqType) (x y : T) P : (~ P -> x = y) -> x != y -> P. Proof. by move=> Pxy; apply: contraNP => /Pxy/eqP. Qed. -Lemma contra_eqP (T : eqType) (x y : T) (Q : Prop) : (~ Q -> x != y) -> x = y -> Q. +Lemma contra_eqP (T : eqType) (x y : T) Q : (~ Q -> x != y) -> x = y -> Q. Proof. by move=> Qxy /eqP; apply: contraTP. Qed. +Lemma contra_leP {disp1 : unit} {T1 : porderType disp1} [P : Prop] [x y : T1] : + (~ P -> (x < y)%O) -> (y <= x)%O -> P. +Proof. +move=> Pxy yx; apply/asboolP. +by apply: Order.POrderTheory.contra_leT yx => /asboolPn. +Qed. + +Lemma contra_ltP {disp1 : unit} {T1 : porderType disp1} [P : Prop] [x y : T1] : + (~ P -> (x <= y)%O) -> (y < x)%O -> P. +Proof. +move=> Pxy yx; apply/asboolP. +by apply: Order.POrderTheory.contra_ltT yx => /asboolPn. +Qed. + Lemma wlog_neg P : (~ P -> P) -> P. -Proof. by move=> ?; case: (pselect P). Qed. +Proof. by case: (PropB P); exact. Qed. Lemma not_inj : injective not. Proof. exact: can_inj notK. Qed. + Lemma notLR P Q : (P = ~ Q) -> (~ P) = Q. Proof. exact: canLR notK. Qed. Lemma notRL P Q : (~ P) = Q -> P = ~ Q. Proof. exact: canRL notK. Qed. @@ -522,7 +545,6 @@ Proof. by split=> [/propext ->|/propext <-]; rewrite notK. Qed. Lemma iff_not2 (P Q : Prop) : (~ P <-> ~ Q) <-> (P <-> Q). Proof. by split=> [/iff_notr|PQ]; [|apply/iff_notr]; rewrite notK. Qed. -(* -------------------------------------------------------------------- *) (* assia : let's see if we need the simplpred machinery. In any case, we sould first try definitions + appropriate Arguments setting to see whether these can replace the canonical structures machinery. *) @@ -544,14 +566,12 @@ Notation xpredpD := (fun (p1 p2 : predp _) x => ~ p2 x /\ p1 x). Notation xpreimp := (fun f (p : predp _) x => p (f x)). Notation xrelpU := (fun (r1 r2 : relp _) x y => r1 x y \/ r2 x y). -(* -------------------------------------------------------------------- *) Definition pred0p (T : Type) (P : predp T) : bool := `[

]. Prenex Implicits pred0p. Lemma pred0pP (T : Type) (P : predp T) : reflect (P =1 xpredp0) (pred0p P). Proof. by apply: (iffP (asboolP _)). Qed. -(* -------------------------------------------------------------------- *) Lemma forallp_asboolPn {T} {P : T -> Prop} : reflect (forall x : T, ~ P x) (~~ `[]). Proof. @@ -587,12 +607,15 @@ split=> [/asboolP|[p nq pq]]; [|exact/nq/pq]. by rewrite asbool_neg => /imply_asboolPn. Qed. -Lemma not_andP (P Q : Prop) : ~ (P /\ Q) <-> ~ P \/ ~ Q. +Lemma not_andE (P Q : Prop) : (~ (P /\ Q)) = ~ P \/ ~ Q. Proof. -split => [/asboolPn|[|]]; try by apply: contra_not => -[]. +eqProp=> [/asboolPn|[|]]; try by apply: contra_not => -[]. by rewrite asbool_and negb_and => /orP[]/asboolPn; [left|right]. Qed. +Lemma not_andP (P Q : Prop) : ~ (P /\ Q) <-> ~ P \/ ~ Q. +Proof. by rewrite not_andE. Qed. + Lemma not_and3P (P Q R : Prop) : ~ [/\ P, Q & R] <-> [\/ ~ P, ~ Q | ~ R]. Proof. split=> [/and3_asboolP|/or3_asboolP]. @@ -600,27 +623,100 @@ by rewrite 2!negb_and -3!asbool_neg => /or3_asboolP. by rewrite 3!asbool_neg -2!negb_and => /and3_asboolP. Qed. +Lemma notP (P : Prop) : ~ ~ P <-> P. +Proof. by split => [|p]; [exact: contrapT|exact]. Qed. + +Lemma notE (P : Prop) : (~ ~ P) = P. Proof. by rewrite propeqE notP. Qed. + +Lemma not_orE (P Q : Prop) : (~ (P \/ Q)) = ~ P /\ ~ Q. +Proof. by rewrite -[_ /\ _]notE not_andE 2!notE. Qed. + Lemma not_orP (P Q : Prop) : ~ (P \/ Q) <-> ~ P /\ ~ Q. -Proof. -split; [apply: contra_notP => /not_andP|apply: contraPnot => AB; apply/not_andP]; - by rewrite 2!notK. -Qed. +Proof. by rewrite not_orE. Qed. Lemma not_implyE (P Q : Prop) : (~ (P -> Q)) = (P /\ ~ Q). Proof. by rewrite propeqE not_implyP. Qed. -Lemma orC (P Q : Prop) : (P \/ Q) = (Q \/ P). -Proof. by rewrite propeqE; split=> [[]|[]]; [right|left|right|left]. Qed. +Lemma implyE (P Q : Prop) : (P -> Q) = (~ P \/ Q). +Proof. by rewrite -[LHS]notE not_implyE propeqE not_andP notE. Qed. + +Lemma orC : commutative or. +Proof. by move=> /PropB[] /PropB[] => //; rewrite !orB. Qed. Lemma orA : associative or. Proof. by move=> P Q R; rewrite propeqE; split=> [|]; tauto. Qed. -Lemma andC (P Q : Prop) : (P /\ Q) = (Q /\ P). -Proof. by rewrite propeqE; split=> [[]|[]]. Qed. +Lemma orCA : left_commutative or. +Proof. by move=> P Q R; rewrite !orA (orC P). Qed. + +Lemma orAC : right_commutative or. +Proof. by move=> P Q R; rewrite -!orA (orC Q). Qed. + +Lemma orACA : interchange or or. +Proof. by move=> P Q R S; rewrite !orA (orAC P). Qed. + +Lemma orNp P Q : (~ P \/ Q) = (P -> Q). +Proof. by case/PropB: P; rewrite notB orB implyB. Qed. + +Lemma orpN P Q : (P \/ ~ Q) = (Q -> P). Proof. by rewrite orC orNp. Qed. + +Lemma or3E P Q R : [\/ P, Q | R] = (P \/ Q \/ R). +Proof. +rewrite -(asboolE P) -(asboolE Q) -(asboolE R) (reflect_eq or3P). +by rewrite -2!(reflect_eq orP). +Qed. + +Lemma or4E P Q R S : [\/ P, Q, R | S] = (P \/ Q \/ R \/ S). +Proof. +rewrite -(asboolE P) -(asboolE Q) -(asboolE R) -(asboolE S) (reflect_eq or4P). +by rewrite -3!(reflect_eq orP). +Qed. + +Lemma andC : commutative and. +Proof. by move=> /PropB[] /PropB[]; rewrite !andB. Qed. Lemma andA : associative and. Proof. by move=> P Q R; rewrite propeqE; split=> [|]; tauto. Qed. +Lemma andCA : left_commutative and. +Proof. by move=> P Q R; rewrite !andA (andC P). Qed. + +Lemma andAC : right_commutative and. +Proof. by move=> P Q R; rewrite -!andA (andC Q). Qed. + +Lemma andACA : interchange and and. +Proof. by move=> P Q R S; rewrite !andA (andAC P). Qed. + +Lemma and3E P Q R : [/\ P, Q & R] = (P /\ Q /\ R). +Proof. by eqProp=> [[] | [? []]]. Qed. + +Lemma and4E P Q R S : [/\ P, Q, R & S] = (P /\ Q /\ R /\ S). +Proof. by eqProp=> [[] | [? [? []]]]. Qed. + +Lemma and5E P Q R S T : [/\ P, Q, R, S & T] = (P /\ Q /\ R /\ S /\ T). +Proof. by eqProp=> [[] | [? [? [? []]]]]. Qed. + +Lemma implyNp P Q : (~ P -> Q : Prop) = (P \/ Q). +Proof. by rewrite -orNp notK. Qed. + +Lemma implypN (P Q : Prop) : (P -> ~ Q) = ~ (P /\ Q). +Proof. by case/PropB: P; rewrite implyB andB ?notB. Qed. + +Lemma implyNN P Q : (~ P -> ~ Q) = (Q -> P). +Proof. by rewrite implyNp orpN. Qed. + +Lemma or_andr : right_distributive or and. +Proof. by case/PropB=> Q R; rewrite !orB ?andB. Qed. + +Lemma or_andl : left_distributive or and. +Proof. by move=> P Q R; rewrite -!(orC R) or_andr. Qed. + +Lemma and_orr : right_distributive and or. +Proof. by move=> P Q R; apply/not_inj; rewrite !(not_andE, not_orE) or_andr. Qed. + +Lemma and_orl : left_distributive and or. +Proof. by move=> P Q R; apply/not_inj; rewrite !(not_andE, not_orE) or_andl. Qed. + Lemma forallNE {T} (P : T -> Prop) : (forall x, ~ P x) = ~ exists x, P x. Proof. by rewrite propeqE; split => [fP [x /fP]//|nexP x Px]; apply: nexP; exists x. @@ -644,9 +740,12 @@ Proof. by rewrite forallNE. Qed. Lemma not_forallP T (P : T -> Prop) : (forall x, P x) <-> ~ exists x, ~ P x. Proof. by rewrite existsNE notK. Qed. +Lemma exists2E A P Q : (exists2 x : A, P x & Q x) = (exists x, P x /\ Q x). +Proof. by eqProp=> -[x]; last case; exists x. Qed. + Lemma exists2P T (P Q : T -> Prop) : (exists2 x, P x & Q x) <-> exists x, P x /\ Q x. -Proof. by split=> [[x ? ?] | [x []]]; exists x. Qed. +Proof. by rewrite exists2E. Qed. Lemma not_exists2P T (P Q : T -> Prop) : (exists2 x, P x & Q x) <-> ~ forall x, ~ P x \/ ~ Q x. @@ -676,6 +775,14 @@ split=> [[x Px NQx] /(_ x Px)//|]; apply: contra_notP => + x Px. by apply: contra_notP => NQx; exists x. Qed. +Lemma forallp_asboolPn2 {T} {P Q : T -> Prop} : + reflect (forall x : T, ~ P x \/ ~ Q x) (~~ `[]). +Proof. +apply: (iffP idP)=> [/asboolPn NP x|NP]. + by move/forallPNP : NP => /(_ x)/and_rec/not_andP. +by apply/asboolP=> -[x Px Qx]; have /not_andP := NP x; exact. +Qed. + Module FunOrder. Section FunOrder. Import Order.TTheory. @@ -715,10 +822,9 @@ move=> g f h /asboolP fg /asboolP gh; apply/asboolP => x. by rewrite (le_trans (fg x)). Qed. -Definition porderMixin := - @LePOrderMixin _ lef ltf ltf_def lef_refl lef_anti lef_trans. - -Canonical porderType := POrderType fun_display (aT -> T) porderMixin. +#[export] +HB.instance Definition _ := @Order.isPOrder.Build + fun_display (aT -> T) lef ltf ltf_def lef_refl lef_anti lef_trans. End FunOrder. @@ -755,15 +861,13 @@ apply/idP/idP => [/asboolP f_le_g|/eqP <-]. - apply/asboolP => x; exact: leIr. Qed. -Definition latticeMixin := - LatticeMixin meetfC joinfC meetfA joinfA joinfKI meetfKU lef_meet. - -Canonical latticeType := LatticeType (aT -> T) latticeMixin. +#[export] +HB.instance Definition _ := Order.POrder_isLattice.Build _ (aT -> T) + meetfC joinfC meetfA joinfA joinfKI meetfKU lef_meet. End FunLattice. Module Exports. -Canonical porderType. -Canonical latticeType. +HB.reexport. End Exports. End FunOrder. Export FunOrder.Exports. @@ -789,3 +893,13 @@ Proof. by apply/funeqP => ?; rewrite iterSr. Qed. Lemma iter0 {T} (f : T -> T) : iter 0 f = id. Proof. by []. Qed. +Section Inhabited. +Variable (T : Type). + +Lemma inhabitedE: inhabited T = exists x : T, True. +Proof. by eqProp; case. Qed. + +Lemma inhabited_witness: inhabited T -> T. +Proof. by rewrite inhabitedE => /cid[]. Qed. + +End Inhabited. diff --git a/classical/cardinality.v b/classical/cardinality.v index 14bc8ef95..2cce9b33a 100644 --- a/classical/cardinality.v +++ b/classical/cardinality.v @@ -1,11 +1,10 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From HB Require Import structures. From mathcomp Require Import all_ssreflect finmap ssralg ssrnum ssrint rat. -From mathcomp Require Import finset. -Require Import mathcomp_extra boolp classical_sets functions. +From mathcomp Require Import mathcomp_extra boolp classical_sets functions. -(******************************************************************************) -(* Cardinality *) +(**md**************************************************************************) +(* # Cardinality *) (* *) (* This file provides an account of cardinality properties of classical sets. *) (* This includes standard results of set theory such as the Pigeon Hole *) @@ -17,6 +16,7 @@ Require Import mathcomp_extra boolp classical_sets functions. (* only relations A #<= B and A #= B to compare the cardinals of two sets *) (* (on two possibly different types). *) (* *) +(* ``` *) (* A #<= B == the cardinal of A is smaller or equal to the one of B *) (* A #>= B := B #<= A *) (* A #= B == the cardinal of A is equal to the cardinal of B *) @@ -33,6 +33,7 @@ Require Import mathcomp_extra boolp classical_sets functions. (* A.`1 := [fset x.1 | x in A] *) (* A.`2 := [fset x.2 | x in A] *) (* {fimfun aT >-> T} == type of functions with a finite image *) +(* ``` *) (* *) (******************************************************************************) @@ -457,12 +458,6 @@ Lemma eq_countable T U (A : set T) (B : set U) : A #= B -> countable A = countable B. Proof. by move=> /card_le_eql leA; rewrite /countable leA. Qed. -Lemma countable_setT_countMixin (T : Type) : - countable (@setT T) -> Countable.mixin_of T. -Proof. -by move=> /pcard_leP/unsquash f; exists f 'oinv_f; apply: in1TT 'funoK_f. -Qed. - Lemma countableP (T : countType) (A : set T) : countable A. Proof. by apply/card_leP; squash (to_setT \o choice.pickle). Qed. #[global] Hint Resolve countableP : core. @@ -650,7 +645,7 @@ Proof. exact/card_le_finite/card_le_setD. Qed. Lemma finite_setU T (A B : set T) : finite_set (A `|` B) = (finite_set A /\ finite_set B). Proof. -pose fP := @finite_fsetP [choiceType of {classic T}]; rewrite propeqE; split. +pose fP := @finite_fsetP {classic T}; rewrite propeqE; split. by move=> finAUB; split; apply: sub_finite_set finAUB. by case=> /fP[X->]/fP[Y->]; apply/fP; exists (X `|` Y)%fset; rewrite set_fsetU. Qed. @@ -910,7 +905,7 @@ Lemma __deprecated__bigcup_fset_set T (I : choiceType) (A : set I) (F : I -> set finite_set A -> \bigcup_(i in A) F i = \big[setU/set0]_(i <- fset_set A) F i. Proof. by move=> /bigsetU_fset_set->. Qed. #[deprecated(note="Use -bigsetU_fset_set instead")] -Notation bigcup_fset_set := __deprecated__bigcup_fset_set. +Notation bigcup_fset_set := __deprecated__bigcup_fset_set (only parsing). Lemma bigsetU_fset_set_cond T (I : choiceType) (A : set I) (F : I -> set T) (P : pred I) : finite_set A -> @@ -924,7 +919,7 @@ Lemma __deprecated__bigcup_fset_set_cond T (I : choiceType) (A : set I) (F : I - \bigcup_(i in A `&` P) F i = \big[setU/set0]_(i <- fset_set A | P i) F i. Proof. by move=> /bigsetU_fset_set_cond->. Qed. #[deprecated(note="Use -bigsetU_fset_set_cond instead")] -Notation bigcup_fset_set_cond := __deprecated__bigcup_fset_set_cond. +Notation bigcup_fset_set_cond := __deprecated__bigcup_fset_set_cond (only parsing). Lemma bigsetI_fset_set T (I : choiceType) (A : set I) (F : I -> set T) : finite_set A -> \big[setI/setT]_(i <- fset_set A) F i =\bigcap_(i in A) F i. @@ -936,7 +931,7 @@ Lemma __deprecated__bigcap_fset_set T (I : choiceType) (A : set I) (F : I -> set finite_set A -> \bigcap_(i in A) F i = \big[setI/setT]_(i <- fset_set A) F i. Proof. by move=> /bigsetI_fset_set->. Qed. #[deprecated(note="Use -bigsetI_fset_set instead")] -Notation bigcap_fset_set := __deprecated__bigcap_fset_set. +Notation bigcap_fset_set := __deprecated__bigcap_fset_set (only parsing). Lemma bigsetI_fset_set_cond T (I : choiceType) (A : set I) (F : I -> set T) (P : pred I) : finite_set A -> @@ -1065,7 +1060,7 @@ by under eq_imagel do rewrite /= gE ?inE//; rewrite image_eq. Qed. #[deprecated(note="use countable0 instead")] -Notation countable_set0 := countable0. +Notation countable_set0 := countable0 (only parsing). Lemma countable1 T (x : T) : countable [set x]. Proof. exact: finite_set_countable. Qed. @@ -1094,7 +1089,7 @@ Qed. Lemma card_nat2 : [set: nat * nat] #= [set: nat]. Proof. exact/eq_card_nat/infinite_prod_nat/countableP. Qed. -Canonical rat_pointedType := PointedType rat 0. +HB.instance Definition _ := isPointed.Build rat 0. Lemma infinite_rat : infinite_set [set: rat]. Proof. @@ -1109,7 +1104,9 @@ Lemma choicePcountable {T : choiceType} : countable [set: T] -> {T' : countType | T = T' :> Type}. Proof. move=> /pcard_leP/unsquash f. -by exists (CountType T (CountMixin (in1TT 'funoK_f))). +pose TcM := PCanIsCountable (in1TT 'funoK_f). +pose TC : countType := HB.pack T TcM. +by exists TC. Qed. Lemma eqPcountable {T : eqType} : countable [set: T] -> @@ -1236,13 +1233,15 @@ HB.mixin Record FiniteImage aT rT (f : aT -> rT) := { }. HB.structure Definition FImFun aT rT := {f of @FiniteImage aT rT f}. +Arguments fimfunP {aT rT} _. +#[global] Hint Resolve fimfunP : core. + Reserved Notation "{ 'fimfun' aT >-> T }" (at level 0, format "{ 'fimfun' aT >-> T }"). Reserved Notation "[ 'fimfun' 'of' f ]" (at level 0, format "[ 'fimfun' 'of' f ]"). Notation "{ 'fimfun' aT >-> T }" := (@FImFun.type aT T) : form_scope. Notation "[ 'fimfun' 'of' f ]" := [the {fimfun _ >-> _} of f] : form_scope. -#[global] Hint Resolve fimfunP : core. Lemma fimfun_inP {aT rT} (f : {fimfun aT >-> rT}) (D : set aT) : finite_set (f @` D). @@ -1279,21 +1278,18 @@ Qed. Lemma fimfun_valP f (Pf : f \in fimfun) : fimfun_Sub Pf = f :> (_ -> _). Proof. by []. Qed. -Canonical fimfun_subType := SubType T _ _ fimfun_rect fimfun_valP. +HB.instance Definition _ := isSub.Build _ _ T fimfun_rect fimfun_valP. End fimfun. Lemma fimfuneqP aT rT (f g : {fimfun aT >-> rT}) : f = g <-> f =1 g. Proof. by split=> [->//|fg]; apply/val_inj/funext. Qed. -Definition fimfuneqMixin aT (rT : eqType) := - [eqMixin of {fimfun aT >-> rT} by <:]. -Canonical fimfuneqType aT (rT : eqType) := - EqType {fimfun aT >-> rT} (fimfuneqMixin aT rT). -Definition fimfunchoiceMixin aT (rT : choiceType) := - [choiceMixin of {fimfun aT >-> rT} by <:]. -Canonical fimfunchoiceType aT (rT : choiceType) := - ChoiceType {fimfun aT >-> rT} (fimfunchoiceMixin aT rT). +HB.instance Definition _ aT (rT : eqType) := + [Equality of {fimfun aT >-> rT} by <:]. + +HB.instance Definition _ aT (rT : choiceType) := + [Choice of {fimfun aT >-> rT} by <:]. Lemma finite_image_cst {aT rT : Type} (x : rT) : finite_set (range (cst x : aT -> _)). @@ -1322,10 +1318,10 @@ Proof. split=> [|f g]; rewrite !inE/=; first exact: finite_image_cst. by move=> fA gA; apply: (finite_image11 (fun x y => x - y)). Qed. -Canonical fimfun_add := AddrPred fimfun_zmod_closed. -Canonical fimfun_zmod := ZmodPred fimfun_zmod_closed. -Definition fimfun_zmodMixin := [zmodMixin of {fimfun aT >-> rT} by <:]. -Canonical fimfun_zmodType := ZmodType {fimfun aT >-> rT} fimfun_zmodMixin. +HB.instance Definition _ := + GRing.isZmodClosed.Build (aT -> rT) fimfun fimfun_zmod_closed. +HB.instance Definition _ := + [SubChoice_isSubZmodule of {fimfun aT >-> rT} by <:]. Implicit Types (f g : {fimfun aT >-> rT}). diff --git a/classical/classical_sets.v b/classical/classical_sets.v index e647c855c..5d586a362 100644 --- a/classical/classical_sets.v +++ b/classical/classical_sets.v @@ -1,72 +1,117 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) -From mathcomp Require Import all_ssreflect ssralg matrix finmap order ssrnum. +From HB Require Import structures. +From mathcomp Require Import all_ssreflect ssralg matrix finmap ssrnum. From mathcomp Require Import ssrint interval. -Require Import mathcomp_extra boolp. +From mathcomp Require Import mathcomp_extra boolp. -(******************************************************************************) +(**md**************************************************************************) +(* # Set Theory *) +(* *) (* This file develops a basic theory of sets and types equipped with a *) -(* canonical inhabitant (pointed types). *) +(* canonical inhabitant (pointed types): *) +(* - A decidable equality is defined for any type. It is thus possible to *) +(* define an eqType structure for any type using the mixin gen_eqMixin. *) +(* - This file adds the possibility to define a choiceType structure for *) +(* any type thanks to an axiom gen_choiceMixin giving a choice mixin. *) +(* - We chose to have generic mixins and no global instances of the eqType *) +(* and choiceType structures to let the user choose which definition of *) +(* equality to use and to avoid conflict with already declared instances. *) (* *) -(* --> A decidable equality is defined for any type. It is thus possible to *) -(* define an eqType structure for any type using the mixin gen_eqMixin. *) -(* --> This file adds the possibility to define a choiceType structure for *) -(* any type thanks to an axiom gen_choiceMixin giving a choice mixin. *) -(* --> We chose to have generic mixins and no global instances of the eqType *) -(* and choiceType structures to let the user choose which definition of *) -(* equality to use and to avoid conflict with already declared instances. *) +(* Thanks to this basic set theory, we proved Zorn's Lemma, which states *) +(* that any ordered set such that every totally ordered subset admits an *) +(* upper bound has a maximal element. We also proved an analogous version *) +(* for preorders, where maximal is replaced with premaximal: $t$ is *) +(* premaximal if whenever $t < s$ we also have $s < t$. *) (* *) -(* * Sets: *) -(* set T == type of sets on T. *) +(* About the naming conventions in this file: *) +(* - use T, T', T1, T2, etc., aT (domain type), rT (return type) for names *) +(* of variables in Type (or choiceType/pointedType/porderType) *) +(* + use the same suffix or prefix for the sets as their containing type *) +(* (e.g., A1 in T1, etc.) *) +(* + as a consequence functions are rather of type aT -> rT *) +(* - use I, J when the type corresponds to an index *) +(* - sets are named A, B, C, D, etc., or Y when it is ostensibly an image *) +(* set (i.e., of type set rT) *) +(* - indexed sets are rather named F *) +(* *) +(* Example of notations: *) +(* | Coq notations | | Meaning | *) +(* |-----------------------------:|---|:------------------------------------ *) +(* | set0 |==| $\emptyset$ *) +(* | [set: A] |==| the full set of elements of type A *) +(* | `` `\|` `` |==| $\cup$ *) +(* | `` `&` `` |==| $\cap$ *) +(* | `` `\` `` |==| set difference *) +(* | `` ~` `` |==| set complement *) +(* | `` `<=` `` |==| $\subseteq$ *) +(* | `` f @` A `` |==| image by f of A *) +(* | `` f @^-1` A `` |==| preimage by f of A *) +(* | [set x] |==| the singleton set $\{x\}$ *) +(* | [set~ x] |==| the complement of $\{x\}$ *) +(* | [set E \| x in P] |==| the set of E with x ranging in P *) +(* | range f |==| image by f of the full set *) +(* | \big[setU/set0]_(i <- s \| P i) f i |==| finite union *) +(* | \bigcup_(k in P) F k |==| countable union *) +(* | \bigcap_(k in P) F k |==| countable intersection *) +(* | trivIset D F |==| F is a sequence of pairwise disjoint *) +(* | | | sets indexed over the domain D *) +(* *) +(* Detailed documentation: *) +(* ## Sets *) +(* ``` *) +(* set T == type of sets on T *) (* (x \in P) == boolean membership predicate from ssrbool *) (* for set P, available thanks to a canonical *) -(* predType T structure on sets on T. *) -(* [set x : T | P] == set of points x : T such that P holds. *) -(* [set x | P] == same as before with T left implicit. *) +(* predType T structure on sets on T *) +(* [set x : T | P] == set of points x : T such that P holds *) +(* [set x | P] == same as before with T left implicit *) (* [set E | x in A] == set defined by the expression E for x in *) -(* set A. *) +(* set A *) (* [set E | x in A & y in B] == same as before for E depending on 2 *) -(* variables x and y in sets A and B. *) -(* setT == full set. *) -(* set0 == empty set. *) -(* range f == the range of f, i.e. [set f x | x in setT] *) -(* [set a] == set containing only a. *) +(* variables x and y in sets A and B *) +(* setT == full set *) +(* set0 == empty set *) +(* range f == the range of f, i.e., [set f x | x in setT] *) +(* [set a] == set containing only a *) (* [set a : T] == same as before with the type of a made *) -(* explicit. *) -(* A `|` B == union of A and B. *) -(* a |` A == A extended with a. *) -(* [set a1; a2; ..; an] == set containing only the n elements ai. *) -(* A `&` B == intersection of A and B. *) -(* A `*` B == product of A and B, i.e. set of pairs (a,b) *) -(* such that A a and B b. *) +(* explicit *) +(* A `|` B == union of A and B *) +(* a |` A == A extended with a *) +(* [set a1; a2; ..; an] == set containing only the n elements ai *) +(* A `&` B == intersection of A and B *) +(* A `*` B == product of A and B, i.e., set of pairs *) +(* (a,b) such that A a and B b *) (* A.`1 == set of points a such that there exists b so *) -(* that A (a, b). *) +(* that A (a, b) *) (* A.`2 == set of points a such that there exists b so *) -(* that A (b, a). *) -(* ~` A == complement of A. *) -(* [set~ a] == complement of [set a]. *) -(* A `\` B == complement of B in A. *) -(* A `\ a == A deprived of a. *) +(* that A (b, a) *) +(* ~` A == complement of A *) +(* [set~ a] == complement of [set a] *) +(* A `\` B == complement of B in A *) +(* A `\ a == A deprived of a *) (* `I_n := [set k | k < n] *) (* \bigcup_(i in P) F == union of the elements of the family F whose *) -(* index satisfies P. *) -(* \bigcup_(i : T) F == union of the family F indexed on T. *) +(* index satisfies P *) +(* \bigcup_(i : T) F == union of the family F indexed on T *) (* \bigcup_(i < n) F := \bigcup_(i in `I_n) F *) -(* \bigcup_i F == same as before with T left implicit. *) +(* \bigcup_i F == same as before with T left implicit *) (* \bigcap_(i in P) F == intersection of the elements of the family *) -(* F whose index satisfies P. *) -(* \bigcap_(i : T) F == union of the family F indexed on T. *) +(* F whose index satisfies P *) +(* \bigcap_(i : T) F == union of the family F indexed on T *) (* \bigcap_(i < n) F := \bigcap_(i in `I_n) F *) -(* \bigcap_i F == same as before with T left implicit. *) +(* \bigcap_i F == same as before with T left implicit *) (* smallest C G := \bigcap_(A in [set M | C M /\ G `<=` M]) A *) -(* A `<=` B <-> A is included in B. *) -(* A `<=>` B <-> double inclusion A `<=` B and B `<=` A. *) -(* f @^-1` A == preimage of A by f. *) -(* f @` A == image of A by f. Notation for `image A f`. *) -(* A !=set0 := exists x, A x. *) +(* A `<=` B <-> A is included in B *) +(* A `<` B := A `<=` B /\ ~ (B `<=` A) *) +(* A `<=>` B <-> double inclusion A `<=` B and B `<=` A *) +(* f @^-1` A == preimage of A by f *) +(* f @` A == image of A by f *) +(* This is a notation for `image A f` *) +(* A !=set0 := exists x, A x *) (* [set` p] == a classical set corresponding to the *) (* predType p *) (* `[a, b] := [set` `[a, b]], i.e., a classical set *) -(* corresponding to the interval `[a, b]. *) +(* corresponding to the interval `[a, b] *) (* `]a, b] := [set` `]a, b]] *) (* `[a, b[ := [set` `[a, b[] *) (* `]a, b[ := [set` `]a, b[] *) @@ -75,56 +120,66 @@ Require Import mathcomp_extra boolp. (* `[a, +oo[ := [set` `[a, +oo[] *) (* `]a, +oo[ := [set` `]a, +oo[] *) (* `]-oo, +oo[ := [set` `]-oo, +oo[] *) -(* is_subset1 A <-> A contains only 1 element. *) -(* is_fun f <-> for each a, f a contains only 1 element. *) -(* is_total f <-> for each a, f a is non empty. *) -(* is_totalfun f <-> conjunction of is_fun and is_total. *) +(* is_subset1 A <-> A contains only 1 element *) +(* is_fun f <-> for each a, f a contains only 1 element *) +(* is_total f <-> for each a, f a is non empty *) +(* is_totalfun f <-> conjunction of is_fun and is_total *) (* xget x0 P == point x in P if it exists, x0 otherwise; *) -(* P must be a set on a choiceType. *) +(* P must be a set on a choiceType *) (* fun_of_rel f0 f == function that maps x to an element of f x *) -(* if there is one, to f0 x otherwise. *) +(* if there is one, to f0 x otherwise *) (* F `#` G <-> intersections beween elements of F an G are *) -(* all non empty. *) +(* all non empty *) +(* ``` *) (* *) -(* * Pointed types: *) +(* ## Pointed types *) +(* ``` *) (* pointedType == interface type for types equipped with a *) -(* canonical inhabitant. *) +(* canonical inhabitant *) (* PointedType T m == packs the term m : T to build a *) (* pointedType; T must have a choiceType *) -(* structure. *) -(* [pointedType of T for cT] == T-clone of the pointedType structure cT. *) +(* structure *) +(* [pointedType of T for cT] == T-clone of the pointedType structure cT *) (* [pointedType of T] == clone of a canonical pointedType structure *) -(* on T. *) -(* point == canonical inhabitant of a pointedType. *) -(* get P == point x in P if it exists, point otherwise; *) +(* on T *) +(* point == canonical inhabitant of a pointedType *) +(* get P == point x in P if it exists, point otherwise *) (* P must be a set on a pointedType. *) +(* ``` *) (* *) -(* --> Thanks to this basic set theory, we proved Zorn's Lemma, which states *) -(* that any ordered set such that every totally ordered subset admits an *) -(* upper bound has a maximal element. We also proved an analogous version *) -(* for preorders, where maximal is replaced with premaximal: t is *) -(* premaximal if whenever t < s we also have s < t. *) -(* *) +(* ``` *) (* $| T | == T : Type is inhabited *) (* squash x == proof of $| T | (with x : T) *) (* unsquash s == extract a witness from s : $| T | *) -(* --> Tactic: *) +(* ``` *) +(* *) +(* ## Tactic *) (* - squash x: *) (* solves a goal $| T | by instantiating with x or [the T of x] *) (* *) -(* trivIset D F == the sets F i, where i ranges over D : set I,*) -(* are pairwise-disjoint *) +(* ``` *) +(* trivIset D F == the sets F i, where i ranges over *) +(* D : set I, are pairwise-disjoint *) (* cover D F := \bigcup_(i in D) F i *) (* partition D F A == the non-empty sets F i,where i ranges over *) (* D : set I, form a partition of A *) (* pblock_index D F x == index i such that i \in D and x \in F i *) (* pblock D F x := F (pblock_index D F x) *) (* *) -(* * Upper and lower bounds: *) +(* maximal_disjoint_subcollection F A B == A is a maximal (for inclusion) *) +(* disjoint subcollection of the collection *) +(* B of elements in F : I -> set T *) +(* ``` *) +(* *) +(* ## Upper and lower bounds *) +(* ``` *) (* ubound A == the set of upper bounds of the set A *) (* lbound A == the set of lower bounds of the set A *) -(* Predicates to express existence conditions of supremum and infimum of *) -(* sets of real numbers: *) +(* ``` *) +(* *) +(* Predicates to express existence conditions of supremum and infimum of sets *) +(* of real numbers: *) +(* ``` *) (* has_ubound A := ubound A != set0 *) (* has_sup A := A != set0 /\ has_ubound A *) (* has_lbound A := lbound A != set0 *) @@ -137,26 +192,20 @@ Require Import mathcomp_extra boolp. (* infimum x0 A == infimum of A or x0 if A is empty *) (* *) (* F `#` G := the classes of sets F and G intersect *) +(* ``` *) (* *) -(* * sections: *) +(* ## Sections *) +(* ``` *) (* xsection A x == with A : set (T1 * T2) and x : T1 is the *) (* x-section of A *) (* ysection A y == with A : set (T1 * T2) and y : T2 is the *) (* y-section of A *) +(* ``` *) (* *) -(* * About the naming conventions in this file: *) -(* - use T, T', T1, T2, etc., aT (domain type), rT (return type) for names of *) -(* variables in Type (or choiceType/pointedType/porderType) *) -(* + use the same suffix or prefix for the sets as their containing type *) -(* (e.g., A1 in T1, etc.) *) -(* + as a consequence functions are rather of type aT -> rT *) -(* - use I, J when the type corresponds to an index *) -(* - sets are named A, B, C, D, etc., or Y when it is ostensibly an image set *) -(* (i.e., of type set rT) *) -(* - indexed sets are rather named F *) -(* *) -(* * Composition of relations: *) +(* ## Composition of relations *) +(* ``` *) (* A \; B == [set x | exists z, A (x.1, z) & B (z, x.2)] *) +(* ``` *) (* *) (******************************************************************************) @@ -301,6 +350,9 @@ Definition bigcup T I (P : set I) (F : I -> set T) := Definition subset A B := forall t, A t -> B t. Local Notation "A `<=` B" := (subset A B). +Lemma subsetP A B : {subset A <= B} <-> (A `<=` B). +Proof. by split => + x => /(_ x); rewrite ?inE. Qed. + Definition disj_set A B := setI A B == set0. Definition proper A B := A `<=` B /\ ~ (B `<=` A). @@ -319,6 +371,7 @@ Arguments setMR _ _ _ _ _ /. Arguments setML _ _ _ _ _ /. Arguments fst_set _ _ _ _ /. Arguments snd_set _ _ _ _ /. +Arguments subsetP {T A B}. Notation range F := [set F i | i in setT]. Notation "[ 'set' a ]" := (set1 a) : classical_set_scope. @@ -461,7 +514,7 @@ apply: contra_notP => /forallNP h. by apply/eqP; rewrite predeqE => t; split => // _; apply: contrapT. Qed. #[deprecated(note="Use setTPn instead")] -Notation setTP := setTPn. +Notation setTP := setTPn (only parsing). Lemma in_set0 (x : T) : (x \in set0) = false. Proof. by rewrite memNset. Qed. Lemma in_setT (x : T) : x \in setT. Proof. by rewrite mem_set. Qed. @@ -498,6 +551,9 @@ Proof. by apply/seteqP; split. Qed. Lemma set_false : [set` pred0] = set0 :> set T. Proof. by apply/seteqP; split. Qed. +Lemma set_predC (P : {pred T}) : [set` predC P] = ~` [set` P]. +Proof. by apply/seteqP; split => t /negP. Qed. + Lemma set_andb (P Q : {pred T}) : [set` predI P Q] = [set` P] `&` [set` Q]. Proof. by apply/predeqP => x; split; rewrite /= inE => /andP. Qed. @@ -523,6 +579,10 @@ Proof. by move=> sAB sBC ? ?; apply/sBC/sAB. Qed. Lemma sub0set A : set0 `<=` A. Proof. by []. Qed. +Lemma properW A B : A `<` B -> A `<=` B. Proof. by case. Qed. + +Lemma properxx A : ~ A `<` A. Proof. by move=> [?]; apply. Qed. + Lemma setC0 : ~` set0 = setT :> set T. Proof. by rewrite predeqE; split => ?. Qed. @@ -638,6 +698,14 @@ Proof. by rewrite setUA !(setUAC _ C) -(setUA _ C) setUid. Qed. Lemma setUUr A B C : A `|` (B `|` C) = (A `|` B) `|` (A `|` C). Proof. by rewrite !(setUC A) setUUl. Qed. +Lemma setU_id2r C A B : + (forall x, (~` B) x -> A x = C x) -> (A `|` B) = (C `|` B). +Proof. +move=> h; apply/seteqP; split => [x [Ax|Bx]|x [Cx|Bx]]; [|by right| |by right]. +- by have [|/h {}h] := pselect (B x); [by right|left; rewrite -h]. +- by have [|/h {}h] := pselect (B x); [by right|left; rewrite h]. +Qed. + Lemma setDE A B : A `\` B = A `&` ~` B. Proof. by []. Qed. Lemma setDUK A B : A `<=` B -> A `|` (B `\` A) = B. @@ -1013,9 +1081,23 @@ End basic_lemmas. #[global] Hint Resolve subsetUl subsetUr subIsetl subIsetr subDsetl subDsetr : core. #[deprecated(since="mathcomp-analysis 0.6", note="Use setICl instead.")] -Notation setvI := setICl. +Notation setvI := setICl (only parsing). #[deprecated(since="mathcomp-analysis 0.6", note="Use setICr instead.")] -Notation setIv := setICr. +Notation setIv := setICr (only parsing). +Arguments setU_id2r {T} C {A B}. + +Section set_order. +Import Order.TTheory. + +Lemma set_eq_le d (rT : porderType d) T (f g : T -> rT) : + [set x | f x = g x] = [set x | (f x <= g x)%O] `&` [set x | (f x >= g x)%O]. +Proof. by apply/seteqP; split => [x/= ->//|x /andP]; rewrite -eq_le =>/eqP. Qed. + +Lemma set_neq_lt d (rT : orderType d) T (f g : T -> rT) : + [set x | f x != g x ] = [set x | (f x < g x)%O] `|` [set x | (f x > g x)%O]. +Proof. by apply/seteqP; split => [x/=|x /=]; rewrite neq_lt => /orP. Qed. + +End set_order. Lemma image2E {TA TB rT : Type} (A : set TA) (B : set TB) (f : TA -> TB -> rT) : [set f x y | x in A & y in B] = uncurry f @` (A `*` B). @@ -1024,9 +1106,12 @@ apply/predeqP => x; split=> [[a ? [b ? <-]]|[[a b] [? ? <-]]]/=; by [exists (a, b) | exists a => //; exists b]. Qed. -Lemma set_nil (T : choiceType) : [set` [::]] = @set0 T. +Lemma set_nil (T : eqType) : [set` [::]] = @set0 T. Proof. by rewrite predeqP. Qed. +Lemma set_cons1 (T : eqType) (x : T) : [set` [:: x]] = [set x]. +Proof. by apply/seteqP; split => y /=; rewrite ?inE => /eqP. Qed. + Lemma set_seq_eq0 (T : eqType) (S : seq T) : ([set` S] == set0) = (S == [::]). Proof. apply/eqP/eqP=> [|->]; rewrite predeqE //; case: S => // h t /(_ h). @@ -1083,6 +1168,9 @@ Proof. by move=> k; apply/val_inj. Qed. Lemma IIordK {n} : cancel (@IIord n) ordII. Proof. by move=> k; apply/val_inj. Qed. +Lemma mem_not_I N n : (n \in ~` `I_N) = (N <= n). +Proof. by rewrite in_setC /mkset /in_mem /mem /= /in_set asboolb -leqNgt. Qed. + End InitialSegment. Lemma setT_unit : [set: unit] = [set tt]. @@ -1175,14 +1263,12 @@ Section SetMonoids. Variable (T : Type). Import Monoid. -Canonical setU_monoid := Law (@setUA T) (@set0U T) (@setU0 T). -Canonical setU_comoid := ComLaw (@setUC T). -Canonical setU_mul_monoid := MulLaw (@setTU T) (@setUT T). -Canonical setI_monoid := Law (@setIA T) (@setTI T) (@setIT T). -Canonical setI_comoid := ComLaw (@setIC T). -Canonical setI_mul_monoid := MulLaw (@set0I T) (@setI0 T). -Canonical setU_add_monoid := AddLaw (@setUIl T) (@setUIr T). -Canonical setI_add_monoid := AddLaw (@setIUl T) (@setIUr T). +HB.instance Definition _ := isComLaw.Build (set T) set0 setU setUA setUC set0U. +HB.instance Definition _ := isMulLaw.Build (set T) setT setU setTU setUT. +HB.instance Definition _ := isComLaw.Build (set T) setT setI setIA setIC setTI. +HB.instance Definition _ := isMulLaw.Build (set T) set0 setI set0I setI0. +HB.instance Definition _ := isAddLaw.Build (set T) setU setI setUIl setUIr. +HB.instance Definition _ := isAddLaw.Build (set T) setI setU setIUl setIUr. End SetMonoids. @@ -1219,10 +1305,16 @@ Proof. by split=> fAY x; have := fAY x; rewrite !inE. Qed. Lemma image_subP {A Y f} : f @` A `<=` Y <-> {homo f : x / A x >-> Y x}. Proof. by split=> fAY x => [Ax|[y + <-]]; apply: fAY=> //; exists x. Qed. -Lemma image_sub {f : aT -> rT} {A : set aT} {B : set rT} : +Lemma image_sub {f : aT -> rT} {A : set aT} {B : set rT} : (f @` A `<=` B) = (A `<=` f @^-1` B). Proof. by apply/propext; rewrite image_subP; split=> AB a /AB. Qed. +Lemma imsub1 x A f : f @` A `<=` [set x] -> forall a, A a -> f a = x. +Proof. by move=> + a Aa; apply; exists a. Qed. + +Lemma imsub1P x A f : f @` A `<=` [set x] <-> forall a, A a -> f a = x. +Proof. by split=> [/(@imsub1 _)//|+ _ [a Aa <-]]; apply. Qed. + Lemma image_setU f A B : f @` (A `|` B) = f @` A `|` f @` B. Proof. rewrite eqEsubset; split => b. @@ -1279,6 +1371,9 @@ Proof. by case=> [t ?]; exists (f t). Qed. Lemma preimage_image f A : A `<=` f @^-1` (f @` A). Proof. by move=> a Aa; exists a. Qed. +Lemma preimage_range {A B : Type} (f : A -> B) : f @^-1` (range f) = [set: A]. +Proof. by rewrite eqEsubset; split=> x // _; exists x. Qed. + Lemma image_preimage_subset f Y : f @` (f @^-1` Y) `<=` Y. Proof. by move=> _ [t /= Yft <-]. Qed. @@ -1371,6 +1466,18 @@ Qed. Lemma preimage10 {T R} {f : T -> R} {x} : ~ range f x -> f @^-1` [set x] = set0. Proof. by move/preimage10P. Qed. +Lemma preimage_true {T} (P : {pred T}) : P @^-1` [set true] = [set` P]. +Proof. by apply/seteqP; split => [x/=//|x]. Qed. + +Lemma preimage_false {T} (P : {pred T}) : P @^-1` [set false] = ~` [set` P]. +Proof. by apply/seteqP; split => [t/= /negbT/negP|t /= /negP/negbTE]. Qed. + +Lemma preimage_mem_true {T} (A : set T) : mem A @^-1` [set true] = A. +Proof. by rewrite preimage_true; under eq_fun do rewrite inE. Qed. + +Lemma preimage_mem_false {T} (A : set T) : mem A @^-1` [set false] = ~` A. +Proof. by rewrite preimage_false; under eq_fun do rewrite inE. Qed. + End image_lemmas. Arguments sub_image_setI {aT rT f A B} t _. @@ -1735,7 +1842,8 @@ Lemma setC_bigsetU U (s : seq T) (f : T -> set U) (P : pred T) : Proof. by elim/big_rec2: _ => [|i X Y Pi <-]; rewrite ?setC0 ?setCU. Qed. Lemma setC_bigsetI U (s : seq T) (f : T -> set U) (P : pred T) : - (~` \big[setI/setT]_(t <- s | P t) f t) = \big[setU/set0]_(t <- s | P t) ~` f t. + (~` \big[setI/setT]_(t <- s | P t) f t) = + \big[setU/set0]_(t <- s | P t) ~` f t. Proof. by elim/big_rec2: _ => [|i X Y Pi <-]; rewrite ?setCT ?setCI. Qed. Lemma bigcupDr (F : I -> set T) (P : set I) (A : set T) : P !=set0 -> @@ -1746,18 +1854,25 @@ Lemma setD_bigcupl (F : I -> set T) (P : set I) (A : set T) : \bigcup_(i in P) F i `\` A = \bigcup_(i in P) (F i `\` A). Proof. by rewrite setDE setI_bigcupl; under eq_bigcupr do rewrite -setDE. Qed. -Lemma bigcup_bigcup_dep {J : Type} (F : I -> J -> set T) (P : set I) (Q : I -> set J) : - \bigcup_(i in P) \bigcup_(j in Q i) F i j = - \bigcup_(k in P `*`` Q) F k.1 k.2. +Lemma bigcup_setM_dep {J : Type} (F : I -> J -> set T) + (P : set I) (Q : I -> set J) : + \bigcup_(k in P `*`` Q) F k.1 k.2 = \bigcup_(i in P) \bigcup_(j in Q i) F i j. Proof. -apply/predeqP => x; split=> [[i Pi [j Pj Fijx]]|]; first by exists (i, j). +apply/predeqP => x; split=> [|[i Pi [j Pj Fijx]]]; last by exists (i, j). by move=> [[/= i j] [Pi Qj] Fijx]; exists i => //; exists j. Qed. -Lemma bigcup_bigcup {J : Type} (F : I -> J -> set T) (P : set I) (Q : set J) : - \bigcup_(i in P) \bigcup_(j in Q) F i j = - \bigcup_(k in P `*` Q) F k.1 k.2. -Proof. exact: bigcup_bigcup_dep. Qed. +Lemma bigcup_setM {J : Type} (F : I -> J -> set T) (P : set I) (Q : set J) : + \bigcup_(k in P `*` Q) F k.1 k.2 = \bigcup_(i in P) \bigcup_(j in Q) F i j. +Proof. exact: bigcup_setM_dep. Qed. + +Lemma bigcup_bigcup T' (F : I -> set T) (P : set I) (G : T -> set T') : + \bigcup_(i in \bigcup_(n in P) F n) G i = + \bigcup_(n in P) \bigcup_(i in F n) G i. +Proof. +apply/seteqP; split; first by move=> x [n [m ? ?] h]; exists m => //; exists n. +by move=> x [n ? [m ?]] h; exists m => //; exists n. +Qed. Lemma bigcupID (Q : set I) (F : I -> set T) (P : set I) : \bigcup_(i in P) F i = @@ -1882,10 +1997,10 @@ Lemma bigcap_fsetD1 {T U : choiceType} (x : T) (F : T -> set U) (X : {fset T}) : Proof. by move=> Xx; rewrite (bigcap_setD1 x)// set_fsetD1. Qed. Arguments bigcup_fsetD1 {T U} x. -Section bigcup_set. +Section bigcup_seq. Variables (T : choiceType) (U : Type). -Lemma bigcup_set_cond (s : seq T) (f : T -> set U) (P : pred T) : +Lemma bigcup_seq_cond (s : seq T) (f : T -> set U) (P : pred T) : \bigcup_(t in [set x | (x \in s) && P x]) (f t) = \big[setU/set0]_(t <- s | P t) (f t). Proof. @@ -1900,23 +2015,31 @@ rewrite big_cons -ih predeqE => u; split=> [[t /andP[]]|]. + by exists t => //; apply/andP; split => //; rewrite inE orbC ts. Qed. -Lemma bigcup_set (s : seq T) (f : T -> set U) : +Lemma bigcup_seq (s : seq T) (f : T -> set U) : \bigcup_(t in [set` s]) (f t) = \big[setU/set0]_(t <- s) (f t). Proof. -rewrite -(bigcup_set_cond s f xpredT); congr (\bigcup_(t in mkset _) _). +rewrite -(bigcup_seq_cond s f xpredT); congr (\bigcup_(t in mkset _) _). by rewrite funeqE => t; rewrite andbT. Qed. -Lemma bigcap_set_cond (s : seq T) (f : T -> set U) (P : pred T) : +Lemma bigcap_seq_cond (s : seq T) (f : T -> set U) (P : pred T) : \bigcap_(t in [set x | (x \in s) && P x]) (f t) = \big[setI/setT]_(t <- s | P t) (f t). -Proof. by apply: setC_inj; rewrite setC_bigcap setC_bigsetI bigcup_set_cond. Qed. +Proof. by apply: setC_inj; rewrite setC_bigcap setC_bigsetI bigcup_seq_cond. Qed. -Lemma bigcap_set (s : seq T) (f : T -> set U) : +Lemma bigcap_seq (s : seq T) (f : T -> set U) : \bigcap_(t in [set` s]) (f t) = \big[setI/setT]_(t <- s) (f t). -Proof. by apply: setC_inj; rewrite setC_bigcap setC_bigsetI bigcup_set. Qed. - -End bigcup_set. +Proof. by apply: setC_inj; rewrite setC_bigcap setC_bigsetI bigcup_seq. Qed. + +End bigcup_seq. +#[deprecated(since="mathcomp-analysis 0.6.4",note="Use bigcup_seq instead")] +Notation bigcup_set := bigcup_seq (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.4",note="Use bigcup_seq_cond instead")] +Notation bigcup_set_cond := bigcup_seq_cond (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.4",note="Use bigcap_seq instead")] +Notation bigcap_set := bigcap_seq (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.4",note="Use bigcap_seq_cond instead")] +Notation bigcap_set_cond := bigcap_seq_cond (only parsing). Lemma bigcup_pred [T : finType] [U : Type] (P : {pred T}) (f : T -> set U) : \bigcup_(t in [set` P]) f t = \big[setU/set0]_(t in P) f t. @@ -1964,7 +2087,7 @@ Implicit Types (A : set T) (F : nat -> set T). Lemma bigcup_mkord n F : \bigcup_(i < n) F i = \big[setU/set0]_(i < n) F i. Proof. -rewrite -(big_mkord xpredT F) -bigcup_set. +rewrite -(big_mkord xpredT F) -bigcup_seq. by apply: eq_bigcupl; split=> i; rewrite /= mem_index_iota leq0n. Qed. @@ -2121,76 +2244,25 @@ Lemma inTT_bij [T1 T2 : Type] [f : T1 -> T2] : {in [set: T1], bijective f} -> bijective f. Proof. by case=> [g /in1TT + /in1TT +]; exists g. Qed. -Module Pointed. - -Definition point_of (T : Type) := T. - -Record class_of (T : Type) := Class { - base : Choice.class_of T; - mixin : point_of T -}. - -Section ClassDef. - -Structure type := Pack { sort; _ : class_of sort }. -Local Coercion sort : type >-> Sortclass. -Variables (T : Type) (cT : type). -Definition class := let: Pack _ c := cT return class_of cT in c. - -Definition clone c of phant_id class c := @Pack T c. -Let xT := let: Pack T _ := cT in T. -Notation xclass := (class : class_of xT). -Local Coercion base : class_of >-> Choice.class_of. - -Definition pack m := - fun bT b of phant_id (Choice.class bT) b => @Pack T (Class b m). - -Definition eqType := @Equality.Pack cT xclass. -Definition choiceType := @Choice.Pack cT xclass. +HB.mixin Record isPointed T := { point : T }. -End ClassDef. +#[short(type=pointedType)] +HB.structure Definition Pointed := {T of isPointed T & Choice T}. -Module Exports. - -Coercion sort : type >-> Sortclass. -Coercion base : class_of >-> Choice.class_of. -Coercion mixin : class_of >-> point_of. -Coercion eqType : type >-> Equality.type. -Canonical eqType. -Coercion choiceType : type >-> Choice.type. -Canonical choiceType. -Notation pointedType := type. -Notation PointedType T m := (@pack T m _ _ idfun). -Notation "[ 'pointedType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) - (at level 0, format "[ 'pointedType' 'of' T 'for' cT ]") : form_scope. -Notation "[ 'pointedType' 'of' T ]" := (@clone T _ _ id) - (at level 0, format "[ 'pointedType' 'of' T ]") : form_scope. - -End Exports. - -End Pointed. - -Export Pointed.Exports. - -Definition point {M : pointedType} : M := Pointed.mixin (Pointed.class M). +(* NB: was arrow_pointedType *) +HB.instance Definition _ (T : Type) (T' : T -> pointedType) := + isPointed.Build (forall t : T, T' t) (fun=> point). -Canonical arrow_pointedType (T : Type) (T' : pointedType) := - PointedType (T -> T') (fun=> point). - -Definition dep_arrow_pointedType (T : Type) (T' : T -> pointedType) := - Pointed.Pack - (Pointed.Class (dep_arrow_choiceClass T') (fun i => @point (T' i))). - -Canonical unit_pointedType := PointedType unit tt. -Canonical bool_pointedType := PointedType bool false. -Canonical Prop_pointedType := PointedType Prop False. -Canonical nat_pointedType := PointedType nat 0. -Canonical prod_pointedType (T T' : pointedType) := - PointedType (T * T') (point, point). -Canonical matrix_pointedType m n (T : pointedType) := - PointedType 'M[T]_(m, n) (\matrix_(_, _) point)%R. -Canonical option_pointedType (T : choiceType) := PointedType (option T) None. -Canonical pointed_fset {T : choiceType} := PointedType {fset T} fset0. +HB.instance Definition _ := isPointed.Build unit tt. +HB.instance Definition _ := isPointed.Build bool false. +HB.instance Definition _ := isPointed.Build Prop False. +HB.instance Definition _ := isPointed.Build nat 0. +HB.instance Definition _ (T T' : pointedType) := + isPointed.Build (T * T')%type (point, point). +HB.instance Definition _ m n (T : pointedType) := + isPointed.Build 'M[T]_(m, n) (\matrix_(_, _) point)%R. +HB.instance Definition _ (T : choiceType) := isPointed.Build (option T) None. +HB.instance Definition _ (T : choiceType) := isPointed.Build {fset T} fset0. Notation get := (xget point). Notation "[ 'get' x | E ]" := (get [set x | E]) @@ -2236,108 +2308,56 @@ Lemma unsquashK {T} : cancel (@unsquash T) squash. Proof. by move=> []. Qed. (* Empty types *) -Module Empty. +HB.mixin Record isEmpty T := { + axiom : T -> False +}. + +#[short(type="emptyType")] +HB.structure Definition Empty := {T of isEmpty T & Finite T}. + +HB.factory Record Choice_isEmpty T of Choice T := { + axiom : T -> False +}. +HB.builders Context T of Choice_isEmpty T. + +Definition pickle : T -> nat := fun=> 0%N. +Definition unpickle : nat -> option T := fun=> None. +Lemma pickleK : pcancel pickle unpickle. +Proof. by move=> x; case: (axiom x). Qed. +HB.instance Definition _ := isCountable.Build T pickleK. + +Lemma fin_axiom : Finite.axiom ([::] : seq T). +Proof. by move=> /[dup]/axiom. Qed. +HB.instance Definition _ := isFinite.Build T fin_axiom. -Definition mixin_of T := T -> False. +HB.instance Definition _ := isEmpty.Build T axiom. +HB.end. -Section EqMixin. -Variables (T : Type) (m : mixin_of T). +HB.factory Record Type_isEmpty T := { + axiom : T -> False +}. +HB.builders Context T of Type_isEmpty T. Definition eq_op (x y : T) := true. -Lemma eq_opP : Equality.axiom eq_op. Proof. by []. Qed. -Definition eqMixin := EqMixin eq_opP. -End EqMixin. +Lemma eq_opP : Equality.axiom eq_op. Proof. by move=> ? /[dup]/axiom. Qed. +HB.instance Definition _ := hasDecEq.Build T eq_opP. -Section ChoiceMixin. -Variables (T : Type) (m : mixin_of T). Definition find of pred T & nat : option T := None. Lemma findP (P : pred T) (n : nat) (x : T) : find P n = Some x -> P x. Proof. by []. Qed. Lemma ex_find (P : pred T) : (exists x : T, P x) -> exists n : nat, find P n. -Proof. by case. Qed. +Proof. by move=> [/[dup]/axiom]. Qed. Lemma eq_find (P Q : pred T) : P =1 Q -> find P =1 find Q. Proof. by []. Qed. -Definition choiceMixin := Choice.Mixin findP ex_find eq_find. -End ChoiceMixin. +HB.instance Definition _ := hasChoice.Build T findP ex_find eq_find. -Section CountMixin. -Variables (T : Type) (m : mixin_of T). -Definition pickle : T -> nat := fun=> 0. -Definition unpickle : nat -> option T := fun=> None. -Lemma pickleK : pcancel pickle unpickle. Proof. by []. Qed. -Definition countMixin := CountMixin pickleK. -End CountMixin. - -Section FinMixin. -Variables (T : countType) (m : mixin_of T). -Lemma fin_axiom : Finite.axiom ([::] : seq T). Proof. by []. Qed. -Definition finMixin := FinMixin fin_axiom. -End FinMixin. - -Section ClassDef. - -Set Primitive Projections. -Record class_of T := Class { - base : Finite.class_of T; - mixin : mixin_of T -}. -Unset Primitive Projections. -Local Coercion base : class_of >-> Finite.class_of. - -Structure type : Type := Pack {sort; _ : class_of sort}. -Local Coercion sort : type >-> Sortclass. -Variables (T : Type) (cT : type). -Definition class := let: Pack _ c as cT' := cT return class_of cT' in c. -Definition clone c of phant_id class c := @Pack T c. - -Definition pack (m0 : mixin_of T) := - fun bT b & phant_id (Finite.class bT) b => - fun m & phant_id m0 m => Pack (@Class T b m). - -Definition eqType := @Equality.Pack cT class. -Definition choiceType := @Choice.Pack cT class. -Definition countType := @Countable.Pack cT class. -Definition finType := @Finite.Pack cT class. - -End ClassDef. - -Module Import Exports. -Coercion base : class_of >-> Finite.class_of. -Coercion mixin : class_of >-> mixin_of. -Coercion sort : type >-> Sortclass. -Coercion eqType : type >-> Equality.type. -Canonical eqType. -Coercion choiceType : type >-> Choice.type. -Canonical choiceType. -Coercion countType : type >-> Countable.type. -Canonical countType. -Coercion finType : type >-> Finite.type. -Canonical finType. -Notation emptyType := type. -Notation EmptyType T m := (@pack T m _ _ id _ id). -Notation "[ 'emptyType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) - (at level 0, format "[ 'emptyType' 'of' T 'for' cT ]") : form_scope. -Notation "[ 'emptyType' 'of' T ]" := (@clone T _ _ id) - (at level 0, format "[ 'emptyType' 'of' T ]") : form_scope. -Coercion eqMixin : mixin_of >-> Equality.mixin_of. -Coercion choiceMixin : mixin_of >-> Choice.mixin_of. -Coercion countMixin : mixin_of >-> Countable.mixin_of. -End Exports. +HB.instance Definition _ := Choice_isEmpty.Build T axiom. +HB.end. -End Empty. -Export Empty.Exports. +HB.instance Definition _ := Type_isEmpty.Build False id. -Definition False_emptyMixin : Empty.mixin_of False := id. -Canonical False_eqType := EqType False False_emptyMixin. -Canonical False_choiceType := ChoiceType False False_emptyMixin. -Canonical False_countType := CountType False False_emptyMixin. -Canonical False_finType := FinType False (Empty.finMixin False_emptyMixin). -Canonical False_emptyType := EmptyType False False_emptyMixin. +HB.instance Definition _ := isEmpty.Build void (@of_void _). -Definition void_emptyMixin : Empty.mixin_of void := @of_void _. -Canonical void_emptyType := EmptyType void void_emptyMixin. - -Definition no {T : emptyType} : T -> False := - let: Empty.Pack _ (Empty.Class _ f) := T in f. +Definition no {T : emptyType} : T -> False := @axiom T. Definition any {T : emptyType} {U} : T -> U := @False_rect _ \o no. Lemma empty_eq0 {T : emptyType} : all_equal_to (set0 : set T). @@ -2357,13 +2377,17 @@ Arguments qcanon {T C sort alt} x. Lemma choicePpointed : quasi_canonical choiceType pointedType. Proof. -apply: qcanon => T; have [/unsquash x|/(_ (squash _)) TF] := pselect $|T|. - by right; exists (PointedType T x); case: T x. +apply: qcanon => -[Ts [Tc Te]]. +set T := Choice.Pack _. +have [/unsquash x|/(_ (squash _)) TF] := pselect $|T|. + right. + pose Tp := isPointed.Build T x. + pose TT : pointedType := HB.pack T Te Tc Tp. + by exists TT. left. -pose cT := CountType _ (TF : Empty.mixin_of T). -pose fM := Empty.finMixin (TF : Empty.mixin_of cT). -exists (EmptyType (FinType _ fM) TF) => //=. -by case: T TF @cT @fM. +pose TMixin := Choice_isEmpty.Build T TF. +pose TT : emptyType := HB.pack T Te Tc TMixin. +by exists TT. Qed. Lemma eqPpointed : quasi_canonical eqType pointedType. @@ -2382,6 +2406,23 @@ Section partitions. Definition trivIset T I (D : set I) (F : I -> set T) := forall i j : I, D i -> D j -> F i `&` F j !=set0 -> i = j. +Lemma trivIset1 T I (i : I) (F : I -> set T) : trivIset [set i] F. +Proof. by move=> j k <- <-. Qed. + +Lemma ltn_trivIset T (F : nat -> set T) : + (forall n m, (m < n)%N -> F m `&` F n = set0) -> trivIset setT F. +Proof. +move=> h m n _ _ [t [mt nt]]; apply/eqP/negPn/negP. +by rewrite neq_ltn => /orP[] /h; apply/eqP/set0P; exists t. +Qed. + +Lemma subsetC_trivIset T (F : nat -> set T) : + (forall n, F n.+1 `<=` ~` \big[setU/set0]_(i < n.+1) F i) -> trivIset setT F. +Proof. +move=> sF; apply: ltn_trivIset => n m h; rewrite setIC; apply/disjoints_subset. +by case: n h => // n h; apply: (subset_trans (sF n)); exact/subsetC/bigsetU_sup. +Qed. + Lemma trivIset_mkcond T I (D : set I) (F : I -> set T) : trivIset D F <-> trivIset setT (fun i => if i \in D then F i else set0). Proof. @@ -2462,8 +2503,32 @@ Lemma trivIset_preimage1_in {aT} {rT : choiceType} (D : set rT) (A : set aT) (f : aT -> rT) : trivIset D (fun x => A `&` f @^-1` [set x]). Proof. by move=> y z _ _ [x [[_ <-] [_ <-]]]. Qed. +Lemma trivIset_bigcup (I T : Type) (J : eqType) (D : J -> set I) (F : I -> set T) : + (forall n, trivIset (D n) F) -> + (forall n m i j, n != m -> D n i -> D m j -> F i `&` F j !=set0 -> i = j) -> + trivIset (\bigcup_k D k) F. +Proof. +move=> tB H; move=> i j [n _ Dni] [m _ Dmi] ij. +have [nm|nm] := eqVneq n m; first by apply: (tB m) => //; rewrite -nm. +exact: (H _ _ _ _ nm). +Qed. + +Lemma trivIsetT_bigcup T1 T2 (I : eqType) (D : I -> set T1) (F : T1 -> set T2) : + trivIset setT D -> + trivIset (\bigcup_i D i) F -> + trivIset setT (fun i => \bigcup_(t in D i) F t). +Proof. +move=> D0 h i j _ _ [t [[m Dim Fmt] [n Djn Fnt]]]. +have mn : m = n by apply: h => //; [exists i|exists j|exists t]. +rewrite {}mn {m} in Dim Fmt *. +by apply: D0 => //; exists n. +Qed. + Definition cover T I D (F : I -> set T) := \bigcup_(i in D) F i. +Lemma coverE T I D (F : I -> set T) : cover D F = \bigcup_(i in D) F i. +Proof. by []. Qed. + Lemma cover_restr T I D' D (F : I -> set T) : D `<=` D' -> (forall i, D' i -> ~ D i -> F i = set0) -> cover D F = cover D' F. @@ -2537,7 +2602,7 @@ Qed. End partitions. #[deprecated(note="Use trivIset_setIl instead")] -Notation trivIset_setI := trivIset_setIl. +Notation trivIset_setI := trivIset_setIl (only parsing). Definition total_on T (A : set T) (R : T -> T -> Prop) := forall s t, A s -> A t -> R s t \/ R t s. @@ -2555,7 +2620,8 @@ Hypothesis (Rsucc : forall s, exists t, R s t /\ s <> t /\ Let Teq := @gen_eqMixin T. Let Tch := @gen_choiceMixin T. -Let Tp := Pointed.Pack (Pointed.Class (Choice.Class Teq Tch) t0). +Let Tp : pointedType := (* FIXME: use HB.pack *) + Pointed.Pack (@Pointed.Class T (isPointed.Axioms_ t0) Tch Teq). Let lub := fun A : {A : set T | total_on A R} => [get t : Tp | (forall s, sval A s -> R s t) /\ forall r, (forall s, sval A s -> R s r) -> R t r]. @@ -2617,12 +2683,12 @@ Lemma Zorn T (R : T -> T -> Prop) : exists t, forall s, R t s -> s = t. Proof. move=> Rrefl Rtrans Rantisym Rtot_max. -set totR := ({A : set T | total_on A R}). +pose totR := {A : set T | total_on A R}. set R' := fun A B : totR => sval A `<=` sval B. have R'refl A : R' A A by []. have R'trans A B C : R' A B -> R' B C -> R' A C by apply: subset_trans. have R'antisym A B : R' A B -> R' B A -> A = B. - rewrite /R'; case: A; case: B => /= B totB A totA sAB sBA. + rewrite /R'; move: A B => [/= A totA] [/= B totB] sAB sBA. by apply: eq_exist; rewrite predeqE=> ?; split=> [/sAB|/sBA]. have R'tot_lub A : total_on A R' -> exists t, (forall s, A s -> R' s t) /\ forall r, (forall s, A s -> R' s r) -> R' t r. @@ -2633,7 +2699,7 @@ have R'tot_lub A : total_on A R' -> exists t, (forall s, A s -> R' s t) /\ by have /(_ _ _ Cs Ct) := svalP C. by have /(_ _ _ Bs Bt) := svalP B. exists (exist _ (\bigcup_(B in A) sval B) AUtot); split. - by move=> B ???; exists B. + by move=> B ? ? ?; exists B. by move=> B Bub ? /= [? /Bub]; apply. apply: contrapT => nomax. have {}nomax t : exists s, R t s /\ s <> t. @@ -2648,9 +2714,9 @@ have Astot : total_on (sval A `|` [set s]) R. by move=> [/tub Rvt|->]; right=> //; apply: Rtrans Rts. move=> [Av|->]; [apply: (svalP A)|left] => //. by apply: Rtrans Rts; apply: tub. -exists (exist _ (sval A `|` [set s]) Astot); split; first by move=> ??; left. +exists (exist _ (sval A `|` [set s]) Astot); split; first by move=> ? ?; left. split=> [AeAs|[B Btot] sAB sBAs]. - have [/tub Rst|] := (pselect (sval A s)); first exact/snet/Rantisym. + have [/tub Rst|] := pselect (sval A s); first exact/snet/Rantisym. by rewrite AeAs /=; apply; right. have [Bs|nBs] := pselect (B s). by right; apply: eq_exist; rewrite predeqE => r; split=> [/sBAs|[/sAB|->]]. @@ -2659,6 +2725,61 @@ apply: eq_exist; rewrite predeqE => r; split=> [Br|/sAB] //. by have /sBAs [|ser] // := Br; rewrite ser in Br. Qed. +Section Zorn_subset. +Variables (T : Type) (P : set (set T)). + +Lemma Zorn_bigcup : + (forall F : set (set T), F `<=` P -> total_on F subset -> + P (\bigcup_(X in F) X)) -> + exists A, P A /\ forall B, A `<` B -> ~ P B. +Proof. +move=> totP; pose R (sA sB : P) := sval sA `<=` sval sB. +have {}totR F (FR : total_on F R) : exists sB, forall sA, F sA -> R sA sB. + have FP : [set val x | x in F] `<=` P. + by move=> _ [X FX <-]; apply: set_mem; apply: valP. + have totF : total_on [set val x | x in F] subset. + by move=> _ _ [X FX <-] [Y FY <-]; apply: FR. + exists (SigSub (mem_set (totP _ FP totF))) => A FA; rewrite /R/=. + exact: (bigcup_sup (imageP val _)). +have [| | |sA sAmax] := Zorn _ _ _ totR. +- by move=> ?; exact: subset_refl. +- by move=> ? ? ?; exact: subset_trans. +- by move=> [A PA] [B PB]; rewrite /R /= => AB BA; exact/eq_exist/seteqP. +- exists (val sA); case: sA => A PA /= in sAmax *; split; first exact: set_mem. + move=> B AB PB; have [BA] := sAmax (SigSub (mem_set PB)) (properW AB). + by move: AB; rewrite BA; exact: properxx. +Qed. + +End Zorn_subset. + +Definition maximal_disjoint_subcollection T I (F : I -> set T) (A B : set I) := + [/\ A `<=` B, trivIset A F & forall C, + A `<` C -> C `<=` B -> ~ trivIset C F ]. + +Section maximal_disjoint_subcollection. +Context {I T : Type}. +Variables (B : I -> set T) (D : set I). + +Let P := fun X => X `<=` D /\ trivIset X B. + +Let maxP (A : set (set I)) : + A `<=` P -> total_on A (fun x y => x `<=` y) -> P (\bigcup_(x in A) x). +Proof. +move=> AP h; split; first by apply: bigcup_sub => E /AP []. +move=> i j [x Ax] xi [y Ay] yj ij; have [xy|yx] := h _ _ Ax Ay. +- by apply: (AP _ Ay).2 => //; exact: xy. +- by apply: (AP _ Ax).2 => //; exact: yx. +Qed. + +Lemma ex_maximal_disjoint_subcollection : + { E | maximal_disjoint_subcollection B E D }. +Proof. +have /cid[E [[ED tEB] maxE]] := Zorn_bigcup maxP. +by exists E; split => // F /maxE + FD; exact: contra_not. +Qed. + +End maximal_disjoint_subcollection. + Definition premaximal T (R : T -> T -> Prop) (t : T) := forall s, R t s -> R s t. @@ -2668,7 +2789,8 @@ Lemma ZL_preorder T (t0 : T) (R : T -> T -> Prop) : exists t, premaximal R t. Proof. set Teq := @gen_eqMixin T; set Tch := @gen_choiceMixin T. -set Tp := Pointed.Pack (Pointed.Class (Choice.Class Teq Tch) t0). +pose Tpo := isPointed.Build T t0. +pose Tp : pointedType := HB.pack T Teq Tch Tpo. move=> Rrefl Rtrans tot_max. set eqR := fun s t => R s t /\ R t s; set ceqR := fun s => [set t | eqR s t]. have eqR_trans r s t : eqR r s -> eqR s t -> eqR r t. @@ -2918,13 +3040,14 @@ Proof. by rewrite setUC setKU. Qed. Lemma meetKU B A : A `|` (A `&` B) = A. Proof. by rewrite setIC setKI. Qed. -Definition orderMixin := @MeetJoinMixin _ _ (fun A B => `[]) setI - setU le_def lt_def (@setIC _) (@setUC _) (@setIA _) (@setUA _) joinKI meetKU - (@setIUl _) setIid. +#[export] +HB.instance Definition _ : Choice (set T) := Choice.copy _ (set T). -Local Canonical porderType := POrderType set_display (set T) orderMixin. -Local Canonical latticeType := LatticeType (set T) orderMixin. -Local Canonical distrLatticeType := DistrLatticeType (set T) orderMixin. +#[export] +HB.instance Definition _ := + Order.isMeetJoinDistrLattice.Build set_display (set T) + le_def lt_def (@setIC _) (@setUC _) (@setIA _) (@setUA _) + joinKI meetKU (@setIUl _) setIid. Lemma SetOrder_sub0set A : (set0 <= A)%O. Proof. by apply/asboolP; apply: sub0set. Qed. @@ -2932,12 +3055,13 @@ Proof. by apply/asboolP; apply: sub0set. Qed. Lemma SetOrder_setTsub A : (A <= setT)%O. Proof. exact/asboolP. Qed. -Local Canonical bLatticeType := - BLatticeType (set T) (Order.BLattice.Mixin SetOrder_sub0set). -Local Canonical tbLatticeType := - TBLatticeType (set T) (Order.TBLattice.Mixin SetOrder_setTsub). -Local Canonical bDistrLatticeType := [bDistrLatticeType of set T]. -Local Canonical tbDistrLatticeType := [tbDistrLatticeType of set T]. +#[export] +HB.instance Definition _ := Order.hasBottom.Build set_display (set T) + SetOrder_sub0set. + +#[export] +HB.instance Definition _ := Order.hasTop.Build set_display (set T) + SetOrder_setTsub. Lemma subKI A B : B `&` (A `\` B) = set0. Proof. by rewrite setDE setICA setICr setI0. Qed. @@ -2945,26 +3069,21 @@ Proof. by rewrite setDE setICA setICr setI0. Qed. Lemma joinIB A B : (A `&` B) `|` A `\` B = A. Proof. by rewrite setUC -setDDr setDv setD0. Qed. -Local Canonical cbDistrLatticeType := CBDistrLatticeType (set T) - (@CBDistrLatticeMixin _ _ (fun A B => A `\` B) subKI joinIB). +#[export] +HB.instance Definition _ := + Order.hasRelativeComplement.Build set_display (set T) subKI joinIB. -Local Canonical ctbDistrLatticeType := CTBDistrLatticeType (set T) - (@CTBDistrLatticeMixin _ _ _ (fun A => ~` A) (fun x => esym (setTD x))). +#[export] +HB.instance Definition _ := Order.hasComplement.Build set_display (set T) + (fun x => esym (setTD x)). End SetOrder. +Module Exports. HB.reexport. End Exports. End Internal. Module Exports. -Canonical Internal.porderType. -Canonical Internal.latticeType. -Canonical Internal.distrLatticeType. -Canonical Internal.bLatticeType. -Canonical Internal.tbLatticeType. -Canonical Internal.bDistrLatticeType. -Canonical Internal.tbDistrLatticeType. -Canonical Internal.cbDistrLatticeType. -Canonical Internal.ctbDistrLatticeType. +Export Internal.Exports. Section exports. Context {T : Type}. diff --git a/classical/contra.v b/classical/contra.v new file mode 100644 index 000000000..6f158e482 --- /dev/null +++ b/classical/contra.v @@ -0,0 +1,883 @@ +(* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) +From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq. +From mathcomp Require Import boolp. + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +(******************************************************************************) +(* Contraposition *) +(* *) +(* This file provides tactics to reason by contraposition and contradiction. *) +(* *) +(* * Tactics *) +(* assume_not == add a goal negation assumption. The tactic also works for *) +(* goals in Type, simplifies the added assumption, and *) +(* exposes its top-level constructive content. *) +(* absurd_not == proof by contradiction. Same as assume_not, but the goal is *) +(* erased and replaced by False. *) +(* Caveat: absurd_not cannot be used as a move/ view because *) +(* its conclusion is indeterminate. The more general notP can *) +(* be used instead. *) +(* contra == proof by contraposition. Change a goal of the form *) +(* assumption -> conclusion to ~ conclusion -> ~ assumption. *) +(* As with assume_not, contra allows both assumption and *) +(* conclusion to be in Type, simplifies the negation of both *) +(* assumption and conclusion, and exposes the constructive *) +(* contents of the negated conclusion. *) +(* The contra tactic also supports a limited form of the ':' *) +(* discharge pseudo tactical, whereby contra: means *) +(* move: ; contra. *) +(* The only allowed are one term, possibly preceded *) +(* by a clear switch. *) +(* absurd == proof by contradiction. The defective form of the tactic *) +(* simply replaces the entire goal with False (just as the Ltac *) +(* exfalso), leaving the user to derive a contradiction from *) +(* the assumptions. *) +(* The ':' form absurd: replaces the goal with the *) +(* negation of the (single) (as with contra:, a clear *) +(* switch is also allowed. *) +(* Finally the Ltac absurd term form is also supported. *) +(******************************************************************************) + +(* Hiding module for the internal definitions and lemmas used by the tactics + defined here. *) +Module Internals. + +(******************************************************************************) +(* A wrapper for view lemmas with an indeterminate conclusion (of the form *) +(* forall ... T ..., pattern -> T), and for which the intended view pattern *) +(* may fail to match some assumptions. This wrapper ensures that such views *) +(* are only used in the forward direction (as in move/), and only with the *) +(* appropriate move_viewP hint, preventing its application to an arbitrary *) +(* assumption A by the instatiation to A -> T' of its indeterminate *) +(* conclusion T. This is similar to the implies wrapper, except move_viewP is *) +(* NOT declared as a coercion - it must be used explicitly to apply the view *) +(* manually to an assumption (as in, move_viewP my_view some_assumption). *) +(******************************************************************************) + +Variant move_view S T := MoveView of S -> T. +Definition move_viewP {S T} mv : S -> T := let: MoveView v := mv in v. +Hint View for move/ move_viewP|2. + +(******************************************************************************) +(* A generic Forall "constructor" for the Gallina forall quantifier, i.e., *) +(* \Forall x, P := Forall (fun x => P) := forall x, P. *) +(* The main use of Forall is to apply congruence to a forall equality: *) +(* congr1 Forall : forall P Q, P = Q -> Forall P = Forall Q. *) +(* in particular in a classical setting with function extensionality, where *) +(* we can have (forall x, P x = Q x) -> (forall x, P x) = (forall x, Q x). *) +(* We use a forallSort structure to factor the ad hoc PTS product formation *) +(* rules; forallSort is keyed on the type of the entire forall expression, or *) +(* (up to subsumption) the type of the forall body - this is always a sort. *) +(* This implementation has two important limitations: *) +(* 1) It cannot handle the SProp sort and its typing rules. However, its *) +(* main application is extensionality, which is not compatible with *) +(* SProp because an (A : SProp) -> B "function" is not a generic *) +(* (A : Type) -> B function as SProp is not included in Type. *) +(* 2) The Forall constructor can't be inserted by a straightforward *) +(* unfold (as in, rewrite -[forall x, _]/(Forall _)) because of the *) +(* way Coq unification handles Type constraints. The ForallI tactic *) +(* mitigates this issue, but there are additional issues with its *) +(* implementation -- see below. *) +(******************************************************************************) + +Structure forallSort A := + ForallSort {forall_sort :> Type; _ : (A -> forall_sort) -> forall_sort}. + +Notation mkForallSort A S := (@ForallSort A S (fun T => forall x, T x)). +Polymorphic Definition TypeForall (S := Type) (A : S) := mkForallSort A S. +Canonical TypeForall. + +Canonical PropForall A := mkForallSort A Prop. + +(* This is just a special case of TypeForall, but it provides a projection *) +(* for the Set sort "constant". *) +Canonical SetForall (A : Set) := mkForallSort A Set. + +Definition Forall {A} {S : forallSort A} := + let: ForallSort _ F := S return (A -> S) -> S in F. + +Notation "\Forall x .. z , T" := + (Forall (fun x => .. (Forall (fun z => T)) ..)) + (at level 200, x binder, z binder, T at level 200, + format "'[hv' '\Forall' '[' x .. z , ']' '/ ' T ']'") : type_scope. + +(* The ForallI implementation has to work around several Coq 8.12 issues: *) +(* - Coq unification defers Type constraints so we must ensure the type *) +(* constraint for the forall term F is processed, and the resulting *) +(* sort unified with the forall_sort projection _BEFORE_ F is unified *) +(* with a Forall _ pattern, because the inferred forallSort structure *) +(* determines the actual shape of that pattern. This is done by passing *) +(* F to erefl, then constraining the type of erefl to Forall _ = _. Note *) +(* that putting a redundant F on the right hand side would break due to *) +(* incomplete handling of subtyping. *) +(* - ssr rewrite and Coq replace do not handle universe constraints. *) +(* and rewrite does not handle subsumption of the redex type. This means *) +(* we cannot use rewrite, replace or fold, and must resort to primitive *) +(* equality destruction. *) +(* - ssr case: and set do not recognize ssrpatternarg parameters, so we *) +(* must rely on ssrmatching.ssrpattern. *) +Tactic Notation "ForallI" ssrpatternarg(pat) := + let F := fresh "F" in ssrmatching.ssrpattern pat => F; + case: F / (@erefl _ F : Forall _ = _). +Tactic Notation "ForallI" := ForallI (forall x, _). + +(******************************************************************************) +(* We define specialized copies of the wrapped structure of ssrfun for Prop *) +(* and Type, as we need more than two alternative rules (indeed, 3 for Prop *) +(* and 4 for Type). We need separate copies for Prop and Type as universe *) +(* polymorphism cannot instantiate Type with Prop. *) +(******************************************************************************) + +Structure wrappedProp := WrapProp {unwrap_Prop :> Prop}. +Definition wrap4Prop := WrapProp. +Definition wrap3Prop := wrap4Prop. +Definition wrap2Prop := wrap3Prop. +Canonical wrap1Prop P := wrap2Prop P. + +Polymorphic Structure wrappedType@{i} := WrapType {unwrap_Type :> Type@{i}}. +Polymorphic Definition wrap4Type@{i} := WrapType@{i}. +Polymorphic Definition wrap3Type@{i} := wrap4Type@{i}. +Polymorphic Definition wrap2Type@{i} := wrap3Type@{i}. +Polymorphic Definition wrap1Type@{i} (T : Type@{i}) := wrap2Type T. +Canonical wrap1Type. + +Lemma generic_forall_extensionality {A} {S : forallSort A} {P Q : A -> S} : + P =1 Q -> Forall P = Forall Q. +Proof. by move/funext->. Qed. + +(******************************************************************************) +(* A set of tools (tactics, views, and rewrite rules) to facilitate the *) +(* handling of classical negation. The core functionality of these tools is *) +(* implemented by three sets of canonical structures that provide for the *) +(* simplification of negation statements (e.g., using de Morgan laws), the *) +(* conversion from constructive statements in Type to purely logical ones in *) +(* Prop (equivalently, expansion rules for the statement inhabited T), and *) +(* conversely extraction of constructive contents from logical statements. *) +(* Except for bool predicates and operators, all definitions are treated *) +(* transparently when matching statements for either simplification or *) +(* conversion; this is achieved by using the wrapper telescope pattern, first *) +(* delegating the matching of specific logical connectives, predicates, or *) +(* type constructors to an auxiliary structure that FAILS to match unknown *) +(* operators, thus triggers the expansion of defined constants. If this *) +(* ultimately fails then the wrapper is expanded, and the primary structure *) +(* instance for the expanded wrapper provides an alternative default rule: *) +(* not simplifying ~ P, not expanding inhabited T, or not extracting any *) +(* contents from a proposition P, respectively. *) +(* Additional rules, for intermediate wrapper instances, are used to handle *) +(* forall statements (for which canonical instances are not yet supported), *) +(* as well as addiitonal simplifications, such as inhabited P = P :> Prop. *) +(* Finally various tertiary structures are used to match deeper patterns, *) +(* such as bounded forall statements of the form forall x, P x -> Q x, or *) +(* inequalites x != y (i.e., is_true (~~ (x == y))). As mentioned above, *) +(* tertiary rules for bool subexpressions do not try to expand definitions, *) +(* as this would lead to the undesireable expansion of some standard *) +(* definitions. This is simply achieved by NOT using the wrapper telescope *) +(* pattern, and just having a default instance alongside those for specific *) +(* predicates and connectives. *) +(******************************************************************************) + +(******************************************************************************) +(* The negatedProp structure provides simplification of the Prop negation *) +(* (~ _) for standard connectives and predicates. The instances below cover *) +(* the pervasive and ssrbool Prop connectives, decidable equality, as well as *) +(* bool propositions (i.e., the is_true predicate), together with a few bool *) +(* connectives and predicates: negation ~~, equality ==, and nat <= and <. *) +(* Others can be added (e.g., Order.le/lt) by declaring appropriate instances *) +(* of bool_negation and bool_affirmation, while other Prop connectives and *) +(* predicates can be added by declaring instances of proper_negatedProp. *) +(******************************************************************************) + +(******************************************************************************) +(* The implementation follows the wrapper telescope pattern outlined above: *) +(* negatedProp instances match on the wrappedProp wrapper to try three *) +(* generic matching rules, in sucession: *) +(* Rule 1: match a specific connective or predicate with an instance of the *) +(* properNegatedProp secondary structure, expanding definitions *) +(* if needed, but failing if no proper match is found. *) +(* Rule 2: match a forall statement (including (T : Type) -> P statements). *) +(* Rule 3: match any Prop but return the trivial simplification. *) +(* The simplified proposition is returned as a projection parameter nP rather *) +(* than a Structure member, so that applying the corresponding views or *) +(* rewrite rules doesn't expose the inferred structures; properNegatedProp *) +(* does similarly. Also, negatedProp similarly returns a 'trivial' bool flag *) +(* that is set when Rule 3 is used, but this is actually used in the reverse *) +(* direction: views notP and rewrite rule notE force trivial := false, thus *) +(* excluding trivial instances. *) +(******************************************************************************) + +Structure negatedProp (trivial : bool) nP := + NegatedProp {negated_Prop :> wrappedProp; _ : (~ negated_Prop) = nP}. + +Structure properNegatedProp nP := ProperNegatedProp { + proper_negated_Prop :> Prop; _ : (~ proper_negated_Prop) = nP}. + +Local Notation nProp t nP P := (unwrap_Prop (@negated_Prop t nP P)). +Local Notation nPred t nP P x := (nProp t (nP x) (P x)). +Local Notation pnProp nP P := (@proper_negated_Prop nP P). + +(******************************************************************************) +(* User views and rewrite rules. The plain versions (notP, notE and notI) do *) +(* not match trivial instances; lax_XXX versions allow them. In addition, *) +(* the negation introduction rewrite rule notI does not match forall or -> *) +(* statements - lax_notI must be used for these. *) +(******************************************************************************) + +Lemma lax_notE {t nP} P : (~ nProp t nP P) = nP. Proof. by case: P. Qed. +Lemma lax_notP {t nP P} : ~ nProp t nP P -> nP. Proof. by rewrite lax_notE. Qed. +Definition lax_notI {t nP} P : nProp t nP P = (~ nP) := canRL notK (lax_notE P). + +Definition notE {nP} P : (~ nProp false nP P) = nP := lax_notE P. +Definition notP {nP P} := MoveView (@lax_notP false nP P). + +Fact proper_nPropP nP P : (~ pnProp nP P) = nP. Proof. by case: P. Qed. +Definition notI {nP} P : pnProp nP P = ~ nP := canRL notK (proper_nPropP P). + +(* Rule 1: proper negation simplification, delegated to properNegatedProp. *) +Canonical proper_nProp nP P := + @NegatedProp false nP (wrap1Prop (pnProp nP P)) (proper_nPropP P). + +(* Rule 2: forall_nProp is defined below as it uses exists_nProp. *) + +(* Rule 3: trivial negation. *) +Canonical trivial_nProp P := @NegatedProp true (~ P) (wrap3Prop P) erefl. + +(* properNegatedProp instances. *) + +Canonical True_nProp := @ProperNegatedProp False True notB.1. +Canonical False_nProp := @ProperNegatedProp True False notB.2. +Canonical not_nProp P := @ProperNegatedProp P (~ P) (notK P). + +Fact and_nPropP P tQ nQ Q : (~ (P /\ nProp tQ nQ Q)) = (P -> nQ). +Proof. by rewrite -implypN lax_notE. Qed. +Canonical and_nProp P tQ nQ Q := + ProperNegatedProp (@and_nPropP P tQ nQ Q). + +Fact and3_nPropP P Q tR nR R : (~ [/\ P, Q & nProp tR nR R]) = (P -> Q -> nR). +Proof. by hnf; rewrite and3E notE. Qed. +Canonical and3_nProp P Q tR nR R := + ProperNegatedProp (@and3_nPropP P Q tR nR R). + +Fact and4_nPropP P Q R tS nS S : + (~ [/\ P, Q, R & nProp tS nS S]) = (P -> Q -> R -> nS). +Proof. by hnf; rewrite and4E notE. Qed. +Canonical and4_nProp P Q R tS nS S := + ProperNegatedProp (@and4_nPropP P Q R tS nS S). + +Fact and5_nPropP P Q R S tT nT T : + (~ [/\ P, Q, R, S & nProp tT nT T]) = (P -> Q -> R -> S -> nT). +Proof. by hnf; rewrite and5E notE. Qed. +Canonical and5_nProp P Q R S tT nT T := + ProperNegatedProp (@and5_nPropP P Q R S tT nT T). + +Fact or_nPropP tP nP P tQ nQ Q : + (~ (nProp tP nP P \/ nProp tQ nQ Q)) = (nP /\ nQ). +Proof. by rewrite not_orE !lax_notE. Qed. +Canonical or_nProp tP nP P tQ nQ Q := + ProperNegatedProp (@or_nPropP tP nP P tQ nQ Q). + +Fact or3_nPropP tP nP P tQ nQ Q tR nR R : + (~ [\/ nProp tP nP P, nProp tQ nQ Q | nProp tR nR R]) = [/\ nP, nQ & nR]. +Proof. by rewrite or3E notE and3E. Qed. +Canonical or3_nProp tP nP P tQ nQ Q tR nR R := + ProperNegatedProp (@or3_nPropP tP nP P tQ nQ Q tR nR R). + +Fact or4_nPropP tP nP P tQ nQ Q tR nR R tS nS S : + (~ [\/ nProp tP nP P, nProp tQ nQ Q, nProp tR nR R | nProp tS nS S]) + = [/\ nP, nQ, nR & nS]. +Proof. by rewrite or4E notE and4E. Qed. +Canonical or4_nProp tP nP P tQ nQ Q tR nR R tS nS S := + ProperNegatedProp (@or4_nPropP tP nP P tQ nQ Q tR nR R tS nS S). + +(******************************************************************************) +(* The andRHS tertiary structure used to simplify (~ (P -> False)) to P, *) +(* both here for the imply_nProp instance and for bounded_forall_nProp below. *) +(* Because the andRHS instances match the Prop RETURNED by negatedProp they *) +(* do not need to expand definitions, hence do not need to use the wrapper *) +(* telescope pattern. *) +(******************************************************************************) + +Notation and_def binary P Q PQ := (PQ = if binary then P /\ Q else Q)%type. +Structure andRHS binary P Q PQ := + AndRHS {and_RHS :> Prop; _ : (P /\ and_RHS) = PQ; _ : and_def binary P Q PQ}. +Canonical unary_and_rhs P := @AndRHS false P P P True (andB.1.2 P) erefl. +Canonical binary_and_rhs P Q := @AndRHS true P Q (P /\ Q) Q erefl erefl. + +Fact imply_nPropP b P nQ PnQ tR (nR : andRHS b P nQ PnQ) R : + (~ (P -> nProp tR nR R)) = PnQ. +Proof. by rewrite -orNp {R}lax_notE; case: nR. Qed. +Canonical imply_nProp b P nQ PnQ tR nR R := + ProperNegatedProp (@imply_nPropP b P nQ PnQ tR nR R). + +Fact exists_nPropP A tP nP P : + (~ exists x : A, nPred tP nP P x) = (forall x : A, nP x). +Proof. +eqProp=> [nEP x | AnP [x]]; last by rewrite -/(~ _) lax_notE. +by rewrite -(lax_notE (P x)) => Px; case: nEP; exists x. +Qed. +Canonical exists_nProp A tP nP P := + ProperNegatedProp (@exists_nPropP A tP nP P). + +Fact exists2_nPropP A P tQ nQ Q : + (~ exists2 x : A, P x & nPred tQ nQ Q x) = (forall x : A, P x -> nQ x). +Proof. by rewrite exists2E notE. Qed. +Canonical exists2_nProp A P tQ nQ Q := + ProperNegatedProp (@exists2_nPropP A P tQ nQ Q). + +Fact inhabited_nPropP T : (~ inhabited T) = (T -> False). +Proof. by rewrite inhabitedE notE. Qed. +Canonical inhabited_nProp T := ProperNegatedProp (inhabited_nPropP T). + +(******************************************************************************) +(* Rule 2: forall negation, including (T : Type) -> P statements. *) +(* We use tertiary structures to recognize bounded foralls and simplify, *) +(* e.g., ~ forall x, P -> Q to exists2 x, P & ~ Q, or even exists x, P when *) +(* Q := False (as above for imply). *) +(* As forall_body_nProp and forall_body_proper_nProp are telescopes *) +(* over negatedProp and properNegatedProp, respectively, their instances *) +(* match instances declared above without the need to expand definitions, *) +(* hence do not need to use the wrapper telescope idiom. *) +(******************************************************************************) + +Structure negatedForallBody bounded P nQ tR nR := NegatedForallBody { + negated_forall_body :> negatedProp tR nR; _ : and_def bounded P nQ nR}. +Structure properNegatedForallBody b P nQ nR := ProperNegatedForallBody { + proper_negated_forall_body :> properNegatedProp nR; _ : and_def b P nQ nR}. +Notation nBody b P nQ t nR x := (negatedForallBody b (P x) (nQ x) t (nR x)). + +(******************************************************************************) +(* The explicit argument to fun_if is a workaround for a bug in the Coq *) +(* unification code that prevents default instances from ever matching match *) +(* constructs. Furthermore rewriting with ifE would not work here, because *) +(* the if_expr definition would be expanded by the eta expansion needed to *) +(* match the exists_nProp rule. *) +(******************************************************************************) + +Fact forall_nPropP A b P nQ tR nR (R : forall x, nBody b P nQ tR nR x) : + (~ forall x : A, R x) = if b then exists2 x, P x & nQ x else exists x, nQ x. +Proof. +rewrite exists2E -(fun_if (fun P => exists x, idfun P x)) notI /=; congr not. +apply/generic_forall_extensionality=> x; rewrite if_arg lax_notI. +by case: (R x) => _ <-. +Qed. +Canonical forall_nProp A b P nQ tR nR (R : forall x, nBody b P nQ tR nR x) := + @NegatedProp false _ (wrap2Prop (forall x : A, R x)) (forall_nPropP R). + +Fact proper_nBodyP b P nQ nR : + properNegatedForallBody b P nQ nR -> and_def b P nQ nR. +Proof. by case. Qed. +Canonical proper_nBody b P nQ nR R := + let def_nR := @proper_nBodyP b P nQ nR R in + @NegatedForallBody b P nQ false nR (proper_nProp R) def_nR. +Canonical nonproper_nBody tP nP P := + @NegatedForallBody false True nP tP nP P erefl. + +Fact andRHS_def b P Q PQ : andRHS b P Q PQ -> and_def b P Q PQ. +Proof. by case. Qed. +Canonical bounded_nBody b P nQ PnQ tR nR R := + ProperNegatedForallBody (@imply_nProp b P nQ PnQ tR nR R) (andRHS_def nR). +Canonical unbounded_nBody nQ Q := + @ProperNegatedForallBody false True nQ nQ Q erefl. + +(******************************************************************************) +(* The properNegatedProp instance that handles boolean statements. We use *) +(* two tertiary structures to handle positive and negative boolean statements *) +(* so that the contra tactic below will mostly subsume the collection of *) +(* contraXX lemmas in ssrbool and eqtype. *) +(* We only match manifest ~~ connectives, the true and false constants, *) +(* and the ==, <=%N, and <%N predicates. In particular we do not use de *) +(* Morgan laws to push boolean negation into connectives, as we did above for *) +(* Prop connectives. It will be up to the user to use rewriting to put the *) +(* negated statement in its desired shape. *) +(******************************************************************************) + +Structure negatedBool nP := + NegatedBool {negated_bool :> bool; _ : (~ negated_bool) = nP}. +Structure positedBool P := + PositedBool {posited_bool :> bool; _ : is_true posited_bool = P}. + +Local Fact is_true_nPropP nP (b : negatedBool nP) : (~ b) = nP. +Proof. by case: b. Qed. +Canonical is_true_nProp nP b := ProperNegatedProp (@is_true_nPropP nP b). + +Local Fact true_negP : (~ true) = False. Proof. by eqProp. Qed. +Local Fact true_posP : (true : Prop) = True. Proof. by eqProp. Qed. +Local Fact false_negP : (~ false) = True. Proof. by eqProp. Qed. +Local Fact false_posP : (false : Prop) = False. Proof. by eqProp. Qed. +Canonical true_neg := NegatedBool true_negP. +Canonical true_pos := PositedBool true_posP. +Canonical false_neg := NegatedBool false_negP. +Canonical false_pos := PositedBool false_posP. + +Local Fact id_negP (b : bool) : (~ b) = ~~ b. Proof. exact/reflect_eq/negP. Qed. +Canonical id_neg b := NegatedBool (id_negP b). +Canonical id_pos (b : bool) := @PositedBool b b erefl. + +Local Fact negb_negP P (b : positedBool P) : (~ ~~ b) = P. +Proof. by rewrite (reflect_eq negP) negbK; case: b. Qed. +Canonical negb_neg P b := NegatedBool (@negb_negP P b). +Local Fact negb_posP nP (b : negatedBool nP) : (~~ b = nP :> Prop). +Proof. by rewrite -(reflect_eq negP) notE. Qed. +Canonical negb_pos nP b := PositedBool (@negb_posP nP b). + +(******************************************************************************) +(* We use a tertiary structure to handle the negation of nat comparisons, and *) +(* simplify ~ m <= n to n < m, and ~ m < n to n <= m. As m < n is merely *) +(* notation for m.+1 <= n, we need to dispatch on the left hand side of the *) +(* comparison to perform the latter simplification. *) +(******************************************************************************) + +Structure negatedLeqLHS n lt_nm := + NegatedLeqLHS {negated_leq_LHS :> nat; _ : (n < negated_leq_LHS) = lt_nm}. +Canonical neg_ltn_LHS n m := @NegatedLeqLHS n (n <= m) m.+1 erefl. +Canonical neg_leq_LHS n m := @NegatedLeqLHS n (n < m) m erefl. + +Local Fact leq_negP n lt_nm (m : negatedLeqLHS n lt_nm) : (~ m <= n) = lt_nm. +Proof. by rewrite notE -ltnNge; case: m => /= m ->. Qed. +Canonical leq_neg n lt_nm m := NegatedBool (@leq_negP n lt_nm m). + +(******************************************************************************) +(* We use two tertiary structures to simplify negation of boolean constant *) +(* and decidable equalities, simplifying b <> true to ~~ b, b <> false to b, *) +(* x <> y to x != y, and ~ x != y to x = y. We do need to use the wrapper *) +(* telescope pattern here, as we want to simplify instances of x <> y when y *) +(* evaluates to true or false. Since we only need two rules (true/false RHS *) +(* or generic eqType RHS) we can use the generic wrapped type from ssrfun. *) +(* The actual matching of the true and false RHS is delegated to a fourth *) +(* level bool_eq_negation_rhs structure. Finally observe that the ~ x != y to *) +(* x = y simplification can be handled by a bool_affirmation instance. *) +(******************************************************************************) + +Structure neqRHS nP T x := + NeqRHS {neq_RHS :> wrapped T; _ : (x <> unwrap neq_RHS) = nP}. +Structure boolNeqRHS nP (x : bool) := + BoolNeqRHS {bool_neq_RHS; _ : (x <> bool_neq_RHS) = nP}. + +Local Fact eq_nPropP nP T x (y : neqRHS nP x) : (x <> unwrap y :> T) = nP. +Proof. by case: y. Qed. +Canonical eq_nProp nP T x y := ProperNegatedProp (@eq_nPropP nP T x y). + +Local Fact bool_neqP nP x y : (x <> @bool_neq_RHS nP x y) = nP. +Proof. by case: y. Qed. +Canonical bool_neq nP x y := @NeqRHS nP bool x (wrap _) (@bool_neqP nP x y). +Canonical true_neq nP b := BoolNeqRHS (@is_true_nPropP nP b). +Local Fact false_neqP P (b : positedBool P) : (b <> false :> bool) = P. +Proof. + admit. +Admitted. +Canonical false_neq P b := BoolNeqRHS (@false_neqP P b). + +Local Fact eqType_neqP (T : eqType) (x y : T) : (x <> y) = (x != y). +Proof. by rewrite (reflect_eq eqP) (reflect_eq negP). Qed. +Canonical eqType_neq (T : eqType) x y := + @NeqRHS (x != y) T x (Wrap y) (eqType_neqP x y). +Local Fact eq_op_posP (T : eqType) x y : (x == y :> T : Prop) = (x = y). +Proof. exact/esym/reflect_eq/eqP. Qed. +Canonical eq_op_pos T x y := PositedBool (@eq_op_posP T x y). + +(******************************************************************************) +(* The witnessedType structure provides conversion between Type and Prop in *) +(* goals; the conversion is mostly used in the Type-to-Prop direction, e.g., *) +(* as a preprocessing step preceding proof by contradiction (see absurd_not *) +(* below), but the Prop-to-Type direction is required for contraposition. *) +(* Thus witnessedType associates to a type T a "witness" proposition P *) +(* equivalent to the existence of an x of type T. As in a `{classical_logic} *) +(* context inhabited T is such a proposition, witnessedType can be understood *) +(* as providing simplification for inhabited T, much like negatedProp *) +(* provides simplification for ~ P for standard connectives and predicates. *) +(******************************************************************************) + +(******************************************************************************) +(* Similarly to negatedProp, witnessedType returns the witness proposition *) +(* via a projection argument P, but does not need to signal "trivial" *) +(* instances as the default value for P is nontrivial (namely, inhabited T), *) +(* while the "trivial" case where P = T is actually desireable and handled *) +(* by an extra top-priority rule. *) +(******************************************************************************) + +Structure witnessedType P := WitnessedType { + witnessed_Type :> wrappedType; _ : inhabited witnessed_Type = P}. +Structure properWitnessedType P := ProperWitnessedType { + proper_witnessed_Type :> Type; _ : inhabited proper_witnessed_Type = P}. +Local Notation wType P T := (unwrap_Type (@witnessed_Type P T)). +Local Notation wTycon P T x := (wType (P x) (T x)). + +(* User interface lemmas. *) + +Lemma witnessedType_intro {P : Prop} T : P -> wType P T. +Proof. by case: T => /= T <- /inhabited_witness. Qed. +Local Coercion witnessedType_intro : witnessedType >-> Funclass. + +Lemma witnessedType_elim {P} T : wType P T -> P. +Proof. by case: T => /= T <-. Qed. +Local Notation wTypeP := witnessedType_elim. + +(* Helper lemma and tactic. *) + +Local Fact eq_inhabited T (P : Prop) : (T -> P) -> (P -> T) -> inhabited T = P. +Proof. by move=> T_P P_T; eqProp=> [[/T_P] | /P_T]. Qed. +Ltac eqInh := apply: eq_inhabited. + +(* Rule 1: Prop goals are left as is. *) +Canonical Prop_wType P := + @WitnessedType P (wrap1Type P) (eq_inhabited (@id P) id). + +(* Rule 2: Specific type constructors (sigs, sums, and pairs) are delegated *) +(* to the secondary properWitnessedType structure. *) +Lemma proper_wTypeP P (T : properWitnessedType P) : inhabited T = P. +Proof. by case: T. Qed. +Canonical proper_wType P T := + @WitnessedType P (wrap2Type _) (@proper_wTypeP P T). + +(* Rule 3: Forall (and -> as a special case). *) +Local Fact forall_wTypeP A P T : + inhabited (forall x : A, wTycon P T x) = (forall x : A, P x) . +Proof. by do [eqInh=> allP x; have:= allP x] => [/wTypeP | /T]. Qed. +Canonical forall_wType A P T := + @WitnessedType _ (wrap3Type _) (@forall_wTypeP A P T). + +(* Rule 4: Default to inhabited if all else fails. *) +Canonical inhabited_wType T := @WitnessedType (inhabited T) (wrap4Type T) erefl. + +(* Specific proper_witnessedType instances. *) + +Local Fact void_wTypeP : inhabited void = False. Proof. by eqInh. Qed. +Canonical void_wType := ProperWitnessedType void_wTypeP. + +Local Fact unit_wTypeP : inhabited unit = True. Proof. by eqInh. Qed. +Canonical unit_wType := ProperWitnessedType unit_wTypeP. + +Local Fact pair_wTypeP P Q S T : inhabited (wType P S * wType Q T) = (P /\ Q). +Proof. by eqInh=> [[/wTypeP-isP /wTypeP] | [/S-x /T]]. Qed. +Canonical pair_wType P Q S T := ProperWitnessedType (@pair_wTypeP P Q S T). + +Local Fact sum_wTypeP P Q S T : inhabited (wType P S + wType Q T) = (P \/ Q). +Proof. by eqInh=> [[] /wTypeP | /decide_or[/S | /T]]; by [left | right]. Qed. +Canonical sum_wType P Q S T := ProperWitnessedType (@sum_wTypeP P Q S T). + +Local Fact sumbool_wTypeP P Q : inhabited ({P} + {Q}) = (P \/ Q). +Proof. by eqInh=> [[] | /decide_or[]]; by [left | right]. Qed. +Canonical sumbool_wType P Q := ProperWitnessedType (@sumbool_wTypeP P Q). + +Local Fact sumor_wTypeP P Q T : inhabited (wType P T + {Q}) = (P \/ Q). +Proof. by eqInh=> [[/wTypeP|] | /decide_or[/T|]]; by [left | right]. Qed. +Canonical sumor_wType P Q T := ProperWitnessedType (@sumor_wTypeP P Q T). + +Local Fact sig1_wTypeP T P : inhabited {x : T | P x} = (exists x : T, P x). +Proof. by eqInh=> [[x Px] | /cid//]; exists x. Qed. +Canonical sig1_wType T P := ProperWitnessedType (@sig1_wTypeP T P). + +Local Fact sig2_wTypeP T P Q : + inhabited {x : T | P x & Q x} = exists2 x : T, P x & Q x. +Proof. by eqInh=> [[x Px Qx] | /cid2//]; exists x. Qed. +Canonical sig2_wType T P Q := ProperWitnessedType (@sig2_wTypeP T P Q). + +Local Fact sigT_wTypeP A P T : + inhabited {x : A & wTycon P T x} = (exists x : A, P x). +Proof. by eqInh=> [[x /wTypeP] | /cid[x /T]]; exists x. Qed. +Canonical sigT_wType A P T := ProperWitnessedType (@sigT_wTypeP A P T). + +Local Fact sigT2_wTypeP A P Q S T : + inhabited {x : A & wTycon P S x & wTycon Q T x} = (exists2 x : A, P x & Q x). +Proof. by eqInh=> [[x /wTypeP-Px /wTypeP] | /cid2[x /S-y /T]]; exists x. Qed. +Canonical sigT2_wType A P Q S T := + ProperWitnessedType (@sigT2_wTypeP A P Q S T). + +(******************************************************************************) +(* The witnessProp structure provides for conversion of some Prop *) +(* assumptions to Type values with some constructive contents, e.g., convert *) +(* a P \/ Q assumption to a {P} + {Q} sumbool value. This is not the same as *) +(* the forward direction of witnessedType, because instances here match the *) +(* Prop statement: witness_Prop find a T such that P -> T while witnessedType *) +(* finds a P such that P -> T (and T -> P for the converse direction). *) +(******************************************************************************) + +(******************************************************************************) +(* The implementation follows the wrapper telescope pattern similarly to *) +(* negatedProp, with three rules, one for Prop constructors with proper *) +(* constructive contents, one for forall propositions (also with proper *) +(* constructive contents) and one default rule that just returns P : Prop as *) +(* is (thus, with no other contents except the provability of P). *) +(* The witnessProp structure also uses projection parameters to return the *) +(* inferred Type T together with a bool 'trivial' flag that is set when the *) +(* trivial rule is used. Here, however, this flag is used in both directions: *) +(* the 'witness' view forces it to false to prevent trivial instances, but *) +(* the flag is also used to fine tune the choice of T, selecting between *) +(* sum, sumor, and sumbool, between sig and sigT, and sig2 and sigT2. This *) +(* relies on the fact that the tactic engine will eagerly iota reduce the *) +(* returned type, so that the user will never see the conditionals specified *) +(* in the proper_witness_Prop instances. *) +(* However, it would not be possible to construct the specialised types *) +(* for trivial witnesses (e.g., {P} + {Q}) using the types returned by *) +(* witnessProp instances, since thes are in Type, and the information that *) +(* they are actully in Prop has been lost. This is solved by returning an *) +(* additional Prop P0 that is a copy of the matched Prop P when *) +(* trivial = true. (We put P0 = True when trivial = false, as we only need to *) +(* ensure P -> P0.) *) +(* Caveat: although P0 should in principle be the last parameter of *) +(* witness_Prop, and we use this order for the wProp and wPred projector *) +(* local notation, it is important to put P0 BEFORE T, to circumvent an *) +(* incompleteness in Coq's implementation of higher-order pattern unification *) +(* that would cause the trivial rule to fail for the body of an exists. *) +(* In such a case the rule needs to unify (1) ?P0 x ~ ?P and (2) ?T x ~ ?P *) +(* for some type A some x : A in the context of ?P, but not ?P0 nor ?T. This *) +(* succeeds easily if (1) is performed before (2), setting ?P := ?P0 x and *) +(* ?T := ?P0, but if (2) is attempted first Coq tries to perform ?P := ?T x, *) +(* which fails Type/Prop universe constraints, and then fails outright, *) +(* instead of using pattern unification to solve (2) as ?P := ?Q x, ?T := ?Q *) +(* for a fresh ?Q : A -> Prop. *) +(******************************************************************************) + +Structure witnessProp (trivial : bool) (P0 : Prop) (T : Type) := + WitnessProp {witness_Prop :> wrappedProp; _ : witness_Prop -> T * P0}. +Structure properWitnessProp T := + ProperWitnessProp {proper_witness_Prop :> Prop; _ : proper_witness_Prop -> T}. + +Local Notation wProp t T P0 P := (unwrap_Prop (@witness_Prop t P0 T P)). +Local Notation wPred t T P0 P x := (wProp t (T x) (P0 x) (P x)). + +Local Fact wPropP t T P0 P : wProp t T P0 P -> T * P0. Proof. by case: P. Qed. +Lemma lax_witness {t T P0 P} : move_view (wProp t T P0 P) T. +Proof. by split=> /wPropP[]. Qed. +Definition witness {T P0 P} := @lax_witness false T P0 P. + +(* Rule 1: proper instances (except forall), delegated to an auxiliary *) +(* structures. *) +Local Fact proper_wPropP T P : wrap1Prop (@proper_witness_Prop T P) -> T * True. +Proof. by case: P => _ P_T {}/P_T. Qed. +Canonical proper_wProp T P := WitnessProp false (@proper_wPropP T P). + +(* Rule 2: forall types (including implication); as only proper instances are *) +(* allowed, we set trivial = false for the recursive body instance. *) +Local Fact forall_wPropP A T P0 P : + wrap2Prop (forall x : A, wPred false T P0 P x) -> (forall x, T x) * True. +Proof. by move=> P_A; split=> // x; have /witness := P_A x. Qed. +Canonical forall_wProp A T P0 P := WitnessProp false (@forall_wPropP A T P0 P). + +(* Rule 3: trivial (proof) self-witness. *) +Canonical trivial_wProp P := + WitnessProp true (fun p : wrap3Prop P => (p, p) : P * P). + +(* Specific proper_witnesss_Prop instances. *) + +Canonical inhabited_wProp T := ProperWitnessProp (@inhabited_witness T). + +(******************************************************************************) +(* Conjunctions P /\ Q are a little delicate to handle, as we should not *) +(* produce a proper instance (and thus fail) if neither P nor Q is proper. *) +(* We use a tertiary structure for this : nand_bool b, which has instances *) +(* only for booleans b0 such that ~~ (b0 && b). We allow the witness_Prop *) +(* instance for P to return an arbitrary 'trivial' flag s, but then force the *) +(* 'trivial' flag for Q to be an instance of nand_bool s. *) +(******************************************************************************) + +Structure nandBool b := NandBool {nand_bool :> bool; _ : ~~ (nand_bool && b)}. +Canonical nand_false_bool b := @NandBool b false isT. +Canonical nand_true_bool := @NandBool false true isT. + +Local Fact and_wPropP s S P0 P (t : nandBool s) T Q0 Q : + wProp s S P0 P /\ wProp t T Q0 Q -> S * T. +Proof. by case=> /lax_witness-x /lax_witness. Qed. +Canonical and_wProp s S P0 P t T Q0 Q := + ProperWitnessProp (@and_wPropP s S P0 P t T Q0 Q). + +(* The first : Type cast ensures the return type of the inner 'if' is not *) +(* incorrectly set to 'Set', while the second merely ensures the S + T *) +(* notation is resolved correctly). *) +Local Fact or_wPropP s S P0 P t T Q0 Q : + wProp s S P0 P \/ wProp t T Q0 Q -> + if t then if s then {P0} + {Q0} : Type else S + {Q0} else S + T : Type. +Proof. +by case: s t => -[] in P Q *; (case/decide_or=> /wPropP[]; [left | right]). +Qed. +Canonical or_wProp s S P0 P t T Q0 Q := + ProperWitnessProp (@or_wPropP s S P0 P t T Q0 Q). + +Local Fact exists_wPropP A t T P0 P : + (exists x : A, wPred t T P0 P x) -> if t then {x | P0 x} else {x & T x}. +Proof. by case/cid => x /wPropP[]; case t; exists x. Qed. +Canonical exists_wProp A t T P0 P := + ProperWitnessProp (@exists_wPropP A t T P0 P). + +(* Note the expanded expression for st = s && t, which will be reduced to *) +(* true or false by iota reduction when s and t are known. *) +Local Fact exists2_wPropP A s S P0 P t T Q0 Q (st := if s then t else false) : + (exists2 x : A, wPred s S P0 P x & wPred t T Q0 Q x) -> + if st then {x | P0 x & Q0 x} else {x : A & S x & T x}. +Proof. by case/cid2=> x /wPropP[P0x y] /wPropP[]; case: ifP; exists x. Qed. +Canonical exists2_wProp A s S P0 P t T Q0 Q := + ProperWitnessProp (@exists2_wPropP A s S P0 P t T Q0 Q). + +(******************************************************************************) +(* User lemmas and tactics for proof by contradiction and contraposition. *) +(******************************************************************************) + +(******************************************************************************) +(* Helper lemmas: *) +(* push_goal_copy makes a copy of the goal that can then be matched with *) +(* witnessedType and negatedProp instances to generate a contradiction *) +(* assuption, without disturbing the original form of the goal. *) +(* assume_not_with turns the copy generated by push_identity into an *) +(* equivalent negative assumption, which can then be simplified using the *) +(* lax_notP and lax_witness views. *) +(* absurd and absurdW replace the goal with False; absurdW does this under *) +(* an assumption, and is used to weaken proof-by-assuming-negation to *) +(* proof-by-contradiction. *) +(* contra_Type converts an arbitrary function goal (with assumption and *) +(* conclusion in Type) to an equivalent contrapositive Prop implication. *) +(* contra_notP simplifies a contrapositive ~ Q -> ~ P goal using *) +(* negatedProp instances. *) +(******************************************************************************) + +Local Fact push_goal_copy {T} : ((T -> T) -> T) -> T. Proof. exact. Qed. +Local Fact assume_not_with {R P T} : (~ P -> R) -> (wType P T -> R) -> R. +Proof. by move=> nP_T T_R; have [/T|] := asboolP P. Qed. + +Local Fact absurdW {S T} : (S -> False) -> S -> T. Proof. by []. Qed. + +Local Fact contra_Type {P Q S T} : (~ Q -> ~ P) -> wType P S -> wType Q T. +Proof. by rewrite implyNN => P_Q /wTypeP/P_Q/T. Qed. + +Local Fact contra_notP tP tQ (nP nQ : Prop) P Q : + (nP -> nQ) -> (~ nProp tP nP P -> ~ nProp tQ nQ Q). +Proof. by rewrite 2!lax_notE. Qed. + +End Internals. +Import Internals. +Canonical TypeForall. +Canonical PropForall. +Canonical SetForall. +Canonical wrap1Prop. +Canonical wrap1Type. +Canonical proper_nProp. +Canonical trivial_nProp. +Canonical True_nProp. +Canonical False_nProp. +Canonical not_nProp. +Canonical and_nProp. +Canonical and3_nProp. +Canonical and4_nProp. +Canonical and5_nProp. +Canonical or_nProp. +Canonical or3_nProp. +Canonical or4_nProp. +Canonical unary_and_rhs. +Canonical binary_and_rhs. +Canonical imply_nProp. +Canonical exists_nProp. +Canonical exists2_nProp. +Canonical inhabited_nProp. +Canonical forall_nProp. +Canonical proper_nBody. +Canonical nonproper_nBody. +Canonical bounded_nBody. +Canonical unbounded_nBody. +Canonical is_true_nProp. +Canonical true_neg. +Canonical true_pos. +Canonical false_neg. +Canonical false_pos. +Canonical id_neg. +Canonical id_pos. +Canonical negb_neg. +Canonical negb_pos. +Canonical neg_ltn_LHS. +Canonical neg_leq_LHS. +Canonical leq_neg. +Canonical eq_nProp. +Canonical bool_neq. +Canonical true_neq. +Canonical false_neq. +Canonical eqType_neq. +Canonical eq_op_pos. +Canonical Prop_wType. +Canonical proper_wType. +Canonical forall_wType. +Canonical inhabited_wType. +Canonical void_wType. +Canonical unit_wType. +Canonical pair_wType. +Canonical sum_wType. +Canonical sumbool_wType. +Canonical sumor_wType. +Canonical sig1_wType. +Canonical sig2_wType. +Canonical sigT_wType. +Canonical sigT2_wType. +Canonical proper_wProp. +Canonical forall_wProp. +Canonical trivial_wProp. +Canonical inhabited_wProp. +Canonical nand_false_bool. +Canonical nand_true_bool. +Canonical and_wProp. +Canonical or_wProp. +Canonical exists_wProp. +Canonical exists2_wProp. + +(******************************************************************************) +(* Lemma and tactic assume_not: add a goal negation assumption. The tactic *) +(* also works for goals in Type, simplifies the added assumption, and *) +(* exposes its top-level constructive content. *) +(******************************************************************************) + +Lemma assume_not {P} : (~ P -> P) -> P. Proof. by rewrite implyNp orB. Qed. +Ltac assume_not := + apply: Internals.push_goal_copy; apply: Internals.assume_not_with + => /Internals.lax_notP-/Internals.lax_witness. + +(******************************************************************************) +(* Lemma and tactic absurd_not: proof by contradiction. Same as assume_not, *) +(* but the goal is erased and replaced by False. *) +(* Caveat: absurd_not cannot be used as a move/ view because its conclusion *) +(* is indeterminate. The more general notP defined above can be used instead. *) +(******************************************************************************) +Lemma absurd_not {P} : (~ P -> False) -> P. Proof. by move/Internals.notP. Qed. +Ltac absurd_not := assume_not; apply: Internals.absurdW. + +(******************************************************************************) +(* Tactic contra: proof by contraposition. Assume the negation of the goal *) +(* conclusion, and prove the negation of a given assumption. The defective *) +(* form contra (which can also be written contrapose) expects the assumption *) +(* to be pushed on the goal which thus has the form assumption -> conclusion. *) +(* As with assume_not, contra allows both assumption and conclusion to be *) +(* in Type, simplifies the negation of both assumption and conclusion, and *) +(* exposes the constructive contents of the negated conclusion. *) +(* The contra tactic also supports a limited form of the ':' discharge *) +(* pseudo tactical, whereby contra: means move: ; contra. *) +(* The only allowed are one term, possibly preceded by a clear *) +(* switch. *) +(******************************************************************************) + +Ltac contrapose := + apply: Internals.contra_Type; + apply: Internals.contra_notP => /Internals.lax_witness. +Tactic Notation "contra" := contrapose. +Tactic Notation "contra" ":" constr(H) := move: (H); contra. +Tactic Notation "contra" ":" ident(H) := move: H; contra. +Tactic Notation "contra" ":" "{" hyp_list(Hs) "}" constr(H) := + contra: (H); clear Hs. +Tactic Notation "contra" ":" "{" hyp_list(Hs) "}" ident(H) := + contra: H; clear Hs. +Tactic Notation "contra" ":" "{" "-" "}" constr(H) := contra: (H). + +(******************************************************************************) +(* Lemma and tactic absurd: proof by contradiction. The defective form of the *) +(* lemma simply replaces the entire goal with False (just as the Ltac *) +(* exfalso), leaving the user to derive a contradiction from the assumptions. *) +(* The ':' form absurd: replaces the goal with the negation of the *) +(* (single) (as with contra:, a clear switch is also allowed. *) +(* Finally the Ltac absurd term form is also supported. *) +(******************************************************************************) + +Lemma absurd T : False -> T. Proof. by []. Qed. +Tactic Notation (at level 0) "absurd" := apply absurd. +Tactic Notation (at level 0) "absurd" constr(P) := have []: ~ P. +Tactic Notation "absurd" ":" constr(H) := absurd; contra: (H) => _. +Tactic Notation "absurd" ":" ident(H) := absurd; contra: H => _. +Tactic Notation "absurd" ":" "{" hyp_list(Hs) "}" constr(H) := + absurd: (H) => _; clear Hs. +Tactic Notation "absurd" ":" "{" hyp_list(Hs) "}" ident(H) := + absurd: H => _; clear Hs. diff --git a/classical/fsbigop.v b/classical/fsbigop.v index 2eb96a6ce..18b4d06fb 100644 --- a/classical/fsbigop.v +++ b/classical/fsbigop.v @@ -1,14 +1,17 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval finmap. -Require Import mathcomp_extra boolp classical_sets functions cardinality. +From mathcomp Require Import mathcomp_extra boolp classical_sets functions. +From mathcomp Require Import cardinality. -(******************************************************************************) -(* Finitely-supported big operators *) +(**md**************************************************************************) +(* # Finitely-supported big operators *) (* *) +(* ``` *) (* finite_support idx D F := D `&` F @^-1` [set~ idx] *) (* \big[op/idx]_(i \in A) F i == iterated application of the operator op *) (* with neutral idx over finite_support idx A F *) (* \sum_(i \in A) F i == iterated addition, in ring_scope *) +(* ``` *) (* *) (******************************************************************************) @@ -275,7 +278,7 @@ Proof. by move=> Afin; apply: __deprecated__full_fsbigID; apply: finite_setIl. Q Arguments fsbigID {R idx op I} B. #[deprecated(note="Use fsbigID instead")] -Notation full_fsbigID := __deprecated__full_fsbigID. +Notation full_fsbigID := __deprecated__full_fsbigID (only parsing). Lemma fsbigU (R : Type) (idx : R) (op : Monoid.com_law idx) (I : choiceType) (A B : set I) (F : I -> R) : @@ -316,8 +319,11 @@ have [->|a0] := eqVneq a zero. rewrite big_distrr [RHS](full_fsbigID (F @^-1` [set zero])); last first. apply: sub_finite_set finF => x /= [Px aFN0]. by split=> //; apply: contra_not aFN0 => ->; rewrite Monoid.simpm. -rewrite [X in plus X _](_ : _ = zero) ?Monoid.simpm; last first. - by rewrite fsbig1// => i [_ ->]; rewrite Monoid.simpm. +set b0 := bigop _ _ _. +set b1 := bigop _ _ _. +set b2 := bigop _ _ _. +rewrite (_ : b1 = zero) ?Monoid.simpm; last first. + by rewrite /b1 fsbig1// => i [_ ->]; rewrite Monoid.simpm. apply/esym/fsbig_fwiden => //. by move=> x [Px Fx0]; rewrite /= in_finite_support// inE. move=> i []; rewrite /preimage/= in_finite_support //. @@ -421,9 +427,9 @@ Arguments fsbig_image {R idx op I J} _ _. Arguments __deprecated__reindex_inside {R idx op I J} _ _. Arguments reindex_fsbigT {R idx op I J} _ _. #[deprecated(note="use reindex_fsbig, fsbig_image or reindex_fsbigT instead")] -Notation reindex_inside := __deprecated__reindex_inside. +Notation reindex_inside := __deprecated__reindex_inside (only parsing). #[deprecated(note="use reindex_fsbigT instead")] -Notation reindex_inside_setT := reindex_fsbigT. +Notation reindex_inside_setT := reindex_fsbigT (only parsing). Lemma fsbigN1 (R : eqType) (idx : R) (op : Monoid.com_law idx) (T1 T2 : choiceType) (Q : set T2) (f : T1 -> T2 -> R) (x : T1) : diff --git a/classical/functions.v b/classical/functions.v index e8a79c8d1..ace873725 100644 --- a/classical/functions.v +++ b/classical/functions.v @@ -1,18 +1,19 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From mathcomp Require Import all_ssreflect finmap ssralg ssrnum ssrint rat. From HB Require Import structures. -Require Import mathcomp_extra boolp classical_sets. +From mathcomp Require Import mathcomp_extra boolp classical_sets. Add Search Blacklist "__canonical__". Add Search Blacklist "__functions_". Add Search Blacklist "_factory_". Add Search Blacklist "_mixin_". -(******************************************************************************) -(* Theory of functions *) +(**md**************************************************************************) +(* # Theory of functions *) (* *) -(* This file provides a theory of functions whose domain and codomain are *) -(* represented by sets. *) +(* This file provides a theory of functions $f : A\to B$ whose domain $A$ *) +(* and codomain $B$ are represented by sets. *) (* *) +(* ``` *) (* set_fun A B f == f : aT -> rT is a function with domain *) (* A : set aT and codomain B : set rT *) (* set_surj A B f == f is surjective *) @@ -44,12 +45,14 @@ Add Search Blacklist "_mixin_". (* {splitsurj A >-> B} *) (* 'inj_ f == proof of {in A &, injective f} where f has type *) (* {splitinj A >-> _} *) +(* ``` *) (* *) +(* ``` *) (* funin A f == alias for f : aT -> rT, with A : set aT *) (* [fun f in A] == the function f from the set A to the set f @` A*) (* 'split_ d f == partial injection from aT : Type to rt : Type; *) (* f : aT -> rT, d : rT -> aT *) -(* split := 'split_point *) +(* split := 'split_(fun=> point) *) (* @to_setT T == function that associates to x : T a dependent *) (* pair of x with a proof that x belongs to setT *) (* (i.e., the type set_type [set: T]) *) @@ -77,9 +80,11 @@ Add Search Blacklist "_mixin_". (* A and B are intended to be the ranges of f and g *) (* 'pinv_ d A f == inverse of the function [fun f in A] over *) (* f @` A, function d outside of f @` A *) -(* pinv := notation for 'pinv_point *) +(* pinv := notation for 'pinv_(fun=> point) *) +(* ``` *) (* *) -(* * Function restriction: *) +(* ## Function restriction *) +(* ``` *) (* patch d A f == "partial function" that behaves as the function *) (* f over the set A and as the function d otherwise *) (* restrict D f := patch (fun=> point) D f *) @@ -105,11 +110,14 @@ Add Search Blacklist "_mixin_". (* valLfun_ v A B f := [fun of valL_ f] with f : {fun [set: A] >-> B} *) (* valL := 'valL_ point *) (* valLRfun v := 'valLfun_ v \o valR_fun *) +(* ``` *) (* *) +(* ``` *) (* Section function_space == canonical ringType and lmodType *) (* structures for functions whose range is *) (* a ringType, comRingType, or lmodType. *) (* fctE == multi-rule for fct *) +(* ``` *) (* *) (******************************************************************************) @@ -222,10 +230,10 @@ Definition set_inj := {in A &, injective f}. Definition set_bij := [/\ set_fun, set_inj & set_surj]. End MainProperties. -HB.mixin Record IsFun {aT rT} (A : set aT) (B : set rT) (f : aT -> rT) := +HB.mixin Record isFun {aT rT} (A : set aT) (B : set rT) (f : aT -> rT) := { funS : set_fun A B f }. HB.structure Definition Fun {aT rT} (A : set aT) (B : set rT) := - { f of IsFun _ _ A B f }. + { f of isFun _ _ A B f }. Notation "{ 'fun' A >-> B }" := (@Fun.type _ _ A B) : form_scope. Notation "[ 'fun' 'of' f ]" := [the {fun _ >-> _} of f : _ -> _] : form_scope. @@ -239,7 +247,7 @@ Definition phant_oinv aT rT (f : {oinv aT >-> rT}) Notation "''oinv_' f" := (@phant_oinv _ _ _ (Phantom (_ -> _) f%FUN)). HB.structure Definition OInvFun aT rT A B := - {f of OInv aT rT f & IsFun aT rT A B f}. + {f of OInv aT rT f & isFun aT rT A B f}. Notation "{ 'oinvfun' A >-> B }" := (@OInvFun.type _ _ A B) : type_scope. Notation "[ 'oinvfun' 'of' f ]" := [the {oinvfun _ >-> _} of f : _ -> _] : form_scope. @@ -258,13 +266,17 @@ HB.end. HB.structure Definition Inversible aT rT := {f of Inv aT rT f}. Notation "{ 'inv' aT >-> rT }" := (@Inversible.type aT rT) : type_scope. Notation "[ 'inv' 'of' f ]" := [the {inv _ >-> _} of f : _ -> _] : form_scope. -Definition phant_inv aT rT (f : {inv aT >-> rT}) of phantom (_ -> _) f := @inv _ _ f. -Notation "f ^-1" := (@inv _ _ f%FUN) (only printing) : fun_scope. +Definition phant_inv aT rT (f : {inv aT >-> rT}) of phantom (_ -> _) f := + @inv _ _ f. Notation "f ^-1" := (@inv _ _ f%function) (only printing) : function_scope. +Notation "f ^-1" := + (@phant_inv _ _ _ (Phantom (_ -> _) f%function)) : function_scope. +(* TODO: remove the following notations in fun_scope *) +Notation "f ^-1" := (@inv _ _ f%FUN) (only printing) : fun_scope. Notation "f ^-1" := (@phant_inv _ _ _ (Phantom (_ -> _) f%FUN)) : fun_scope. -Notation "f ^-1" := (@phant_inv _ _ _ (Phantom (_ -> _) f%function)) : function_scope. -HB.structure Definition InvFun aT rT A B := {f of Inv aT rT f & IsFun aT rT A B f}. +HB.structure Definition InvFun aT rT A B := + {f of Inv aT rT f & isFun aT rT A B f}. Notation "{ 'invfun' A >-> B }" := (@InvFun.type _ _ A B) : type_scope. Notation "[ 'invfun' 'of' f ]" := [the {invfun _ >-> _} of f : _ -> _] : form_scope. @@ -304,7 +316,8 @@ Notation "[ 'splitsurj' 'of' f ]" := HB.structure Definition SplitSurjFun aT rT A B := {f of @SplitSurj aT rT A B f & @Fun _ _ A B f}. -Notation "{ 'splitsurjfun' A >-> B }" := (@SplitSurjFun.type _ _ A B) : type_scope. +Notation "{ 'splitsurjfun' A >-> B }" := + (@SplitSurjFun.type _ _ A B) : type_scope. Notation "[ 'splitsurjfun' 'of' f ]" := [the {splitsurjfun _ >-> _} of f : _ -> _] : form_scope. @@ -329,7 +342,7 @@ Notation "[ 'splitinj' 'of' f ]" := [the {splitinj _ >-> _} of f : _ -> _] : form_scope. HB.structure Definition SplitInjFun aT rT (A : set aT) (B : set rT) := - {f of @SplitInj _ rT A f & @IsFun _ _ A B f}. + {f of @SplitInj _ rT A f & @isFun _ _ A B f}. Notation "{ 'splitinjfun' A >-> B }" := (@SplitInjFun.type _ _ A B) : type_scope. Notation "[ 'splitinjfun' 'of' f ]" := [the {splitinjfun _ >-> _} of f : _ -> _] : form_scope. @@ -344,10 +357,8 @@ HB.structure Definition SplitBij {aT rT} {A : set aT} {B : set rT} := Notation "{ 'splitbij' A >-> B }" := (@SplitBij.type _ _ A B) : type_scope. Notation "[ 'splitbij' 'of' f ]" := [the {splitbij _ >-> _} of f] : form_scope. -(** begin hide *) (* Hint View for move / Inversible.sort inv | 2. *) (* Hint View for apply / Inversible.sort inv | 2. *) -(** end hide *) Module ShortFunSyntax. Notation "A ~> B" := {fun A >-> B} (at level 70) : type_scope. @@ -367,9 +378,9 @@ Notation "A <~> B" := {bij A >-> B} (at level 70) : type_scope. Notation "A <<~> B" := {splitbij A >-> B} (at level 70) : type_scope. End ShortFunSyntax. -(**********) -(* Theory *) -(**********) +(**md**************************************************************************) +(* ## Theory *) +(******************************************************************************) Definition phant_funS aT rT (A : set aT) (B : set rT) (f : {fun A >-> B}) of phantom (_ -> _) f := @funS _ _ _ _ f. @@ -389,7 +400,7 @@ Definition mem_fun aT rT (A : set aT) (B : set rT) (f : {fun A >-> B}) := Definition phant_mem_fun aT rT (A : set aT) (B : set rT) (f : {fun A >-> B}) of phantom (_ -> _) f := homo_setP.2 (@funS _ _ _ _ f). -Notation "'mem_fun_ f" := (phant_funS (Phantom (_ -> _) f)) +Notation "'mem_fun_ f" := (phant_mem_fun (Phantom (_ -> _) f)) (at level 8, f at level 2) : form_scope. Lemma some_inv {aT rT} (f : {inv aT >-> rT}) x : Some (f^-1 x) = 'oinv_f x. @@ -474,22 +485,18 @@ Definition phant_funK aT rT (A : set aT) (f : {splitinj A >-> rT}) Notation "'funK_ f" := (phant_funK (Phantom (_ -> _) f)) : form_scope. #[global] Hint Resolve funK : core. -(**********************) -(* Structure Equality *) -(**********************) +(** Structure Equality *) Lemma funP {aT rT} {A : set aT} {B : set rT} (f g : {fun A >-> B}) : f = g <-> f =1 g. Proof. case: f g => [f [[ffun]]] [g [[gfun]]]/=; split=> [[->//]|/funext eqfg]. rewrite eqfg in ffun *; congr {| Fun.sort := _; Fun.class := {| - Fun.functions_IsFun_mixin := {|IsFun.funS := _|}|}|}. + Fun.functions_isFun_mixin := {|isFun.funS := _|}|}|}. exact: Prop_irrelevance. Qed. -(************************) -(* Preliminary Builders *) -(************************) +(** Preliminary Builders *) HB.factory Record Inv_Can {aT rT} {A : set aT} (f : aT -> rT) of Inv _ _ f := { funK : {in A, cancel f f^-1} }. @@ -513,9 +520,7 @@ HB.builders Context {aT rT} {A : set aT} {B : set rT} (f : aT -> rT) HB.instance Definition _ := OInv_CanV.Build _ _ _ _ f oinvS oinvK. HB.end. -(*********************) -(* Trivial instances *) -(*********************) +(** Trivial instances *) Section OInverse. Context {aT rT : Type} {A : set aT} {B : set rT}. @@ -527,7 +532,7 @@ Lemma oinvV {f : {oinv aT >-> rT}} : 'oinv_('oinv_f) = omap f. Proof. by []. Qed. HB.instance Definition _ (f : {surj A >-> B}) := - IsFun.Build rT (option aT) B (some @` A) 'oinv_f oinvS. + isFun.Build rT (option aT) B (some @` A) 'oinv_f oinvS. Lemma surjoinv_inj_subproof (f : {surj A >-> B}) : OInv_Can _ _ B 'oinv_f. Proof. @@ -557,7 +562,7 @@ HB.instance Definition _ (f : {inv aT >-> rT}) := Inversible.copy inv f^-1. Lemma invV (f : {inv aT >-> rT}) : f^-1^-1 = f. Proof. by []. Qed. HB.instance Definition _ (f : {splitsurj A >-> B}) := - IsFun.Build rT aT B A f^-1 invS. + isFun.Build rT aT B A f^-1 invS. HB.instance Definition _ (f : {splitsurj A >-> B}) := Fun.copy inv f^-1. HB.instance Definition _ {f : {splitsurj A >-> B}} := Inv_Can.Build _ _ _ f^-1 'invK_f. @@ -581,7 +586,7 @@ Lemma some_canV_subproof : OInv_CanV _ _ A (some @` A) (@Some T). Proof. by split=> [x|x /set_mem] [a Aa <-]//=; exists a. Qed. HB.instance Definition _ := some_canV_subproof. -Lemma some_fun_subproof : IsFun _ _ A (some @` A) (@Some T). +Lemma some_fun_subproof : isFun _ _ A (some @` A) (@Some T). Proof. by split=> x; exists x. Qed. HB.instance Definition _ := some_fun_subproof. @@ -611,7 +616,7 @@ by split=> [b|b /set_mem] Bb/=; rewrite inv_oapp; case: oinvP => // x; exists x. Qed. HB.instance Definition _ f := oapp_surj_subproof f. -Lemma oapp_fun_subproof (f : {fun A >-> B}) : IsFun _ _ (some @` A) B (oapp f). +Lemma oapp_fun_subproof (f : {fun A >-> B}) : isFun _ _ (some @` A) B (oapp f). Proof. by split=> x [a Aa <-] /=; apply: funS. Qed. HB.instance Definition _ f := oapp_fun_subproof f. HB.instance Definition _ (f : {oinvfun A >-> B}) := Fun.on (oapp f). @@ -649,7 +654,7 @@ Section Composition. Context {aT rT sT} {A : set aT} {B : set rT} {C : set sT}. Local Lemma comp_fun_subproof (f : {fun A >-> B}) (g : {fun B >-> C}) : - IsFun _ _ A C (g \o f). + isFun _ _ A C (g \o f). Proof. by split => x /'funS_f; apply: funS. Qed. HB.instance Definition _ f g := comp_fun_subproof f g. @@ -712,7 +717,7 @@ Definition totalfun_ (A : set aT) (f : aT -> rT) := f. Context {A : set aT}. Local Notation totalfun := (totalfun_ A). HB.instance Definition _ (f : aT -> rT) := - IsFun.Build _ _ A setT (totalfun f) (fun _ _ => I). + isFun.Build _ _ A setT (totalfun f) (fun _ _ => I). HB.instance Definition _ (f : {inj A >-> rT}) := Inject.on (totalfun f). HB.instance Definition _ (f : {splitinj A >-> rT}) := SplitInj.on (totalfun f). HB.instance Definition _ (f : {surj A >-> [set: rT]}) := @@ -766,9 +771,7 @@ HB.instance Definition _ (f : {surjfun A >-> B}) := Fun.on (omap f). HB.instance Definition _ (f : {bij A >-> B}) := Fun.on (omap f). End Map. -(************) -(* Builders *) -(************) +(** Builders *) HB.factory Record CanV {aT rT} {A : set aT} {B : set rT} (f : aT -> rT) := { inv; invS : {homo inv : x / B x >-> A x}; invK : {in B, cancel inv f}; }. @@ -786,7 +789,7 @@ HB.factory Record OInv_Can2 {aT rT} {A : set aT} {B : set rT} (f : aT -> rT) of oinvK : {in B, ocancel 'oinv_f f}; }. HB.builders Context {aT rT} A B (f : aT -> rT) of OInv_Can2 _ _ A B f. - HB.instance Definition _ := IsFun.Build aT rT _ _ f funS. + HB.instance Definition _ := isFun.Build aT rT _ _ f funS. HB.instance Definition _ := OInv_Can.Build aT rT _ f funoK. HB.instance Definition _ := OInv_CanV.Build aT rT _ _ f oinvS oinvK. HB.end. @@ -818,7 +821,7 @@ HB.factory Record Inv_Can2 {aT rT} {A : set aT} {B : set rT} (f : aT -> rT) of invK : {in B, cancel f^-1 f}; }. HB.builders Context {aT rT} A B (f : aT -> rT) of Inv_Can2 _ _ A B f. - HB.instance Definition _ := IsFun.Build aT rT A B f funS. + HB.instance Definition _ := isFun.Build aT rT A B f funS. HB.instance Definition _ := Inv_Can.Build aT rT A f funK. HB.instance Definition _ := @Inv_CanV.Build aT rT A B f invS invK. HB.end. @@ -853,9 +856,7 @@ HB.builders Context {aT rT} f of BijTT aT rT f. (in1W (projT2 exg).1) (in1W (projT2 exg).2). HB.end. -(**********) -(* Fun in *) -(**********) +(** Fun in *) Section surj_oinv. Context {aT rT} {A : set aT} {B : set rT} {f : aT -> rT} (fsurj : set_surj A B f). @@ -912,7 +913,7 @@ Lemma set_fun_image : set_fun A (f @` A) f. Proof. exact/image_subP. Qed. HB.instance Definition _ := - @IsFun.Build _ _ _ _ (funin A f) set_fun_image. + @isFun.Build _ _ _ _ (funin A f) set_fun_image. HB.instance Definition _ : OCanV _ _ A (f @` A) (funin A f) := ((fun _ => id) : set_surj A (f @` A) f). @@ -923,9 +924,7 @@ Notation "[ 'fun' f 'in' A ]" := (funin A f) format "[ 'fun' f 'in' A ]") : function_scope. #[global] Hint Resolve set_fun_image : core. -(*********************) -(* Partial injection *) -(*********************) +(** Partial injection *) Section split. Context {aT rT} (A : set aT) (B : set rT). @@ -961,11 +960,9 @@ HB.instance Definition _ (f : {bij A >-> B}) := Surject.on (split f). End split. Notation "''split_' a" := (split_ a) : form_scope. -Notation split := 'split_point. +Notation split := 'split_(fun=> point). -(*****************) -(* More Builders *) -(*****************) +(** More Builders *) HB.factory Record Inj {aT rT} (A : set aT) (f : aT -> rT) := { inj : {in A &, injective f} }. @@ -1010,9 +1007,9 @@ HB.instance Definition _ (f : {inj A >-> rT}) := SurjFun_Inj.Build _ _ _ _ [fun f in A] 'inj_f. End Inverses. -(********************) -(* Simple Factories *) -(********************) +(**md**************************************************************************) +(* ## Simple Factories *) +(******************************************************************************) Section Pinj. Context {aT rT} {A : set aT} {f : aT -> rT} (finj : {in A &, injective f}). @@ -1024,7 +1021,7 @@ Section Pfun. Context {aT rT} {A : set aT} {B : set rT} {f : aT -> rT} (ffun : {homo f : x / A x >-> B x}). Let g : _ -> _ := f. -#[local] HB.instance Definition _ := IsFun.Build _ _ _ _ g ffun. +#[local] HB.instance Definition _ := isFun.Build _ _ _ _ g ffun. Lemma Pfun : {i : {fun A >-> B} | f = i}. Proof. by exists [fun of g]. Qed. End Pfun. @@ -1033,7 +1030,7 @@ Context {aT rT} {A : set aT} {B : set rT} {f : {inj A >-> rT}} (ffun : {homo f : x / A x >-> B x}). Let g : _ -> _ := f. #[local] HB.instance Definition _ := Inject.on g. -#[local] HB.instance Definition _ := IsFun.Build _ _ A B g ffun. +#[local] HB.instance Definition _ := isFun.Build _ _ A B g ffun. Lemma injPfun : {i : {injfun A >-> B} | f = i :> (_ -> _)}. Proof. by exists [injfun of g]. Qed. End injPfun. @@ -1063,7 +1060,7 @@ Context {aT rT} {A : set aT} {B : set rT} {f : {surj A >-> B}} (ffun : {homo f : x / A x >-> B x}). Let g : _ -> _ := f. #[local] HB.instance Definition _ := Surject.on g. -#[local] HB.instance Definition _ := IsFun.Build _ _ A B g ffun. +#[local] HB.instance Definition _ := isFun.Build _ _ A B g ffun. Lemma surjPfun : {s : {surjfun A >-> B} | f = s :> (_ -> _)}. Proof. by exists [surjfun of g]. Qed. End surjPfun. @@ -1105,26 +1102,22 @@ Proof. by move/in1W/(@funPsplitsurj _ _ _ _ [fun of totalfun f] [fun of totalfun g]). Qed. -(*************) -(* Instances *) -(*************) +(**md**************************************************************************) +(* ## Instances *) +(******************************************************************************) -(*************************************) -(* The identity is a split bijection *) -(*************************************) +(** The identity is a split bijection *) HB.instance Definition _ T A := @Can2.Build T T A A idfun idfun (fun x y => y) (fun x y => y) (fun _ _ => erefl) (fun _ _ => erefl). -(**********************************************************) -(* Iteration preserves Fun, Injectivity, and Surjectivity *) -(**********************************************************) +(** Iteration preserves Fun, Injectivity, and Surjectivity *) Section iter_inv. Context {aT} {A : set aT}. -Local Lemma iter_fun_subproof n (f : {fun A >-> A}) : IsFun _ _ A A (iter n f). -Proof. +Local Lemma iter_fun_subproof n (f : {fun A >-> A}) : isFun _ _ A A (iter n f). +Proof. split => x; elim: n => // n /[apply] ?; apply/(fun_image_sub f). by exists (iter n f x). Qed. @@ -1133,7 +1126,7 @@ HB.instance Definition _ n f := iter_fun_subproof n f. Section OInv. Context {f : {oinv aT >-> aT}}. -HB.instance Definition _ n := OInv.Build _ _ (iter n f) +HB.instance Definition _ n := OInv.Build _ _ (iter n f) (iter n (obind 'oinv_f) \o some). Lemma oinv_iter n : 'oinv_(iter n f) = iter n (obind 'oinv_f) \o some. Proof. by []. Qed. @@ -1152,9 +1145,9 @@ Lemma inv_iter n : (iter n f)^-1 = iter n f^-1. Proof. by []. Qed. End OInv. Lemma iter_can_subproof n (f : {injfun A >-> A}) : OInv_Can aT aT A (iter n f). -Proof. +Proof. split=> x Ax; rewrite oinv_iter /=; elim: n=> // n IH. -rewrite iterfSr /= funoK //; exact: mem_fun. +by rewrite iterfSr /= funoK //; exact: mem_fun. Qed. HB.instance Definition _ f g := iter_can_subproof f g. @@ -1185,15 +1178,13 @@ HB.instance Definition _ n (f : {splitbij A >-> A}) := Surject.on (iter n f). End iter_surj. -(**********) -(* Unbind *) -(**********) +(** Unbind *) Section Unbind. Context {aT rT} {A : set aT} {B : set rT} (dflt : aT -> rT). Definition unbind (f : aT -> option rT) x := odflt (dflt x) (f x). -Lemma unbind_fun_subproof (f : {fun A >-> some @` B}) : IsFun _ _ A B (unbind f). +Lemma unbind_fun_subproof (f : {fun A >-> some @` B}) : isFun _ _ A B (unbind f). Proof. by rewrite /unbind; split=> x /'funS_f [y Bu <-]. Qed. HB.instance Definition _ f := unbind_fun_subproof f. @@ -1244,9 +1235,7 @@ HB.instance Definition _ (f : {splitbij A >-> some @` B}) := Bij.on (unbind f). End Unbind. -(*********) -(* Odflt *) -(*********) +(** Odflt *) Section Odflt. Context {T} {A : set T} (x : T). @@ -1260,9 +1249,7 @@ HB.instance Definition _ := SplitBij.copy (odflt x) End Odflt. -(************) -(* Subtypes *) -(************) +(** Subtypes *) Section SubType. Context {T : Type} {P : pred T} (sT : subType P) (x0 : sT). @@ -1287,24 +1274,20 @@ Lemma inv_insubd : (insubd x0)^-1 = val. Proof. by []. Qed. End SubType. -(***********) -(* To setT *) -(***********) +(** To setT *) Definition to_setT {T} (x : T) : [set: T] := @SigSub _ _ _ x (mem_set I : x \in setT). HB.instance Definition _ T := Can.Build T [set: T] setT to_setT ((fun _ _ => erefl) : {in setT, cancel to_setT val}). -HB.instance Definition _ T := IsFun.Build T _ setT setT to_setT (fun _ _ => I). +HB.instance Definition _ T := isFun.Build T _ setT setT to_setT (fun _ _ => I). HB.instance Definition _ T := SplitInjFun_CanV.Build T _ _ _ to_setT (fun x y => I) inj. Definition setTbij {T} := [splitbij of @to_setT T]. Lemma inv_to_setT T : (@to_setT T)^-1 = val. Proof. by []. Qed. -(**********) -(* Subfun *) -(**********) +(** Subfun *) Section subfun. Context {T} {A B : set T}. @@ -1360,15 +1343,14 @@ HB.instance Definition _ := seteqfun_can2_subproof. End seteqfun. -(*************) -(* Inclusion *) -(*************) +(** Inclusion *) + Section incl. Context {T} {A B : set T}. Definition incl (AB : A `<=` B) := @id T. HB.instance Definition _ (AB : A `<=` B) := Inv.Build _ _ (incl AB) id. -HB.instance Definition _ (AB : A `<=` B) := IsFun.Build _ _ A B (incl AB) AB. +HB.instance Definition _ (AB : A `<=` B) := isFun.Build _ _ A B (incl AB) AB. HB.instance Definition _ (AB : A `<=` B) := Inv_Can.Build _ _ A (incl AB) (fun _ _ => erefl). @@ -1381,15 +1363,13 @@ HB.instance Definition _ AB := eqincl_surj AB. End incl. Notation inclT A := (incl (@subsetT _ _)). -(*******************) -(* Ad hoc function *) -(*******************) +(** Ad hoc function *) Section mkfun. Context {aT} {rT} {A : set aT} {B : set rT}. Notation isfun f := {homo f : x / A x >-> B x}. Definition mkfun f (fAB : isfun f) := f. -HB.instance Definition _ f fAB := @IsFun.Build _ _ A B (@mkfun f fAB) fAB. +HB.instance Definition _ f fAB := @isFun.Build _ _ A B (@mkfun f fAB) fAB. Definition mkfun_fun f fAB := [fun of @mkfun f fAB]. HB.instance Definition _ (f : {inj A >-> rT}) fAB := Inject.on (@mkfun f fAB). HB.instance Definition _ (f : {splitinj A >-> rT}) fAB := @@ -1400,9 +1380,7 @@ HB.instance Definition _ (f : {splitsurj A >-> B}) fAB := SplitSurj.on (@mkfun f fAB). End mkfun. -(***********) -(* set_val *) -(***********) +(** set_val *) Section set_val. Context {T} {A : set T}. @@ -1415,27 +1393,21 @@ End set_val. #[global] Hint Extern 0 (is_true (set_val _ \in _)) => solve [apply: valP] : core. -(**********) -(* Squash *) -(**********) +(** Squash *) HB.instance Definition _ T := CanV.Build T $|T| setT setT squash (fun _ _ => I) (in1W unsquashK). HB.instance Definition _ T := SplitInj.copy (@unsquash T) squash^-1%FUN. Definition ssquash {T} := [splitsurj of @squash T]. -(***********************) -(* pickle and unpickle *) -(***********************) +(** pickle and unpickle *) HB.instance Definition _ (T : countType) := Inj.Build _ _ setT (@choice.pickle T) (in2W (pcan_inj choice.pickleK)). HB.instance Definition _ (T : countType) := - IsFun.Build _ _ setT setT (@choice.pickle T) (fun _ _ => I). + isFun.Build _ _ setT setT (@choice.pickle T) (fun _ _ => I). -(***********) -(* set0fun *) -(***********) +(** set0fun *) Lemma set0fun_inj {P T} : injective (@set0fun P T). Proof. by case=> x x0; have := set_mem x0. Qed. @@ -1443,20 +1415,16 @@ Proof. by case=> x x0; have := set_mem x0. Qed. HB.instance Definition _ P T := Inj.Build (@set0 T) P setT set0fun (in2W set0fun_inj). HB.instance Definition _ P T := - IsFun.Build _ _ setT setT (@set0fun P T) (fun _ _ => I). + isFun.Build _ _ setT setT (@set0fun P T) (fun _ _ => I). -(************) -(* cast_ord *) -(************) +(** cast_ord *) HB.instance Definition _ {m n} {eq_mn : m = n} := Can2.Build 'I_m 'I_n setT setT (cast_ord eq_mn) (fun _ _ => I) (fun _ _ => I) (in1W (cast_ordK _)) (in1W (cast_ordKV _)). -(************************) -(* enum_val & enum_rank *) -(************************) +(** enum_val & enum_rank *) HB.instance Definition _ (T : finType) := Can2.Build T _ setT setT enum_rank (fun _ _ => I) (fun _ _ => I) @@ -1466,9 +1434,7 @@ HB.instance Definition _ (T : finType) := Can2.Build _ T setT setT enum_val (fun _ _ => I) (fun _ _ => I) (in1W enum_valK) (in1W enum_rankK). -(**************) -(* Finset val *) -(**************) +(** Finset val *) Definition finset_val {T : choiceType} {X : {fset T}} (x : X) : [set` X] := exist (fun x => x \in [set` X]) (val x) (mem_set (valP x)). @@ -1490,17 +1456,15 @@ HB.instance Definition _ {T : choiceType} {X : {fset T}} := Can2.Build _ X setT setT val_finset (fun _ _ => I) (fun _ _ => I) (in1W val_finsetK) (in1W finset_valK). -(*****************) -(* 'I_n and `I_n *) -(*****************) +(** 'I_n and `I_n *) HB.instance Definition _ n := Can2.Build _ _ setT setT (@ordII n) (fun _ _ => I) (fun _ _ => I) (in1W ordIIK) (in1W IIordK). HB.instance Definition _ n := SplitBij.copy (@IIord n) (ordII^-1). -(***********) -(* Glueing *) -(***********) +(**md**************************************************************************) +(* ## Glueing *) +(******************************************************************************) Definition glue {T T'} {X Y : set T} {A B : set T'} of [disjoint X & Y] & [disjoint A & B] := @@ -1527,7 +1491,7 @@ Context {XY : [disjoint X & Y]} {AB : [disjoint A & B]}. Local Notation gl := (glue XY AB). Lemma glue_fun_subproof (f : {fun X >-> A}) (g : {fun Y >-> B}) : - IsFun T T' (X `|` Y) (A `|` B) (gl f g). + isFun T T' (X `|` Y) (A `|` B) (gl f g). Proof. by split=> x []xP; [left; rewrite glue1|right; rewrite glue2]; rewrite ?inE//; apply: funS. @@ -1595,9 +1559,7 @@ HB.instance Definition _ (f : {splitbij X >-> A}) (g : {splitbij Y >-> B}) := End Glue. -(************************************) -(* Z-module addition is a bijection *) -(************************************) +(** Z-module addition is a bijection *) Section addition. Context {V : zmodType} (x : V). @@ -1612,16 +1574,16 @@ HB.instance Definition _ := addr_can2_subproof. End addition. -(************************************) -(* Z-module opposite is a bijection *) -(************************************) +(** Z-module opposite is a bijection *) Section addition. Context {V : zmodType} (x : V). +Local Open Scope ring_scope. +(* TODO: promote -%R to empty scope in mathcomp/HB *) HB.instance Definition _ := Inv.Build V V (-%R) (-%R). -Lemma inv_oppr : (-%R)^-1 = (-%R). by []. Qed. +Lemma inv_oppr : (-%R)^-1%FUN = (-%R). Proof. by []. Qed. Lemma oppr_can2_subproof : Inv_Can2 V V setT setT (-%R). Proof. by split => // y _; rewrite inv_oppr ?GRing.opprK. Qed. @@ -1629,9 +1591,7 @@ HB.instance Definition _ := oppr_can2_subproof. End addition. -(*************) -(* emtpyType *) -(*************) +(** emtpyType *) Section empty. Context {T : emptyType} {T' : Type} {X : set T}. @@ -1643,7 +1603,7 @@ Lemma empty_can_subproof : OInv_Can T T' X any. Proof. by split=> x; rewrite empty_eq0 inE. Qed. HB.instance Definition _ := empty_can_subproof. -Lemma empty_fun_subproof Y : IsFun T T' X Y any. +Lemma empty_fun_subproof Y : isFun T T' X Y any. Proof. by split=> x; rewrite empty_eq0. Qed. HB.instance Definition _ Y := empty_fun_subproof Y. @@ -1652,9 +1612,9 @@ HB.instance Definition _ := empty_canv_subproof. End empty. -(************************) -(* Theory of surjection *) -(************************) +(**md**************************************************************************) +(* ## Theory of surjection *) +(******************************************************************************) Section surj_lemmas. Variables aT rT : Type. @@ -1791,9 +1751,7 @@ move=> j; apply/seteqP; split=> x. by move=> [f fDE fF i Fi]; exists (f i); [apply: fDE|apply: fF]. Qed. -(**************) -(* Injections *) -(**************) +(** Injections *) Lemma trivIset_inj T I (D : set I) (F : I -> set T) : (forall i, D i -> F i !=set0) -> trivIset D F -> set_inj D F. @@ -1802,9 +1760,7 @@ move=> FN0 Ftriv i j; rewrite !inE => Di Dj Fij. by apply: Ftriv Di (Dj) _; rewrite Fij setIid; apply: FN0. Qed. -(**************) -(* Bijections *) -(**************) +(** Bijections *) Section set_bij_lemmas. Context {aT rT : Type} {A : set aT} {B : set rT} {f : aT -> rT}. @@ -1821,7 +1777,7 @@ Lemma set_bij_sub : f @` A `<=` B. Proof. exact/image_subP/set_bij_homo. Qed. Lemma set_bij_surj : set_surj A B f. Proof. by case: fbij. Qed. HB.instance Definition _ : OCanV _ _ _ _ g := set_bij_surj. -HB.instance Definition _ := IsFun.Build _ _ A B g set_bij_homo. +HB.instance Definition _ := isFun.Build _ _ A B g set_bij_homo. HB.instance Definition _ := SurjFun_Inj.Build _ _ A B g set_bij_inj. End set_bij_lemmas. @@ -1869,9 +1825,9 @@ Definition phant_bijTT aT rT (f : {bij [set: aT] >-> [set: rT]}) Notation "''bijTT_' f" := (phant_bijTT (Phantom (_ -> _) f)) : form_scope. #[global] Hint Extern 0 (bijective _) => solve [apply: bijTT] : core. -(*****************************) -(* Patching and restrictions *) -(*****************************) +(**md**************************************************************************) +(* ## Patching and restrictions *) +(******************************************************************************) Section patch. Context {aT rT : Type} (d : aT -> rT) (A : set aT). @@ -1897,7 +1853,7 @@ End inj. End patch. Notation restrict := (patch (fun=> point)). -Notation "f \_ D" := (restrict D f) : fun_scope. +Notation "f \_ D" := (restrict D f) : function_scope. Lemma patchE aT (rT : pointedType) (f : aT -> rT) (B : set aT) x : (f \_ B) x = if x \in B then f x else point. @@ -1953,10 +1909,9 @@ do 2![case: ifPn => //]; rewrite !in_setE => Di Dj Fix Fjx. by apply: FDtriv => //; exists x. Qed. - -(**************************************) -(* Restriction of domain and codomain *) -(**************************************) +(**md**************************************************************************) +(* ## Restriction of domain and codomain *) +(******************************************************************************) Section RestrictionLeft. Context {U V : Type} (v : V) {A : set U} {B : set V}. @@ -1965,7 +1920,7 @@ Local Notation restrict := (patch (fun=> v) A). Definition sigL (f : U -> V) : A -> V := f \o set_val. -Lemma sigL_isfun (f : {fun A >-> B}) : IsFun _ _ [set: A] B (sigL f). +Lemma sigL_isfun (f : {fun A >-> B}) : isFun _ _ [set: A] B (sigL f). Proof. by split=> x _; apply: funS. Qed. HB.instance Definition _ (f : {fun A >-> B}) := sigL_isfun f. @@ -1973,7 +1928,7 @@ Definition sigLfun (f : {fun A >-> B}) := [fun of sigL f]. Definition valL_ (f : A -> V) : U -> V := ((@oapp _ _)^~ v) f \o 'oinv_set_val. Lemma valL_isfun (f : {fun [set: A] >-> B}) : - IsFun _ _ A B (valL_ (f : _ -> _)). + isFun _ _ A B (valL_ (f : _ -> _)). Proof. by split=> x Ax; apply: funS. Qed. HB.instance Definition _ (f : {fun [set: A] >-> B}) := valL_isfun f. Definition valLfun_ (f : {fun [set: A] >-> B}) := [fun of valL_ f]. @@ -2354,9 +2309,6 @@ Proof. by rewrite -sigLRfun_bijP valLRK. Qed. End Restrictions2. -Lemma subsetP {T} {A B : set T} : {subset A <= B} <-> (A `<=` B). -Proof. by split => + x => /(_ x); rewrite ?inE. Qed. - Section set_bij_basic_lemmas. Context {aT rT : Type}. Implicit Types (A : set aT) (B : set rT) (f : aT -> rT). @@ -2569,7 +2521,7 @@ Section injpPfun. Context {B : set U} {f : {inj A >-> U}} (ffun : {homo f : x / A x >-> B x}). Let g : _ -> _ := f. #[local] HB.instance Definition _ := SplitInj.copy g ('split_dflt [fun g in A]). -#[local] HB.instance Definition _ := IsFun.Build _ _ _ _ g ffun. +#[local] HB.instance Definition _ := isFun.Build _ _ _ _ g ffun. Lemma injpPfun_ : {i : {splitinjfun A >-> B} | f = i :> (_ -> _)}. Proof. by exists [splitinjfun of g]. Qed. End injpPfun. @@ -2582,16 +2534,16 @@ End funpPinj. End pointed_inverse. Notation "''pinv_' dflt" := (pinv_ dflt) : form_scope. -Notation pinv := 'pinv_point. +Notation pinv := 'pinv_(fun=> point). Notation "''pPbij_' dflt" := (pPbij_ dflt) : form_scope. -Notation pPbij := 'pPbij_point. +Notation pPbij := 'pPbij_(fun=> point). Notation selfPbij := 'pPbij_id. Notation "''pPinj_' dflt" := (pPinj_ dflt) : form_scope. -Notation pPinj := 'pPinj_point. +Notation pPinj := 'pPinj_(fun=> point). Notation "''injpPfun_' dflt" := (injpPfun_ dflt) : form_scope. -Notation injpPfun := 'injpPfun_point. +Notation injpPfun := 'injpPfun_(fun=> point). Notation "''funpPinj_' dflt" := (funpPinj_ dflt) : form_scope. -Notation funpPinj := 'funpPinj_point. +Notation funpPinj := 'funpPinj_(fun=> point). Section function_space. Local Open Scope ring_scope. @@ -2609,16 +2561,16 @@ Qed. Obligation Tactic := idtac. Program Definition fct_zmodMixin (T : Type) (M : zmodType) := - @ZmodMixin (T -> M) \0 (fun f x => - f x) (fun f g => f \+ g) _ _ _ _. + @GRing.isZmodule.Build (T -> M) \0 (fun f x => - f x) (fun f g => f \+ g) + _ _ _ _. Next Obligation. by move=> T M f g h; rewrite funeqE=> x /=; rewrite addrA. Qed. Next Obligation. by move=> T M f g; rewrite funeqE=> x /=; rewrite addrC. Qed. Next Obligation. by move=> T M f; rewrite funeqE=> x /=; rewrite add0r. Qed. Next Obligation. by move=> T M f; rewrite funeqE=> x /=; rewrite addNr. Qed. -Canonical fct_zmodType T (M : zmodType) := ZmodType (T -> M) (fct_zmodMixin T M). +HB.instance Definition _ (T : Type) (M : zmodType) := fct_zmodMixin T M. Program Definition fct_ringMixin (T : pointedType) (M : ringType) := - @RingMixin [zmodType of T -> M] (cst 1) (fun f g => f \* g) - _ _ _ _ _ _. + @GRing.Zmodule_isRing.Build (T -> M) (cst 1) (fun f g => f \* g) _ _ _ _ _ _. Next Obligation. by move=> T M f g h; rewrite funeqE=> x /=; rewrite mulrA. Qed. Next Obligation. by move=> T M f; rewrite funeqE=> x /=; rewrite mul1r. Qed. Next Obligation. by move=> T M f; rewrite funeqE=> x /=; rewrite mulr1. Qed. @@ -2627,25 +2579,30 @@ Next Obligation. by move=> T M f g h; rewrite funeqE=> x/=; rewrite mulrDr. Qed. Next Obligation. by move=> T M ; apply/eqP; rewrite funeqE => /(_ point) /eqP; rewrite oner_eq0. Qed. -Canonical fct_ringType (T : pointedType) (M : ringType) := - RingType (T -> M) (fct_ringMixin T M). +HB.instance Definition _ (T : pointedType) (M : ringType) := fct_ringMixin T M. -Program Canonical fct_comRingType (T : pointedType) (M : comRingType) := - ComRingType (T -> M) _. -Next Obligation. by move=> T M f g; rewrite funeqE => x/=; rewrite mulrC. Qed. +Program Definition fct_comRingType (T : pointedType) (M : comRingType) := + GRing.Ring_hasCommutativeMul.Build (T -> M) _. +Next Obligation. +by move=> T M f g; rewrite funeqE => x; rewrite /GRing.mul/= mulrC. +Qed. +HB.instance Definition _ (T : pointedType) (M : comRingType) := + fct_comRingType T M. -Program Definition fct_lmodMixin (U : Type) (R : ringType) (V : lmodType R) - := @LmodMixin R [zmodType of U -> V] (fun k f => k \*: f) _ _ _ _. -Next Obligation. by move=> U R V k f v; rewrite funeqE=> x; exact: scalerA. Qed. -Next Obligation. by move=> U R V f; rewrite funeqE=> x /=; rewrite scale1r. Qed. +Section fct_lmod. +Variables (U : Type) (R : ringType) (V : lmodType R). +Program Definition fct_lmodMixin := @GRing.Zmodule_isLmodule.Build R (U -> V) + (fun k f => k \*: f) _ _ _ _. +Next Obligation. by move=> k f v; rewrite funeqE=> x; exact: scalerA. Qed. +Next Obligation. by move=> f; rewrite funeqE=> x /=; rewrite scale1r. Qed. Next Obligation. -by move=> U R V f g h; rewrite funeqE => x /=; rewrite scalerDr. +by move=> f g h; rewrite funeqE => x /=; rewrite scalerDr. Qed. Next Obligation. -by move=> U R V f g h; rewrite funeqE => x /=; rewrite scalerDl. +by move=> f g h; rewrite funeqE => x /=; rewrite scalerDl. Qed. -Canonical fct_lmodType U (R : ringType) (V : lmodType R) := - LmodType _ (U -> V) (fct_lmodMixin U V). +HB.instance Definition _ := fct_lmodMixin. +End fct_lmod. Lemma fct_sumE (I T : Type) (M : zmodType) r (P : {pred I}) (f : I -> T -> M) (x : T) : @@ -2662,6 +2619,10 @@ Lemma addrfctE (T : Type) (K : zmodType) (f g : T -> K) : f + g = (fun x => f x + g x). Proof. by []. Qed. +Lemma sumrfctE (T : Type) (K : zmodType) (s : seq (T -> K)) : + \sum_(f <- s) f = (fun x => \sum_(f <- s) f x). +Proof. by apply/funext => x;elim/big_ind2 : _ => // _ a _ b <- <-. Qed. + Lemma opprfctE (T : Type) (K : zmodType) (f : T -> K) : - f = (fun x => - f x). Proof. by []. Qed. diff --git a/classical/mathcomp_extra.v b/classical/mathcomp_extra.v index 1bff02bda..7e4e7091b 100644 --- a/classical/mathcomp_extra.v +++ b/classical/mathcomp_extra.v @@ -1,22 +1,15 @@ (* mathcomp analysis (c) 2022 Inria and AIST. License: CeCILL-C. *) Require Import BinPos. From mathcomp Require choice. -(* Missing coercion (done before Import to avoid redeclaration error, - thanks to KS for the trick) *) -(* MathComp 1.15 addition *) -Coercion choice.Choice.mixin : choice.Choice.class_of >-> choice.Choice.mixin_of. - From mathcomp Require Import all_ssreflect finmap ssralg ssrnum ssrint rat. From mathcomp Require Import finset interval. -(***************************) -(* MathComp 1.15 additions *) -(***************************) - -(******************************************************************************) +(**md**************************************************************************) +(* # MathComp extra *) +(* *) (* This files contains lemmas and definitions missing from MathComp. *) (* *) -(* f \max g := fun x => Num.max (f x) (g x) *) +(* ``` *) (* oflit f := Some \o f *) (* pred_oapp T D := [pred x | oapp (mem D) false x] *) (* f \* g := fun x => f x * g x *) @@ -29,6 +22,9 @@ From mathcomp Require Import finset interval. (* dfwith f x == fun j => x if j = i, and f j otherwise *) (* given x : T i *) (* swap x := (x.2, x.1) *) +(* monotonous A f := {in A &, {mono f : x y / x <= y}} \/ *) +(* {in A &, {mono f : x y /~ x <= y}} *) +(* ``` *) (* *) (******************************************************************************) @@ -36,13 +32,19 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. +(***************************) +(* MathComp 1.15 additions *) +(***************************) + Reserved Notation "f \* g" (at level 40, left associativity). Reserved Notation "f \- g" (at level 50, left associativity). Reserved Notation "\- f" (at level 35, f at level 35). -Reserved Notation "f \max g" (at level 50, left associativity). Number Notation positive Pos.of_num_int Pos.to_num_uint : AC_scope. +Notation "f \min g" := (Order.min_fun f g) : function_scope. +Notation "f \max g" := (Order.max_fun f g) : function_scope. + Lemma all_sig2_cond {I : Type} {T : Type} (D : pred I) (P Q : I -> T -> Prop) : T -> (forall x : I, D x -> {y : T | P x y & Q x y}) -> @@ -196,8 +198,8 @@ Implicit Types i : interval R. Lemma mem_miditv i : (i.1 < i.2)%O -> miditv i \in i. Proof. move: i => [[ba a|[]] [bb b|[]]] //= ab; first exact: mid_in_itv. - by rewrite !in_itv -lteif_subl_addl subrr lteif01. -by rewrite !in_itv lteif_subl_addr -lteif_subl_addl subrr lteif01. + by rewrite !in_itv -lteifBlDl subrr lteif01. +by rewrite !in_itv lteifBlDr -lteifBlDl subrr lteif01. Qed. Lemma miditv_le_left i b : (i.1 < i.2)%O -> (BSide b (miditv i) <= i.2)%O. @@ -237,7 +239,7 @@ End itv_porderType. Lemma sumr_le0 (R : numDomainType) I (r : seq I) (P : pred I) (F : I -> R) : (forall i, P i -> F i <= 0)%R -> (\sum_(i <- r | P i) F i <= 0)%R. -Proof. by move=> F0; elim/big_rec : _ => // i x Pi; apply/ler_naddl/F0. Qed. +Proof. by move=> F0; elim/big_rec : _ => // i x Pi; apply/ler_wnDl/F0. Qed. Lemma enum_ord0 : enum 'I_0 = [::]. Proof. by apply/eqP; rewrite -size_eq0 size_enum_ord. Qed. @@ -305,10 +307,6 @@ Qed. Lemma eqbLR (b1 b2 : bool) : b1 = b2 -> b1 -> b2. Proof. by move->. Qed. -Definition max_fun T (R : numDomainType) (f g : T -> R) x := Num.max (f x) (g x). -Notation "f \max g" := (max_fun f g) : ring_scope. -Arguments max_fun {T R} _ _ _ /. - Lemma gtr_opp (R : numDomainType) (r : R) : (0 < r)%R -> (- r < r)%R. Proof. by move=> n0; rewrite -subr_lt0 -opprD oppr_lt0 addr_gt0. Qed. @@ -373,13 +371,13 @@ Proof. by rewrite -mulr2n -mulr_natr mulfVK //= pnatr_eq0. Qed. Lemma ler_addgt0Pr x y : reflect (forall e, e > 0 -> x <= y + e) (x <= y). Proof. -apply/(iffP idP)=> [lexy e e_gt0 | lexye]; first by rewrite ler_paddr// ltW. +apply/(iffP idP)=> [lexy e e_gt0 | lexye]; first by rewrite ler_wpDr// ltW. have [||ltyx]// := comparable_leP. rewrite (@comparabler_trans _ (y + 1))// /Order.comparable ?lexye ?ltr01//. - by rewrite ler_addl ler01 orbT. + by rewrite lerDl ler01 orbT. have /midf_lt [_] := ltyx; rewrite le_gtF//. -rewrite -(@addrK _ y y) addrAC -addrA 2!mulrDl -splitr lexye//. -by rewrite divr_gt0// ?ltr0n// subr_gt0. +rewrite -(subrKA y) addrACA 2!mulrDl -splitr lexye//. +by rewrite addrC divr_gt0// ?ltr0n// subr_gt0. Qed. Lemma ler_addgt0Pl x y : reflect (forall e, e > 0 -> x <= e + y) (x <= y). @@ -391,9 +389,9 @@ Lemma in_segment_addgt0Pr x y z : reflect (forall e, e > 0 -> y \in `[x - e, z + e]) (y \in `[x, z]). Proof. apply/(iffP idP)=> [xyz e /[dup] e_gt0 /ltW e_ge0 | xyz_e]. - by rewrite in_itv /= ler_subl_addr !ler_paddr// (itvP xyz). + by rewrite in_itv /= lerBlDr !ler_wpDr// (itvP xyz). by rewrite in_itv /= ; apply/andP; split; apply/ler_addgt0Pr => ? /xyz_e; - rewrite in_itv /= ler_subl_addr => /andP []. + rewrite in_itv /= lerBlDr => /andP []. Qed. Lemma in_segment_addgt0Pl x y z : @@ -405,14 +403,14 @@ Qed. Lemma lt_le a b : (forall x, x < a -> x < b) -> a <= b. Proof. -move=> ab; apply/ler_addgt0Pr => e e_gt0; rewrite -ler_subl_addr ltW//. -by rewrite ab // ltr_subl_addr -ltr_subl_addl subrr. +move=> ab; apply/ler_addgt0Pr => e e_gt0; rewrite -lerBlDr ltW//. +by rewrite ab // ltrBlDr -ltrBlDl subrr. Qed. Lemma gt_ge a b : (forall x, b < x -> a < x) -> a <= b. Proof. move=> ab; apply/ler_addgt0Pr => e e_gt0. -by rewrite ltW// ab// -ltr_subl_addl subrr. +by rewrite ltW// ab// -ltrBlDl subrr. Qed. End lt_le_gt_ge. @@ -431,7 +429,7 @@ Proof. by apply: subitvP; rewrite subitvE !bound_lexx. Qed. (**********************************) Reserved Notation "`1- r" (format "`1- r", at level 2). -Reserved Notation "f \^-1" (at level 3, format "f \^-1"). +Reserved Notation "f \^-1" (at level 3, format "f \^-1", left associativity). Lemma natr1 (R : ringType) (n : nat) : (n%:R + 1 = n.+1%:R :> R)%R. Proof. by rewrite GRing.mulrSr. Qed. @@ -469,642 +467,521 @@ Arguments big_rmcond_in {R idx op I r} P. (* MathComp > 1.15.0 additions *) (*******************************) -Section bigminr_maxr. -Import Num.Def. +Reserved Notation "`1- x" (format "`1- x", at level 2). -Lemma bigminr_maxr (R : realDomainType) I r (P : pred I) (F : I -> R) x : - \big[minr/x]_(i <- r | P i) F i = - \big[maxr/- x]_(i <- r | P i) - F i. -Proof. -by elim/big_rec2: _ => [|i y _ _ ->]; rewrite ?oppr_max opprK. -Qed. -End bigminr_maxr. +Section onem. +Variable R : numDomainType. +Implicit Types r : R. -Section SemiGroupProperties. -Variables (R : Type) (op : R -> R -> R). -Hypothesis opA : associative op. +Definition onem r := 1 - r. +Local Notation "`1- r" := (onem r). -(* Convert an AC op : R -> R -> R to a com_law on option R *) -Definition AC_subdef of associative op & commutative op := - fun x => oapp (fun y => Some (oapp (op^~ y) y x)) x. -Definition oAC := nosimpl AC_subdef. +Lemma onem0 : `1-0 = 1. Proof. by rewrite /onem subr0. Qed. -Hypothesis opC : commutative op. -Let opCA : left_commutative op. Proof. by move=> x *; rewrite !opA (opC x). Qed. -Let opAC : right_commutative op. -Proof. by move=> *; rewrite -!opA [X in op _ X]opC. Qed. +Lemma onem1 : `1-1 = 0. Proof. by rewrite /onem subrr. Qed. -Hypothesis opyy : idempotent op. +Lemma onemK r : `1-(`1-r) = r. +Proof. by rewrite /onem opprB addrCA subrr addr0. Qed. -Local Notation oop := (oAC opA opC). +Lemma add_onemK r : r + `1- r = 1. +Proof. by rewrite /onem addrC subrK. Qed. -Lemma opACE x y : oop (Some x) (Some y) = some (op x y). Proof. by []. Qed. +Lemma onem_gt0 r : r < 1 -> 0 < `1-r. Proof. by rewrite subr_gt0. Qed. -Lemma oopA_subdef : associative oop. -Proof. by move=> [x|] [y|] [z|]//; rewrite /oAC/= opA. Qed. +Lemma onem_ge0 r : r <= 1 -> 0 <= `1-r. +Proof. by rewrite le_eqVlt => /predU1P[->|/onem_gt0/ltW]; rewrite ?onem1. Qed. -Lemma oopx1_subdef : left_id None oop. Proof. by case. Qed. -Lemma oop1x_subdef : right_id None oop. Proof. by []. Qed. +Lemma onem_le1 r : 0 <= r -> `1-r <= 1. +Proof. by rewrite lerBlDr lerDl. Qed. -Lemma oopC_subdef : commutative oop. -Proof. by move=> [x|] [y|]//; rewrite /oAC/= opC. Qed. +Lemma onem_lt1 r : 0 < r -> `1-r < 1. +Proof. by rewrite ltrBlDr ltrDl. Qed. -Canonical opAC_law := Monoid.Law oopA_subdef oopx1_subdef oop1x_subdef. -Canonical opAC_com_law := Monoid.ComLaw oopC_subdef. +Lemma onemX_ge0 r n : 0 <= r -> r <= 1 -> 0 <= `1-(r ^+ n). +Proof. by move=> ? ?; rewrite subr_ge0 exprn_ile1. Qed. -Context [x : R]. +Lemma onemX_lt1 r n : 0 < r -> `1-(r ^+ n) < 1. +Proof. by move=> ?; rewrite onem_lt1// exprn_gt0. Qed. -Lemma some_big_AC [I : Type] r P (F : I -> R) : - Some (\big[op/x]_(i <- r | P i) F i) = - oop (\big[oop/None]_(i <- r | P i) Some (F i)) (Some x). -Proof. by elim/big_rec2 : _ => //= i [y|] _ Pi [] -> //=; rewrite opA. Qed. +Lemma onemD r s : `1-(r + s) = `1-r - s. +Proof. by rewrite /onem addrAC opprD addrA addrAC. Qed. -Lemma big_ACE [I : Type] r P (F : I -> R) : - \big[op/x]_(i <- r | P i) F i = - odflt x (oop (\big[oop/None]_(i <- r | P i) Some (F i)) (Some x)). -Proof. by apply: Some_inj; rewrite some_big_AC. Qed. +Lemma onemMr r s : s * `1-r = s - s * r. +Proof. by rewrite /onem mulrBr mulr1. Qed. -Lemma big_undup_AC [I : eqType] r P (F : I -> R) (opK : idempotent op) : - \big[op/x]_(i <- undup r | P i) F i = \big[op/x]_(i <- r | P i) F i. -Proof. by rewrite !big_ACE !big_undup//; case=> //= ?; rewrite /oAC/= opK. Qed. +Lemma onemM r s : `1-(r * s) = `1-r + `1-s - `1-r * `1-s. +Proof. +rewrite /onem mulrBr mulr1 mulrBl mul1r opprB -addrA. +by rewrite (addrC (1 - r)) !addrA subrK opprB addrA subrK addrK. +Qed. -Lemma perm_big_AC [I : eqType] [r] s [P : pred I] [F : I -> R] : - perm_eq r s -> \big[op/x]_(i <- r | P i) F i = \big[op/x]_(i <- s | P i) F i. -Proof. by rewrite !big_ACE => /(@perm_big _ _)->. Qed. +End onem. +Notation "`1- r" := (onem r) : ring_scope. -Section Id. -Hypothesis opxx : op x x = x. +Lemma onemV (F : numFieldType) (x : F) : x != 0 -> `1-(x^-1) = (x - 1) / x. +Proof. by move=> ?; rewrite mulrDl divff// mulN1r. Qed. -Lemma big_const_idem I (r : seq I) P : \big[op/x]_(i <- r | P i) x = x. -Proof. by elim/big_ind : _ => // _ _ -> ->. Qed. +Lemma lez_abs2 (a b : int) : 0 <= a -> a <= b -> (`|a| <= `|b|)%N. +Proof. by case: a => //= n _; case: b. Qed. -Lemma big_id_idem I (r : seq I) P F : - op (\big[op/x]_(i <- r | P i) F i) x = \big[op/x]_(i <- r | P i) F i. -Proof. by elim/big_rec : _ => // ? ? ?; rewrite -opA => ->. Qed. +Lemma ler_gtP (R : numFieldType) (x y : R) : + reflect (forall z, z > y -> x <= z) (x <= y). +Proof. +apply: (equivP (ler_addgt0Pr _ _)); split=> [xy z|xz e e_gt0]. + by rewrite -subr_gt0 => /xy; rewrite addrC addrNK. +by apply: xz; rewrite -[ltLHS]addr0 ler_ltD. +Qed. -Lemma big_mkcond_idem I r (P : pred I) F : - \big[op/x]_(i <- r | P i) F i = \big[op/x]_(i <- r) (if P i then F i else x). +Lemma ler_ltP (R : numFieldType) (x y : R) : + reflect (forall z, z < x -> z <= y) (x <= y). Proof. -elim: r => [|i r]; rewrite ?(big_nil, big_cons)//. -by case: ifPn => Pi ->//; rewrite -[in LHS]big_id_idem. +apply: (equivP (ler_addgt0Pr _ _)); split=> [xy z|xz e e_gt0]. + by rewrite -subr_gt0 => /xy; rewrite addrCA -[leLHS]addr0 lerD2l subr_ge0. +by rewrite -lerBlDr xz// -[ltRHS]subr0 ler_ltB. Qed. -Lemma big_split_idem I r (P : pred I) F1 F2 : - \big[op/x]_(i <- r | P i) op (F1 i) (F2 i) = - op (\big[op/x]_(i <- r | P i) F1 i) (\big[op/x]_(i <- r | P i) F2 i). -Proof. by elim/big_rec3 : _ => [//|i ? ? _ _ ->]; rewrite // opCA -!opA opCA. Qed. +Definition inv_fun T (R : unitRingType) (f : T -> R) x := (f x)^-1%R. +Notation "f \^-1" := (inv_fun f) : ring_scope. +Arguments inv_fun {T R} _ _ /. -Lemma big_id_idem_AC I (r : seq I) P F : - \big[op/x]_(i <- r | P i) op (F i) x = \big[op/x]_(i <- r | P i) F i. -Proof. by rewrite big_split_idem big_const_idem ?big_id_idem. Qed. +Definition bound_side d (T : porderType d) (c : bool) (x : itv_bound T) := + if x is BSide c' _ then c == c' else false. -Lemma bigID_idem I r (a P : pred I) F : - \big[op/x]_(i <- r | P i) F i = - op (\big[op/x]_(i <- r | P i && a i) F i) - (\big[op/x]_(i <- r | P i && ~~ a i) F i). -Proof. -rewrite -big_id_idem_AC big_mkcond_idem !(big_mkcond_idem _ _ F) -big_split_idem. -by apply: eq_bigr => i; case: ifPn => //=; case: ifPn. -Qed. +Lemma real_ltr_distlC [R : numDomainType] [x y : R] (e : R) : + x - y \is Num.real -> (`|x - y| < e) = (x - e < y < x + e). +Proof. by move=> ?; rewrite distrC real_ltr_distl// -rpredN opprB. Qed. -End Id. +Definition proj {I} {T : I -> Type} i (f : forall i, T i) := f i. -Lemma big_rem_AC (I : eqType) (r : seq I) z (P : pred I) F : z \in r -> - \big[op/x]_(y <- r | P y) F y = - if P z then op (F z) (\big[op/x]_(y <- rem z r | P y) F y) - else \big[op/x]_(y <- rem z r | P y) F y. -Proof. -by move=> /[!big_ACE] /(big_rem _)->//; case: ifP; case: (bigop _ _ _) => /=. -Qed. +Section DFunWith. +Variables (I : eqType) (T : I -> Type) (f : forall i, T i). -Lemma bigD1_AC (I : finType) j (P : pred I) F : P j -> - \big[op/x]_(i | P i) F i = op (F j) (\big[op/x]_(i | P i && (i != j)) F i). -Proof. by move=> /[!big_ACE] /(bigD1 _)->; case: (bigop _ _) => /=. Qed. +Definition dfwith i (x : T i) (j : I) : T j := + if (i =P j) is ReflectT ij then ecast j (T j) ij x else f j. -Variable le : rel R. -Hypothesis le_refl : reflexive le. -Hypothesis op_incr : forall x y, le x (op x y). +Lemma dfwithin i x : dfwith x i = x. +Proof. by rewrite /dfwith; case: eqP => // ii; rewrite eq_axiomK. Qed. -Lemma sub_big I [s] (P P' : {pred I}) (F : I -> R) : (forall i, P i -> P' i) -> - le (\big[op/x]_(i <- s | P i) F i) (\big[op/x]_(i <- s | P' i) F i). -Proof. -move=> PP'; rewrite !big_ACE (bigID P P')/=. -under [in X in le _ X]eq_bigl do rewrite (andb_idl (PP' _)). -case: (bigop _ _ _) (bigop _ _ _) => [y|] [z|]//=. - by rewrite opAC op_incr. -by rewrite opC op_incr. -Qed. +Lemma dfwithout i (x : T i) j : i != j -> dfwith x j = f j. +Proof. by rewrite /dfwith; case: eqP. Qed. + +Variant dfwith_spec i (x : T i) : forall j, T j -> Type := + | DFunWithin : dfwith_spec x x + | DFunWithout j : i != j -> dfwith_spec x (f j). -Lemma sub_big_seq (I : eqType) s s' P (F : I -> R) : - (forall i, count_mem i s <= count_mem i s')%N -> - le (\big[op/x]_(i <- s | P i) F i) (\big[op/x]_(i <- s' | P i) F i). +Lemma dfwithP i (x : T i) (j : I) : dfwith_spec x (dfwith x j). Proof. -rewrite !big_ACE => /count_subseqP[_ /subseqP[m sm ->]]/(perm_big _)->. -by rewrite big_mask big_tnth// -!big_ACE sub_big// => j /andP[]. +by case: (eqVneq i j) => [<-|nij]; + [rewrite dfwithin|rewrite dfwithout//]; constructor. Qed. -Lemma sub_big_seq_cond (I : eqType) s s' P P' (F : I -> R) : - (forall i, count_mem i (filter P s) <= count_mem i (filter P' s'))%N -> - le (\big[op/x]_(i <- s | P i) F i) (\big[op/x]_(i <- s' | P' i) F i). -Proof. by move=> /(sub_big_seq xpredT F); rewrite !big_filter. Qed. +Lemma projK i (x : T i) : cancel (@dfwith i) (proj i). +Proof. by move=> z; rewrite /proj dfwithin. Qed. -Lemma uniq_sub_big (I : eqType) s s' P (F : I -> R) : uniq s -> uniq s' -> - {subset s <= s'} -> - le (\big[op/x]_(i <- s | P i) F i) (\big[op/x]_(i <- s' | P i) F i). -Proof. -move=> us us' ss'; rewrite sub_big_seq => // i; rewrite !count_uniq_mem//. -by have /implyP := ss' i; case: (_ \in s) (_ \in s') => [] []. -Qed. +End DFunWith. +Arguments dfwith {I T} f i x. -Lemma uniq_sub_big_cond (I : eqType) s s' P P' (F : I -> R) : - uniq (filter P s) -> uniq (filter P' s') -> - {subset [seq i <- s | P i] <= [seq i <- s' | P' i]} -> - le (\big[op/x]_(i <- s | P i) F i) (\big[op/x]_(i <- s' | P' i) F i). -Proof. by move=> u u' /(uniq_sub_big xpredT F u u'); rewrite !big_filter. Qed. +Definition swap (T1 T2 : Type) (x : T1 * T2) := (x.2, x.1). -Lemma sub_big_idem (I : eqType) s s' P (F : I -> R) : - {subset s <= s'} -> - le (\big[op/x]_(i <- s | P i) F i) (\big[op/x]_(i <- s' | P i) F i). +(* MathComp 2.2 addition *) +Lemma ler_sqrt {R : rcfType} (a b : R) : + (0 <= b -> (Num.sqrt a <= Num.sqrt b) = (a <= b))%R. Proof. -move=> ss'; rewrite -big_undup_AC// -[X in le _ X]big_undup_AC//. -by rewrite uniq_sub_big ?undup_uniq// => i; rewrite !mem_undup; apply: ss'. +have [b_gt0 _|//|<- _] := ltgtP; last first. + by rewrite sqrtr0 -sqrtr_eq0 le_eqVlt ltNge sqrtr_ge0 orbF. +have [a_le0|a_gt0] := ler0P a; last by rewrite ler_psqrt// ?qualifE/= ?ltW. +by rewrite ler0_sqrtr // sqrtr_ge0 (le_trans a_le0) ?ltW. Qed. -Lemma sub_big_idem_cond (I : eqType) s s' P P' (F : I -> R) : - {subset [seq i <- s | P i] <= [seq i <- s' | P' i]} -> - le (\big[op/x]_(i <- s | P i) F i) (\big[op/x]_(i <- s' | P' i) F i). -Proof. by move=> /(sub_big_idem xpredT F); rewrite !big_filter. Qed. +Section order_min. +Variables (d : unit) (T : orderType d). +Import Order. +Local Open Scope order_scope. -Lemma sub_in_big [I : eqType] (s : seq I) (P P' : {pred I}) (F : I -> R) : - {in s, forall i, P i -> P' i} -> - le (\big[op/x]_(i <- s | P i) F i) (\big[op/x]_(i <- s | P' i) F i). +Lemma lt_min_lt (x y z : T) : (min x z < min y z)%O -> (x < y)%O. Proof. -move=> PP'; apply: sub_big_seq_cond => i; rewrite leq_count_subseq//. -rewrite subseq_filter filter_subseq andbT; apply/allP => j. -by rewrite !mem_filter => /andP[/PP'/[apply]->]. +rewrite /Order.min/=; case: ifPn => xz; case: ifPn => yz; rewrite ?ltxx//. +- by move=> /lt_le_trans; apply; rewrite leNgt. +- by rewrite ltNge (ltW yz). Qed. -Lemma le_big_ord n m [P : {pred nat}] [F : nat -> R] : (n <= m)%N -> - le (\big[op/x]_(i < n | P i) F i) (\big[op/x]_(i < m | P i) F i). +End order_min. + +(**************************) +(* MathComp 2.1 additions *) +(**************************) + +From mathcomp Require Import poly. + +Definition coefE := + (coef0, coef1, coefC, coefX, coefXn, + coefZ, coefMC, coefCM, coefXnM, coefMXn, coefXM, coefMX, coefMNn, coefMn, + coefN, coefB, coefD, + coef_cons, coef_Poly, coef_poly, + coef_deriv, coef_nderivn, coef_derivn, coef_map, coef_sum, + coef_comp_poly). + +Module Export Pdeg2. + +Module Export Field. + +Section Pdeg2Field. +Variable F : fieldType. +Hypothesis nz2 : 2%:R != 0 :> F. + +Variable p : {poly F}. +Hypothesis degp : size p = 3%N. + +Let a := p`_2. +Let b := p`_1. +Let c := p`_0. + +Let pneq0 : p != 0. Proof. by rewrite -size_poly_gt0 degp. Qed. +Let aneq0 : a != 0. +Proof. by move: pneq0; rewrite -lead_coef_eq0 lead_coefE degp. Qed. +Let a2neq0 : 2%:R * a != 0. Proof. by rewrite mulf_neq0. Qed. +Let sqa2neq0 : (2%:R * a) ^+ 2 != 0. Proof. exact: expf_neq0. Qed. + +Let aa4 : 4%:R * a * a = (2%:R * a)^+2. +Proof. by rewrite expr2 mulrACA mulrA -natrM. Qed. + +Let splitr (x : F) : x = x / 2%:R + x / 2%:R. Proof. -by move=> nm; rewrite (big_ord_widen_cond m)// sub_big => //= ? /andP[]. +apply: (mulIf nz2); rewrite -mulrDl mulfVK//. +by rewrite -[2%:R]/(1 + 1)%:R natrD mulrDr mulr1. Qed. -Lemma subset_big [I : finType] [A A' P : {pred I}] (F : I -> R) : - A \subset A' -> - le (\big[op/x]_(i in A | P i) F i) (\big[op/x]_(i in A' | P i) F i). +Let pE : p = a *: 'X^2 + b *: 'X + c%:P. Proof. -move=> AA'; apply: sub_big => y /andP[yA yP]; apply/andP; split => //. -exact: subsetP yA. +apply/polyP => + /[!coefE] => -[|[|[|i]]] /=; rewrite !Monoid.simpm//. +by rewrite nth_default// degp. Qed. -Lemma subset_big_cond (I : finType) (A A' P P' : {pred I}) (F : I -> R) : - [set i in A | P i] \subset [set i in A' | P' i] -> - le (\big[op/x]_(i in A | P i) F i) (\big[op/x]_(i in A' | P' i) F i). -Proof. by move=> /subsetP AP; apply: sub_big => i; have /[!inE] := AP i. Qed. +Let delta := b ^+ 2 - 4%:R * a * c. -Lemma le_big_nat_cond n m n' m' (P P' : {pred nat}) (F : nat -> R) : - (n' <= n)%N -> (m <= m')%N -> (forall i, (n <= i < m)%N -> P i -> P' i) -> - le (\big[op/x]_(n <= i < m | P i) F i) (\big[op/x]_(n' <= i < m' | P' i) F i). +Lemma deg2_poly_canonical : + p = a *: (('X + (b / (2%:R * a))%:P)^+2 - (delta / (4%:R * a ^+ 2))%:P). Proof. -move=> len'n lemm' PP'i; rewrite uniq_sub_big_cond ?filter_uniq ?iota_uniq//. -move=> i; rewrite !mem_filter !mem_index_iota => /and3P[Pi ni im]. -by rewrite PP'i ?ni//= (leq_trans _ ni)// (leq_trans im). +rewrite pE sqrrD -!addrA scalerDr; congr +%R; rewrite addrA scalerDr; congr +%R. +- rewrite -mulrDr -polyCD -!mul_polyC mulrA mulrAC -polyCM. + by rewrite [a * _]mulrC mulrDl invfM -!mulrA mulVf// mulr1 -splitr. +- rewrite [a ^+ 2]expr2 mulrA aa4 -polyC_exp -polyCB expr_div_n -mulrBl subKr. + by rewrite -mul_polyC -polyCM mulrCA mulrACA aa4 mulrCA mulfV// mulr1. Qed. -Lemma le_big_nat n m n' m' [P] [F : nat -> R] : (n' <= n)%N -> (m <= m')%N -> - le (\big[op/x]_(n <= i < m | P i) F i) (\big[op/x]_(n' <= i < m' | P i) F i). -Proof. by move=> len'n lemm'; rewrite le_big_nat_cond. Qed. +Variable r : F. +Hypothesis r_sqrt_delta : r ^+ 2 = delta. + +Let r1 := (- b - r) / (2%:R * a). +Let r2 := (- b + r) / (2%:R * a). -Lemma le_big_ord_cond n m (P P' : {pred nat}) (F : nat -> R) : - (n <= m)%N -> (forall i : 'I_n, P i -> P' i) -> - le (\big[op/x]_(i < n | P i) F i) (\big[op/x]_(i < m | P' i) F i). +Lemma deg2_poly_factor : p = a *: ('X - r1%:P) * ('X - r2%:P). Proof. -move=> nm PP'; rewrite -!big_mkord le_big_nat_cond//= => i ni. -by have := PP' (Ordinal ni). +rewrite [p]deg2_poly_canonical//= -/a -/b -/c -/delta /r1 /r2. +rewrite ![(- b + _) * _]mulrDl 2!polyCD 2!opprD 2!addrA !mulNr !polyCN !opprK. +rewrite -scalerAl [in RHS]mulrC -subr_sqr -polyC_exp -[4%:R]/(2 * 2)%:R natrM. +by rewrite -expr2 -exprMn [in RHS]exprMn exprVn r_sqrt_delta. Qed. -End SemiGroupProperties. +End Pdeg2Field. +End Field. -Section bigmaxmin. -Local Notation max := Order.max. -Local Notation min := Order.min. -Local Open Scope order_scope. -Variables (d : _) (T : porderType d). -Variables (I : Type) (r : seq I) (f : I -> T) (x0 x : T) (P : pred I). +Module Real. -Lemma bigmax_le : - x0 <= x -> (forall i, P i -> f i <= x) -> \big[max/x0]_(i <- r | P i) f i <= x. -Proof. by move=> ? ?; elim/big_ind: _ => // *; rewrite maxEle; case: ifPn. Qed. +Section Pdeg2Real. -Lemma bigmax_lt : - x0 < x -> (forall i, P i -> f i < x) -> \big[max/x0]_(i <- r | P i) f i < x. -Proof. by move=> ? ?; elim/big_ind: _ => // *; rewrite maxElt; case: ifPn. Qed. +Variable F : realFieldType. -Lemma lt_bigmin : - x < x0 -> (forall i, P i -> x < f i) -> x < \big[min/x0]_(i <- r | P i) f i. -Proof. by move=> ? ?; elim/big_ind: _ => // *; rewrite minElt; case: ifPn. Qed. +Section Pdeg2RealConvex. -Lemma le_bigmin : - x <= x0 -> (forall i, P i -> x <= f i) -> x <= \big[min/x0]_(i <- r | P i) f i. -Proof. by move=> ? ?; elim/big_ind: _ => // *; rewrite minEle; case: ifPn. Qed. +Variable p : {poly F}. +Hypothesis degp : size p = 3%N. -End bigmaxmin. +Let a := p`_2. +Let b := p`_1. +Let c := p`_0. -Section bigmax. -Local Notation max := Order.max. -Local Open Scope order_scope. -Variables (d : unit) (T : orderType d). +Hypothesis age0 : 0 <= a. -Section bigmax_Type. -Variables (I : Type) (r : seq I) (x : T). -Implicit Types (P a : pred I) (F : I -> T). +Let delta := b ^+ 2 - 4%:R * a * c. -Lemma bigmax_mkcond P F : \big[max/x]_(i <- r | P i) F i = - \big[max/x]_(i <- r) (if P i then F i else x). -Proof. by rewrite big_mkcond_idem ?maxxx//; [exact: maxA|exact: maxC]. Qed. +Let pneq0 : p != 0. Proof. by rewrite -size_poly_gt0 degp. Qed. +Let aneq0 : a != 0. +Proof. by move: pneq0; rewrite -lead_coef_eq0 lead_coefE degp. Qed. +Let agt0 : 0 < a. Proof. by rewrite lt_def aneq0. Qed. +Let a4gt0 : 0 < 4%:R * a. Proof. by rewrite mulr_gt0 ?ltr0n. Qed. -Lemma bigmax_split P F1 F2 : - \big[max/x]_(i <- r | P i) (max (F1 i) (F2 i)) = - max (\big[max/x]_(i <- r | P i) F1 i) (\big[max/x]_(i <- r | P i) F2 i). -Proof. by rewrite big_split_idem ?maxxx//; [exact: maxA|exact: maxC]. Qed. +Lemma deg2_poly_min x : p.[- b / (2%:R * a)] <= p.[x]. +Proof. +rewrite [p]deg2_poly_canonical ?pnatr_eq0// -/a -/b -/c /delta !hornerE/=. +by rewrite ler_pM2l// lerD2r addrC mulNr subrr ?mulr0 ?expr0n sqr_ge0. +Qed. -Lemma bigmax_idl P F : - \big[max/x]_(i <- r | P i) F i = max x (\big[max/x]_(i <- r | P i) F i). -Proof. by rewrite maxC big_id_idem ?maxxx//; exact: maxA. Qed. +Lemma deg2_poly_minE : p.[- b / (2%:R * a)] = - delta / (4%:R * a). +Proof. +rewrite [p]deg2_poly_canonical ?pnatr_eq0// -/a -/b -/c -/delta !hornerE/=. +rewrite -?expr2 [X in X^+2]addrC [in LHS]mulNr subrr expr0n add0r mulNr. +by rewrite mulrC mulNr invfM mulrA mulfVK. +Qed. -Lemma bigmax_idr P F : - \big[max/x]_(i <- r | P i) F i = max (\big[max/x]_(i <- r | P i) F i) x. -Proof. by rewrite [LHS]bigmax_idl maxC. Qed. +Lemma deg2_poly_ge0 : reflect (forall x, 0 <= p.[x]) (delta <= 0). +Proof. +apply/(iffP idP) => [dlt0 x | /(_ (- b / (2%:R * a)))]; last first. + by rewrite deg2_poly_minE ler_pdivlMr// mul0r oppr_ge0. +apply: le_trans (deg2_poly_min _). +by rewrite deg2_poly_minE ler_pdivlMr// mul0r oppr_ge0. +Qed. -Lemma bigmaxID a P F : \big[max/x]_(i <- r | P i) F i = - max (\big[max/x]_(i <- r | P i && a i) F i) - (\big[max/x]_(i <- r | P i && ~~ a i) F i). -Proof. by rewrite (bigID_idem maxA maxC _ _ a) ?maxxx. Qed. +End Pdeg2RealConvex. -End bigmax_Type. +End Pdeg2Real. -Let le_maxr_id (x y : T) : x <= max x y. Proof. by rewrite le_maxr lexx. Qed. +Section Pdeg2RealClosed. -Lemma sub_bigmax [x0] I s (P P' : {pred I}) (F : I -> T) : - (forall i, P i -> P' i) -> - \big[max/x0]_(i <- s | P i) F i <= \big[max/x0]_(i <- s | P' i) F i. -Proof. exact: (sub_big maxA maxC). Qed. +Variable F : rcfType. -Lemma sub_bigmax_seq [x0] (I : eqType) s s' P (F : I -> T) : {subset s <= s'} -> - \big[max/x0]_(i <- s | P i) F i <= \big[max/x0]_(i <- s' | P i) F i. -Proof. exact: (sub_big_idem maxA maxC maxxx). Qed. +Section Pdeg2RealClosedConvex. -Lemma sub_bigmax_cond [x0] (I : eqType) s s' P P' (F : I -> T) : - {subset [seq i <- s | P i] <= [seq i <- s' | P' i]} -> - \big[max/x0]_(i <- s | P i) F i <= \big[max/x0]_(i <- s' | P' i) F i. -Proof. exact: (sub_big_idem_cond maxA maxC maxxx). Qed. +Variable p : {poly F}. +Hypothesis degp : size p = 3%N. -Lemma sub_in_bigmax [x0] [I : eqType] (s : seq I) (P P' : {pred I}) (F : I -> T) : - {in s, forall i, P i -> P' i} -> - \big[max/x0]_(i <- s | P i) F i <= \big[max/x0]_(i <- s | P' i) F i. -Proof. exact: (sub_in_big maxA maxC). Qed. +Let a := p`_2. +Let b := p`_1. +Let c := p`_0. -Lemma le_bigmax_nat [x0] n m n' m' P (F : nat -> T) : n' <= n -> m <= m' -> - \big[max/x0]_(n <= i < m | P i) F i <= \big[max/x0]_(n' <= i < m' | P i) F i. -Proof. exact: (le_big_nat maxA maxC). Qed. +Let nz2 : 2%:R != 0 :> F. Proof. by rewrite pnatr_eq0. Qed. -Lemma le_bigmax_nat_cond [x0] n m n' m' (P P' : {pred nat}) (F : nat -> T) : - (n' <= n)%N -> (m <= m')%N -> (forall i, n <= i < m -> P i -> P' i) -> - \big[max/x0]_(n <= i < m | P i) F i <= \big[max/x0]_(n' <= i < m' | P' i) F i. -Proof. exact: (le_big_nat_cond maxA maxC). Qed. +Let delta := b ^+ 2 - 4%:R * a * c. -Lemma le_bigmax_ord [x0] n m (P : {pred nat}) (F : nat -> T) : (n <= m)%N -> - \big[max/x0]_(i < n | P i) F i <= \big[max/x0]_(i < m | P i) F i. -Proof. exact: (le_big_ord maxA maxC). Qed. +Let r1 := (- b - Num.sqrt delta) / (2%:R * a). +Let r2 := (- b + Num.sqrt delta) / (2%:R * a). -Lemma le_bigmax_ord_cond [x0] n m (P P' : {pred nat}) (F : nat -> T) : - (n <= m)%N -> (forall i : 'I_n, P i -> P' i) -> - \big[max/x0]_(i < n | P i) F i <= \big[max/x0]_(i < m | P' i) F i. -Proof. exact: (le_big_ord_cond maxA maxC). Qed. +Lemma deg2_poly_factor : 0 <= delta -> p = a *: ('X - r1%:P) * ('X - r2%:P). +Proof. by move=> dge0; apply: deg2_poly_factor; rewrite ?sqr_sqrtr. Qed. -Lemma subset_bigmax [x0] [I : finType] (A A' P : {pred I}) (F : I -> T) : - A \subset A' -> - \big[max/x0]_(i in A | P i) F i <= \big[max/x0]_(i in A' | P i) F i. -Proof. exact: (subset_big maxA maxC). Qed. +End Pdeg2RealClosedConvex. -Lemma subset_bigmax_cond [x0] (I : finType) (A A' P P' : {pred I}) (F : I -> T) : - [set i in A | P i] \subset [set i in A' | P' i] -> - \big[max/x0]_(i in A | P i) F i <= \big[max/x0]_(i in A' | P' i) F i. -Proof. exact: (subset_big_cond maxA maxC). Qed. +End Pdeg2RealClosed. +End Real. -Section bigmax_finType. -Variables (I : finType) (x : T). -Implicit Types (P : pred I) (F : I -> T). +End Pdeg2. -Lemma bigmaxD1 j P F : P j -> - \big[max/x]_(i | P i) F i = max (F j) (\big[max/x]_(i | P i && (i != j)) F i). -Proof. by move/(bigD1_AC maxA maxC) ->. Qed. +Section Degle2PolyRealConvex. -Lemma le_bigmax_cond j P F : P j -> F j <= \big[max/x]_(i | P i) F i. -Proof. by move=> Pj; rewrite (bigmaxD1 _ Pj) le_maxr lexx. Qed. +Variable (F : realFieldType) (p : {poly F}). +Hypothesis degp : (size p <= 3)%N. -Lemma le_bigmax F j : F j <= \big[max/x]_i F i. -Proof. exact: le_bigmax_cond. Qed. +Let a := p`_2. +Let b := p`_1. +Let c := p`_0. -(* NB: as of [2022-08-02], bigop.bigmax_sup already exists for nat *) -Lemma bigmax_sup j P m F : P j -> m <= F j -> m <= \big[max/x]_(i | P i) F i. -Proof. by move=> Pj ?; apply: le_trans (le_bigmax_cond _ Pj). Qed. +Let delta := b ^+ 2 - 4%:R * a * c. -Lemma bigmax_leP m P F : reflect (x <= m /\ forall i, P i -> F i <= m) - (\big[max/x]_(i | P i) F i <= m). +Lemma deg_le2_poly_delta_ge0 : 0 <= a -> (forall x, 0 <= p.[x]) -> delta <= 0. Proof. -apply: (iffP idP) => [|[? ?]]; last exact: bigmax_le. -rewrite bigmax_idl le_maxl => /andP[-> leFm]; split=> // i Pi. -by apply: le_trans leFm; exact: le_bigmax_cond. +move=> age0 pge0; move: degp; rewrite leq_eqVlt => /orP[/eqP|] degp'. + exact/(Real.deg2_poly_ge0 degp' age0). +have a0 : a = 0 by rewrite /a nth_default. +rewrite /delta a0 mulr0 mul0r subr0 exprn_even_le0//=. +have [//|/eqP nzb] := eqP; move: (pge0 ((- 1 - c) / b)). +have -> : p = b *: 'X + c%:P. + apply/polyP => + /[!coefE] => -[|[|i]] /=; rewrite !Monoid.simpm//. + by rewrite nth_default// -ltnS (leq_trans degp'). +by rewrite !hornerE/= mulrAC mulfV// mul1r subrK ler0N1. Qed. -Lemma bigmax_ltP m P F : - reflect (x < m /\ forall i, P i -> F i < m) (\big[max/x]_(i | P i) F i < m). -Proof. -apply: (iffP idP) => [|[? ?]]; last exact: bigmax_lt. -rewrite bigmax_idl lt_maxl => /andP[-> ltFm]; split=> // i Pi. -by apply: le_lt_trans ltFm; exact: le_bigmax_cond. -Qed. +End Degle2PolyRealConvex. -Lemma bigmax_eq_arg j P F : P j -> (forall i, P i -> x <= F i) -> - \big[max/x]_(i | P i) F i = F [arg max_(i > j | P i) F i]. -Proof. -move=> Pi0; case: arg_maxP => //= i Pi PF PxF. -apply/eqP; rewrite eq_le le_bigmax_cond // andbT. -by apply/bigmax_leP; split => //; exact: PxF. -Qed. +Section Degle2PolyRealClosedConvex. + +Variable (F : rcfType) (p : {poly F}). +Hypothesis degp : (size p <= 3)%N. -Lemma eq_bigmax j P F : P j -> (forall i, P i -> x <= F i) -> - {i0 | i0 \in I & \big[max/x]_(i | P i) F i = F i0}. -Proof. by move=> Pi0 Hx; rewrite (bigmax_eq_arg Pi0) //; eexists. Qed. +Let a := p`_2. +Let b := p`_1. +Let c := p`_0. -Lemma le_bigmax2 P F1 F2 : (forall i, P i -> F1 i <= F2 i) -> - \big[max/x]_(i | P i) F1 i <= \big[max/x]_(i | P i) F2 i. +Let delta := b ^+ 2 - 4%:R * a * c. + +Lemma deg_le2_poly_ge0 : (forall x, 0 <= p.[x]) -> delta <= 0. Proof. -move=> FG; elim/big_ind2 : _ => // a b e f ba fe. -rewrite le_maxr 2!le_maxl ba fe /= andbT; have [//|/= af] := leP f a. -by rewrite (le_trans ba) // (le_trans _ fe) // ltW. +have [age0|alt0] := leP 0 a; first exact: deg_le2_poly_delta_ge0. +move=> pge0; move: degp; rewrite leq_eqVlt => /orP[/eqP|] degp'; last first. + by move: alt0; rewrite /a nth_default ?ltxx. +have [//|dge0] := leP delta 0. +pose r1 := (- b - Num.sqrt delta) / (2%:R * a). +pose r2 := (- b + Num.sqrt delta) / (2%:R * a). +pose x0 := Num.max (r1 + 1) (r2 + 1). +move: (pge0 x0); rewrite (Real.deg2_poly_factor degp' (ltW dge0)). +rewrite !hornerE/= -mulrA nmulr_rge0// leNgt => /negbTE<-. +by apply: mulr_gt0; rewrite subr_gt0 lt_maxr ltrDl ltr01 ?orbT. Qed. -End bigmax_finType. - -End bigmax. -Arguments bigmax_mkcond {d T I r}. -Arguments bigmaxID {d T I r}. -Arguments bigmaxD1 {d T I x} j. -Arguments bigmax_sup {d T I x} j. -Arguments bigmax_eq_arg {d T I} x j. -Arguments eq_bigmax {d T I x} j. +End Degle2PolyRealClosedConvex. -Section bigmin. -Local Notation min := Order.min. -Local Open Scope order_scope. -Variables (d : _) (T : orderType d). - -Section bigmin_Type. -Variable (I : Type) (r : seq I) (x : T). -Implicit Types (P a : pred I) (F : I -> T). - -Lemma bigmin_mkcond P F : \big[min/x]_(i <- r | P i) F i = - \big[min/x]_(i <- r) (if P i then F i else x). -Proof. rewrite big_mkcond_idem ?minxx//; [exact: minA|exact: minC]. Qed. - -Lemma bigmin_split P F1 F2 : - \big[min/x]_(i <- r | P i) (min (F1 i) (F2 i)) = - min (\big[min/x]_(i <- r | P i) F1 i) (\big[min/x]_(i <- r | P i) F2 i). -Proof. rewrite big_split_idem ?minxx//; [exact: minA|exact: minC]. Qed. - -Lemma bigmin_idl P F : - \big[min/x]_(i <- r | P i) F i = min x (\big[min/x]_(i <- r | P i) F i). -Proof. rewrite minC big_id_idem ?minxx//; exact: minA. Qed. - -Lemma bigmin_idr P F : - \big[min/x]_(i <- r | P i) F i = min (\big[min/x]_(i <- r | P i) F i) x. -Proof. by rewrite [LHS]bigmin_idl minC. Qed. - -Lemma bigminID a P F : \big[min/x]_(i <- r | P i) F i = - min (\big[min/x]_(i <- r | P i && a i) F i) - (\big[min/x]_(i <- r | P i && ~~ a i) F i). -Proof. by rewrite (bigID_idem minA minC _ _ a) ?minxx. Qed. - -End bigmin_Type. - -Let le_minr_id (x y : T) : x >= min x y. Proof. by rewrite le_minl lexx. Qed. - -Lemma sub_bigmin [x0] I s (P P' : {pred I}) (F : I -> T) : - (forall i, P' i -> P i) -> - \big[min/x0]_(i <- s | P i) F i <= \big[min/x0]_(i <- s | P' i) F i. -Proof. exact: (sub_big minA minC ge_refl). Qed. - -Lemma sub_bigmin_cond [x0] (I : eqType) s s' P P' (F : I -> T) : - {subset [seq i <- s | P i] <= [seq i <- s' | P' i]} -> - \big[min/x0]_(i <- s' | P' i) F i <= \big[min/x0]_(i <- s | P i) F i. -Proof. exact: (sub_big_idem_cond minA minC minxx ge_refl). Qed. - -Lemma sub_bigmin_seq [x0] (I : eqType) s s' P (F : I -> T) : {subset s' <= s} -> - \big[min/x0]_(i <- s | P i) F i <= \big[min/x0]_(i <- s' | P i) F i. -Proof. exact: (sub_big_idem minA minC minxx ge_refl). Qed. - -Lemma sub_in_bigmin [x0] [I : eqType] (s : seq I) (P P' : {pred I}) (F : I -> T) : - {in s, forall i, P' i -> P i} -> - \big[min/x0]_(i <- s | P i) F i <= \big[min/x0]_(i <- s | P' i) F i. -Proof. exact: (sub_in_big minA minC ge_refl). Qed. - -Lemma le_bigmin_nat [x0] n m n' m' P (F : nat -> T) : - (n <= n')%N -> (m' <= m)%N -> - \big[min/x0]_(n <= i < m | P i) F i <= \big[min/x0]_(n' <= i < m' | P i) F i. -Proof. exact: (le_big_nat minA minC ge_refl). Qed. - -Lemma le_bigmin_nat_cond [x0] n m n' m' (P P' : pred nat) (F : nat -> T) : - (n <= n')%N -> (m' <= m)%N -> (forall i, n' <= i < m' -> P' i -> P i) -> - \big[min/x0]_(n <= i < m | P i) F i <= \big[min/x0]_(n' <= i < m' | P' i) F i. -Proof. exact: (le_big_nat_cond minA minC ge_refl). Qed. - -Lemma le_bigmin_ord [x0] n m (P : pred nat) (F : nat -> T) : (m <= n)%N -> - \big[min/x0]_(i < n | P i) F i <= \big[min/x0]_(i < m | P i) F i. -Proof. exact: (le_big_ord minA minC ge_refl). Qed. - -Lemma le_bigmin_ord_cond [x0] n m (P P' : pred nat) (F : nat -> T) : - (m <= n)%N -> (forall i : 'I_m, P' i -> P i) -> - \big[min/x0]_(i < n | P i) F i <= \big[min/x0]_(i < m | P' i) F i. -Proof. exact: (le_big_ord_cond minA minC ge_refl). Qed. - -Lemma subset_bigmin [x0] [I : finType] [A A' P : {pred I}] (F : I -> T) : - A' \subset A -> - \big[min/x0]_(i in A | P i) F i <= \big[min/x0]_(i in A' | P i) F i. -Proof. exact: (subset_big minA minC ge_refl). Qed. - -Lemma subset_bigmin_cond [x0] (I : finType) (A A' P P' : {pred I}) (F : I -> T) : - [set i in A' | P' i] \subset [set i in A | P i] -> - \big[min/x0]_(i in A | P i) F i <= \big[min/x0]_(i in A' | P' i) F i. -Proof. exact: (subset_big_cond minA minC ge_refl). Qed. - -Section bigmin_finType. -Variable (I : finType) (x : T). -Implicit Types (P : pred I) (F : I -> T). - -Lemma bigminD1 j P F : P j -> - \big[min/x]_(i | P i) F i = min (F j) (\big[min/x]_(i | P i && (i != j)) F i). -Proof. by move/(bigD1_AC minA minC) ->. Qed. - -Lemma bigmin_le_cond j P F : P j -> \big[min/x]_(i | P i) F i <= F j. +(* not yet backported *) +Lemma deg_le2_ge0 (F : rcfType) (a b c : F) : + (forall x, 0 <= a * x ^+ 2 + b * x + c)%R -> (b ^+ 2 - 4%:R * a * c <= 0)%R. Proof. -have := mem_index_enum j; rewrite unlock; elim: (index_enum I) => //= i l ih. -rewrite inE => /orP [/eqP-> ->|/ih leminlfi Pi]; first by rewrite le_minl lexx. -by case: ifPn => Pj; [rewrite le_minl leminlfi// orbC|exact: leminlfi]. +move=> pge0; pose p := \poly_(i < 3) [:: c; b; a]`_i. +have := @deg_le2_poly_ge0 _ p (size_poly _ _); rewrite !coef_poly/=; apply=> r. +rewrite horner_poly !big_ord_recr !big_ord0/= !Monoid.simpm/= expr1. +by rewrite -mulrA -expr2 addrC addrA addrAC. Qed. -Lemma bigmin_le j F : \big[min/x]_i F i <= F j. -Proof. exact: bigmin_le_cond. Qed. - -Lemma bigmin_inf j P m F : P j -> F j <= m -> \big[min/x]_(i | P i) F i <= m. -Proof. by move=> Pj ?; apply: le_trans (bigmin_le_cond _ Pj) _. Qed. +(* NB: Coq 8.17.0 generalizes dependent_choice from Set to Type + making the following lemma redundant *) +Section dependent_choice_Type. +Context X (R : X -> X -> Prop). -Lemma bigmin_geP m P F : reflect (m <= x /\ forall i, P i -> m <= F i) - (m <= \big[min/x]_(i | P i) F i). +Lemma dependent_choice_Type : (forall x, {y | R x y}) -> + forall x0, {f | f 0%N = x0 /\ forall n, R (f n) (f n.+1)}. Proof. -apply: (iffP idP) => [lemFi|[lemx lemPi]]; [split|exact: le_bigmin]. -- by rewrite (le_trans lemFi)// bigmin_idl le_minl lexx. -- by move=> i Pi; rewrite (le_trans lemFi)// (bigminD1 _ Pi)// le_minl lexx. +move=> h x0. +set (f := fix f n := if n is n'.+1 then proj1_sig (h (f n')) else x0). +exists f; split => //. +intro n; induction n; simpl; apply: proj2_sig. Qed. +End dependent_choice_Type. -Lemma bigmin_gtP m P F : - reflect (m < x /\ forall i, P i -> m < F i) (m < \big[min/x]_(i | P i) F i). +Section max_min. +Variable R : realFieldType. +Import Num.Theory. + +Let nz2 : 2%:R != 0 :> R. Proof. by rewrite pnatr_eq0. Qed. + +Lemma maxr_absE (x y : R) : Num.max x y = (x + y + `|x - y|) / 2%:R. Proof. -apply: (iffP idP) => [lemFi|[lemx lemPi]]; [split|exact: lt_bigmin]. -- by rewrite (lt_le_trans lemFi)// bigmin_idl le_minl lexx. -- by move=> i Pi; rewrite (lt_le_trans lemFi)// (bigminD1 _ Pi)// le_minl lexx. +apply: canRL (mulfK _) _ => //; rewrite ?pnatr_eq0//. +case: lerP => _; (* TODO: ring *) rewrite [2%:R]mulr2n mulrDr mulr1. + by rewrite addrACA subrr addr0. +by rewrite addrCA addrAC subrr add0r. Qed. -Lemma bigmin_eq_arg j P F : P j -> (forall i, P i -> F i <= x) -> - \big[min/x]_(i | P i) F i = F [arg min_(i < j | P i) F i]. +Lemma minr_absE (x y : R) : Num.min x y = (x + y - `|x - y|) / 2%:R. Proof. -move=> Pi0; case: arg_minP => //= i Pi PF PFx. -apply/eqP; rewrite eq_le bigmin_le_cond //=. -by apply/bigmin_geP; split => //; exact: PFx. +apply: (addrI (Num.max x y)); rewrite addr_max_min maxr_absE. (* TODO: ring *) +by rewrite -mulrDl addrACA subrr addr0 mulrDl -splitr. Qed. -Lemma eq_bigmin j P F : P j -> (forall i, P i -> F i <= x) -> - {i0 | i0 \in I & \big[min/x]_(i | P i) F i = F i0}. -Proof. by move=> Pi0 Hx; rewrite (bigmin_eq_arg Pi0) //; eexists. Qed. - -End bigmin_finType. +End max_min. -End bigmin. -Arguments bigmin_mkcond {d T I r}. -Arguments bigminID {d T I r}. -Arguments bigminD1 {d T I x} j. -Arguments bigmin_inf {d T I x} j. -Arguments bigmin_eq_arg {d T I} x j. -Arguments eq_bigmin {d T I x} j. - -Section onem. -Variable R : numDomainType. -Implicit Types r : R. - -Definition onem r := 1 - r. -Local Notation "`1- r" := (onem r). +Notation trivial := (ltac:(done)). -Lemma onem0 : `1-0 = 1. Proof. by rewrite /onem subr0. Qed. +Section bigmax_seq. +Context d {T : orderType d} {x : T} {I : eqType}. +Variables (r : seq I) (i0 : I) (P : pred I). -Lemma onem1 : `1-1 = 0. Proof. by rewrite /onem subrr. Qed. +(* NB: as of [2023-08-28], bigop.leq_bigmax_seq already exists for nat *) +Lemma le_bigmax_seq F : + i0 \in r -> P i0 -> (F i0 <= \big[Order.max/x]_(i <- r | P i) F i)%O. +Proof. +move=> + Pi0; elim: r => // h t ih; rewrite inE big_cons. +move=> /predU1P[<-|i0t]; first by rewrite Pi0 le_maxr// lexx. +by case: ifPn => Ph; [rewrite le_maxr ih// orbT|rewrite ih]. +Qed. -Lemma onemK r : `1-(`1-r) = r. -Proof. by rewrite /onem opprB addrCA subrr addr0. Qed. +(* NB: as of [2023-08-28], bigop.bigmax_sup_seq already exists for nat *) +Lemma bigmax_sup_seq (m : T) (F : I -> T) : + i0 \in r -> P i0 -> (m <= F i0)%O -> + (m <= \big[Order.max/x]_(i <- r | P i) F i)%O. +Proof. by move=> i0r Pi0 ?; apply: le_trans (le_bigmax_seq _ _ _). Qed. -Lemma add_onemK r : r + `1- r = 1. -Proof. by rewrite /onem addrC subrK. Qed. +End bigmax_seq. +Arguments le_bigmax_seq {d T} x {I r} i0 P. -Lemma onem_gt0 r : r < 1 -> 0 < `1-r. Proof. by rewrite subr_gt0. Qed. +(* NB: PR 1079 to MathComp in progress *) +Lemma gerBl {R : numDomainType} (x y : R) : 0 <= y -> x - y <= x. +Proof. by move=> y0; rewrite lerBlDl lerDr. Qed. -Lemma onem_ge0 r : r <= 1 -> 0 <= `1-r. -Proof. by rewrite le_eqVlt => /predU1P[->|/onem_gt0/ltW]; rewrite ?onem1. Qed. +(* the following appears in MathComp 2.1.0 and MathComp 1.18.0 *) +Section normr. +Variable R : realDomainType. -Lemma onem_le1 r : 0 <= r -> `1-r <= 1. -Proof. by rewrite ler_subl_addr ler_addl. Qed. +Definition Rnpos : qualifier 0 R := [qualify x : R | x <= 0]. +Lemma nposrE x : (x \is Rnpos) = (x <= 0). Proof. by []. Qed. -Lemma onem_lt1 r : 0 < r -> `1-r < 1. -Proof. by rewrite ltr_subl_addr ltr_addl. Qed. +Lemma ger0_le_norm : + {in Num.nneg &, {mono (@Num.Def.normr _ R) : x y / x <= y}}. +Proof. by move=> x y; rewrite !nnegrE => x0 y0; rewrite !ger0_norm. Qed. -Lemma onemX_ge0 r n : 0 <= r -> r <= 1 -> 0 <= `1-(r ^+ n). -Proof. by move=> ? ?; rewrite subr_ge0 exprn_ile1. Qed. +Lemma gtr0_le_norm : + {in Num.pos &, {mono (@Num.Def.normr _ R) : x y / x <= y}}. +Proof. by move=> x y; rewrite !posrE => /ltW x0 /ltW y0; exact: ger0_le_norm. Qed. -Lemma onemX_lt1 r n : 0 < r -> `1-(r ^+ n) < 1. -Proof. by move=> ?; rewrite onem_lt1// exprn_gt0. Qed. +Lemma ler0_ge_norm : + {in Rnpos &, {mono (@Num.Def.normr _ R) : x y / x <= y >-> x >= y}}. +Proof. +move=> x y; rewrite !nposrE => x0 y0. +by rewrite !ler0_norm// -subr_ge0 opprK addrC subr_ge0. +Qed. -Lemma onemD r s : `1-(r + s) = `1-r - s. -Proof. by rewrite /onem addrAC opprD addrA addrAC. Qed. +Lemma ltr0_ge_norm : + {in Num.neg &, {mono (@Num.Def.normr _ R) : x y / x <= y >-> x >= y}}. +Proof. by move=> x y; rewrite !negrE => /ltW x0 /ltW y0; exact: ler0_ge_norm. Qed. -Lemma onemMr r s : s * `1-r = s - s * r. -Proof. by rewrite /onem mulrBr mulr1. Qed. +End normr. -Lemma onemM r s : `1-(r * s) = `1-r + `1-s - `1-r * `1-s. +Lemma leq_ltn_expn m : exists n, (2 ^ n <= m.+1 < 2 ^ n.+1)%N. Proof. -rewrite /onem mulrBr mulr1 mulrBl mul1r opprB -addrA. -by rewrite (addrC (1 - r)) !addrA subrK opprB addrA subrK addrK. +elim: m => [|m [n /andP[h1 h2]]]; first by exists O. +have [m2n|nm2] := ltnP m.+2 (2 ^ n.+1)%N. + by exists n; rewrite m2n andbT (leq_trans h1). +exists n.+1; rewrite nm2/= -addn1. +rewrite -[X in (_ <= X)%N]prednK ?expn_gt0// -[X in (_ <= X)%N]addn1 leq_add2r. +by rewrite (leq_trans h2)// -subn1 leq_subRL ?expn_gt0// add1n ltn_exp2l. Qed. -End onem. -Notation "`1- r" := (onem r) : ring_scope. +Definition monotonous d (T : porderType d) (pT : predType T) (A : pT) (f : T -> T) := + {in A &, {mono f : x y / (x <= y)%O}} \/ {in A &, {mono f : x y /~ (x <= y)%O}}. -Lemma lez_abs2 (a b : int) : 0 <= a -> a <= b -> (`|a| <= `|b|)%N. -Proof. by case: a => //= n _; case: b. Qed. +(* NB: these lemmas have been introduced to develop the theory of bounded variation *) +Section path_lt. +Context d {T : orderType d}. +Implicit Types (a b c : T) (s : seq T). -Lemma ler_gtP (R : numFieldType) (x y : R) : - reflect (forall z, z > y -> x <= z) (x <= y). +Lemma last_filterP a (P : pred T) s : + P a -> P (last a [seq x <- s | P x]). Proof. -apply: (equivP (ler_addgt0Pr _ _)); split=> [xy z|xz e e_gt0]. - by rewrite -subr_gt0 => /xy; rewrite addrC addrNK. -by apply: xz; rewrite -[ltLHS]addr0 ler_lt_add. +by elim: s a => //= t1 t2 ih a Pa; case: ifPn => //= Pt1; exact: ih. Qed. -Lemma ler_ltP (R : numFieldType) (x y : R) : - reflect (forall z, z < x -> z <= y) (x <= y). +Lemma path_lt_filter0 a s : path <%O a s -> [seq x <- s | (x < a)%O] = [::]. Proof. -apply: (equivP (ler_addgt0Pr _ _)); split=> [xy z|xz e e_gt0]. - by rewrite -subr_gt0 => /xy; rewrite addrCA -[leLHS]addr0 ler_add2l subr_ge0. -by rewrite -ler_subl_addr xz// -[ltRHS]subr0 ler_lt_sub. +move=> /lt_path_min/allP sa; rewrite -(filter_pred0 s). +apply: eq_in_filter => x xs. +by apply/negbTE; have := sa _ xs; rewrite ltNge; apply: contra => /ltW. Qed. -Definition inv_fun T (R : unitRingType) (f : T -> R) x := (f x)^-1%R. -Notation "f \^-1" := (inv_fun f) : ring_scope. -Arguments inv_fun {T R} _ _ /. - -Definition bound_side d (T : porderType d) (c : bool) (x : itv_bound T) := - if x is BSide c' _ then c == c' else false. - -Lemma real_ltr_distlC [R : numDomainType] [x y : R] (e : R) : - x - y \is Num.real -> (`|x - y| < e) = (x - e < y < x + e). -Proof. by move=> ?; rewrite distrC real_ltr_distl// -rpredN opprB. Qed. - -Definition proj {I} {T : I -> Type} i (f : forall i, T i) := f i. - -Section DFunWith. -Variables (I : eqType) (T : I -> Type) (f : forall i, T i). - -Definition dfwith i (x : T i) (j : I) : T j := - if (i =P j) is ReflectT ij then ecast j (T j) ij x else f j. - -Lemma dfwithin i x : dfwith x i = x. -Proof. by rewrite /dfwith; case: eqP => // ii; rewrite eq_axiomK. Qed. - -Lemma dfwithout i (x : T i) j : i != j -> dfwith x j = f j. -Proof. by rewrite /dfwith; case: eqP. Qed. - -Variant dfwith_spec i (x : T i) : forall j, T j -> Type := - | DFunWithin : dfwith_spec x x - | DFunWithout j : i != j -> dfwith_spec x (f j). +Lemma path_lt_filterT a s : path <%O a s -> [seq x <- s | (a < x)%O] = s. +Proof. +move=> /lt_path_min/allP sa; rewrite -[RHS](filter_predT s). +by apply: eq_in_filter => x xs; exact: sa. +Qed. -Lemma dfwithP i (x : T i) (j : I) : dfwith_spec x (dfwith x j). +Lemma path_lt_head a b s : (a < b)%O -> path <%O b s -> path <%O a s. Proof. -by case: (eqVneq i j) => [<-|nij]; - [rewrite dfwithin|rewrite dfwithout//]; constructor. +by elim: s b => // h t ih b /= ab /andP[bh ->]; rewrite andbT (lt_trans ab). Qed. -Lemma projK i (x : T i) : cancel (@dfwith i) (proj i). -Proof. by move=> z; rewrite /proj dfwithin. Qed. +(* TODO: this lemma feels a bit too technical, generalize? *) +Lemma path_lt_last_filter a b c s : + (a < c)%O -> (c < b)%O -> path <%O a s -> last a s = b -> + last c [seq x <- s | (c < x)%O] = b. +Proof. +elim/last_ind : s a b c => /= [|h t ih a b c ac cb]. + move=> a b c ac cb _ ab. + by apply/eqP; rewrite eq_le (ltW cb) -ab (ltW ac). +rewrite rcons_path => /andP[ah ht]; rewrite last_rcons => tb. +by rewrite filter_rcons tb cb last_rcons. +Qed. -End DFunWith. -Arguments dfwith {I T} f i x. +Lemma path_lt_le_last a s : path <%O a s -> (a <= last a s)%O. +Proof. +elim: s a => // a [_ c /andP[/ltW//]|b t ih i/= /and3P[ia ab bt]] /=. +have /= := ih a; rewrite ab bt => /(_ erefl). +by apply: le_trans; exact/ltW. +Qed. -Definition swap (T1 T2 : Type) (x : T1 * T2) := (x.2, x.1). +End path_lt. +Arguments last_filterP {d T a} P s. diff --git a/classical/set_interval.v b/classical/set_interval.v index bf7c11c0b..7d13ca4bb 100644 --- a/classical/set_interval.v +++ b/classical/set_interval.v @@ -1,19 +1,26 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From mathcomp Require Import all_ssreflect ssralg ssrnum interval. -Require Import mathcomp_extra boolp classical_sets functions. +From mathcomp Require Import mathcomp_extra boolp classical_sets. From HB Require Import structures. +From mathcomp Require Import functions. -(******************************************************************************) +(**md**************************************************************************) +(* # Sets and Intervals *) +(* *) (* This files contains lemmas about sets and intervals. *) (* *) +(* ``` *) (* neitv i == the interval i is non-empty *) (* when the support type is a numFieldType, this *) (* is equivalent to (i.1 < i.2)%O (lemma neitvE) *) (* set_itv_infty_set0 == multirule to simplify empty intervals *) -(* conv, ndconv == convexity operator *) +(* line_path a b t := (1 - t) * a + t * b, convexity operator over a *) +(* numDomainType *) +(* ndline_path == line_path a b with the constraint that a < b *) (* factor a b x := (x - a) / (b - a) *) (* set_itvE == multirule to turn intervals into inequalities *) (* disjoint_itv i j == intervals i and j are disjoint *) +(* ``` *) (* *) (******************************************************************************) @@ -25,8 +32,8 @@ Import Order.TTheory GRing.Theory Num.Def Num.Theory. Local Open Scope classical_set_scope. Local Open Scope ring_scope. -(* definitions and lemmas to make a bridge between MathComp intervals and *) -(* classical sets *) +(** definitions and lemmas to make a bridge between MathComp intervals and + classical sets *) Section set_itv_porderType. Variables (d : unit) (T : porderType d). Implicit Types (i j : interval T) (x y : T) (a : itv_bound T). @@ -48,6 +55,21 @@ Qed. Lemma subset_itvP i j : {subset i <= j} <-> [set` i] `<=` [set` j]. Proof. by []. Qed. +Lemma in1_subset_itv (P : T -> Prop) i j : + [set` j] `<=` [set` i] -> {in i, forall x, P x} -> {in j, forall x, P x}. +Proof. by move=> /subset_itvP ji iP z zB; apply: iP; exact: ji. Qed. + +Lemma subset_itvW x y z u b0 b1 : + (x <= y)%O -> (z <= u)%O -> + `]y, z[ `<=` [set` Interval (BSide b0 x) (BSide b1 u)]. +Proof. +move=> xy zu; apply: (@subset_trans _ `]x, u[%classic). + move=> x0/=; rewrite 2!in_itv/= => /andP[]. + by move=> /(le_lt_trans xy) ->/= /lt_le_trans; exact. +by move: b0 b1 => [] [] /=; [exact: subset_itv_oo_co|exact: subset_itv_oo_cc| + exact: subset_refl|exact: subset_itv_oo_oc]. +Qed. + Lemma set_itvoo x y : `]x, y[%classic = [set z | (x < z < y)%O]. Proof. by []. Qed. @@ -174,8 +196,8 @@ Qed. Lemma lb_ubN E x : lbound E x <-> ubound (-%R @` E) (- x). Proof. split=> [/lbP xlbE|/ubP xlbE]. -by move=> _ [z Ez <-]; rewrite ler_oppr opprK; apply xlbE. -by move=> y Ey; rewrite -(opprK x) ler_oppl; apply xlbE; exists y. +by move=> _ [z Ez <-]; rewrite lerNr opprK; apply xlbE. +by move=> y Ey; rewrite -(opprK x) lerNl; apply xlbE; exists y. Qed. Lemma ub_lbN E x : ubound E x <-> lbound (-%R @` E) (- x). @@ -221,10 +243,10 @@ Qed. Lemma has_lbPn E : ~ has_lbound E <-> (forall x, exists2 y, E y & y < x). Proof. split=> [/has_lb_ubN /has_ubPn NEnub x|Enlb /has_lb_ubN]. - have [y ENy ltxy] := NEnub (- x); exists (- y); rewrite 1?ltr_oppl //. + have [y ENy ltxy] := NEnub (- x); exists (- y); rewrite 1?ltrNl //. by case: ENy => z Ez <-; rewrite opprK. apply/has_ubPn => x; have [y Ey ltyx] := Enlb (- x). -exists (- y); last by rewrite ltr_oppr. +exists (- y); last by rewrite ltrNr. by exists y => //; rewrite opprK. Qed. @@ -235,10 +257,10 @@ move: a => [b r|[|]] _ //. suff: ~ has_lbound `]-oo, r[%classic. by case: b => //; apply/contra_not/subset_has_lbound => x /ltW. apply/has_lbPn => x; exists (minr (r - 1) (x - 1)). - by rewrite !set_itvE/= lt_minl ltr_subl_addr ltr_addl ltr01. - by rewrite lt_minl orbC ltr_subl_addr ltr_addl ltr01. + by rewrite !set_itvE/= lt_minl ltrBlDr ltrDl ltr01. + by rewrite lt_minl orbC ltrBlDr ltrDl ltr01. case=> r /(_ (r - 1)) /=; rewrite in_itv /= => /(_ erefl). -by apply/negP; rewrite -ltNge ltr_subl_addr ltr_addl. +by apply/negP; rewrite -ltNge ltrBlDr ltrDl. Qed. Lemma hasNubound_itv (a : itv_bound R) : a != +oo%O -> @@ -249,9 +271,9 @@ move: a => [b r|[|]] _ //. case: b => //; apply/contra_not/subset_has_ubound => x. by rewrite !set_itvE => /ltW. apply/has_ubPn => x; rewrite !set_itvE; exists (maxr (r + 1) (x + 1)); - by rewrite ?in_itv /= ?andbT lt_maxr ltr_addl ltr01 // orbT. + by rewrite ?in_itv /= ?andbT lt_maxr ltrDl ltr01 // orbT. case=> r /(_ (r + 1)) /=; rewrite in_itv /= => /(_ erefl). -by apply/negP; rewrite -ltNge ltr_addl. +by apply/negP; rewrite -ltNge ltrDl. Qed. End interval_hasNbound. @@ -268,9 +290,9 @@ Lemma opp_itv_bnd_infty (R : numDomainType) (x : R) b : [set` Interval -oo%O (BSide (negb b) (- x))]. Proof. rewrite predeqE => /= r; split=> [[y xy <-]|xr]. - by case: b xy; rewrite !in_itv/= andbT (ler_opp2, ltr_opp2). + by case: b xy; rewrite !in_itv/= andbT (lerN2, ltrN2). exists (- r); rewrite ?opprK //. -by case: b xr; rewrite !in_itv/= andbT (ler_oppr, ltr_oppr). +by case: b xr; rewrite !in_itv/= andbT (lerNr, ltrNr). Qed. Lemma opp_itv_infty_bnd (R : numDomainType) (x : R) b : @@ -278,9 +300,9 @@ Lemma opp_itv_infty_bnd (R : numDomainType) (x : R) b : [set` Interval (BSide (negb b) (- x)) +oo%O]. Proof. rewrite predeqE => /= r; split=> [[y xy <-]|xr]. - by case: b xy; rewrite !in_itv/= andbT (ler_opp2, ltr_opp2). + by case: b xy; rewrite !in_itv/= andbT (lerN2, ltrN2). exists (- r); rewrite ?opprK //. -by case: b xr; rewrite !in_itv/= andbT (ler_oppl, ltr_oppl). +by case: b xr; rewrite !in_itv/= andbT (lerNl, ltrNl). Qed. Lemma opp_itv_bnd_bnd (R : numDomainType) a b (x y : R) : @@ -288,20 +310,20 @@ Lemma opp_itv_bnd_bnd (R : numDomainType) a b (x y : R) : [set` Interval (BSide (~~ b) (- y)) (BSide (~~ a) (- x))]. Proof. rewrite predeqE => /= r; split => [[{}r + <-]|]. - by rewrite !in_itv/= 2!lteif_opp2 negbK andbC. + by rewrite !in_itv/= 2!lteifN2 negbK andbC. rewrite in_itv/= negbK => yrab. -by exists (- r); rewrite ?opprK// !in_itv lteif_oppr andbC lteif_oppl. +by exists (- r); rewrite ?opprK// !in_itv lteifNr andbC lteifNl. Qed. Lemma opp_itvoo (R : numDomainType) (x y : R) : -%R @` `]x, y[%classic = `](- y), (- x)[%classic. Proof. rewrite predeqE => /= r; split => [[{}r + <-]|]. - by rewrite !in_itv/= !ltr_opp2 andbC. -by exists (- r); rewrite ?opprK// !in_itv/= ltr_oppl ltr_oppr andbC. + by rewrite !in_itv/= !ltrN2 andbC. +by exists (- r); rewrite ?opprK// !in_itv/= ltrNl ltrNr andbC. Qed. -(* lemmas between itv and set-theoretic operations *) +(** lemmas between itv and set-theoretic operations *) Section set_itv_porderType. Variables (d : unit) (T : orderType d). Implicit Types (a : itv_bound T) (x y : T) (i j : interval T) (b : bool). @@ -330,50 +352,52 @@ Proof. by rewrite set_itv_splitI/= setDE setCitvr. Qed. End set_itv_porderType. -Section conv_factor_numDomainType. +Section line_path_factor_numDomainType. Variable R : numDomainType. Implicit Types (a b t r : R) (A : set R). Lemma mem_1B_itvcc t : (1 - t \in `[0, 1]) = (t \in `[0, 1]). -Proof. by rewrite !in_itv/= subr_ge0 ger_addl oppr_le0 andbC. Qed. +Proof. by rewrite !in_itv/= subr_ge0 gerDl oppr_le0 andbC. Qed. -Definition conv a b t : R := (1 - t) * a + t * b. +Definition line_path a b t : R := (1 - t) * a + t * b. -Lemma conv_id : conv 0 1 = id. -Proof. by apply/funext => t; rewrite /conv mulr0 add0r mulr1. Qed. +Lemma line_path_id : line_path 0 1 = id. +Proof. by apply/funext => t; rewrite /line_path mulr0 add0r mulr1. Qed. -Lemma convEl a b t : conv a b t = t * (b - a) + a. -Proof. by rewrite /conv mulrBl mul1r mulrBr addrAC [RHS]addrC addrA. Qed. +Lemma line_pathEl a b t : line_path a b t = t * (b - a) + a. +Proof. by rewrite /line_path mulrBl mul1r mulrBr addrAC [RHS]addrC addrA. Qed. -Lemma convEr a b t : conv a b t = (1 - t) * (a - b) + b. +Lemma line_pathEr a b t : line_path a b t = (1 - t) * (a - b) + b. Proof. -rewrite /conv mulrBr -addrA; congr (_ + _). +rewrite /line_path mulrBr -addrA; congr (_ + _). by rewrite mulrBl opprB mul1r addrNK. Qed. -Lemma conv10 t : conv 1 0 t = 1 - t. -Proof. by rewrite /conv mulr0 addr0 mulr1. Qed. +Lemma line_path10 t : line_path 1 0 t = 1 - t. +Proof. by rewrite /line_path mulr0 addr0 mulr1. Qed. -Lemma conv0 a b : conv a b 0 = a. -Proof. by rewrite /conv subr0 mul1r mul0r addr0. Qed. +Lemma line_path0 a b : line_path a b 0 = a. +Proof. by rewrite /line_path subr0 mul1r mul0r addr0. Qed. -Lemma conv1 a b : conv a b 1 = b. -Proof. by rewrite /conv subrr mul0r add0r mul1r. Qed. +Lemma line_path1 a b : line_path a b 1 = b. +Proof. by rewrite /line_path subrr mul0r add0r mul1r. Qed. -Lemma conv_sym a b t : conv a b t = conv b a (1 - t). -Proof. by rewrite /conv opprB addrCA subrr addr0 addrC. Qed. +Lemma line_path_sym a b t : line_path a b t = line_path b a (1 - t). +Proof. by rewrite /line_path opprB addrCA subrr addr0 addrC. Qed. -Lemma conv_flat a : conv a a = cst a. -Proof. by apply/funext => t; rewrite convEl subrr mulr0 add0r. Qed. +Lemma line_path_flat a : line_path a a = cst a. +Proof. by apply/funext => t; rewrite line_pathEl subrr mulr0 add0r. Qed. -Lemma leW_conv a b : a <= b -> {homo conv a b : x y / x <= y}. -Proof. by move=> ? ? ? ?; rewrite !convEl ler_add ?ler_wpmul2r// subr_ge0. Qed. +Lemma leW_line_path a b : a <= b -> {homo line_path a b : x y / x <= y}. +Proof. +by move=> ? ? ? ?; rewrite !line_pathEl lerD ?ler_wpM2r// subr_ge0. +Qed. Definition factor a b x := (x - a) / (b - a). Lemma leW_factor a b : a <= b -> {homo factor a b : x y / x <= y}. Proof. -by move=> ? ? ? ?; rewrite /factor ler_wpmul2r ?ler_add// invr_ge0 subr_ge0. +by move=> ? ? ? ?; rewrite /factor ler_wpM2r ?lerD// invr_ge0 subr_ge0. Qed. Lemma factor_flat a : factor a a = cst 0. @@ -382,51 +406,56 @@ Proof. by apply/funext => x; rewrite /factor subrr invr0 mulr0. Qed. Lemma factorl a b : factor a b a = 0. Proof. by rewrite /factor subrr mul0r. Qed. -Definition ndconv a b of a < b := conv a b. +Definition ndline_path a b of a < b := line_path a b. -Lemma ndconvE a b (ab : a < b) : ndconv ab = conv a b. Proof. by []. Qed. +Lemma ndline_pathE a b (ab : a < b) : ndline_path ab = line_path a b. +Proof. by []. Qed. -End conv_factor_numDomainType. +End line_path_factor_numDomainType. -Section conv_factor_numFieldType. +Section line_path_factor_numFieldType. Variable R : numFieldType. Implicit Types (a b t r : R) (A : set R). Lemma factorr a b : a != b -> factor a b b = 1. Proof. by move=> Nab; rewrite /factor divff// subr_eq0 eq_sym. Qed. -Lemma factorK a b : a != b -> cancel (factor a b) (conv a b). -Proof. by move=> ? x; rewrite convEl mulfVK ?addrNK// subr_eq0 eq_sym. Qed. +Lemma factorK a b : a != b -> cancel (factor a b) (line_path a b). +Proof. by move=> ? x; rewrite line_pathEl mulfVK ?addrNK// subr_eq0 eq_sym. Qed. -Lemma convK a b : a != b -> cancel (conv a b) (factor a b). -Proof. by move=> ? x; rewrite /factor convEl addrK mulfK// subr_eq0 eq_sym. Qed. +Lemma line_pathK a b : a != b -> cancel (line_path a b) (factor a b). +Proof. +by move=> ? x; rewrite /factor line_pathEl addrK mulfK// subr_eq0 eq_sym. +Qed. -Lemma conv_inj a b : a != b -> injective (conv a b). -Proof. by move/convK/can_inj. Qed. +Lemma line_path_inj a b : a != b -> injective (line_path a b). +Proof. by move/line_pathK/can_inj. Qed. Lemma factor_inj a b : a != b -> injective (factor a b). Proof. by move/factorK/can_inj. Qed. -Lemma conv_bij a b : a != b -> bijective (conv a b). -Proof. by move=> ab; apply: Bijective (convK ab) (factorK ab). Qed. +Lemma line_path_bij a b : a != b -> bijective (line_path a b). +Proof. by move=> ab; apply: Bijective (line_pathK ab) (factorK ab). Qed. Lemma factor_bij a b : a != b -> bijective (factor a b). -Proof. by move=> ab; apply: Bijective (factorK ab) (convK ab). Qed. +Proof. by move=> ab; apply: Bijective (factorK ab) (line_pathK ab). Qed. -Lemma le_conv a b : a < b -> {mono conv a b : x y / x <= y}. +Lemma le_line_path a b : a < b -> {mono line_path a b : x y / x <= y}. Proof. move=> ltab; have leab := ltW ltab. -by apply: homo_mono (convK _) (leW_factor _) (leW_conv _); rewrite // lt_eqF. +apply: homo_mono (line_pathK _) (leW_factor _) (leW_line_path _) => //. +by rewrite lt_eqF. Qed. Lemma le_factor a b : a < b -> {mono factor a b : x y / x <= y}. Proof. move=> ltab; have leab := ltW ltab. -by apply: homo_mono (factorK _) (leW_conv _) (leW_factor _); rewrite // lt_eqF. +apply: homo_mono (factorK _) (leW_line_path _) (leW_factor _) => //. +by rewrite lt_eqF. Qed. -Lemma lt_conv a b : a < b -> {mono conv a b : x y / x < y}. -Proof. by move/le_conv/leW_mono. Qed. +Lemma lt_line_path a b : a < b -> {mono line_path a b : x y / x < y}. +Proof. by move/le_line_path/leW_mono. Qed. Lemma lt_factor a b : a < b -> {mono factor a b : x y / x < y}. Proof. by move/le_factor/leW_mono. Qed. @@ -434,51 +463,58 @@ Proof. by move/le_factor/leW_mono. Qed. Let ltNeq a b : a < b -> a != b. Proof. by move=> /lt_eqF->. Qed. HB.instance Definition _ a b (ab : a < b) := - @Can2.Build _ _ setT setT (ndconv ab) (factor a b) + @Can2.Build _ _ setT setT (ndline_path ab) (factor a b) (fun _ _ => I) (fun _ _ => I) - (in1W (convK (ltNeq ab))) (in1W (factorK (ltNeq ab))). + (in1W (line_pathK (ltNeq ab))) (in1W (factorK (ltNeq ab))). -Lemma conv_itv_bij ba bb a b : a < b -> +Lemma line_path_itv_bij ba bb a b : a < b -> set_bij [set` Interval (BSide ba 0) (BSide bb 1)] - [set` Interval (BSide ba a) (BSide bb b)] (conv a b). + [set` Interval (BSide ba a) (BSide bb b)] (line_path a b). Proof. -move=> ltab; rewrite -ndconvE; apply: bij_subr => //=; rewrite setTI ?ndconvE. -apply/predeqP => t /=; rewrite !in_itv/= {1}convEl convEr. -rewrite -lteif_subl_addr subrr -lteif_pdivr_mulr ?subr_gt0// mul0r. -rewrite -lteif_subr_addr subrr -lteif_ndivr_mulr ?subr_lt0// mul0r. -by rewrite lteif_subr_addl addr0. +move=> ltab; rewrite -ndline_pathE. +apply: bij_subr => //=; rewrite setTI ?ndline_pathE. +apply/predeqP => t /=; rewrite !in_itv/= {1}line_pathEl line_pathEr. +rewrite -lteifBlDr subrr -lteif_pdivrMr ?subr_gt0// mul0r. +rewrite -lteifBrDr subrr -lteif_ndivrMr ?subr_lt0// mul0r. +by rewrite lteifBrDl addr0. Qed. Lemma factor_itv_bij ba bb a b : a < b -> set_bij [set` Interval (BSide ba a) (BSide bb b)] [set` Interval (BSide ba 0) (BSide bb 1)] (factor a b). Proof. -move=> ltab; have -> : factor a b = (ndconv ltab)^-1%FUN by []. -by apply/splitbij_sub_sym => //; apply: conv_itv_bij. +move=> ltab; have -> : factor a b = (ndline_path ltab)^-1%FUN by []. +by apply/splitbij_sub_sym => //; apply: line_path_itv_bij. Qed. -Lemma mem_conv_itv ba bb a b : a < b -> +Lemma mem_line_path_itv ba bb a b : a < b -> set_fun [set` Interval (BSide ba 0) (BSide bb 1)] - [set` Interval (BSide ba a) (BSide bb b)] (conv a b). -Proof. by case/(conv_itv_bij ba bb). Qed. + [set` Interval (BSide ba a) (BSide bb b)] (line_path a b). +Proof. by case/(line_path_itv_bij ba bb). Qed. -Lemma mem_conv_itvcc a b : a <= b -> set_fun `[0, 1] `[a, b] (conv a b). +Lemma mem_line_path_itvcc a b : a <= b -> set_fun `[0, 1] `[a, b] (line_path a b). Proof. -rewrite le_eqVlt => /predU1P[<-|]; first by rewrite set_itv1 conv_flat. -by move=> lt_ab; case: (conv_itv_bij true false lt_ab). +rewrite le_eqVlt => /predU1P[<-|]; first by rewrite set_itv1 line_path_flat. +by move=> lt_ab; case: (line_path_itv_bij true false lt_ab). Qed. -Lemma range_conv ba bb a b : a < b -> - conv a b @` [set` Interval (BSide ba 0) (BSide bb 1)] = +Lemma range_line_path ba bb a b : a < b -> + line_path a b @` [set` Interval (BSide ba 0) (BSide bb 1)] = [set` Interval (BSide ba a) (BSide bb b)]. -Proof. by move=> /(conv_itv_bij ba bb)/Pbij[f ->]; rewrite image_eq. Qed. +Proof. by move=> /(line_path_itv_bij ba bb)/Pbij[f ->]; rewrite image_eq. Qed. Lemma range_factor ba bb a b : a < b -> factor a b @` [set` Interval (BSide ba a) (BSide bb b)] = [set` Interval (BSide ba 0) (BSide bb 1)]. Proof. by move=> /(factor_itv_bij ba bb)/Pbij[f ->]; rewrite image_eq. Qed. -End conv_factor_numFieldType. +Lemma onem_factor a b x : a != b -> `1-(factor a b x) = factor b a x. +Proof. +rewrite eq_sym -subr_eq0 => ab; rewrite /onem /factor -(divff ab) -mulrBl. +by rewrite opprB addrA subrK -mulrNN opprB -invrN opprB. +Qed. + +End line_path_factor_numFieldType. Lemma mem_factor_itv (R : realFieldType) ba bb (a b : R) : set_fun [set` Interval (BSide ba a) (BSide bb b)] diff --git a/coq-mathcomp-analysis.opam b/coq-mathcomp-analysis.opam index ca0fe8a5e..12286a782 100644 --- a/coq-mathcomp-analysis.opam +++ b/coq-mathcomp-analysis.opam @@ -19,7 +19,7 @@ build: [make "-C" "theories" "-j%{jobs}%"] install: [make "-C" "theories" "install"] depends: [ "coq-mathcomp-classical" { = version} - "coq-mathcomp-solvable" { (>= "1.13.0" & < "1.16~") | (= "dev") } + "coq-mathcomp-solvable" { (>= "2.0.0") | (= "dev") } "coq-mathcomp-field" "coq-mathcomp-bigenough" { (>= "1.0.0") } ] @@ -27,8 +27,26 @@ depends: [ tags: [ "category:Mathematics/Real Calculus and Topology" "keyword:analysis" + "keyword:extended real numbers" + "keyword:filter" + "keyword:Cantor" "keyword:topology" "keyword:real numbers" + "keyword:sequence" + "keyword:convexity" + "keyword:Landau notation" + "keyword:logarithm" + "keyword:sin" + "keyword:cos" + "keyword:tangent" + "keyword:trigonometric function" + "keyword:exponential" + "keyword:differentiation" + "keyword:derivative" + "keyword:measure theory" + "keyword:integration" + "keyword:Lebesgue" + "keyword:probability" "logpath:mathcomp.analysis" ] authors: [ diff --git a/coq-mathcomp-classical.opam b/coq-mathcomp-classical.opam index 6051720d0..6f8cfb2f7 100644 --- a/coq-mathcomp-classical.opam +++ b/coq-mathcomp-classical.opam @@ -18,12 +18,12 @@ the Coq proof-assistant and using the Mathematical Components library.""" build: [make "-C" "classical" "-j%{jobs}%"] install: [make "-C" "classical" "install"] depends: [ - "coq" { (>= "8.14" & < "8.17~") | (= "dev") } - "coq-mathcomp-ssreflect" { (>= "1.13.0" & < "1.16~") | (= "dev") } + "coq" { (>= "8.16" & < "8.19~") | (= "dev") } + "coq-mathcomp-ssreflect" { (>= "2.0.0") | (= "dev") } "coq-mathcomp-fingroup" "coq-mathcomp-algebra" - "coq-mathcomp-finmap" { (>= "1.5.1" & < "1.6~") | (= "dev") } - "coq-hierarchy-builder" { (>= "1.2.0") } + "coq-mathcomp-finmap" { (>= "2.0.0") | (= "dev") } + "coq-hierarchy-builder" { (>= "1.4.0") } ] tags: [ @@ -31,6 +31,9 @@ tags: [ "keyword:classical" "keyword:logic" "keyword:sets" + "keyword:set theory" + "keyword:function" + "keyword:cardinal" "logpath:mathcomp.classical" ] authors: [ diff --git a/etc/changes.awk b/etc/changes.awk deleted file mode 100644 index 0cfc3bcfb..000000000 --- a/etc/changes.awk +++ /dev/null @@ -1,48 +0,0 @@ -BEGIN { - deprecated = 0 - note = "" -} -/(Definition|Notation|Lemma|Theorem|Corollary)/ { - s = gensub(/^([ +-]) *(Definition|Notation|Lemma|Theorem|Corollary) +([^ :\(\{\["]+).*/, "\\1 \\2 \\3", 1) - if (s != $0) { - class = gensub(/^[ +-] (Definition|Notation|Lemma|Theorem|Corollary).*/,"\\1", 1, s) - name = gensub(/^[ +-] (Definition|Notation|Lemma|Theorem|Corollary) (.*)/,"\\2", 1, s) - added_to = "" - removed_from = "" - deprecated_in = "" - if (match(name, /_(subproof|subdef)/)) { } - else { - if (match(s, /^\+.*/)) { added_to = file } - if (match(s, /^\-.*/)) { removed_from = file } - if (deprecated == 1) { deprecated_in = file } - if (deprecated == 1 || added_to != "" || removed_from != "") { - printf("insert or ignore into changes values (\"%s\", \"%s\", \"%s\", \"%s\", \"%s\", \"%s\", %d);\n", - name, class, added_to, delete_from, deprecated_in, note, NR) - if (added_to != "") { - printf("update changes set added_file = \"%s\" where name = \"%s\";\n", added_to, name) - printf("update changes set class = \"%s\" where name = \"%s\";\n", class, name) - } - if (removed_from != "") { - printf("update changes set removed_file = \"%s\" where name = \"%s\";\n", removed_from, name) - } - if (note != "") { - printf("update changes set deprecated_file = \"%s\" where name = \"%s\";\n", file, name) - printf("update changes set deprecated_note = \"%s\" where name = \"%s\";\n", note, name) - } - } - } - } - deprecated = 0 - note = "" -} -/^+#.*deprecated/ { - deprecated = 1 - note = gensub(/.*note *= *"([^"]+)".*/, "\\1", 1) - if (note == $0) { note = "deprecated" } -} -/^+.*note=/ { - if (deprecated == 1) { - note = gensub(/.*note *= *"([^"]+)".*/, "\\1", 1) - if (note == $0) { note = "deprecated" } - } -} diff --git a/etc/changes.sh b/etc/changes.sh deleted file mode 100755 index bcf403c48..000000000 --- a/etc/changes.sh +++ /dev/null @@ -1,334 +0,0 @@ -#!/usr/bin/env bash -set -e -shopt -s nullglob - -if [ "$DEBUG" = 1 ]; then - set -x -fi - -show_help(){ - cat <&2 - exit 1 -} - -while :; do - case $1 in - -h|-\?|--help) - show_help # Display a usage synopsis. - exit 0 - ;; - -s|--since) - shift - COMMIT=$1 - shift - ;; - -c|--check) - shift - CHANGELOG=$1 - OUTMODE="check" - shift - ;; - -e|--exclude) - shift - EXCLUDE=$1 - shift - ;; - -r|--raw) - OUTMODE="raw" - shift - ;; - --pp) - OUTMODE="pp" - shift - ;; - --cd) - CD=1 - shift - ;; - -i|--interactive) - INTERACTIVE=1 - shift - ;; - *) - if ! [ "$*" ]; then break - else FILES=$*; break - fi - ;; - - esac -done - -if ! [ "$OUTMODE" ]; then OUTMODE="changelog"; fi -if ! [ "$FILES" ]; then FILES=**/*.v; fi -if ! [ "$COMMIT" ]; then COMMIT="master"; fi -if ! [ "$EXCLUDE" ]; then EXCLUDE=$(mktemp); touch $EXCLUDE; fi - -if ! [ -f "$EXCLUDE" ]; then - echo "$EXCLUDE does not exist" - exit 1 -fi - -D=$(mktemp -d) -DB=$D/changes.db -if [ "$OUTMODE" == "pp" ]; then echo "Contents of $DB"; fi - -SQL="sqlite3 --line $DB -column -noheader -list -nullvalue NULL" -SQLPP="sqlite3 --line $DB -column -header -nullvalue NULL" -$SQL 'create table changes (name, class, added_file, removed_file, deprecated_file, deprecated_note, line INTEGER);' -$SQL 'create unique index changes_idx on changes(name);' - -VERNAC="Definition Notation Lemma Theorem Corollary" -ALLV=$(echo $VERNAC | sed "s/ /_/g") - -touchp() { mkdir -p "$(dirname "$1")" && touch "$1" ; } - -len() { wc -l $1 | cut -d" " -f 1; } - -INDENT=4 -MAXLENGTH=80 - -sql() { - OUT=$(mktemp); - $SQL "$*" > $OUT - RAW=$(cat $OUT) - LEN=$(len $OUT) - PP=$(cat $OUT | awk -F "|" -v LEN=$LEN -v INDENT=$INDENT -v INIT=$INIT -v MAXLENGTH=$MAXLENGTH ' - function println(s, off) { - l = length(s) - if (OUTLEN + l + off <= MAXLENGTH) printf s - else { - OUTLEN = INDENT - printf "\n" - for (j = 0; j < INDENT; j++) { printf " " } - printf s - } - OUTLEN += l - } - - BEGIN { OUTLEN = INIT } - (NR == LEN && LEN > 1) { println("and ") } - { println(sprintf("`%s`", $1), 2) - if ($2) println(sprintf(" (%s)", $2), 2) } - (NR < LEN && LEN > 1) { println(", ", -2) } - (NR == LEN) { printf ".\n" }' ORS=" ") -} - -class() { - if [ $1 == 1 ]; then - echo $2 | sed "s/Definition/definition/;s/Notation/notation/; - s/Lemma/lemma/;s/Theorem/theorem/;s/Corollary/corollary/;" - else - echo $2 | sed "s/Definition/definitions/;s/Notation/notations/; - s/Lemma/lemmas/;s/Theorem/theorems/;s/Corollary/corollaries/;" - fi -} - -for f in $FILES; do - touchp $D/diffs/$f - git diff "$COMMIT" -- $f > $D/diffs/$f -done - -for f in $FILES; do - cat $D/diffs/$f | awk -f etc/changes.awk -v file=$f | $SQL --batch -done - -$SQL "select name from changes" > $D/all_changes - -cat $EXCLUDE | while read d; do - $SQL "delete from changes where name = \"$d\";" -done - -$SQL "select name from changes" > $D/nonexcluded_changes - -$SQL 'create table deprecated (name, file, renamed INTEGER, generalized INTEGER, target, target_file, note);' -$SQL 'create unique index deprecated_idx on deprecated(name);' - -parse_deprecated() { - NAME=$1 - shift - FILE=$1 - shift - RENAMED=0 - GENERALIZED=0 - TARGET=$(echo $* | grep -Fo -f $D/all_changes || true) - if [ "$TARGET" ]; then - if echo $* | grep -qo "rename"; then RENAMED=1; fi - if echo $* | grep -qEo "generali[zs]e"; then GENERALIZED=1; fi - TARGET_FILE=$($SQL "select added_file from changes where name=\"$TARGET\";") - fi - $SQL "insert into deprecated values - (\"$NAME\", \"$FILE\", $RENAMED, $GENERALIZED, \"$TARGET\", \"$TARGET_FILE\", \"$*\");" - $SQL "delete from changes where name=\"$NAME\";" - if [ "$RENAMED" == "1" ] || [ "$GENERALIZED" == "1" ]; then - $SQL "delete from changes where name=\"$TARGET\";" - fi -} - -$SQL "select name, deprecated_file, deprecated_note from changes - where deprecated_file != \"\"" |\ -while read d; do - args=${d//|/ } - parse_deprecated $args -done - -case $OUTMODE in - "raw") - echo "==========================================" - $SQL "select * from changes;" - echo "==========================================" - ;; - "pp") - echo "==========================================" - $SQLPP "select * from changes;" - echo "==========================================" - ;; - "changelog") - echo "### Added" - echo "" - for f in $FILES; do - sql "select name from changes where removed_file=\"\" - and added_file=\"$f\" and deprecated_file=\"\";" - if [ $LEN -gt 0 ]; then - echo "- in file \`$(basename $f)\`," - for v in $VERNAC; do - INIT=20 - sql "select name from changes where removed_file=\"\" - and added_file=\"$f\" and class=\"$v\";" - if [ $LEN -gt 0 ]; then - echo " + new $(class $LEN $v) $PP" - fi - done - fi - done - echo "" - echo "### Renamed" - echo "" - for f in $FILES; do - INIT=20 - sql "select name, target from deprecated - where renamed = 1 and generalized = 0 - and target_file = \"$f\" and file = \"$f\";" - if [ $LEN -gt 0 ]; then - echo "- in file \`$(basename $f)\`," - cat $OUT | sed "s/^\(.*\)|\(.*\)/ + \`\1\` -> \`\2\`/" - fi - sql "select distinct file from deprecated - where renamed = 1 and generalized = 0 - and target_file = \"$f\" and file != \"$f\";" - if [ $LEN -gt 0 ]; then - SRCS=$RAW - for s in $SRCS; do - INIT=50 - sql "select name, target from deprecated - where renamed = 1 and generalized = 0 - and target_file = \"$f\" and file = \"$s\";" - echo "- moved from \`$(basename $s)\` to \`$(basename $f)\`:" - cat $OUT | sed "s/^\(.*\)|\(.*\)/ + \`\1\` -> \`\2\`/" - done - fi - done - echo "" - echo "### Generalized" - echo "" - for f in $FILES; do - INIT=20 - sql "select name, target from deprecated - where generalized = 1 - and target_file = \"$f\" and file = \"$f\";" - if [ $LEN -gt 0 ]; then - echo "- in file \`$(basename $f)\`," - cat $OUT | sed "s/^\(.*\)|\(.*\)/ + \`\1\` -> \`\2\`/" - fi - sql "select distinct file from deprecated - where generalized = 1 - and target_file = \"$f\" and file != \"$f\";" - if [ $LEN -gt 0 ]; then - SRCS=$RAW - for s in $SRCS; do - INIT=50 - sql "select name, target from deprecated - where generalized = 1 - and target_file = \"$f\" and file = \"$s\";" - echo "- moved from \`$(basename $s)\` to \`$(basename $f)\`:" - cat $OUT | sed "s/^\(.*\)|\(.*\)/ + \`\1\` -> \`\2\`/" - done - fi - done - echo "" - echo "### Deprecated" - echo "" - for f in $FILES; do - INIT=20 - sql "select name, note from deprecated where file=\"$f\" and renamed = 0 and generalized = 0;" - if [ $LEN -gt 0 ]; then - echo "- in file \`$(basename $f)\`, deprecated" - cat $OUT | sed "s/^\(.*\)|\(.*\)/ + \`\1\` (\2),/" - fi - done - echo "" - echo "### Maybe changed" - echo "" - for f in $FILES; do - INIT=20 - sql "select name from changes where added_file=\"$f\" - and removed_file=\"$f\" and deprecated_file=\"\";" - if [ $LEN -gt 0 ]; then - echo "- in file \`$(basename $f)\`, updated $PP" - fi - done - echo "" - echo "### Moved from one file to another and maybe changed or generalized" - echo "" - for f in $FILES; do - sql "select distinct removed_file from changes where added_file=\"$f\" - and removed_file != \"\" and removed_file != \"$f\" - and deprecated_file=\"\";" - if [ $LEN -gt 0 ]; then - SRCS=$RAW - for s in $SRCS; do - INIT=50 - sql "select name from changes where added_file=\"$f\" - and removed_file=\"$s\" and deprecated_file=\"\";" - echo "- moved from \`$(basename $s)\` to \`$(basename $f)\`: $PP" - done - fi - done - echo "" - echo "### Removed" - echo "" - for f in $FILES; do - INIT=20 - sql "select name from changes where added_file=\"\" - and removed_file=\"$f\" and deprecated_file=\"\";" - if [ $LEN -gt 0 ]; then - echo "- in file \`$(basename $f)\`, removed $PP" - fi - done - ;; - "check") - cat $D/nonexcluded_changes | while read d; do - grep -q "\`$d\`" $CHANGELOG || echo $d - done > $D/absent_from_changelog - LEN=$(len $D/absent_from_changelog); - if [ $LEN -gt 0 ]; then - cat $D/absent_from_changelog - fi - ;; -esac - -if [ "$CD" ]; then cd $D; exec $SHELL; fi -if [ "$INTERACTIVE" ]; then rlwrap sqlite3 $DB; fi diff --git a/theories/Make b/theories/Make index 617280d72..a22b53479 100644 --- a/theories/Make +++ b/theories/Make @@ -13,6 +13,7 @@ reals.v landau.v Rstruct.v topology.v +cantor.v prodnormedzmodule.v normedtype.v realfun.v @@ -28,8 +29,15 @@ derive.v measure.v numfun.v lebesgue_integral.v +hoelder.v +probability.v +lebesgue_stieltjes_measure.v summability.v signed.v +itv.v +convex.v +charge.v +kernel.v altreals/xfinmap.v altreals/discrete.v altreals/realseq.v diff --git a/theories/Rstruct.v b/theories/Rstruct.v index 4fdd313f6..3ce44ea26 100644 --- a/theories/Rstruct.v +++ b/theories/Rstruct.v @@ -21,10 +21,15 @@ the economic rights, and the successive licensors have only limited liability. See the COPYING file for more details. *) +(**md**************************************************************************) +(* # Compatibility with the real numbers of Coq *) +(******************************************************************************) + Require Import Rdefinitions Raxioms RIneq Rbasic_fun Zwf. Require Import Epsilon FunctionalExtensionality Ranalysis1 Rsqrt_def. Require Import Rtrigo1 Reals. From mathcomp Require Import all_ssreflect ssralg poly mxpoly ssrnum. +From HB Require Import structures. Set Implicit Arguments. Unset Strict Implicit. @@ -49,8 +54,7 @@ Proof. by move=> r1 r2; rewrite /eqr; case: Req_EM_T=> H; apply: (iffP idP). Qed. -Canonical R_eqMixin := EqMixin eqrP. -Canonical R_eqType := Eval hnf in EqType R R_eqMixin. +#[hnf] HB.instance Definition _ := hasDecEq.Build R eqrP. Fact inhR : inhabited R. Proof. exact: (inhabits 0). Qed. @@ -72,17 +76,15 @@ suff->: u = v by rewrite PEQ. by congr epsilon; apply: functional_extensionality=> x; rewrite PEQ. Qed. -Definition R_choiceMixin : choiceMixin R := - Choice.Mixin pickR_some pickR_ex pickR_ext. - -Canonical R_choiceType := Eval hnf in ChoiceType R R_choiceMixin. +#[hnf] +HB.instance Definition _ := hasChoice.Build R pickR_some pickR_ex pickR_ext. Fact RplusA : associative (Rplus). Proof. by move=> *; rewrite Rplus_assoc. Qed. -Definition R_zmodMixin := ZmodMixin RplusA Rplus_comm Rplus_0_l Rplus_opp_l. - -Canonical R_zmodType := Eval hnf in ZmodType R R_zmodMixin. +#[hnf] +HB.instance Definition _ := GRing.isZmodule.Build R + RplusA Rplus_comm Rplus_0_l Rplus_opp_l. Fact RmultA : associative (Rmult). Proof. by move=> *; rewrite Rmult_assoc. Qed. @@ -90,22 +92,24 @@ Proof. by move=> *; rewrite Rmult_assoc. Qed. Fact R1_neq_0 : R1 != R0. Proof. by apply/eqP/R1_neq_R0. Qed. -Definition R_ringMixin := RingMixin RmultA Rmult_1_l Rmult_1_r - Rmult_plus_distr_r Rmult_plus_distr_l R1_neq_0. +#[hnf] +HB.instance Definition _ := GRing.Zmodule_isRing.Build R + RmultA Rmult_1_l Rmult_1_r Rmult_plus_distr_r Rmult_plus_distr_l R1_neq_0. -Canonical R_ringType := Eval hnf in RingType R R_ringMixin. -Canonical R_comRingType := Eval hnf in ComRingType R Rmult_comm. +#[hnf] +HB.instance Definition _ := GRing.Ring_hasCommutativeMul.Build R Rmult_comm. Import Monoid. -Canonical Radd_monoid := Law RplusA Rplus_0_l Rplus_0_r. -Canonical Radd_comoid := ComLaw Rplus_comm. +HB.instance Definition _ := isComLaw.Build R 0 Rplus + RplusA Rplus_comm Rplus_0_l. -Canonical Rmul_monoid := Law RmultA Rmult_1_l Rmult_1_r. -Canonical Rmul_comoid := ComLaw Rmult_comm. +HB.instance Definition _ := isComLaw.Build R 1 Rmult + RmultA Rmult_comm Rmult_1_l. -Canonical Rmul_mul_law := MulLaw Rmult_0_l Rmult_0_r. -Canonical Radd_add_law := AddLaw Rmult_plus_distr_r Rmult_plus_distr_l. +HB.instance Definition _ := isMulLaw.Build R 0 Rmult Rmult_0_l Rmult_0_r. +HB.instance Definition _ := isAddLaw.Build R Rmult Rplus + Rmult_plus_distr_r Rmult_plus_distr_l. Definition Rinvx r := if (r != 0) then / r else r. @@ -132,26 +136,19 @@ Qed. Lemma Rinvx_out : {in predC unit_R, Rinvx =1 id}. Proof. by move=> x; rewrite inE/= /Rinvx -if_neg => ->. Qed. -Definition R_unitRingMixin := - UnitRingMixin RmultRinvx RinvxRmult intro_unit_R Rinvx_out. - -Canonical R_unitRing := - Eval hnf in UnitRingType R R_unitRingMixin. - -Canonical R_comUnitRingType := - Eval hnf in [comUnitRingType of R]. +#[hnf] +HB.instance Definition _ := GRing.Ring_hasMulInverse.Build R + RmultRinvx RinvxRmult intro_unit_R Rinvx_out. Lemma R_idomainMixin x y : x * y = 0 -> (x == 0) || (y == 0). Proof. by move=> /Rmult_integral []->; rewrite eqxx ?orbT. Qed. -Canonical R_idomainType := Eval hnf in IdomainType R R_idomainMixin. +#[hnf] +HB.instance Definition _ := GRing.ComUnitRing_isIntegral.Build R + R_idomainMixin. -Lemma R_fieldMixin : GRing.Field.mixin_of [unitRingType of R]. -Proof. by done. Qed. - -Definition R_fieldIdomainMixin := FieldIdomainMixin R_fieldMixin. - -Canonical R_fieldType := FieldType R R_fieldMixin. +Lemma R_fieldMixin : GRing.field_axiom R. Proof. by []. Qed. +HB.instance Definition _ := GRing.UnitRing_isField.Build R R_fieldMixin. (** Reflect the order on the reals to bool *) @@ -201,9 +198,10 @@ by move/RlebP=> ->; rewrite orbT. Qed. Lemma RnormM : {morph Rabs : x y / x * y}. -exact: Rabs_mult. Qed. +Proof. exact: Rabs_mult. Qed. Lemma Rleb_def x y : (Rleb x y) = (Rabs (y - x) == y - x). +Proof. apply/(sameP (RlebP x y))/(iffP idP)=> [/eqP H| /Rle_minus H]. apply: Rminus_le; rewrite -Ropp_minus_distr. apply/Rge_le/Ropp_0_le_ge_contravar. @@ -214,6 +212,7 @@ by apply/Ropp_0_ge_le_contravar/Rle_ge. Qed. Lemma Rltb_def x y : (Rltb x y) = (y != x) && (Rleb x y). +Proof. apply/(sameP (RltbP x y))/(iffP idP). case/andP=> /eqP H /RlebP/Rle_not_gt H2. by case: (Rtotal_order x y)=> // [][] // /esym. @@ -222,11 +221,8 @@ move=> H; apply/andP; split; [apply/eqP|apply/RlebP]. exact: Rlt_le. Qed. -Definition R_numMixin := NumMixin Rleb_norm_add addr_Rgtb0 Rnorm0_eq0 - Rleb_leVge RnormM Rleb_def Rltb_def. -Canonical R_porderType := POrderType ring_display R R_numMixin. -Canonical R_numDomainType := NumDomainType R R_numMixin. -Canonical R_normedZmodType := NormedZmodType R R R_numMixin. +HB.instance Definition _ := Num.IntegralDomain_isNumRing.Build R + Rleb_norm_add addr_Rgtb0 Rnorm0_eq0 Rleb_leVge RnormM Rleb_def Rltb_def. Lemma RleP : forall x y, reflect (Rle x y) (x <= y)%R. Proof. exact: RlebP. Qed. @@ -238,27 +234,22 @@ Proof. exact: RltbP. Qed. (* Lemma RgtP : forall x y, reflect (Rgt x y) (x > y)%R. *) (* Proof. exact: RltbP. Qed. *) -Canonical R_numFieldType := [numFieldType of R]. - Lemma Rreal_axiom (x : R) : (0 <= x)%R || (x <= 0)%R. Proof. case: (Rle_dec 0 x)=> [/RleP ->|] //. by move/Rnot_le_lt/Rlt_le/RleP=> ->; rewrite orbT. Qed. -Lemma R_total : totalPOrderMixin R_porderType. +Lemma R_total : total (<=%O : rel R). Proof. move=> x y; case: (Rle_lt_dec x y) => [/RleP -> //|/Rlt_le/RleP ->]; by rewrite orbT. Qed. -Canonical R_latticeType := LatticeType R R_total. -Canonical R_distrLatticeType := DistrLatticeType R R_total. -Canonical R_orderType := OrderType R R_total. -Canonical R_realDomainType := [realDomainType of R]. -Canonical R_realFieldType := [realFieldType of R]. +HB.instance Definition _ := Order.POrder_isTotal.Build _ R R_total. -Lemma Rarchimedean_axiom : Num.archimedean_axiom R_numDomainType. +Lemma Rarchimedean_axiom : + Num.archimedean_axiom [the numDomainType of R : Type]. Proof. move=> x; exists (Z.abs_nat (up x) + 2)%N. have [Hx1 Hx2]:= (archimed x). @@ -276,7 +267,7 @@ apply/RltbP/Rabs_def1. apply/Rplus_le_compat_r/IHz; split; first exact: Zlt_le_weak. exact: Zlt_pred. apply: (Rle_trans _ (IZR 0)); first exact: IZR_le. - by apply/RlebP/(ler0n R_numDomainType (Z.abs_nat z)). + by apply/RlebP/(ler0n [the numDomainType of R : Type] (Z.abs_nat z)). apply: (Rlt_le_trans _ (IZR (up x) - 1)). apply: Ropp_lt_cancel; rewrite Ropp_involutive. rewrite Ropp_minus_distr /Rminus -opp_IZR -{2}(Z.opp_involutive (up x)). @@ -294,16 +285,14 @@ apply: (Rlt_le_trans _ (IZR (up x) - 1)). rewrite mulrnDr; apply: (Rlt_le_trans _ 2). by rewrite -{1}[1]Rplus_0_r; apply/Rplus_lt_compat_l/Rlt_0_1. rewrite -[2]Rplus_0_l; apply: Rplus_le_compat_r. - by apply/RlebP/(ler0n R_numDomainType (Z.abs_nat _)). + by apply/RlebP/(ler0n [the numDomainType of R : Type] (Z.abs_nat _)). apply: Rminus_le. rewrite /Rminus Rplus_assoc [- _ + _]Rplus_comm -Rplus_assoc -!/(Rminus _ _). exact: Rle_minus. Qed. -(* Canonical R_numArchiDomainType := ArchiDomainType R Rarchimedean_axiom. *) -(* (* Canonical R_numArchiFieldType := [numArchiFieldType of R]. *) *) -(* Canonical R_realArchiDomainType := [realArchiDomainType of R]. *) -Canonical R_realArchiFieldType := ArchiFieldType R Rarchimedean_axiom. +HB.instance Definition _ := Num.RealField_isArchimedean.Build R + Rarchimedean_axiom. (** Here are the lemmas that we will use to prove that R has the rcfType structure. *) @@ -343,7 +332,8 @@ have Hg: (fun x=> f x * f x ^+ n)%R =1 g. by apply: (continuity_eq Hg); exact: continuity_mult. Qed. -Lemma Rreal_closed_axiom : Num.real_closed_axiom R_numDomainType. +Lemma Rreal_closed_axiom : + Num.real_closed_axiom [the numDomainType of R : Type]. Proof. move=> p a b; rewrite !le_eqVlt. case Hpa: ((p.[a])%R == 0%R). @@ -366,13 +356,12 @@ apply:continuity_scal; apply: continuity_exp=> x esp Hesp. by exists esp; split=> // y []. Qed. -Canonical R_rcfType := RcfType R Rreal_closed_axiom. -(* Canonical R_realClosedArchiFieldType := [realClosedArchiFieldType of R]. *) +HB.instance Definition _ := Num.RealField_isClosed.Build R Rreal_closed_axiom. End ssreal_struct. Local Open Scope ring_scope. -From mathcomp.classical Require Import boolp classical_sets. +From mathcomp Require Import boolp classical_sets. Require Import reals. Section ssreal_struct_contd. @@ -426,9 +415,8 @@ Proof. by move=> supE x Ex; apply/ge_supremum_Nmem => //; exact: Rsupremums_neq0. Qed. -Definition real_realMixin : Real.mixin_of _ := - RealMixin (@Rsup_ub (0 : R)) (real_sup_adherent 0). -Canonical real_realType := RealType R real_realMixin. +HB.instance Definition _ := ArchimedeanField_isReal.Build R + (@Rsup_ub (0 : R)) (real_sup_adherent 0). Implicit Types (x y : R) (m n : nat). @@ -480,7 +468,7 @@ Proof. elim: n => // n IH; by rewrite S_INR IH RplusE -addn1 natrD. Qed. Lemma RsqrtE x : 0 <= x -> sqrt x = Num.sqrt x. Proof. move => x0; apply/eqP; have [t1 t2] := conj (sqrtr_ge0 x) (sqrt_pos x). -rewrite eq_sym -(eqr_expn2 (_: 0 < 2)%N t1) //; last by apply /RleP. +rewrite eq_sym -(eqrXn2 (_: 0 < 2)%N t1) //; last by apply /RleP. rewrite sqr_sqrtr // !exprS expr0 mulr1 -RmultE ?sqrt_sqrt //; by apply/RleP. Qed. @@ -577,7 +565,7 @@ Proof. move=> k0; elim: s => /= [|h [/=|h' t ih]]. by rewrite bigmaxr_nil mulr0. by rewrite !bigmaxr_un. -by rewrite bigmaxr_cons {}ih bigmaxr_cons maxr_pmulr. +by rewrite bigmaxr_cons {}ih bigmaxr_cons maxr_pMr. Qed. #[deprecated(note="To be removed. Use topology.v's bigmax/min lemmas instead.")] @@ -695,24 +683,11 @@ End bigmaxr. End ssreal_struct_contd. -Require Import signed topology normedtype. +Require Import signed topology. Section analysis_struct. -Canonical R_pointedType := [pointedType of R for pointed_of_zmodule R_ringType]. -Canonical R_filteredType := - [filteredType R of R for filtered_of_normedZmod R_normedZmodType]. -Canonical R_topologicalType : topologicalType := TopologicalType R - (topologyOfEntourageMixin - (uniformityOfBallMixin - (@nbhs_ball_normE _ R_normedZmodType) - (pseudoMetric_of_normedDomain R_normedZmodType))). -Canonical R_uniformType : uniformType := - UniformType R - (uniformityOfBallMixin (@nbhs_ball_normE _ R_normedZmodType) - (pseudoMetric_of_normedDomain R_normedZmodType)). -Canonical R_pseudoMetricType : pseudoMetricType R_numDomainType := - PseudoMetricType R (pseudoMetric_of_normedDomain R_normedZmodType). +HB.instance Definition _ := PseudoMetric.copy R R^o. (* TODO: express using ball?*) Lemma continuity_pt_nbhs (f : R -> R) x : @@ -736,10 +711,10 @@ Lemma continuity_pt_cvg (f : R -> R) (x : R) : Proof. eapply iff_trans; first exact: continuity_pt_nbhs. apply iff_sym. -have FF : Filter (f @ x). +have FF : Filter (f @ x)%classic. by typeclasses eauto. (*by apply fmap_filter; apply: @filter_filter' (locally_filter _).*) -case: (@fcvg_ballP _ _ (f @ x) FF (f x)) => {FF}H1 H2. +case: (@fcvg_ballP _ _ (f @ x)%classic FF (f x)) => {FF}H1 H2. (* TODO: in need for lemmas and/or refactoring of already existing lemmas (ball vs. Rabs) *) split => [{H2} - /H1 {}H1 eps|{H1} H]. - have {H1} [//|_/posnumP[x0] Hx0] := H1 eps%:num. @@ -764,8 +739,7 @@ Lemma continuity_pt_dnbhs f x : continuity_pt f x <-> forall eps, 0 < eps -> x^' (fun u => `|f x - f u| < eps). Proof. -rewrite continuity_pt_cvg' (@cvgrPdist_lt _ [normedModType _ of R^o]). -exact. +by rewrite continuity_pt_cvg' -filter_fromP cvg_ballP -filter_fromP. Qed. Lemma nbhs_pt_comp (P : R -> Prop) (f : R -> R) (x : R) : diff --git a/theories/altreals/discrete.v b/theories/altreals/discrete.v index 362817804..d2b0f71e9 100644 --- a/theories/altreals/discrete.v +++ b/theories/altreals/discrete.v @@ -4,6 +4,7 @@ (* Copyright (c) - 2016--2018 - Polytechnique *) (* -------------------------------------------------------------------- *) +From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra. From mathcomp.classical Require Import boolp. Require Import xfinmap reals. @@ -39,27 +40,19 @@ Variable T : Type. Variable E : pred T. Record pred_sub : Type := - PSubSub { rsval : T; rsvalP : rsval \in E }. + PSubSub { rsval :> T; rsvalP : rsval \in E }. -Coercion rsval : pred_sub >-> T. - -Canonical pred_sub_subType := Eval hnf in [subType for rsval]. +HB.instance Definition _ := [isSub for rsval]. End Def. -Definition pred_sub_eqMixin (T : eqType) (E : pred T) := - Eval hnf in [eqMixin of pred_sub E by <:]. -Canonical pred_sub_eqType (T : eqType) (E : pred T) := - Eval hnf in EqType (@pred_sub T E) (pred_sub_eqMixin E). +HB.instance Definition _ (T : eqType) (E : pred T) := + [Equality of pred_sub E by <:]. -Definition pred_sub_choiceMixin (T : choiceType) (E : pred T) := - Eval hnf in [choiceMixin of pred_sub E by <:]. -Canonical pred_sub_choiceType (T : choiceType) (E : pred T) := - Eval hnf in ChoiceType (@pred_sub T E) (pred_sub_choiceMixin E). +HB.instance Definition _ (T : choiceType) (E : pred T) := + [Choice of pred_sub E by <:]. -Definition pred_sub_countMixin (T : countType) (E : pred T) := - Eval hnf in [countMixin of pred_sub E by <:]. -Canonical pred_sub_countType (T : countType) (E : pred T) := - Eval hnf in CountType (@pred_sub T E) (pred_sub_countMixin E). +HB.instance Definition _ (T : countType) (E : pred T) := + [Countable of pred_sub E by <:]. End PredSubtype. Notation "[ 'psub' E ]" := (@pred_sub _ E) @@ -77,7 +70,7 @@ End PIncl. Section Countable. Variable (T : Type) (E : pred T). -CoInductive countable : Type := +Variant countable : Type := Countable (rpickle : [psub E] -> nat) (runpickle : nat -> option [psub E]) @@ -113,20 +106,13 @@ End CanCountable. Section CountType. Variables (T : eqType) (E : pred T) (c : countable E). -Definition countable_countMixin := CountMixin (rpickleK c). -Definition countable_choiceMixin := CountChoiceMixin countable_countMixin. - -Definition countable_choiceType := - ChoiceType [psub E] countable_choiceMixin. - -Definition countable_countType := - CountType countable_choiceType countable_countMixin. +Definition countable_countMixin := Countable.copy [psub E] + (pcan_type (rpickleK c)). +Definition countable_choiceMixin := Choice.copy [psub E] + (pcan_type (rpickleK c)). End CountType. End CountableTheory. -Notation "[ 'countable' 'of' c ]" := (countable_countType c) - (format "[ 'countable' 'of' c ]"). - (* -------------------------------------------------------------------- *) Section Finite. Variables (T : eqType). @@ -183,7 +169,7 @@ Variables (T : eqType) (E F : pred T). Lemma countable_sub: {subset E <= F} -> countable F -> countable E. Proof. move=> le_EF [f g fgK]; pose f' (x : [psub E]) := f (pincl le_EF x). -pose g' x := obind (insub (sT := [subType of [psub E]])) (omap val (g x)). +pose g' x := obind (insub (sT := [the subType _ of [psub E]])) (omap val (g x)). by exists f' g' => x; rewrite /f' /g' fgK /= valK. Qed. End CountSub. @@ -196,7 +182,8 @@ Hypothesis cE : forall i, countable (E i). Lemma cunion_countable : countable [pred x | `[< exists i, x \in E i >]]. Proof. -pose S := { i : nat & [countable of cE i] }; set F := [pred x | _]. +pose Ci i : countType := HB.pack [psub (E i)] (countable_countMixin (cE i)). +pose S := { i : nat & Ci i }; set F := [pred x | _]. have H: forall (x : [psub F]), exists i : nat, val x \in E i. by case=> x /= /asboolP[i] Eix; exists i. have G: forall (x : S), val (tagged x) \in F. diff --git a/theories/altreals/distr.v b/theories/altreals/distr.v index ab093e019..b81cca9e7 100644 --- a/theories/altreals/distr.v +++ b/theories/altreals/distr.v @@ -70,7 +70,8 @@ Lemma summable_mu : summable mu. Proof. by case: mu. Qed. End DistrCoreTh. -#[global] Hint Resolve ge0_mu le1_mu summable_mu : core. +#[global] Hint Extern 0 (is_true (0 <= _)) => solve [apply: ge0_mu] : core. +#[global] Hint Resolve le1_mu summable_mu : core. (* -------------------------------------------------------------------- *) Section Clamp. @@ -174,13 +175,13 @@ Lemma isdistr_finP {R : realType} {I : finType} (mu : I -> R) : Proof. split=> -[ ge0_mu le1]; split=> //. + by apply/le1; rewrite /index_enum -enumT enum_uniq. + move=> J uqJ; rewrite big_uniq 1?(le_trans _ le1) //=. - by rewrite [X in _<=X](bigID (mem J)) /= ler_addl sumr_ge0. + by rewrite [X in _<=X](bigID (mem J)) /= lerDl sumr_ge0. Qed. Lemma le1_mu1 {R : realType} {T : choiceType} (mu : {distr T / R}) x : mu x <= 1. Proof. -apply/(@le_trans _ _ (psum mu)) => //; rewrite -[mu x]ger0_norm //. +apply/(@le_trans _ _ (psum mu)) => //; rewrite -[mu x]ger0_norm//. by apply/ger1_psum. Qed. @@ -267,7 +268,7 @@ Local Lemma has_sup_mrat s J : uniq J -> \sum_(i <- J) mrat s i <= 1. Proof. move=> uqJ; rewrite -mulr_suml /= -natr_sum; case: (size s =P 0%N). by move=> ->; rewrite invr0 mulr0 ler01. -move=> /eqP nz_s; rewrite ler_pdivr_mulr ?ltr0n ?lt0n // mul1r. +move=> /eqP nz_s; rewrite ler_pdivrMr ?ltr0n ?lt0n // mul1r. rewrite ler_nat (bigID (mem s)) /= [X in (_+X)%N]big1 ?addn0. by move=> i /count_memPn. have ->: (size s = \sum_(i <- undup s) count_mem i s)%N. @@ -362,10 +363,10 @@ Proof. split=> [x|J uqJ]; first by apply/ge0_psum. rewrite /mlet psum_bigop; first by move=> y x; rewrite mulr_ge0. move=> u; apply/(le_summable (F2 := mu)) => //. - by move=> x; rewrite mulr_ge0 //= ler_pimulr ?le1_mu1. + by move=> x; rewrite mulr_ge0 //= ler_piMr ?le1_mu1. apply/(le_trans _ (le1_mu mu))/le_psum => //. move=> x; rewrite sumr_ge0 /= => [y _|]; first by rewrite mulr_ge0. -rewrite -mulr_sumr ler_pimulr //; apply/(le_trans _ (le1_mu (f x))). +rewrite -mulr_sumr ler_piMr //; apply/(le_trans _ (le1_mu (f x))). have := summable_mu (f x) => /gerfinseq_psum => /(_ _ uqJ). by apply/(le_trans _)/ler_sum=> y _; apply/ler_norm. Qed. @@ -437,7 +438,7 @@ Proof. (* summable -> refactor *) move=> le_f; unlock dlet=> y /=; apply/le_psum/summable_mlet. move=> x; rewrite mulr_ge0 //=; case: (mu x =P 0). by move=> ->; rewrite !mul0r. -by move/dinsuppPn/le_f/(_ y) => h; rewrite ler_pmul. +by move/dinsuppPn/le_f/(_ y) => h; rewrite ler_pM. Qed. Lemma le_mu_dlet f mu nu : mu <=1 nu -> dlet f mu <=1 dlet f nu. @@ -445,7 +446,7 @@ Proof. move=> le_mu x; unlock dlet; rewrite /= /mlet. apply/le_psum/summable_mlet => y; rewrite mulr_ge0 //=. case: (mu y =P 0) => [->|]; first by rewrite mul0r mulr_ge0. -by move=>/dinsuppPn=> h; rewrite ler_pmul. +by move=>/dinsuppPn=> h; rewrite ler_pM. Qed. Lemma le_dlet f g mu nu : @@ -495,7 +496,7 @@ Proof. unlock dlet; rewrite /= /mlet => /eq0_psum h x /dinsuppP /eqP mu_x. have {}/h: summable (fun x => mu x * F x y). apply/(le_summable (F2 := mu)) => // z. - by rewrite mulr_ge0 //= ler_pimulr // le1_mu1. + by rewrite mulr_ge0 //= ler_piMr // le1_mu1. by move/(_ x)/eqP; rewrite mulf_eq0 (negbTE mu_x) /= => /eqP. Qed. End BindTheory. @@ -504,7 +505,7 @@ End BindTheory. Section DLetDLet. Context {T U V : choiceType} (f1 : T -> distr U) (f2 : U -> distr V). -Lemma dlet_dlet (mu : {distr T / R}) : +Lemma __deprecated__dlet_dlet (mu : {distr T / R}) : \dlet_(x <- \dlet_(y <- mu) f1 y) f2 x =1 \dlet_(y <- mu) (\dlet_(x <- f1 y) f2 x). Proof. @@ -512,12 +513,12 @@ move=> z; unlock dlet => /=; rewrite /mlet /=. pose S y x := mu x * (f1 x y * f2 y z). rewrite (eq_psum (F2 := fun y => psum (S^~ y))) => [x|]. by rewrite -psumZ //; apply/eq_psum => y /=. -rewrite interchange_psum. +rewrite __admitted__interchange_psum. + by move=> x; apply/summableZ/summable_mlet. + rewrite {}/S; apply/(le_summable (F2 := mu)) => //. - move=> x; rewrite ge0_psum /= psumZ ?ler_pimulr //. + move=> x; rewrite ge0_psum /= psumZ ?ler_piMr //. apply/(le_trans _ (le1_mu (f1 x)))/le_psum => //. - by move=> y; rewrite mulr_ge0 //= ler_pimulr ?le1_mu1. + by move=> y; rewrite mulr_ge0 //= ler_piMr ?le1_mu1. apply/eq_psum=> y /=; rewrite -psumZr //. by apply/eq_psum=> x /=; rewrite {}/S mulrA. Qed. @@ -566,8 +567,7 @@ apply/(@le_trans _ _ (\sum_(j <- J) f K j)); last first. have /(gerfinseq_psum uqJ) := summable_mu (f K). move/le_trans=> -/(_ _ (le1_mu (f K)))=> h. by apply/(le_trans _ h)/ler_sum=> i _; apply/ler_norm. -apply/ler_sum=> j _; rewrite /F; case/boolP: `[< _ >]; [done|]. -by move=> _; apply/ge0_mu. +by apply/ler_sum=> j _; rewrite /F; case/boolP: `[< _ >]. Qed. Definition dlim T (f : nat -> distr T) := @@ -680,17 +680,24 @@ move/dcvg_homo: mn_f => /dcvgP /(_ x) [l _]. by move=> cv; rewrite (nlimE cv). Qed. -Lemma dlet_lim f h : (forall n m, (n <= m)%N -> f n <=1 f m) -> +Lemma __admitted__dlet_lim f h : (forall n m, (n <= m)%N -> f n <=1 f m) -> \dlet_(x <- dlim f) h x =1 \dlim_(n) \dlet_(x <- f n) h x. Proof. Admitted. -Lemma dlim_let (f : nat -> T -> {distr U / R}) (mu : {distr T / R}) : +Lemma __admitted__dlim_let (f : nat -> T -> {distr U / R}) (mu : {distr T / R}) : (forall x n m, (n <= m)%N -> f n x <=1 f m x) -> \dlim_(n) \dlet_(x <- mu) (f n x) =1 \dlet_(x <- mu) \dlim_(n) (f n x). Proof using Type. Admitted. End DLimTheory. +#[deprecated(since="mathcomp-analysis 0.6.2", + note="lacks proof, use __admitted__dlet_lim explicitly if you really want to use this lemma")] +Notation dlet_lim := __admitted__dlet_lim. +#[deprecated(since="mathcomp-analysis 0.6.2", + note="lacks proof, use __admitted__dlim_let explicitly if you really want to use this lemma")] +Notation dlim_let := __admitted__dlim_let. + (* -------------------------------------------------------------------- *) Section Marginals. Variable (T U : choiceType) (h : T -> U) (mu : distr T). @@ -712,16 +719,16 @@ rewrite dmarginE dletE; apply/eq_psum => x //=. by rewrite mulrC dunit1E. Qed. -Lemma dlet_dmargin (mu : {distr T / R}) (f : T -> U) (g : U -> {distr V / R}): +Lemma __deprecated__dlet_dmargin (mu : {distr T / R}) (f : T -> U) (g : U -> {distr V / R}): \dlet_(u <- dmargin f mu) g u =1 \dlet_(t <- mu) (g (f t)). Proof. -move=> x; rewrite dlet_dlet; apply: eq_in_dlet=> //. +move=> x; rewrite __deprecated__dlet_dlet; apply: eq_in_dlet=> //. by move=> y _ z; rewrite dlet_unit. Qed. -Lemma dmargin_dlet (mu : {distr T / R}) (f : U -> V) (g : T -> {distr U / R}): +Lemma __deprecated__dmargin_dlet (mu : {distr T / R}) (f : U -> V) (g : T -> {distr U / R}): dmargin f (\dlet_(t <- mu) g t) =1 \dlet_(t <- mu) (dmargin f (g t)). -Proof. by apply/dlet_dlet. Qed. +Proof. by apply/__deprecated__dlet_dlet. Qed. Lemma dmargin_dunit (t : T) (f : T -> U): dmargin f (dunit t) =1 dunit (f t) :> {distr U / R}. @@ -729,6 +736,16 @@ Proof. by apply/dlet_unit. Qed. End MarginalsTh. End Std. +#[deprecated(since="mathcomp-analysis 0.6.2", + note="relies on admitted, use __deprecated__dlet_dlet explicitly if you really want to use this lemma")] +Notation dlet_dlet := __deprecated__dlet_dlet. +#[deprecated(since="mathcomp-analysis 0.6.2", + note="relies on admitted, use __deprecated__dmargin_dlet explicitly if you really want to use this lemma")] +Notation dmargin_dlet := __deprecated__dmargin_dlet. +#[deprecated(since="mathcomp-analysis 0.6.2", + note="relies on admitted, use __deprecated__dlet_dmargin explicitly if you really want to use this lemma")] +Notation dlet_dmargin := __deprecated__dlet_dmargin. + Notation dfst mu := (dmargin fst mu). Notation dsnd mu := (dmargin snd mu). @@ -770,19 +787,26 @@ Proof. by move=> h; apply/dinsuppP; rewrite dswapE; apply/dinsuppPn. Qed. -Lemma dfst_dswap : dfst (dswap mu) =1 dsnd mu. +Lemma __deprecated__dfst_dswap : dfst (dswap mu) =1 dsnd mu. Proof. -move=> z; rewrite dlet_dlet; apply/eq_in_dlet => // -[x y]. +move=> z; rewrite __deprecated__dlet_dlet; apply/eq_in_dlet => // -[x y]. by move=> _ t /=; rewrite dlet_unit /=. Qed. -Lemma dsnd_dswap : dsnd (dswap mu) =1 dfst mu. +Lemma __deprecated__dsnd_dswap : dsnd (dswap mu) =1 dfst mu. Proof. -move=> z; rewrite dlet_dlet; apply/eq_in_dlet => // -[x y]. +move=> z; rewrite __deprecated__dlet_dlet; apply/eq_in_dlet => // -[x y]. by move=> _ t /=; rewrite dlet_unit /=. Qed. End DSwapTheory. +#[deprecated(since="mathcomp-analysis 0.6.2", + note="relies on admitted, use __deprecated__dfst_dswap explicitly if you really want to use this lemma")] +Notation dfst_dswap := __deprecated__dfst_dswap. +#[deprecated(since="mathcomp-analysis 0.6.2", + note="relies on admitted, use __deprecated__dsnd_dswap explicitly if you really want to use this lemma")] +Notation dsnd_dswap := __deprecated__dsnd_dswap. + (* -------------------------------------------------------------------- *) Section DFst. Context {R : realType} {T U : choiceType}. @@ -812,9 +836,9 @@ End DFst. Section DSnd. Context {R : realType} {T U : choiceType}. -Lemma dsndE (mu : {distr (T * U) / R}) y : +Lemma __deprecated__dsndE (mu : {distr (T * U) / R}) y : dsnd mu y = psum (fun x => mu (x, y)). -Proof. by rewrite -dfst_dswap dfstE; apply/eq_psum=> x; rewrite dswapE. Qed. +Proof. by rewrite -__deprecated__dfst_dswap dfstE; apply/eq_psum=> x; rewrite dswapE. Qed. Lemma summable_snd (mu : {distr (T * U) / R}) y : summable (fun x => mu (x, y)). @@ -824,6 +848,10 @@ by move=> x /=; rewrite dswapE. Qed. End DSnd. +#[deprecated(since="mathcomp-analysis 0.6.2", + note="relies on admitted, use __deprecated__dsndE explicitly if you really want to use this lemma")] +Notation dsndE := __deprecated__dsndE. + (* -------------------------------------------------------------------- *) Section PrCoreTheory. Context {R : realType} {T : choiceType}. @@ -833,7 +861,7 @@ Implicit Types (mu : {distr T / R}) (A B E : pred T). Lemma summable_pr E mu : summable (fun x => (E x)%:R * mu x). Proof. apply/(le_summable (F2 := mu)) => [x|]; last by apply/summable_mu. - by rewrite mulr_ge0 ?ler0n //= ler_pimull // lern1 leq_b1. + by rewrite mulr_ge0 ?ler0n //= ler_piMl // lern1 leq_b1. Qed. Lemma pr_pred0 mu : \P_[mu] pred0 = 0. @@ -929,7 +957,7 @@ Context {R : realType} {T U : choiceType} {I : eqType}. Implicit Types (mu : {distr T / R}) (A B E : pred T). -Lemma pr_dlet E f (mu : {distr U / R}) : +Lemma __deprecated__pr_dlet E f (mu : {distr U / R}) : \P_[dlet f mu] E = \E_[mu] (fun x => \P_[f x] E). Proof. rewrite /esp -psum_sum => [x|]; first by rewrite mulr_ge0 ?ge0_pr. @@ -937,7 +965,7 @@ rewrite /pr; unlock dlet => /=; rewrite /mlet /=. pose F x y := (E x)%:R * (mu y * f y x). transitivity (psum (fun x => psum (fun y => F x y))); rewrite {}/F. by apply/eq_psum => x; rewrite -psumZ ?ler0n. -rewrite interchange_psum /=; last first. +rewrite __admitted__interchange_psum /=; last first. apply/eq_psum=> y /=; rewrite mulrC -psumZ //. by apply/eq_psum=> x /=; rewrite mulrCA. + have := summable_pr E (dlet f mu); apply/eq_summable. @@ -948,7 +976,7 @@ Qed. Lemma pr_dmargin E f (mu : {distr U / R}) : \P_[dmargin f mu] E = \P_[mu] [pred x | f x \in E]. Proof. -by rewrite /dmargin pr_dlet pr_exp; apply/eq_exp=> x _; rewrite pr_dunit. +by rewrite /dmargin __deprecated__pr_dlet pr_exp; apply/eq_exp=> x _; rewrite pr_dunit. Qed. Lemma eq0_pr A mu : @@ -972,7 +1000,7 @@ Proof. move=> le_BA; apply/le_psum; last first. apply/summableMl => //; exists 1=> // x. by rewrite ger0_norm ?(ler0n, lern1) ?leq_b1. -move=> x; rewrite mulr_ge0 ?ler0n ?ler_wpmul2r //. +move=> x; rewrite mulr_ge0 ?ler0n ?ler_wpM2r //. rewrite ler_nat; have := le_BA x; rewrite -!topredE /=. by case: (B x) => // ->. Qed. @@ -987,7 +1015,7 @@ Lemma le_exp mu f1 f2: \E?_[mu] f1 -> \E?_[mu] f2 -> f1 <=1 f2 -> \E_[mu] f1 <= \E_[mu] f2. Proof. move=> sm1 sm2 le_f; apply/le_sum => //. -by move=> x; rewrite ler_wpmul2r. +by move=> x; rewrite ler_wpM2r. Qed. Lemma le_in_pr E1 E2 mu : @@ -996,7 +1024,7 @@ Lemma le_in_pr E1 E2 mu : Proof. move=> le; rewrite /pr; apply/le_psum; last by apply/summable_pr. move=> x; rewrite mulr_ge0 ?ler0n //=; case/boolP: (x \in dinsupp mu). - move/le; rewrite -!topredE /= => E12; rewrite ler_wpmul2r //. + move/le; rewrite -!topredE /= => E12; rewrite ler_wpM2r //. by rewrite ler_nat; case: (E1 x) E12 => // ->. by move/dinsuppPn=> ->; rewrite !mulr0. Qed. @@ -1016,7 +1044,7 @@ Lemma le1_prc A B mu : \P_[mu, B] A <= 1. Proof. have := ge0_pr B mu; rewrite /prc le_eqVlt. case/orP=> [/eqP<-|]; first by rewrite invr0 mulr0 ler01. -by move/ler_pdivr_mulr=> ->; rewrite mul1r le_in_pr // => x _ /andP[]. +by move/ler_pdivrMr=> ->; rewrite mul1r le_in_pr // => x _ /andP[]. Qed. Lemma prc_sum A mu : 0 < \P_[mu] A -> @@ -1109,11 +1137,11 @@ Proof. by rewrite pr_or opprB addrCA subrr addr0. Qed. Lemma ler_pr_or A B mu : \P_[mu] [predU A & B] <= \P_[mu] A + \P_[mu] B. -Proof. by rewrite pr_or ler_subl_addr ler_addl ge0_pr. Qed. +Proof. by rewrite pr_or lerBlDr lerDl ge0_pr. Qed. Lemma ler_pr_and A B mu : \P_[mu] [predI A & B] <= \P_[mu] A + \P_[mu] B. -Proof. by rewrite pr_and ler_subl_addr ler_addl ge0_pr. Qed. +Proof. by rewrite pr_and lerBlDr lerDl ge0_pr. Qed. Lemma pr_predC E mu: \P_[mu](predC E) = \P_[mu] predT - \P_[mu] E. Proof. @@ -1134,7 +1162,7 @@ move=> x mux; move/pr_eq0: zPB' => /(_ x) h; rewrite !inE. by apply/negP=> /andP[_ /h] /dinsuppP. Qed. -Lemma exp_split A f mu : \E?_[mu] f -> \E_[mu] f = +Lemma __admitted__exp_split A f mu : \E?_[mu] f -> \E_[mu] f = \P_[mu] A * \E_[mu, A] f + \P_[mu] (predC A) * \E_[mu, predC A] f. Proof using Type. Admitted. @@ -1146,11 +1174,11 @@ case=> M ltM; rewrite /has_esp; apply/summable_seqP. exists (Num.max M 0); first by rewrite le_maxr lexx orbT. move=> J uqJ; apply/(@le_trans _ _ (\sum_(j <- J) M * mu j)). apply/ler_sum=> j _; rewrite normrM [X in _*X]ger0_norm //. - by apply/ler_wpmul2r=> //; apply/ltW. + by apply/ler_wpM2r=> //; apply/ltW. case: (ltrP M 0) => [lt0_M|ge0_M]. rewrite ?(ltW lt0_M) // -mulr_sumr. by rewrite nmulr_rle0 //; apply/sumr_ge0. -by rewrite -mulr_sumr ler_pimulr // -pr_mem ?le1_pr. +by rewrite -mulr_sumr ler_piMr // -pr_mem ?le1_pr. Qed. Lemma bounded_has_exp mu F : @@ -1171,15 +1199,25 @@ move=> ge0M bd; apply/(@le_trans _ _ (\E_[mu] (fun _ => M))). + by apply/bounded_has_exp; exists M. + by apply/has_expC. + by move=> x; apply/(le_trans _ (bd x))/ler_norm. -by rewrite exp_cst ler_pimull // le1_pr. +by rewrite exp_cst ler_piMl // le1_pr. Qed. -Lemma exp_dlet mu (nu : T -> {distr U / R}) F : +Lemma __admitted__exp_dlet mu (nu : T -> {distr U / R}) F : (forall eta, \E?_[eta] F) -> \E_[dlet nu mu] F = \E_[mu] (fun x => \E_[nu x] F). Proof using Type*. Admitted. End PrTheory. +#[deprecated(since="mathcomp-analysis 0.6.2", + note="relies on admitted, use __deprecated__pr_dlet explicitly if you really want to use this lemma")] +Notation pr_dlet := __deprecated__pr_dlet. +#[deprecated(since="mathcomp-analysis 0.6.2", + note="lacks proof, use __admitted__exp_split explicitly if you really want to use this lemma")] +Notation exp_split := __admitted__exp_split. +#[deprecated(since="mathcomp-analysis 0.6.2", + note="lacks proof, use __admitted__exp_dlet explicitly is you really want to use this lemma")] +Notation exp_dlet := __admitted__exp_dlet. + (* -------------------------------------------------------------------- *) Section Jensen. Context {R : realType} {I : finType}. @@ -1206,21 +1244,21 @@ elim: {i} s (l i) (ge0_l i) (x i) => [|j s ih] li ge0_li xi. by rewrite !big_nil !addr0 => ->; rewrite !mul1r. rewrite !big_cons; have := ge0_l j; rewrite le_eqVlt. case/orP => [/eqP<-|gt0_lj]. - by rewrite !Monoid.simpm /=; apply/ih. + by rewrite !Monoid.simpm /= !Monoid.simpm; apply/ih. rewrite !addrA => eq1; pose z := (li * xi + l j * x j) / (li + l j). -have nz_lij: li + l j != 0 by rewrite gt_eqF ?ltr_paddl. +have nz_lij: li + l j != 0 by rewrite gt_eqF ?ltr_wpDl. have/ih := eq1 => -/(_ _ z); rewrite [_ * (_ / _)]mulrC. rewrite mulfVK // => {}ih; apply/(le_trans (ih _)). by rewrite addr_ge0 ?ge0_l. -rewrite ler_add2r {ih}/z mulrDl ![_*_/_]mulrAC. +rewrite lerD2r {ih}/z [_ / _]mulrDl ![_*_/_]mulrAC. set c1 : R := _ / _; set c2 : R := _ / _; have eqc2: c2 = 1 - c1. apply/(mulfI nz_lij); rewrite mulrBr mulr1 ![(li + l j)*_]mulrC. by apply/eqP; rewrite !mulfVK // eq_sym subr_eq addrC. set c := (li + l j); pose z := (c * c1 * f xi + c * c2 * f (x j)). apply/(@le_trans _ _ z); last by rewrite /z ![_*(_/_)]mulrC !mulfVK. -rewrite {}/z -![c * _ * _]mulrA -mulrDr ler_wpmul2l ?addr_ge0 //. +rewrite {}/z -![c * _ * _]mulrA -mulrDr ler_wpM2l ?addr_ge0 //. rewrite eqc2 cvx_f // ?leNye ?leey // divr_ge0 ?addr_ge0 //=. -by rewrite ler_pdivr_mulr ?mul1r ?ler_addl ?ltr_paddl. +by rewrite ler_pdivrMr ?mul1r ?lerDl ?ltr_wpDl. Qed. End Jensen. End Jensen. diff --git a/theories/altreals/realseq.v b/theories/altreals/realseq.v index f611a0d0b..7462ed1c7 100644 --- a/theories/altreals/realseq.v +++ b/theories/altreals/realseq.v @@ -112,18 +112,17 @@ case: l1 l2 => [l1||] [l2||] //= lt_l12; last first. + exists (NNInf 0), (NPInf 1) => x y; rewrite !inE => lt1 lt2. by apply/(lt_trans lt1)/(lt_trans ltr01). + exists (NNInf (l2-1)), (B1 l2) => x y; rewrite !inE. - rewrite ltr_norml [-1 < _]ltr_subr_addl. + rewrite ltr_norml [-1 < _]ltrBrDl. by move => lt1 /andP[lt2 _]; apply/(lt_trans lt1). + exists (B1 l1), (NPInf (l1+1)) => x y; rewrite !inE. - rewrite ltr_norml ltr_subl_addr [1+_]addrC => /andP[_]. + rewrite ltr_norml ltrBlDr [1+_]addrC => /andP[_]. by move=> lt1 lt2; apply/(lt_trans lt1). pose e := l2 - l1; exists (B l1 (e/2%:R)), (B l2 (e/2%:R)). have gt0_e: 0 < e by rewrite subr_gt0. move=> x y; rewrite !inE/= /eclamp pmulr_rle0 // invr_le0. rewrite lern0 /= !ltr_distl => /andP[_ lt1] /andP[lt2 _]. apply/(lt_trans lt1)/(le_lt_trans _ lt2). -rewrite ler_subr_addl addrCA -mulrDl -mulr2n -mulr_natr. -by rewrite mulfK ?pnatr_eq0 //= /e addrCA subrr addr0. +by rewrite lerBrDl addrCA -splitr /e addrCA subrr addr0. Qed. Lemma separable {R : realType} (l1 l2 : \bar R) : @@ -210,14 +209,14 @@ Lemma ncvg_nbounded u x : ncvg u x%:E -> nbounded u. Proof. (* FIXME: factor out `sup` of a finite set *) case/(_ (B x 1)) => K cu; pose S := [seq `|u n| | n <- iota 0 K]. pose M : R := sup [set x : R | x \in S]; pose e := Num.max (`|x| + 1) (M + 1). -apply/asboolP/nboundedP; exists e => [|n]; first by rewrite lt_maxr ltr_paddl. +apply/asboolP/nboundedP; exists e => [|n]; first by rewrite lt_maxr ltr_wpDl. case: (ltnP n K); last first. move/cu; rewrite inE eclamp_id ?ltr01 // => ltunBx1. rewrite lt_maxr; apply/orP; left; rewrite -[u n](addrK x) addrAC. - by apply/(le_lt_trans (ler_norm_add _ _)); rewrite addrC ltr_add2l. + by apply/(le_lt_trans (ler_normD _ _)); rewrite addrC ltrD2l. move=> lt_nK; have: `|u n| \in S; first by apply/map_f; rewrite mem_iota. move=> un_S; rewrite lt_maxr; apply/orP; right. -case E: {+}K lt_nK => [|k] // lt_nSk; apply/ltr_spaddr; first apply/ltr01. +case E: {+}K lt_nK => [|k] // lt_nSk; apply/ltr_pwDr; first apply/ltr01. suff : has_sup (fun x : R => x \in S) by move/sup_upper_bound/ubP => ->. split; first by exists `|u 0%N|; rewrite /S E inE eqxx. elim: {+}S => [|v s [ux /ubP hux]]; first by exists 0; apply/ubP. @@ -229,7 +228,7 @@ Qed. Lemma nboundedC c : nbounded c%:S. Proof. apply/asboolP/nboundedP; exists (`|c| + 1). - by rewrite ltr_spaddr. by move=> _; rewrite ltr_addl. + by rewrite ltr_pwDr. by move=> _; rewrite ltrDl. Qed. Lemma ncvgC c : ncvg c%:S c%:E. @@ -244,20 +243,20 @@ Proof. move=> cu cv; elim/nbh_finW => e /= gt0_e; pose z := e / 2%:R. case: (cu (B lu z)) (cv (B lv z)) => [ku {}cu] [kv {}cv]. exists (maxn ku kv) => n; rewrite geq_max => /andP[leu lev]. -rewrite inE opprD addrACA (le_lt_trans (ler_norm_add _ _)) //. +rewrite inE opprD addrACA (le_lt_trans (ler_normD _ _)) //. move: (cu _ leu) (cv _ lev); rewrite !inE eclamp_id. by rewrite mulr_gt0 // invr_gt0 ltr0Sn. -move=> cu' cv'; suff ->: e = z + z by rewrite ltr_add. -by rewrite -mulrDl -mulr2n -mulr_natr mulfK ?pnatr_eq0. +move=> cu' cv'; suff ->: e = z + z by rewrite ltrD. +exact: splitr. Qed. Lemma ncvgN u lu : ncvg u lu -> ncvg (- u) (- lu). Proof. case: lu => [lu||] cu /=; first last. + elim/nbh_pinfW=> M; case: (cu (NNInf (-M))) => K {}cu. - by exists K => n /cu; rewrite !inE ltr_oppr. + by exists K => n /cu; rewrite !inE ltrNr. + elim/nbh_ninfW=> M; case: (cu (NPInf (-M))) => K {}cu. - by exists K => n /cu; rewrite !inE ltr_oppl. + by exists K => n /cu; rewrite !inE ltrNl. elim/nbh_finW => e /= gt0_e; case: (cu (B lu e)). by move=> K {}cu; exists K=> n /cu; rewrite !inE -opprD normrN eclamp_id. Qed. @@ -286,10 +285,10 @@ Lemma ncvgMl u v : ncvg u 0%:E -> nbounded v -> ncvg (u \* v) 0%:E. move=> cu /asboolP/nboundedP [M gt0_M ltM]; elim/nbh_finW => e /= gt0_e. case: (cu (B 0 (e / (M + 1)))) => K {}cu; exists K => n le_Kn. rewrite inE subr0 normrM; apply/(@lt_trans _ _ (e / (M + 1) * M)). - apply/ltr_pmul => //; have /cu := le_Kn; rewrite inE subr0 eclamp_id //. + apply/ltr_pM => //; have /cu := le_Kn; rewrite inE subr0 eclamp_id //. by rewrite mulr_gt0 // invr_gt0 addr_gt0. -rewrite -mulrAC -mulrA gtr_pmulr // ltr_pdivr_mulr ?addr_gt0 //. -by rewrite mul1r ltr_addl. +rewrite -mulrAC -mulrA gtr_pMr // ltr_pdivrMr ?addr_gt0 //. +by rewrite mul1r ltrDl. Qed. Lemma ncvgMr u v : ncvg v 0%:E -> nbounded u -> ncvg (u \* v) 0%:E. @@ -542,7 +541,7 @@ elim/nbh_finW=> /= e gt0_e; have sS: has_sup S. have /sup_adherent := sS => /(_ _ gt0_e) [r] [N ->] lt_uN. exists N => n le_Nn; rewrite !inE distrC ger0_norm ?subr_ge0. by move/ubP : (sup_upper_bound sS) => -> //; exists n. -by rewrite ltr_subl_addr -ltr_subl_addl (lt_le_trans lt_uN) ?mn_u. +by rewrite ltrBlDr -ltrBlDl (lt_le_trans lt_uN) ?mn_u. Qed. End LimOp. diff --git a/theories/altreals/realsum.v b/theories/altreals/realsum.v index 43ec07ada..caaa40645 100644 --- a/theories/altreals/realsum.v +++ b/theories/altreals/realsum.v @@ -70,7 +70,7 @@ Proof. by move=> x; rewrite /fpos /fneg -{1}oppr0 -oppr_min normrN. Qed. Lemma fposZ f c : 0 <= c -> fpos (c \*o f) =1 c \*o fpos f. Proof. move=> ge0_c x; rewrite /fpos /= -{1}(mulr0 c). -by rewrite -maxr_pmulr // normrM ger0_norm. +by rewrite -maxr_pMr // normrM ger0_norm. Qed. Lemma fnegZ f c : 0 <= c -> fneg (c \*o f) =1 c \*o fneg f. @@ -83,7 +83,7 @@ Lemma fpos_natrM f (n : T -> nat) x : fpos (fun x => (n x)%:R * f x) x = (n x)%:R * fpos f x. Proof. rewrite /fpos -[in RHS]normr_nat -normrM. -by rewrite maxr_pmulr ?ler0n // mulr0. +by rewrite maxr_pMr ?ler0n // mulr0. Qed. Lemma fneg_natrM f (n : T -> nat) x : @@ -143,7 +143,7 @@ case/summableP=> M ge0_M bM; pose E (p : nat) := [pred x | `|f x| > 1 / p.+1%:~R set F := [pred x | _]; have le: {subset F <= [pred x | `[< exists p, x \in E p >]]}. move=> x; rewrite !inE => nz_fx. pose j := `|floor (1 / `|f x|)|%N; exists j; rewrite inE. - rewrite ltr_pdivr_mulr ?ltr0z // -ltr_pdivr_mull ?normr_gt0 //. + rewrite ltr_pdivrMr ?ltr0z // -ltr_pdivrMl ?normr_gt0 //. rewrite mulr1 /j div1r -addn1 /= PoszD intrD mulr1z. rewrite gez0_abs ?floor_ge0 ?invr_ge0 ?normr_ge0 //. by rewrite -RfloorE; apply lt_succ_Rfloor. @@ -185,7 +185,7 @@ elim/nbh_finW=>e /= gt0_e. case: (sup_adherent gt0_e supE)=> x [K ->] lt_uK. exists K=> n le_Kn; rewrite inE distrC ger0_norm ?subr_ge0. by move/ubP: (sup_upper_bound supE); apply; exists n. -rewrite ltr_subl_addr addrC -ltr_subl_addr. +rewrite ltrBlDr addrC -ltrBlDr. by rewrite (lt_le_trans lt_uK) //; apply/mono_u. Qed. @@ -444,15 +444,15 @@ Hypothesis smS : summable S. Lemma ptsum_homo x y : (x <= y)%N -> (\sum_(i < x) S i <= \sum_(i < y) S i). Proof. move=> le_xy; rewrite -!(big_mkord predT) -(subnKC le_xy) /=. -by rewrite /index_iota !subn0 iotaD big_cat /= ler_addl sumr_ge0. +by rewrite /index_iota !subn0 iotaD big_cat /= lerDl sumr_ge0. Qed. Lemma psummable_ptbounded : nbounded (fun n => \sum_(i < n) S i). Proof. apply/asboolP/nboundedP; exists (psum S + 1). - rewrite ltr_spaddr ?ltr01 1?(le_trans (normr_ge0 (S 0%N))) //. + rewrite ltr_pwDr ?ltr01 1?(le_trans (normr_ge0 (S 0%N))) //. by apply/ger1_psum. -move=> n; rewrite ltr_spaddr ?ltr01 // ger0_norm ?sumr_ge0 //. +move=> n; rewrite ltr_pwDr ?ltr01 // ger0_norm ?sumr_ge0 //. apply/(le_trans _ (ger_big_ord_psum _ n)) => //. by apply/ler_sum=> /= i _; apply/ler_norm. Qed. @@ -506,9 +506,9 @@ have bd_v n : v n <= psum S. by move=> J _; apply/ler_norm. case: (ncvg_mono_bnd hm_v) => [|l cv]. apply/asboolP/nboundedP; exists (psum S + 1) => //. - by apply/(le_lt_trans (ge0_psum S)); rewrite ltr_addl ltr01. + by apply/(le_lt_trans (ge0_psum S)); rewrite ltrDl ltr01. move=> n; rewrite ger0_norm ?sumr_ge0 //. - by rewrite (le_lt_trans (bd_v n)) // ltr_addl ltr01. + by rewrite (le_lt_trans (bd_v n)) // ltrDl ltr01. have le_lS: l <= psum S by rewrite -lee_fin (ncvg_leC _ cv). rewrite (nlimE cv) /= (rwP eqP) eq_le le_lS andbT. rewrite leNgt; apply/negP=> {le_lS} /(lt_psum smS)[J]. @@ -564,8 +564,8 @@ Proof. case=> [M1 h1] [M2 h2]; exists (M1 + M2) => J /=. pose M := \sum_(x : J) (`|S1 (val x)| + `|S2 (val x)|). rewrite (@le_trans _ _ M) // ?ler_sum // => [K _|]. - by rewrite ler_norm_add. -by rewrite /M big_split ler_add ?(h1, h2). + by rewrite ler_normD. +by rewrite /M big_split lerD ?(h1, h2). Qed. (* -------------------------------------------------------------------- *) @@ -606,7 +606,7 @@ Qed. Lemma summableZ (S : T -> R) c : summable S -> summable (c \*o S). Proof. case=> [M h]; exists (`|c| * M) => J; move/(_ J): h => /=. -move/(ler_wpmul2l (normr_ge0 c)); rewrite mulr_sumr. +move/(ler_wpM2l (normr_ge0 c)); rewrite mulr_sumr. move/(le_trans _); apply; rewrite le_eqVlt; apply/orP. by left; apply/eqP/eq_bigr=> j _; rewrite normrM. Qed. @@ -622,7 +622,7 @@ Lemma summableMl (S1 S2 : T -> R) : Proof. case=> M leM smS2; apply/summable_abs. apply/(le_summable (F2 := M \*o \`|S2|)). -+ by move=> x /=; rewrite normr_ge0 /= normrM ler_wpmul2r. ++ by move=> x /=; rewrite normr_ge0 /= normrM ler_wpM2r. + by apply/summableZ/summable_abs. Qed. @@ -771,7 +771,7 @@ Lemma le_psum_condl (S : T -> R) (P : pred T) : summable S -> psum (fun x => (P x)%:R * S x) <= psum S. Proof. move=> smS; apply/le_psum_abs=> // x; rewrite normrM. -by apply/ler_pimull => //; rewrite normr_nat lern1 leq_b1. +by apply/ler_piMl => //; rewrite normr_nat lern1 leq_b1. Qed. (* -------------------------------------------------------------------- *) @@ -804,24 +804,24 @@ rewrite !psumE // (rwP eqP) eq_le -(rwP andP); split. apply/sup_le_ub. + by exists 0, fset0; rewrite big_fset0. apply/ubP=> _ [J ->]; rewrite big_split /=. - apply/ler_add; rewrite -psumE 1?(le_trans _ (gerfin_psum J _)) //. + apply/lerD; rewrite -psumE 1?(le_trans _ (gerfin_psum J _)) //. + by apply/ler_sum=> j _ /=; apply/ler_norm. + by apply/ler_sum=> j _ /=; apply/ler_norm. -rewrite -ler_subr_addr; apply/sup_le_ub. +rewrite -lerBrDr; apply/sup_le_ub. + by exists 0, fset0; rewrite big_fset0. -apply/ubP=> _ [J1 ->]; rewrite ler_subr_addr addrC. -rewrite -ler_subr_addr; apply/sup_le_ub. +apply/ubP=> _ [J1 ->]; rewrite lerBrDr addrC. +rewrite -lerBrDr; apply/sup_le_ub. + by exists 0, fset0; rewrite big_fset0. -apply/ubP=> _ [J2 ->]; rewrite ler_subr_addr addrC. +apply/ubP=> _ [J2 ->]; rewrite lerBrDr addrC. pose J := J1 `|` J2; rewrite -psumE ?(le_trans _ (gerfin_psum J _)) //. pose D := \sum_(j : J) (S1 (val j) + S2 (val j)). apply/(@le_trans _ _ D); last by apply/ler_sum=> i _; apply/ler_norm. -rewrite /D big_split /=; apply/ler_add; apply/big_fset_subset=> //. +rewrite /D big_split /=; apply/lerD; apply/big_fset_subset=> //. + by apply/fsubsetP/fsubsetUl. + by apply/fsubsetP/fsubsetUr. Qed. (* -------------------------------------------------------------------- *) -Lemma psumB S1 S2 : +Lemma __admitted__psumB S1 S2 : (forall x, 0 <= S2 x <= S1 x) -> summable S1 -> psum (S1 \- S2) = (psum S1 - psum S2). Proof using Type. Admitted. @@ -839,13 +839,13 @@ have smZ := summableZ c smS; rewrite (rwP eqP) eq_le. apply/andP; split; first rewrite {1}/psum asboolT //. apply/sup_le_ub. + by exists 0, fset0; rewrite big_fset0. - apply/ubP=> _ [J ->]; rewrite -ler_pdivr_mull //. + apply/ubP=> _ [J ->]; rewrite -ler_pdivrMl //. rewrite mulr_sumr (le_trans _ (gerfin_psum J _)) //. apply/ler_sum=> /= j _; rewrite normrM. by rewrite gtr0_norm // mulKf ?gt_eqF. -rewrite -ler_pdivl_mull // {1}/psum asboolT //; apply/sup_le_ub. +rewrite -ler_pdivlMl // {1}/psum asboolT //; apply/sup_le_ub. + by exists 0, fset0; rewrite big_fset0. -apply/ubP=> _ [J ->]; rewrite ler_pdivl_mull //. +apply/ubP=> _ [J ->]; rewrite ler_pdivlMl //. rewrite mulr_sumr; apply/(le_trans _ (gerfin_psum J _))=> //. by apply/ler_sum=> /= j _; rewrite normrM (gtr0_norm gt0_c). Qed. @@ -903,12 +903,16 @@ move=> eq_r ler; set s := RHS; have h J: uniq J -> \sum_(x <- J) `|S x| <= s. rewrite (perm_big [seq x <- r | x \in J]) /=. apply/uniq_perm; rewrite ?filter_uniq // => x. by rewrite !mem_filter andbC. - by rewrite big_filter ler_addl sumr_ge0. + by rewrite big_filter lerDl sumr_ge0. case/summable_of_bd: h => smS le_psum; apply/eqP. by rewrite eq_le le_psum /=; apply/gerfinseq_psum. Qed. End StdSum. +#[deprecated(since="mathcomp-analysis 0.6.2", + note="lacks proof, use __admitted__psumB explicitly if you really want to")] +Notation psumB := __admitted__psumB. + (* -------------------------------------------------------------------- *) Section PSumReindex. Context {R : realType} {T U : choiceType}. @@ -1098,7 +1102,7 @@ End PSumPair. Section SupInterchange. Context {R : realType} {T U : Type}. -Lemma interchange_sup (S : T -> U -> R) : +Lemma __admitted__interchange_sup (S : T -> U -> R) : (forall x, has_sup [set r | exists y, r = S x y]) -> has_sup [set r | exists x, r = sup [set r | exists y, r = S x y]] -> sup [set r | exists x, r = sup [set r | exists y, r = S x y]] @@ -1106,17 +1110,25 @@ Lemma interchange_sup (S : T -> U -> R) : Proof using Type. Admitted. End SupInterchange. +#[deprecated(since="mathcomp-analysis 0.6.2", + note="lacks proof, use __admitted__interchange_sup explicitly if you really want to use this lemma")] +Notation interchange_sup := __admitted__interchange_sup. + (* -------------------------------------------------------------------- *) Section PSumInterchange. Context {R : realType} {T U : choiceType}. -Lemma interchange_psum (S : T -> U -> R) : +Lemma __admitted__interchange_psum (S : T -> U -> R) : (forall x, summable (S x)) -> summable (fun x => psum (fun y => S x y)) -> psum (fun x => psum (fun y => S x y)) = psum (fun y => psum (fun x => S x y)). Proof using Type. Admitted. End PSumInterchange. +#[deprecated(since="mathcomp-analysis 0.6.2", + note="lacks proof, use __admitted__interchange_psum explicitly if you really want to use this lemma")] +Notation interchange_psum := __admitted__interchange_psum. + (* -------------------------------------------------------------------- *) Section SumTheory. Context {R : realType} {T : choiceType}. @@ -1134,12 +1146,12 @@ Lemma le_sum S1 S2 : summable S1 -> summable S2 -> (S1 <=1 S2) -> sum S1 <= sum S2. Proof. -move=> smS1 smS2 leS; rewrite /sum ler_sub //. +move=> smS1 smS2 leS; rewrite /sum lerB //. apply/le_psum/summable_fpos => // x. by rewrite ge0_fpos /= le_fpos. apply/le_psum/summable_fneg => // x. rewrite -!fposN ge0_fpos le_fpos // => y. -by rewrite ler_opp2. +by rewrite lerN2. Qed. Lemma sum0 : sum (fun _ : T => 0) = 0 :> R. diff --git a/theories/altreals/xfinmap.v b/theories/altreals/xfinmap.v index 4de1b19cb..85eae7ff5 100644 --- a/theories/altreals/xfinmap.v +++ b/theories/altreals/xfinmap.v @@ -25,11 +25,11 @@ Proof. by case: J => J /= /canonical_uniq. Qed. (* -------------------------------------------------------------------- *) Lemma enum_fset0 (T : choiceType) : - enum [finType of fset0] = [::] :> seq (@fset0 T). + enum (fset0 : finType) = [::] :> seq (@fset0 T). Proof. by rewrite enumT unlock. Qed. Lemma enum_fset1 (T : choiceType) (x : T) : - enum [finType of [fset x]] = [:: [`fset11 x]]. + enum ([fset x] : finType) = [:: [`fset11 x]]. Proof. apply/perm_small_eq=> //; apply/uniq_perm => //. by apply/enum_uniq. @@ -125,7 +125,7 @@ Lemma big_fset_subset (I J : {fset T}) (F : T -> R) : Proof. move=> ge0_F le_IJ; rewrite !big_fset_seq /=. rewrite [X in _<=X](bigID [pred j : T | j \in I]) /=. -rewrite ler_paddr ?sumr_ge0 // -[X in _<=X]big_filter. +rewrite ler_wpDr ?sumr_ge0 // -[X in _<=X]big_filter. rewrite le_eqVlt; apply/orP; left; apply/eqP/perm_big. apply/uniq_perm; rewrite ?filter_uniq //; last move=> i. rewrite mem_filter; case/boolP: (_ \in _) => //=. diff --git a/theories/cantor.v b/theories/cantor.v new file mode 100644 index 000000000..11e37fecf --- /dev/null +++ b/theories/cantor.v @@ -0,0 +1,602 @@ +(* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) +From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum interval rat. +From mathcomp Require Import finmap. +From mathcomp Require Import mathcomp_extra boolp classical_sets functions. +From mathcomp Require Import cardinality. +Require Import reals signed topology. +From HB Require Import structures. + +(**md**************************************************************************) +(* # The Cantor Space and Applications *) +(* *) +(* This file develops the theory of the Cantor space, that is bool^nat with *) +(* the product topology. The two main theorems proved here are *) +(* homeomorphism_cantor_like, and cantor_surj, a.k.a. Alexandroff-Hausdorff. *) +(* *) +(* ``` *) +(* pointed_principal_filter == alias for pointed types with principal *) +(* filters *) +(* cantor_space == the Cantor space, with its canonical metric *) +(* cantor_like T == perfect + compact + hausdroff + zero dimensional *) +(* tree_of T == builds a topological tree with levels (T n) *) +(* ``` *) +(* *) +(* The overall goal of the next few sections is to prove that *) +(* Every compact metric space `T` is the image of the Cantor space. *) +(* The overall proof will build two continuous functions *) +(* Cantor space -> a bespoke tree for `T` -> `T` *) +(* *) +(* The proof is in 4 parts: *) +(* - Part 1: Some generic machinery about continuous functions from trees. *) +(* - Part 2: All cantor-like spaces are homeomorphic to the Cantor space. *) +(* (an application of part 1) *) +(* - Part 3: Finitely branching trees are Cantor-like. *) +(* - Part 4: Every compact metric space has a finitely branching tree with *) +(* a continuous surjection. (a second application of part 1) *) +(* *) +(******************************************************************************) + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Import numFieldTopology.Exports. + +Local Open Scope classical_set_scope. + +(* we start by introducing an alias for pointed types with + principal filters *) +Definition pointed_principal_filter (P : pointedType) : Type := P. +HB.instance Definition _ (P : pointedType) := + Pointed.on (pointed_principal_filter P). +HB.instance Definition _ (P : pointedType) := + hasNbhs.Build (pointed_principal_filter P) principal_filter. + +(* we use `discrete_topology` to equip pointed types + with a discrete topology *) +Section discrete_topology_for_pointed_types. + +Let discrete_pointed_subproof (P : pointedType) : + discrete_space (pointed_principal_filter P). +Proof. by []. Qed. + +Definition pointed_discrete_topology (P : pointedType) : Type := + discrete_topology (discrete_pointed_subproof P). + +End discrete_topology_for_pointed_types. +(* note that in topology.v, we already have: +HB.instance Definition _ := discrete_uniform_mixin. +and +HB.instance Definition _ := discrete_pseudometric_mixin. *) + +(* we need the following proof when using + `discrete_hausdorff` or `discrete_zero_dimension` *) +Lemma discrete_pointed (T : pointedType) : + discrete_space (pointed_discrete_topology T). +Proof. +apply/funext => /= x; apply/funext => A; apply/propext; split. +- by move=> [E hE EA] x0 ->{x0}; apply: EA => /=; apply: hE => /=; exists x. +- move=> h; exists [set x | x.1 = x.2]; first by move=> -[a b] [t _] [<- <-]. + by move=> y /= xy; exact: h. +Qed. + +Definition cantor_space := + prod_topology (fun _ : nat => discrete_topology discrete_bool). + +HB.instance Definition _ := Pointed.on cantor_space. +HB.instance Definition _ := Nbhs.on cantor_space. +HB.instance Definition _ := Topological.on cantor_space. + +Definition cantor_like (T : topologicalType) := + [/\ perfect_set [set: T], + compact [set: T], + hausdorff_space T & + zero_dimensional T]. + +(* TODO: move to topology.v? *) +Lemma discrete_bool_compact : compact [set: discrete_topology discrete_bool]. +Proof. by rewrite setT_bool; apply/compactU; exact: compact_set1. Qed. + +Lemma cantor_space_compact : compact [set: cantor_space]. +Proof. +have := @tychonoff _ (fun _ : nat => _) _ (fun=> discrete_bool_compact). +by congr (compact _); rewrite eqEsubset. +Qed. + +Lemma cantor_space_hausdorff : hausdorff_space cantor_space. +Proof. +apply: hausdorff_product => ?; apply: discrete_hausdorff. +exact: discrete_pointed. +Qed. + +Lemma cantor_zero_dimensional : zero_dimensional cantor_space. +Proof. +apply: zero_dimension_prod => _; apply: discrete_zero_dimension. +exact: discrete_pointed. +Qed. + +Lemma cantor_perfect : perfect_set [set: cantor_space]. +Proof. by apply: perfect_diagonal => _; exists (true, false). Qed. + +Lemma cantor_like_cantor_space : cantor_like cantor_space. +Proof. +split. +- exact: cantor_perfect. +- exact: cantor_space_compact. +- exact: cantor_space_hausdorff. +- exact: cantor_zero_dimensional. +Qed. + +(**md**************************************************************************) +(* ## Part 1 *) +(* *) +(* A tree here has countable levels, and nodes of type `K n` on the nth *) +(* level. *) +(* Each level is in the 'discrete' topology, so the nodes are independent. *) +(* The goal is to build a map from branches to X. *) +(* 1. Each level of the tree corresponds to an approximation of `X`. *) +(* 2. Each level refines the previous approximation. *) +(* 3. Then each branch has a corresponding Cauchy filter. *) +(* 4. The overall function from branches to X is a continuous surjection. *) +(* 5. With an extra disjointness condition, this is also an injection *) +(* *) +(******************************************************************************) +Section topological_trees. +Context {K : nat -> topologicalType} {X : topologicalType} + (refine_apx : forall n, set X -> K n -> set X) + (tree_invariant : set X -> Prop). + +Hypothesis cmptX : compact [set: X]. +Hypothesis hsdfX : hausdorff_space X. +Hypothesis discreteK : forall n, discrete_space (K n). +Hypothesis refine_cover : forall n U, U = \bigcup_e @refine_apx n U e. +Hypothesis refine_invar : forall n U e, + tree_invariant U -> tree_invariant (@refine_apx n U e). +Hypothesis invar_n0 : forall U, tree_invariant U -> U !=set0. +Hypothesis invarT : tree_invariant [set: X]. +Hypothesis invar_cl : tree_invariant `<=` closed. +Hypothesis refine_separates: forall x y : X, x != y -> + exists n, forall (U : set X) e, + @refine_apx n U e x -> ~@refine_apx n U e y. + +Let refine_subset n U e : @refine_apx n U e `<=` U. +Proof. by rewrite [X in _ `<=` X](refine_cover n); exact: bigcup_sup. Qed. + +Let T := prod_topology K. + +Local Fixpoint branch_apx (b : T) n := + if n is m.+1 then refine_apx (branch_apx b m) (b m) else [set: X]. + +Let tree_mapF b := filter_from [set: nat] (branch_apx b). + +Let tree_map_invar b n : tree_invariant (branch_apx b n). +Proof. by elim: n => // n ?; exact: refine_invar. Qed. + +Let tree_map_sub b i j : (i <= j)%N -> branch_apx b j `<=` branch_apx b i. +Proof. +elim: j i => [?|j IH i]; first by rewrite leqn0 => /eqP ->. +rewrite leq_eqVlt => /predU1P[->//|/IH]. +by apply: subset_trans; exact: refine_subset. +Qed. + +Instance tree_map_filter b : ProperFilter (tree_mapF b). +Proof. +split; first by case => n _ P; case: (invar_n0 (tree_map_invar b n)) => x /P. +apply: filter_from_filter; first by exists 0%N. +move=> i j _ _; exists (maxn i j) => //; rewrite subsetI. +by split; apply: tree_map_sub; [exact: leq_maxl | exact: leq_maxr]. +Qed. + +Let tree_map b := lim (tree_mapF b). + +Let cvg_tree_map b : cvg (tree_mapF b). +Proof. +have [|x [_ clx]] := cmptX (tree_map_filter b); first exact: filterT. +apply/cvg_ex; exists x => /=; apply: (compact_cluster_set1 _ cmptX) => //. +- exact: filterT. +- exact: filterT. +rewrite eqEsubset; split=> [y cly|? -> //]. +have [->//|/refine_separates[n sep]] := eqVneq x y. +have bry : branch_apx b n.+1 y. + have /closure_id -> := invar_cl (tree_map_invar b n.+1). + by move: cly; rewrite clusterE; apply; exists n.+1. +suff /sep : branch_apx b n.+1 x by []. +have /closure_id -> := invar_cl (tree_map_invar b n.+1). +by move: clx; rewrite clusterE; apply; exists n.+1. +Qed. + +Local Lemma tree_map_surj : set_surj [set: T] [set: X] tree_map. +Proof. +move=> z _; suff : exists g, forall n, branch_apx g n z. + case=> g gnz; exists g => //; apply: close_eq => // U [oU Uz] V ngV; exists z. + by split => //; have [n _] := @cvg_tree_map g _ ngV; exact. +have zcov' : forall n (U : set X), exists e, U z -> @refine_apx n U e z. + move=> n U; have [|?] := pselect (U z); last by exists point. + by rewrite [X in X z -> _](@refine_cover n U); case => e _ ?; exists e. +pose zcov n U := projT1 (cid (zcov' n U)). +pose fix g n : K n * set X := + if n is m.+1 + then (zcov m.+1 (g m).2, @refine_apx m.+1 (g m).2 (zcov m.+1 (g m).2)) + else (zcov O [set: X], @refine_apx O [set: X] (zcov O [set: X])). +pose g' n := (g n).1; have apxg n : branch_apx g' n.+1 = (g n).2. + by elim: n => //= n ->. +exists g'; elim => // n /= IH. +have /(_ IH) := projT2 (cid (zcov' n (branch_apx g' n))). +by case: n {IH} => // n; rewrite apxg. +Qed. + +Let tree_prefix (b : T) (n : nat) : + \forall c \near b, forall i, (i < n)%N -> b i = c i. +Proof. +elim: n => [|n IH]; first by near=> z => ?; rewrite ltn0. +near=> z => i; rewrite leq_eqVlt => /predU1P[|iSn]; last by rewrite (near IH z). +move=> [->]; near: z; exists (proj n @^-1` [set b n]). +split => //; suff : @open T (proj n @^-1` [set b n]) by []. +by apply: open_comp; [move=> + _; exact: proj_continuous| exact: discrete_open]. +Unshelve. all: end_near. Qed. + +Let apx_prefix b c n : + (forall i, (i < n)%N -> b i = c i) -> branch_apx b n = branch_apx c n. +Proof. +elim: n => //= n IH inS; rewrite IH; first by rewrite inS. +by move=> ? ?; exact/inS/ltnW. +Qed. + +Let tree_map_apx b n : branch_apx b n (tree_map b). +Proof. +apply: (@closed_cvg _ _ _ (tree_map_filter b)); last exact: cvg_tree_map. + by apply: invar_cl; exact: tree_map_invar. +by exists n. +Qed. + +Local Lemma tree_map_cts : continuous tree_map. +Proof. +move=> b U /cvg_tree_map [n _] /filterS; apply. + exact/fmap_filter/nbhs_filter. +rewrite nbhs_simpl /=; near_simpl; have := tree_prefix b n; apply: filter_app. +by near=> z => /apx_prefix ->; exact: tree_map_apx. +Unshelve. all: end_near. Qed. + +Let tree_map_setI x y n : tree_map x = tree_map y -> + refine_apx (branch_apx x n) (x n) `&` refine_apx (branch_apx y n) (y n) !=set0. +Proof. +move=> xyE; exists (tree_map y); split. + by rewrite -xyE -/(branch_apx x n.+1); exact: tree_map_apx. +by rewrite -/(branch_apx y n.+1); exact: tree_map_apx. +Qed. + +Local Lemma tree_map_inj : (forall n U, trivIset [set: K n] (@refine_apx n U)) -> + set_inj [set: T] tree_map. +Proof. +move=> triv x y _ _ xyE; apply: functional_extensionality_dep => n. +suff : forall n, branch_apx x n = branch_apx y n. + move=> brE; apply: (@triv n (branch_apx x n) _ _ I I). + by rewrite [in X in _ `&` X]brE; exact: tree_map_setI. +elim => // m /= brE. +rewrite (@triv m (branch_apx x m) (x m) (y m) I I) 1?brE//. +by rewrite -[in X in X `&` _]brE; exact: tree_map_setI. +Qed. + +Lemma tree_map_props : exists f : T -> X, + [/\ continuous f, + set_surj [set: T] [set: X] f & + (forall n U, trivIset [set: K n] (@refine_apx n U)) -> + set_inj [set: T] f]. +Proof. +exists tree_map; split. +- exact: tree_map_cts. +- exact: tree_map_surj. +- exact: tree_map_inj. +Qed. + +End topological_trees. + +(**md**************************************************************************) +(* ## Part 2 *) +(* We can use `tree_map_props` to build a homeomorphism from the *) +(* cantor_space to a Cantor-like space T. *) +(******************************************************************************) + +Section TreeStructure. +Context {R : realType} {T : pseudoMetricType R}. +Hypothesis cantorT : cantor_like T. + +Let dsctT : zero_dimensional T. Proof. by case: cantorT. Qed. +Let pftT : perfect_set [set: T]. Proof. by case: cantorT. Qed. +Let cmptT : compact [set: T]. Proof. by case: cantorT. Qed. +Let hsdfT : @hausdorff_space T. Proof. by case: cantorT. Qed. + +Let c_invar (U : set T) := clopen U /\ U !=set0. + +Let U_ := unsquash (clopen_surj cmptT). + +Let split_clopen' (U : set T) : exists V, + open U -> U !=set0 -> [/\ clopen V, V `&` U !=set0 & ~`V `&` U !=set0]. +Proof. +have [oU|?] := pselect (open U); last by exists point. +have [Un0|?] := pselect (U !=set0); last by exists point. +have [x [y] [Ux] Uy xny] := (iffLR perfect_set2) pftT U oU Un0. +have [V [clV Vx Vy]] := dsctT xny; exists V => _ _. +by split => //; [exists x | exists y]. +Qed. + +Let split_clopen (U : set T) := projT1 (cid (split_clopen' U)). + +Let c_ind n (V : set T) (b : bool) := + let Wn := + if pselect ((U_ n) `&` V !=set0 /\ ~` (U_ n) `&` V !=set0) + then U_ n else split_clopen V in + (if b then Wn else ~` Wn) `&` V. + +Local Lemma cantor_map : exists f : cantor_space -> T, + [/\ continuous f, + set_surj [set: cantor_space] [set: T] f & + set_inj [set: cantor_space] f ]. +Proof. +have [] := @tree_map_props + (fun=> discrete_topology discrete_bool) T c_ind c_invar cmptT hsdfT. +- by move=> ?; exact: discrete_pointed. +- move=> n V; rewrite eqEsubset; split => [t Vt|t [? ? []]//]. + have [?|?] := pselect (U_ n `&` V !=set0 /\ ~` U_ n `&` V !=set0). + + have [Unt|Unt] := pselect (U_ n t). + * by exists true => //; rewrite /c_ind; case: pselect. + * by exists false => //; rewrite /c_ind; case: pselect. + + have [scVt|scVt] := pselect (split_clopen V t). + * by exists true => //; rewrite /c_ind; case: pselect. + * by exists false => //; rewrite /c_ind; case: pselect. +- move=> n U e [] clU Un0; rewrite /c_ind; case: pselect => /=. + + move=> [UU CUU]; case: e => //; split => //; apply: clopenI => //. + exact: funS. + by apply: clopenC => //; exact: funS. + + move=> _; have [|//|clscU scUU CscUU] := projT2 (cid (split_clopen' U)). + by case: clU. + case: e; split => //; first exact: clopenI. + by apply: clopenI => //; exact: clopenC. +- by move=> ? []. +- by split; [exact: clopenT | exists point]. +- by move=> ? [[]]. +- move=> x y /dsctT [A [clA Ax Any]]. + have [n _ UnA] := @surj _ _ _ _ U_ _ clA; exists n => V e. + have [|+ _] := pselect (V y); last by apply: subsetC => ? []. + have [Vx Vy|? _ []//] := pselect (V x). + rewrite {1 2}/c_ind; case: pselect => /=; rewrite ?UnA. + by move=> _; case: e; case => // ? ?; apply/not_andP; left. + by apply: absurd; split; [exists x | exists y]. +- move=> f [ctsf surjf injf]; exists f; split => //. + apply: injf. + by move=> n U i j _ _ [z] [] [] + Uz [+ _]; move: i j => [] []. +Qed. + +Let tree_map := projT1 (cid cantor_map). + +Let tree_map_bij : bijective tree_map. +Proof. +by rewrite -setTT_bijective; have [? ? ?] := projT2 (cid cantor_map); split. +Qed. + +#[local] HB.instance Definition _ := @BijTT.Build _ _ _ tree_map_bij. + +Lemma homeomorphism_cantor_like : + exists f : {splitbij [set: cantor_space] >-> [set: T]}, + continuous f /\ (forall A, closed A -> closed (f @` A)). +Proof. +exists [the {splitbij _ >-> _} of tree_map] => /=. +have [cts surj inje] := projT2 (cid cantor_map); split; first exact: cts. +move=> A clA; apply: (compact_closed hsdfT). +apply: (@continuous_compact _ _ tree_map); first exact: continuous_subspaceT. +apply: (@subclosed_compact _ _ [set: cantor_space]) => //. +exact: cantor_space_compact. +Qed. + +End TreeStructure. + +(**md**************************************************************************) +(* ## Part 3: Finitely branching trees are Cantor-like *) +(******************************************************************************) +Section FinitelyBranchingTrees. +Context {R : realType}. + +Definition tree_of (T : nat -> pointedType) : pseudoMetricType R := + [the pseudoMetricType R of prod_topology + (fun n => pointed_discrete_topology (T n))]. + +Lemma cantor_like_finite_prod (T : nat -> topologicalType) : + (forall n, finite_set [set: pointed_discrete_topology (T n)]) -> + (forall n, (exists xy : T n * T n, xy.1 != xy.2)) -> + cantor_like (tree_of T). +Proof. +move=> finiteT twoElems; split. +- exact/(@perfect_diagonal (pointed_discrete_topology \o T))/twoElems. +- have := tychonoff (fun n => finite_compact (finiteT n)). + set A := (X in compact X -> _). + suff : A = [set: tree_of (fun x : nat => T x)] by move=> ->. + by rewrite eqEsubset. +- apply: (@hausdorff_product _ (pointed_discrete_topology \o T)) => n. + by apply: discrete_hausdorff; exact: discrete_pointed. +- apply: zero_dimension_prod => ?; apply: discrete_zero_dimension. + exact: discrete_pointed. +Qed. + +End FinitelyBranchingTrees. + +Local Notation "A ^-1" := ([set xy | A (xy.2, xy.1)]) : classical_set_scope. + +(**md**************************************************************************) +(* ## Part 4: Building a finitely branching tree to cover `T` *) +(******************************************************************************) +Section alexandroff_hausdorff. +Context {R : realType} {T : pseudoMetricType R}. + +Hypothesis cptT : compact [set: T]. +Hypothesis hsdfT : hausdorff_space T. + +Section two_pointed. +Context (t0 t1 : T). +Hypothesis T2e : t0 != t1. + +Let ent_balls' (E : set (T * T)) : + exists M : set (set T), entourage E -> [/\ + finite_set M, + forall A, M A -> exists a, A a /\ + A `<=` closure [set y | split_ent E (a, y)], + exists A B : set T, M A /\ M B /\ A != B, + \bigcup_(A in M) A = [set: T] & + M `<=` closed]. +Proof. +have [entE|?] := pselect (entourage E); last by exists point. +move: cptT; rewrite compact_cover. +pose fs x := interior [set y | split_ent E (x, y)]. +move=> /(_ T [ set: T] fs)[t _|t _ |]. +- exact: open_interior. +- exists t => //. + by rewrite /fs /interior -nbhs_entourageE; exists (split_ent E). +move=> M' _ Mcov; exists + ((closure \o fs) @` [set` M'] `|` [set [set t0]; [set t1]]). +move=> _; split=> [|A [|]| | |]. +- rewrite finite_setU; split; first exact/finite_image/finite_fset. + exact: finite_set2. +- move=> [z M'z] <-; exists z; split. + + apply: subset_closure; apply: nbhs_singleton; apply: nbhs_interior. + by rewrite -nbhs_entourageE; exists (split_ent E). + + by apply: closure_subset; exact: interior_subset. +- by case => ->; [exists t0 | exists t1]; split => // t ->; + apply: subset_closure; exact: entourage_refl. +- exists [set t0], [set t1]; split;[|split]. + + by right; left. + + by right; right. + + apply/eqP; rewrite eqEsubset => -[] /(_ t0 erefl). + by move: T2e => /[swap] -> /eqP. +- rewrite -subTset => t /Mcov [t' M't' fsxt]; exists (closure (fs t')). + by left; exists t'. + exact: subset_closure. +- move=> ? [[? ?] <-|]; first exact: closed_closure. + by move=> [|] ->; exact/accessible_closed_set1/hausdorff_accessible. +Qed. + +Let ent_balls E := projT1 (cid (ent_balls' E)). + +Let count_unif' := cid2 + ((iffLR countable_uniformityP) (@countable_uniformity_metric _ T)). + +Let count_unif := projT1 count_unif'. + +Let ent_count_unif n : entourage (count_unif n). +Proof. +have := projT2 (cid (ent_balls' (count_unif n))). +rewrite /count_unif; case: count_unif'. +by move=> /= f fnA fnE; case /(_ (fnE _)) => _ _ _ + _; rewrite -subTset. +Qed. + +Let count_unif_sub E : entourage E -> exists N, count_unif N `<=` E. +Proof. +by move=> entE; rewrite /count_unif; case: count_unif' => f + ? /=; exact. +Qed. + +Let K' n : Type := @sigT (set T) (ent_balls (count_unif n)). + +Let K'p n : K' n. +Proof. +apply: cid; have [//| _ _ _ + _] := projT2 (cid (ent_balls' (count_unif n))). +by rewrite -subTset => /(_ point I) [W Q ?]; exists W; exact: Q. +Qed. + +HB.instance Definition _ n := gen_eqMixin (K' n). +HB.instance Definition _ n := gen_choiceMixin (K' n). +HB.instance Definition _ n := isPointed.Build (K' n) (K'p n). + +Let K n := [the pointedType of K' n]. +Let Tree := @tree_of R K. + +Let embed_refine n (U : set T) (k : K n) := + (if pselect (projT1 k `&` U !=set0) + then projT1 k + else if pselect (exists e : K n , projT1 e `&` U !=set0) is left e + then projT1 (projT1 (cid e)) + else set0) `&` U. +Let embed_invar (U : set T) := closed U /\ U !=set0. + +Let Kn_closed n (e : K n) : closed (projT1 e). +Proof. +case: e => W; have [//| _ _ _ _] := projT2 (cid (ent_balls' (count_unif n))). +exact. +Qed. + +Local Lemma cantor_surj_pt1 : exists2 f : Tree -> T, + continuous f & set_surj [set: Tree] [set: T] f. +Proof. +pose entn n := projT2 (cid (ent_balls' (count_unif n))). +have [//| | |? []//| |? []// | |] := @tree_map_props + (pointed_discrete_topology \o K) T (embed_refine) (embed_invar) cptT hsdfT. +- by move=> n; exact: discrete_pointed. +- move=> n U; rewrite eqEsubset; split=> [t Ut|t [? ? []]//]. + have [//|_ _ _ + _] := entn n; rewrite -subTset. + move=> /(_ t I)[W cbW Wt]; exists (existT _ W cbW) => //. + by rewrite /embed_refine; case: pselect => //=; apply: absurd; exists t. +- move=> n U e [clU Un0]; split. + apply: closedI => //; case: pselect => //= ?. + by case: pselect => ?; [exact: Kn_closed|exact: closed0]. + rewrite /embed_refine; case: pselect => //= ?; case: pselect. + by case=> i [z [pz bz]]; set P := cid _; have := projT2 P; apply. + case: Un0 => z Uz; apply: absurd. + have [//|_ _ _ + _] := entn n; rewrite -subTset; move=> /(_ z I)[i bi iz]. + by exists (existT _ _ bi), z. +- by split; [exact: closedT | exists point]. +- move=> x y xny; move: hsdfT; rewrite open_hausdorff. + move=> /(_ _ _ xny)[[U V]] /= [/set_mem Ux /set_mem Vy] [+ oV UVI0]. + rewrite openE => /(_ _ Ux); rewrite /interior -nbhs_entourageE => -[E entE ExU]. + have [//| n ctE] := + @count_unif_sub (split_ent E `&` (split_ent E)^-1%classic). + exact: filterI. + exists n => B [C ebC]; have [//|_ Csub _ _ _ embx emby] := entn n. + have [[D cbD] /= Dx Dy] : exists2 e : K n, projT1 e x & projT1 e y. + move: embx emby; rewrite /embed_refine; case: pselect => /=. + by move=> ? [? ?] [? ?]; exists (existT _ _ ebC). + case: pselect; last by move => ? ? []. + by move=> e _ [? ?] [? ?]; exists (projT1 (cid e)). + suff : E (x, y) by move/ExU; move/eqP/disjoints_subset: UVI0 => /[apply]. + have [z [Dz DzE]] := Csub _ cbD. + have /ent_closure:= DzE _ Dx => /(_ (ent_count_unif n))/ctE [_ /= Exz]. + have /ent_closure:= DzE _ Dy => /(_ (ent_count_unif n))/ctE [Ezy _]. + exact: (@entourage_split _ (*[the uniformType of T]*) z). +by move=> f [ctsf surjf _]; exists f. +Qed. + +Local Lemma cantor_surj_pt2 : + exists f : {surj [set: cantor_space] >-> [set: Tree]}, continuous f. +Proof. +have [|f [ctsf _]] := @homeomorphism_cantor_like R Tree; last by exists f. +apply: (@cantor_like_finite_prod _ (pointed_discrete_topology \o K)) => [n /=|n]. + have [//| fs _ _ _ _] := projT2 (cid (ent_balls' (count_unif n))). + suff -> : [set: {classic K' n}] = + (@projT1 (set T) _) @^-1` (projT1 (cid (ent_balls' (count_unif n)))). + by apply: finite_preimage => // ? ? _ _; exact: eq_sigT_hprop. + by rewrite eqEsubset; split => // -[]. +have [//| _ _ [A [B [pA [pB AB]]]] _ _] := + projT2 (cid (ent_balls' (count_unif n))). +exists (existT _ _ pA, existT _ _ pB) => /=. +by move: AB; apply: contra_neq => -[]. +Qed. + +Local Lemma cantor_surj_twop : + exists f : {surj [set: cantor_space] >-> [set: T]}, continuous f. +Proof. +move: cantor_surj_pt2 cantor_surj_pt1 => -[f ctsf] [g ctsg /Psurj[sjg gsjg]]. +exists [surj of sjg \o f] => z. +by apply continuous_comp; [exact: ctsf|rewrite -gsjg; exact: ctsg]. +Qed. + +End two_pointed. + +(** The Alexandroff-Hausdorff theorem *) +Theorem cantor_surj : + exists f : {surj [set: cantor_space] >-> [set: T]}, continuous f. +Proof. +have [[p ppt]|/forallNP xpt] := pselect (exists p : T, p != point). + by apply: cantor_surj_twop; exact: ppt. +have /Psurj[f cstf] : set_surj [set: cantor_space] [set: T] (cst point). + by move=> q _; exists point => //; have /negP/negPn/eqP -> := xpt q. +by exists f; rewrite -cstf; exact: cst_continuous. +Qed. + +End alexandroff_hausdorff. diff --git a/theories/charge.v b/theories/charge.v new file mode 100644 index 000000000..30b2d11b0 --- /dev/null +++ b/theories/charge.v @@ -0,0 +1,1962 @@ +(* mathcomp analysis (c) 2022 Inria and AIST. License: CeCILL-C. *) +From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval. +From mathcomp Require Import finmap fingroup perm rat. +From mathcomp Require Import mathcomp_extra boolp classical_sets cardinality. +From mathcomp Require Import functions fsbigop set_interval. +From HB Require Import structures. +Require Import reals ereal signed topology numfun normedtype sequences. +Require Import esum measure realfun lebesgue_measure lebesgue_integral. + +(**md**************************************************************************) +(* # Charges *) +(* *) +(* NB: See CONTRIBUTING.md for an introduction to HB concepts and commands. *) +(* *) +(* This file contains a formalization of charges (a.k.a. signed measures) and *) +(* their theory (Hahn decomposition theorem, etc.). *) +(* *) +(* ## Structures for functions on classes of sets *) +(* ``` *) +(* {additive_charge set T -> \bar R} == notation for additive charges where *) +(* T is a semiring of sets and R is a *) +(* numFieldType *) +(* The HB class is AdditiveCharge. *) +(* {charge set T -> \bar R} == type of charges over T a semiring of sets *) +(* where R is a numFieldType *) +(* The HB class is Charge. *) +(* isCharge == factory corresponding to the "textbook *) +(* definition" of charges *) +(* ``` *) +(* *) +(* ## Instances of mathematical structures *) +(* ``` *) +(* measure_of_charge nu nu0 == measure corresponding to the charge nu, nu0 *) +(* is a proof that nu is non-negative *) +(* crestr nu mD == restriction of the charge nu to the domain D *) +(* where mD is a proof that D is measurable *) +(* crestr0 nu mD == csrestr nu mD that returns 0 for *) +(* non-measurable sets *) +(* czero == zero charge *) +(* cscale r nu == charge nu scaled by a factor r : R *) +(* charge_add n1 n2 == the charge corresponding to the sum of *) +(* charges n1 and n2 *) +(* charge_of_finite_measure mu == charge corresponding to a finite measure mu *) +(* ``` *) +(* *) +(* ## Theory *) +(* ``` *) + +(* nu.-positive_set P == P is a positive set with nu a charge *) +(* nu.-negative_set N == N is a negative set with nu a charge *) +(* hahn_decomposition nu P N == the full set can be decomposed in P and N, *) +(* a positive set and a negative set for the *) +(* charge nu *) +(* jordan_pos nu nuPN == the charge obtained by restricting the charge *) +(* nu to the positive set P of the Hahn *) +(* decomposition nuPN: hahn_decomposition nu P N *) +(* jordan_neg nu nuPN == the charge obtained by restricting the charge *) +(* nu to the positive set N of the Hahn *) +(* decomposition nuPN: hahn_decomposition nu P N *) +(* 'd nu '/d mu == Radon-Nikodym derivative of nu w.r.t. mu *) +(* (the scope is charge_scope) *) +(* ``` *) +(* *) +(******************************************************************************) + +Reserved Notation "{ 'additive_charge' 'set' T '->' '\bar' R }" + (at level 36, T, R at next level, + format "{ 'additive_charge' 'set' T '->' '\bar' R }"). +Reserved Notation "{ 'charge' 'set' T '->' '\bar' R }" + (at level 36, T, R at next level, + format "{ 'charge' 'set' T '->' '\bar' R }"). +Reserved Notation "'d nu '/d mu" (at level 10, nu, mu at next level, + format "''d' nu ''/d' mu"). +Reserved Notation "nu .-negative_set" (at level 2, format "nu .-negative_set"). +Reserved Notation "nu .-positive_set" (at level 2, format "nu .-positive_set"). + +Declare Scope charge_scope. + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Import numFieldTopology.Exports. + +Local Open Scope ring_scope. +Local Open Scope classical_set_scope. +Local Open Scope ereal_scope. + +HB.mixin Record isAdditiveCharge d (T : semiRingOfSetsType d) (R : numFieldType) + (mu : set T -> \bar R) := { charge_semi_additive : measure.semi_additive mu }. + +#[short(type=additive_charge)] +HB.structure Definition AdditiveCharge d (T : semiRingOfSetsType d) + (R : numFieldType) := { mu of isAdditiveCharge d T R mu & FinNumFun d mu }. + +Notation "{ 'additive_charge' 'set' T '->' '\bar' R }" := + (additive_charge T R) : ring_scope. + +#[export] Hint Resolve charge_semi_additive : core. + +HB.mixin Record isSemiSigmaAdditive d (T : semiRingOfSetsType d) (R : numFieldType) + (mu : set T -> \bar R) := { + charge_semi_sigma_additive : semi_sigma_additive mu }. + +#[short(type=charge)] +HB.structure Definition Charge d (T : semiRingOfSetsType d) (R : numFieldType) + := { mu of isSemiSigmaAdditive d T R mu & AdditiveCharge d mu }. + +Notation "{ 'charge' 'set' T '->' '\bar' R }" := (charge T R) : ring_scope. + +HB.factory Record isCharge d (T : semiRingOfSetsType d) (R : realFieldType) + (mu : set T -> \bar R) := { + charge0 : mu set0 = 0 ; + charge_finite : forall x, d.-measurable x -> mu x \is a fin_num ; + charge_sigma_additive : semi_sigma_additive mu +}. + +HB.builders Context d (T : semiRingOfSetsType d) (R : realFieldType) + mu of isCharge d T R mu. + +Let finite : fin_num_fun mu. Proof. exact: charge_finite. Qed. + +HB.instance Definition _ := SigmaFinite_isFinite.Build d T R mu finite. + +Let semi_additive : measure.semi_additive mu. +Proof. +move=> I n mI trivI mUI. +rewrite (semi_sigma_additive_is_additive charge0)//. +exact: charge_sigma_additive. +Qed. + +HB.instance Definition _ := isAdditiveCharge.Build d T R mu semi_additive. + +Let semi_sigma_additive : semi_sigma_additive mu. +Proof. exact: charge_sigma_additive. Qed. + +HB.instance Definition _ := + isSemiSigmaAdditive.Build d T R mu semi_sigma_additive. + +HB.end. + +Section charge_lemmas. +Context d (T : ringOfSetsType d) (R : numFieldType). +Implicit Type nu : {charge set T -> \bar R}. + +Lemma charge0 nu : nu set0 = 0. +Proof. +have /[!big_ord0] ->// := @charge_semi_additive _ _ _ nu (fun=> set0) 0%N. +exact: trivIset_set0. +Qed. + +Hint Resolve charge0 : core. + +Lemma charge_semi_additiveW nu : + nu set0 = 0 -> measure.semi_additive nu -> semi_additive2 nu. +Proof. +move=> nu0 anu A B mA mB + AB; rewrite -bigcup2inE bigcup_mkord. +move=> /(anu (bigcup2 A B)) ->. +- by rewrite !(big_ord_recl, big_ord0)/= adde0. +- by move=> [|[|[]]]//=. +- move=> [|[|i]] [|[|j]]/= _ _ //. + + by rewrite AB => -[]. + + by rewrite setI0 => -[]. + + by rewrite setIC AB => -[]. + + by rewrite setI0 => -[]. + + by rewrite set0I => -[]. + + by rewrite set0I => -[]. + + by rewrite setI0 => -[]. +Qed. + +Lemma charge_semi_additive2E nu : semi_additive2 nu = additive2 nu. +Proof. +rewrite propeqE; split=> [anu A B ? ? ?|anu A B ? ? _ ?]; last by rewrite anu. +by rewrite anu //; exact: measurableU. +Qed. + +Lemma charge_semi_additive2 nu : semi_additive2 nu. +Proof. exact: charge_semi_additiveW. Qed. + +Hint Resolve charge_semi_additive2 : core. + +Lemma chargeU nu : additive2 nu. Proof. by rewrite -charge_semi_additive2E. Qed. + +Lemma chargeDI nu (A B : set T) : measurable A -> measurable B -> + nu A = nu (A `\` B) + nu (A `&` B). +Proof. +move=> mA mB; rewrite -charge_semi_additive2. +- by rewrite -setDDr setDv setD0. +- exact: measurableD. +- exact: measurableI. +- by apply: measurableU; [exact: measurableD |exact: measurableI]. +- by rewrite setDE setIACA setICl setI0. +Qed. + +Lemma charge_partition nu S P N : + measurable S -> measurable P -> measurable N -> + P `|` N = [set: T] -> P `&` N = set0 -> nu S = nu (S `&` P) + nu (S `&` N). +Proof. +move=> mS mP mN PNT PN0; rewrite -{1}(setIT S) -PNT setIUr chargeU//. +- exact: measurableI. +- exact: measurableI. +- by rewrite setICA -(setIA S P N) PN0 setIA setI0. +Qed. + +End charge_lemmas. +#[export] Hint Resolve charge0 : core. +#[export] Hint Resolve charge_semi_additive2 : core. + +Definition measure_of_charge d (T : semiRingOfSetsType d) (R : numFieldType) + (nu : set T -> \bar R) of (forall E, 0 <= nu E) := nu. + +Section measure_of_charge. +Context d (T : ringOfSetsType d) (R : realFieldType). +Variables (nu : {charge set T -> \bar R}) (nupos : forall E, 0 <= nu E). + +Local Notation mu := (measure_of_charge nupos). + +Let mu0 : mu set0 = 0. Proof. exact: charge0. Qed. + +Let mu_ge0 S : 0 <= mu S. Proof. by rewrite nupos. Qed. + +Let mu_sigma_additive : semi_sigma_additive mu. +Proof. exact: charge_semi_sigma_additive. Qed. + +HB.instance Definition _ := isMeasure.Build _ T R (measure_of_charge nupos) + mu0 mu_ge0 mu_sigma_additive. + +End measure_of_charge. +Arguments measure_of_charge {d T R}. + +Section charge_of_finite_measure. +Context d (T : measurableType d) (R : realType). +Variables (mu : {finite_measure set T -> \bar R}). + +Definition charge_of_finite_measure : set T -> \bar R := mu. + +Local Notation nu := charge_of_finite_measure. + +Let nu0 : nu set0 = 0. Proof. exact: measure0. Qed. + +Let nu_finite S : measurable S -> nu S \is a fin_num. +Proof. exact: fin_num_measure. Qed. + +Let nu_sigma_additive : semi_sigma_additive nu. +Proof. exact: measure_semi_sigma_additive. Qed. + +HB.instance Definition _ := isCharge.Build _ T R nu + nu0 nu_finite nu_sigma_additive. + +End charge_of_finite_measure. +Arguments charge_of_finite_measure {d T R}. + +Section charge_lemmas_realFieldType. +Context d (T : ringOfSetsType d) (R : realFieldType). +Implicit Type nu : {charge set T -> \bar R}. + +Lemma chargeD nu (A B : set T) : measurable A -> measurable B -> + nu (A `\` B) = nu A - nu (A `&` B). +Proof. +move=> mA mB. +rewrite (chargeDI nu mA mB) addeK// fin_numE 1?gt_eqF 1?lt_eqF//. +- by rewrite ltey_eq fin_num_measure//; exact:measurableI. +- by rewrite ltNye_eq fin_num_measure//; exact:measurableI. +Qed. + +End charge_lemmas_realFieldType. + +Definition crestr d (T : semiRingOfSetsType d) (R : numDomainType) (D : set T) + (f : set T -> \bar R) of measurable D := fun X => f (X `&` D). + +Section charge_restriction. +Context d (T : measurableType d) (R : numFieldType). +Variables (nu : {charge set T -> \bar R}) (D : set T) (mD : measurable D). + +Local Notation restr := (crestr nu mD). + +Let crestr_finite_measure_function U : measurable U -> restr U \is a fin_num. +Proof. +move=> mU. +by have /(fin_num_measure nu) : measurable (U `&` D) by exact: measurableI. +Qed. + +HB.instance Definition _ := SigmaFinite_isFinite.Build _ _ _ + restr crestr_finite_measure_function. + +Let crestr_semi_additive : measure.semi_additive restr. +Proof. +move=> F n mF tF mU; pose FD i := F i `&` D. +have mFD i : measurable (FD i) by exact: measurableI. +have tFD : trivIset setT FD. + apply/trivIsetP => i j _ _ ij. + move/trivIsetP : tF => /(_ i j Logic.I Logic.I ij). + by rewrite /FD setIACA => ->; rewrite set0I. +rewrite -(charge_semi_additive _ _ mFD)//; last exact: bigsetU_measurable. +by rewrite /crestr /FD big_distrl. +Qed. + +HB.instance Definition _ := + isAdditiveCharge.Build _ _ _ restr crestr_semi_additive. + +Let crestr_semi_sigma_additive : semi_sigma_additive restr. +Proof. +move=> F mF tF mU; pose FD i := F i `&` D. +have mFD i : measurable (FD i) by exact: measurableI. +have tFD : trivIset setT FD. + apply/trivIsetP => i j _ _ ij. + move/trivIsetP : tF => /(_ i j Logic.I Logic.I ij). + by rewrite /FD setIACA => ->; rewrite set0I. +rewrite /restr setI_bigcupl; apply: charge_semi_sigma_additive => //. +by apply: bigcup_measurable => k _; exact: measurableI. +Qed. + +HB.instance Definition _ := + isSemiSigmaAdditive.Build _ _ _ restr crestr_semi_sigma_additive. + +End charge_restriction. + +Definition crestr0 d (T : semiRingOfSetsType d) (R : numFieldType) (D : set T) + (f : set T -> \bar R) (mD : measurable D) := + fun X => if X \in measurable then crestr f mD X else 0. + +Section charge_restriction0. +Context d (T : measurableType d) (R : realFieldType). +Variables (nu : {charge set T -> \bar R}) (D : set T) (mD : measurable D). + +Local Notation restr := (crestr0 nu mD). + +Let crestr00 : restr set0 = 0. +Proof. +rewrite/crestr0 ifT ?inE // /crestr set0I. +exact: charge0. +Qed. + +Let crestr0_fin_num_fun : fin_num_fun restr. +Proof. +by move=> U mU; rewrite /crestr0 mem_set// fin_num_measure. +Qed. + +Let crestr0_sigma_additive : semi_sigma_additive restr. +Proof. +move=> F mF tF mU; rewrite /crestr0 mem_set//. +rewrite [X in X @ _ --> _](_ : _ = (fun n => \sum_(0 <= i < n) crestr nu mD (F i))). + exact: charge_semi_sigma_additive. +by apply/funext => n; apply: eq_bigr => i _; rewrite mem_set. +Qed. + +HB.instance Definition _ := isCharge.Build _ _ _ + restr crestr00 crestr0_fin_num_fun crestr0_sigma_additive. + +End charge_restriction0. + +Section charge_zero. +Context d (T : semiRingOfSetsType d) (R : realFieldType). +Local Open Scope ereal_scope. + +Definition czero (A : set T) : \bar R := 0. + +Let czero0 : czero set0 = 0. Proof. by []. Qed. + +Let czero_finite_measure_function B : measurable B -> czero B \is a fin_num. +Proof. by []. Qed. + +Let czero_sigma_additive : semi_sigma_additive czero. +Proof. +move=> F mF tF mUF; rewrite [X in X @ _ --> _](_ : _ = cst 0); first exact: cvg_cst. +by apply/funext => n; rewrite big1. +Qed. + +HB.instance Definition _ := isCharge.Build _ _ _ czero + czero0 czero_finite_measure_function czero_sigma_additive. + +End charge_zero. +Arguments czero {d T R}. + +Section charge_scale. +Local Open Scope ereal_scope. +Context d (T : ringOfSetsType d) (R : realFieldType). +Variables (r : R) (nu : {charge set T -> \bar R}). + +Definition cscale (A : set T) : \bar R := r%:E * nu A. + +Let cscale0 : cscale set0 = 0. Proof. by rewrite /cscale charge0 mule0. Qed. + +Let cscale_finite_measure_function U : measurable U -> cscale U \is a fin_num. +Proof. by move=> mU; apply: fin_numM => //; exact: fin_num_measure. Qed. + +HB.instance Definition _ := SigmaFinite_isFinite.Build _ _ _ + cscale cscale_finite_measure_function. + +Let cscale_semi_additive : measure.semi_additive cscale. +Proof. +move=> F n mF tF mU; rewrite /cscale charge_semi_additive//. +rewrite fin_num_sume_distrr// => i j _ _. +by rewrite fin_num_adde_defl// fin_num_measure. +Qed. + +HB.instance Definition _ := + isAdditiveCharge.Build _ _ _ cscale cscale_semi_additive. + +Let cscale_sigma_additive : semi_sigma_additive cscale. +Proof. +move=> F mF tF mUF; rewrite /cscale; rewrite [X in X @ _ --> _](_ : _ = + (fun n => r%:E * \sum_(0 <= i < n) nu (F i))); last first. + apply/funext => k; rewrite fin_num_sume_distrr// => i j _ _. + by rewrite fin_num_adde_defl// fin_num_measure. +rewrite /mscale; have [->|r0] := eqVneq r 0%R. + rewrite mul0e [X in X @ _ --> _](_ : _ = (fun=> 0)); first exact: cvg_cst. + by under eq_fun do rewrite mul0e. +by apply: cvgeMl => //; apply: charge_semi_sigma_additive. +Qed. + +HB.instance Definition _ := isCharge.Build _ _ _ cscale + cscale0 cscale_finite_measure_function cscale_sigma_additive. + +End charge_scale. + +Lemma dominates_cscalel d (T : measurableType d) (R : realType) + (mu : set T -> \bar R) + (nu : {charge set T -> \bar R}) + (c : R) : nu `<< mu -> cscale c nu `<< mu. +Proof. by move=> numu E mE /numu; rewrite /cscale => ->//; rewrite mule0. Qed. + +Lemma dominates_cscaler d (T : measurableType d) (R : realType) + (nu : {charge set T -> \bar R}) + (mu : set T -> \bar R) + (c : R) : c != 0%R -> mu `<< nu -> mu `<< cscale c nu. +Proof. +move=> /negbTE c0 munu E mE /eqP; rewrite /cscale mule_eq0 eqe c0/=. +by move=> /eqP/munu; exact. +Qed. + +Section charge_add. +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType). +Variables (n1 n2 : {charge set T -> \bar R}). + +Definition cadd := n1 \+ n2. + +Let cadd0 : cadd set0 = 0. +Proof. by rewrite /cadd 2!charge0 adde0. Qed. + +Let cadd_finite A : measurable A -> cadd A \is a fin_num. +Proof. by move=> mA; rewrite fin_numD !fin_num_measure. Qed. + +Let cadd_sigma_additive : semi_sigma_additive cadd. +Proof. +move=> F mF tF mUF; rewrite /cadd. +under eq_fun do rewrite big_split; apply: cvg_trans. + (* TODO: IIRC explicit arguments were added to please Coq 8.14, rm if not needed anymore *) + apply: (@cvgeD _ _ _ R (fun x => \sum_(0 <= i < x) (n1 (F i))) + (fun x => \sum_(0 <= i < x) (n2 (F i))) + (n1 (\bigcup_n F n)) (n2 (\bigcup_n F n))). + - by rewrite fin_num_adde_defr// fin_num_measure. + - exact: charge_semi_sigma_additive. + - exact: charge_semi_sigma_additive. +exact: cvg_id. +Qed. + +HB.instance Definition _ := isCharge.Build _ _ _ cadd + cadd0 cadd_finite cadd_sigma_additive. + +End charge_add. + +Lemma dominates_cadd d (T : measurableType d) (R : realType) + (mu : {sigma_finite_measure set T -> \bar R}) + (nu0 nu1 : {charge set T -> \bar R}) : + nu0 `<< mu -> nu1 `<< mu -> + cadd nu0 nu1 `<< mu. +Proof. +by move=> nu0mu nu1mu A mA A0; rewrite /cadd nu0mu// nu1mu// adde0. +Qed. + +Section pushforward_charge. +Local Open Scope ereal_scope. +Context d1 d2 (T1 : measurableType d1) (T2 : measurableType d2) (f : T1 -> T2). +Variables (R : realFieldType) (nu : {charge set T1 -> \bar R}). + +Hypothesis mf : measurable_fun setT f. + +Let pushforward0 : pushforward nu mf set0 = 0. +Proof. by rewrite /pushforward preimage_set0 charge0. Qed. + +Let pushforward_finite A : measurable A -> pushforward nu mf A \is a fin_num. +Proof. +move=> mA; apply: fin_num_measure. +by rewrite -[X in measurable X]setTI; exact: mf. +Qed. + +Let pushforward_sigma_additive : semi_sigma_additive (pushforward nu mf). +Proof. +move=> F mF tF mUF; rewrite /pushforward preimage_bigcup. +apply: charge_semi_sigma_additive. +- by move=> n; rewrite -[X in measurable X]setTI; exact: mf. +- apply/trivIsetP => /= i j _ _ ij; rewrite -preimage_setI. + by move/trivIsetP : tF => /(_ _ _ _ _ ij) ->//; rewrite preimage_set0. +- by rewrite -preimage_bigcup -[X in measurable X]setTI; exact: mf. +Qed. + +HB.instance Definition _ := isCharge.Build _ _ _ (pushforward nu mf) + pushforward0 pushforward_finite pushforward_sigma_additive. + +End pushforward_charge. + +HB.builders Context d (T : measurableType d) (R : realType) + (mu : set T -> \bar R) of Measure_isFinite d T R mu. + +Let mu0 : mu set0 = 0. +Proof. by apply: measure0. Qed. + +HB.instance Definition _ := isCharge.Build _ _ _ + mu (measure0 [the content _ _ of mu]) + fin_num_measure measure_semi_sigma_additive. + +HB.end. + +Section dominates_pushforward. + +Lemma dominates_pushforward d d' (T : measurableType d) (T' : measurableType d') + (R : realType) (mu : {measure set T -> \bar R}) + (nu : {charge set T -> \bar R}) (f : T -> T') (mf : measurable_fun setT f) : + nu `<< mu -> pushforward nu mf `<< pushforward mu mf. +Proof. +by move=> numu A mA; apply: numu; rewrite -[X in measurable X]setTI; exact: mf. +Qed. + +End dominates_pushforward. + +Section positive_negative_set. +Context d (T : semiRingOfSetsType d) (R : numDomainType). +Implicit Types nu : set T -> \bar R. + +Definition positive_set nu (P : set T) := + measurable P /\ forall A, measurable A -> A `<=` P -> nu A >= 0. + +Definition negative_set nu (N : set T) := + measurable N /\ forall A, measurable A -> A `<=` N -> nu A <= 0. + +End positive_negative_set. + +Notation "nu .-negative_set" := (negative_set nu) : charge_scope. +Notation "nu .-positive_set" := (positive_set nu) : charge_scope. + +Local Open Scope charge_scope. + +Section positive_negative_set_lemmas. +Context d (T : measurableType d) (R : numFieldType). +Implicit Types nu : {charge set T -> \bar R}. + +Lemma negative_set_charge_le0 nu N : nu.-negative_set N -> nu N <= 0. +Proof. by move=> [mN]; exact. Qed. + +Lemma negative_set0 nu : nu.-negative_set set0. +Proof. by split => // A _; rewrite subset0 => ->; rewrite charge0. Qed. + +Lemma positive_negative0 nu P N : nu.-positive_set P -> nu.-negative_set N -> + forall S, measurable S -> nu (S `&` P `&` N) = 0. +Proof. +move=> [mP posP] [mN negN] S mS; apply/eqP; rewrite eq_le; apply/andP; split. + apply: negN; first by apply: measurableI => //; exact: measurableI. + by apply/setIidPl; rewrite -setIA setIid. +rewrite -setIAC. +apply: posP; first by apply: measurableI => //; exact: measurableI. +by apply/setIidPl; rewrite -setIA setIid. +Qed. + +End positive_negative_set_lemmas. + +Section positive_negative_set_realFieldType. +Context d (T : measurableType d) (R : realFieldType). +Implicit Types nu : {charge set T -> \bar R}. + +Lemma bigcup_negative_set nu (F : (set T)^nat) : + (forall i, nu.-negative_set (F i)) -> + nu.-negative_set (\bigcup_i F i). +Proof. +move=> hF; have mUF : measurable (\bigcup_k F k). + by apply: bigcup_measurable => n _; have [] := hF n. +split=> [//|S mS SUF]. +pose SF n := (S `&` F n) `\` \bigcup_(k < n) F k. +have SSF : S = \bigcup_i SF i. + transitivity (\bigcup_k seqDU (fun n => S `&` F n) k); last first. + by apply: eq_bigcup => // n _; rewrite seqDUIE. + by rewrite -seqDU_bigcup_eq -setI_bigcupr setIidl. +have mSF n : measurable (SF n). + apply: measurableD; first by apply: measurableI => //; have [] := hF n. + by apply: bigcup_measurable => // k _; have [] := hF k. +have SFS : (\sum_(0 <= i < n) nu (SF i)) @[n --> \oo] --> nu S. + by rewrite SSF; apply: charge_semi_sigma_additive => //; + [by rewrite /SF -seqDUIE; exact: trivIset_seqDU|exact: bigcup_measurable]. +have nuS_ n : nu (SF n) <= 0 by have [_] := hF n; apply => // x -[[]]. +move/cvg_lim : (SFS) => <-//; apply: lime_le. + by apply/cvg_ex => /=; first eexists; exact: SFS. +by apply: nearW => n; exact: sume_le0. +Qed. + +Lemma negative_setU nu N M : + nu.-negative_set N -> nu.-negative_set M -> nu.-negative_set (N `|` M). +Proof. +move=> nN nM; rewrite -bigcup2E; apply: bigcup_negative_set => -[//|[//|/= _]]. +exact: negative_set0. +Qed. + +End positive_negative_set_realFieldType. + +Section hahn_decomposition_lemma. +Context d (T : measurableType d) (R : realType). +Variables (nu : {charge set T -> \bar R}) (D : set T). + +Let elt_prop (x : set T * \bar R) := [/\ measurable x.1, + x.1 `<=` D, 0 <= x.2 & nu x.1 >= mine (x.2 * 2^-1%:E) 1]. + +Let elt_type := {x : set T * \bar R * set T | elt_prop x.1}. + +Let A_ (x : elt_type) := (proj1_sig x).1.1. +Let g_ (x : elt_type) := (proj1_sig x).1.2. +Let U_ (x : elt_type) := (proj1_sig x).2. + +Let mA_ x : measurable (A_ x). Proof. by move: x => [[[? ?] ?]] []. Qed. +Let A_D x : A_ x `<=` D. Proof. by move: x => [[[? ?] ?]] []. Qed. +Let g_ge0 x : 0 <= g_ x. Proof. by move: x => [[[? ?] ?]] []. Qed. +Let nuA_g_ x : nu (A_ x) >= mine (g_ x * 2^-1%:E) 1. +Proof. by move: x => [[[? ?] ?]] []. Qed. + +Let nuA_ge0 x : 0 <= nu (A_ x). +Proof. by rewrite (le_trans _ (nuA_g_ _))// le_minr lee01 andbT mule_ge0. Qed. + +Let subDD A := [set nu E | E in [set E | measurable E /\ E `<=` D `\` A] ]. + +Let d_ A := ereal_sup (subDD A). + +Let d_ge0 X : 0 <= d_ X. +Proof. by apply: ereal_sup_ub => /=; exists set0; rewrite ?charge0. Qed. + +Let elt_rel i j := + [/\ g_ j = d_ (U_ i), A_ j `<=` D `\` U_ i & U_ j = U_ i `|` A_ j ]. + +Let next_elt A : + { B | [/\ measurable B, B `<=` D `\` A & nu B >= mine (d_ A * 2^-1%:E) 1] }. +Proof. +pose m := mine (d_ A * 2^-1%R%:E) 1; apply/cid. +have := d_ge0 A; rewrite le_eqVlt => /predU1P[<-|d_gt0]. + by exists set0; split => //; rewrite charge0 mul0e minEle lee01. +have /ereal_sup_gt/cid2[_ [B/= [mB BDA <- mnuB]]] : m < d_ A. + rewrite /m; have [->|dn1oo] := eqVneq (d_ A) +oo. + by rewrite min_r ?ltey ?gt0_mulye ?leey. + rewrite -(@fineK _ (d_ A)); last by rewrite gt0_fin_numE// ltey. + rewrite -EFinM -fine_min// lte_fin lt_minl; apply/orP; left. + by rewrite ltr_pdivrMr// ltr_pMr ?ltr1n// fine_gt0// d_gt0/= ltey. +by exists B; split => //; rewrite (le_trans _ (ltW mnuB)). +Qed. + +Let mine2_cvg_0_cvg_0 (u : (\bar R)^nat) : (forall k, 0 <= u k) -> + mine (u n * 2^-1%:E) 1 @[n --> \oo] --> 0 -> u n @[n --> \oo] --> 0. +Proof. +move=> u0 h. +have u2 n : u n = 2%:E * (u n * 2^-1%:E) by rewrite muleCA -EFinM divff ?mule1. +rewrite (eq_cvg _ _ u2) -[X in _ --> X]/(nbhs 0). +rewrite -(mule0 2%:E); apply: cvgeMl => //. +by apply: (mine_cvg_0_cvg_0 lte01) => // n; rewrite mule_ge0. +Qed. + +Lemma hahn_decomposition_lemma : measurable D -> + {A | [/\ A `<=` D, nu.-negative_set A & nu A <= nu D]}. +Proof. +move=> mD; have [A0 [mA0 + A0d0]] := next_elt set0. +rewrite setD0 => A0D. +have [v [v0 Pv]] : {v : nat -> elt_type | + v 0%N = exist _ (A0, d_ set0, A0) (And4 mA0 A0D (d_ge0 set0) A0d0) /\ + forall n, elt_rel (v n) (v n.+1)}. + apply: dependent_choice_Type => -[[[A' ?] U] [/= mA' A'D]]. + have [A1 [mA1 A1DU A1t1] ] := next_elt U. + have A1D : A1 `<=` D by apply: (subset_trans A1DU); apply: subDsetl. + by exists (exist _ (A1, d_ U, U `|` A1) (And4 mA1 A1D (d_ge0 U) A1t1)). +have Ubig n : U_ (v n) = \big[setU/set0]_(i < n.+1) A_ (v i). + elim: n => [|n ih]; first by rewrite v0/= big_ord_recr/= big_ord0 set0U v0. + by have [_ _ ->] := Pv n; rewrite big_ord_recr/= -ih. +have tA : trivIset setT (A_ \o v). + apply: subsetC_trivIset => n. + have [_ + _] := Pv n; move/subset_trans; apply. + by rewrite -setTD; apply: setDSS => //; rewrite Ubig big_ord_recr. +set Aoo := \bigcup_k A_ (v k). +have mAoo : measurable Aoo by exact: bigcup_measurable. +exists (D `\` Aoo). +have cvg_nuA : (\sum_(0 <= i < n) nu (A_ (v i))) @[n --> \oo]--> nu Aoo. + exact: charge_semi_sigma_additive. +have nuAoo : 0 <= nu Aoo. + move/cvg_lim : cvg_nuA => <-//=; apply: nneseries_ge0 => n _. + exact: nuA_ge0. +have A_cvg_0 : nu (A_ (v n)) @[n --> \oo] --> 0. + rewrite [X in X @ _ --> _](_ : _ = (fun n => (fine (nu (A_ (v n))))%:E)); last first. + by apply/funext => n/=; rewrite fineK// fin_num_measure. + apply: continuous_cvg => //; apply: cvg_series_cvg_0. + rewrite (_ : series _ = fine \o (fun n => \sum_(0 <= i < n) nu (A_ (v i)))); last first. + apply/funext => n /=. + by rewrite /series/= sum_fine//= => i _; rewrite fin_num_measure. + move: cvg_nuA; rewrite -(@fineK _ (nu Aoo)) ?fin_num_measure//. + by move=> /fine_cvgP[_ ?]; apply/cvg_ex; exists (fine (nu Aoo)). +have mine_cvg_0 : (mine (g_ (v n) * 2^-1%:E) 1) @[n --> \oo] --> 0. + apply: (@squeeze_cvge _ _ _ _ _ _ (fun n => nu (A_ (v n)))); + [|exact: cvg_cst|by []]. + by apply: nearW => n /=; rewrite nuA_g_ andbT le_minr lee01 andbT mule_ge0. +have g_cvg_0 : (g_ \o v) n @[n --> \oo] --> 0 by apply: mine2_cvg_0_cvg_0 => //=. +have nuDAoo : nu D >= nu (D `\` Aoo). + rewrite -[in leRHS](@setDUK _ Aoo D); last first. + by apply: bigcup_sub => i _; exact: A_D. + by rewrite chargeU// ?lee_addr// ?setDIK//; exact: measurableD. +split; [by []| |by []]; split; [exact: measurableD | move=> E mE EDAoo]. +pose H n := subDD (\big[setU/set0]_(i < n) A_ (v i)). +have EH n : [set nu E] `<=` H n. + have : nu E \in subDD Aoo by rewrite inE; exists E. + rewrite -sub1set => /subset_trans; apply => x/= [F [mF FDAoo ?]]. + exists F => //; split => //. + by apply: (subset_trans FDAoo); apply: setDS; exact: bigsetU_bigcup. +have nudelta n : nu E <= g_ (v n). + move: n => [|n]. + rewrite v0/=; apply: ereal_sup_ub => /=; exists E; split => //. + by apply: (subset_trans EDAoo); exact: setDS. + suff : nu E <= d_ (U_ (v n)) by have [<- _] := Pv n. + have /le_ereal_sup := EH n.+1; rewrite ereal_sup1 => /le_trans; apply. + apply/le_ereal_sup => x/= [A' [mA' A'D ?]]. + exists A' => //; split => //. + by apply: (subset_trans A'D); apply: setDS; rewrite Ubig. +apply: (@closed_cvg _ _ _ _ _ (fun v => nu E <= v) _ _ _ g_cvg_0) => //. + exact: closed_ereal_le_ereal. +exact: nearW. +Unshelve. all: by end_near. Qed. + +End hahn_decomposition_lemma. + +Definition hahn_decomposition d (T : semiRingOfSetsType d) (R : numFieldType) + (nu : {charge set T -> \bar R}) P N := + [/\ nu.-positive_set P, nu.-negative_set N, P `|` N = [set: T] & P `&` N = set0]. + +Section hahn_decomposition_theorem. +Context d (T : measurableType d) (R : realType). +Variable nu : {charge set T -> \bar R}. + +Let elt_prop (x : set T * \bar R) := [/\ x.2 <= 0, + nu.-negative_set x.1 & nu x.1 <= maxe (x.2 * 2^-1%:E) (- 1%E) ]. + +Let elt_type := {AzU : set T * \bar R * set T | elt_prop AzU.1}. + +Let A_ (x : elt_type) := (proj1_sig x).1.1. +Let z_ (x : elt_type) := (proj1_sig x).1.2. +Let U_ (x : elt_type) := (proj1_sig x).2. + +Let mA_ x : measurable (A_ x). Proof. by move: x => [[[? ?] ?] [/= ? []]]. Qed. +Let negative_set_A_ x : nu.-negative_set (A_ x). +Proof. by move: x => [[[? ?] ?]] -[]. Qed. +Let nuA_z_ x : nu (A_ x) <= maxe (z_ x * 2^-1%:E) (- 1%E). +Proof. by move: x => [[[? ?] ?]] -[]. Qed. + +Let nuA_le0 x : nu (A_ x) <= 0. +Proof. by move: x => [[[? ?] ?]] [? h ?]; exact: negative_set_charge_le0. Qed. + +Let z_le0 x : z_ x <= 0. +Proof. by move: x => [[[? ?] ?]] -[]. Qed. + +Let subC A := [set nu E | E in [set E | measurable E /\ E `<=` ~` A] ]. + +Let s_ A := ereal_inf (subC A). + +Let s_le0 X : s_ X <= 0. +Proof. +by apply: ereal_inf_lb => /=; exists set0; rewrite ?charge0//=; split. +Qed. + +Let elt_rel i j := + [/\ z_ j = s_ (U_ i), A_ j `<=` ~` U_ i & U_ j = U_ i `|` A_ j]. + +Let next_elt U : { A | [/\ A `<=` ~` U, + negative_set nu A & nu A <= maxe (s_ U * 2^-1%R%:E) (- 1%E)] }. +Proof. +pose m := maxe (s_ U * 2^-1%R%:E) (- 1%E); apply/cid. +have := s_le0 U; rewrite le_eqVlt => /predU1P[->|s_lt0]. + exists set0; split => //; rewrite ?charge0 ?mul0e ?maxEle ?lee0N1//. + exact: negative_set0. +have /ereal_inf_lt/cid2[_ [B/= [mB BU] <-] nuBm] : s_ U < m. + rewrite /m; have [->|s0oo] := eqVneq (s_ U) -oo. + by rewrite max_r ?ltNye// gt0_mulNye// leNye. + rewrite -(@fineK _ (s_ U)); last by rewrite lt0_fin_numE// ltNye. + rewrite -EFinM -fine_max// lte_fin lt_maxr; apply/orP; left. + by rewrite ltr_pdivlMr// gtr_nMr ?ltr1n// fine_lt0// s_lt0/= ltNye andbT. +have [C [CB nsC nuCB]] := hahn_decomposition_lemma nu mB. +exists C; split => //; first exact: (subset_trans CB). +by rewrite (le_trans nuCB)// (le_trans (ltW nuBm)). +Qed. + +Theorem Hahn_decomposition : exists P N, hahn_decomposition nu P N. +Proof. +have [A0 [_ negA0 A0s0]] := next_elt set0. +have [v [v0 Pv]] : {v | + v 0%N = exist _ (A0, s_ set0, A0) (And3 (s_le0 set0) negA0 A0s0) /\ + forall n, elt_rel (v n) (v n.+1)}. + apply: dependent_choice_Type => -[[[A s] U] [/= s_le0' nsA]]. + have [A' [? nsA' A's'] ] := next_elt U. + by exists (exist _ (A', s_ U, U `|` A') (And3 (s_le0 U) nsA' A's')). +have Ubig n : U_ (v n) = \big[setU/set0]_(i < n.+1) A_ (v i). + elim: n => [|n ih]; first by rewrite v0/= big_ord_recr/= big_ord0 set0U v0. + by have [_ _ ->] := Pv n; rewrite big_ord_recr/= -ih. +have tA : trivIset setT (A_ \o v). + apply: subsetC_trivIset => n. + have [_ + _] := Pv n; move/subset_trans; apply. + by apply: subsetC; rewrite Ubig big_ord_recr. +set N := \bigcup_k (A_ (v k)). +have mN : measurable N by exact: bigcup_measurable. +have neg_set_N : negative_set nu N. + by apply: bigcup_negative_set => i; exact: negative_set_A_. +pose P := ~` N. +have mP : measurable P by exact: measurableC. +exists P, N; split; [|exact: neg_set_N|by rewrite /P setvU|by rewrite /P setICl]. +split=> // D mD DP; rewrite leNgt; apply/negP => nuD0. +have znuD n : z_ (v n) <= nu D. + move: n => [|n]. + by rewrite v0 /=; apply: ereal_inf_lb; exists D; split => //; rewrite setC0. + have [-> _ _] := Pv n; apply: ereal_inf_lb => /=; exists D; split => //. + apply: (subset_trans DP); apply: subsetC; rewrite Ubig. + exact: bigsetU_bigcup. +have max_le0 n : maxe (z_ (v n) * 2^-1%:E) (- 1%E) <= 0. + by rewrite le_maxl leeN10 andbT pmule_lle0. +have not_s_cvg_0 : ~ (z_ \o v) n @[n --> \oo] --> 0. + move/fine_cvgP => -[zfin] /cvgrPdist_lt. + have /[swap] /[apply] -[M _ hM] : (0 < `|fine (nu D)|)%R. + by rewrite normr_gt0// fine_eq0// ?lt_eqF// fin_num_measure. + near \oo => n. + have /hM : (M <= n)%N by near: n; exists M. + rewrite sub0r normrN /= ler0_norm ?fine_le0// ltr0_norm//; last first. + by rewrite fine_lt0// nuD0 andbT ltNye_eq fin_num_measure. + rewrite ltrN2; apply/negP; rewrite -leNgt fine_le ?fin_num_measure//. + by near: n; exact. +have nuN : nu N = \sum_(n //. + by apply: charge_semi_sigma_additive; [|exact: tA|exact: bigcup_measurable]. +have sum_A_maxe : \sum_(n \oo]). + by apply: is_cvg_ereal_npos_natsum_cond => n _ _; exact: max_le0. +move=> /cvg_ex[[l| |]]; first last. + - move/cvg_lim => limNoo. + have : nu N <= -oo by rewrite -limNoo// nuN. + by rewrite leNgt => /negP; apply; rewrite ltNye_eq fin_num_measure. + - move/cvg_lim => limoo. + have := @npeseries_le0 _ (fun n => maxe (z_ (v n) * 2^-1%:E) (- 1%E)) xpredT 0. + by rewrite limoo// leNgt => /(_ (fun n _ => max_le0 n))/negP; apply. +move/fine_cvgP => [Hfin cvgl]. +have : cvg (series (fun n => fine (maxe (z_ (v n) * 2^-1%:E) (- 1%E))) n @[n --> \oo]). + apply/cvg_ex; exists l; move: cvgl. + rewrite (_ : _ \o _ = (fun n => + \sum_(0 <= k < n) fine (maxe (z_ (v k) * 2^-1%:E)%E (- 1%E)%E))%R) //. + apply/funext => n/=; rewrite sum_fine// => m _. + rewrite le0_fin_numE; first by rewrite lt_maxr ltNyr orbT. + by rewrite /maxe; case: ifPn => // _; rewrite mule_le0_ge0. +move/cvg_series_cvg_0 => maxe_cvg_0. +apply: not_s_cvg_0. +rewrite (_ : _ \o _ = (fun n => z_ (v n) * 2^-1%:E) \* cst 2%:E); last first. + by apply/funext => n/=; rewrite -muleA -EFinM mulVr ?mule1// unitfE. +rewrite (_ : 0 = 0 * 2%:E); last by rewrite mul0e. +apply: cvgeM; [by rewrite mule_def_fin| |exact: cvg_cst]. +apply/fine_cvgP; split. + move/cvgrPdist_lt : maxe_cvg_0 => /(_ _ ltr01)[M _ hM]; near=> n. + have /hM : (M <= n)%N by near: n; exists M. + rewrite sub0r normrN ltNge => maxe_lt1; rewrite fin_numE; apply/andP; split. + by apply: contra maxe_lt1 => /eqP ->; rewrite max_r ?leNye//= normrN1 lexx. + by rewrite lt_eqF// (@le_lt_trans _ _ 0)// mule_le0_ge0. +apply/cvgrPdist_lt => _ /posnumP[e]. +have : (0 < minr e%:num 1)%R by rewrite lt_minr// ltr01 andbT. +move/cvgrPdist_lt : maxe_cvg_0 => /[apply] -[M _ hM]. +near=> n; rewrite sub0r normrN. +have /hM : (M <= n)%N by near: n; exists M. +rewrite sub0r normrN /maxe/=; case: ifPn => [_|]. + by rewrite normrN normr1 lt_minr ltxx andbF. +by rewrite -leNgt => ? /lt_le_trans; apply; rewrite le_minl lexx. +Unshelve. all: by end_near. Qed. + +Lemma Hahn_decomposition_uniq P1 N1 P2 N2 : + hahn_decomposition nu P1 N1 -> hahn_decomposition nu P2 N2 -> + forall S, measurable S -> + nu (S `&` P1) = nu (S `&` P2) /\ nu (S `&` N1) = nu (S `&` N2). +Proof. +move=> [psP1 nsN1 PN1T PN10] [psP2 nsN2 PN2T PN20] S mS. +move: (psP1) (nsN1) (psP2) (nsN2) => [mP1 _] [mN1 _] [mP2 _] [mN2 _]. +split. +- transitivity (nu (S `&` P1 `&` P2)). + + rewrite (charge_partition _ _ mP2 mN2)//; last exact: measurableI. + by rewrite (positive_negative0 psP1 nsN2 mS) adde0. + + rewrite [RHS](charge_partition _ _ mP1 mN1)//; last exact: measurableI. + by rewrite (positive_negative0 psP2 nsN1 mS) adde0 setIAC. +- transitivity (nu (S `&` N1 `&` N2)). + + rewrite (charge_partition nu _ mP2 mN2)//; last exact: measurableI. + have := positive_negative0 psP2 nsN1 mS. + by rewrite setIAC => ->; rewrite add0e. + + rewrite [RHS](charge_partition nu _ mP1 mN1)//; last exact: measurableI. + by rewrite (setIAC _ _ P1) (positive_negative0 psP1 nsN2 mS) add0e setIAC. +Qed. + +End hahn_decomposition_theorem. + +Section jordan_decomposition. +Context d (T : measurableType d) (R : realType). +Variable nu : {charge set T -> \bar R}. +Variables (P N : set T) (nuPN : hahn_decomposition nu P N). + +Let mP : measurable P. Proof. by have [[mP _] _ _ _] := nuPN. Qed. + +Let mN : measurable N. Proof. by have [_ [mN _] _ _] := nuPN. Qed. + +Local Definition cjordan_pos : {charge set T -> \bar R} := + [the charge _ _ of crestr0 nu mP]. + +Lemma cjordan_posE A : cjordan_pos A = crestr0 nu mP A. +Proof. by []. Qed. + +Let positive_set_cjordan_pos E : 0 <= cjordan_pos E. +Proof. +have [posP _ _ _] := nuPN. +rewrite cjordan_posE /crestr0/=; case: ifPn => // /[1!inE] mE. +by apply posP; [apply: measurableI|apply: subIsetr]. +Qed. + +Definition jordan_pos := measure_of_charge _ positive_set_cjordan_pos. + +Lemma jordan_posE A : jordan_pos A = cjordan_pos A. +Proof. by []. Qed. + +HB.instance Definition _ := Measure.on jordan_pos. + +Let finite_jordan_pos : fin_num_fun jordan_pos. +Proof. by move=> U mU; rewrite fin_num_measure. Qed. + +HB.instance Definition _ := @Measure_isFinite.Build _ _ _ + jordan_pos finite_jordan_pos. + +Local Definition cjordan_neg : {charge set T -> \bar R} := + [the charge _ _ of cscale (-1) [the charge _ _ of crestr0 nu mN]]. + +Lemma cjordan_negE A : cjordan_neg A = - crestr0 nu mN A. +Proof. by rewrite /= /cscale/= EFinN mulN1e. Qed. + +Let positive_set_cjordan_neg E : 0 <= cjordan_neg E. +Proof. +rewrite cjordan_negE /crestr0/=; case: ifPn; rewrite ?oppe0//. +move=> /[!inE] mE; rewrite /crestr lee_oppr oppe0. +by move: nuPN => [_ [_ +] _ _] => -> //; exact: measurableI. +Qed. + +Definition jordan_neg := measure_of_charge _ positive_set_cjordan_neg. + +Lemma jordan_negE A : jordan_neg A = cjordan_neg A. +Proof. by []. Qed. + +HB.instance Definition _ := Measure.on jordan_neg. + +Let finite_jordan_neg : fin_num_fun jordan_neg. +Proof. by move=> U mU; rewrite fin_num_measure. Qed. + +HB.instance Definition _ := @Measure_isFinite.Build _ _ _ + jordan_neg finite_jordan_neg. + +Lemma jordan_decomp (A : set T) : measurable A -> + nu A = (cadd [the charge _ _ of jordan_pos] + ([the charge _ _ of cscale (-1) [the charge _ _ of jordan_neg]])) A. +Proof. +move=> mA. +rewrite /cadd cjordan_posE /= /cscale EFinN mulN1e cjordan_negE oppeK. +rewrite /crestr0 mem_set// -[in LHS](setIT A). +case: nuPN => _ _ <- PN0; rewrite setIUr chargeU//. +- exact: measurableI. +- exact: measurableI. +- by rewrite setIACA PN0 setI0. +Qed. + +Lemma jordan_pos_dominates (mu : {measure set T -> \bar R}) : + nu `<< mu -> jordan_pos `<< mu. +Proof. +move=> nu_mu A mA muA0; have := nu_mu A mA muA0. +rewrite jordan_posE// cjordan_posE /crestr0 mem_set// /crestr/=. +have mAP : measurable (A `&` P) by exact: measurableI. +suff : mu (A `&` P) = 0 by move/(nu_mu _ mAP) => ->. +by apply/eqP; rewrite eq_le measure_ge0// andbT -muA0 le_measure// inE. +Qed. + +Lemma jordan_neg_dominates (mu : {measure set T -> \bar R}) : + nu `<< mu -> jordan_neg `<< mu. +Proof. +move=> nu_mu A mA muA0; have := nu_mu A mA muA0. +rewrite jordan_negE// cjordan_negE /crestr0 mem_set// /crestr/=. +have mAN : measurable (A `&` N) by exact: measurableI. +suff : mu (A `&` N) = 0 by move=> /(nu_mu _ mAN) ->; rewrite oppe0. +by apply/eqP; rewrite eq_le measure_ge0// andbT -muA0 le_measure// inE. +Qed. + +End jordan_decomposition. + +(* We put definitions and lemmas used only in the proof of the Radon-Nikodym + theorem as Definition's and Lemma's in the following modules. See + https://staff.aist.go.jp/reynald.affeldt/documents/measure-ppl2023.pdf + for an overview. *) +Module approxRN. +Section approxRN. +Context d (T : measurableType d) (R : realType). +Variables mu nu : {measure set T -> \bar R}. + +Definition approxRN := [set g : T -> \bar R | [/\ + forall x, 0 <= g x, mu.-integrable [set: T] g & + forall E, measurable E -> \int[mu]_(x in E) g x <= nu E] ]. + +Let approxRN_neq0 : approxRN !=set0. +Proof. +exists (cst 0); split => //; first exact: integrable0. +by move=> E mE; rewrite integral0 measure_ge0. +Qed. + +Definition int_approxRN := [set \int[mu]_x g x | g in approxRN]. + +Definition sup_int_approxRN := ereal_sup int_approxRN. + +Lemma sup_int_approxRN_ge0 : 0 <= sup_int_approxRN. +Proof. +rewrite -(ereal_sup1 0) le_ereal_sup// sub1set inE. +exists (fun=> 0); last exact: integral0. +by split => //; [exact: integrable0|move=> E; rewrite integral0]. +Qed. + +End approxRN. +End approxRN. + +Module approxRN_seq. +Section approxRN_seq. +Context d (T : measurableType d) (R : realType). +Variable mu : {measure set T -> \bar R}. +Variable nu : {finite_measure set T -> \bar R}. + +Import approxRN. + +Let approxRN := approxRN mu nu. +Let int_approxRN := int_approxRN mu nu. +Let M := sup_int_approxRN mu nu. + +Let int_approxRN_ub : exists M, forall x, x \in int_approxRN -> x <= M%:E. +Proof. +exists (fine (nu setT)) => x /[1!inE] -[g [g0 g1 g2] <-{x}]. +by rewrite fineK ?fin_num_measure// (le_trans (g2 setT _))// inE. +Qed. + +Lemma sup_int_approxRN_lty : M < +oo. +Proof. +rewrite /sup_int_approxRN; have [m hm] := int_approxRN_ub. +rewrite (@le_lt_trans _ _ m%:E)// ?ltey// ub_ereal_sup// => x IGx. +by apply: hm; rewrite inE. +Qed. + +Lemma sup_int_approxRN_fin_num : M \is a fin_num. +Proof. +rewrite ge0_fin_numE//; first exact: sup_int_approxRN_lty. +exact: sup_int_approxRN_ge0. +Qed. + +Lemma approxRN_seq_ex : { g : (T -> \bar R)^nat | + forall k, g k \in approxRN /\ \int[mu]_x g k x > M - k.+1%:R^-1%:E }. +Proof. +pose P m g := g \in approxRN /\ M - m.+1%:R^-1%:E < \int[mu]_x g x. +suff : { g : (T -> \bar R) ^nat & forall m, P m (g m)} by case => g ?; exists g. +apply: (@choice _ _ P) => m. +rewrite /P. +have /(@ub_ereal_sup_adherent _ int_approxRN) : (0 < m.+1%:R^-1 :> R)%R. + by rewrite invr_gt0. +move/(_ sup_int_approxRN_fin_num) => [_ [h Gh <-]]. +by exists h; rewrite inE; split => //; rewrite -/M in q. +Qed. + +Definition approxRN_seq : (T -> \bar R)^nat := sval approxRN_seq_ex. + +Let g_ := approxRN_seq. + +Lemma approxRN_seq_prop : forall m, + g_ m \in approxRN /\ \int[mu]_x (g_ m x) > M - m.+1%:R^-1%:E. +Proof. exact: (projT2 approxRN_seq_ex). Qed. + +Lemma approxRN_seq_ge0 x n : 0 <= g_ n x. +Proof. by have [+ _]:= approxRN_seq_prop n; rewrite inE /= => -[]. Qed. + +Lemma measurable_approxRN_seq n : measurable_fun setT (g_ n). +Proof. by have := approxRN_seq_prop n; rewrite inE =>-[[_ /integrableP[]]]. Qed. + +Definition max_approxRN_seq n x := \big[maxe/-oo]_(j < n.+1) g_ j x. + +Let F_ := max_approxRN_seq. + +Lemma measurable_max_approxRN_seq n : measurable_fun [set: T] (F_ n). +Proof. +elim: n => [|n ih]. + rewrite /F_ /max_approxRN_seq. + under eq_fun do rewrite big_ord_recr/=; rewrite -/(measurable_fun _ _). + under eq_fun do rewrite big_ord0; rewrite -/(measurable_fun _ _). + under eq_fun do rewrite maxNye; rewrite -/(measurable_fun _ _). + have [+ _] := approxRN_seq_prop 0%N. + by rewrite inE /= => -[]// _ _ _; exact: measurable_approxRN_seq. +rewrite /F_ /max_approxRN_seq => m. +under eq_fun do rewrite big_ord_recr. +by apply: measurable_maxe => //; exact: measurable_approxRN_seq. +Qed. + +Lemma max_approxRN_seq_ge0 n x : 0 <= F_ n x. +Proof. +by apply/bigmax_geP; right => /=; exists ord0 => //; exact: approxRN_seq_ge0. +Qed. + +Lemma max_approxRN_seq_ge n x : F_ n x >= g_ n x. +Proof. by apply/bigmax_geP; right => /=; exists ord_max. Qed. + +Lemma max_approxRN_seq_nd x : nondecreasing_seq (F_ ^~ x). +Proof. by move=> a b ab; rewrite (le_bigmax_ord xpredT (g_ ^~ x)). Qed. + +Lemma is_cvg_max_approxRN_seq n : cvg (F_ ^~ n @ \oo). +Proof. by apply: ereal_nondecreasing_is_cvgn; exact: max_approxRN_seq_nd. Qed. + +Lemma is_cvg_int_max_approxRN_seq A : + measurable A -> cvg ((fun n => \int[mu]_(x in A) F_ n x) @ \oo). +Proof. +move=> mA; apply: ereal_nondecreasing_is_cvgn => a b ab. +apply: ge0_le_integral => //. +- by move=> ? ?; exact: max_approxRN_seq_ge0. +- by apply: measurable_funS (measurable_max_approxRN_seq a). +- by move=> ? ?; exact: max_approxRN_seq_ge0. +- exact: measurable_funS (measurable_max_approxRN_seq b). +- by move=> x _; exact: max_approxRN_seq_nd. +Qed. + +Definition is_max_approxRN m j := + [set x | F_ m x = g_ j x /\ forall k, (k < j)%N -> g_ k x < g_ j x]. + +Let E := is_max_approxRN. + +Lemma is_max_approxRNE m j : E m j = [set x| F_ m x = g_ j x] `&` + [set x |forall k, (k < j)%nat -> g_ k x < g_ j x]. +Proof. by apply/seteqP; split. Qed. + +Lemma trivIset_is_max_approxRN n : trivIset [set: nat] (E n). +Proof. +apply/trivIsetP => /= i j _ _ ij. +apply/seteqP; split => // x []; rewrite /E/= => -[+ + [+ +]]. +wlog : i j ij / (i < j)%N. + move=> h Fmgi iFm Fmgj jFm. + have := ij; rewrite neq_lt => /orP[ji|ji]; first exact: (h i j). + by apply: (h j i) => //; rewrite eq_sym. +by move=> {}ij Fmgi h Fmgj => /(_ _ ij); rewrite -Fmgi -Fmgj ltxx. +Qed. + +Lemma bigsetU_is_max_approxRN m : \big[setU/set0]_(j < m.+1) E m j = [set: T]. +Proof. +apply/seteqP; split => // x _; rewrite -bigcup_mkord. +pose j := [arg max_(j > @ord0 m) g_ j x]%O. +have j0_proof : exists k, (k < m.+1)%N && (g_ k x == g_ j x). + by exists j => //; rewrite eqxx andbT. +pose j0 := ex_minn j0_proof. +have j0m : (j0 < m.+1)%N by rewrite /j0; case: ex_minnP => // ? /andP[]. +have j0max k : (k < j0)%N -> g_ k x < g_ j0 x. + rewrite /j0; case: ex_minnP => //= j' /andP[j'm j'j] h kj'. + rewrite lt_neqAle; apply/andP; split; last first. + rewrite (eqP j'j) /j; case: arg_maxP => //= i _. + by move/(_ (Ordinal (ltn_trans kj' j'm))); exact. + apply/negP => /eqP gkj'. + have := h k; rewrite -(eqP j'j) -gkj' eqxx andbT (ltn_trans kj' j'm). + by move=> /(_ erefl); rewrite leqNgt kj'. +exists j0 => //; split. + rewrite /F_ /max_approxRN_seq (bigmax_eq_arg _ ord0)//; last first. + by move=> ? _; rewrite leNye. + rewrite /j0/=; case: ex_minnP => //= j' /andP[j'm /eqP]. + by rewrite /g_ => -> h. +by move=> k kj; exact: j0max. +Qed. + +Lemma measurable_is_max_approxRN m j : measurable (E m j). +Proof. +rewrite is_max_approxRNE; apply: measurableI => /=. + rewrite -[X in measurable X]setTI. + by apply: emeasurable_fun_eq => //; [exact: measurable_max_approxRN_seq| + exact: measurable_approxRN_seq]. +rewrite [T in measurable T](_ : _ = \bigcap_(k in `I_j) [set x | g_ k x < g_ j x])//. +apply: bigcap_measurable => k _. +rewrite -[X in measurable X]setTI; apply: emeasurable_fun_lt => //; +exact: measurable_approxRN_seq. +Qed. + +End approxRN_seq. +End approxRN_seq. + +Module lim_max_approxRN_seq. +Section lim_max_approxRN_seq. +Context d (T : measurableType d) (R : realType). +Variables mu nu : {finite_measure set T -> \bar R}. + +Import approxRN. + +Let G := approxRN mu nu. +Let M := sup_int_approxRN mu nu. + +Import approxRN_seq. + +Let g := approxRN_seq mu nu. +Let F := max_approxRN_seq mu nu. + +Definition fRN := fun x => lim (F ^~ x @ \oo). + +Lemma measurable_fun_fRN : measurable_fun [set: T] fRN. +Proof. +rewrite (_ : fRN = fun x => limn_esup (F ^~ x)). + apply: measurable_fun_limn_esup => // n. + exact: measurable_max_approxRN_seq. +apply/funext=> n; rewrite is_cvg_limn_esupE//. +exact: is_cvg_max_approxRN_seq. +Qed. + +Lemma fRN_ge0 x : 0 <= fRN x. +Proof. +apply: lime_ge => //; first exact: is_cvg_max_approxRN_seq. +by apply: nearW => ?; exact: max_approxRN_seq_ge0. +Qed. + +Let int_fRN_lim A : measurable A -> + \int[mu]_(x in A) fRN x = lim (\int[mu]_(x in A) F n x @[n --> \oo]). +Proof. +move=> mA; rewrite monotone_convergence// => n. +- exact: measurable_funS (measurable_max_approxRN_seq mu nu n). +- by move=> ? ?; exact: max_approxRN_seq_ge0. +- by move=> ?; exact: max_approxRN_seq_nd. +Qed. + +Let E m j := is_max_approxRN mu nu m j. + +Let int_F_nu m A (mA : measurable A) : \int[mu]_(x in A) F m x <= nu A. +Proof. +rewrite [leLHS](_ : _ = + \sum_(j < m.+1) \int[mu]_(x in (A `&` E m j)) F m x); last first. + rewrite -[in LHS](setIT A) -(bigsetU_is_max_approxRN mu nu m) big_distrr/=. + rewrite -(@big_mkord _ _ _ m.+1 xpredT (fun i => A `&` is_max_approxRN mu nu m i)). + rewrite ge0_integral_bigsetU ?big_mkord//. + - by move=> n; apply: measurableI => //; exact: measurable_is_max_approxRN. + - exact: iota_uniq. + - apply: trivIset_setIl; apply: (@sub_trivIset _ _ _ setT (E m)) => //. + exact: trivIset_is_max_approxRN. + - by apply: measurable_funTS => //; exact: measurable_max_approxRN_seq. + - by move=> ? ?; exact: max_approxRN_seq_ge0. +rewrite [leLHS](_ : _ = + \sum_(j < m.+1) (\int[mu]_(x in (A `&` (E m j))) g j x)); last first. + apply: eq_bigr => i _; apply:eq_integral => x; rewrite inE => -[?] [] Fmgi h. + by apply/eqP; rewrite eq_le; rewrite /F Fmgi lexx. +rewrite [leRHS](_ : _ = \sum_(j < m.+1) (nu (A `&` E m j))); last first. + rewrite -(@measure_semi_additive _ _ _ nu (fun i => A `&` E m i))//. + - by rewrite -big_distrr/= bigsetU_is_max_approxRN// setIT. + - by move=> k; apply: measurableI => //; exact: measurable_is_max_approxRN. + - by apply: trivIset_setIl => //; exact: trivIset_is_max_approxRN. + - apply: bigsetU_measurable => /= i _; apply: measurableI => //. + exact: measurable_is_max_approxRN. +apply: lee_sum => //= i _. +have [+ _] := approxRN_seq_prop mu nu i. +rewrite inE /G/= => -[_ _]; apply. +by apply: measurableI => //; exact: measurable_is_max_approxRN. +Qed. + +Let F_G m : F m \in G. +Proof. +rewrite inE /G/=; split => //. +- by move=> ?; exact: max_approxRN_seq_ge0. +- apply/integrableP; split; first exact: measurable_max_approxRN_seq. + under eq_integral. + by move=> x _; rewrite gee0_abs; last exact: max_approxRN_seq_ge0; over. + have /le_lt_trans := int_F_nu m measurableT; apply. + by apply: fin_num_fun_lty; exact: fin_num_measure. +- by move=> A; exact: int_F_nu. +Qed. + +Let M_g_F m : M - m.+1%:R^-1%:E < \int[mu]_x g m x /\ + \int[mu]_x g m x <= \int[mu]_x F m x <= M. +Proof. +split; first by have [] := approxRN_seq_prop mu nu m. +apply/andP; split; last first. + by apply: ereal_sup_ub; exists (F m) => //; have := F_G m; rewrite inE. +apply: ge0_le_integral => //. +- by move=> x _; exact: approxRN_seq_ge0. +- exact: measurable_approxRN_seq. +- by move=> ? *; exact: max_approxRN_seq_ge0. +- exact: measurable_max_approxRN_seq. +- by move=> ? _; exact: max_approxRN_seq_ge. +Qed. + +Lemma int_fRN_lty : \int[mu]_x `|fRN x| < +oo. +Proof. +rewrite (@le_lt_trans _ _ M)//; last exact: sup_int_approxRN_lty. +under eq_integral. + by move=> x _; rewrite gee0_abs; last exact: fRN_ge0; over. +rewrite int_fRN_lim// lime_le//; first exact: is_cvg_int_max_approxRN_seq. +by apply: nearW => n; have [_ /andP[_ ]] := M_g_F n. +Qed. + +Lemma int_fRN_ub A : measurable A -> \int[mu]_(x in A) fRN x <= nu A. +Proof. +move=> mA; rewrite int_fRN_lim// lime_le //. + exact: is_cvg_int_max_approxRN_seq. +by apply: nearW => n; exact: int_F_nu. +Qed. + +Lemma int_fRNE : \int[mu]_x fRN x = M. +Proof. +apply/eqP; rewrite eq_le; apply/andP; split. + rewrite int_fRN_lim// lime_le//; first exact: is_cvg_int_max_approxRN_seq. + by apply: nearW => n; have [_ /andP[_]] := M_g_F n. +rewrite int_fRN_lim//. +have cvgM : (M - m.+1%:R^-1%:E) @[m --> \oo] --> M. + rewrite -[X in _ --> X]sube0; apply: cvgeB. + + by rewrite fin_num_adde_defl. + + exact: cvg_cst. + + apply/fine_cvgP; split; first exact: nearW. + rewrite [X in X @ _ --> _](_ : _ = (fun x => x.+1%:R^-1))//. + apply/gtr0_cvgV0; first exact: nearW. + apply/cvgrnyP. + rewrite [X in X @ _](_ : _ = fun n => n + 1)%N; first exact: cvg_addnr. + by apply/funext => n; rewrite addn1. +apply: (@le_trans _ _ (lim (M - m.+1%:R^-1%:E @[m --> \oo]))). + by move/cvg_lim : cvgM => ->. +apply: lee_lim; [by apply/cvg_ex; exists M|exact: is_cvg_int_max_approxRN_seq|]. +apply: nearW => m. +by have [/[swap] /andP[? _] /ltW/le_trans] := M_g_F m; exact. +Qed. + +Section ab_absurdo. +Context A (mA : measurable A) (h : \int[mu]_(x in A) fRN x < nu A). + +Lemma epsRN_ex : + {eps : {posnum R} | \int[mu]_(x in A) (fRN x + eps%:num%:E) < nu A}. +Proof. +have [muA0|] := eqVneq (mu A) 0. + exists (PosNum ltr01). + under eq_integral. + move=> x _; rewrite -(@gee0_abs _ (_ + _)); last first. + by rewrite adde_ge0// fRN_ge0. + over. + rewrite (@integral_abs_eq0 _ _ _ _ setT)//. + by rewrite (le_lt_trans _ h)// integral_ge0// => x Ax; exact: fRN_ge0. + by apply: emeasurable_funD => //; exact: measurable_fun_fRN. +rewrite neq_lt ltNge measure_ge0//= => muA_gt0. +pose mid := ((fine (nu A) - fine (\int[mu]_(x in A) fRN x)) / 2)%R. +pose e := (mid / fine (mu A))%R. +have ? : \int[mu]_(x in A) fRN x \is a fin_num. + rewrite ge0_fin_numE// ?(lt_le_trans h)// ?leey// integral_ge0//. + by move=> x Ax; exact: fRN_ge0. +have e_gt0 : (0 < e)%R. + rewrite /e divr_gt0//; last first. + by rewrite fine_gt0// muA_gt0/= ltey_eq fin_num_measure. + by rewrite divr_gt0// subr_gt0// fine_lt// fin_num_measure. +exists (PosNum e_gt0); rewrite ge0_integralD//; last 2 first. + by move=> x Ax; exact: fRN_ge0. + exact: measurable_funS measurable_fun_fRN. +rewrite integral_cst// -lte_subr_addr//; last first. + by rewrite fin_numM// fin_num_measure. +rewrite -[X in _ * X](@fineK _ (mu A)) ?fin_num_measure//. +rewrite -EFinM -mulrA mulVr ?mulr1; last first. + by rewrite unitfE gt_eqF// fine_gt0// muA_gt0/= ltey_eq fin_num_measure. +rewrite lte_subr_addl// addeC -lte_subr_addl//; last first. +rewrite -(@fineK _ (nu A))// ?fin_num_measure// -[X in _ - X](@fineK _)//. +rewrite -EFinB lte_fin /mid ltr_pdivrMr// ltr_pMr// ?ltr1n// subr_gt0. +by rewrite fine_lt// fin_num_measure. +Qed. + +Definition epsRN := sval epsRN_ex. + +Definition sigmaRN B := nu B - \int[mu]_(x in B) (fRN x + epsRN%:num%:E). + +Let sigmaRN0 : sigmaRN set0 = 0. +Proof. +by rewrite /sigmaRN measure0 integral_set0 subee. +Qed. + +Let fin_num_int_fRN_eps B : measurable B -> + \int[mu]_(x in B) (fRN x + epsRN%:num%:E) \is a fin_num. +Proof. +move=> mB; rewrite ge0_integralD//; last 2 first. + by move=> x Bx; exact: fRN_ge0. + exact: measurable_funS measurable_fun_fRN. +rewrite fin_numD integral_cst// fin_numM ?fin_num_measure// andbT. +rewrite ge0_fin_numE ?measure_ge0//; last first. + by apply: integral_ge0 => x Bx; exact: fRN_ge0. +rewrite (le_lt_trans _ int_fRN_lty)//. +under [in leRHS]eq_integral. + move=> x _; rewrite gee0_abs; last first. + exact: fRN_ge0. + over. +apply: subset_integral => //; first exact: measurable_fun_fRN. +by move=> x _; exact: fRN_ge0. +Qed. + +Let fin_num_sigmaRN B : measurable B -> sigmaRN B \is a fin_num. +Proof. +move=> mB; rewrite /sigmaRN fin_numB fin_num_measure//=. +exact: fin_num_int_fRN_eps. +Qed. + +Let sigmaRN_sigma_additive : semi_sigma_additive sigmaRN. +Proof. +move=> H mH tH mUH. +rewrite [X in X @ _ --> _](_ : _ = (fun n => \sum_(0 <= i < n) nu (H i) - + \sum_(0 <= i < n) \int[mu]_(x in H i) (fRN x + epsRN%:num%:E))); last first. + apply/funext => n; rewrite big_split/= fin_num_sumeN// => i _. + by rewrite fin_num_int_fRN_eps. +apply: cvgeB. +- by rewrite adde_defC fin_num_adde_defl// fin_num_measure. +- exact: measure_semi_sigma_additive. +- rewrite (ge0_integral_bigcup mH _ _ tH). + + have /cvg_ex[/= l hl] : cvg ((fun n => + \sum_(0 <= i < n) \int[mu]_(y in H i) (fRN y + epsRN%:num%:E)) @ \oo). + apply: is_cvg_ereal_nneg_natsum => n _. + by apply: integral_ge0 => x _; rewrite adde_ge0//; exact: fRN_ge0. + by rewrite (@cvg_lim _ _ _ _ _ _ l). + + apply: integrableD => //=. + * apply: (integrableS measurableT) => //. + by apply/integrableP; split; [exact:measurable_fun_fRN|exact:int_fRN_lty]. + * apply/integrableP; split => //. + by rewrite integral_cst// lte_mul_pinfty// ltey_eq fin_num_measure. + + by move=> x _; rewrite adde_ge0//; exact: fRN_ge0. +Qed. + +HB.instance Definition _ := @isCharge.Build _ _ _ sigmaRN + sigmaRN0 fin_num_sigmaRN sigmaRN_sigma_additive. + +End ab_absurdo. + +End lim_max_approxRN_seq. +End lim_max_approxRN_seq. + +Section radon_nikodym_finite. +Context d (T : measurableType d) (R : realType). +Variables mu nu : {finite_measure set T -> \bar R}. + +Import approxRN. + +Let G := approxRN mu nu. +Let M := sup_int_approxRN mu nu. + +Import lim_max_approxRN_seq. + +Let f := fRN mu nu. +Let mf := measurable_fun_fRN. +Let f_ge0 := fRN_ge0. + +Lemma radon_nikodym_finite : nu `<< mu -> exists f : T -> \bar R, + [/\ forall x, f x >= 0, mu.-integrable [set: T] f & + forall E, measurable E -> nu E = \int[mu]_(x in E) f x]. +Proof. +move=> nu_mu; exists f; split. + - by move=> x; exact: f_ge0. + - by apply/integrableP; split; [exact: mf|exact: int_fRN_lty]. +move=> // A mA. +apply/eqP; rewrite eq_le int_fRN_ub// andbT leNgt; apply/negP => abs. +pose sigma : {charge set T -> \bar R} := + [the {charge set T -> \bar R} of sigmaRN mA abs]. +have [P [N [[mP posP] [mN negN] PNX PN0]]] := Hahn_decomposition sigma. +pose AP := A `&` P. +have mAP : measurable AP by exact: measurableI. +have muAP_gt0 : 0 < mu AP. + rewrite lt0e measure_ge0// andbT. + apply/eqP/(contra_not (nu_mu _ mAP))/eqP; rewrite gt_eqF//. + rewrite (@lt_le_trans _ _ (sigma AP))//. + rewrite (@lt_le_trans _ _ (sigma A))//; last first. + rewrite (charge_partition _ _ mP mN)// gee_addl//. + by apply: negN => //; exact: measurableI. + by rewrite sube_gt0// (proj2_sig (epsRN_ex mA abs)). + rewrite /sigma/= /sigmaRN lee_subel_addl ?fin_num_measure//. + by rewrite lee_paddl// integral_ge0// => x _; rewrite adde_ge0//; exact: f_ge0. +pose h x := if x \in AP then f x + (epsRN mA abs)%:num%:E else f x. +have mh : measurable_fun setT h. + apply: measurable_fun_if => //. + - by apply: (measurable_fun_bool true); rewrite preimage_mem_true. + - by apply: measurable_funTS; apply: emeasurable_funD => //; exact: mf. + - by apply: measurable_funTS; exact: mf. +have hge0 x : 0 <= h x. + by rewrite /h; case: ifPn => [_|?]; [rewrite adde_ge0// f_ge0|exact: f_ge0]. +have hnuP S : measurable S -> S `<=` AP -> \int[mu]_(x in S) h x <= nu S. + move=> mS SAP. + have : 0 <= sigma S. + by apply: posP => //; apply: (subset_trans SAP); exact: subIsetr. + rewrite sube_ge0; last by rewrite fin_num_measure// orbT. + apply: le_trans; rewrite le_eqVlt; apply/orP; left; apply/eqP. + rewrite -{1}(setIid S) integral_mkcondr; apply/eq_integral => x /[!inE] Sx. + by rewrite /restrict /h !ifT// inE//; exact: SAP. +have hnuN S : measurable S -> S `<=` ~` AP -> \int[mu]_(x in S) h x <= nu S. + move=> mS ScAP; rewrite /h; under eq_integral. + move=> x xS; rewrite ifF; last first. + by apply/negbTE; rewrite notin_set; apply: ScAP; apply: set_mem. + over. + exact: int_fRN_ub. +have hnu S : measurable S -> \int[mu]_(x in S) h x <= nu S. + move=> mS. + rewrite -(setD0 S) -(setDv AP) setDDr. + have mSIAP : measurable (S `&` AP) by exact: measurableI. + have mSDAP : measurable (S `\` AP) by exact: measurableD. + rewrite integral_setU //. + - rewrite measureU//. + by apply: lee_add; [exact: hnuN|exact: hnuP]. + by rewrite setDE setIACA setICl setI0. + - exact: measurable_funTS. + - by rewrite disj_set2E setDE setIACA setICl setI0. +have int_h_M : \int[mu]_x h x > M. + have mCAP := measurableC mAP. + have disj_AP : [disjoint AP & ~` AP] by exact/disj_set2P/setICr. + rewrite -(setUv AP) integral_setU ?setUv// /h. + under eq_integral do rewrite ifT//. + under [X in _ < _ + X]eq_integral. + by move=> x; rewrite inE /= => xE0p; rewrite memNset//; over. + rewrite ge0_integralD//; last 2 first. + - by move=> x _; exact: f_ge0. + - by apply: measurable_funTS; exact: mf. + rewrite integral_cst // addeAC -integral_setU//; last 2 first. + by rewrite setUv//; exact: mf. + by move=> x _; exact: f_ge0. + rewrite setUv int_fRNE -lte_subel_addl; last first. + rewrite ge0_fin_numE// ?sup_int_approxRN_lty//. + exact: approxRN_seq.sup_int_approxRN_lty. + exact: sup_int_approxRN_ge0. + by rewrite /M subee ?mule_gt0// approxRN_seq.sup_int_approxRN_fin_num. +have Gh : G h. + split=> //; apply/integrableP; split => //. + under eq_integral do rewrite gee0_abs//. + by rewrite (le_lt_trans (hnu _ measurableT))// ltey_eq fin_num_measure. +have : \int[mu]_x h x <= M. + rewrite -(ereal_sup1 (\int[mu]_x h x)). + rewrite (@le_ereal_sup _ [set \int[mu]_x h x] (int_approxRN mu nu))//. + by rewrite sub1set inE; exists h. +by rewrite leNgt int_h_M. +Qed. + +End radon_nikodym_finite. + +Section radon_nikodym_sigma_finite. +Context d (T : measurableType d) (R : realType). +Variables (mu : {sigma_finite_measure set T -> \bar R}) + (nu : {finite_measure set T -> \bar R}). + +Lemma radon_nikodym_sigma_finite : nu `<< mu -> + exists f : T -> \bar R, [/\ forall x, f x >= 0, forall x, f x \is a fin_num, + mu.-integrable [set: T] f & + forall A, measurable A -> nu A = \int[mu]_(x in A) f x]. +Proof. +move=> nu_mu; have [F TF /all_and2[mF muFoo]] := sigma_finiteT mu. +pose E := seqDU F. +have mE k : measurable (E k). + by apply: measurableD => //; exact: bigsetU_measurable. +have muEoo k : mu (E k) < +oo. + by rewrite (le_lt_trans _ (muFoo k))// le_measure ?inE//; exact: subDsetl. +have UET : \bigcup_i E i = [set: T] by rewrite TF [RHS]seqDU_bigcup_eq. +have tE := trivIset_seqDU F. +pose mu_ j : {finite_measure set T -> \bar R} := + [the {finite_measure set _ -> \bar _} of mfrestr (mE j) (muEoo j)]. +have nuEoo i : nu (E i) < +oo by rewrite ltey_eq fin_num_measure. +pose nu_ j : {finite_measure set T -> \bar R} := + [the {finite_measure set _ -> \bar _} of mfrestr (mE j) (nuEoo j)]. +have nu_mu_ k : nu_ k `<< mu_ k. + by move=> S mS mu_kS0; apply: nu_mu => //; exact: measurableI. +have [g_] := choice (fun j => radon_nikodym_finite (nu_mu_ j)). +move=> /all_and3[g_ge0 ig_ int_gE]. +pose f_ j x := if x \in E j then g_ j x else 0. +have f_ge0 k x : 0 <= f_ k x by rewrite /f_; case: ifP. +have mf_ k : measurable_fun setT (f_ k). + apply: measurable_fun_if => //. + - by apply: (measurable_fun_bool true); rewrite preimage_mem_true. + - rewrite preimage_mem_true. + by apply: measurable_funTS => //; have /integrableP[] := ig_ k. +have if_T k : integrable mu setT (f_ k). + apply/integrableP; split => //. + under eq_integral do rewrite gee0_abs//. + rewrite -(setUv (E k)) integral_setU //; last 3 first. + - exact: measurableC. + - by rewrite setUv. + - exact/disj_set2P/subsets_disjoint. + rewrite /f_; under eq_integral do rewrite ifT//. + rewrite (@eq_measure_integral _ _ _ (E k) (mu_ k)); last first. + by move=> A mA AEj; rewrite /mu_ /= /mfrestr /mrestr setIidl. + rewrite -int_gE ?inE//. + under eq_integral. + move=> x /[!inE] /= Ekx; rewrite ifF; last by rewrite memNset. + over. + by rewrite integral0 ?adde0 ltey_eq fin_num_measure. +have int_f_E j S : measurable S -> \int[mu]_(x in S) f_ j x = nu (S `&` E j). + move=> mS. + have mSIEj := measurableI _ _ mS (mE j). + have mSDEj := measurableD mS (mE j). + rewrite -{1}(setUIDK S (E j)) (integral_setU _ mSIEj mSDEj)//; last 2 first. + - by rewrite setUIDK; exact: (measurable_funS measurableT). + - by apply/disj_set2P; rewrite setDE setIACA setICr setI0. + rewrite /f_ -(eq_integral _ (g_ j)); last first. + by move=> x /[!inE] SIEjx; rewrite /f_ ifT// inE; exact: (@subIsetr _ S). + rewrite (@eq_measure_integral _ _ _ (S `&` E j) (mu_ j)); last first. + move=> A mA; rewrite subsetI => -[_ ?]; rewrite /mu_ /=. + by rewrite /mfrestr /mrestr setIidl. + rewrite -int_gE; last exact: measurableI. + under eq_integral. + move=> x; rewrite inE setDE /= => -[_ Ejx]. + rewrite ifF; last by rewrite memNset. + over. + by rewrite integral0 adde0 /nu_/= /mfrestr /mrestr -setIA setIid. +pose f x : \bar R := \sum_(j i _; rewrite int_f_E// setTI. + rewrite -UET measure_bigcup//. + by apply: eq_eseriesl => // x; rewrite in_setT. +have mf : measurable_fun setT f by exact: ge0_emeasurable_fun_sum. +have fi : mu.-integrable setT f. + apply/integrableP; split => //. + under eq_integral do (rewrite gee0_abs; last exact: nneseries_ge0). + by rewrite int_f_nuT ltey_eq fin_num_measure. +have ae_f := integrable_ae measurableT fi. +pose f' x := if f x \is a fin_num then f x else 0. +have ff' : ae_eq mu setT f f'. + case: ae_f => N [mN N0 fN]; exists N; split => //. + apply: subset_trans fN; apply: subsetC => z/= /(_ I) fz _. + by rewrite /f' fz. +have mf' : measurable_fun setT f'. + apply: measurable_fun_ifT => //; apply: (measurable_fun_bool true) => /=. + by have := emeasurable_fin_num measurableT mf; rewrite setTI. +exists f'; split. +- by move=> t; rewrite /f'; case: ifPn => // ?; exact: nneseries_ge0. +- by move=> t; rewrite /f'; case: ifPn. +- apply/integrableP; split => //; apply/abse_integralP => //. + move/ae_eq_integral : (ff') => /(_ measurableT mf) <-//. + by apply/abse_integralP => //; move/integrableP : fi => []. +have nuf A : d.-measurable A -> nu A = \int[mu]_(x in A) f x. + move=> mA; rewrite integral_nneseries//; last first. + by move=> n; exact: measurable_funTS. + rewrite nneseries_esum; last by move=> m _; rewrite integral_ge0. + under eq_esum do rewrite int_f_E//. + rewrite -nneseries_esum; last first. + by move=> n; rewrite measure_ge0//; exact: measurableI. + rewrite (@eq_eseriesl _ _ (fun x => x \in [set: nat])); last first. + by move=> x; rewrite in_setT. + rewrite -measure_bigcup//. + - by rewrite -setI_bigcupr UET setIT. + - by move=> i _; exact: measurableI. + - exact: trivIset_setIl. +move=> A mA; rewrite nuf ?inE//; apply: ae_eq_integral => //. +- exact/measurable_funTS. +- exact/measurable_funTS. +- exact: ae_eq_subset ff'. +Qed. + +End radon_nikodym_sigma_finite. + +Module Radon_Nikodym_SigmaFinite. +Section radon_nikodym_sigma_finite_def. +Context d (T : measurableType d) (R : realType). +Variables (nu : {finite_measure set T -> \bar R}) + (mu : {sigma_finite_measure set T -> \bar R}). + +Definition f : T -> \bar R := + match pselect (nu `<< mu) with + | left nu_mu => sval (cid (radon_nikodym_sigma_finite nu_mu)) + | right _ => cst -oo + end. + +Lemma f_ge0 : nu `<< mu -> forall x, 0 <= f x. +Proof. by rewrite /f; case: pselect => // numu _; case: cid => x []. Qed. + +Lemma f_fin_num : nu `<< mu -> forall x, f x \is a fin_num. +Proof. by rewrite /f; case: pselect => // numu _; case: cid => x []. Qed. + +Lemma f_integrable : nu `<< mu -> mu.-integrable [set: T] f. +Proof. by rewrite /f; case: pselect => // numu _; case: cid => x []. Qed. + +Lemma f_integral : nu `<< mu -> forall A, measurable A -> + nu A = \int[mu]_(x in A) f x. +Proof. by rewrite /f; case: pselect => // numu _; case: cid => x []. Qed. + +End radon_nikodym_sigma_finite_def. + +Section integrableM. +Context d (T : measurableType d) (R : realType). +Variables (nu : {finite_measure set T -> \bar R}) + (mu : {sigma_finite_measure set T -> \bar R}). +Hypothesis numu : nu `<< mu. +Implicit Types f : T -> \bar R. + +Local Notation "'d nu '/d mu" := (f nu mu). + +Lemma change_of_variables f E : (forall x, 0 <= f x) -> + measurable E -> measurable_fun E f -> + \int[mu]_(x in E) (f x * ('d nu '/d mu) x) = \int[nu]_(x in E) f x. +Proof. +move=> f0 mE mf; set g := 'd nu '/d mu. +have [h [ndh hf]] := approximation mE mf (fun x _ => f0 x). +have -> : \int[nu]_(x in E) f x = + lim (\int[nu]_(x in E) (EFin \o h n) x @[n --> \oo]). + have fE x : E x -> f x = lim ((EFin \o h n) x @[n --> \oo]). + by move=> Ex; apply/esym/cvg_lim => //; exact: hf. + under eq_integral => x /[!inE] /fE -> //. + apply: monotone_convergence => //. + - move=> n; apply/EFin_measurable_fun. + by apply: (measurable_funS measurableT) => //; exact/measurable_funP. + - by move=> n x Ex //=; rewrite lee_fin. + - by move=> x Ex a b /ndh /=; rewrite lee_fin => /lefP. +have -> : \int[mu]_(x in E) (f \* g) x = + lim (\int[mu]_(x in E) ((EFin \o h n) \* g) x @[n --> \oo]). + have fg x :E x -> f x * g x = lim (((EFin \o h n) \* g) x @[n --> \oo]). + by move=> Ex; apply/esym/cvg_lim => //; apply: cvgeMr; + [exact: f_fin_num|exact: hf]. + under eq_integral => x /[!inE] /fg -> //. + apply: monotone_convergence => [//| | |]. + - move=> n; apply/emeasurable_funM; apply/measurable_funTS. + exact/EFin_measurable_fun. + exact: measurable_int (f_integrable _). + - by move=> n x Ex //=; rewrite mule_ge0 ?lee_fin//=; exact: f_ge0. + - by move=> x Ex a b /ndh /= /lefP hahb; rewrite lee_wpmul2r ?lee_fin// f_ge0. +suff suf n : \int[mu]_(x in E) ((EFin \o h n) x * g x) = + \int[nu]_(x in E) (EFin \o h n) x. + by under eq_fun do rewrite suf. +transitivity (\int[nu]_(x in E) + (\sum_(y \in range (h n)) (y * \1_(h n @^-1` [set y]) x)%:E)); last first. + by apply: eq_integral => t tE; rewrite /= fimfunE -fsumEFin. +have indich m r : measurable_fun E (fun x => (r * \1_(h m @^-1` [set r]) x)%:E). + by apply: (measurable_comp measurableT) => //; exact: measurable_funM. +rewrite ge0_integral_fsum//; last by move=> m y Ey; exact: nnfun_muleindic_ge0. +transitivity (\int[mu]_(x in E) (\sum_(y \in range (h n)) + (y * \1_(h n @^-1` [set y]) x)%:E * g x)). + under [RHS]eq_integral => x xE. + rewrite -ge0_mule_fsuml => [|y]; last exact: nnfun_muleindic_ge0. + rewrite fsumEFin // -(fimfunE _ x); over. + by []. +rewrite ge0_integral_fsum//; last 2 first. + - move=> y; apply: emeasurable_funM => //; apply: measurable_funTS. + exact: measurable_int (f_integrable _). + - by move=> m y Ey; rewrite mule_ge0 ?f_ge0// nnfun_muleindic_ge0. +apply: eq_fsbigr => r rhn. +under [RHS]eq_integral do rewrite EFinM. +rewrite integralZl_indic_nnsfun => //. +under eq_integral do rewrite EFinM -muleA. +rewrite ge0_integralZl//. + congr *%E. + under eq_integral do rewrite muleC. + under [RHS]eq_integral do rewrite -[_%:E]mul1e -/(idfun 1). + rewrite -(integral_setI_indic _ _)// -(integral_setI_indic _ _)//. + by rewrite -f_integral//= integral_cst ?mul1e. +- apply: emeasurable_funM; first exact/EFin_measurable_fun. + exact/measurable_funTS/(measurable_int (f_integrable _)). +- by move=> t Et; rewrite mule_ge0// ?lee_fin//; exact: f_ge0. +- by move: rhn; rewrite inE => -[t _ <-]; rewrite lee_fin. +Qed. + +Lemma integrableM f E : (forall x, 0 <= f x) -> measurable E -> + nu.-integrable E f -> mu.-integrable E (f \* 'd nu '/d mu). +Proof. +move=> f0 mE intEf; apply/integrableP; split. + apply: emeasurable_funM; first exact: (@measurable_int _ _ _ nu). + exact/measurable_funTS/(measurable_int (f_integrable _)). +under eq_integral. + move=> x _; rewrite gee0_abs; last first. + by apply: mule_ge0=> //; exact: f_ge0. + over. +rewrite change_of_variables//; last exact: (@measurable_int _ _ _ nu). +by move/integrableP : intEf=> [mf +]; under eq_integral do rewrite gee0_abs//. +Qed. + +End integrableM. + +Section chain_rule. +Context d (T : measurableType d) (R : realType). +Variables (nu : {finite_measure set T -> \bar R}) + (la : {sigma_finite_measure set T -> \bar R}) + (mu : {finite_measure set T -> \bar R}). + +Local Notation "'d nu '/d mu" := (f nu mu). + +Lemma chain_rule E : nu `<< mu -> mu `<< la -> measurable E -> + ae_eq la E ('d nu '/d la) ('d nu '/d mu \* 'd mu '/d la). +Proof. +move=> numu mula mE; have nula := measure_dominates_trans numu mula. +have mf : measurable_fun E ('d nu '/d mu). + exact/measurable_funTS/(measurable_int (f_integrable _)). +have [h [ndh hf]] := approximation mE mf (fun x _ => f_ge0 numu x). +apply: integral_ae_eq => //. +- apply: (integrableS measurableT) => //. + apply: f_integrable. + exact: (measure_dominates_trans numu mula). +- apply: emeasurable_funM => //. + exact/measurable_funTS/(measurable_int (f_integrable _)). +- move=> A AE mA; rewrite change_of_variables//. + + by rewrite -!f_integral. + + exact: f_ge0. + + exact: measurable_funS mf. +Qed. + +End chain_rule. +End Radon_Nikodym_SigmaFinite. + +Section radon_nikodym. +Context d (T : measurableType d) (R : realType). +Variables (nu : {charge set T -> \bar R}) + (mu : {sigma_finite_measure set T -> \bar R}). + +Local Lemma Radon_Nikodym0 : nu `<< mu -> + exists f : T -> \bar R, [/\ (forall x, f x \is a fin_num), + mu.-integrable [set: T] f & + forall A, measurable A -> nu A = \int[mu]_(x in A) f x]. +Proof. +move=> nu_mu; have [P [N nuPN]] := Hahn_decomposition nu. +have [fp [fp0 fpfin intfp fpE]] := @radon_nikodym_sigma_finite _ _ _ mu + [the {finite_measure set _ -> \bar _} of jordan_pos nuPN] + (jordan_pos_dominates nuPN nu_mu). +have [fn [fn0 fnfin intfn fnE]] := @radon_nikodym_sigma_finite _ _ _ mu + [the {finite_measure set _ -> \bar _} of jordan_neg nuPN] + (jordan_neg_dominates nuPN nu_mu). +exists (fp \- fn); split; first by move=> x; rewrite fin_numB// fpfin fnfin. + exact: integrableB. +move=> E mE; rewrite [LHS](jordan_decomp nuPN mE)// integralB//; + [|exact: (integrableS measurableT)..]. +rewrite -fpE ?inE// -fnE ?inE//= /cadd/= jordan_posE jordan_negE. +by rewrite /cscale EFinN mulN1e. +Qed. + +Definition Radon_Nikodym : T -> \bar R := + match pselect (nu `<< mu) with + | left nu_mu => sval (cid (Radon_Nikodym0 nu_mu)) + | right _ => cst -oo + end. + +Lemma Radon_NikodymE (numu : nu `<< mu) : + Radon_Nikodym = sval (cid (Radon_Nikodym0 numu)). +Proof. +rewrite /= /Radon_Nikodym; case: pselect => //= numu'. +by congr (sval (cid (Radon_Nikodym0 _))); exact: Prop_irrelevance. +Qed. + +Lemma Radon_Nikodym_fin_num x : nu `<< mu -> + Radon_Nikodym x \is a fin_num. +Proof. by move=> numu; rewrite (Radon_NikodymE numu); case: cid => ? []. Qed. + +Lemma Radon_Nikodym_integrable : nu `<< mu -> + mu.-integrable [set: T] Radon_Nikodym. +Proof. by move=> numu; rewrite (Radon_NikodymE numu); case: cid => ? []. Qed. + +Lemma Radon_Nikodym_integral A : nu `<< mu -> + measurable A -> nu A = \int[mu]_(x in A) Radon_Nikodym x. +Proof. +by move=> numu; rewrite (Radon_NikodymE numu); case: cid => ? [? ?]; exact. +Qed. + +End radon_nikodym. +Notation "'d nu '/d mu" := (Radon_Nikodym nu mu) : charge_scope. + +#[global] Hint Extern 0 (_.-integrable setT ('d _ '/d _)) => + solve [apply: Radon_Nikodym_integrable] : core. +#[global] Hint Extern 0 (measurable_fun setT ('d _ '/d _)) => + solve [apply: measurable_int; exact: Radon_Nikodym_integrable] : core. + +Section Radon_Nikodym_charge_of_finite_measure. +Context d (T : measurableType d) (R : realType). +Variables (nu : {finite_measure set T -> \bar R}) + (mu : {sigma_finite_measure set T -> \bar R}). +Hypothesis numu : nu `<< mu. +Implicit Types f : T -> \bar R. + +Lemma ae_eq_Radon_Nikodym_SigmaFinite E : measurable E -> + ae_eq mu E (Radon_Nikodym_SigmaFinite.f nu mu) + ('d [the charge _ _ of charge_of_finite_measure nu] '/d mu). +Proof. +move=> mE; apply: integral_ae_eq => //. +- apply: (integrableS measurableT) => //. + exact: Radon_Nikodym_SigmaFinite.f_integrable. +- exact: measurable_funTS. +- move=> A AE mA; rewrite -Radon_Nikodym_integral//. + by rewrite -Radon_Nikodym_SigmaFinite.f_integral. +Qed. + +Lemma Radon_Nikodym_change_of_variables f E : measurable E -> + nu.-integrable E f -> + \int[mu]_(x in E) + (f x * ('d [the charge _ _ of charge_of_finite_measure nu] '/d mu) x) = + \int[nu]_(x in E) f x. +Proof. +move=> mE mf; rewrite [in RHS](funeposneg f) integralB //; last 2 first. + - exact: integrable_funepos. + - exact: integrable_funeneg. +rewrite -(ae_eq_integral _ _ _ _ _ + (ae_eq_mul2l f (ae_eq_Radon_Nikodym_SigmaFinite mE)))//; last 2 first. +- apply: emeasurable_funM => //; first exact: measurable_int mf. + apply: measurable_funTS. + exact: measurable_int (Radon_Nikodym_SigmaFinite.f_integrable _). +- apply: emeasurable_funM => //; first exact: measurable_int mf. + exact: measurable_funTS. +rewrite [in LHS](funeposneg f). +under eq_integral => x xE. rewrite muleBl; last 2 first. + - exact: Radon_Nikodym_SigmaFinite.f_fin_num. + - exact: add_def_funeposneg. + over. +rewrite [in LHS]integralB //; last 2 first. +- apply: Radon_Nikodym_SigmaFinite.integrableM => //. + exact: integrable_funepos. +- apply: Radon_Nikodym_SigmaFinite.integrableM => //. + exact: integrable_funeneg. +congr (_ - _) ; rewrite Radon_Nikodym_SigmaFinite.change_of_variables//; + apply: measurable_int; first exact: integrable_funepos mf. +exact: integrable_funeneg mf. +Qed. + +End Radon_Nikodym_charge_of_finite_measure. + +Section radon_nikodym_lemmas. +Context d (T : measurableType d) (R : realType). +Implicit Types (nu : {charge set T -> \bar R}) + (mu : {sigma_finite_measure set T -> \bar R}). + +Lemma Radon_Nikodym_cscale mu nu c E : measurable E -> nu `<< mu -> + ae_eq mu E ('d [the charge _ _ of cscale c nu] '/d mu) + (fun x => c%:E * 'd nu '/d mu x). +Proof. +move=> mE numu; apply: integral_ae_eq => [//| | |A AE mA]. +- apply: (integrableS measurableT) => //. + exact/Radon_Nikodym_integrable/dominates_cscalel. +- exact/measurable_funTS/emeasurable_funM. +- rewrite integralZl//; last first. + by apply: (integrableS measurableT) => //; exact: Radon_Nikodym_integrable. + rewrite -Radon_Nikodym_integral => //; last exact: dominates_cscalel. + by rewrite -Radon_Nikodym_integral. +Qed. + +Lemma Radon_Nikodym_cadd mu nu0 nu1 E : measurable E -> + nu0 `<< mu -> nu1 `<< mu -> + ae_eq mu E ('d [the charge _ _ of cadd nu0 nu1] '/d mu) + ('d nu0 '/d mu \+ 'd nu1 '/d mu). +Proof. +move=> mE nu0mu nu1mu; apply: integral_ae_eq => [//| | |A AE mA]. +- apply: (integrableS measurableT) => //. + by apply: Radon_Nikodym_integrable => /=; exact: dominates_cadd. +- by apply: measurable_funTS => //; exact: emeasurable_funD. +- rewrite integralD //; [|exact: integrableS (Radon_Nikodym_integrable _)..]. + rewrite -Radon_Nikodym_integral //=; last exact: dominates_cadd. + by rewrite -Radon_Nikodym_integral // -Radon_Nikodym_integral. +Qed. + +End radon_nikodym_lemmas. + +Section Radon_Nikodym_chain_rule. +Context d (T : measurableType d) (R : realType). +Variables (nu : {charge set T -> \bar R}) + (la : {sigma_finite_measure set T -> \bar R}) + (mu : {finite_measure set T -> \bar R}). + +Lemma Radon_Nikodym_chain_rule : nu `<< mu -> mu `<< la -> + ae_eq la setT ('d nu '/d la) + ('d nu '/d mu \* + 'd [the charge _ _ of charge_of_finite_measure mu] '/d la). +Proof. +have [Pnu [Nnu nuPN]] := Hahn_decomposition nu. +move=> numu mula; have nula := measure_dominates_trans numu mula. +apply: integral_ae_eq; [exact: measurableT| |exact: emeasurable_funM|]. +- exact: Radon_Nikodym_integrable. +- move=> E _ mE. + rewrite -Radon_Nikodym_integral// Radon_Nikodym_change_of_variables//. + + exact: Radon_Nikodym_integral. + + by apply: (integrableS measurableT) => //; exact: Radon_Nikodym_integrable. +Qed. + +End Radon_Nikodym_chain_rule. diff --git a/theories/constructive_ereal.v b/theories/constructive_ereal.v index 43e906291..6c3c0643b 100644 --- a/theories/constructive_ereal.v +++ b/theories/constructive_ereal.v @@ -9,27 +9,30 @@ (c.f. https://github.com/math-comp/real-closed/pull/29 ) and incorporate it into mathcomp proper where it could then be used for bounds of intervals*) +From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra finmap. -From mathcomp.classical Require Import mathcomp_extra. +From mathcomp Require Import mathcomp_extra. Require Import signed. -(******************************************************************************) -(* Extended real numbers *) +(**md**************************************************************************) +(* # Extended real numbers $\overline{R}$ *) (* *) -(* Given a type R for numbers, \bar R is the type R extended with symbols -oo *) -(* and +oo (notation scope: %E), suitable to represent extended real numbers. *) -(* When R is a numDomainType, \bar R is equipped with a canonical porderType *) -(* and operations for addition/opposite. When R is a realDomainType, \bar R *) -(* is equipped with a Canonical orderType. *) +(* Given a type R for numbers, \bar R is the type R extended with symbols *) +(* -oo and +oo (notation scope: %E), suitable to represent extended real *) +(* numbers. When R is a numDomainType, \bar R is equipped with a canonical *) +(* porderType and operations for addition/opposite. When R is a *) +(* realDomainType, \bar R is equipped with a Canonical orderType. *) (* *) (* Naming convention: in definition/lemma identifiers, "e" stands for an *) (* extended number and "y" and "Ny" for +oo ad -oo respectively. *) -(* *) +(* ``` *) (* \bar R == coproduct of R and {+oo, -oo}; *) (* notation for extended (R:Type) *) (* r%:E == injects real numbers into \bar R *) (* +%E, -%E, *%E == addition/opposite/multiplication for extended *) (* reals *) +(* er_map (f : T -> T') == the \bar T -> \bar T' lifting of f *) +(* sqrte == square root for extended reals *) (* `| x |%E == the absolute value of x *) (* x ^+ n == iterated multiplication *) (* x *+ n == iterated addition *) @@ -46,22 +49,26 @@ Require Import signed. (* (\sum_(i in A) f i)%E == bigop-like notation in scope %E *) (* maxe x y, mine x y == notation for the maximum/minimum of two *) (* extended real numbers *) +(* ``` *) (* *) -(* Signed extended real numbers: *) +(* ## Signed extended real numbers *) +(* ``` *) (* {posnum \bar R} == interface type for elements in \bar R that are *) (* positive, c.f., signed.v, notation in scope %E *) (* {nonneg \bar R} == interface types for elements in \bar R that are *) (* non-negative, c.f. signed.v, notation in scope %E *) (* x%:pos == explicitly casts x to {posnum \bar R}, in scope %E *) (* x%:nng == explicitly casts x to {nonneg \bar R}, in scope %E *) +(* ``` *) (* *) -(* Topology of extended real numbers: *) +(* ## Topology of extended real numbers *) +(* ``` *) (* contract == order-preserving bijective function *) (* from extended real numbers to [-1; 1] *) (* expand == function from real numbers to extended *) (* real numbers that cancels contract in *) (* [-1; 1] *) -(* *) +(* ``` *) (******************************************************************************) Set Implicit Arguments. @@ -69,9 +76,11 @@ Unset Strict Implicit. Unset Printing Implicit Defensive. Reserved Notation "x %:E" (at level 2, format "x %:E"). +Reserved Notation "x %:dE" (at level 2, format "x %:dE"). Reserved Notation "x +? y" (at level 50, format "x +? y"). Reserved Notation "x *? y" (at level 50, format "x *? y"). Reserved Notation "'\bar' x" (at level 2, format "'\bar' x"). +Reserved Notation "'\bar' '^d' x" (at level 2, format "'\bar' '^d' x"). Reserved Notation "{ 'posnum' '\bar' R }" (at level 0, format "{ 'posnum' '\bar' R }"). Reserved Notation "{ 'nonneg' '\bar' R }" (at level 0, @@ -92,6 +101,8 @@ Proof. by move=> a b; case. Qed. Definition dual_extended := extended. +Definition dEFin : forall {R}, R -> dual_extended R := @EFin. + (* Notations in ereal_dual_scope should be kept *before* the corresponding notation in ereal_scope, otherwise when none of the scope is open (lte x y) would be displayed as (x < y)%dE, instead @@ -100,10 +111,13 @@ Notation "+oo" := (@EPInf _ : dual_extended _) : ereal_dual_scope. Notation "+oo" := (@EPInf _) : ereal_scope. Notation "-oo" := (@ENInf _ : dual_extended _) : ereal_dual_scope. Notation "-oo" := (@ENInf _) : ereal_scope. +Notation "r %:dE" := (@EFin _ r%R : dual_extended _) : ereal_dual_scope. +Notation "r %:E" := (@EFin _ r%R : dual_extended _) : ereal_dual_scope. Notation "r %:E" := (@EFin _ r%R). Notation "'\bar' R" := (extended R) : type_scope. -Notation "0" := (0%R%:E : dual_extended _) : ereal_dual_scope. -Notation "0" := (0%R%:E) : ereal_scope. +Notation "'\bar' '^d' R" := (dual_extended R) : type_scope. +Notation "0" := (@GRing.zero (\bar^d _)) : ereal_dual_scope. +Notation "0" := (@GRing.zero (\bar _)) : ereal_scope. Notation "1" := (1%R%:E : dual_extended _) : ereal_dual_scope. Notation "1" := (1%R%:E) : ereal_scope. @@ -121,6 +135,9 @@ Definition er_map T T' (f : T -> T') (x : \bar T) : \bar T' := | -oo => -oo end. +Lemma er_map_idfun T (x : \bar T) : er_map idfun x = x. +Proof. by case: x. Qed. + Definition fine {R : zmodType} x : R := if x is EFin v then v else 0. Section EqEReal. @@ -137,8 +154,7 @@ Definition eq_ereal (x y : \bar R) := Lemma ereal_eqP : Equality.axiom eq_ereal. Proof. by case=> [?||][?||]; apply: (iffP idP) => //= [/eqP|[]] ->. Qed. -Definition ereal_eqMixin := Equality.Mixin ereal_eqP. -Canonical ereal_eqType := Equality.Pack ereal_eqMixin. +HB.instance Definition _ := hasDecEq.Build (\bar R) ereal_eqP. Lemma eqe (r1 r2 : R) : (r1%:E == r2%:E) = (r1 == r2). Proof. by []. Qed. @@ -164,16 +180,14 @@ Definition decode (x : GenTree.tree R) : option (\bar R) := Lemma codeK : pcancel code decode. Proof. by case. Qed. -Definition ereal_choiceMixin := PcanChoiceMixin codeK. -Canonical ereal_choiceType := ChoiceType (extended R) ereal_choiceMixin. +HB.instance Definition _ := Choice.copy (\bar R) (pcan_type codeK). End ERealChoice. Section ERealCount. Variable (R : countType). -Definition ereal_countMixin := PcanCountMixin (@codeK R). -Canonical ereal_countType := CountType (extended R) ereal_countMixin. +HB.instance Definition _ := PCanIsCountable (@codeK R). End ERealCount. @@ -216,11 +230,8 @@ Qed. Fact ereal_display : unit. Proof. by []. Qed. -Definition ereal_porderMixin := - LePOrderMixin lt_def_ereal le_refl_ereal le_anti_ereal le_trans_ereal. - -Canonical ereal_porderType := - POrderType ereal_display (extended R) ereal_porderMixin. +HB.instance Definition _ := Order.isPOrder.Build ereal_display (\bar R) + lt_def_ereal le_refl_ereal le_anti_ereal le_trans_ereal. Lemma leEereal x y : (x <= y)%O = le_ereal x y. Proof. by []. Qed. Lemma ltEereal x y : (x < y)%O = lt_ereal x y. Proof. by []. Qed. @@ -275,6 +286,63 @@ Notation "x < y < z" := ((x < y) && (y < z)) : ereal_scope. Notation "x <= y :> T" := ((x : T) <= (y : T)) (only parsing) : ereal_scope. Notation "x < y :> T" := ((x : T) < (y : T)) (only parsing) : ereal_scope. +Section ERealZsemimodule. +Context {R : nmodType}. +Implicit Types x y z : \bar R. + +Definition adde_subdef x y := + match x, y with + | x%:E , y%:E => (x + y)%:E + | -oo, _ => -oo + | _ , -oo => -oo + | +oo, _ => +oo + | _ , +oo => +oo + end. + +Definition adde := nosimpl adde_subdef. + +Definition dual_adde_subdef x y := + match x, y with + | x%:E , y%:E => (x + y)%R%:E + | +oo, _ => +oo + | _ , +oo => +oo + | -oo, _ => -oo + | _ , -oo => -oo + end. + +Definition dual_adde := nosimpl dual_adde_subdef. + +Lemma addeA_subproof : associative (S := \bar R) adde. +Proof. by case=> [x||] [y||] [z||] //; rewrite /adde /= addrA. Qed. + +Lemma addeC_subproof : commutative (S := \bar R) adde. +Proof. by case=> [x||] [y||] //; rewrite /adde /= addrC. Qed. + +Lemma add0e_subproof : left_id (0%:E : \bar R) adde. +Proof. by case=> // r; rewrite /adde /= add0r. Qed. + +HB.instance Definition _ := GRing.isNmodule.Build (\bar R) + addeA_subproof addeC_subproof add0e_subproof. + +Lemma daddeA_subproof : associative (S := \bar^d R) dual_adde. +Proof. by case=> [x||] [y||] [z||] //; rewrite /dual_adde /= addrA. Qed. + +Lemma daddeC_subproof : commutative (S := \bar^d R) dual_adde. +Proof. by case=> [x||] [y||] //; rewrite /dual_adde /= addrC. Qed. + +Lemma dadd0e_subproof : left_id (0%:dE%dE : \bar^d R) dual_adde. +Proof. by case=> // r; rewrite /dual_adde /= add0r. Qed. + +HB.instance Definition _ := Choice.on (\bar^d R). +HB.instance Definition _ := GRing.isNmodule.Build (\bar^d R) + daddeA_subproof daddeC_subproof dadd0e_subproof. + +Definition enatmul x n : \bar R := iterop n +%R x 0. + +Definition ednatmul (x : \bar^d R) n : \bar^d R := iterop n +%R x 0. + +End ERealZsemimodule. + Section ERealOrder_numDomainType. Context {R : numDomainType}. Implicit Types (x y : \bar R) (r : R). @@ -325,6 +393,9 @@ split=> [|[->|[r r0 ->//]]]; last by rewrite real_leey/=. by case: x => [r r0 | _ |//]; [right; exists r|left]. Qed. +Lemma fine0 : fine 0 = 0%R :> R. Proof. by []. Qed. +Lemma fine1 : fine 1 = 1%R :> R. Proof. by []. Qed. + End ERealOrder_numDomainType. #[global] Hint Resolve lee01 lte01 : core. @@ -351,43 +422,30 @@ Definition lteey := (ltey, leey). Definition lteNye := (ltNye, leNye). -Lemma le_total_ereal : totalPOrderMixin [porderType of \bar R]. +Lemma le_er_map (f : R -> R) : {homo f : x y / (x <= y)%R} -> + {homo er_map f : x y / x <= y}. +Proof. +move=> ndf. +by move=> [r| |] [l| |]//=; rewrite ?leey ?leNye// !lee_fin; exact: ndf. +Qed. + +Lemma le_total_ereal : total (Order.le : rel (\bar R)). Proof. by move=> [?||][?||]//=; rewrite (ltEereal, leEereal)/= ?num_real ?le_total. Qed. -Canonical ereal_latticeType := LatticeType (extended R) le_total_ereal. -Canonical ereal_distrLatticeType := DistrLatticeType (extended R) le_total_ereal. -Canonical ereal_orderType := OrderType (extended R) le_total_ereal. +HB.instance Definition _ := Order.POrder_isTotal.Build ereal_display (\bar R) + le_total_ereal. + +HB.instance Definition _ := Order.hasBottom.Build ereal_display (\bar R) leNye. +HB.instance Definition _ := Order.hasTop.Build ereal_display (\bar R) leey. End ERealOrder_realDomainType. -Section ERealArith. -Context {R : numDomainType}. +Section ERealZmodule. +Context {R : zmodType}. Implicit Types x y z : \bar R. -Definition adde_subdef x y := - match x, y with - | x%:E , y%:E => (x + y)%:E - | -oo, _ => -oo - | _ , -oo => -oo - | +oo, _ => +oo - | _ , +oo => +oo - end. - -Definition adde := nosimpl adde_subdef. - -Definition dual_adde_subdef x y := - match x, y with - | x%:E , y%:E => (x + y)%R%:E - | +oo, _ => +oo - | _ , +oo => +oo - | -oo, _ => -oo - | _ , -oo => -oo - end. - -Definition dual_adde := nosimpl dual_adde_subdef. - Definition oppe x := match x with | r%:E => (- r)%:E @@ -395,6 +453,12 @@ Definition oppe x := | +oo => -oo end. +End ERealZmodule. + +Section ERealArith. +Context {R : numDomainType}. +Implicit Types x y z : \bar R. + Definition mule_subdef x y := match x, y with | x%:E , y%:E => (x * y)%:E @@ -404,35 +468,31 @@ Definition mule_subdef x y := Definition mule := nosimpl mule_subdef. -Definition abse x := if x is r%:E then `|r|%:E else +oo. +Definition abse x : \bar R := if x is r%:E then `|r|%:E else +oo. Definition expe x n := iterop n mule x 1. -Definition enatmul x n := iterop n adde x 0. - -Definition ednatmul x n := iterop n dual_adde x 0. - End ERealArith. -Notation "+%dE" := dual_adde. -Notation "+%E" := adde. +Notation "+%dE" := (@GRing.add (\bar^d _)). +Notation "+%E" := (@GRing.add (\bar _)). Notation "-%E" := oppe. -Notation "x + y" := (dual_adde x%dE y%dE) : ereal_dual_scope. -Notation "x + y" := (adde x y) : ereal_scope. -Notation "x - y" := (dual_adde x%dE (oppe y%dE)) : ereal_dual_scope. -Notation "x - y" := (adde x (oppe y)) : ereal_scope. -Notation "- x" := (oppe (x%dE : dual_extended _)) : ereal_dual_scope. -Notation "- x" := (oppe x) : ereal_scope. +Notation "x + y" := (GRing.add (x%dE : \bar^d _) y%dE) : ereal_dual_scope. +Notation "x + y" := (GRing.add x%E y%E) : ereal_scope. +Notation "x - y" := ((x%dE : \bar^d _) + oppe y%dE) : ereal_dual_scope. +Notation "x - y" := (x%E + (oppe y%E)) : ereal_scope. +Notation "- x" := (oppe x%dE : \bar^d _) : ereal_dual_scope. +Notation "- x" := (oppe x%E) : ereal_scope. Notation "*%E" := mule. -Notation "x * y" := (mule (x%dE : dual_extended _) (y%dE : dual_extended _)) : ereal_dual_scope. -Notation "x * y" := (mule x y) : ereal_scope. -Notation "`| x |" := (abse (x%dE : dual_extended _)) : ereal_dual_scope. -Notation "`| x |" := (abse x) : ereal_scope. +Notation "x * y" := (mule x%dE y%dE : \bar^d _) : ereal_dual_scope. +Notation "x * y" := (mule x%E y%E) : ereal_scope. +Notation "`| x |" := (abse x%dE : \bar^d _) : ereal_dual_scope. +Notation "`| x |" := (abse x%E) : ereal_scope. Arguments abse {R}. -Notation "x ^+ n" := (expe x%dE n) : ereal_dual_scope. -Notation "x ^+ n" := (expe x n) : ereal_scope. +Notation "x ^+ n" := (expe x%dE n : \bar^d _) : ereal_dual_scope. +Notation "x ^+ n" := (expe x%E n) : ereal_scope. Notation "x *+ n" := (ednatmul x%dE n) : ereal_dual_scope. -Notation "x *+ n" := (enatmul x n) : ereal_scope. +Notation "x *+ n" := (enatmul x%E n) : ereal_scope. Notation "\- f" := (fun x => - f x)%dE : ereal_dual_scope. Notation "\- f" := (fun x => - f x)%E : ereal_scope. @@ -444,53 +504,53 @@ Notation "f \- g" := (fun x => f x - g x)%dE : ereal_dual_scope. Notation "f \- g" := (fun x => f x - g x)%E : ereal_scope. Notation "\sum_ ( i <- r | P ) F" := - (\big[+%dE/0%:E]_(i <- r | P%B) F%dE) : ereal_dual_scope. + (\big[+%dE/0%dE]_(i <- r | P%B) F%dE) : ereal_dual_scope. Notation "\sum_ ( i <- r | P ) F" := - (\big[+%E/0%:E]_(i <- r | P%B) F%E) : ereal_scope. + (\big[+%E/0%E]_(i <- r | P%B) F%E) : ereal_scope. Notation "\sum_ ( i <- r ) F" := - (\big[+%dE/0%:E]_(i <- r) F%dE) : ereal_dual_scope. + (\big[+%dE/0%dE]_(i <- r) F%dE) : ereal_dual_scope. Notation "\sum_ ( i <- r ) F" := - (\big[+%E/0%:E]_(i <- r) F%E) : ereal_scope. + (\big[+%E/0%E]_(i <- r) F%E) : ereal_scope. Notation "\sum_ ( m <= i < n | P ) F" := - (\big[+%dE/0%:E]_(m <= i < n | P%B) F%dE) : ereal_dual_scope. + (\big[+%dE/0%dE]_(m <= i < n | P%B) F%dE) : ereal_dual_scope. Notation "\sum_ ( m <= i < n | P ) F" := - (\big[+%E/0%:E]_(m <= i < n | P%B) F%E) : ereal_scope. + (\big[+%E/0%E]_(m <= i < n | P%B) F%E) : ereal_scope. Notation "\sum_ ( m <= i < n ) F" := - (\big[+%dE/0%:E]_(m <= i < n) F%dE) : ereal_dual_scope. + (\big[+%dE/0%dE]_(m <= i < n) F%dE) : ereal_dual_scope. Notation "\sum_ ( m <= i < n ) F" := - (\big[+%E/0%:E]_(m <= i < n) F%E) : ereal_scope. + (\big[+%E/0%E]_(m <= i < n) F%E) : ereal_scope. Notation "\sum_ ( i | P ) F" := - (\big[+%dE/0%:E]_(i | P%B) F%dE) : ereal_dual_scope. + (\big[+%dE/0%dE]_(i | P%B) F%dE) : ereal_dual_scope. Notation "\sum_ ( i | P ) F" := - (\big[+%E/0%:E]_(i | P%B) F%E) : ereal_scope. + (\big[+%E/0%E]_(i | P%B) F%E) : ereal_scope. Notation "\sum_ i F" := - (\big[+%dE/0%:E]_i F%dE) : ereal_dual_scope. + (\big[+%dE/0%dE]_i F%dE) : ereal_dual_scope. Notation "\sum_ i F" := - (\big[+%E/0%:E]_i F%E) : ereal_scope. + (\big[+%E/0%E]_i F%E) : ereal_scope. Notation "\sum_ ( i : t | P ) F" := - (\big[+%dE/0%:E]_(i : t | P%B) F%dE) (only parsing) : ereal_dual_scope. + (\big[+%dE/0%dE]_(i : t | P%B) F%dE) (only parsing) : ereal_dual_scope. Notation "\sum_ ( i : t | P ) F" := - (\big[+%E/0%:E]_(i : t | P%B) F%E) (only parsing) : ereal_scope. + (\big[+%E/0%E]_(i : t | P%B) F%E) (only parsing) : ereal_scope. Notation "\sum_ ( i : t ) F" := - (\big[+%dE/0%:E]_(i : t) F%dE) (only parsing) : ereal_dual_scope. + (\big[+%dE/0%dE]_(i : t) F%dE) (only parsing) : ereal_dual_scope. Notation "\sum_ ( i : t ) F" := - (\big[+%E/0%:E]_(i : t) F%E) (only parsing) : ereal_scope. + (\big[+%E/0%E]_(i : t) F%E) (only parsing) : ereal_scope. Notation "\sum_ ( i < n | P ) F" := - (\big[+%dE/0%:E]_(i < n | P%B) F%dE) : ereal_dual_scope. + (\big[+%dE/0%dE]_(i < n | P%B) F%dE) : ereal_dual_scope. Notation "\sum_ ( i < n | P ) F" := - (\big[+%E/0%:E]_(i < n | P%B) F%E) : ereal_scope. + (\big[+%E/0%E]_(i < n | P%B) F%E) : ereal_scope. Notation "\sum_ ( i < n ) F" := - (\big[+%dE/0%:E]_(i < n) F%dE) : ereal_dual_scope. + (\big[+%dE/0%dE]_(i < n) F%dE) : ereal_dual_scope. Notation "\sum_ ( i < n ) F" := - (\big[+%E/0%:E]_(i < n) F%E) : ereal_scope. + (\big[+%E/0%E]_(i < n) F%E) : ereal_scope. Notation "\sum_ ( i 'in' A | P ) F" := - (\big[+%dE/0%:E]_(i in A | P%B) F%dE) : ereal_dual_scope. + (\big[+%dE/0%dE]_(i in A | P%B) F%dE) : ereal_dual_scope. Notation "\sum_ ( i 'in' A | P ) F" := - (\big[+%E/0%:E]_(i in A | P%B) F%E) : ereal_scope. + (\big[+%E/0%E]_(i in A | P%B) F%E) : ereal_scope. Notation "\sum_ ( i 'in' A ) F" := - (\big[+%dE/0%:E]_(i in A) F%dE) : ereal_dual_scope. + (\big[+%dE/0%dE]_(i in A) F%dE) : ereal_dual_scope. Notation "\sum_ ( i 'in' A ) F" := - (\big[+%E/0%:E]_(i in A) F%E) : ereal_scope. + (\big[+%E/0%E]_(i in A) F%E) : ereal_scope. Section ERealOrderTheory. Context {R : numDomainType}. @@ -517,6 +577,18 @@ Proof. by rewrite lte_fin ltrN10. Qed. Lemma leeN10 : - 1%E <= 0 :> \bar R. Proof. by rewrite lee_fin lerN10. Qed. +Lemma lte0n n : (0 < n%:R%:E :> \bar R) = (0 < n)%N. +Proof. by rewrite lte_fin ltr0n. Qed. + +Lemma lee0n n : (0 <= n%:R%:E :> \bar R) = (0 <= n)%N. +Proof. by rewrite lee_fin ler0n. Qed. + +Lemma lte1n n : (1 < n%:R%:E :> \bar R) = (1 < n)%N. +Proof. by rewrite lte_fin ltr1n. Qed. + +Lemma lee1n n : (1 <= n%:R%:E :> \bar R) = (1 <= n)%N. +Proof. by rewrite lee_fin ler1n. Qed. + Lemma fine_ge0 x : 0 <= x -> (0 <= fine x)%R. Proof. by case: x. Qed. @@ -556,8 +628,8 @@ Context {R : numDomainType}. Implicit Type (x : \bar R). Definition fin_num := [qualify a x : \bar R | (x != -oo) && (x != +oo)]. -Fact fin_num_key : pred_key fin_num. by []. Qed. -Canonical fin_num_keyd := KeyedQualifier fin_num_key. +Fact fin_num_key : pred_key fin_num. Proof. by []. Qed. +(*Canonical fin_num_keyd := KeyedQualifier fin_num_key.*) Lemma fin_numE x : (x \is a fin_num) = (x != -oo) && (x != +oo). Proof. by []. Qed. @@ -605,6 +677,10 @@ Proof. by case: x => //=; rewrite oppr0. Qed. Lemma EFinD r r' : (r + r')%:E = r%:E + r'%:E. Proof. by []. Qed. +Lemma EFin_semi_additive : @semi_additive _ (\bar R) EFin. Proof. by split. Qed. +HB.instance Definition _ := GRing.isSemiAdditive.Build R (\bar R) EFin + EFin_semi_additive. + Lemma EFinB r r' : (r - r')%:E = r%:E - r'%:E. Proof. by []. Qed. Lemma EFinM r r' : (r * r')%:E = r%:E * r'%:E. Proof. by []. Qed. @@ -621,29 +697,39 @@ Local Notation "x +? y" := (adde_def x y). Lemma adde_defC x y : x +? y = y +? x. Proof. by rewrite /adde_def andbC (andbC (x == -oo)) (andbC (x == +oo)). Qed. -Lemma adde_defNN x y : - x +? - y = x +? y. +Lemma fin_num_adde_defr x y : x \is a fin_num -> x +? y. +Proof. by move: x y => [x| |] [y | |]. Qed. + +Lemma fin_num_adde_defl x y : y \is a fin_num -> x +? y. +Proof. by rewrite adde_defC; exact: fin_num_adde_defr. Qed. + +Lemma adde_defN x y : x +? - y = - x +? y. Proof. by move: x y => [x| |] [y| |]. Qed. +Lemma adde_defDr x y z : x +? y -> x +? z -> x +? (y + z). +Proof. by move: x y z => [x||] [y||] [z||]. Qed. + Lemma adde_defEninfty x : (x +? -oo) = (x != +oo). Proof. by case: x. Qed. Lemma ge0_adde_def : {in [pred x | x >= 0] &, forall x y, x +? y}. Proof. by move=> [x| |] [y| |]. Qed. -Lemma addeC : commutative (S := \bar R) +%E. -Proof. by case=> [x||] [y||] //; rewrite /adde /= addrC. Qed. +Lemma addeC : commutative (S := \bar R) +%E. Proof. exact: addrC. Qed. -Lemma adde0 : right_id (0 : \bar R) +%E. -Proof. by case=> // r; rewrite /adde /= addr0. Qed. +Lemma adde0 : right_id (0 : \bar R) +%E. Proof. exact: addr0. Qed. -Lemma add0e : left_id (0 : \bar R) +%E. -Proof. by move=> x; rewrite addeC adde0. Qed. +Lemma add0e : left_id (0 : \bar R) +%E. Proof. exact: add0r. Qed. -Lemma addeA : associative (S := \bar R) +%E. -Proof. by case=> [x||] [y||] [z||] //; rewrite /adde /= addrA. Qed. +Lemma addeA : associative (S := \bar R) +%E. Proof. exact: addrA. Qed. -Canonical adde_monoid := Monoid.Law addeA add0e adde0. -Canonical adde_comoid := Monoid.ComLaw addeC. +Lemma adde_def_sum I h t (P : pred I) (f : I -> \bar R) : + {in P, forall i : I, f h +? f i} -> + f h +? \sum_(j <- t | P j) f j. +Proof. +move=> fhi; elim/big_rec : _; first by rewrite fin_num_adde_defl. +by move=> i x Pi fhx; rewrite adde_defDr// fhi. +Qed. Lemma addeAC : @right_commutative (\bar R) _ +%E. Proof. exact: Monoid.mulmAC. Qed. @@ -683,12 +769,18 @@ Proof. by case=> [x||] //=; rewrite opprK. Qed. Lemma oppe_inj : @injective (\bar R) _ -%E. Proof. exact: inv_inj oppeK. Qed. +Lemma adde_defNN x y : - x +? - y = x +? y. +Proof. by rewrite adde_defN oppeK. Qed. + Lemma oppe_eq0 x : (- x == 0)%E = (x == 0)%E. Proof. by rewrite -(can_eq oppeK) oppe0. Qed. -Lemma oppeD x y : y \is a fin_num -> - (x + y) = - x - y. +Lemma oppeD x y : x +? y -> - (x + y) = - x - y. Proof. by move: x y => [x| |] [y| |] //= _; rewrite opprD. Qed. +Lemma fin_num_oppeD x y : y \is a fin_num -> - (x + y) = - x - y. +Proof. by move=> finy; rewrite oppeD// fin_num_adde_defl. Qed. + Lemma sube0 x : x - 0 = x. Proof. by move: x => [x| |] //; rewrite -EFinB subr0. Qed. @@ -715,11 +807,14 @@ Proof. by move: x => [r| |] //=; rewrite /mule/= ?mulr0// eqxx. Qed. Lemma mul0e x : 0 * x = 0. Proof. by move: x => [r| |]/=; rewrite /mule/= ?mul0r// eqxx. Qed. -Canonical mule_mulmonoid := @Monoid.MulLaw _ _ mule mul0e mule0. +HB.instance Definition _ := Monoid.isMulLaw.Build (\bar R) 0 mule mul0e mule0. Lemma expeS x n : x ^+ n.+1 = x * x ^+ n. Proof. by case: n => //=; rewrite mule1. Qed. +Lemma EFin_expe r n : (r ^+ n)%:E = r%:E ^+ n. +Proof. by elim: n => [//|n IHn]; rewrite exprS EFinM IHn expeS. Qed. + Definition mule_def x y := ~~ (((x == 0) && (`| y | == +oo)) || ((y == 0) && (`| x | == +oo))). @@ -758,7 +853,7 @@ Proof. by move=> [x| |] [y| |]. Qed. Lemma abse_eq0 x : (`|x| == 0) = (x == 0). Proof. by move: x => [| |] //= r; rewrite !eqe normr_eq0. Qed. -Lemma abse0 : `|0| = 0 :> \bar R. Proof. by rewrite /abse normr0. Qed. +Lemma abse0 : `|0| = 0 :> \bar R. Proof. by rewrite /abse/= normr0. Qed. Lemma abse1 : `|1| = 1 :> \bar R. Proof. by rewrite /abse normr1. Qed. @@ -786,8 +881,11 @@ Qed. Lemma fin_numN x : (- x \is a fin_num) = (x \is a fin_num). Proof. by rewrite !fin_num_abs abseN. Qed. -Lemma oppeB x y : y \is a fin_num -> - (x - y) = - x + y. -Proof. by move=> yfin; rewrite oppeD ?oppeK// fin_numN. Qed. +Lemma oppeB x y : x +? - y -> - (x - y) = - x + y. +Proof. by move=> xy; rewrite oppeD// oppeK. Qed. + +Lemma fin_num_oppeB x y : y \is a fin_num -> - (x - y) = - x + y. +Proof. by move=> ?; rewrite oppeB// adde_defN fin_num_adde_defl. Qed. Lemma fin_numD x y : (x + y \is a fin_num) = (x \is a fin_num) && (y \is a fin_num). @@ -829,20 +927,35 @@ Proof. by move=> [r| |] [s| |]. Qed. Lemma fineM : {in @fin_num R &, {morph fine : x y / x * y >-> (x * y)%R}}. Proof. by move=> [x| |] [y| |]. Qed. -Lemma fin_num_adde_def x y : y \is a fin_num -> x +? y. -Proof. by move: x y => [x| |] [y | |]. Qed. - Lemma fineK x : x \is a fin_num -> (fine x)%:E = x. Proof. by case: x. Qed. +Lemma EFin_sum_fine (I : Type) s (P : pred I) (f : I -> \bar R) : + (forall i, P i -> f i \is a fin_num) -> + (\sum_(i <- s | P i) fine (f i))%:E = \sum_(i <- s | P i) f i. +Proof. +by move=> h; rewrite -sumEFin; apply: eq_bigr => i Pi; rewrite fineK// h. +Qed. + Lemma sum_fine (I : Type) s (P : pred I) (F : I -> \bar R) : - (forall i, P i -> F i \is a fin_num) -> + (forall i, P i -> F i \is a fin_num) -> (\sum_(i <- s | P i) fine (F i) = fine (\sum_(i <- s | P i) F i))%R. +Proof. by move=> h; rewrite -EFin_sum_fine. Qed. + +Lemma sumeN I s (P : pred I) (f : I -> \bar R) : + {in P &, forall i j, f i +? f j} -> + \sum_(i <- s | P i) - f i = - \sum_(i <- s | P i) f i. +Proof. +elim: s => [|a b ih h]; first by rewrite !big_nil oppe0. +rewrite !big_cons; case: ifPn => Pa; last by rewrite ih. +by rewrite oppeD ?ih// adde_def_sum// => i Pi; rewrite h. +Qed. + +Lemma fin_num_sumeN I s (P : pred I) (f : I -> \bar R) : + (forall i, P i -> f i \is a fin_num) -> + \sum_(i <- s | P i) - f i = - \sum_(i <- s | P i) f i. Proof. -move=> h; apply: EFin_inj; rewrite -sumEFin fineK. - by apply eq_bigr => ? ?; rewrite fineK// h. -rewrite sum_fin_num; apply/allP => x; elim: s => //= a b ih. -by case: ifPn => // /h ? /[!inE] /predU1P[->//|]; exact: ih. +by move=> h; rewrite sumeN// => i j Pi Pj; rewrite fin_num_adde_defl// h. Qed. Lemma telescope_sume n m (f : nat -> \bar R) : @@ -939,20 +1052,20 @@ by apply/eqP/esum_eqyP => //; exists i. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed `esum_eqNyP`")] -Notation esum_ninftyP := esum_eqNyP. +Notation esum_ninftyP := esum_eqNyP (only parsing). #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed `esum_eqNy`")] -Notation esum_ninfty := esum_eqNy. +Notation esum_ninfty := esum_eqNy (only parsing). #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed `esum_eqyP`")] -Notation esum_pinftyP := esum_eqyP. +Notation esum_pinftyP := esum_eqyP (only parsing). #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed `esum_eqy`")] -Notation esum_pinfty := esum_eqy. +Notation esum_pinfty := esum_eqy (only parsing). Lemma adde_ge0 x y : 0 <= x -> 0 <= y -> 0 <= x + y. Proof. by move: x y => [r0| |] [r1| |] // ? ?; rewrite !lee_fin addr_ge0. Qed. Lemma adde_le0 x y : x <= 0 -> y <= 0 -> x + y <= 0. Proof. -move: x y => [r0||] [r1||]// ? ?; rewrite !lee_fin -(addr0 0%R); exact: ler_add. +move: x y => [r0||] [r1||]// ? ?; rewrite !lee_fin -(addr0 0%R); exact: lerD. Qed. Lemma oppe_gt0 x : (0 < - x) = (x < 0). @@ -1079,7 +1192,7 @@ Lemma mule_lt0_gt0 x y : x < 0 -> 0 < y -> x * y < 0. Proof. by move=> x0 y0; rewrite muleC mule_gt0_lt0. Qed. Lemma gte_opp x : 0 < x -> - x < x. -Proof. by case: x => //= r; rewrite !lte_fin; apply: gtr_opp. Qed. +Proof. by case: x => //= r; rewrite !lte_fin; apply: gtrN. Qed. Lemma realMe x y : (0%E >=< x)%O -> (0%E >=< y)%O -> (0%E >=< x * y)%O. Proof. @@ -1092,6 +1205,13 @@ case: x y => [x||] [y||]// rx ry; |by rewrite mulNyNy /Order.comparable le0y]. Qed. +Lemma sqreD x y : x + y \is a fin_num -> + (x + y) ^+ 2 = x ^+ 2 + x * y *+ 2 + y ^+ 2. +Proof. +case: x y => [x||] [y||] // _. +by rewrite -EFinM -EFin_natmul -!EFin_expe -!EFinD sqrrD. +Qed. + Lemma abse_ge0 x : 0 <= `|x|. Proof. by move: x => [x| |] /=; rewrite ?le0y ?lee_fin. Qed. @@ -1118,11 +1238,11 @@ Notation "x *? y" := (mule_def x y) : ereal_scope. Notation maxe := (@Order.max ereal_display _). Notation "@ 'maxe' R" := (@Order.max ereal_display R) - (at level 10, R at level 8, only parsing) : fun_scope. + (at level 10, R at level 8, only parsing) : function_scope. Notation mine := (@Order.min ereal_display _). Notation "@ 'mine' R" := (@Order.min ereal_display R) - (at level 10, R at level 8, only parsing) : fun_scope. + (at level 10, R at level 8, only parsing) : function_scope. Module DualAddTheoryNumDomain. @@ -1132,12 +1252,12 @@ Local Open Scope ereal_dual_scope. Context {R : numDomainType}. -Implicit Types x y z : \bar R. +Implicit Types x y z : \bar^d R. Lemma dual_addeE x y : (x + y)%dE = - ((- x) + (- y))%E. Proof. by case: x => [x| |]; case: y => [y| |] //=; rewrite opprD !opprK. Qed. -Lemma dual_sumeE I (r : seq I) (P : pred I) (F : I -> \bar R) : +Lemma dual_sumeE I (r : seq I) (P : pred I) (F : I -> \bar^d R) : (\sum_(i <- r | P i) F i)%dE = - (\sum_(i <- r | P i) (- F i)%E)%E. Proof. apply: (big_ind2 (fun x y => x = - y)%E) => [|_ x _ y -> ->|i _]. @@ -1152,42 +1272,46 @@ Proof. by case: x => [x| |]; case: y. Qed. Lemma dEFinD (r r' : R) : (r + r')%R%:E = r%:E + r'%:E. Proof. by []. Qed. +Lemma dEFinE (r : R) : dEFin r = r%:E. Proof. by []. Qed. + +Lemma dEFin_semi_additive : @semi_additive _ (\bar^d R) dEFin. +Proof. by split. Qed. +#[export] +HB.instance Definition _ := GRing.isSemiAdditive.Build R (\bar^d R) dEFin + dEFin_semi_additive. + Lemma dEFinB (r r' : R) : (r - r')%R%:E = r%:E - r'%:E. Proof. by []. Qed. Lemma dsumEFin I r P (F : I -> R) : \sum_(i <- r | P i) (F i)%:E = (\sum_(i <- r | P i) F i)%R%:E. -Proof. by rewrite dual_sumeE sumEFin sumrN EFinN oppeK. Qed. - -Lemma daddeC : commutative (S := \bar R) +%dE. -Proof. by move=> x y; rewrite !dual_addeE addeC. Qed. +Proof. by rewrite dual_sumeE fin_num_sumeN// oppeK sumEFin. Qed. -Lemma dadde0 : right_id (0 : \bar R) +%dE. -Proof. by move=> x; rewrite dual_addeE eqe_oppLRP oppe0 adde0. Qed. +Lemma daddeC : commutative (S := \bar^d R) +%dE. Proof. exact: addrC. Qed. -Lemma dadd0e : left_id (0 : \bar R) +%dE. -Proof. by move=> x;rewrite dual_addeE eqe_oppLRP oppe0 add0e. Qed. +Lemma dadde0 : right_id (0 : \bar^d R) +%dE. Proof. exact: addr0. Qed. -Lemma daddeA : associative (S := \bar R) +%dE. -Proof. by move=> x y z; rewrite !dual_addeE !oppeK addeA. Qed. +Lemma dadd0e : left_id (0 : \bar^d R) +%dE. Proof. exact: add0r. Qed. -Canonical dadde_monoid := Monoid.Law daddeA dadd0e dadde0. -Canonical dadde_comoid := Monoid.ComLaw daddeC. +Lemma daddeA : associative (S := \bar^d R) +%dE. Proof. exact: addrA. Qed. -Lemma daddeAC : right_commutative (S := \bar R) +%dE. +Lemma daddeAC : right_commutative (S := \bar^d R) +%dE. Proof. exact: Monoid.mulmAC. Qed. -Lemma daddeCA : left_commutative (S := \bar R) +%dE. +Lemma daddeCA : left_commutative (S := \bar^d R) +%dE. Proof. exact: Monoid.mulmCA. Qed. -Lemma daddeACA : @interchange (\bar R) +%dE +%dE. +Lemma daddeACA : @interchange (\bar^d R) +%dE +%dE. Proof. exact: Monoid.mulmACA. Qed. -Lemma realDed x y : (0%E >=< x)%O -> (0%E >=< y)%O -> (0%E >=< x + y)%O. +Lemma realDed x y : (0%dE >=< x)%O -> (0%dE >=< y)%O -> (0%dE >=< x + y)%O. Proof. case: x y => [x||] [y||] //; exact: realD. Qed. -Lemma doppeD x y : y \is a fin_num -> - (x + y) = - x - y. -Proof. by move: y => [y| |] _ //; rewrite !dual_addeE !oppeK oppeD. Qed. +Lemma doppeD x y : x +? y -> - (x + y) = - x - y. +Proof. by move: x y => [x| |] [y| |] //= _; rewrite opprD. Qed. + +Lemma fin_num_doppeD x y : y \is a fin_num -> - (x + y) = - x - y. +Proof. by move=> finy; rewrite doppeD// fin_num_adde_defl. Qed. Lemma dsube0 x : x - 0 = x. Proof. by move: x => [x| |] //; rewrite -dEFinB subr0. Qed. @@ -1195,8 +1319,11 @@ Proof. by move: x => [x| |] //; rewrite -dEFinB subr0. Qed. Lemma dsub0e x : 0 - x = - x. Proof. by move: x => [x| |] //; rewrite -dEFinB sub0r. Qed. -Lemma doppeB x y : y \is a fin_num -> - (x - y) = - x + y. -Proof. by move=> yfin; rewrite doppeD ?oppeK// fin_numN. Qed. +Lemma doppeB x y : x +? - y -> - (x - y) = - x + y. +Proof. by move=> xy; rewrite doppeD// oppeK. Qed. + +Lemma fin_num_doppeB x y : y \is a fin_num -> - (x - y) = - x + y. +Proof. by move=> ?; rewrite doppeB// fin_num_adde_defl// fin_numN. Qed. Lemma dfin_numD x y : (x + y \is a fin_num) = (x \is a fin_num) && (y \is a fin_num). @@ -1269,7 +1396,7 @@ Lemma dadde_ss_eq0 x y : (0 <= x) && (0 <= y) || (x <= 0) && (y <= 0) -> x + y == 0 = (x == 0) && (y == 0). Proof. move=> /orP[|] /andP[]; [exact: pdadde_eq0|exact: ndadde_eq0]. Qed. -Lemma desum_eqyP (T : eqType) (s : seq T) (P : pred T) (f : T -> \bar R) : +Lemma desum_eqyP (T : eqType) (s : seq T) (P : pred T) (f : T -> \bar^d R) : \sum_(i <- s | P i) f i = +oo <-> exists i, [/\ i \in s, P i & f i = +oo]. Proof. rewrite dual_sumeE eqe_oppLRP /= esum_eqNyP. @@ -1284,7 +1411,7 @@ by under eq_existsb => i do rewrite eqe_oppLR. Qed. Lemma desum_eqNyP - (T : eqType) (s : seq T) (P : pred T) (f : T -> \bar R) : + (T : eqType) (s : seq T) (P : pred T) (f : T -> \bar^d R) : (forall i, P i -> f i != +oo) -> \sum_(i <- s | P i) f i = -oo <-> exists i, [/\ i \in s, P i & f i = -oo]. Proof. @@ -1294,7 +1421,7 @@ rewrite dual_sumeE eqe_oppLRP /= esum_eqyP => [|i Pi]; last first. by split=> -[i + /ltac:(exists i)] => [|] []; [|split]; rewrite // eqe_oppLRP. Qed. -Lemma desum_eqNy (I : finType) (f : I -> \bar R) (P : {pred I}) : +Lemma desum_eqNy (I : finType) (f : I -> \bar^d R) (P : {pred I}) : (forall i, f i != +oo) -> (\sum_(i | P i) f i == -oo) = [exists i in P, f i == -oo]. Proof. @@ -1304,13 +1431,13 @@ by under eq_existsb => i do rewrite eqe_oppLR. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed `desum_eqNyP`")] -Notation desum_ninftyP := desum_eqNyP. +Notation desum_ninftyP := desum_eqNyP (only parsing). #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed `desum_eqNy`")] -Notation desum_ninfty := desum_eqNy. +Notation desum_ninfty := desum_eqNy (only parsing). #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed `desum_eqyP`")] -Notation desum_pinftyP := desum_eqyP. +Notation desum_pinftyP := desum_eqyP (only parsing). #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed `desum_eqy`")] -Notation desum_pinfty := desum_eqy. +Notation desum_pinfty := desum_eqy (only parsing). Lemma dadde_ge0 x y : 0 <= x -> 0 <= y -> 0 <= x + y. Proof. rewrite dual_addeE oppe_ge0 -!oppe_le0; exact: adde_le0. Qed. @@ -1318,27 +1445,27 @@ Proof. rewrite dual_addeE oppe_ge0 -!oppe_le0; exact: adde_le0. Qed. Lemma dadde_le0 x y : x <= 0 -> y <= 0 -> x + y <= 0. Proof. rewrite dual_addeE oppe_le0 -!oppe_ge0; exact: adde_ge0. Qed. -Lemma dsume_ge0 T (f : T -> \bar R) (P : pred T) : +Lemma dsume_ge0 T (f : T -> \bar^d R) (P : pred T) : (forall n, P n -> 0 <= f n) -> forall l, 0 <= \sum_(i <- l | P i) f i. Proof. move=> u0 l; rewrite dual_sumeE oppe_ge0 sume_le0 // => t Pt. rewrite oppe_le0; exact: u0. Qed. -Lemma dsume_le0 T (f : T -> \bar R) (P : pred T) : +Lemma dsume_le0 T (f : T -> \bar^d R) (P : pred T) : (forall n, P n -> f n <= 0) -> forall l, \sum_(i <- l | P i) f i <= 0. Proof. move=> u0 l; rewrite dual_sumeE oppe_le0 sume_ge0 // => t Pt. rewrite oppe_ge0; exact: u0. Qed. -Lemma gte_dopp (r : \bar R) : (0 < r)%E -> (- r < r)%E. -Proof. by case: r => //= r; rewrite !lte_fin; apply: gtr_opp. Qed. +Lemma gte_dopp (r : \bar^d R) : (0 < r)%E -> (- r < r)%E. +Proof. by case: r => //= r; rewrite !lte_fin; apply: gtrN. Qed. -Lemma ednatmul_pinfty n : +oo *+ n.+1 = +oo :> \bar R. +Lemma ednatmul_pinfty n : +oo *+ n.+1 = +oo :> \bar^d R. Proof. by elim: n => //= n ->. Qed. -Lemma ednatmul_ninfty n : -oo *+ n.+1 = -oo :> \bar R. +Lemma ednatmul_ninfty n : -oo *+ n.+1 = -oo :> \bar^d R. Proof. by elim: n => //= n ->. Qed. Lemma EFin_dnatmul (r : R) n : (r *+ n.+1)%:E = r%:E *+ n.+1. @@ -1354,6 +1481,13 @@ Qed. Lemma dmule2n x : x *+ 2 = x + x. Proof. by []. Qed. +Lemma sqredD x y : x + y \is a fin_num -> + (x + y) ^+ 2 = x ^+ 2 + x * y *+ 2 + y ^+ 2. +Proof. +case: x y => [x||] [y||] // _. +by rewrite -EFinM -EFin_dnatmul -!EFin_expe -!dEFinD sqrrD. +Qed. + End DualERealArithTh_numDomainType. End DualAddTheoryNumDomain. @@ -1377,21 +1511,27 @@ Proof. by case: x => // x //=; exact: ltNyr. Qed. Lemma ge0_fin_numE x : 0 <= x -> (x \is a fin_num) = (x < +oo). Proof. by move: x => [x| |] => // x0; rewrite fin_numElt ltNyr. Qed. +Lemma gt0_fin_numE x : 0 < x -> (x \is a fin_num) = (x < +oo). +Proof. by move/ltW; exact: ge0_fin_numE. Qed. + Lemma le0_fin_numE x : x <= 0 -> (x \is a fin_num) = (-oo < x). Proof. by move: x => [x| |]//=; rewrite lee_fin => x0; rewrite ltNyr. Qed. +Lemma lt0_fin_numE x : x < 0 -> (x \is a fin_num) = (-oo < x). +Proof. by move/ltW; exact: le0_fin_numE. Qed. + Lemma eqyP x : x = +oo <-> (forall A, (0 < A)%R -> A%:E <= x). Proof. split=> [-> // A A0|Ax]; first by rewrite leey. apply/eqP; rewrite eq_le leey /= leNgt; apply/negP. case: x Ax => [x Ax _|//|/(_ _ ltr01)//]. suff: ~ x%:E < (Order.max 0 x + 1)%:E. - by apply; rewrite lte_fin ltr_spaddr// le_maxr lexx orbT. -by apply/negP; rewrite -leNgt; apply/Ax/ltr_spaddr; rewrite // le_maxr lexx. + by apply; rewrite lte_fin ltr_pwDr// le_maxr lexx orbT. +by apply/negP; rewrite -leNgt; apply/Ax/ltr_pwDr; rewrite // le_maxr lexx. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed `eqyP`")] -Notation eq_pinftyP := eqyP. +Notation eq_pinftyP := eqyP (only parsing). Lemma seq_psume_eq0 (I : choiceType) (r : seq I) (P : pred I) (F : I -> \bar R) : (forall i, P i -> 0 <= F i)%E -> @@ -1456,22 +1596,22 @@ Proof. by move=> /orP[?|?]; [rewrite suber_ge0|rewrite subre_ge0]. Qed. Lemma lte_oppl x y : (- x < y) = (- y < x). Proof. -by move: x y => [r| |] [r'| |] //=; rewrite ?(ltry, ltNyr)// !lte_fin ltr_oppl. +by move: x y => [r| |] [r'| |] //=; rewrite ?(ltry, ltNyr)// !lte_fin ltrNl. Qed. Lemma lte_oppr x y : (x < - y) = (y < - x). Proof. -by move: x y => [r| |] [r'| |] //=; rewrite ?(ltry, ltNyr)// !lte_fin ltr_oppr. +by move: x y => [r| |] [r'| |] //=; rewrite ?(ltry, ltNyr)// !lte_fin ltrNr. Qed. Lemma lee_oppr x y : (x <= - y) = (y <= - x). Proof. -by move: x y => [r0| |] [r1| |] //=; rewrite ?(leey, leNye)// !lee_fin ler_oppr. +by move: x y => [r0| |] [r1| |] //=; rewrite ?(leey, leNye)// !lee_fin lerNr. Qed. Lemma lee_oppl x y : (- x <= y) = (- y <= x). Proof. -by move: x y => [r0| |] [r1| |] //=; rewrite ?(leey, leNye)// !lee_fin ler_oppl. +by move: x y => [r0| |] [r1| |] //=; rewrite ?(leey, leNye)// !lee_fin lerNl. Qed. Lemma muleN x y : x * - y = - (x * y). @@ -1587,19 +1727,19 @@ have := mule_eq_pinfty x (- y); rewrite muleN eqe_oppLR => ->. by rewrite !eqe_oppLR lte_oppr lte_oppl oppe0 (orbC _ ((x == -oo) && _)). Qed. -Lemma lte_opp x y : (- x < - y) = (y < x). +Lemma lteN2 x y : (- x < - y) = (y < x). Proof. by rewrite lte_oppl oppeK. Qed. Lemma lte_add a b x y : a < b -> x < y -> a + x < b + y. Proof. move: a b x y=> [a| |] [b| |] [x| |] [y| |]; rewrite ?(ltry,ltNyr)//. -by rewrite !lte_fin; exact: ltr_add. +by rewrite !lte_fin; exact: ltrD. Qed. Lemma lee_addl x y : 0 <= y -> x <= x + y. Proof. move: x y => -[ x [y| |]//= | [| |]// | [| | ]//]; - by [rewrite !lee_fin ler_addl | move=> _; exact: leey]. + by [rewrite !lee_fin lerDl | move=> _; exact: leey]. Qed. Lemma lee_addr x y : 0 <= y -> x <= y + x. @@ -1608,7 +1748,7 @@ Proof. by rewrite addeC; exact: lee_addl. Qed. Lemma gee_addl x y : y <= 0 -> x + y <= x. Proof. move: x y => -[ x [y| |]//= | [| |]// | [| | ]//]; - by [rewrite !lee_fin ger_addl | move=> _; exact: leNye]. + by [rewrite !lee_fin gerDl | move=> _; exact: leNye]. Qed. Lemma gee_addr x y : y <= 0 -> y + x <= x. @@ -1616,7 +1756,7 @@ Proof. rewrite addeC; exact: gee_addl. Qed. Lemma lte_addl y x : y \is a fin_num -> (y < y + x) = (0 < x). Proof. -by move: x y => [x| |] [y| |] _ //; rewrite ?ltry ?ltNyr // !lte_fin ltr_addl. +by move: x y => [x| |] [y| |] _ //; rewrite ?ltry ?ltNyr // !lte_fin ltrDl. Qed. Lemma lte_addr y x : y \is a fin_num -> (y < x + y) = (0 < x). @@ -1625,7 +1765,7 @@ Proof. rewrite addeC; exact: lte_addl. Qed. Lemma gte_subl y x : y \is a fin_num -> (y - x < y) = (0 < x). Proof. move: y x => [x| |] [y| |] _ //; rewrite addeC /= ?ltNyr ?ltry//. -by rewrite !lte_fin gtr_addr ltr_oppl oppr0. +by rewrite !lte_fin gtrDr ltrNl oppr0. Qed. Lemma gte_subr y x : y \is a fin_num -> (- x + y < y) = (0 < x). @@ -1633,7 +1773,7 @@ Proof. by rewrite addeC; exact: gte_subl. Qed. Lemma gte_addl x y : x \is a fin_num -> (x + y < x) = (y < 0). Proof. -by move: x y => [r| |] [s| |]// _; [rewrite !lte_fin gtr_addl|rewrite !ltNyr]. +by move: x y => [r| |] [s| |]// _; [rewrite !lte_fin gtrDl|rewrite !ltNyr]. Qed. Lemma gte_addr x y : x \is a fin_num -> (y + x < x) = (y < 0). @@ -1642,13 +1782,13 @@ Proof. by rewrite addeC; exact: gte_addl. Qed. Lemma lte_add2lE x a b : x \is a fin_num -> (x + a < x + b) = (a < b). Proof. move: a b x => [a| |] [b| |] [x| |] _ //; rewrite ?(ltry, ltNyr)//. -by rewrite !lte_fin ltr_add2l. +by rewrite !lte_fin ltrD2l. Qed. Lemma lee_add2l x a b : a <= b -> x + a <= x + b. Proof. move: a b x => -[a [b [x /=|//|//] | []// |//] | []// | ]. -- by rewrite !lee_fin ler_add2l. +- by rewrite !lee_fin lerD2l. - by move=> r _; exact: leey. - by move=> -[b [| |]// | []// | //] r oob; exact: leNye. Qed. @@ -1656,7 +1796,7 @@ Qed. Lemma lee_add2lE x a b : x \is a fin_num -> (x + a <= x + b) = (a <= b). Proof. move: a b x => [a| |] [b| |] [x| |] _ //; rewrite ?(leey, leNye)//. -by rewrite !lee_fin ler_add2l. +by rewrite !lee_fin lerD2l. Qed. Lemma lee_add2r x a b : a <= b -> a + x <= b + x. @@ -1665,13 +1805,13 @@ Proof. rewrite addeC (addeC b); exact: lee_add2l. Qed. Lemma lee_add a b x y : a <= b -> x <= y -> a + x <= b + y. Proof. move: a b x y => [a| |] [b| |] [x| |] [y| |]; rewrite ?(leey, leNye)//. -by rewrite !lee_fin; exact: ler_add. +by rewrite !lee_fin; exact: lerD. Qed. Lemma lte_le_add a b x y : b \is a fin_num -> a < x -> b <= y -> a + b < x + y. Proof. move: x y a b => [x| |] [y| |] [a| |] [b| |] _ //=; rewrite ?(ltry, ltNyr)//. -by rewrite !lte_fin; exact: ltr_le_add. +by rewrite !lte_fin; exact: ltr_leD. Qed. Lemma lee_lt_add a b x y : a \is a fin_num -> a <= x -> b < y -> a + b < x + y. @@ -1680,20 +1820,20 @@ Proof. by move=> afin xa yb; rewrite (addeC a) (addeC x) lte_le_add. Qed. Lemma lee_sub x y z u : x <= y -> u <= z -> x - z <= y - u. Proof. move: x y z u => -[x| |] -[y| |] -[z| |] -[u| |] //=; rewrite ?(leey,leNye)//. -by rewrite !lee_fin; exact: ler_sub. +by rewrite !lee_fin; exact: lerB. Qed. Lemma lte_le_sub z u x y : u \is a fin_num -> x < z -> u <= y -> x - y < z - u. Proof. move: z u x y => [z| |] [u| |] [x| |] [y| |] _ //=; rewrite ?(ltry, ltNyr)//. -by rewrite !lte_fin => xltr tley; apply: ltr_le_add; rewrite // ler_oppl opprK. +by rewrite !lte_fin => xltr tley; apply: ltr_leD; rewrite // lerNl opprK. Qed. Lemma lte_pmul2r z : z \is a fin_num -> 0 < z -> {mono *%E^~ z : x y / x < y}. Proof. move: z => [z| |] _ // z0 [x| |] [y| |] //. -- by rewrite !lte_fin ltr_pmul2r. +- by rewrite !lte_fin ltr_pM2r. - by rewrite mulr_infty gtr0_sg// mul1e 2!ltry. - by rewrite mulr_infty gtr0_sg// mul1e ltNge leNye ltNge leNye. - by rewrite mulr_infty gtr0_sg// mul1e ltNge leey ltNge leey. @@ -1714,6 +1854,18 @@ Qed. Lemma lte_nmul2r z : z \is a fin_num -> z < 0 -> {mono *%E^~ z : x y /~ x < y}. Proof. by move=> zfin z0 x y; rewrite -!(muleC z) lte_nmul2l. Qed. +Lemma lte_pmulr x y : y \is a fin_num -> 0 < y -> (y < y * x) = (1 < x). +Proof. by move=> yfin y0; rewrite -[X in X < _ = _]mule1 lte_pmul2l. Qed. + +Lemma lte_pmull x y : y \is a fin_num -> 0 < y -> (y < x * y) = (1 < x). +Proof. by move=> yfin y0; rewrite muleC lte_pmulr. Qed. + +Lemma lte_nmulr x y : y \is a fin_num -> y < 0 -> (y < y * x) = (x < 1). +Proof. by move=> yfin y0; rewrite -[X in X < _ = _]mule1 lte_nmul2l. Qed. + +Lemma lte_nmull x y : y \is a fin_num -> y < 0 -> (y < x * y) = (x < 1). +Proof. by move=> yfin y0; rewrite muleC lte_nmulr. Qed. + Lemma lee_sum I (f g : I -> \bar R) s (P : pred I) : (forall i, P i -> f i <= g i) -> \sum_(i <- s | P i) f i <= \sum_(i <- s | P i) g i. @@ -1832,7 +1984,7 @@ Qed. Lemma lte_subl_addr x y z : y \is a fin_num -> (x - y < z) = (x < z + y). Proof. move: x y z => [x| |] [y| |] [z| |] _ //=; rewrite ?ltry ?ltNyr //. -by rewrite !lte_fin ltr_subl_addr. +by rewrite !lte_fin ltrBlDr. Qed. Lemma lte_subl_addl x y z : y \is a fin_num -> (x - y < z) = (x < y + z). @@ -1841,7 +1993,7 @@ Proof. by move=> ?; rewrite lte_subl_addr// addeC. Qed. Lemma lte_subr_addr x y z : z \is a fin_num -> (x < y - z) = (x + z < y). Proof. move: x y z => [x| |] [y| |] [z| |] _ //=; rewrite ?ltNyr ?ltry //. -by rewrite !lte_fin ltr_subr_addr. +by rewrite !lte_fin ltrBrDr. Qed. Lemma lte_subr_addl x y z : z \is a fin_num -> (x < y - z) = (z + x < y). @@ -1850,7 +2002,7 @@ Proof. by move=> ?; rewrite lte_subr_addr// addeC. Qed. Lemma lte_subel_addr x y z : x \is a fin_num -> (x - y < z) = (x < z + y). Proof. move: x y z => [x| |] [y| |] [z| |] _ //=; rewrite ?ltNyr ?ltry //. -by rewrite !lte_fin ltr_subl_addr. +by rewrite !lte_fin ltrBlDr. Qed. Lemma lte_subel_addl x y z : x \is a fin_num -> (x - y < z) = (x < y + z). @@ -1859,7 +2011,7 @@ Proof. by move=> ?; rewrite lte_subel_addr// addeC. Qed. Lemma lte_suber_addr x y z : x \is a fin_num -> (x < y - z) = (x + z < y). Proof. move: x y z => [x| |] [y| |] [z| |] _ //=; rewrite ?ltNyr ?ltry //. -by rewrite !lte_fin ltr_subr_addr. +by rewrite !lte_fin ltrBrDr. Qed. Lemma lte_suber_addl x y z : x \is a fin_num -> (x < y - z) = (z + x < y). @@ -1868,7 +2020,7 @@ Proof. by move=> ?; rewrite lte_suber_addr// addeC. Qed. Lemma lee_subl_addr x y z : y \is a fin_num -> (x - y <= z) = (x <= z + y). Proof. move: x y z => [x| |] [y| |] [z| |] _ //=; rewrite ?leey ?leNye //. -by rewrite !lee_fin ler_subl_addr. +by rewrite !lee_fin lerBlDr. Qed. Lemma lee_subl_addl x y z : y \is a fin_num -> (x - y <= z) = (x <= y + z). @@ -1877,7 +2029,7 @@ Proof. by move=> ?; rewrite lee_subl_addr// addeC. Qed. Lemma lee_subr_addr x y z : z \is a fin_num -> (x <= y - z) = (x + z <= y). Proof. move: y x z => [y| |] [x| |] [z| |] _ //=; rewrite ?leNye ?leey //. -by rewrite !lee_fin ler_subr_addr. +by rewrite !lee_fin lerBrDr. Qed. Lemma lee_subr_addl x y z : z \is a fin_num -> (x <= y - z) = (z + x <= y). @@ -1886,7 +2038,7 @@ Proof. by move=> ?; rewrite lee_subr_addr// addeC. Qed. Lemma lee_subel_addr x y z : z \is a fin_num -> (x - y <= z) = (x <= z + y). Proof. move: x y z => [x| |] [y| |] [z| |] _ //=; rewrite ?leey ?leNye //. -by rewrite !lee_fin ler_subl_addr. +by rewrite !lee_fin lerBlDr. Qed. Lemma lee_subel_addl x y z : z \is a fin_num -> (x - y <= z) = (x <= y + z). @@ -1895,7 +2047,7 @@ Proof. by move=> ?; rewrite lee_subel_addr// addeC. Qed. Lemma lee_suber_addr x y z : y \is a fin_num -> (x <= y - z) = (x + z <= y). Proof. move: y x z => [y| |] [x| |] [z| |] _ //=; rewrite ?leNye ?leey //. -by rewrite !lee_fin ler_subr_addr. +by rewrite !lee_fin lerBrDr. Qed. Lemma lee_suber_addl x y z : y \is a fin_num -> (x <= y - z) = (z + x <= y). @@ -1989,8 +2141,8 @@ Qed. Local Open Scope ereal_scope. -Canonical mule_monoid := Monoid.Law muleA mul1e mule1. -Canonical mule_comoid := Monoid.ComLaw muleC. +HB.instance Definition _ := Monoid.isComLaw.Build (\bar R) 1%E mule + muleA muleC mul1e. Lemma muleCA : left_commutative ( *%E : \bar R -> \bar R -> \bar R ). Proof. exact: Monoid.mulmCA. Qed. @@ -2027,7 +2179,7 @@ rewrite /mule/=; move: x y z => [r| |] [s| |] [t| |] //= s0 t0. - by case: ltgtP => //; rewrite adde0. - rewrite !eqe paddr_eq0 //; move: s0; rewrite lee_fin. case: (ltgtP s) => //= [s0|->{s}] _; rewrite ?add0e. - + rewrite lte_fin -[in LHS](addr0 0%R) ltr_le_add // lte_fin s0. + + rewrite lte_fin -[in LHS](addr0 0%R) ltr_leD // lte_fin s0. by case: ltgtP t0 => // [t0|[<-{t}]] _; [rewrite gt_eqF|rewrite eqxx]. + by move: t0; rewrite lee_fin; case: (ltgtP t). - by rewrite ltry; case: ltgtP s0. @@ -2035,7 +2187,7 @@ rewrite /mule/=; move: x y z => [r| |] [s| |] [t| |] //= s0 t0. - by rewrite ltry. - rewrite !eqe paddr_eq0 //; move: s0; rewrite lee_fin. case: (ltgtP s) => //= [s0|->{s}] _; rewrite ?add0e. - + rewrite lte_fin -[in LHS](addr0 0%R) ltr_le_add // lte_fin s0. + + rewrite lte_fin -[in LHS](addr0 0%R) ltr_leD // lte_fin s0. by case: ltgtP t0 => // [t0|[<-{t}]]. + by move: t0; rewrite lee_fin; case: (ltgtP t). - by rewrite ltry; case: ltgtP s0. @@ -2055,7 +2207,7 @@ rewrite /mule/=; move: x y z => [r| |] [s| |] [t| |] //= s0 t0. - by case: ltgtP => //; rewrite adde0. - rewrite !eqe naddr_eq0 //; move: s0; rewrite lee_fin. case: (ltgtP s) => //= [s0|->{s}] _; rewrite ?add0e. - + rewrite !lte_fin -[in LHS](addr0 0%R) ltNge ler_add // ?ltW //=. + + rewrite !lte_fin -[in LHS](addr0 0%R) ltNge lerD // ?ltW //=. by rewrite !ltNge ltW //. + by case: (ltgtP t). - by rewrite ltry; case: ltgtP s0. @@ -2063,7 +2215,7 @@ rewrite /mule/=; move: x y z => [r| |] [s| |] [t| |] //= s0 t0. - by rewrite ltry. - rewrite !eqe naddr_eq0 //; move: s0; rewrite lee_fin. case: (ltgtP s) => //= [s0|->{s}] _; rewrite ?add0e. - + rewrite !lte_fin -[in LHS](addr0 0%R) ltNge ler_add // ?ltW //=. + + rewrite !lte_fin -[in LHS](addr0 0%R) ltNge lerD // ?ltW //=. by rewrite !ltNge ltW // -lee_fin t0; case: eqP. + by case: (ltgtP t). - by rewrite ltNge s0 /=; case: eqP. @@ -2076,7 +2228,7 @@ Proof. by move=> y0 z0; rewrite !(muleC x) le0_muleDl. Qed. Lemma gee_pmull y x : y \is a fin_num -> 0 < x -> y <= 1 -> y * x <= x. Proof. move: x y => [x| |] [y| |] _ //=. -- by rewrite lte_fin => x0 r0; rewrite /mule/= lee_fin ger_pmull. +- by rewrite lte_fin => x0 r0; rewrite /mule/= lee_fin ger_pMl. - by move=> _; rewrite /mule/= eqe => r1; rewrite leey. Qed. @@ -2084,7 +2236,7 @@ Lemma lee_wpmul2r x : 0 <= x -> {homo *%E^~ x : y z / y <= z}. Proof. move: x => [x|_|//]. rewrite lee_fin le_eqVlt => /predU1P[<- y z|x0]; first by rewrite 2!mule0. - move=> [y| |] [z| |]//; first by rewrite !lee_fin// ler_pmul2r. + move=> [y| |] [z| |]//; first by rewrite !lee_fin// ler_pM2r. - by move=> _; rewrite mulr_infty gtr0_sg// mul1e leey. - by move=> _; rewrite mulr_infty gtr0_sg// mul1e leNye. - by move=> _; rewrite 2!mulr_infty gtr0_sg// 2!mul1e. @@ -2136,6 +2288,16 @@ Proof. by move=> F0; rewrite muleC le0_sume_distrl//; under eq_bigr do rewrite muleC. Qed. +Lemma fin_num_sume_distrr (I : Type) (s : seq I) x (P : pred I) + (F : I -> \bar R) : + x \is a fin_num -> {in P &, forall i j, F i +? F j} -> + x * (\sum_(i <- s | P i) F i) = \sum_(i <- s | P i) x * F i. +Proof. +move=> xfin PF; elim: s => [|h t ih]; first by rewrite !big_nil mule0. +rewrite !big_cons; case: ifPn => Ph //. +by rewrite muleDr// ?ih// adde_def_sum// => i Pi; rewrite PF. +Qed. + Lemma eq_infty x : (forall r, r%:E <= x) -> x = +oo. Proof. case: x => [x /(_ (x + 1)%R)|//|/(_ 0%R)//]. @@ -2148,7 +2310,7 @@ move=> *; apply: (can_inj oppeK); apply: eq_infty => r. by rewrite lee_oppr -EFinN. Qed. -Lemma lee_opp x y : (- x <= - y) = (y <= x). +Lemma leeN2 x y : (- x <= - y) = (y <= x). Proof. by rewrite lee_oppl oppeK. Qed. Lemma lee_abs x : x <= `|x|. @@ -2169,7 +2331,7 @@ Qed. Lemma lee_abs_add x y : `|x + y| <= `|x| + `|y|. Proof. -by move: x y => [x| |] [y| |] //; rewrite /abse -EFinD lee_fin ler_norm_add. +by move: x y => [x| |] [y| |] //; rewrite /abse -EFinD lee_fin ler_normD. Qed. Lemma lee_abs_sum (I : Type) (s : seq I) (F : I -> \bar R) (P : pred I) : @@ -2181,7 +2343,7 @@ Qed. Lemma lee_abs_sub x y : `|x - y| <= `|x| + `|y|. Proof. -by move: x y => [x| |] [y| |] //; rewrite /abse -EFinD lee_fin ler_norm_sub. +by move: x y => [x| |] [y| |] //; rewrite /abse -EFinD lee_fin ler_normB. Qed. Lemma abseM : {morph @abse R : x y / x * y}. @@ -2201,26 +2363,34 @@ move=> [x| |] [y| |] //=; first by rewrite normrM. - by rewrite mulyy. Qed. -Lemma maxEFin r1 r2 : maxe r1%:E r2%:E = (Num.max r1 r2)%:E. +Lemma fine_max : + {in fin_num &, {mono @fine R : x y / maxe x y >-> (Num.max x y)%:E}}. Proof. -by have [ab|ba] := leP r1 r2; +by move=> [x| |] [y| |]//= _ _; apply/esym; have [ab|ba] := leP x y; [apply/max_idPr; rewrite lee_fin|apply/max_idPl; rewrite lee_fin ltW]. Qed. -Lemma minEFin r1 r2 : mine r1%:E r2%:E = (Num.min r1 r2)%:E. +Lemma EFin_max : {morph (@EFin R) : r s / Num.max r s >-> maxe r s}. +Proof. by move=> a b /=; rewrite -fine_max. Qed. + +Lemma fine_min : + {in fin_num &, {mono @fine R : x y / mine x y >-> (Num.min x y)%:E}}. Proof. -by have [ab|ba] := leP r1 r2; +by move=> [x| |] [y| |]//= _ _; apply/esym; have [ab|ba] := leP x y; [apply/min_idPl; rewrite lee_fin|apply/min_idPr; rewrite lee_fin ltW]. Qed. -Lemma adde_maxl : left_distributive (@adde R) maxe. +Lemma EFin_min : {morph (@EFin R) : r s / Num.min r s >-> mine r s}. +Proof. by move=> a b /=; rewrite -fine_min. Qed. + +Lemma adde_maxl : left_distributive (@GRing.add (\bar R)) maxe. Proof. move=> x y z; have [xy|yx] := leP x y. by apply/esym/max_idPr; rewrite lee_add2r. by apply/esym/max_idPl; rewrite lee_add2r// ltW. Qed. -Lemma adde_maxr : right_distributive (@adde R) maxe. +Lemma adde_maxr : right_distributive (@GRing.add (\bar R)) maxe. Proof. move=> x y z; have [yz|zy] := leP y z. by apply/esym/max_idPr; rewrite lee_add2l. @@ -2239,8 +2409,8 @@ Proof. by move=> x; have [//|] := leP -oo x; rewrite ltNge leNye. Qed. Lemma maxeNy : right_id (-oo : \bar R) maxe. Proof. by move=> x; rewrite maxC maxNye. Qed. -Canonical maxe_monoid := Monoid.Law maxA maxNye maxeNy. -Canonical maxe_comoid := Monoid.ComLaw maxC. +HB.instance Definition _ := + Monoid.isLaw.Build (\bar R) -oo maxe maxA maxNye maxeNy. Lemma minNye : left_zero (-oo : \bar R) mine. Proof. by move=> x; have [|//] := leP x -oo; rewrite leeNy_eq => /eqP. Qed. @@ -2254,13 +2424,11 @@ Proof. by move=> x; have [//|] := leP x +oo; rewrite ltNge leey. Qed. Lemma miney : right_id (+oo : \bar R) mine. Proof. by move=> x; rewrite minC minye. Qed. -Canonical mine_monoid := Monoid.Law minA minye miney. -Canonical mine_comoid := Monoid.ComLaw minC. Lemma oppe_max : {morph -%E : x y / maxe x y >-> mine x y : \bar R}. Proof. move=> [x| |] [y| |] //=. -- by rewrite maxEFin minEFin -EFinN oppr_max. +- by rewrite -fine_max//= -fine_min//= oppr_max. - by rewrite maxey mineNy. - by rewrite miney. - by rewrite minNye. @@ -2285,17 +2453,28 @@ Proof. by move=> zfin z0; rewrite muleC maxeMr// !(muleC z). Qed. Lemma mineMr z x y : z \is a fin_num -> 0 < z -> z * mine x y = mine (z * x) (z * y). Proof. -by move=> ? ?; rewrite -eqe_oppP -muleN oppe_min maxeMr// !muleN -oppe_min. +move=> fz zgt0. +by rewrite -eqe_oppP -muleN [in LHS]oppe_min maxeMr// !muleN -oppe_min. Qed. Lemma mineMl z x y : z \is a fin_num -> 0 < z -> mine x y * z = mine (x * z) (y * z). Proof. by move=> zfin z0; rewrite muleC mineMr// !(muleC z). Qed. +Lemma bigmaxe_fin_num (s : seq R) r : r \in s -> + \big[maxe/-oo%E]_(i <- s) i%:E \is a fin_num. +Proof. +move=> rs; have {rs} : s != [::]. + by rewrite -size_eq0 -lt0n -has_predT; apply/hasP; exists r. +elim: s => [//|a l]; have [-> _ _|_ /(_ isT) ih _] := eqVneq l [::]. + by rewrite big_seq1. +by rewrite big_cons {1}/maxe; case: (_ < _)%E. +Qed. + Lemma lee_pemull x y : 0 <= y -> 1 <= x -> y <= x * y. Proof. move: x y => [x| |] [y| |] //; last by rewrite mulyy. -- by rewrite -EFinM 3!lee_fin; exact: ler_pemull. +- by rewrite -EFinM 3!lee_fin; exact: ler_peMl. - move=> _; rewrite lee_fin => x1. by rewrite mulr_infty gtr0_sg ?mul1e// (lt_le_trans _ x1). - rewrite lee_fin le_eqVlt => /predU1P[<- _|y0 _]; first by rewrite mule0. @@ -2305,7 +2484,7 @@ Qed. Lemma lee_nemull x y : y <= 0 -> 1 <= x -> x * y <= y. Proof. move: x y => [x| |] [y| |] //; last by rewrite mulyNy. -- by rewrite -EFinM 3!lee_fin; exact: ler_nemull. +- by rewrite -EFinM 3!lee_fin; exact: ler_neMl. - move=> _; rewrite lee_fin => x1. by rewrite mulr_infty gtr0_sg ?mul1e// (lt_le_trans _ x1). - rewrite lee_fin le_eqVlt => /predU1P[-> _|y0 _]; first by rewrite mule0. @@ -2332,7 +2511,7 @@ Lemma lte_pmul x1 y1 x2 y2 : Proof. move: x1 y1 x2 y2 => [x1| |] [y1| |] [x2| |] [y2| |] //; rewrite !(lte_fin,lee_fin). -- by move=> *; rewrite ltr_pmul. +- by move=> *; rewrite ltr_pM. - move=> x10 x20 xy1 xy2. by rewrite mulry gtr0_sg ?mul1e -?EFinM ?ltry// (le_lt_trans _ xy1). - move=> x10 x20 xy1 xy2. @@ -2344,7 +2523,7 @@ Lemma lee_pmul x1 y1 x2 y2 : 0 <= x1 -> 0 <= x2 -> x1 <= y1 -> x2 <= y2 -> x1 * x2 <= y1 * y2. Proof. move: x1 y1 x2 y2 => [x1| |] [y1| |] [x2| |] [y2| |] //; rewrite !lee_fin. -- exact: ler_pmul. +- exact: ler_pM. - rewrite le_eqVlt => /predU1P[<- x20 y10 _|x10 x20 xy1 _]. by rewrite mul0e mule_ge0// leey. by rewrite mulr_infty gtr0_sg// ?mul1e ?leey// (lt_le_trans x10). @@ -2371,7 +2550,7 @@ Qed. Lemma lee_pmul2l x : x \is a fin_num -> 0 < x -> {mono *%E x : x y / x <= y}. Proof. move: x => [x _|//|//] /[!(@lte_fin R)] x0 [y| |] [z| |]. -- by rewrite -2!EFinM 2!lee_fin ler_pmul2l. +- by rewrite -2!EFinM 2!lee_fin ler_pM2l. - by rewrite mulry gtr0_sg// mul1e 2!leey. - by rewrite mulrNy gtr0_sg// mul1e 2!leeNy_eq. - by rewrite mulry gtr0_sg// mul1e 2!leye_eq. @@ -2385,6 +2564,37 @@ Qed. Lemma lee_pmul2r x : x \is a fin_num -> 0 < x -> {mono *%E^~ x : x y / x <= y}. Proof. by move=> xfin x0 y z; rewrite -2!(muleC x) lee_pmul2l. Qed. +Lemma lee_sqr x y : 0 <= x -> 0 <= y -> (x ^+ 2 <= y ^+ 2) = (x <= y). +Proof. +move=> xge0 yge0; apply/idP/idP; rewrite !expe2. + by apply: contra_le => yltx; apply: lte_pmul. +by move=> xley; apply: lee_pmul. +Qed. + +Lemma lte_sqr x y : 0 <= x -> 0 <= y -> (x ^+ 2 < y ^+ 2) = (x < y). +Proof. +move=> xge0 yge0; apply/idP/idP; rewrite !expe2. + by apply: contra_lt => yltx; apply: lee_pmul. +by move=> xley; apply: lte_pmul. +Qed. + +Lemma lee_sqrE x y : 0 <= y -> x ^+ 2 <= y ^+ 2 -> x <= y. +Proof. +move=> yge0; have [xge0|xlt0 x2ley2] := leP 0 x; first by rewrite lee_sqr. +exact: le_trans (ltW xlt0) _. +Qed. + +Lemma lte_sqrE x y : 0 <= y -> x ^+ 2 < y ^+ 2 -> x < y. +Proof. +move=> yge0; have [xge0|xlt0 x2ley2] := leP 0 x; first by rewrite lte_sqr. +exact: lt_le_trans xlt0 _. +Qed. + +Lemma sqre_ge0 x : 0 <= x ^+ 2. +Proof. +by case: x => [x||]; rewrite /= ?mulyy ?mulNyNy ?le0y//; apply: sqr_ge0. +Qed. + Lemma lee_paddl y x z : 0 <= x -> y <= z -> y <= x + z. Proof. by move=> *; rewrite -[y]add0e lee_add. Qed. @@ -2400,13 +2610,13 @@ Proof. by move=> *; rewrite addeC lte_paddl. Qed. Lemma lte_spaddre z x y : z \is a fin_num -> 0 < y -> z <= x -> z < x + y. Proof. move: z y x => [z| |] [y| |] [x| |] _ //=; rewrite ?(lte_fin,ltry)//. -exact: ltr_spaddr. +exact: ltr_pwDr. Qed. Lemma lte_spadder z x y : x \is a fin_num -> 0 < y -> z <= x -> z < x + y. Proof. move: z y x => [z| |] [y| |] [x| |] _ //=; rewrite ?(lte_fin,ltry,ltNyr)//. -exact: ltr_spaddr. +exact: ltr_pwDr. Qed. End ERealArithTh_realDomainType. @@ -2419,7 +2629,11 @@ Arguments lee_sum_npos_natl {R}. #[global] Hint Extern 0 (is_true (0 <= `| _ |)%E) => solve [apply: abse_ge0] : core. #[deprecated(since="mathcomp-analysis 0.6", note="Use lte_spaddre instead.")] -Notation lte_spaddr := lte_spaddre. +Notation lte_spaddr := lte_spaddre (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.5", note="Use leeN2 instead.")] +Notation lee_opp := leeN2 (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.5", note="Use lteN2 instead.")] +Notation lte_opp := lteN2 (only parsing). Module DualAddTheoryRealDomain. @@ -2430,22 +2644,22 @@ Import DualAddTheoryNumDomain. Local Open Scope ereal_dual_scope. Context {R : realDomainType}. -Implicit Types x y z a b : \bar R. +Implicit Types x y z a b : \bar^d R. Lemma dsube_lt0 x y : (x - y < 0) = (x < y). -Proof. by rewrite dual_addeE oppe_lt0 sube_gt0 lte_opp. Qed. +Proof. by rewrite dual_addeE oppe_lt0 sube_gt0 lteN2. Qed. Lemma dsube_ge0 x y : (0 <= y - x) = (x <= y). -Proof. by rewrite dual_addeE oppe_ge0 sube_le0 lee_opp. Qed. +Proof. by rewrite dual_addeE oppe_ge0 sube_le0 leeN2. Qed. Lemma dsuber_le0 x y : y \is a fin_num -> (x - y <= 0) = (x <= y). Proof. -by move=> ?; rewrite dual_addeE oppe_le0 suber_ge0 ?fin_numN// lee_opp. +by move=> ?; rewrite dual_addeE oppe_le0 suber_ge0 ?fin_numN// leeN2. Qed. Lemma dsubre_le0 y x : y \is a fin_num -> (y - x <= 0) = (y <= x). Proof. -by move=> ?; rewrite dual_addeE oppe_le0 subre_ge0 ?fin_numN// lee_opp. +by move=> ?; rewrite dual_addeE oppe_le0 subre_ge0 ?fin_numN// leeN2. Qed. Lemma dsube_le0 x y : (x \is a fin_num) || (y \is a fin_num) -> @@ -2453,7 +2667,7 @@ Lemma dsube_le0 x y : (x \is a fin_num) || (y \is a fin_num) -> Proof. by move=> /orP[?|?]; [rewrite dsuber_le0|rewrite dsubre_le0]. Qed. Lemma lte_dadd a b x y : a < b -> x < y -> a + x < b + y. -Proof. rewrite !dual_addeE lte_opp -lte_opp -(lte_opp y); exact: lte_add. Qed. +Proof. rewrite !dual_addeE lteN2 -lteN2 -(lteN2 y); exact: lte_add. Qed. Lemma lee_daddl x y : 0 <= y -> x <= x + y. Proof. rewrite dual_addeE lee_oppr -oppe_le0; exact: gee_addl. Qed. @@ -2481,150 +2695,144 @@ Proof. by rewrite -fin_numN dual_addeE lte_oppl oppeK; exact: lte_addr. Qed. Lemma gte_daddl x y : x \is a fin_num -> (x + y < x) = (y < 0). Proof. -by rewrite -fin_numN dual_addeE lte_oppl -oppe0 lte_oppr; exact: lte_addl. +by rewrite -fin_numN dual_addeE lte_oppl -[0]oppe0 lte_oppr; exact: lte_addl. Qed. Lemma gte_daddr x y : x \is a fin_num -> (y + x < x) = (y < 0). Proof. by rewrite daddeC; exact: gte_daddl. Qed. Lemma lte_dadd2lE x a b : x \is a fin_num -> (x + a < x + b) = (a < b). -Proof. -by move=> ?; rewrite !dual_addeE lte_opp lte_add2lE ?fin_numN// lte_opp. -Qed. +Proof. by move=> ?; rewrite !dual_addeE lteN2 lte_add2lE ?fin_numN// lteN2. Qed. Lemma lee_dadd2l x a b : a <= b -> x + a <= x + b. -Proof. rewrite !dual_addeE lee_opp -lee_opp; exact: lee_add2l. Qed. +Proof. rewrite !dual_addeE leeN2 -leeN2; exact: lee_add2l. Qed. Lemma lee_dadd2lE x a b : x \is a fin_num -> (x + a <= x + b) = (a <= b). -Proof. -by move=> ?; rewrite !dual_addeE lee_opp lee_add2lE ?fin_numN// lee_opp. -Qed. +Proof. by move=> ?; rewrite !dual_addeE leeN2 lee_add2lE ?fin_numN// leeN2. Qed. Lemma lee_dadd2r x a b : a <= b -> a + x <= b + x. -Proof. rewrite !dual_addeE lee_opp -lee_opp; exact: lee_add2r. Qed. +Proof. rewrite !dual_addeE leeN2 -leeN2; exact: lee_add2r. Qed. Lemma lee_dadd a b x y : a <= b -> x <= y -> a + x <= b + y. -Proof. rewrite !dual_addeE lee_opp -lee_opp -(lee_opp y); exact: lee_add. Qed. +Proof. rewrite !dual_addeE leeN2 -leeN2 -(leeN2 y); exact: lee_add. Qed. Lemma lte_le_dadd a b x y : b \is a fin_num -> a < x -> b <= y -> a + b < x + y. -Proof. rewrite !dual_addeE lte_opp -lte_opp; exact: lte_le_sub. Qed. +Proof. rewrite !dual_addeE lteN2 -lteN2; exact: lte_le_sub. Qed. Lemma lee_lt_dadd a b x y : a \is a fin_num -> a <= x -> b < y -> a + b < x + y. Proof. by move=> afin xa yb; rewrite (daddeC a) (daddeC x) lte_le_dadd. Qed. Lemma lee_dsub x y z t : x <= y -> t <= z -> x - z <= y - t. -Proof. rewrite !dual_addeE lee_oppl oppeK -lee_opp !oppeK; exact: lee_add. Qed. +Proof. rewrite !dual_addeE lee_oppl oppeK -leeN2 !oppeK; exact: lee_add. Qed. Lemma lte_le_dsub z u x y : u \is a fin_num -> x < z -> u <= y -> x - y < z - u. -Proof. -rewrite !dual_addeE lte_opp !oppeK -lte_opp; exact: lte_le_add. -Qed. +Proof. by rewrite !dual_addeE lteN2 !oppeK -lteN2; exact: lte_le_add. Qed. -Lemma lee_dsum I (f g : I -> \bar R) s (P : pred I) : +Lemma lee_dsum I (f g : I -> \bar^d R) s (P : pred I) : (forall i, P i -> f i <= g i) -> \sum_(i <- s | P i) f i <= \sum_(i <- s | P i) g i. Proof. -move=> Pfg; rewrite !dual_sumeE lee_opp. -apply: lee_sum => i Pi; rewrite lee_opp; exact: Pfg. +move=> Pfg; rewrite !dual_sumeE leeN2. +apply: lee_sum => i Pi; rewrite leeN2; exact: Pfg. Qed. -Lemma lee_dsum_nneg_subset I (s : seq I) (P Q : {pred I}) (f : I -> \bar R) : +Lemma lee_dsum_nneg_subset I (s : seq I) (P Q : {pred I}) (f : I -> \bar^d R) : {subset Q <= P} -> {in [predD P & Q], forall i, 0 <= f i} -> \sum_(i <- s | Q i) f i <= \sum_(i <- s | P i) f i. Proof. -move=> QP PQf; rewrite !dual_sumeE lee_opp. +move=> QP PQf; rewrite !dual_sumeE leeN2. apply: lee_sum_npos_subset => [//|i iPQ]; rewrite oppe_le0; exact: PQf. Qed. -Lemma lee_dsum_npos_subset I (s : seq I) (P Q : {pred I}) (f : I -> \bar R) : +Lemma lee_dsum_npos_subset I (s : seq I) (P Q : {pred I}) (f : I -> \bar^d R) : {subset Q <= P} -> {in [predD P & Q], forall i, f i <= 0} -> \sum_(i <- s | P i) f i <= \sum_(i <- s | Q i) f i. Proof. -move=> QP PQf; rewrite !dual_sumeE lee_opp. +move=> QP PQf; rewrite !dual_sumeE leeN2. apply: lee_sum_nneg_subset => [//|i iPQ]; rewrite oppe_ge0; exact: PQf. Qed. Lemma lee_dsum_nneg (I : eqType) (s : seq I) (P Q : pred I) - (f : I -> \bar R) : (forall i, P i -> ~~ Q i -> 0 <= f i) -> + (f : I -> \bar^d R) : (forall i, P i -> ~~ Q i -> 0 <= f i) -> \sum_(i <- s | P i && Q i) f i <= \sum_(i <- s | P i) f i. Proof. -move=> PQf; rewrite !dual_sumeE lee_opp. +move=> PQf; rewrite !dual_sumeE leeN2. apply: lee_sum_npos => i Pi nQi; rewrite oppe_le0; exact: PQf. Qed. Lemma lee_dsum_npos (I : eqType) (s : seq I) (P Q : pred I) - (f : I -> \bar R) : (forall i, P i -> ~~ Q i -> f i <= 0) -> + (f : I -> \bar^d R) : (forall i, P i -> ~~ Q i -> f i <= 0) -> \sum_(i <- s | P i) f i <= \sum_(i <- s | P i && Q i) f i. Proof. -move=> PQf; rewrite !dual_sumeE lee_opp. +move=> PQf; rewrite !dual_sumeE leeN2. apply: lee_sum_nneg => i Pi nQi; rewrite oppe_ge0; exact: PQf. Qed. -Lemma lee_dsum_nneg_ord (f : nat -> \bar R) (P : pred nat) : +Lemma lee_dsum_nneg_ord (f : nat -> \bar^d R) (P : pred nat) : (forall n, P n -> 0 <= f n)%E -> {homo (fun n => \sum_(i < n | P i) (f i)) : i j / (i <= j)%N >-> i <= j}. Proof. -move=> f0 m n mlen; rewrite !dual_sumeE lee_opp. +move=> f0 m n mlen; rewrite !dual_sumeE leeN2. apply: (lee_sum_npos_ord (fun i => - f i)%E) => [i Pi|//]. rewrite oppe_le0; exact: f0. Qed. -Lemma lee_dsum_npos_ord (f : nat -> \bar R) (P : pred nat) : +Lemma lee_dsum_npos_ord (f : nat -> \bar^d R) (P : pred nat) : (forall n, P n -> f n <= 0)%E -> {homo (fun n => \sum_(i < n | P i) (f i)) : i j / (i <= j)%N >-> j <= i}. Proof. -move=> f0 m n mlen; rewrite !dual_sumeE lee_opp. +move=> f0 m n mlen; rewrite !dual_sumeE leeN2. apply: (lee_sum_nneg_ord (fun i => - f i)%E) => [i Pi|//]. rewrite oppe_ge0; exact: f0. Qed. -Lemma lee_dsum_nneg_natr (f : nat -> \bar R) (P : pred nat) m : +Lemma lee_dsum_nneg_natr (f : nat -> \bar^d R) (P : pred nat) m : (forall n, (m <= n)%N -> P n -> 0 <= f n) -> {homo (fun n => \sum_(m <= i < n | P i) (f i)) : i j / (i <= j)%N >-> i <= j}. Proof. -move=> f0 i j le_ij; rewrite !dual_sumeE lee_opp. +move=> f0 i j le_ij; rewrite !dual_sumeE leeN2. apply: lee_sum_npos_natr => [n ? ?|//]; rewrite oppe_le0; exact: f0. Qed. -Lemma lee_dsum_npos_natr (f : nat -> \bar R) (P : pred nat) m : +Lemma lee_dsum_npos_natr (f : nat -> \bar^d R) (P : pred nat) m : (forall n, (m <= n)%N -> P n -> f n <= 0) -> {homo (fun n => \sum_(m <= i < n | P i) (f i)) : i j / (i <= j)%N >-> j <= i}. Proof. -move=> f0 i j le_ij; rewrite !dual_sumeE lee_opp. +move=> f0 i j le_ij; rewrite !dual_sumeE leeN2. apply: lee_sum_nneg_natr => [n ? ?|//]; rewrite oppe_ge0; exact: f0. Qed. -Lemma lee_dsum_nneg_natl (f : nat -> \bar R) (P : pred nat) n : +Lemma lee_dsum_nneg_natl (f : nat -> \bar^d R) (P : pred nat) n : (forall m, (m < n)%N -> P m -> 0 <= f m) -> {homo (fun m => \sum_(m <= i < n | P i) (f i)) : i j / (i <= j)%N >-> j <= i}. Proof. -move=> f0 i j le_ij; rewrite !dual_sumeE lee_opp. +move=> f0 i j le_ij; rewrite !dual_sumeE leeN2. apply: lee_sum_npos_natl => [m ? ?|//]; rewrite oppe_le0; exact: f0. Qed. -Lemma lee_dsum_npos_natl (f : nat -> \bar R) (P : pred nat) n : +Lemma lee_dsum_npos_natl (f : nat -> \bar^d R) (P : pred nat) n : (forall m, (m < n)%N -> P m -> f m <= 0) -> {homo (fun m => \sum_(m <= i < n | P i) (f i)) : i j / (i <= j)%N >-> i <= j}. Proof. -move=> f0 i j le_ij; rewrite !dual_sumeE lee_opp. +move=> f0 i j le_ij; rewrite !dual_sumeE leeN2. apply: lee_sum_nneg_natl => [m ? ?|//]; rewrite oppe_ge0; exact: f0. Qed. Lemma lee_dsum_nneg_subfset (T : choiceType) (A B : {fset T}%fset) (P : pred T) - (f : T -> \bar R) : {subset A <= B} -> + (f : T -> \bar^d R) : {subset A <= B} -> {in [predD B & A], forall t, P t -> 0 <= f t} -> \sum_(t <- A | P t) f t <= \sum_(t <- B | P t) f t. Proof. -move=> AB f0; rewrite !dual_sumeE lee_opp. +move=> AB f0; rewrite !dual_sumeE leeN2. apply: lee_sum_npos_subfset => [//|? ? ?]; rewrite oppe_le0; exact: f0. Qed. Lemma lee_dsum_npos_subfset (T : choiceType) (A B : {fset T}%fset) (P : pred T) - (f : T -> \bar R) : {subset A <= B} -> + (f : T -> \bar^d R) : {subset A <= B} -> {in [predD B & A], forall t, P t -> f t <= 0} -> \sum_(t <- B | P t) f t <= \sum_(t <- A | P t) f t. Proof. -move=> AB f0; rewrite !dual_sumeE lee_opp. +move=> AB f0; rewrite !dual_sumeE leeN2. apply: lee_sum_nneg_subfset => [//|? ? ?]; rewrite oppe_ge0; exact: f0. Qed. @@ -2719,7 +2927,9 @@ Lemma dsube_gt0 x y : (x \is a fin_num) || (y \is a fin_num) -> Proof. by move=> /orP[?|?]; [rewrite dsuber_gt0|rewrite dsubre_gt0]. Qed. Lemma dmuleDr x y z : x \is a fin_num -> y +? z -> x * (y + z) = x * y + x * z. -Proof. by move=> *; rewrite !dual_addeE muleN muleDr ?adde_defNN// !muleN. Qed. +Proof. +by move=> *; rewrite !dual_addeE/= muleN muleDr ?adde_defNN// !muleN. +Qed. Lemma dmuleDl x y z : x \is a fin_num -> y +? z -> (y + z) * x = y * x + z * x. Proof. by move=> *; rewrite -!(muleC x) dmuleDr. Qed. @@ -2736,7 +2946,8 @@ Proof. by move=> *; rewrite !dual_addeE mulNe ge0_muleDl ?oppe_ge0 ?mulNe. Qed. Lemma dle0_muleDr x y z : y <= 0 -> z <= 0 -> x * (y + z) = x * y + x * z. Proof. by move=> *; rewrite !dual_addeE muleN ge0_muleDr ?oppe_ge0 ?muleN. Qed. -Lemma ge0_dsume_distrl (I : Type) (s : seq I) x (P : pred I) (F : I -> \bar R) : +Lemma ge0_dsume_distrl (I : Type) (s : seq I) x (P : pred I) + (F : I -> \bar^d R) : (forall i, P i -> 0 <= F i) -> (\sum_(i <- s | P i) F i) * x = \sum_(i <- s | P i) (F i * x). Proof. @@ -2745,14 +2956,16 @@ move=> F0; rewrite !dual_sumeE !mulNe le0_sume_distrl => [|i Pi]. - by rewrite oppe_le0 F0. Qed. -Lemma ge0_dsume_distrr (I : Type) (s : seq I) x (P : pred I) (F : I -> \bar R) : +Lemma ge0_dsume_distrr (I : Type) (s : seq I) x (P : pred I) + (F : I -> \bar^d R) : (forall i, P i -> 0 <= F i) -> x * (\sum_(i <- s | P i) F i) = \sum_(i <- s | P i) (x * F i). Proof. by move=> F0; rewrite muleC ge0_dsume_distrl//; under eq_bigr do rewrite muleC. Qed. -Lemma le0_dsume_distrl (I : Type) (s : seq I) x (P : pred I) (F : I -> \bar R) : +Lemma le0_dsume_distrl (I : Type) (s : seq I) x (P : pred I) + (F : I -> \bar^d R) : (forall i, P i -> F i <= 0) -> (\sum_(i <- s | P i) F i) * x = \sum_(i <- s | P i) (F i * x). Proof. @@ -2761,7 +2974,8 @@ move=> F0; rewrite !dual_sumeE mulNe ge0_sume_distrl => [|i Pi]. - by rewrite oppe_ge0 F0. Qed. -Lemma le0_dsume_distrr (I : Type) (s : seq I) x (P : pred I) (F : I -> \bar R) : +Lemma le0_dsume_distrr (I : Type) (s : seq I) x (P : pred I) + (F : I -> \bar^d R) : (forall i, P i -> F i <= 0) -> x * (\sum_(i <- s | P i) F i) = \sum_(i <- s | P i) (x * F i). Proof. @@ -2770,10 +2984,10 @@ Qed. Lemma lee_abs_dadd x y : `|x + y| <= `|x| + `|y|. Proof. -by move: x y => [x| |] [y| |] //; rewrite /abse -dEFinD lee_fin ler_norm_add. +by move: x y => [x| |] [y| |] //; rewrite /abse -dEFinD lee_fin ler_normD. Qed. -Lemma lee_abs_dsum (I : Type) (s : seq I) (F : I -> \bar R) (P : pred I) : +Lemma lee_abs_dsum (I : Type) (s : seq I) (F : I -> \bar^d R) (P : pred I) : `|\sum_(i <- s | P i) F i| <= \sum_(i <- s | P i) `|F i|. Proof. elim/big_ind2 : _ => //; first by rewrite abse0. @@ -2782,13 +2996,13 @@ Qed. Lemma lee_abs_dsub x y : `|x - y| <= `|x| + `|y|. Proof. -by move: x y => [x| |] [y| |] //; rewrite /abse -dEFinD lee_fin ler_norm_sub. +by move: x y => [x| |] [y| |] //; rewrite /abse -dEFinD lee_fin ler_normB. Qed. -Lemma dadde_minl : left_distributive (@dual_adde R) mine. +Lemma dadde_minl : left_distributive (@GRing.add (\bar^d R)) mine. Proof. by move=> x y z; rewrite !dual_addeE oppe_min adde_maxl oppe_max. Qed. -Lemma dadde_minr : right_distributive (@dual_adde R) mine. +Lemma dadde_minr : right_distributive (@GRing.add (\bar^d R)) mine. Proof. by move=> x y z; rewrite !dual_addeE oppe_min adde_maxr oppe_max. Qed. Lemma dmule_natl x n : n%:R%:E * x = x *+ n. @@ -2809,13 +3023,13 @@ Proof. by move=> *; rewrite daddeC lte_pdaddl. Qed. Lemma lte_spdaddre z x y : z \is a fin_num -> 0 < y -> z <= x -> z < x + y. Proof. move: z y x => [z| |] [y| |] [x| |] _ //=; rewrite ?(lte_fin,ltry,ltNyr)//. -exact: ltr_spaddr. +exact: ltr_pwDr. Qed. Lemma lte_spdadder z x y : x \is a fin_num -> 0 < y -> z <= x -> z < x + y. Proof. move: z y x => [z| |] [y| |] [x| |] _ //=; rewrite ?(lte_fin,ltry,ltNyr)//. -exact: ltr_spaddr. +exact: ltr_pwDr. Qed. End DualERealArithTh_realDomainType. @@ -2830,14 +3044,14 @@ End DualAddTheoryRealDomain. Lemma lee_opp2 {R : numDomainType} : {mono @oppe R : x y /~ x <= y}. Proof. -move=> x y; case: x y => [?||] [?||] //; first by rewrite !lee_fin !ler_opp2. +move=> x y; case: x y => [?||] [?||] //; first by rewrite !lee_fin !lerN2. by rewrite /Order.le/= realN. by rewrite /Order.le/= realN. Qed. Lemma lte_opp2 {R : numDomainType} : {mono @oppe R : x y /~ x < y}. Proof. -move=> x y; case: x y => [?||] [?||] //; first by rewrite !lte_fin !ltr_opp2. +move=> x y; case: x y => [?||] [?||] //; first by rewrite !lte_fin !ltrN2. by rewrite /Order.lt/= realN. by rewrite /Order.lt/= realN. Qed. @@ -2847,17 +3061,24 @@ Variable R : realFieldType. Implicit Types x y : \bar R. Implicit Types r : R. -Lemma lee_adde x y : (forall e : {posnum R}, x <= y + e%:num%:E) -> x <= y. +Lemma lee_addgt0Pr x y : + reflect (forall e, (0 < e)%R -> x <= y + e%:E) (x <= y). +Proof. +apply/(iffP idP) => [|]. +- move: x y => [x| |] [y| |]//. + + by rewrite lee_fin => xy e e0; rewrite -EFinD lee_fin ler_wpDr// ltW. + + by move=> _ e e0; rewrite leNye. +- move: x y => [x| |] [y| |]// xy; rewrite ?leey ?leNye//; + [|by move: xy => /(_ _ lte01)..]. + by rewrite lee_fin; apply/ler_addgt0Pr => e e0; rewrite -lee_fin EFinD xy. +Qed. + +Lemma lee_subgt0Pr x y : + reflect (forall e, (0 < e)%R -> x - e%:E <= y) (x <= y). Proof. -move: x y => [x||] [y||] // xleye; rewrite ?leNye ?leey//; last first. -- exact: (le_trans (xleye 1%:pos%R)). -- by move: (!! xleye 1%:pos%R). -- by move: (!! xleye 1%:pos%R). -rewrite leNgt; apply/negP => yltx. -have xmy_gt0 : (0 < (x - y) / 2)%R by rewrite ltr_pdivl_mulr// mul0r subr_gt0. -move: (xleye (PosNum xmy_gt0)); apply/negP; rewrite -ltNge /= -EFinD lte_fin. -rewrite [Y in (Y + _)%R]splitr [X in (_ < X)%R]splitr. -by rewrite -!mulrDl ltr_pmul2r// addrCA addrK ltr_add2l. +apply/(iffP idP) => [xy e|xy]. + by rewrite lee_subl_addr//; move: e; exact/lee_addgt0Pr. +by apply/lee_addgt0Pr => e e0; rewrite -lee_subl_addr// xy. Qed. Lemma lee_mul01Pr x y : 0 <= x -> @@ -2875,7 +3096,7 @@ move: x y => [x||] [y||] // in x0 h *. rewrite lee_fin leNgt; apply/negP => yx. have /h : (0 < (y + x) / (2 * x) < 1)%R. apply/andP; split; first by rewrite divr_gt0 // ?addr_gt0// ?mulr_gt0. - by rewrite ltr_pdivr_mulr ?mulr_gt0// mul1r mulr_natl mulr2n ltr_add2r. + by rewrite ltr_pdivrMr ?mulr_gt0// mul1r mulr_natl mulr2n ltrD2r. rewrite -(EFinM _ x) lee_fin invrM ?unitfE// ?gt_eqF// -mulrA mulrAC. by rewrite mulVr ?unitfE ?gt_eqF// mul1r; apply/negP; rewrite -ltNge midf_lt. - by rewrite leey. @@ -2887,7 +3108,7 @@ Qed. Lemma lte_pdivr_mull r x y : (0 < r)%R -> (r^-1%:E * y < x) = (y < r%:E * x). Proof. move=> r0; move: x y => [x| |] [y| |] //=. -- by rewrite 2!lte_fin ltr_pdivr_mull. +- by rewrite 2!lte_fin ltr_pdivrMl. - by rewrite mulr_infty sgrV gtr0_sg// mul1e 2!ltNge 2!leey. - by rewrite mulr_infty sgrV gtr0_sg// mul1e -EFinM 2!ltNyr. - by rewrite mulr_infty gtr0_sg// mul1e 2!ltry. @@ -2904,7 +3125,7 @@ Proof. by move=> r0; rewrite muleC lte_pdivr_mull// muleC. Qed. Lemma lte_pdivl_mull r y x : (0 < r)%R -> (x < r^-1%:E * y) = (r%:E * x < y). Proof. move=> r0; move: x y => [x| |] [y| |] //=. -- by rewrite 2!lte_fin ltr_pdivl_mull. +- by rewrite 2!lte_fin ltr_pdivlMl. - by rewrite mulr_infty sgrV gtr0_sg// mul1e 2!ltry. - by rewrite mulr_infty sgrV gtr0_sg// mul1e. - by rewrite mulr_infty gtr0_sg// mul1e. @@ -2920,7 +3141,7 @@ Proof. by move=> r0; rewrite muleC lte_pdivl_mull// muleC. Qed. Lemma lte_ndivl_mulr r x y : (r < 0)%R -> (x < y * r^-1%:E) = (y < x * r%:E). Proof. -rewrite -oppr0 ltr_oppr => r0; rewrite -{1}(opprK r) invrN. +rewrite -oppr0 ltrNr => r0; rewrite -{1}(opprK r) invrN. by rewrite EFinN muleN lte_oppr lte_pdivr_mulr// EFinN muleNN. Qed. @@ -2929,7 +3150,7 @@ Proof. by move=> r0; rewrite muleC lte_ndivl_mulr// muleC. Qed. Lemma lte_ndivr_mull r x y : (r < 0)%R -> (r^-1%:E * y < x) = (r%:E * x < y). Proof. -rewrite -oppr0 ltr_oppr => r0; rewrite -{1}(opprK r) invrN. +rewrite -oppr0 ltrNr => r0; rewrite -{1}(opprK r) invrN. by rewrite EFinN mulNe lte_oppl lte_pdivl_mull// EFinN muleNN. Qed. @@ -2962,7 +3183,7 @@ Proof. by move=> r0; rewrite muleC lee_pdivl_mull// muleC. Qed. Lemma lee_ndivl_mulr r x y : (r < 0)%R -> (x <= y * r^-1%:E) = (y <= x * r%:E). Proof. -rewrite -oppr0 ltr_oppr => r0; rewrite -{1}(opprK r) invrN. +rewrite -oppr0 ltrNr => r0; rewrite -{1}(opprK r) invrN. by rewrite EFinN muleN lee_oppr lee_pdivr_mulr// EFinN muleNN. Qed. @@ -2971,13 +3192,21 @@ Proof. by move=> r0; rewrite muleC lee_ndivl_mulr// muleC. Qed. Lemma lee_ndivr_mull r x y : (r < 0)%R -> (r^-1%:E * y <= x) = (r%:E * x <= y). Proof. -rewrite -oppr0 ltr_oppr => r0; rewrite -{1}(opprK r) invrN. +rewrite -oppr0 ltrNr => r0; rewrite -{1}(opprK r) invrN. by rewrite EFinN mulNe lee_oppl lee_pdivl_mull// EFinN muleNN. Qed. Lemma lee_ndivr_mulr r x y : (r < 0)%R -> (y * r^-1%:E <= x) = (x * r%:E <= y). Proof. by move=> r0; rewrite muleC lee_ndivr_mull// muleC. Qed. +Lemma eqe_pdivr_mull r x y : (r != 0)%R -> + ((r^-1)%:E * y == x) = (y == r%:E * x). +Proof. +rewrite neq_lt => /orP[|] r0. +- by rewrite eq_le lee_ndivr_mull// lee_ndivl_mull// -eq_le. +- by rewrite eq_le lee_pdivr_mull// lee_pdivl_mull// -eq_le. +Qed. + End realFieldType_lemmas. Module DualAddTheoryRealField. @@ -2987,15 +3216,68 @@ Import DualAddTheoryNumDomain DualAddTheoryRealDomain. Section DualRealFieldType_lemmas. Local Open Scope ereal_dual_scope. Variable R : realFieldType. -Implicit Types x y : \bar R. +Implicit Types x y : \bar^d R. -Lemma lee_dadde x y : (forall e : {posnum R}, x <= y + e%:num%:E) -> x <= y. -Proof. by move=> xye; apply: lee_adde => e; case: x {xye} (xye e). Qed. +Lemma lee_daddgt0Pr x y : + reflect (forall e, (0 < e)%R -> x <= y + e%:E) (x <= y). +Proof. exact: lee_addgt0Pr. Qed. End DualRealFieldType_lemmas. End DualAddTheoryRealField. +Section sqrte. +Variable R : rcfType. +Implicit Types x y : \bar R. + +Definition sqrte x := + if x is +oo then +oo else if x is r%:E then (Num.sqrt r)%:E else 0. + +Lemma sqrte0 : sqrte 0 = 0 :> \bar R. +Proof. by rewrite /= sqrtr0. Qed. + +Lemma sqrte_ge0 x : 0 <= sqrte x. +Proof. by case: x => [x|//|]; rewrite /= ?leey// lee_fin sqrtr_ge0. Qed. + +Lemma lee_sqrt x y : 0 <= y -> (sqrte x <= sqrte y) = (x <= y). +Proof. +case: x y => [x||] [y||] yge0 //=. +- exact: mathcomp_extra.ler_sqrt. +- by rewrite !leey. +- by rewrite leNye lee_fin sqrtr_ge0. +Qed. + +Lemma sqrteM x y : 0 <= x -> sqrte (x * y) = sqrte x * sqrte y. +Proof. +case: x y => [x||] [y||] //= age0. +- by rewrite sqrtrM ?EFinM. +- move: age0; rewrite le_eqVlt eqe => /predU1P[<-|x0]. + by rewrite mul0e sqrte0 sqrtr0 mul0e. + by rewrite mulry gtr0_sg ?mul1e// mulry gtr0_sg ?mul1e// sqrtr_gt0. +- move: age0; rewrite mule0 mulrNy lee_fin -sgr_ge0. + by case: sgrP; rewrite ?mul0e ?sqrte0// ?mul1e// ler0N1. +- rewrite !mulyr; case: (sgrP y) => [->||]. + + by rewrite sqrtr0 sgr0 mul0e sqrte0. + + by rewrite mul1e/= -sqrtr_gt0 -sgr_gt0 -lte_fin => /gt0_muley->. + + by move=> y0; rewrite EFinN mulN1e/= ltr0_sqrtr// sgr0 mul0e. +- by rewrite mulyy. +- by rewrite mulyNy mule0. +Qed. + +Lemma sqr_sqrte x : 0 <= x -> sqrte x ^+ 2 = x. +Proof. +case: x => [x||] xge0; rewrite expe2 ?mulyy//. +by rewrite -sqrteM// -EFinM/= sqrtr_sqr ger0_norm. +Qed. + +Lemma sqrte_sqr x : sqrte (x ^+ 2) = `|x|%E. +Proof. by case: x => [x||//]; rewrite /expe/= ?sqrtr_sqr// mulyy. Qed. + +Lemma sqrte_fin_num x : 0 <= x -> (sqrte x \is a fin_num) = (x \is a fin_num). +Proof. by case: x => [x|//|//]; rewrite !qualifE/=. Qed. + +End sqrte. + Module DualAddTheory. Export DualAddTheoryNumDomain. Export DualAddTheoryRealDomain. @@ -3007,9 +3289,9 @@ Export DualAddTheory. End ConstructiveDualAddTheory. Definition posnume (R : numDomainType) of phant R := {> 0 : \bar R}. -Notation "{ 'posnum' '\bar' R }" := (@posnume _ (Phant R)) : type_scope. +Notation "{ 'posnum' '\bar' R }" := (@posnume _ (Phant R)) : type_scope. Definition nonnege (R : numDomainType) of phant R := {>= 0 : \bar R}. -Notation "{ 'nonneg' '\bar' R }" := (@nonnege _ (Phant R)) : type_scope. +Notation "{ 'nonneg' '\bar' R }" := (@nonnege _ (Phant R)) : type_scope. Notation "x %:pos" := (widen_signed x%:sgn : {posnum \bar _}) (only parsing) : ereal_dual_scope. @@ -3105,7 +3387,7 @@ Lemma adde_snum_subproof (xnz ynz : KnownSign.nullity) (y : {compare (0 : \bar R) & ynz & yr}) (rnz := add_nonzero_subdef xnz ynz xr yr) (rrl := add_reality_subdef xnz ynz xr yr) : - Signed.spec 0 rnz rrl (x%:num + y%:num). + Signed.spec 0 rnz rrl (adde x%:num y%:num). Proof. rewrite {}/rnz {}/rrl; apply/andP; split. move: xr yr xnz ynz x y => [[[]|]|] [[[]|]|] [] []//= x y; @@ -3113,7 +3395,7 @@ rewrite {}/rnz {}/rrl; apply/andP; split. move: xr yr xnz ynz x y => [[[]|]|] [[[]|]|] [] []//= x y; do ?[by case: (bottom x)|by case: (bottom y) |by rewrite adde_ge0|by rewrite adde_le0 - |exact: realDe|by rewrite 2!eq0 add0e]. + |exact: realDe|by rewrite 2!eq0 /adde/= addr0]. Qed. Canonical adde_snum (xnz ynz : KnownSign.nullity) @@ -3124,13 +3406,20 @@ Canonical adde_snum (xnz ynz : KnownSign.nullity) Import DualAddTheory. +Lemma dEFin_snum_subproof nz cond (x : {num R & nz & cond}) : + Signed.spec 0 nz cond (dEFin x%:num). +Proof. exact: EFin_snum_subproof. Qed. + +Canonical dEFin_snum nz cond (x : {num R & nz & cond}) := + Signed.mk (dEFin_snum_subproof x). + Lemma dadde_snum_subproof (xnz ynz : KnownSign.nullity) (xr yr : KnownSign.reality) (x : {compare (0 : \bar R) & xnz & xr}) (y : {compare (0 : \bar R) & ynz & yr}) (rnz := add_nonzero_subdef xnz ynz xr yr) (rrl := add_reality_subdef xnz ynz xr yr) : - Signed.spec 0 rnz rrl (x%:num + y%:num)%dE. + Signed.spec 0 rnz rrl (dual_adde x%:num y%:num)%dE. Proof. rewrite {}/rnz {}/rrl; apply/andP; split. move: xr yr xnz ynz x y => [[[]|]|] [[[]|]|] [] []//= x y; @@ -3138,7 +3427,7 @@ rewrite {}/rnz {}/rrl; apply/andP; split. move: xr yr xnz ynz x y => [[[]|]|] [[[]|]|] [] []//= x y; do ?[by case: (bottom x)|by case: (bottom y) |by rewrite dadde_ge0|by rewrite dadde_le0 - |exact: realDed|by rewrite 2!eq0 dadd0e]. + |exact: realDed|by rewrite 2!eq0 /dual_adde/= addr0]. Qed. Canonical dadde_snum (xnz ynz : KnownSign.nullity) @@ -3196,7 +3485,7 @@ Context {R : numDomainType} {nz : KnownSign.nullity} {cond : KnownSign.reality}. Local Notation nR := {compare (0 : \bar R) & nz & cond}. Implicit Types (a : \bar R). -Lemma num_abse_eq0 a : (`|a|%:nng == 0%:nng) = (a == 0). +Lemma num_abse_eq0 a : (`|a|%:nng == 0%:E%:nng) = (a == 0). Proof. by rewrite -abse_eq0. Qed. End MorphNum. @@ -3295,8 +3584,8 @@ Definition contract x : R := Lemma contract_lt1 r : (`|contract r%:E| < 1)%R. Proof. rewrite normrM normrV ?unitfE //. -rewrite ltr_pdivr_mulr // ?mul1r//; last by rewrite gtr0_norm. -by rewrite [ltRHS]gtr0_norm ?ltr_addr// ltr_spaddl. +rewrite ltr_pdivrMr // ?mul1r//; last by rewrite gtr0_norm. +by rewrite [ltRHS]gtr0_norm ?ltrDr// ltr_pwDl. Qed. Lemma contract_le1 x : (`|contract x| <= 1)%R. @@ -3305,7 +3594,7 @@ by case: x => [r| |] /=; rewrite ?normrN1 ?normr1 // (ltW (contract_lt1 _)). Qed. Lemma contract0 : contract 0 = 0%R. -Proof. by rewrite /contract mul0r. Qed. +Proof. by rewrite /contract/= mul0r. Qed. Lemma contractN x : contract (- x) = (- contract x)%R. Proof. by case: x => //= [r|]; [ rewrite normrN mulNr | rewrite opprK]. Qed. @@ -3322,15 +3611,15 @@ Proof. by move=> r1; rewrite /expand r1. Qed. Lemma expandN r : expand (- r)%R = - expand r. Proof. rewrite /expand; case: ifPn => [r1|]. - rewrite ifF; [by rewrite ifT // -ler_oppr|apply/negbTE]. - by rewrite -ltNge -(opprK r) -ltr_oppl (lt_le_trans _ r1) // -subr_gt0 opprK. -rewrite -ltNge => r1; case: ifPn; rewrite ler_oppl opprK; [by move=> ->|]. -by rewrite -ltNge leNgt => ->; rewrite leNgt -ltr_oppl r1 /= mulNr normrN. + rewrite ifF; [by rewrite ifT // -lerNr|apply/negbTE]. + by rewrite -ltNge -(opprK r) -ltrNl (lt_le_trans _ r1) // -subr_gt0 opprK. +rewrite -ltNge => r1; case: ifPn; rewrite lerNl opprK; [by move=> ->|]. +by rewrite -ltNge leNgt => ->; rewrite leNgt -ltrNl r1 /= mulNr normrN. Qed. Lemma expandN1 r : (r <= -1)%R -> expand r = -oo. Proof. -by rewrite ler_oppr => /expand1/eqP; rewrite expandN eqe_oppLR => /eqP. +by rewrite lerNr => /expand1/eqP; rewrite expandN eqe_oppLR => /eqP. Qed. Lemma expand0 : expand 0%R = 0. @@ -3341,7 +3630,7 @@ Proof. move=> r; rewrite inE le_eqVlt => /orP[|r1]. rewrite eqr_norml => /andP[/orP[]/eqP->{r}] _; by [rewrite expand1|rewrite expandN1]. -rewrite /expand 2!leNgt ltr_oppl; case/ltr_normlP : (r1) => -> -> /=. +rewrite /expand 2!leNgt ltrNl; case/ltr_normlP : (r1) => -> -> /=. have r_pneq0 : (1 + r / (1 - r) != 0)%R. rewrite -[X in (X + _)%R](@divrr _ (1 - r)%R) -?mulrDl; last first. by rewrite unitfE subr_eq0 eq_sym lt_eqF // ltr_normlW. @@ -3367,16 +3656,16 @@ Qed. Lemma le_contract : {mono contract : x y / (x <= y)%O}. Proof. apply: le_mono; move=> -[r0 | | ] [r1 | _ | _] //=. -- rewrite lte_fin => r0r1; rewrite ltr_pdivr_mulr ?ltr_paddr//. - rewrite mulrAC ltr_pdivl_mulr ?ltr_paddr// 2?mulrDr 2?mulr1. +- rewrite lte_fin => r0r1; rewrite ltr_pdivrMr ?ltr_wpDr//. + rewrite mulrAC ltr_pdivlMr ?ltr_wpDr// 2?mulrDr 2?mulr1. have [r10|?] := ler0P r1; last first. - rewrite ltr_le_add // mulrC; have [r00|//] := ler0P r0. - by rewrite (@le_trans _ _ 0%R) // ?pmulr_lle0// mulr_ge0// ?oppr_ge0// ltW. - have [?|r00] := ler0P r0; first by rewrite ltr_le_add // 2!mulrN mulrC. + rewrite ltr_leD // mulrC; have [r00|//] := ler0P r0. + by rewrite (@le_trans _ _ 0%R) // ?pmulr_rle0// mulr_ge0// ?oppr_ge0// ltW. + have [?|r00] := ler0P r0; first by rewrite ltr_leD // 2!mulrN mulrC. by move: (le_lt_trans r10 (lt_trans r00 r0r1)); rewrite ltxx. -- by rewrite ltr_pdivr_mulr ?ltr_paddr// mul1r ltr_spaddl // ler_norm. -- rewrite ltr_pdivl_mulr ?mulN1r ?ltr_paddr// => _. - by rewrite ltr_oppl ltr_spaddl // ler_normr lexx orbT. +- by rewrite ltr_pdivrMr ?ltr_wpDr// mul1r ltr_pwDl // ler_norm. +- rewrite ltr_pdivlMr ?mulN1r ?ltr_wpDr// => _. + by rewrite ltrNl ltr_pwDl // ler_normr lexx orbT. - by rewrite -subr_gt0 opprK. Qed. @@ -3393,7 +3682,7 @@ Definition expand_inj := mono_inj_in lexx le_anti le_expand_in. Lemma fine_expand r : (`|r| < 1)%R -> (fine (expand r))%:E = expand r. Proof. -by move=> r1; rewrite /expand 2!leNgt ltr_oppl; case/ltr_normlP : r1 => -> ->. +by move=> r1; rewrite /expand 2!leNgt ltrNl; case/ltr_normlP : r1 => -> ->. Qed. Lemma le_expand : {homo expand : x y / (x <= y)%O}. @@ -3401,9 +3690,9 @@ Proof. move=> x y xy; have [x1|] := lerP `|x| 1. have [y_le1|/ltW /expand1->] := leP y 1%R; last by rewrite leey. rewrite le_expand_in ?inE// ler_norml y_le1 (le_trans _ xy)//. - by rewrite ler_oppl (ler_normlP _ _ _). + by rewrite lerNl (ler_normlP _ _ _). rewrite ltr_normr => /orP[|] x1; last first. - by rewrite expandN1 // ?leNye // ler_oppr ltW. + by rewrite expandN1 // ?leNye // lerNr ltW. by rewrite expand1; [rewrite expand1 // (le_trans _ xy) // ltW | exact: ltW]. Qed. @@ -3419,7 +3708,7 @@ Qed. End contract_expand. Section ereal_PseudoMetric. -Variable R : realFieldType. +Context {R : realFieldType}. Implicit Types (x y : \bar R) (r : R). Definition ereal_ball x r y := (`|contract x - contract y| < r)%R. @@ -3434,7 +3723,7 @@ Lemma ereal_ball_triangle x y z r1 r2 : ereal_ball x r1 y -> ereal_ball y r2 z -> ereal_ball x (r1 + r2) z. Proof. rewrite /ereal_ball => h1 h2; rewrite -[X in (X - _)%R](subrK (contract y)). -by rewrite -addrA (le_lt_trans (ler_norm_add _ _)) // ltr_add. +by rewrite -addrA (le_lt_trans (ler_normD _ _)) // ltrD. Qed. Lemma ereal_ballN x y (e : {posnum R}) : @@ -3445,7 +3734,7 @@ Lemma ereal_ball_ninfty_oversize (e : {posnum R}) x : (2 < e%:num)%R -> ereal_ball -oo e%:num x. Proof. move=> e2; rewrite /ereal_ball /= (le_lt_trans _ e2) // -opprB normrN opprK. -rewrite (le_trans (ler_norm_add _ _)) // normr1 -ler_subr_addr. +rewrite (le_trans (ler_normD _ _)) // normr1 -lerBrDr. by rewrite (le_trans (contract_le1 _)) // (_ : 2 = 1 + 1)%R // addrK. Qed. @@ -3454,7 +3743,7 @@ Lemma contract_ereal_ball_pinfty r (e : {posnum R}) : Proof. move=> re1; rewrite /ereal_ball; rewrite [contract +oo]/= ler0_norm; last first. by rewrite subr_le0; case/ler_normlP: (contract_le1 r%:E). -by rewrite opprB ltr_subl_addl. +by rewrite opprB ltrBlDl. Qed. End ereal_PseudoMetric. @@ -3476,9 +3765,9 @@ move=> [:wlog]; case: a b => [a||] [b||] //= ltax ltxb. rewrite -subr_gt0 opprD addrA {1}[(b - r)%R]splitr addrK. by rewrite divr_gt0 ?subr_gt0. by rewrite -subr_gt0 addrAC {1}[(r - a)%R]splitr addrK divr_gt0 ?subr_gt0. -- have [//||d dP] := wlog a (r + 1)%R; rewrite ?lte_fin ?ltr_addl //. +- have [//||d dP] := wlog a (r + 1)%R; rewrite ?lte_fin ?ltrDl //. by exists d => y /dP /andP[->] /= /lt_le_trans; apply; rewrite leey. -- have [//||d dP] := wlog (r - 1)%R b; rewrite ?lte_fin ?gtr_addl ?ltrN10 //. +- have [//||d dP] := wlog (r - 1)%R b; rewrite ?lte_fin ?gtrDl ?ltrN10 //. by exists d => y /dP /andP[_ ->] /=; rewrite ltNyr. - by exists 1%:pos%R => ? ?; rewrite ltNyr ltry. Qed. diff --git a/theories/convex.v b/theories/convex.v new file mode 100644 index 000000000..d9bf76a32 --- /dev/null +++ b/theories/convex.v @@ -0,0 +1,277 @@ +(* mathcomp analysis (c) 2022 Inria and AIST. License: CeCILL-C. *) +From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum finmap. +From mathcomp Require Import matrix interval zmodp vector fieldext falgebra. +From mathcomp Require Import mathcomp_extra boolp classical_sets set_interval. +From mathcomp Require Import functions cardinality. +Require Import ereal reals signed topology prodnormedzmodule normedtype derive. +Require Import realfun itv. +From HB Require Import structures. + +(**md**************************************************************************) +(* # Convexity *) +(* *) +(* This file provides a small account of convexity using convex spaces, to be *) +(* completed with material from infotheo. *) +(* *) +(* ``` *) +(* isConvexSpace R T == interface for convex spaces *) +(* ConvexSpace R == structure of convex space *) +(* a <| t |> b == convexity operator *) +(* ``` *) +(* *) +(* E : lmodType R with R : realDomainType and R : realDomainType are shown to *) +(* be convex spaces with the following aliases: *) +(* convex_lmodType E == E : lmodType T as a convex spaces *) +(* convex_realDomainType R == R : realDomainType as a convex space *) +(* *) +(******************************************************************************) + +Reserved Notation "x <| p |> y" (format "x <| p |> y", at level 49). + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Import numFieldTopology.Exports. + +Local Open Scope classical_set_scope. +Local Open Scope ring_scope. + +Import numFieldNormedType.Exports. + +Declare Scope convex_scope. +Local Open Scope convex_scope. + +HB.mixin Record isConvexSpace (R : realDomainType) T := { + conv : {i01 R} -> T -> T -> T ; + conv0 : forall a b, conv 0%:i01 a b = a ; + convmm : forall (p : {i01 R}) a, conv p a a = a ; + convC : forall (p : {i01 R}) a b, conv p a b = conv (1 - p%:inum)%:i01 b a; + convA : forall (p q r : {i01 R}) (a b c : T), + p%:inum * (`1-(q%:inum)) = (`1-(p%:inum * q%:inum)) * r%:inum -> + conv p a (conv q b c) = conv (p%:inum * q%:inum)%:i01 (conv r a b) c +}. + +#[short(type=convType)] +HB.structure Definition ConvexSpace (R : realDomainType) := + {T of isConvexSpace R T & Choice T}. + +Notation "a <| p |> b" := (conv p a b) : convex_scope. + +Section convex_space_lemmas. +Context R (A : convType R). +Implicit Types a b : A. + +Lemma conv1 a b : a <| 1%:i01 |> b = b. +Proof. +rewrite convC/= [X in _ <| X |> _](_ : _ = 0%:i01) ?conv0//. +by apply/val_inj => /=; rewrite subrr. +Qed. + +End convex_space_lemmas. + +Local Open Scope convex_scope. + +Definition convex_lmodType {R : realDomainType} (E : lmodType R) : Type := E. + +Section lmodType_convex_space. +Context {R : realDomainType} {E' : lmodType R}. +Implicit Type p q r : {i01 R}. + +Let E := convex_lmodType E'. + +Let avg p (a b : E) := `1-(p%:inum) *: a + p%:inum *: b. + +Let avg0 a b : avg 0%:i01 a b = a. +Proof. by rewrite /avg/= onem0 scale0r scale1r addr0. Qed. + +Let avgI p x : avg p x x = x. +Proof. by rewrite /avg -scalerDl/= addrC add_onemK scale1r. Qed. + +Let avgC p x y : avg p x y = avg (1 - (p%:inum))%:i01 y x. +Proof. by rewrite /avg onemK addrC. Qed. + +Let avgA p q r (a b c : E) : + p%:inum * (`1-(q%:inum)) = (`1-(p%:inum * q%:inum)) * r%:inum -> + avg p a (avg q b c) = avg (p%:inum * q%:inum)%:i01 (avg r a b) c. +Proof. +move=> pq; rewrite /avg. +rewrite [in LHS]scalerDr [in LHS]addrA [in RHS]scalerDr; congr (_ + _ + _). +- rewrite scalerA; congr (_ *: _) => /=. + by rewrite mulrDr mulr1 mulrN -pq mulrBr mulr1 opprB addrA subrK. +- by rewrite 2!scalerA; congr (_ *: _). +- by rewrite scalerA. +Qed. + +HB.instance Definition _ := Choice.on E. + +HB.instance Definition _ := + isConvexSpace.Build R E avg0 avgI avgC avgA. + +End lmodType_convex_space. + +Definition convex_realDomainType (R : realDomainType) : Type := R^o. + +Section realDomainType_convex_space. +Context {R : realDomainType}. +Implicit Types p q : {i01 R}. + +Let E := @convex_realDomainType R. + +Let avg p (a b : convex_lmodType R^o) := a <| p |> b. + +Let avg0 a b : avg 0%:i01 a b = a. +Proof. by rewrite /avg conv0. Qed. + +Let avgI p x : avg p x x = x. +Proof. by rewrite /avg convmm. Qed. + +Let avgC p x y : avg p x y = avg (1 - (p%:inum))%:i01 y x. +Proof. by rewrite /avg convC. Qed. + +Let avgA p q r (a b c : R) : + p%:inum * (`1-(q%:inum)) = (`1-(p%:inum * q%:inum)) * r%:inum -> + avg p a (avg q b c) = avg (p%:inum * q%:inum)%:i01 (avg r a b) c. +Proof. by move=> h; rewrite /avg (convA _ _ r). Qed. + +HB.instance Definition _ := @isConvexSpace.Build R R^o + _ avg0 avgI avgC avgA. + +End realDomainType_convex_space. + +Section conv_realDomainType. +Context {R : realDomainType}. + +Lemma conv_gt0 (a b : R^o) (t : {i01 R}) : 0 < a -> 0 < b -> 0 < a <| t |> b. +Proof. +move=> a0 b0. +have [->|t0] := eqVneq t 0%:i01; first by rewrite conv0. +have [->|t1] := eqVneq t 1%:i01; first by rewrite conv1. +rewrite addr_gt0// mulr_gt0//; last by rewrite lt_neqAle eq_sym t0/=. +by rewrite onem_gt0// lt_neqAle t1/=. +Qed. + +Lemma convRE (a b : R^o) (t : {i01 R}) : a <| t |> b = `1-(t%:inum) * a + t%:inum * b. +Proof. by []. Qed. + +End conv_realDomainType. + +Definition convex_function (R : realType) (D : set R) (f : R -> R^o) := + forall (t : {i01 R}), {in D &, forall (x y : R^o), (f (x <| t |> y) <= f x <| t |> f y)%R}. +(* TODO: generalize to convTypes once we have ordered convTypes (mathcomp 2) *) + +(* ref: http://www.math.wisc.edu/~nagel/convexity.pdf *) +Section twice_derivable_convex. +Context {R : realType}. +Variables (f : R -> R^o) (a b : R^o). + +Let Df := 'D_1 f. +Let DDf := 'D_1 Df. + +Hypothesis DDf_ge0 : forall x, a < x < b -> 0 <= DDf x. +Hypothesis cvg_left : (f @ b^'-) --> f b. +Hypothesis cvg_right : (f @ a^'+) --> f a. + +Let L x := f a + factor a b x * (f b - f a). + +Let LE x : a < b -> L x = factor b a x * f a + factor a b x * f b. +Proof. +move=> ab; rewrite /L -(@onem_factor _ a) ?lt_eqF// /onem mulrBl mul1r. +by rewrite -addrA -mulrN -mulrDr (addrC (f b)). +Qed. + +Let convexf_ptP : a < b -> (forall x, a <= x <= b -> 0 <= L x - f x) -> + forall t, f (a <| t |> b) <= f a <| t |> f b. +Proof. +move=> ab h t; set x := a <| t |> b; have /h : a <= x <= b. + by rewrite -(conv1 a b) -{1}(conv0 a b) /x !le_line_path//= itv_ge0/=. +rewrite subr_ge0 => /le_trans; apply. +by rewrite LE// /x line_pathK ?lt_eqF// convC line_pathK ?gt_eqF. +Qed. + +Hypothesis HDf : {in `]a, b[, forall x, derivable f x 1}. +Hypothesis HDDf : {in `]a, b[, forall x, derivable Df x 1}. + +Let cDf : {within `]a, b[, continuous Df}. +Proof. by apply: derivable_within_continuous => z zab; exact: HDDf. Qed. + +Lemma second_derivative_convex (t : {i01 R}) : a <= b -> + f (a <| t |> b) <= f a <| t |> f b. +Proof. +rewrite le_eqVlt => /predU1P[<-|/[dup] ab]; first by rewrite !convmm. +move/convexf_ptP; apply => x /andP[]. +rewrite le_eqVlt => /predU1P[<-|ax]. + by rewrite /L factorl mul0r addr0 subrr. +rewrite le_eqVlt => /predU1P[->|xb]. + by rewrite /L factorr ?lt_eqF// mul1r addrAC addrA subrK subrr. +have [c2 Ic2 Hc2] : exists2 c2, x < c2 < b & (f b - f x) / (b - x) = 'D_1 f c2. + have xbf : {in `]x, b[, forall z, derivable f z 1} := + in1_subset_itv (subset_itvW _ _ (ltW ax) (lexx b)) HDf. + have derivef z : z \in `]x, b[ -> is_derive z 1 f ('D_1 f z). + by move=> zxb; apply/derivableP/xbf; exact: zxb. + have [|z zxb fbfx] := MVT xb derivef. + apply/(derivable_oo_continuous_bnd_within (And3 xbf _ cvg_left))/cvg_at_right_filter. + have := derivable_within_continuous HDf. + rewrite continuous_open_subspace//; last exact: interval_open. + by apply; rewrite inE/= in_itv/= ax. + by exists z => //; rewrite fbfx -mulrA divff ?mulr1// subr_eq0 gt_eqF. +have [c1 Ic1 Hc1] : exists2 c1, a < c1 < x & (f x - f a) / (x - a) = 'D_1 f c1. + have axf : {in `]a, x[, forall z, derivable f z 1} := + in1_subset_itv (subset_itvW _ _ (lexx a) (ltW xb)) HDf. + have derivef z : z \in `]a, x[ -> is_derive z 1 f ('D_1 f z). + by move=> zax; apply /derivableP/axf. + have [|z zax fxfa] := MVT ax derivef. + apply/(derivable_oo_continuous_bnd_within (And3 axf cvg_right _))/cvg_at_left_filter. + have := derivable_within_continuous HDf. + rewrite continuous_open_subspace//; last exact: interval_open. + by apply; rewrite inE/= in_itv/= ax. + by exists z => //; rewrite fxfa -mulrA divff ?mulr1// subr_eq0 gt_eqF. +have c1c2 : c1 < c2. + by move: Ic2 Ic1 => /andP[+ _] => /[swap] /andP[_] /lt_trans; apply. +have [d Id h] : + exists2 d, c1 < d < c2 & ('D_1 f c2 - 'D_1 f c1) / (c2 - c1) = DDf d. + have h : {in `]c1, c2[, forall z, derivable Df z 1}. + apply: (in1_subset_itv (subset_itvW _ _ (ltW (andP Ic1).1) (lexx _))). + apply: (in1_subset_itv (subset_itvW _ _ (lexx _) (ltW (andP Ic2).2))). + exact: HDDf. + have derivef z : z \in `]c1, c2[ -> is_derive z 1 Df ('D_1 Df z). + by move=> zc1c2; apply/derivableP/h. + have [|z zc1c2 {}h] := MVT c1c2 derivef. + apply: (derivable_oo_continuous_bnd_within (And3 h _ _)). + + apply: cvg_at_right_filter. + move: cDf; rewrite continuous_open_subspace//; last exact: interval_open. + by apply; rewrite inE/= in_itv/= (andP Ic1).1 (lt_trans _ (andP Ic2).2). + + apply: cvg_at_left_filter. + move: cDf; rewrite continuous_open_subspace//; last exact: interval_open. + by apply; rewrite inE/= in_itv/= (andP Ic2).2 (lt_trans (andP Ic1).1). + by exists z => //; rewrite h -mulrA divff ?mulr1// subr_eq0 gt_eqF. +have LfE : L x - f x = + ((x - a) * (b - x)) / (b - a) * ((f b - f x) / (b - x)) - + ((b - x) * factor a b x) * ((f x - f a) / (x - a)). + rewrite !mulrA -(mulrC (b - x)) -(mulrC (b - x)^-1) !mulrA. + rewrite mulVf ?mul1r ?subr_eq0 ?gt_eqF//. + rewrite -(mulrC (x - a)) -(mulrC (x - a)^-1) !mulrA. + rewrite mulVf ?mul1r ?subr_eq0 ?gt_eqF//. + rewrite -/(factor a b x). + rewrite -(opprB a b) -(opprB x b) invrN mulrNN -/(factor b a x). + rewrite -(@onem_factor _ a) ?lt_eqF//. + rewrite /onem mulrBl mul1r opprB addrA -mulrDr addrA subrK. + by rewrite /L -addrA addrC opprB -addrA (addrC (f a)). +have {Hc1 Hc2} -> : L x - f x = (b - x) * (x - a) * (c2 - c1) / (b - a) * + (('D_1 f c2 - 'D_1 f c1) / (c2 - c1)). + rewrite LfE Hc2 Hc1. + rewrite -(mulrC (b - x)) mulrA -mulrBr. + rewrite (mulrC ('D_1 f c2 - _)) ![in RHS]mulrA; congr *%R. + rewrite -2!mulrA; congr *%R. + by rewrite mulrCA divff ?mulr1// subr_eq0 gt_eqF. +rewrite {}h mulr_ge0//; last first. + rewrite DDf_ge0//; apply/andP; split. + by rewrite (lt_trans (andP Ic1).1)//; case/andP : Id. + by rewrite (lt_trans (andP Id).2)//; case/andP : Ic2. +rewrite mulr_ge0// ?invr_ge0 ?subr_ge0 ?(ltW ab)//. +rewrite mulr_ge0// ?subr_ge0 ?(ltW c1c2)//. +by rewrite mulr_ge0// subr_ge0 ltW. +Qed. + +End twice_derivable_convex. diff --git a/theories/derive.v b/theories/derive.v index ee880f394..e26f43103 100644 --- a/theories/derive.v +++ b/theories/derive.v @@ -1,10 +1,12 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) +From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrnum matrix interval. -From mathcomp.classical Require Import boolp classical_sets functions. -From mathcomp.classical Require Import mathcomp_extra. +From mathcomp Require Import mathcomp_extra boolp classical_sets functions. Require Import reals signed topology prodnormedzmodule normedtype landau forms. -(******************************************************************************) +(**md**************************************************************************) +(* # Differentiation *) +(* *) (* This file provides a theory of differentiation. It includes the standard *) (* rules of differentiation (differential of a sum, of a product, of *) (* exponentiation, of the inverse, etc.) as well as standard theorems (the *) @@ -12,12 +14,17 @@ Require Import reals signed topology prodnormedzmodule normedtype landau forms. (* *) (* Parsable notations (in all of the following, f is not supposed to be *) (* differentiable): *) +(* ``` *) (* 'd f x == the differential of a function f at a point x *) (* differentiable f x == the function f is differentiable at a point x *) (* 'J f x == the Jacobian of f at a point x *) (* 'D_v f == the directional derivative of f along v *) +(* derivable f a v == the function f is derivable at a with direction v *) +(* The type of f is V -> W with V W : normedModType R *) +(* and R : numFieldType *) (* f^`() == the derivative of f of domain R *) (* f^`(n) == the nth derivative of f of domain R *) +(* ``` *) (******************************************************************************) Set Implicit Arguments. @@ -49,7 +56,7 @@ Definition diff (F : filter_on V) (_ : phantom (set (set V)) F) (f : V -> W) := (get (fun (df : {linear V -> W}) => continuous df /\ forall x, f x = f (lim F) + df (x - lim F) +o_(x \near F) (x - lim F))). -Local Notation "''d' f x" := (@diff _ (Phantom _ [filter of x]) f). +Local Notation "''d' f x" := (@diff _ (Phantom _ (nbhs x)) f). Fact diff_key : forall T, T -> unit. Proof. by constructor. Qed. CoInductive differentiable_def (f : V -> W) (x : filter_on V) @@ -57,7 +64,8 @@ CoInductive differentiable_def (f : V -> W) (x : filter_on V) (continuous ('d f x) /\ f = cst (f (lim x)) + 'd f x \o center (lim x) +o_x (center (lim x))). -Local Notation differentiable f F := (@differentiable_def f _ (Phantom _ [filter of F])). +Local Notation differentiable f F := + (@differentiable_def f _ (Phantom _ (nbhs F))). Class is_diff_def (x : filter_on V) (Fph : phantom (set (set V)) x) (f : V -> W) (df : V -> W) := DiffDef { @@ -100,8 +108,9 @@ Section Differential_numFieldType. Context {K : numFieldType (*TODO: to numDomainType?*)} {V W : normedModType K}. (* duplicate from Section Differential *) -Local Notation differentiable f F := (@differentiable_def _ _ _ f _ (Phantom _ [filter of F])). -Local Notation "''d' f x" := (@diff _ _ _ _ (Phantom _ [filter of x]) f). +Local Notation differentiable f F := + (@differentiable_def _ _ _ f _ (Phantom _ (nbhs F))). +Local Notation "''d' f x" := (@diff _ _ _ _ (Phantom _ (nbhs x)) f). Hint Extern 0 (continuous _) => exact: diff_continuous : core. Lemma diff_locallyxP (x : V) (f : V -> W) : @@ -137,10 +146,10 @@ Proof. by move=> /diff_locallyP []. Qed. End Differential_numFieldType. -Notation "''d' f F" := (@diff _ _ _ _ (Phantom _ [filter of F]) f). -Notation differentiable f F := (@differentiable_def _ _ _ f _ (Phantom _ [filter of F])). +Notation "''d' f F" := (@diff _ _ _ _ (Phantom _ (nbhs F)) f). +Notation differentiable f F := (@differentiable_def _ _ _ f _ (Phantom _ (nbhs F))). -Notation "'is_diff' F" := (is_diff_def (Phantom _ [filter of F])). +Notation "'is_diff' F" := (is_diff_def (Phantom _ (nbhs F))). #[global] Hint Extern 0 (differentiable _ _) => solve[apply: ex_diff] : core. #[global] Hint Extern 0 ({for _, continuous _}) => exact: diff_continuous : core. @@ -182,7 +191,7 @@ Variables (X Y Z : normedModType R). Lemma normm_littleo x (f : X -> Y) : `| [o_(x \near x) (1 : R) of f x]| = 0. Proof. rewrite /cst /=; have [e /(_ (`|e x|/2) _)/nbhs_singleton /=] := littleo. -rewrite pmulr_lgt0 // [`|1|]normr1 mulr1 [leLHS]splitr ger_addr pmulr_lle0 //. +rewrite pmulr_lgt0 // [`|1|]normr1 mulr1 [leLHS]splitr gerDr pmulr_lle0 //. by move=> /implyP; case : real_ltgtP; rewrite ?realE ?normrE //= lexx. Qed. @@ -234,14 +243,14 @@ move=> df; apply/eqaddoP => _/posnumP[e]. rewrite -nbhs_nearE nbhs_simpl /= dnbhsE; split; last first. rewrite /at_point opprD -![(_ + _ : _ -> _) _]/(_ + _) scale0r add0r. by rewrite addrA subrr add0r normrN scale0r !normr0 mulr0. -have /eqolimP := df; rewrite -[lim _]/(derive _ _ _). +have /eqolimP := df. move=> /eqaddoP /(_ e%:num) /(_ [gt0 of e%:num]). apply: filter_app; rewrite /= !near_simpl near_withinE; near=> h => hN0. rewrite /= opprD -![(_ + _ : _ -> _) _]/(_ + _) -![(- _ : _ -> _) _]/(- _). rewrite /cst /= [`|1|]normr1 mulr1 => dfv. rewrite addrA -[X in X + _]scale1r -(@mulVf _ h) //. rewrite mulrC -scalerA -scalerBr normrZ. -rewrite -ler_pdivl_mull; last by rewrite normr_gt0. +rewrite -ler_pdivlMl; last by rewrite normr_gt0. by rewrite mulrCA mulVf ?mulr1; last by rewrite normr_eq0. Unshelve. all: by end_near. Qed. @@ -258,7 +267,7 @@ rewrite /= !(near_simpl, near_withinE); apply: filter_app; near=> h. rewrite /= opprD -![(_ + _ : _ -> _) _]/(_ + _) -![(- _ : _ -> _) _]/(- _). rewrite /cst /= [`|1|]normr1 mulr1 addrA => dfv hN0. rewrite -[X in _ - X]scale1r -(@mulVf _ h) //. -rewrite -scalerA -scalerBr normrZ normfV ler_pdivr_mull ?normr_gt0 //. +rewrite -scalerA -scalerBr normrZ normfV ler_pdivrMl ?normr_gt0 //. by rewrite mulrC. Unshelve. all: by end_near. Qed. @@ -313,15 +322,15 @@ have /(littleoP [littleo of k]) /nbhs_ballP[i i0 Hi] : 0 < e / (2 * `|v|). by rewrite divr_gt0 // pmulr_rgt0 // normr_gt0. exists (i / `|v|); first by rewrite /= divr_gt0 // normr_gt0. move=> /= j; rewrite /ball /= /ball_ add0r normrN. -rewrite ltr_pdivl_mulr ?normr_gt0 // => jvi j0. -rewrite add0r normrN normrZ -ltr_pdivl_mull ?normr_gt0 ?invr_neq0 //. +rewrite ltr_pdivlMr ?normr_gt0 // => jvi j0. +rewrite add0r normrN normrZ -ltr_pdivlMl ?normr_gt0 ?invr_neq0 //. have /Hi/le_lt_trans -> // : ball 0 i (j *: v). by rewrite -ball_normE/= add0r normrN (le_lt_trans _ jvi) // normrZ. -rewrite -(mulrC e) -mulrA -ltr_pdivl_mull // mulrA mulVr ?unitfE ?gt_eqF //. -rewrite normrV ?unitfE // div1r invrK ltr_pdivr_mull; last first. +rewrite -(mulrC e) -mulrA -ltr_pdivlMl // mulrA mulVr ?unitfE ?gt_eqF //. +rewrite normrV ?unitfE // div1r invrK ltr_pdivrMl; last first. by rewrite pmulr_rgt0 // normr_gt0. rewrite normrZ mulrC -mulrA. -by rewrite ltr_pmull ?ltr1n // pmulr_rgt0 ?normm_gt0 // normr_gt0. +by rewrite ltr_pMl ?ltr1n // pmulr_rgt0 ?normm_gt0 // normr_gt0. Qed. End DifferentialR_numFieldType. @@ -447,9 +456,9 @@ have /bigO_exP [_ /posnumP[k]] := bigOP [bigO of [O_ (0 : U) id of f]]. have := littleoP [littleo of [o_ (0 : V') id of g]]. move=> /(_ (e%:num / k%:num)) /(_ _) /nbhs_ballP [//|_ /posnumP[d] hd]. apply: filter_app; near=> x => leOxkx; apply: le_trans (hd _ _) _; last first. - rewrite -ler_pdivl_mull //; apply: le_trans leOxkx _. + rewrite -ler_pdivlMl //; apply: le_trans leOxkx _. by rewrite invf_div mulrA -[_ / _ * _]mulrA mulVf // mulr1. -by rewrite -ball_normE /= distrC subr0 (le_lt_trans leOxkx) // -ltr_pdivl_mull. +by rewrite -ball_normE /= distrC subr0 (le_lt_trans leOxkx) // -ltr_pdivlMl. Unshelve. all: by end_near. Qed. Lemma compoO_eqox (U V' W' : normedModType R) (f : U -> V') @@ -468,8 +477,8 @@ move=> /nbhs_ballP [_ /posnumP[d] hd]. have ekgt0 : e%:num / k%:num > 0 by []. have /(_ _ ekgt0) := littleoP [littleo of [o_ (0 : U) id of f]]. apply: filter_app; near=> x => leoxekx; apply: le_trans (hd _ _) _; last first. - by rewrite -ler_pdivl_mull // mulrA [_^-1 * _]mulrC. -by rewrite -ball_normE /= distrC subr0 (le_lt_trans leoxekx)// -ltr_pdivl_mull //. + by rewrite -ler_pdivlMl // mulrA [_^-1 * _]mulrC. +by rewrite -ball_normE /= distrC subr0 (le_lt_trans leoxekx)// -ltr_pdivlMl //. Unshelve. all: by end_near. Qed. End DifferentialR3. @@ -483,17 +492,17 @@ Proof. move/eqoP => oid. rewrite funeqE => x; apply/eqP; have [|xn0] := real_le0P (normr_real x). by rewrite normr_le0 => /eqP ->; rewrite linear0. -rewrite -normr_le0 -(mul0r `|x|) -ler_pdivr_mulr //. -apply/ler_gtP => _ /posnumP[e]; rewrite ler_pdivr_mulr //. +rewrite -normr_le0 -(mul0r `|x|) -ler_pdivrMr //. +apply/ler_gtP => _ /posnumP[e]; rewrite ler_pdivrMr //. have /oid /nbhs_ballP [_ /posnumP[d] dfe] := !! gt0 e. set k := ((d%:num / 2) / (PosNum xn0)%:num)^-1. rewrite -{1}(@scalerKV _ _ k _ x) /k // linearZZ normrZ. -rewrite -ler_pdivl_mull; last by rewrite gtr0_norm. +rewrite -ler_pdivlMl; last by rewrite gtr0_norm. rewrite mulrCA (@le_trans _ _ (e%:num * `|k^-1 *: x|)) //; last first. - by rewrite ler_pmul // normrZ normfV. + by rewrite ler_pM // normrZ normfV. apply: dfe; rewrite -ball_normE /= sub0r normrN normrZ. -rewrite invrK -ltr_pdivl_mulr // ger0_norm // ltr_pdivr_mulr //. -by rewrite -mulrA mulVf ?lt0r_neq0 // mulr1 [ltRHS]splitr ltr_addl. +rewrite invrK -ltr_pdivlMr // ger0_norm // ltr_pdivrMr //. +by rewrite -mulrA mulVf ?lt0r_neq0 // mulr1 [ltRHS]splitr ltrDl. Qed. Lemma diff_unique (V W : normedModType R) (f : V -> W) @@ -507,14 +516,16 @@ have hdf h : (f \o shift x = cst (f x) + h +o_ (0 : V) id) -> h = f \o shift x - cst (f x) +o_ (0 : V) id. move=> hdf; apply: eqaddoE. - rewrite hdf addrAC (addrC _ h) addrK. + rewrite hdf addrAC -!addrA addrC !addrA subrK. rewrite -[LHS]addr0 -addrA; congr (_ + _). by apply/eqP; rewrite eq_sym addrC addr_eq0 oppo. rewrite (hdf _ dxf). suff /diff_locally /hdf -> : differentiable f x. by rewrite opprD addrCA -(addrA (_ - _)) addKr oppox addox. -apply/diffP; apply: (@getPex _ (fun (df : {linear V -> W}) => continuous df /\ - forall y, f y = f (lim x) + df (y - lim x) +o_(y \near x) (y - lim x))). +apply/diffP => /=. +apply: (@getPex _ (fun (df : {linear V -> W}) => continuous df /\ + forall y, f y = f (lim (nbhs x)) + df (y - lim (nbhs x)) + +o_(y \near x) (y - lim (nbhs x)))). exists df; split=> //; apply: eqaddoEx => z. rewrite (hdf _ dxf) !addrA lim_id // /(_ \o _) /= subrK [f _ + _]addrC addrK. rewrite -addrA -[LHS]addr0; congr (_ + _). @@ -555,8 +566,7 @@ Qed. Lemma differentiable_sum n (f : 'I_n -> V -> W) (x : V) : (forall i, differentiable (f i) x) -> differentiable (\sum_(i < n) f i) x. Proof. -elim: n f => [f _| n IH f H]; first by rewrite big_ord0. -rewrite big_ord_recr /=; apply/differentiableD; [apply/IH => ? |]; exact: H. +by elim/big_ind : _ => // ? ? g h ?; apply: differentiableD; [exact:g|exact:h]. Qed. Lemma diffN (f : V -> W) x : @@ -614,7 +624,9 @@ Lemma diffZl (k : V -> R) (f : W) x : differentiable k x -> Proof. move=> df; set g := RHS; have glin : linear g. by move=> a u v; rewrite /g linearP /= scalerDl -scalerA. -by apply:(@diff_unique _ _ _ (Linear glin)); have [] := dscalel f df. +pose glM := GRing.isLinear.Build _ _ _ _ _ glin. +pose gL : {linear _ -> _} := HB.pack g glM. +by apply:(@diff_unique _ _ _ gL); have [] := dscalel f df. Qed. Lemma differentiableZl (k : V -> R) (f : W) x : @@ -636,8 +648,8 @@ Qed. Global Instance is_diff_id (x : V) : is_diff x id id. Proof. apply: DiffDef. - by apply: (@linear_differentiable _ _ [linear of idfun]) => ? //. -by rewrite (@diff_lin _ _ [linear of idfun]) // => ? //. + by apply: (@linear_differentiable _ _ idfun) => ? //. +by rewrite (@diff_lin _ _ idfun) // => ? //. Qed. Global Instance is_diff_scaler (k : R) (x : V) : is_diff x ( *:%R k) ( *:%R k). @@ -649,37 +661,41 @@ Qed. Global Instance is_diff_scalel (k : R) (x : V) : is_diff k ( *:%R ^~ x) ( *:%R ^~ x). Proof. -have sx_lin : linear ( *:%R ^~ x) by move=> u y z; rewrite scalerDl scalerA. -have -> : *:%R ^~ x = Linear sx_lin by rewrite funeqE. +have sx_lin : linear ( *:%R ^~ x : [the lmodType R of R : Type] -> _). + by move=> u y z; rewrite scalerDl scalerA. +pose sxlM := GRing.isLinear.Build _ _ _ _ _ sx_lin. +pose sxL : {linear _ -> _} := HB.pack ( *:%R ^~ x) sxlM. +have -> : *:%R ^~ x = sxL by rewrite funeqE. apply: DiffDef; first exact/linear_differentiable/scalel_continuous. -by rewrite diff_lin//; apply: scalel_continuous. +by rewrite diff_lin //; apply: scalel_continuous. Qed. Lemma differentiable_coord m n (M : 'M[R]_(m.+1, n.+1)) i j : differentiable (fun N : 'M[R]_(m.+1, n.+1) => N i j : R ) M. Proof. have @f : {linear 'M[R]_(m.+1, n.+1) -> R}. - by exists (fun N : 'M[R]_(_, _) => N i j); eexists; move=> ? ?; rewrite !mxE. + by exists (fun N : 'M[R]_(_, _) => N i j); do 2![eexists]; do ?[constructor]; + rewrite ?mxE// => ? *; rewrite ?mxE//; move=> ?; rewrite !mxE. rewrite (_ : (fun _ => _) = f) //; exact/linear_differentiable/coord_continuous. Qed. Lemma linear_lipschitz (V' W' : normedModType R) (f : {linear V' -> W'}) : continuous f -> exists2 k, k > 0 & forall x, `|f x| <= k * `|x|. Proof. -move=> /(_ 0); rewrite linear0 => /(_ _ (nbhsx_ballx 0 1%:pos)). +move=> /(_ 0); rewrite /continuous_at linear0 => /(_ _ (nbhsx_ballx _ _ ltr01)). move=> /nbhs_ballP [_ /posnumP[e] he]; exists (2 / e%:num) => // x. have [|xn0] := real_le0P (normr_real x). by rewrite normr_le0 => /eqP->; rewrite linear0 !normr0 mulr0. set k := 2 / e%:num * (PosNum xn0)%:num. have kn0 : k != 0 by rewrite /k. have abskgt0 : `|k| > 0 by rewrite normr_gt0. -rewrite -[x in leLHS](scalerKV kn0) linearZZ normrZ -ler_pdivl_mull //. +rewrite -[x in leLHS](scalerKV kn0) linearZZ normrZ -ler_pdivlMl //. suff /he : ball 0 e%:num (k^-1 *: x). rewrite -ball_normE /= distrC subr0 => /ltW /le_trans; apply. by rewrite ger0_norm /k // mulVf. rewrite -ball_normE /= distrC subr0 normrZ. rewrite normfV ger0_norm /k // invrM ?unitfE // mulrAC mulVf //. -by rewrite invf_div mul1r [ltRHS]splitr; apply: ltr_spaddr. +by rewrite invf_div mul1r [ltRHS]splitr; apply: ltr_pwDr. Qed. Lemma linear_eqO (V' W' : normedModType R) (f : {linear V' -> W'}) : @@ -735,7 +751,7 @@ Lemma bilinear_schwarz (U V' W' : normedModType R) (f : {bilinear U -> V' -> W'}) : continuous (fun p => f p.1 p.2) -> exists2 k, k > 0 & forall u v, `|f u v| <= k * `|u| * `|v|. Proof. -move=> /(_ 0); rewrite linear0r => /(_ _ (nbhsx_ballx 0 1%:pos)). +move=> /(_ 0); rewrite /continuous_at linear0r => /(_ _ (nbhsx_ballx _ _ ltr01)). move=> /nbhs_ballP [_ /posnumP[e] he]; exists ((2 / e%:num) ^+2) => // u v. have [|un0] := real_le0P (normr_real u). by rewrite normr_le0 => /eqP->; rewrite linear0l !normr0 mulr0 mul0r. @@ -745,12 +761,12 @@ rewrite -[`|u|]/((PosNum un0)%:num) -[`|v|]/((PosNum vn0)%:num). set ku := 2 / e%:num * (PosNum un0)%:num. set kv := 2 / e%:num * (PosNum vn0)%:num. rewrite -[X in f X](@scalerKV _ _ ku) /ku // linearZl_LR normrZ. -rewrite gtr0_norm // -ler_pdivl_mull //. +rewrite gtr0_norm // -ler_pdivlMl //. rewrite -[X in f _ X](@scalerKV _ _ kv) /kv // linearZr_LR normrZ. -rewrite gtr0_norm // -ler_pdivl_mull //. +rewrite gtr0_norm // -ler_pdivlMl //. suff /he : ball 0 e%:num (ku^-1 *: u, kv^-1 *: v). rewrite -ball_normE /= distrC subr0 => /ltW /le_trans; apply. - rewrite ler_pdivl_mull 1?pmulr_lgt0// mulr1 ler_pdivl_mull 1?pmulr_lgt0//. + rewrite ler_pdivlMl 1?pmulr_lgt0// mulr1 ler_pdivlMl 1?pmulr_lgt0//. by rewrite mulrA [ku * _]mulrAC expr2. rewrite -ball_normE /= distrC subr0. have -> : (ku^-1 *: u, kv^-1 *: v) = @@ -758,7 +774,7 @@ have -> : (ku^-1 *: u, kv^-1 *: v) = rewrite invrM ?unitfE // [kv ^-1]invrM ?unitfE //. rewrite mulrC -[_ *: u]scalerA [X in X *: v]mulrC -[_ *: v]scalerA. by rewrite invf_div. -rewrite normrZ ger0_norm // -mulrA gtr_pmulr // ltr_pdivr_mull // mulr1. +rewrite normrZ ger0_norm // -mulrA gtr_pMr // ltr_pdivrMl // mulr1. by rewrite prod_normE/= !normrZ !normfV !normr_id !mulVf ?gt_eqF// maxxx ltr1n. Qed. @@ -767,8 +783,8 @@ Lemma bilinear_eqo (U V' W' : normedModType R) (f : {bilinear U -> V' -> W'}) : Proof. move=> fc; have [_ /posnumP[k] fschwarz] := bilinear_schwarz fc. apply/eqoP=> _ /posnumP[e]; near=> x; rewrite (le_trans (fschwarz _ _))//. -rewrite ler_pmul ?pmulr_rge0 //; last by rewrite num_le_maxr /= lexx orbT. -rewrite -ler_pdivl_mull //. +rewrite ler_pM ?pmulr_rge0 //; last by rewrite num_le_maxr /= lexx orbT. +rewrite -ler_pdivlMl //. suff : `|x| <= k%:num ^-1 * e%:num by apply: le_trans; rewrite num_le_maxr /= lexx. near: x; rewrite !near_simpl; apply/nbhs_le_nbhs_norm. by exists (k%:num ^-1 * e%:num) => //= ? /=; rewrite /= distrC subr0 => /ltW. @@ -794,9 +810,12 @@ Lemma diff_bilin (U V' W' : normedModType R) (f : {bilinear U -> V' -> W'}) p : continuous (fun p => f p.1 p.2) -> 'd (fun q => f q.1 q.2) p = (fun q => f p.1 q.2 + f q.1 p.2) :> (U * V' -> W'). Proof. -move=> fc; have lind : linear (fun q => f p.1 q.2 + f q.1 p.2). - by move=> ???; rewrite linearPr linearPl scalerDr addrACA. -have -> : (fun q => f p.1 q.2 + f q.1 p.2) = Linear lind by []. +pose d q := f p.1 q.2 + f q.1 p.2. +move=> fc; have lind : linear d. + by move=> ???; rewrite /d linearPr linearPl scalerDr addrACA. +pose dlM := GRing.isLinear.Build _ _ _ _ _ lind. +pose dL : {linear _ -> _} := HB.pack d dlM. +rewrite -/d -[d]/(dL : _ -> _). by apply/diff_unique; have [] := dbilin p fc. Qed. @@ -807,22 +826,32 @@ Proof. by move=> fc; apply/diff_locallyP; rewrite diff_bilin //; apply: dbilin p fc. Qed. -Definition Rmult_rev (y x : R) := x * y. -Canonical rev_Rmult := @RevOp _ _ _ Rmult_rev (@GRing.mul [ringType of R]) - (fun _ _ => erefl). +Definition mulr_rev (y x : R) := x * y. +Canonical rev_mulr := @RevOp _ _ _ mulr_rev (@GRing.mul R) (fun _ _ => erefl). -Lemma Rmult_is_linear x : linear (@GRing.mul [ringType of R] x : R -> R). +Lemma mulr_is_linear x : linear (@GRing.mul R x : R -> R). Proof. by move=> ???; rewrite mulrDr scalerAr. Qed. -Canonical Rmult_linear x := Linear (Rmult_is_linear x). +HB.instance Definition _ x := GRing.isLinear.Build R R R _ ( *%R x) + (mulr_is_linear x). -Lemma Rmult_rev_is_linear y : linear (Rmult_rev y : R -> R). -Proof. by move=> ???; rewrite /Rmult_rev mulrDl scalerAl. Qed. -Canonical Rmult_rev_linear y := Linear (Rmult_rev_is_linear y). +Lemma mulr_rev_is_linear y : linear (mulr_rev y : R -> R). +Proof. by move=> ???; rewrite /mulr_rev mulrDl scalerAl. Qed. +HB.instance Definition _ y := GRing.isLinear.Build R R R _ (mulr_rev y) + (mulr_rev_is_linear y). -Canonical Rmult_bilinear := - [bilinear of (@GRing.mul [ringType of [lmodType R of R]])]. +Lemma mulr_is_bilinear : + bilinear_for + (GRing.Scale.Law.clone _ _ *:%R _) (GRing.Scale.Law.clone _ _ *:%R _) + (@GRing.mul R). +Proof. +split=> [u'|u] a x y /=. +- by rewrite mulrDl scalerAl. +- by rewrite mulrDr scalerAr. +Qed. +HB.instance Definition _ := bilinear_isBilinear.Build R R R R _ _ (@GRing.mul R) + mulr_is_bilinear. -Global Instance is_diff_Rmult (p : R*R ) : +Global Instance is_diff_mulr (p : R * R) : is_diff p (fun q => q.1 * q.2) (fun q => p.1 * q.2 + q.1 * p.2). Proof. apply: DiffDef; last by rewrite diff_bilin // => ?; apply: mul_continuous. @@ -859,9 +888,11 @@ Lemma diff_pair (U V' W' : normedModType R) (f : U -> V') (g : U -> W') x : (fun y => ('d f x y, 'd g x y)) :> (U -> V' * W'). Proof. move=> df dg. -have lin_pair : linear (fun y => ('d f x y, 'd g x y)). - by move=> ???; rewrite !linearPZ. -have -> : (fun y => ('d f x y, 'd g x y)) = Linear lin_pair by []. +pose d y := ('d f x y, 'd g x y). +have lin_pair : linear d by move=> ???; rewrite /d !linearPZ. +pose pairlM := GRing.isLinear.Build _ _ _ _ _ lin_pair. +pose pairL : {linear _ -> _} := HB.pack d pairlM. +rewrite -/d -[d]/(pairL : _ -> _). by apply: diff_unique; have [] := dpair df dg. Qed. @@ -885,8 +916,7 @@ Global Instance is_diffM (f g df dg : V -> R) x : Proof. move=> dfx dgx. have -> : f * g = (fun p => p.1 * p.2) \o (fun y => (f y, g y)) by []. -(* TODO: type class inference should succeed or fail, not leave an evar *) -apply: is_diff_eq; do ?exact: is_diff_comp. +apply: is_diff_eq. by rewrite funeqE => ?; rewrite /= [_ * g _]mulrC. Qed. @@ -931,31 +961,29 @@ have hDx_neq0 : h + x != 0. rewrite addrC -[X in X * _]mulr1 -{2}[1](@mulfVK _ (h + x)) //. rewrite mulrA expr_div_n expr1n mulf_div mulr1 [_ ^+ 2 * _]mulrC -mulrA. rewrite -mulrDr mulrBr [1 / _ * _]mulrC normrM. -rewrite mulrDl mulrDl opprD addrACA addrA [x * _]mulrC expr2. -do 2 ?[rewrite -addrA [- _ + _]addrC subrr addr0]. +rewrite mulrDl mulrDl opprD addrACA addrA [x * _]mulrC expr2 2!subrK. rewrite div1r normfV [X in _ / X]normrM invfM [X in _ * X]mulrC. -rewrite mulrA mulrAC ler_pdivr_mulr ?normr_gt0 ?mulf_neq0 //. -rewrite mulrAC ler_pdivr_mulr ?normr_gt0 //. +rewrite mulrA mulrAC ler_pdivrMr ?normr_gt0 ?mulf_neq0 //. +rewrite mulrAC ler_pdivrMr ?normr_gt0 //. have : `|h * h| <= `|x / 2| * (e%:num * `|x * x| * `|h|). rewrite !mulrA; near: h; exists (`|x / 2| * e%:num * `|x * x|). by rewrite /= !pmulr_rgt0 // normr_gt0 mulf_neq0. - by move=> h /ltW; rewrite distrC subr0 [`|h * _|]normrM => /ler_pmul; apply. -move=> /le_trans-> //; rewrite [leLHS]mulrC ler_pmul ?mulr_ge0 //. + by move=> h /ltW; rewrite distrC subr0 [`|h * _|]normrM => /ler_pM; apply. +move=> /le_trans -> //; rewrite [leLHS]mulrC ler_pM ?mulr_ge0 //. near: h; exists (`|x| / 2); first by rewrite /= divr_gt0 ?normr_gt0. move=> h; rewrite /= distrC subr0 => lthhx; rewrite addrC -[h]opprK. apply: le_trans (@ler_dist_dist _ R _ _). rewrite normrN [leRHS]ger0_norm; last first. rewrite subr_ge0; apply: ltW; apply: lt_le_trans lthhx _. - by rewrite ler_pdivr_mulr // -{1}(mulr1 `|x|) ler_pmul // ler1n. -rewrite ler_subr_addr -ler_subr_addl (splitr `|x|). + by rewrite ler_pdivrMr // -{1}(mulr1 `|x|) ler_pM // ler1n. +rewrite lerBrDr -lerBrDl (splitr `|x|). by rewrite normrM normfV (@ger0_norm _ 2) // -addrA subrr addr0; apply: ltW. Unshelve. all: by end_near. Qed. Lemma diff_Rinv (x : R) : x != 0 -> 'd GRing.inv x = (fun h : R => - x ^- 2 *: h) :> (R -> R). Proof. -move=> xn0; have -> : (fun h : R => - x ^- 2 *: h) = - GRing.scale_linear _ (- x ^- 2) by []. +move=> xn0; have -> : (fun h : R => - x ^- 2 *: h) = ( *:%R (- x ^- 2)) by []. by apply: diff_unique; have [] := dinv xn0. Qed. @@ -1013,19 +1041,22 @@ Qed. Lemma deriv1E f x : derivable f x 1 -> 'd f x = ( *:%R^~ (f^`() x)) :> (R -> U). Proof. -move=> df; have lin_scal : linear (fun h : R => h *: f^`() x). - by move=> ? ? ?; rewrite scalerDl scalerA. -have -> : (fun h => h *: f^`() x) = Linear lin_scal by []. +pose d (h : R) := h *: f^`() x. +move=> df; have lin_scal : linear d by move=> ???; rewrite /d scalerDl scalerA. +pose scallM := GRing.isLinear.Build _ _ _ _ _ lin_scal. +pose scalL : {linear _ -> _} := HB.pack d scallM. +rewrite -/d -[d]/(scalL : _ -> _). by apply: diff_unique; [apply: scalel_continuous|apply: der1]. Qed. Lemma diff1E f x : differentiable f x -> 'd f x = (fun h => h *: f^`() x) :> (R -> U). Proof. -move=> df; have lin_scal : linear (fun h : R => h *: 'd f x 1). - by move=> ? ? ?; rewrite scalerDl scalerA. -have -> : (fun h => h *: f^`() x) = Linear lin_scal. - by rewrite derive1E'. +pose d (h : R) := h *: 'd f x 1. +move=> df; have lin_scal : linear d by move=> ???; rewrite /d scalerDl scalerA. +pose scallM := GRing.isLinear.Build _ _ _ _ _ lin_scal. +pose scalL : {linear _ -> _} := HB.pack d scallM. +have -> : (fun h => h *: f^`() x) = scalL by rewrite derive1E'. apply: diff_unique; first exact: scalel_continuous. apply/eqaddoE; have /diff_locally -> := df; congr (_ + _ + _). by rewrite funeqE => h /=; rewrite -{1}[h]mulr1 linearZ. @@ -1042,6 +1073,14 @@ have -> : (fun h => (f \o shift x) h%:A) = f \o shift x. by have /diff_locally := dfx; rewrite diff1E // derive1E =>->. Qed. +Lemma derivable_within_continuous f (i : interval R) : + {in i, forall x, derivable f x 1} -> {within [set` i], continuous f}. +Proof. +move=> di; apply/continuous_in_subspaceT => z /[1!inE] zA. +apply/differentiable_continuous; rewrite -derivable1_diffP. +by apply: di; rewrite inE. +Qed. + End DeriveRU. Section DeriveVW. @@ -1114,9 +1153,7 @@ Global Instance is_derive_sum n (h : 'I_n -> V -> W) (x v : V) (dh : 'I_n -> W) : (forall i, is_derive x v (h i) (dh i)) -> is_derive x v (\sum_(i < n) h i) (\sum_(i < n) dh i). Proof. -elim: n h dh => [h dh dhx|h dh dhx n ihn]. - by rewrite !big_ord0 //; apply: is_derive_cst. -by rewrite !big_ord_recr /=; apply: is_deriveD. +by elim/big_ind2 : _ => // [|] *; [exact: is_derive_cst|exact: is_deriveD]. Qed. Lemma derivable_sum n (h : 'I_n -> V -> W) (x v : V) : @@ -1314,7 +1351,7 @@ have imf_sup : has_sup imf. have [M [Mreal imfltM]] : bounded_set (f @` `[a, b]). by apply/compact_bounded/continuous_compact => //; exact: segment_compact. exists (M + 1) => y /imfltM yleM. - by rewrite (le_trans _ (yleM _ _)) ?ler_norm ?ltr_addl. + by rewrite (le_trans _ (yleM _ _)) ?ler_norm ?ltrDl. have [|imf_ltsup] := pselect (exists2 c, c \in `[a, b]%R & f c = sup imf). move=> [c cab fceqsup]; exists c => // t tab; rewrite fceqsup. by apply/sup_upper_bound => //; exact/imageP. @@ -1332,9 +1369,9 @@ have /ex_strict_bound_gt0 [k k_gt0 /= imVfltk] : bounded_set (g @` `[a, b]). exact: invf_continuous. have [_ [t tab <-]] : exists2 y, imf y & sup imf - k^-1 < y. by apply: sup_adherent => //; rewrite invr_gt0. -rewrite ltr_subl_addr -ltr_subl_addl. +rewrite ltrBlDr -ltrBlDl. suff : sup imf - f t > k^-1 by move=> /ltW; rewrite leNgt => /negbTE ->. -rewrite -[ltRHS]invrK ltf_pinv// ?qualifE ?invr_gt0 ?subr_gt0 ?imf_ltsup//. +rewrite -[ltRHS]invrK ltf_pV2// ?qualifE/= ?invr_gt0 ?subr_gt0 ?imf_ltsup//. by rewrite (le_lt_trans (ler_norm _) _) ?imVfltk//; exact: imageP. Qed. @@ -1345,15 +1382,13 @@ Proof. move=> leab fcont. have /(EVT_max leab) [c clr fcmax] : {within `[a, b], continuous (- f)}. by move=> ?; apply: continuousN => ?; exact: fcont. -by exists c => // ? /fcmax; rewrite ler_opp2. +by exists c => // ? /fcmax; rewrite lerN2. Qed. Lemma cvg_at_rightE (R : numFieldType) (V : normedModType R) (f : R -> V) x : cvg (f @ x^') -> lim (f @ x^') = lim (f @ at_right x). Proof. move=> cvfx; apply/Logic.eq_sym. -(* should be inferred *) -have atrF := at_right_proper_filter x. apply: (@cvg_lim _ _ _ (at_right _)) => // A /cvfx /nbhs_ballP [_ /posnumP[e] xe_A]. by exists e%:num => //= y xe_y; rewrite lt_def => /andP [xney _]; apply: xe_A. Qed. @@ -1363,38 +1398,36 @@ Lemma cvg_at_leftE (R : numFieldType) (V : normedModType R) (f : R -> V) x : cvg (f @ x^') -> lim (f @ x^') = lim (f @ at_left x). Proof. move=> cvfx; apply/Logic.eq_sym. -(* should be inferred *) -have atrF := at_left_proper_filter x. apply: (@cvg_lim _ _ _ (at_left _)) => // A /cvfx /nbhs_ballP [_ /posnumP[e] xe_A]. exists e%:num => //= y xe_y; rewrite lt_def => /andP [xney _]. by apply: xe_A => //; rewrite eq_sym. Qed. Arguments cvg_at_leftE {R V} f x. -Lemma __deprecated__le0r_cvg_map (R : realFieldType) (T : topologicalType) (F : set (set T)) - (FF : ProperFilter F) (f : T -> R) : +Lemma __deprecated__le0r_cvg_map (R : realFieldType) (T : topologicalType) + (F : set_system T) (FF : ProperFilter F) (f : T -> R) : (\forall x \near F, 0 <= f x) -> cvg (f @ F) -> 0 <= lim (f @ F). Proof. by move=> ? ?; rewrite limr_ge. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="generalized by `limr_ge`")] -Notation le0r_cvg_map := __deprecated__le0r_cvg_map. +Notation le0r_cvg_map := __deprecated__le0r_cvg_map (only parsing). -Lemma __deprecated__ler0_cvg_map (R : realFieldType) (T : topologicalType) (F : set (set T)) - (FF : ProperFilter F) (f : T -> R) : +Lemma __deprecated__ler0_cvg_map (R : realFieldType) (T : topologicalType) + (F : set_system T) (FF : ProperFilter F) (f : T -> R) : (\forall x \near F, f x <= 0) -> cvg (f @ F) -> lim (f @ F) <= 0. Proof. by move=> ? ?; rewrite limr_le. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="generalized by `limr_le`")] -Notation ler0_cvg_map := __deprecated__ler0_cvg_map. +Notation ler0_cvg_map := __deprecated__ler0_cvg_map (only parsing). -Lemma __deprecated__ler_cvg_map (R : realFieldType) (T : topologicalType) (F : set (set T)) - (FF : ProperFilter F) (f g : T -> R) : +Lemma __deprecated__ler_cvg_map (R : realFieldType) (T : topologicalType) + (F : set_system T) (FF : ProperFilter F) (f g : T -> R) : (\forall x \near F, f x <= g x) -> cvg (f @ F) -> cvg (g @ F) -> lim (f @ F) <= lim (g @ F). Proof. by move=> ? ? ?; rewrite ler_lim. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="subsumed by `ler_lim`")] -Notation ler_cvg_map := __deprecated__ler_cvg_map. +Notation ler_cvg_map := __deprecated__ler_cvg_map (only parsing). Lemma derive1_at_max (R : realFieldType) (f : R -> R) (a b c : R) : a <= b -> (forall t, t \in `]a, b[%R -> derivable f t 1) -> c \in `]a, b[%R -> @@ -1413,8 +1446,8 @@ apply/eqP; rewrite eq_le; apply/andP; split. by rewrite invr_ge0; apply: ltW; near: h; exists 1 => /=. rewrite subr_le0 [_%:A]mulr1; apply: cmax; near: h. exists (b - c); first by rewrite /= subr_gt0 (itvP cab). - move=> h; rewrite /= distrC subr0 /= in_itv /= -ltr_subr_addr. - move=> /(le_lt_trans (ler_norm _)) -> /ltr_spsaddl -> //. + move=> h; rewrite /= distrC subr0 /= in_itv /= -ltrBrDr. + move=> /(le_lt_trans (ler_norm _)) -> /ltr_pDl -> //. by rewrite (itvP cab). rewrite ['D_1 f c]cvg_at_leftE; last exact: fdrvbl. apply: limr_ge. @@ -1427,8 +1460,8 @@ near=> h; apply: mulr_le0. rewrite subr_le0 [_%:A]mulr1; apply: cmax; near: h. exists (c - a); first by rewrite /= subr_gt0 (itvP cab). move=> h; rewrite /= distrC subr0. -move=> /ltr_normlP []; rewrite ltr_subr_addl ltr_subl_addl in_itv /= => -> _. -by move=> /ltr_snsaddl -> //; rewrite (itvP cab). +move=> /ltr_normlP []; rewrite ltrBrDl ltrBlDl in_itv /= => -> _. +by move=> /ltr_nDl -> //; rewrite (itvP cab). Unshelve. all: by end_near. Qed. Lemma derive1_at_min (R : realFieldType) (f : R -> R) (a b c : R) : @@ -1440,7 +1473,7 @@ apply/eqP; rewrite -oppr_eq0; apply/eqP. rewrite -deriveN; last exact: fdrvbl. suff df : is_derive c 1 (- f) 0 by rewrite derive_val. apply: derive1_at_max leab _ (cab) _ => t tab; first exact/derivableN/fdrvbl. -by rewrite ler_opp2; apply: cmin. +by rewrite lerN2; apply: cmin. Qed. Lemma Rolle (R : realType) (f : R -> R) (a b : R) : @@ -1540,7 +1573,7 @@ Lemma le0r_derive1_ndecr (R : realType) (f : R -> R) (a b : R) : {within `[a,b], continuous f} -> forall x y, a <= x -> x <= y -> y <= b -> f x <= f y. Proof. -move=> fdrvbl dfge0 fcont x y; rewrite -[f _ <= _]ler_opp2. +move=> fdrvbl dfge0 fcont x y; rewrite -[f _ <= _]lerN2. apply (@ler0_derive1_nincr _ (- f)) => t tab; first exact/derivableN/fdrvbl. rewrite derive1E deriveN; last exact: fdrvbl. by rewrite oppr_le0 -derive1E; apply: dfge0. @@ -1560,7 +1593,7 @@ Qed. Section is_derive_instances. Variables (R : numFieldType) (V : normedModType R). -Lemma derivable_cst (x : V) : derivable (fun=> x) 0 1. +Lemma derivable_cst (x : V) : derivable (fun=> x) 0 (1 : R). Proof. exact/diff_derivable. Qed. Lemma derivable_id (x v : V) : derivable id x v. @@ -1569,7 +1602,8 @@ Proof. exact/diff_derivable. Qed. Global Instance is_derive_id (x v : V) : is_derive x v id v. Proof. apply: (DeriveDef (@derivable_id _ _)). -by rewrite deriveE// (@diff_lin _ _ _ [linear of idfun]). +rewrite deriveE// (@diff_lin _ _ _ idfun)//=. +by rewrite /continuous_at. Qed. Global Instance is_deriveNid (x v : V) : is_derive x v -%R (- v). @@ -1579,5 +1613,5 @@ End is_derive_instances. (* Trick to trigger type class resolution *) Lemma trigger_derive (R : realType) (f : R -> R) x x1 y1 : - is_derive x 1 f x1 -> x1 = y1 -> is_derive x 1 f y1. + is_derive x (1 : R) f x1 -> x1 = y1 -> is_derive x 1 f y1. Proof. by move=> Hi <-. Qed. diff --git a/theories/ereal.v b/theories/ereal.v index 04d2dd682..1201c4ea3 100644 --- a/theories/ereal.v +++ b/theories/ereal.v @@ -4,33 +4,38 @@ (* Copyright (c) - 2015--2018 - Inria *) (* Copyright (c) - 2016--2018 - Polytechnique *) (* -------------------------------------------------------------------- *) - +From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra finmap. -From mathcomp.classical Require Import boolp classical_sets functions fsbigop. -From mathcomp.classical Require Import cardinality set_interval mathcomp_extra. +From mathcomp Require Import mathcomp_extra boolp classical_sets functions. +From mathcomp Require Import fsbigop cardinality set_interval. Require Import reals signed topology. Require Export constructive_ereal. -(******************************************************************************) -(* Extended real numbers, classical part *) -(* *) -(* This is an addition to the file ereal.v with classical logic elements. *) +(**md**************************************************************************) +(* # Extended real numbers, classical part ($\overline{\mathbb{R}}$) *) (* *) +(* This is an addition to the file constructive_ereal.v with classical logic *) +(* elements. *) +(* ``` *) (* (\sum_(i \in A) f i)%E == finitely supported sum, see fsbigop.v *) (* *) (* ereal_sup E == supremum of E *) (* ereal_inf E == infimum of E *) (* ereal_supremums_neq0 S == S has a supremum *) +(* ``` *) (* *) -(* Topology of extended real numbers: *) +(* ## Topology of extended real numbers *) +(* ``` *) (* ereal_topologicalType R == topology for extended real numbers over *) (* R, a realFieldType *) (* ereal_pseudoMetricType R == pseudometric space for extended reals *) (* over R where is a realFieldType; the *) (* distance between x and y is defined by *) (* `|contract x - contract y| *) +(* ``` *) (* *) -(* Filters: *) +(* ## Filters *) +(* ``` *) (* ereal_dnbhs x == filter on extended real numbers that *) (* corresponds to the deleted neighborhood *) (* x^' if x is a real number and to *) @@ -40,6 +45,7 @@ Require Export constructive_ereal. (* replaced with nbhs. *) (* ereal_loc_seq x == sequence that converges to x in the set *) (* of extended real numbers. *) +(* ``` *) (* *) (******************************************************************************) @@ -76,7 +82,7 @@ Qed. Local Close Scope classical_set_scope. -Notation "\sum_ ( i '\in' A ) F" := (\big[+%dE/0%E]_(i \in A) F%dE) : +Notation "\sum_ ( i '\in' A ) F" := (\big[+%dE/0%dE]_(i \in A) F%dE) : ereal_dual_scope. Notation "\sum_ ( i '\in' A ) F" := (\big[+%E/0%E]_(i \in A) F%E) : ereal_scope. @@ -98,6 +104,26 @@ rewrite predeqE => t; split => //=; apply/eqP. by rewrite gt_eqF// (lt_le_trans _ (abse_ge0 t)). Qed. +Lemma compreDr T (h : R -> \bar R) (f g : T -> R) : + {morph h : x y / (x + y)%R >-> (x + y)%E} -> + h \o (f \+ g)%R = ((h \o f) \+ (h \o g))%E. +Proof. by move=> mh; apply/funext => t /=; rewrite mh. Qed. + +Lemma compreN T (h : R -> \bar R) (f : T -> R) : + {morph h : x / (- x)%R >-> (- x)%E} -> + h \o (\- f)%R = \- (h \o f)%E. +Proof. by move=> mh; apply/funext => t /=; rewrite mh. Qed. + +Lemma compreBr T (h : R -> \bar R) (f g : T -> R) : + {morph h : x y / (x - y)%R >-> (x - y)%E} -> + h \o (f \- g)%R = ((h \o f) \- (h \o g))%E. +Proof. by move=> mh; apply/funext => t /=; rewrite mh. Qed. + +Lemma compre_scale T (h : R -> \bar R) (f : T -> R) k : + {morph h : x y / (x * y)%R >-> (x * y)%E} -> + h \o (k \o* f) = (fun t => h k * h (f t))%E. +Proof. by move=> mf; apply/funext => t /=; rewrite mf; rewrite muleC. Qed. + Local Close Scope classical_set_scope. End ERealArith. @@ -106,6 +132,9 @@ Section ERealArithTh_numDomainType. Context {R : numDomainType}. Implicit Types (x y z : \bar R) (r : R). +Lemma range_oppe : range -%E = [set: \bar R]%classic. +Proof. by apply/seteqP; split => [//|x] _; exists (- x); rewrite ?oppeK. Qed. + Lemma oppe_subset (A B : set (\bar R)) : ((A `<=` B) <-> (-%E @` A `<=` -%E @` B))%classic. Proof. @@ -138,6 +167,14 @@ Section ERealArithTh_realDomainType. Context {R : realDomainType}. Implicit Types (x y z u a b : \bar R) (r : R). +Lemma le_er_map_in (A : set R) (f : R -> R) : + {in A &, {homo f : x y / (x <= y)%O}} -> + {in (EFin @` A)%classic &, {homo er_map f : x y / (x <= y)%E}}. +Proof. +move=> h x y; rewrite !inE/= => -[r Ar <-{x}] [s As <-{y}]. +by rewrite !lee_fin/= => /h; apply; rewrite inE. +Qed. + Lemma fsume_gt0 (I : choiceType) (P : set I) (F : I -> \bar R) : 0 < \sum_(i \in P) F i -> exists2 i, P i & 0 < F i. Proof. @@ -233,7 +270,7 @@ apply: (big_ind2 (fun x y => x = - y)%E) => [|_ x _ y -> ->|i _]. - by rewrite oppeK. Qed. -Lemma dfsume_ge0 (I : choiceType) (P : set I) (F : I -> \bar R) : +Lemma dfsume_ge0 (I : choiceType) (P : set I) (F : I -> \bar^d R) : (forall i, P i -> 0 <= F i) -> 0 <= \sum_(i \in P) F i. Proof. move=> PF; case: finite_supportP; rewrite ?big_nil// => X XP F0 _. @@ -256,23 +293,23 @@ Import DualAddTheory. Local Open Scope ereal_dual_scope. Context {R : realDomainType}. -Implicit Types x y z a b : \bar R. +Implicit Types x y z a b : \bar^d R. -Lemma dfsume_gt0 (I : choiceType) (P : set I) (F : I -> \bar R) : +Lemma dfsume_gt0 (I : choiceType) (P : set I) (F : I -> \bar^d R) : 0 < \sum_(i \in P) F i -> exists2 i, P i & 0 < F i. Proof. rewrite dual_fsumeE oppe_gt0 => /fsume_lt0[i Pi]. by rewrite oppe_lt0 => ?; exists i. Qed. -Lemma dfsume_lt0 (I : choiceType) (P : set I) (F : I -> \bar R) : +Lemma dfsume_lt0 (I : choiceType) (P : set I) (F : I -> \bar^d R) : \sum_(i \in P) F i < 0 -> exists2 i, P i & F i < 0. Proof. rewrite dual_fsumeE oppe_lt0 => /fsume_gt0[i Pi]. by rewrite oppe_gt0 => ?; exists i. Qed. -Lemma pdfsume_eq0 (I : choiceType) (P : set I) (F : I -> \bar R) : +Lemma pdfsume_eq0 (I : choiceType) (P : set I) (F : I -> \bar^d R) : finite_set P -> (forall i, P i -> 0 <= F i) -> \sum_(i \in P) F i = 0 -> forall i, P i -> F i = 0. @@ -282,7 +319,7 @@ rewrite (fsbigD1 i)//= pdadde_eq0 ?F0 ?negb_and ?Fi0//. by rewrite dfsume_ge0// => j [/F0->]. Qed. -Lemma le0_mule_dfsumr (T : choiceType) x (F : T -> \bar R) (P : set T) : +Lemma le0_mule_dfsumr (T : choiceType) x (F : T -> \bar^d R) (P : set T) : (forall i : T, F i <= 0) -> x * (\sum_(i \in P) F i) = \sum_(i \in P) x * F i. Proof. move=> Fge0. @@ -291,7 +328,7 @@ rewrite (eq_bigr _ (fun _ _ => muleN _ _)). by rewrite (eq_finite_support _ (fun i _ => muleN _ _)). Qed. -Lemma le0_mule_dfsuml (T : choiceType) x (F : T -> \bar R) (P : set T) : +Lemma le0_mule_dfsuml (T : choiceType) x (F : T -> \bar^d R) (P : set T) : (forall i : T, F i <= 0) -> (\sum_(i \in P) F i) * x = \sum_(i \in P) F i * x. Proof. move=> F0; rewrite muleC le0_mule_dfsumr//. @@ -307,11 +344,19 @@ Export ConstructiveDualAddTheory. Export DualAddTheoryNumDomain. End DualAddTheory. +HB.instance Definition _ (R : numDomainType) := isPointed.Build (\bar R) 0%E. + Section ereal_supremum. Variable R : realFieldType. Local Open Scope classical_set_scope. Implicit Types (S : set (\bar R)) (x y : \bar R). +Lemma uboundT : ubound [set: \bar R] = [set +oo]. +Proof. +apply/seteqP; split => /= [x Tx|x -> ?]; last by rewrite leey. +by apply/eqP; rewrite eq_le leey /= Tx. +Qed. + Lemma ereal_ub_pinfty S : ubound S +oo. Proof. by apply/ubP=> x _; rewrite leey. Qed. @@ -323,9 +368,21 @@ right; rewrite predeqE => y; split => [/Snoo|->{y}]. by have := Snoo _ Sx; rewrite leeNy_eq => /eqP <-. Qed. +Lemma supremumsT : supremums [set: \bar R] = [set +oo]. +Proof. +rewrite /supremums uboundT. +by apply/seteqP; split=> [x []//|x -> /=]; split => // y ->. +Qed. + Lemma ereal_supremums_set0_ninfty : supremums (@set0 (\bar R)) -oo. Proof. by split; [exact/ubP | apply/lbP=> y _; rewrite leNye]. Qed. +Lemma supremumT : supremum -oo [set: \bar R] = +oo. +Proof. +rewrite /supremum (negbTE setT0) supremumsT. +by case: xgetP => // /(_ +oo)/= /eqP; rewrite eqxx. +Qed. + Lemma supremum_pinfty S x0 : S +oo -> supremum x0 S = +oo. Proof. move=> Spoo; rewrite /supremum ifF; last by apply/eqP => S0; rewrite S0 in Spoo. @@ -343,11 +400,17 @@ Definition ereal_inf S := - ereal_sup (-%E @` S). Lemma ereal_sup0 : ereal_sup set0 = -oo. Proof. exact: supremum0. Qed. +Lemma ereal_supT : ereal_sup [set: \bar R] = +oo. +Proof. by rewrite /ereal_sup/= supremumT. Qed. + Lemma ereal_sup1 x : ereal_sup [set x] = x. Proof. exact: supremum1. Qed. Lemma ereal_inf0 : ereal_inf set0 = +oo. Proof. by rewrite /ereal_inf image_set0 ereal_sup0. Qed. +Lemma ereal_infT : ereal_inf [set: \bar R] = -oo. +Proof. by rewrite /ereal_inf range_oppe/= ereal_supT. Qed. + Lemma ereal_inf1 x : ereal_inf [set x] = x. Proof. by rewrite /ereal_inf image_set1 ereal_sup1 oppeK. Qed. @@ -378,7 +441,7 @@ Lemma lb_ereal_inf_adherent S (e : R) : (0 < e)%R -> Proof. move=> e0; rewrite fin_numN => /(ub_ereal_sup_adherent e0)[x []]. move=> y Sy <-; rewrite -lte_oppr => /lt_le_trans ex; exists y => //. -by apply: ex; rewrite oppeD// oppeK. +by apply: ex; rewrite fin_num_oppeD// oppeK. Qed. Lemma ereal_sup_gt S x : x < ereal_sup S -> exists2 y, S y & x < y. @@ -448,6 +511,14 @@ case: xgetP => /=; first by move=> _ -> -[] /ubP geS _; apply geS. by case: (ereal_supremums_neq0 S) => /= x0 Sx0; move/(_ x0). Qed. +Lemma ereal_supy S : S +oo -> ereal_sup S = +oo. +Proof. +by move=> Soo; apply/eqP; rewrite eq_le leey/=; exact: ereal_sup_ub. +Qed. + +Lemma ereal_sup_le S x : (exists2 y, S y & x <= y) -> x <= ereal_sup S. +Proof. by move=> [y Sy] /le_trans; apply; exact: ereal_sup_ub. Qed. + Lemma ereal_sup_ninfty S : ereal_sup S = -oo <-> S `<=` [set -oo]. Proof. split. @@ -460,24 +531,31 @@ Proof. by move=> x Sx; rewrite /ereal_inf lee_oppl; apply ereal_sup_ub; exists x. Qed. +Lemma ereal_inf_le S x : (exists2 y, S y & y <= x) -> ereal_inf S <= x. +Proof. by move=> [y Sy]; apply: le_trans; exact: ereal_inf_lb. Qed. + Lemma ereal_inf_pinfty S : ereal_inf S = +oo <-> S `<=` [set +oo]. Proof. rewrite eqe_oppLRP oppe_subset image_set1; exact: ereal_sup_ninfty. Qed. Lemma le_ereal_sup : {homo @ereal_sup R : A B / A `<=` B >-> A <= B}. -Proof. by move=> A B AB; apply ub_ereal_sup => x Ax; apply/ereal_sup_ub/AB. Qed. +Proof. by move=> A B AB; apply: ub_ereal_sup => x Ax; apply/ereal_sup_ub/AB. Qed. Lemma le_ereal_inf : {homo @ereal_inf R : A B / A `<=` B >-> B <= A}. -Proof. by move=> A B AB; apply lb_ereal_inf => x Bx; exact/ereal_inf_lb/AB. Qed. +Proof. by move=> A B AB; apply: lb_ereal_inf => x Bx; exact/ereal_inf_lb/AB. Qed. -Lemma hasNub_ereal_sup (A : set (\bar R)) : ~ has_ubound A -> - A !=set0 -> ereal_sup A = +oo%E. +Lemma hasNub_ereal_sup (A : set R) : ~ has_ubound A -> + A !=set0 -> ereal_sup (EFin @` A) = +oo%E. Proof. -move=> hasNubA A0. -apply/eqP; rewrite eq_le leey /= leNgt; apply: contra_notN hasNubA => Aoo. -by exists (ereal_sup A); exact: ereal_sup_ub. +move=> + A0; apply: contra_notP => /eqP; rewrite -ltey => Aoo. +exists (fine (ereal_sup (EFin @` A))) => x Ax. +rewrite -lee_fin -(@fineK _ x%:E)// lee_fin fine_le//; last first. + by apply: ereal_sup_ub => /=; exists x. +rewrite fin_numE// -ltey Aoo andbT. +apply/eqP => /ereal_sup_ninfty/(_ x%:E). +by have /[swap] /[apply]: (EFin @` A) x%:E by exists x. Qed. -Lemma ereal_sup_EFin (A : set R) : +Lemma ereal_sup_EFin (A : set R) : has_ubound A -> A !=set0 -> ereal_sup (EFin @` A) = (sup A)%:E. Proof. move=> has_ubA A0; apply/eqP; rewrite eq_le; apply/andP; split. @@ -495,7 +573,7 @@ by rewrite -lee_fin fineK//; apply: ereal_sup_ub; exists r. Qed. Lemma ereal_inf_EFin (A : set R) : has_lbound A -> A !=set0 -> - ereal_inf (EFin @` A) = (inf A)%:E. + ereal_inf (EFin @` A) = (inf A)%:E. Proof. move=> has_lbA A0; rewrite /ereal_inf /inf EFinN; congr (- _)%E. rewrite -ereal_sup_EFin; [|exact/has_lb_ubN|exact/nonemptyN]. @@ -504,8 +582,6 @@ Qed. End ereal_supremum_realType. -Canonical ereal_pointed (R : numDomainType) := PointedType (extended R) 0%E. - Lemma restrict_abse T (R : numDomainType) (f : T -> \bar R) (D : set T) : (abse \o f) \_ D = abse \o (f \_ D). Proof. @@ -564,20 +640,19 @@ Context {R : numFieldType}. Local Open Scope ereal_scope. Local Open Scope classical_set_scope. -Definition ereal_dnbhs (x : \bar R) (P : \bar R -> Prop) : Prop := - match x with +Definition ereal_dnbhs (x : \bar R) : set_system (\bar R) := + [set P | match x with | r%:E => r^' (fun r => P r%:E) | +oo => exists M, M \is Num.real /\ forall y, M%:E < y -> P y | -oo => exists M, M \is Num.real /\ forall y, y < M%:E -> P y - end. -Definition ereal_nbhs (x : \bar R) (P : \bar R -> Prop) : Prop := - match x with + end]. +Definition ereal_nbhs (x : \bar R) : set_system (\bar R) := + [set P | match x with | x%:E => nbhs x (fun r => P r%:E) | +oo => exists M, M \is Num.real /\ forall y, M%:E < y -> P y | -oo => exists M, M \is Num.real /\ forall y, y < M%:E -> P y - end. -Canonical ereal_ereal_filter := - FilteredType (extended R) (extended R) (ereal_nbhs). + end]. +HB.instance Definition _ := hasNbhs.Build (\bar R) ereal_nbhs. End ereal_nbhs. Section ereal_nbhs_instances. @@ -593,7 +668,7 @@ case=> [x||]. by move=> P Q PQ /xS; apply => y /PQ. - apply Build_ProperFilter. move=> P [x [xr xP]] //; exists (x + 1)%:E; apply xP => /=. - by rewrite lte_fin ltr_addl. + by rewrite lte_fin ltrDl. split=> /= [|P Q [MP [MPr gtMP]] [MQ [MQr gtMQ]] |P Q sPQ [M [Mr gtM]]]. + by exists 0%R. + have [MP0|MP0] := eqVneq MP 0%R. @@ -619,7 +694,7 @@ case=> [x||]. + by exists M; split => // ? /gtM /sPQ. - apply Build_ProperFilter. + move=> P [M [Mr ltMP]]; exists (M - 1)%:E. - by apply: ltMP; rewrite lte_fin gtr_addl oppr_lt0. + by apply: ltMP; rewrite lte_fin gtrDl oppr_lt0. + split=> /= [|P Q [MP [MPr ltMP]] [MQ [MQr ltMQ]] |P Q sPQ [M [Mr ltM]]]. * by exists 0%R. * have [MP0|MP0] := eqVneq MP 0%R. @@ -628,25 +703,25 @@ case=> [x||]. [apply/ltMP; rewrite MP0 | apply/ltMQ; rewrite MQ0]. exists (- `|MQ|)%R; rewrite realN realE normr_ge0; split => // x xMQ. split. - by apply ltMP; rewrite (lt_le_trans xMQ)// lee_fin MP0 ler_oppl oppr0. - apply ltMQ; rewrite (lt_le_trans xMQ) // lee_fin ler_oppl -normrN. + by apply ltMP; rewrite (lt_le_trans xMQ)// lee_fin MP0 lerNl oppr0. + apply ltMQ; rewrite (lt_le_trans xMQ) // lee_fin lerNl -normrN. by rewrite real_ler_normr ?realN // lexx. * have [MQ0|MQ0] := eqVneq MQ 0%R. exists (- `|MP|)%R; rewrite realN realE normr_ge0; split => // x MPx. split. - apply ltMP; rewrite (lt_le_trans MPx) // lee_fin ler_oppl -normrN. + apply ltMP; rewrite (lt_le_trans MPx) // lee_fin lerNl -normrN. by rewrite real_ler_normr ?realN // lexx. - by apply ltMQ; rewrite (lt_le_trans MPx) // lee_fin MQ0 ler_oppl oppr0. + by apply ltMQ; rewrite (lt_le_trans MPx) // lee_fin MQ0 lerNl oppr0. have {}MP0 : (0 < `|MP|)%R by rewrite normr_gt0. have {}MQ0 : (0 < `|MQ|)%R by rewrite normr_gt0. exists (- (Num.max (PosNum MP0) (PosNum MQ0))%:num)%R. rewrite realN realE /= ge0 /=; split => //. case=> [r|//|]. - - rewrite lte_fin ltr_oppr num_max num_lt_maxl => /andP[]. - rewrite ltr_oppr => MPx; rewrite ltr_oppr => MQx; split. - apply/ltMP; rewrite lte_fin (lt_le_trans MPx) //= ler_oppl -normrN. + - rewrite lte_fin ltrNr num_max num_lt_maxl => /andP[]. + rewrite ltrNr => MPx; rewrite ltrNr => MQx; split. + apply/ltMP; rewrite lte_fin (lt_le_trans MPx) //= lerNl -normrN. by rewrite real_ler_normr ?realN // lexx. - apply/ltMQ; rewrite lte_fin (lt_le_trans MQx) //= ler_oppl -normrN. + apply/ltMQ; rewrite lte_fin (lt_le_trans MQx) //= lerNl -normrN. by rewrite real_ler_normr ?realN // lexx. - by move=> _; split; [apply/ltMP | apply/ltMQ]. * by exists M; split => // x /ltM /sPQ. @@ -719,10 +794,10 @@ move: p => -[p| [M [Mreal MA]] | [M [Mreal MA]]] //=. rewrite lte_fin => M'x /=. apply/nbhs_ballP; exists 1%R => //= y x1y. apply MA; rewrite lte_fin. - rewrite addrC -ltr_subr_addl in M'x. - rewrite (lt_le_trans M'x) // ler_subl_addl addrC -ler_subl_addl. + rewrite addrC -ltrBrDl in M'x. + rewrite (lt_le_trans M'x) // lerBlDl addrC -lerBlDl. rewrite (le_trans _ (ltW x1y)) // real_ler_norm // realB //. - rewrite ltr_subr_addr in M'x. + rewrite ltrBrDr in M'x. rewrite -comparabler0 (@comparabler_trans _ (M + 1)%R) //. by rewrite /Order.comparable (ltW M'x) orbT. by rewrite comparabler0 realD. @@ -732,20 +807,16 @@ move: p => -[p| [M [Mreal MA]] | [M [Mreal MA]]] //=. rewrite lte_fin => M'x /=. apply/nbhs_ballP; exists 1%R => //= y x1y. apply MA; rewrite lte_fin. - rewrite ltr_subr_addl in M'x. - rewrite (le_lt_trans _ M'x) // addrC -ler_subl_addl. + rewrite ltrBrDl in M'x. + rewrite (le_lt_trans _ M'x) // addrC -lerBlDl. rewrite (le_trans _ (ltW x1y)) // distrC real_ler_norm // realB //. by rewrite num_real. (* where we really use realFieldType *) - rewrite addrC -ltr_subr_addr in M'x. + rewrite addrC -ltrBrDr in M'x. rewrite -comparabler0 (@comparabler_trans _ (M - 1)%R) //. by rewrite /Order.comparable (ltW M'x). by rewrite comparabler0 realB. Qed. -Definition ereal_topologicalMixin : Topological.mixin_of (@ereal_nbhs R) := - topologyOfFilterMixin _ ereal_nbhs_singleton ereal_nbhs_nbhs. -Canonical ereal_topologicalType := TopologicalType _ ereal_topologicalMixin. - End ereal_topologicalType. Local Open Scope classical_set_scope. @@ -799,7 +870,8 @@ have : (-%E @` A) (- x) by exists x. by move/h => [y Sy] /eqP; rewrite eqe_opp => /eqP <-. Qed. -Lemma oppe_continuous (R : realFieldType) : continuous (@oppe R). +Lemma oppe_continuous (R : realFieldType) : + continuous (-%E : \bar R -> \bar R). Proof. move=> x S /= xS; apply nbhsNKe; rewrite image_preimage //. by rewrite predeqE => y; split => // _; exists (- y) => //; rewrite oppeK. @@ -858,7 +930,7 @@ case=> x Sx; rewrite ler_norml; apply/andP; split; last first. apply sup_le_ub; first by exists (contract x), x. by move=> r [y Sy] <-; case/ler_normlP : (contract_le1 y). rewrite (@le_trans _ _ (contract x)) //. - by case/ler_normlP : (contract_le1 x); rewrite ler_oppl. + by case/ler_normlP : (contract_le1 x); rewrite lerNl. apply sup_ub; last by exists x. by exists 1%R => r [y Sy <-]; case/ler_normlP : (contract_le1 y). Qed. @@ -885,12 +957,12 @@ split => [r [y Sy <-{r}]|]. apply sup_ub; last by exists y. by exists 1%R => r [z Sz <-]; case/ler_normlP : (contract_le1 z). rewrite ler_norml; apply/andP; split; last first. - rewrite ler_pdivr_mulr // mul1r (_ : 2 = 1 + 1)%R // ler_add //. + rewrite ler_pdivrMr // mul1r (_ : 2 = 1 + 1)%R // lerD //. by case/ler_normlP : (sup_contract_le1 S0). by case/ler_normlP : (contract_le1 (ereal_sup S)). -rewrite ler_pdivl_mulr // (_ : 2 = 1 + 1)%R // mulN1r opprD ler_add //. -by case/ler_normlP : (sup_contract_le1 S0); rewrite ler_oppl. -by case/ler_normlP : (contract_le1 (ereal_sup S)); rewrite ler_oppl. +rewrite ler_pdivlMr // (_ : 2 = 1 + 1)%R // mulN1r opprD lerD //. +by case/ler_normlP : (sup_contract_le1 S0); rewrite lerNl. +by case/ler_normlP : (contract_le1 (ereal_sup S)); rewrite lerNl. Qed. Lemma contract_inf S : S !=set0 -> contract (ereal_inf S) = inf (contract @` S). @@ -913,8 +985,8 @@ Lemma expand_ereal_ball_pinfty {e : {posnum R}} r : (e%:num <= 1)%R -> Proof. move=> e1 er; rewrite /ereal_ball gtr0_norm ?subr_gt0; last first. by case/ltr_normlP : (contract_lt1 r). -rewrite ltr_subl_addl addrC -ltr_subl_addl -[ltLHS]expandK ?lt_contract//. -by rewrite inE ger0_norm ?ler_subl_addl ?ler_addr // subr_ge0. +rewrite ltrBlDl addrC -ltrBlDl -[ltLHS]expandK ?lt_contract//. +by rewrite inE ger0_norm ?lerBlDl ?lerDr // subr_ge0. Qed. Lemma contract_ereal_ball_fin_le r r' (e : {posnum R}) : (r <= r')%R -> @@ -922,7 +994,7 @@ Lemma contract_ereal_ball_fin_le r r' (e : {posnum R}) : (r <= r')%R -> Proof. rewrite le_eqVlt => /predU1P[<-{r'} _|rr' re1]; first exact: ereal_ball_center. rewrite /ereal_ball ltr0_norm; last by rewrite subr_lt0 lt_contract lte_fin. -rewrite opprB ltr_subl_addl (lt_le_trans _ re1) //. +rewrite opprB ltrBlDl (lt_le_trans _ re1) //. by case/ltr_normlP : (contract_lt1 r'). Qed. @@ -931,7 +1003,7 @@ Lemma contract_ereal_ball_fin_lt r r' (e : {posnum R}) : (r' < r)%R -> Proof. move=> r'r reN1; rewrite /ereal_ball. rewrite gtr0_norm ?subr_gt0 ?lt_contract ?lte_fin//. -rewrite ltr_subl_addl addrC -ltr_subl_addl (le_lt_trans reN1) //. +rewrite ltrBlDl addrC -ltrBlDl (le_lt_trans reN1) //. by move: (contract_lt1 r'); rewrite ltr_norml => /andP[]. Qed. @@ -941,7 +1013,7 @@ Lemma expand_ereal_ball_fin_lt r' r (e : {posnum R}) : (r' < r)%R -> Proof. move=> r'r ? r'e'r. rewrite /ereal_ball gtr0_norm ?subr_gt0 ?lt_contract ?lte_fin//. -by rewrite ltr_subl_addl addrC -ltr_subl_addl -lt_expandLR ?inE ?ltW. +by rewrite ltrBlDl addrC -ltrBlDl -lt_expandLR ?inE ?ltW. Qed. Lemma ball_ereal_ball_fin_lt r r' (e : {posnum R}) : @@ -954,9 +1026,9 @@ move=> e' re'r' rr' X; rewrite /ereal_ball. rewrite gtr0_norm ?subr_gt0// ?lt_contract ?lte_fin//. move: re'r'. rewrite /ball /= gtr0_norm // ?subr_gt0// /e'. -rewrite -ltr_subl_addl addrAC subrr add0r ltr_oppl opprK -lte_fin. +rewrite -ltrBlDl addrAC subrr add0r ltrNl opprK -lte_fin. rewrite fine_expand // lt_expandLR ?inE ?ltW//. -by rewrite ltr_subl_addl addrC -ltr_subl_addl. +by rewrite ltrBlDl addrC -ltrBlDl. Qed. Lemma ball_ereal_ball_fin_le r r' (e : {posnum R}) : @@ -970,8 +1042,8 @@ move: rr'; rewrite le_eqVlt => /predU1P[->|rr']; first by rewrite subrr normr0. rewrite /ball /= ltr0_norm ?subr_lt0// opprB in r'e'r. rewrite ltr0_norm ?subr_lt0 ?lt_contract ?lte_fin//. rewrite opprB; move: r'e'r. -rewrite /e' -ltr_subl_addr opprK subrK -lte_fin fine_expand //. -by rewrite lt_expandRL ?inE ?ltW// ltr_subl_addl. +rewrite /e' -ltrBlDr opprK subrK -lte_fin fine_expand //. +by rewrite lt_expandRL ?inE ?ltW// ltrBlDl. Qed. Lemma nbhs_oo_up_e1 (A : set (\bar R)) (e : {posnum R}) : (e%:num <= 1)%R -> @@ -981,7 +1053,7 @@ move=> e1 ooeA. exists (fine (expand (1 - e%:num)%R)); rewrite num_real; split => //. case => [r | | //]. - rewrite fine_expand; last first. - by rewrite ger0_norm ?ltr_subl_addl ?ltr_addr // subr_ge0. + by rewrite ger0_norm ?ltrBlDl ?ltrDr // subr_ge0. by move=> ?; exact/ooeA/expand_ereal_ball_pinfty. - by move=> _; exact/ooeA/ereal_ball_center. Qed. @@ -1005,13 +1077,13 @@ move=> e1 reA; have [e2{e1}|e2] := ltrP 2 e%:num. rewrite predeqE => x; split => // _; apply reA. exact/ereal_ballN/ereal_ball_ninfty_oversize. have /andP[e10 e11] : (0 < e%:num - 1 <= 1)%R. - by rewrite subr_gt0 e1 /= ler_subl_addl. + by rewrite subr_gt0 e1 /= lerBlDl. apply nbhsNKe. have : ((PosNum e10)%:num <= 1)%R by []. move/(@nbhs_oo_down_e1 (-%E @` A) (PosNum e10)); apply. move=> y ye; exists (- y); last by rewrite oppeK. apply/reA/ereal_ballN; rewrite oppeK /=. -by apply: le_ereal_ball ye => /=; rewrite ler_subl_addl ler_addr. +by apply: le_ereal_ball ye => /=; rewrite lerBlDl lerDr. Qed. Lemma nbhs_oo_down_1e (A : set (\bar R)) (e : {posnum R}) : (1 < e%:num)%R -> @@ -1021,13 +1093,13 @@ move=> e1 reA; have [e2{e1}|e2] := ltrP 2 e%:num. suff -> : A = setT by exists 0%R. by rewrite predeqE => x; split => // _; exact/reA/ereal_ball_ninfty_oversize. have /andP[e10 e11] : (0 < e%:num - 1 <= 1)%R. - by rewrite subr_gt0 e1 /= ler_subl_addl. + by rewrite subr_gt0 e1 /= lerBlDl. apply nbhsNKe. have : ((PosNum e10)%:num <= 1)%R by []. move/(@nbhs_oo_up_e1 (-%E @` A) (PosNum e10)); apply. move=> y ye; exists (- y); last by rewrite oppeK. apply/reA/ereal_ballN; rewrite /= oppeK. -by apply: le_ereal_ball ye => /=; rewrite ler_subl_addl ler_addr. +by apply: le_ereal_ball ye => /=; rewrite lerBlDl lerDr. Qed. Lemma nbhs_fin_out_above r (e : {posnum R}) (A : set (\bar R)) : @@ -1038,13 +1110,13 @@ Lemma nbhs_fin_out_above r (e : {posnum R}) (A : set (\bar R)) : Proof. move=> reA reN1 re1. have er1 : (`|contract r%:E - e%:num| < 1)%R. - rewrite ltr_norml reN1 andTb ltr_subl_addl ltr_spaddl //. + rewrite ltr_norml reN1 andTb ltrBlDl ltr_pwDl //. by move: (contract_le1 r%:E); rewrite ler_norml => /andP[]. pose e' := (r - fine (expand (contract r%:E - e%:num)))%R. have e'0 : (0 < e')%R. rewrite subr_gt0 -lte_fin -[ltRHS](contractK r%:E). rewrite fine_expand // lt_expand ?inE ?contract_le1// ?ltW//. - by rewrite ltr_subl_addl ltr_addr. + by rewrite ltrBlDl ltrDr. apply/nbhs_ballP; exists e' => // r' re'r'; apply reA. by have [?|?] := lerP r r'; [exact: contract_ereal_ball_fin_le | exact: ball_ereal_ball_fin_lt]. @@ -1058,12 +1130,12 @@ Lemma nbhs_fin_out_below r (e : {posnum R}) (A : set (\bar R)) : Proof. move=> reA reN1 re1. have ? : (`|contract r%:E + e%:num| < 1)%R. - rewrite ltr_norml re1 andbT (@lt_le_trans _ _ (contract r%:E)) // ?ler_addl //. + rewrite ltr_norml re1 andbT (@lt_le_trans _ _ (contract r%:E)) // ?lerDl //. by move: (contract_lt1 r); rewrite ltr_norml => /andP[]. pose e' : R := (fine (expand (contract r%:E + e%:num)) - r)%R. have e'0 : (0 < e')%R. rewrite /e' subr_gt0 -lte_fin -[in ltLHS](contractK r%:E). - by rewrite fine_expand // lt_expand ?inE ?contract_le1 ?ltr_addl ?ltW. + by rewrite fine_expand // lt_expand ?inE ?contract_le1 ?ltrDl ?ltW. apply/nbhs_ballP; exists e' => // r' r'e'r; apply reA. by have [?|?] := lerP r r'; [exact: ball_ereal_ball_fin_le | exact: contract_ereal_ball_fin_lt]. @@ -1083,7 +1155,7 @@ case: x => [r'| |] //. + by apply contract_ereal_ball_fin_lt => //; exact/ltW. - exact/contract_ereal_ball_pinfty. - apply/ereal_ballN/contract_ereal_ball_pinfty. - by rewrite EFinN contractN -(opprK 1%R) ltr_oppl opprD opprK. + by rewrite EFinN contractN -(opprK 1%R) ltrNl opprD opprK. Qed. Lemma nbhs_fin_inbound r (e : {posnum R}) (A : set (\bar R)) : @@ -1102,8 +1174,8 @@ have [|reN1] := boolP (contract r%:E - e%:num == -1)%R. rewrite neq_lt => /orP[re1|re1]. by apply (@nbhs_fin_out_below _ e) => //; rewrite reN1 addrAC subrr sub0r. have e1 : (1 < e%:num)%R. - move: re1; rewrite reN1 addrAC ltr_subr_addl -!mulr2n -(mulr_natl e%:num). - by rewrite -{1}(mulr1 2) => ?; rewrite -(@ltr_pmul2l _ 2). + move: re1; rewrite reN1 addrAC ltrBrDl -!mulr2n -(mulr_natl e%:num). + by rewrite -{1}(mulr1 2%:R) => ?; rewrite -(@ltr_pM2l _ 2). have Aoo : setT `\ -oo `<=` A. move=> x [_]; rewrite /set1 /= => xnoo; apply reA. case: x xnoo => [r' _ | _ |//]. @@ -1123,11 +1195,11 @@ move: reN1; rewrite eq_sym neq_lt => /orP[reN1|reN1]. by apply (@nbhs_fin_out_above _ e) => //; rewrite re1. move: re1; rewrite neq_lt => /orP[re1|re1]. have ? : (`|contract r%:E - e%:num| < 1)%R. - rewrite ltr_norml reN1 andTb ltr_subl_addl. - rewrite (@lt_le_trans _ _ 1%R) // ?ler_addr//. + rewrite ltr_norml reN1 andTb ltrBlDl. + rewrite (@lt_le_trans _ _ 1%R) // ?lerDr//. by case/ltr_normlP : (contract_lt1 r). have ? : (`|contract r%:E + e%:num| < 1)%R. - rewrite ltr_norml re1 andbT -(addr0 (-1)) ler_lt_add //. + rewrite ltr_norml re1 andbT -(addr0 (-1)) ler_ltD //. by move: (contract_le1 r%:E); rewrite ler_norml => /andP[]. pose e' : R := Num.min (r - fine (expand (contract r%:E - e%:num)))%R @@ -1136,15 +1208,15 @@ move: reN1; rewrite eq_sym neq_lt => /orP[reN1|reN1]. rewrite /e' lt_minr; apply/andP; split. rewrite subr_gt0 -lte_fin -[in ltRHS](contractK r%:E). rewrite fine_expand // lt_expand// ?inE ?contract_le1 ?ltW//. - by rewrite ltr_subl_addl ltr_addr. + by rewrite ltrBlDl ltrDr. rewrite subr_gt0 -lte_fin -[in ltLHS](contractK r%:E). - by rewrite fine_expand// lt_expand ?inE ?contract_le1 ?ltr_addl ?ltW. + by rewrite fine_expand// lt_expand ?inE ?contract_le1 ?ltrDl ?ltW. apply/nbhs_ballP; exists e' => // r' re'r'; apply reA. have [|r'r] := lerP r r'. move=> rr'; apply: ball_ereal_ball_fin_le => //. by apply: le_ball re'r'; rewrite le_minl lexx orbT. move: re'r'; rewrite /ball /= lt_minr => /andP[]. - rewrite gtr0_norm ?subr_gt0 // -ltr_subl_addl addrAC subrr add0r ltr_oppl. + rewrite gtr0_norm ?subr_gt0 // -ltrBlDl addrAC subrr add0r ltrNl. rewrite opprK -lte_fin fine_expand // => r'e'r _. exact: expand_ereal_ball_fin_lt. by apply (@nbhs_fin_out_above _ e) => //; rewrite ltW. @@ -1155,24 +1227,24 @@ move: re1; rewrite le_eqVlt => /orP[re1|re1]. by move: re1; rewrite eq_sym -subr_eq => /eqP <-. have e1 : (1 < e%:num)%R. move: reN1. - rewrite re1 -addrA -opprD ltr_subl_addl ltr_subr_addl -!mulr2n. - rewrite -(mulr_natl e%:num) -{1}(mulr1 2) => ?. - by rewrite -(@ltr_pmul2l _ 2). + rewrite re1 -addrA -opprD ltrBlDl ltrBrDl -!mulr2n. + rewrite -(mulr_natl e%:num) -{1}(mulr1 2%:R) => ?. + by rewrite -(@ltr_pM2l _ 2). have Aoo : (setT `\ +oo `<=` A). move=> x [_]; rewrite /set1 /= => xpoo; apply reA. case: x xpoo => [r' _ | // |_]. rewrite /ereal_ball. have [rr'|r'r] := lerP (contract r%:E) (contract r'%:E). - rewrite re1 opprB addrCA -[ltRHS]addr0 ltr_add2 subr_lt0. + rewrite re1 opprB addrCA -[ltRHS]addr0 ltrD2 subr_lt0. by case/ltr_normlP : (contract_lt1 r'). rewrite /ereal_ball. - rewrite re1 addrAC ltr_subl_addl ltr_add // (lt_trans _ e1) // ltr_oppl. + rewrite re1 addrAC ltrBlDl ltrD // (lt_trans _ e1) // ltrNl. by move: (contract_lt1 r'); rewrite ltr_norml => /andP[]. rewrite /ereal_ball. rewrite [contract -oo]/= opprK gtr0_norm ?subr_gt0; last first. - rewrite -ltr_subl_addl add0r ltr_oppl. + rewrite -ltrBlDl add0r ltrNl. by move: (contract_lt1 r); rewrite ltr_norml => /andP[]. - by rewrite re1 addrAC ltr_subl_addl ltr_add. + by rewrite re1 addrAC ltrBlDl ltrD. have : nbhs r%:E (setT `\ +oo) by exists 1%R => /=. case => _/posnumP[x] /=; rewrite /ball_ => h. by exists x%:num => //= y /h; exact: Aoo. @@ -1190,8 +1262,8 @@ rewrite predeq2E => x A; split. exists (diag e'); rewrite /diag. exists e' => //. rewrite /= /e' lt_minr; apply/andP; split. - by rewrite subr_gt0 lt_contract lte_fin ltr_subl_addr ltr_addl. - by rewrite subr_gt0 lt_contract lte_fin ltr_addl. + by rewrite subr_gt0 lt_contract lte_fin ltrBlDr ltrDl. + by rewrite subr_gt0 lt_contract lte_fin ltrDl. case=> [r' /= re'r'| |]/=. * rewrite /ereal_ball in re'r'. have [r'r|rr'] := lerP (contract r'%:E) (contract r%:E). @@ -1199,35 +1271,35 @@ rewrite predeq2E => x A; split. rewrite ger0_norm ?subr_ge0// in re'r'. have : (contract (r%:E - e%:num%:E) < contract r'%:E)%R. move: re'r'; rewrite /e' lt_minr => /andP[+ _]. - rewrite /e' ltr_subr_addl addrC -ltr_subr_addl => /lt_le_trans. + rewrite /e' ltrBrDl addrC -ltrBrDl => /lt_le_trans. by apply; rewrite opprB addrCA subrr addr0. rewrite -lt_expandRL ?inE ?contract_le1 // !contractK lte_fin. - rewrite ltr_subl_addr addrC -ltr_subl_addr => ->; rewrite andbT. - rewrite (@lt_le_trans _ _ 0%R)// 1?ltr_oppl 1?oppr0// subr_ge0. + rewrite ltrBlDr addrC -ltrBlDr => ->; rewrite andbT. + rewrite (@lt_le_trans _ _ 0%R)// 1?ltrNl 1?oppr0// subr_ge0. by rewrite -lee_fin -le_contract. apply: reA; rewrite /ball /= real_ltr_norml // ?num_real //. rewrite ltr0_norm ?subr_lt0// opprB in re'r'. apply/andP; split; last first. by rewrite (@lt_trans _ _ 0%R) // subr_lt0 -lte_fin -lt_contract. - rewrite ltr_oppl opprB. + rewrite ltrNl opprB. rewrite /e' in re'r'. have r're : (contract r'%:E < contract (r%:E + e%:num%:E))%R. move: re'r'; rewrite lt_minr => /andP[_]. - by rewrite ltr_subl_addr subrK. - rewrite ltr_subl_addr -lte_fin -(contractK (_ + r)%:E)%R. + by rewrite ltrBlDr subrK. + rewrite ltrBlDr -lte_fin -(contractK (_ + r)%:E)%R. by rewrite addrC -(contractK r'%:E) // lt_expand ?inE ?contract_le1. * rewrite /ereal_ball [contract +oo]/=. rewrite lt_minr => /andP[re'1 re'2]. have [cr0|cr0] := lerP 0 (contract r%:E). move: re'2; rewrite ler0_norm; last first. by rewrite subr_le0; case/ler_normlP : (contract_le1 r%:E). - rewrite opprB ltr_subr_addl addrCA subrr addr0 => h. + rewrite opprB ltrBrDl addrCA subrr addr0 => h. exfalso. move: h; apply/negP; rewrite -leNgt. by case/ler_normlP : (contract_le1 (r%:E + e%:num%:E)). move: re'2; rewrite ler0_norm; last first. by rewrite subr_le0; case/ler_normlP : (contract_le1 r%:E). - rewrite opprB ltr_subr_addl addrCA subrr addr0 => h. + rewrite opprB ltrBrDl addrCA subrr addr0 => h. exfalso. move: h; apply/negP; rewrite -leNgt. by case/ler_normlP : (contract_le1 (r%:E + e%:num%:E)). @@ -1235,11 +1307,11 @@ rewrite predeq2E => x A; split. rewrite lt_minr => /andP[re'1 _]. move: re'1. rewrite ger0_norm; last first. - rewrite addrC -ler_subl_addl add0r. + rewrite addrC -lerBlDl add0r. by move: (contract_le1 r%:E); rewrite ler_norml => /andP[]. - rewrite ltr_add2l => h. + rewrite ltrD2l => h. exfalso. - move: h; apply/negP; rewrite -leNgt -ler_oppl. + move: h; apply/negP; rewrite -leNgt -lerNl. by move: (contract_le1 (r%:E - e%:num%:E)); rewrite ler_norml => /andP[]. + exists (diag (1 - contract M%:E))%R; rewrite /diag. exists (1 - contract M%:E)%R => //=. @@ -1249,33 +1321,33 @@ rewrite predeq2E => x A; split. apply: MA; rewrite lte_fin. rewrite ger0_norm in rM1; last first. by rewrite subr_ge0 // (le_trans _ (contract_le1 r%:E)) // ler_norm. - rewrite ltr_subl_addr addrC addrCA addrC -ltr_subl_addr subrr in rM1. + rewrite ltrBlDr addrC addrCA addrC -ltrBlDr subrr in rM1. rewrite subr_gt0 in rM1. by rewrite -lte_fin -lt_contract. * by rewrite /ereal_ball /= subrr normr0 => h; exact: MA. * rewrite /ereal_ball /= opprK => h {MA}. exfalso. move: h; apply/negP. - rewrite -leNgt [in leRHS]ger0_norm // ler_subl_addr. - rewrite -/(contract M%:E) addrC -ler_subl_addr opprD addrA subrr sub0r. + rewrite -leNgt [in leRHS]ger0_norm // lerBlDr. + rewrite -/(contract M%:E) addrC -lerBlDr opprD addrA subrr sub0r. by move: (contract_le1 M%:E); rewrite ler_norml => /andP[]. + exists (diag (1 + contract M%:E)%R); rewrite /diag. exists (1 + contract M%:E)%R => //=. - rewrite -ltr_subl_addl sub0r. + rewrite -ltrBlDl sub0r. by move: (contract_lt1 M); rewrite ltr_norml => /andP[]. case=> [r| |]. * rewrite /ereal_ball => /= rM1. apply MA. rewrite lte_fin. rewrite ler0_norm in rM1; last first. - rewrite ler_subl_addl addr0 ltW //. + rewrite lerBlDl addr0 ltW //. by move: (contract_lt1 r); rewrite ltr_norml => /andP[]. - rewrite opprB opprK -ltr_subl_addl addrK in rM1. + rewrite opprB opprK -ltrBlDl addrK in rM1. by rewrite -lte_fin -lt_contract. * rewrite /ereal_ball /= -opprD normrN => h {MA}. exfalso. move: h; apply/negP. - rewrite -leNgt [in leRHS]ger0_norm// -ler_subl_addr addrAC. + rewrite -leNgt [in leRHS]ger0_norm// -lerBlDr addrAC. rewrite subrr add0r -/(contract M%:E). by rewrite (le_trans _ (ltW (contract_lt1 M))) // ler_norm. * rewrite /ereal_ball /= => _; exact: MA. @@ -1290,18 +1362,8 @@ rewrite predeq2E => x A; split. by rewrite -ltNge => /nbhs_oo_down_1e; apply => ? ?; exact/sEA/reA. Qed. -Definition ereal_pseudoMetricType_mixin := - PseudoMetric.Mixin (@ereal_ball_center R) (@ereal_ball_sym R) - (@ereal_ball_triangle R) erefl. - -Definition ereal_uniformType_mixin : @Uniform.mixin_of (\bar R) nbhs := - uniformityOfBallMixin ereal_nbhsE ereal_pseudoMetricType_mixin. - -Canonical ereal_uniformType := - UniformType (extended R) ereal_uniformType_mixin. - -Canonical ereal_pseudoMetricType := - PseudoMetricType (extended R) ereal_pseudoMetricType_mixin. +HB.instance Definition _ := Nbhs_isPseudoMetric.Build R (\bar R) + ereal_nbhsE ereal_ball_center ereal_ball_sym ereal_ball_triangle erefl. End ereal_PseudoMetric. @@ -1337,18 +1399,18 @@ Definition ereal_loc_seq (R : numDomainType) (x : \bar R) (n : nat) := end. Lemma cvg_ereal_loc_seq (R : realType) (x : \bar R) : - ereal_loc_seq x --> ereal_dnbhs x. + ereal_loc_seq x @ \oo--> ereal_dnbhs x. Proof. move=> P; rewrite /ereal_loc_seq. case: x => /= [x [_/posnumP[d] dP] |[d [dreal dP]] |[d [dreal dP]]]; last 2 first. have /ZnatP [N Nfloor] : floor (Num.max d 0%R) \is a Znat. by rewrite Znat_def floor_ge0 le_maxr lexx orbC. - exists N.+1 => // n ltNn; apply: dP. + exists N.+1 => // n ltNn; apply: dP; rewrite lte_fin. have /le_lt_trans : (d <= Num.max d 0)%R by rewrite le_maxr lexx. by apply; rewrite (lt_le_trans (lt_succ_floor _))// Nfloor natr1 ler_nat. have /ZnatP [N Nfloor] : floor (Num.max (- d)%R 0%R) \is a Znat. by rewrite Znat_def floor_ge0 le_maxr lexx orbC. - exists N.+1 => // n ltNn; apply: dP; rewrite lte_fin ltr_oppl. + exists N.+1 => // n ltNn; apply: dP; rewrite lte_fin ltrNl. have /le_lt_trans : (- d <= Num.max (- d) 0)%R by rewrite le_maxr lexx. by apply; rewrite (lt_le_trans (lt_succ_floor _))// Nfloor natr1 ler_nat. have /ZnatP [N Nfloor] : floor (d%:num^-1) \is a Znat. @@ -1356,6 +1418,6 @@ have /ZnatP [N Nfloor] : floor (d%:num^-1) \is a Znat. exists N => // n leNn; apply: dP; last first. by rewrite eq_sym addrC -subr_eq subrr eq_sym; exact/invr_neq0/lt0r_neq0. rewrite /= opprD addrA subrr distrC subr0 gtr0_norm; last by rewrite invr_gt0. -rewrite -[ltLHS]mulr1 ltr_pdivr_mull // -ltr_pdivr_mulr // div1r. -by rewrite (lt_le_trans (lt_succ_floor _))// Nfloor ler_add// ler_nat. +rewrite -[ltLHS]mulr1 ltr_pdivrMl // -ltr_pdivrMr // div1r. +by rewrite (lt_le_trans (lt_succ_floor _))// Nfloor lerD// ler_nat. Qed. diff --git a/theories/esum.v b/theories/esum.v index 611c1b3b1..d963a52fd 100644 --- a/theories/esum.v +++ b/theories/esum.v @@ -1,15 +1,16 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From mathcomp Require Import all_ssreflect ssralg ssrnum finmap. -From mathcomp.classical Require Import boolp classical_sets functions. -From mathcomp.classical Require Import cardinality fsbigop mathcomp_extra. +From mathcomp Require Import mathcomp_extra boolp classical_sets functions. +From mathcomp Require Import cardinality fsbigop. Require Import reals ereal signed topology sequences normedtype numfun. -(******************************************************************************) -(* Summation over classical sets *) +(**md**************************************************************************) +(* # Summation over classical sets *) (* *) (* This file provides a definition of sum over classical sets and a few *) (* lemmas in particular for the case of sums of non-negative terms. *) (* *) +(* ``` *) (* fsets S == the set of finite sets (fset) included in S *) (* \esum_(i in I) f i == summation of non-negative extended real numbers over *) (* classical sets; I is a classical set and f is a *) @@ -17,6 +18,7 @@ Require Import reals ereal signed topology sequences normedtype numfun. (* reals; it is 0 if I = set0 and sup(\sum_A a) where A *) (* is a finite set included in I o.w. *) (* summable D f := \esum_(x in D) `| f x | < +oo *) +(* ``` *) (* *) (******************************************************************************) @@ -517,9 +519,9 @@ Qed. Lemma summable_cvg (P : pred nat) (f : (\bar R)^nat) : (forall i, P i -> 0 <= f i)%E -> summable P f -> - cvg (fun n => \sum_(0 <= k < n | P k) fine (f k))%R. + cvg ((fun n => \sum_(0 <= k < n | P k) fine (f k))%R @ \oo). Proof. -move=> f0 Pf; apply: nondecreasing_is_cvg. +move=> f0 Pf; apply: nondecreasing_is_cvgn. by apply: nondecreasing_series => n Pn; exact/fine_ge0/f0. exists (fine (\sum_(i x /= [n _ <-]. rewrite summable_fine_sum// -lee_fin fineK//; last first. @@ -535,17 +537,17 @@ Qed. Lemma summable_nneseries_lim (P : pred nat) (f : (\bar R)^nat) : (forall i, P i -> 0 <= f i)%E -> summable P f -> \sum_(i (\sum_(0 <= k < n | P k) fine (f k))%R))%:E. + (lim ((fun n => (\sum_(0 <= k < n | P k) fine (f k))%R) @ \oo))%:E. Proof. move=> f0 Pf; pose A_ n := (\sum_(0 <= k < n | P k) fine (f k))%R. -transitivity (lim (EFin \o A_)). - congr (lim _); apply/funext => /= n; rewrite /A_ /= -sumEFin. +transitivity (lim (EFin \o A_ @ \oo)). + apply/congr_lim/funext => /= n; rewrite /A_ /= -sumEFin. apply eq_bigr => i Pi/=; rewrite fineK//. by rewrite fin_num_abs (@summable_pinfty _ _ P). by rewrite EFin_lim//; apply: summable_cvg. Qed. -Lemma summable_nneseries (f : nat -> \bar R) (P : pred nat) : summable P f -> +Lemma summable_eseries (f : nat -> \bar R) (P : pred nat) : summable P f -> \sum_(i Pf. pose A_ n := (\sum_(0 <= k < n | P k) fine (f^\+ k))%R. pose B_ n := (\sum_(0 <= k < n | P k) fine (f^\- k))%R. pose C_ n := fine (\sum_(0 <= k < n | P k) f k). -pose A := lim A_. -pose B := lim B_. -suff: ((fun n => C_ n - (A - B)) --> (0 : R^o))%R. +pose A := lim (A_ @ \oo). +pose B := lim (B_ @ \oo). +suff: ((fun n => C_ n - (A - B)) @ \oo --> (0 : R^o))%R. move=> CAB. rewrite [X in X - _]summable_nneseries_lim//; last exact/summable_funepos. rewrite [X in _ - X]summable_nneseries_lim//; last exact/summable_funeneg. - rewrite -EFinB; apply/cvg_lim => //; apply/fine_cvgP; split. - apply: nearW => n. - rewrite fin_num_abs; apply: le_lt_trans Pf => /=. - by rewrite -nneseries_esum// (le_trans (lee_abs_sum _ _ _))// nneseries_lim_ge. - by apply: (@cvg_sub0 _ _ _ _ _ _ (cst (A - B)%R) _ CAB) => //; exact: cvg_cst. -have : ((fun x => A_ x - B_ x) --> A - B)%R. + rewrite -EFinB; apply/cvg_lim => //; apply/fine_cvgP; split; last first. + by apply: (@cvg_sub0 _ _ _ _ _ _ (cst (A - B)%R) _ CAB) => //; exact: cvg_cst. + apply: nearW => n; rewrite fin_num_abs; apply: le_lt_trans Pf => /=. + by rewrite -nneseries_esum// (le_trans (lee_abs_sum _ _ _))// nneseries_lim_ge. +have : ((fun x => A_ x - B_ x) @ \oo --> A - B)%R. apply: cvgD. - by apply: summable_cvg => //; exact/summable_funepos. - by apply: cvgN; apply: summable_cvg => //; exact/summable_funeneg. @@ -575,23 +576,20 @@ rewrite distrC subr0. have -> : (C_ = A_ \- B_)%R. apply/funext => k. rewrite /= /A_ /C_ /B_ -sumrN -big_split/= -summable_fine_sum//. - apply eq_bigr => i Pi. - rewrite -fineB//. + apply eq_bigr => i Pi; rewrite -fineB//. - by rewrite [in LHS](funeposneg f). - by rewrite fin_num_abs (@summable_pinfty _ _ P) //; exact/summable_funepos. - by rewrite fin_num_abs (@summable_pinfty _ _ P) //; exact/summable_funeneg. by rewrite distrC; apply: hN; near: n; exists N. Unshelve. all: by end_near. Qed. -Lemma summable_nneseries_esum (f : nat -> \bar R) (P : pred nat) : +Lemma summable_eseries_esum (f : nat -> \bar R) (P : pred nat) : summable P f -> \sum_(i Pfoo. -rewrite -nneseries_esum; last first. +move=> Pfoo; rewrite -nneseries_esum; last first. by move=> n Pn; rewrite /maxe; case: ifPn => //; rewrite -leNgt. -rewrite -nneseries_esum; last first. - by move=> n Pn; rewrite /maxe; case: ifPn => //; rewrite leNgt. -by rewrite [LHS]summable_nneseries. +rewrite -nneseries_esum ?[LHS]summable_eseries//. +by move=> n Pn; rewrite /maxe; case: ifPn => //; rewrite leNgt. Qed. End summable_nat. @@ -625,7 +623,7 @@ have /eqP : esum D (f \- g)^\+ + esum_posneg D g = esum D (f \- g)^\- + esum_pos rewrite max_r 1?lee_oppl ?oppe0// add0e subeK//. by rewrite fin_num_abs (summable_pinfty Dg). rewrite add0e max_l; last by rewrite lee_oppr oppe0 ltW. - rewrite oppeB//; last by rewrite fin_num_abs (summable_pinfty Dg). + rewrite fin_num_oppeB//; last by rewrite fin_num_abs (summable_pinfty Dg). by rewrite -addeA addeCA addeA subeK// fin_num_abs (summable_pinfty Df). rewrite [X in _ == X -> _]addeC -sube_eq; last 2 first. - rewrite fin_numD; apply/andP; split. @@ -635,14 +633,14 @@ rewrite [X in _ == X -> _]addeC -sube_eq; last 2 first. move: Dg; rewrite summableE (@eq_esum _ _ _ _ g)//. by rewrite ge0_esum_posneg// => t Tt; rewrite gee0_abs// g0. by move=> t Tt; rewrite gee0_abs// g0. - - rewrite adde_defC fin_num_adde_def// ge0_esum_posneg//. + - rewrite fin_num_adde_defr// ge0_esum_posneg//. rewrite (@eq_esum _ _ _ _ (abse \o f))// -?summableE// => i Di. by rewrite /= gee0_abs// f0. rewrite -addeA addeCA eq_sym [X in _ == X -> _]addeC -sube_eq; last 2 first. - rewrite ge0_esum_posneg// (@eq_esum _ _ _ _ (abse \o f))// -?summableE// => i Di. by rewrite /= gee0_abs// f0. - - rewrite fin_num_adde_def//. - rewrite ge0_esum_posneg// (@eq_esum _ _ _ _ (abse \o g))// -?summableE// => i Di. + - rewrite fin_num_adde_defl// ge0_esum_posneg//. + rewrite (@eq_esum _ _ _ _ (abse \o g))// -?summableE// => i Di. by rewrite /= gee0_abs// g0. by rewrite ge0_esum_posneg// ge0_esum_posneg// => /eqP ->. Qed. diff --git a/theories/exp.v b/theories/exp.v index 367daac7c..a92627b56 100644 --- a/theories/exp.v +++ b/theories/exp.v @@ -1,27 +1,35 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum matrix. From mathcomp Require Import interval rat. -From mathcomp.classical Require Import boolp classical_sets functions. -From mathcomp.classical Require Import mathcomp_extra. -Require Import reals ereal nsatz_realtype. +From mathcomp Require Import boolp classical_sets functions. +From mathcomp Require Import mathcomp_extra. +Require Import reals ereal. Require Import signed topology normedtype landau sequences derive realfun. +Require Import itv convex. -(******************************************************************************) -(* Theory of exponential/logarithm functions *) +(**md**************************************************************************) +(* # Theory of exponential/logarithm functions *) (* *) (* This file defines exponential and logarithm functions and develops their *) (* theory. *) (* *) -(* * Differentiability of series (Section PseriesDiff) *) -(* This formalization is inspired by HOL-Light (transc.ml). This part is *) -(* temporary: it should be subsumed by a proper theory of power series. *) +(* ## Differentiability of series (Section PseriesDiff) *) +(* *) +(* This formalization is inspired by HOL-Light (transc.ml). This part is *) +(* temporary: it should be subsumed by a proper theory of power series. *) +(* ``` *) (* pseries f x == [series f n * x ^ n]_n *) (* pseries_diffs f i == (i + 1) * f (i + 1) *) (* *) +(* expeR x == extended real number-valued exponential function *) (* ln x == the natural logarithm *) -(* a `^ x == exponential functions *) +(* s `^ r == power function, in ring_scope (assumes s >= 0) *) +(* e `^ r == power function, in ereal_scope (assumes e >= 0) *) (* riemannR a == sequence n |-> 1 / (n.+1) `^ a where a has a type *) (* of type realType *) +(* e `^?(r +? s) == validity condition for the distributivity of *) +(* the power of the addition, in ereal_scope *) +(* ``` *) (* *) (******************************************************************************) @@ -34,10 +42,14 @@ Import numFieldNormedType.Exports. Local Open Scope classical_set_scope. Local Open Scope ring_scope. +Reserved Notation "x '`^?' ( r +? s )" + (format "x '`^?' ( r +? s )", r at next level, at level 11) . + (* PR to mathcomp in progress *) Lemma normr_nneg (R : numDomainType) (x : R) : `|x| \is Num.nneg. -Proof. by rewrite qualifE. Qed. -#[global] Hint Resolve normr_nneg : core. +Proof. by rewrite qualifE/=. Qed. +#[global] Hint Extern 0 (is_true (@Num.norm _ _ _ \is Num.nneg)) => + solve [apply: normr_nneg] : core. (* /PR to mathcomp in progress *) Section PseriesDiff. @@ -47,7 +59,8 @@ Variable R : realType. Definition pseries f (x : R) := [series f i * x ^+ i]_i. Fact is_cvg_pseries_inside_norm f (x z : R) : - cvg (pseries f x) -> `|z| < `|x| -> cvg (pseries (fun i => `|f i|) z). + cvgn (pseries f x) -> `|z| < `|x| -> + cvgn ((pseries (fun i => `|f i|) z)). Proof. move=> Cx zLx; have [K [Kreal Kf]] := cvg_series_bounded Cx. have Kzxn n : 0 <= `|K + 1| * `|z ^+ n| / `|x ^+ n| by rewrite !mulr_ge0. @@ -56,17 +69,17 @@ apply: series_le_cvg Kzxn _ _ => [//=| /= n|]. rewrite (_ : `|_ * _| = `|f n * x ^+ n| * `|z ^+ n| / `|x ^+ n|); last first. rewrite !normrM normr_id mulrAC mulfK // normr_eq0 expf_eq0 andbC. by case: ltrgt0P zLx; rewrite //= normr_lt0. - do! (apply: ler_pmul || apply: mulr_ge0 || rewrite invr_ge0) => //. - by apply Kf => //; rewrite (lt_le_trans _ (ler_norm _))// ltr_addl. + do! (apply: ler_pM || apply: mulr_ge0 || rewrite invr_ge0) => //. + by apply Kf => //; rewrite (lt_le_trans _ (ler_norm _))// ltrDl. have F : `|z / x| < 1. - by rewrite normrM normfV ltr_pdivr_mulr ?mul1r // (le_lt_trans _ zLx). + by rewrite normrM normfV ltr_pdivrMr ?mul1r // (le_lt_trans _ zLx). rewrite (_ : (fun _ => _) = geometric `|K + 1| `|z / x|); last first. by apply/funext => i /=; rewrite normrM exprMn mulrA normfV !normrX exprVn. by apply: is_cvg_geometric_series; rewrite normr_id. Qed. Fact is_cvg_pseries_inside f (x z : R) : - cvg (pseries f x) -> `|z| < `|x| -> cvg (pseries f z). + cvgn (pseries f x) -> `|z| < `|x| -> cvgn (pseries f z). Proof. move=> Cx zLx. apply: normed_cvg; rewrite /normed_series_of /=. @@ -98,18 +111,20 @@ Qed. Lemma pseries_diffs_equiv f x : let s i := i%:R * f i * x ^+ i.-1 in - cvg (pseries (pseries_diffs f) x) -> series s --> - lim (pseries (pseries_diffs f) x). + cvgn (pseries (pseries_diffs f) x) -> + series s @ \oo --> limn (pseries (pseries_diffs f) x). Proof. -move=> s Cx; rewrite -[lim _]subr0 /pseries [X in X --> _]/series /=. -rewrite [X in X --> _](_ : _ = (fun n => \sum_(0 <= i < n) +move=> s Cx; rewrite -[lim _]subr0. +rewrite /pseries/= [X in X @ \oo --> _]/series /=. +rewrite [X in X @ \oo --> _](_ : _ = (fun n => \sum_(0 <= i < n) pseries_diffs f i * x ^+ i - n%:R * f n * x ^+ n.-1)); last first. by rewrite funeqE => n; rewrite pseries_diffs_sumE addrK. by apply: cvgB => //; rewrite -cvg_shiftS; exact: cvg_series_cvg_0. Qed. Lemma is_cvg_pseries_diffs_equiv f x : - cvg (pseries (pseries_diffs f) x) -> cvg [series i%:R * f i * x ^+ i.-1]_i. + cvgn (pseries (pseries_diffs f) x) -> + cvgn ([series i%:R * f i * x ^+ i.-1]_i). Proof. by by move=> Cx; have := pseries_diffs_equiv Cx; move/(cvg_lim _) => -> //. Qed. @@ -150,7 +165,7 @@ Let pseries_diffs_P3 (z h : R) n K : Proof. move=> hNZ zLK zhLk. rewrite pseries_diffs_P2// normrM mulrC. -rewrite ler_pmul2r ?normr_gt0//. +rewrite ler_pM2r ?normr_gt0//. rewrite (le_trans (ler_norm_sum _ _ _))//. rewrite -mulrA mulrC -mulrA mulr_natl -[X in _ *+ X]subn0 -sumr_const_nat. apply ler_sum_nat => i /=. @@ -161,81 +176,82 @@ rewrite -[(n - i)%nat]prednK ?subn_gt0// predn_sub -/d. rewrite -(subnK (_ : i <= n.-1)%nat) -/d; last first. by rewrite -ltnS prednK// (leq_ltn_trans _ ni). rewrite addnC exprD mulrAC -mulrA. -apply: ler_pmul => //. - by rewrite normrX ler_expn2r// qualifE (le_trans _ zLK). +apply: ler_pM => //. + by rewrite normrX lerXn2r// qualifE/= (le_trans _ zLK). apply: le_trans (_ : d.+1%:R * K ^+ d <= _); last first. - rewrite ler_wpmul2r //; first by rewrite exprn_ge0 // (le_trans _ zLK). + rewrite ler_wpM2r //; first by rewrite exprn_ge0 // (le_trans _ zLK). by rewrite ler_nat ltnS /d -subn1 -subnDA leq_subr. rewrite (le_trans (ler_norm_sum _ _ _))//. rewrite mulr_natl -[X in _ *+ X]subn0 -sumr_const_nat ler_sum_nat//= => j jd1. rewrite -[in leRHS](subnK (_ : j <= d)%nat) -1?ltnS // addnC exprD normrM. -by rewrite ler_pmul// normrX ler_expn2r// qualifE (le_trans _ zLK). +by rewrite ler_pM// normrX lerXn2r// qualifE/= (le_trans _ zLK). Qed. Lemma pseries_snd_diffs (c : R^nat) K x : - cvg (pseries c K) -> - cvg (pseries (pseries_diffs c) K) -> - cvg (pseries (pseries_diffs (pseries_diffs c)) K) -> + cvgn (pseries c K) -> + cvgn (pseries (pseries_diffs c) K) -> + cvgn (pseries (pseries_diffs (pseries_diffs c)) K) -> `|x| < `|K| -> - is_derive x 1 - (fun x => lim (pseries c x)) - (lim (pseries (pseries_diffs c) x)). + is_derive x (1 : R) + (fun x => limn (pseries c x)) + (limn (pseries (pseries_diffs c) x)). Proof. move=> Ck CdK CddK xLK; rewrite /pseries. set s := (fun n : nat => _); set (f := fun x0 => _). -suff hfxs : h^-1 *: (f (h + x) - f x) @[h --> 0^'] --> lim (series s). - have F : f^`() x = lim (series s) by apply: cvg_lim hfxs. +suff hfxs : h^-1 *: (f (h + x) - f x) @[h --> 0^'] --> limn (series s). + have F : f^`() x = limn (series s) by apply: cvg_lim hfxs. have Df : derivable f x 1. - move: hfxs; rewrite /derivable [X in X @ _](_ : _ = + move: hfxs; rewrite /derivable [X in X @ 0^'](_ : _ = (fun h => h^-1 *: (f (h%:A + x) - f x))) /=; last first. by apply/funext => i //=; rewrite [i%:A]mulr1. by move=> /(cvg_lim _) -> //. by constructor; [exact: Df|rewrite -derive1E]. pose sx := fun n : nat => c n * x ^+ n. -have Csx : cvg (pseries c x) by apply: is_cvg_pseries_inside Ck _. +have Csx : cvgn (pseries c x) by apply: is_cvg_pseries_inside Ck _. pose shx := fun h (n : nat) => c n * (h + x) ^+ n. -suff Cc : lim (h^-1 *: (series (shx h - sx))) @[h --> 0^'] --> lim (series s). +suff Cc : limn (h^-1 *: (series (shx h - sx))) @[h --> 0^'] --> limn (series s). apply: cvg_sub0 Cc. apply/cvgrPdist_lt => eps eps_gt0 /=. near=> h; rewrite sub0r normrN /=. rewrite (le_lt_trans _ eps_gt0)//. rewrite normr_le0 subr_eq0 -/sx -/(shx _); apply/eqP. - have Cshx' : cvg (series (shx h)). + have Cshx' : cvgn (series (shx h)). apply: is_cvg_pseries_inside Ck _. - rewrite (le_lt_trans (ler_norm_add _ _))// -(subrK `|x| `|K|) ltr_add2r. + rewrite (le_lt_trans (ler_normD _ _))// -(subrK `|x| `|K|) ltrD2r. near: h. - apply/nbhs_ballP => /=; exists ((`|K| - `|x|) /2) => /=. + apply/nbhs_ballP => /=; exists ((`|K| - `|x|) /2%:R) => /=. by rewrite divr_gt0 // subr_gt0. move=> t; rewrite /ball /= sub0r normrN => H tNZ. - rewrite (lt_le_trans H)// ler_pdivr_mulr // mulr2n mulrDr mulr1. - by rewrite ler_paddr // subr_ge0 ltW. - by rewrite limZr; [rewrite lim_seriesB|exact: is_cvg_seriesB]. + rewrite (lt_le_trans H)// ler_pdivrMr // mulr2n mulrDr mulr1. + by rewrite ler_wpDr // subr_ge0 ltW. + rewrite limZr; last exact/is_cvg_seriesB/Csx. + by rewrite lim_seriesB; last exact: Csx. apply: cvg_zero => /=. -suff Cc : lim +suff Cc : limn (series (fun n => c n * (((h + x) ^+ n - x ^+ n) / h - n%:R * x ^+ n.-1))) @[h --> 0^'] --> (0 : R). apply: cvg_sub0 Cc. apply/cvgrPdist_lt => eps eps_gt0 /=. near=> h; rewrite sub0r normrN /=. rewrite (le_lt_trans _ eps_gt0)// normr_le0 subr_eq0; apply/eqP. - have Cs : cvg (series s) by apply: is_cvg_pseries_inside CdK _. + have Cs : cvgn (series s) by apply: is_cvg_pseries_inside CdK _. have Cs1 := is_cvg_pseries_diffs_equiv Cs. have Fs1 := pseries_diffs_equiv Cs. set s1 := (fun i => _) in Cs1. - have Cshx : cvg (series (shx h)). + have Cshx : cvgn (series (shx h)). apply: is_cvg_pseries_inside Ck _. - rewrite (le_lt_trans (ler_norm_add _ _))// -(subrK `|x| `|K|) ltr_add2r. + rewrite (le_lt_trans (ler_normD _ _))// -(subrK `|x| `|K|) ltrD2r. near: h. - apply/nbhs_ballP => /=; exists ((`|K| - `|x|) /2) => /=. + apply/nbhs_ballP => /=; exists ((`|K| - `|x|) / 2%:R) => /=. by rewrite divr_gt0 // subr_gt0. move=> t; rewrite /ball /= sub0r normrN => H tNZ. - rewrite (lt_le_trans H)// ler_pdivr_mulr // mulr2n mulrDr mulr1. - by rewrite ler_paddr // subr_ge0 ltW. + rewrite (lt_le_trans H)// ler_pdivrMr // mulr2n mulrDr mulr1. + by rewrite ler_wpDr // subr_ge0 ltW. have C1 := is_cvg_seriesB Cshx Csx. have Ckf := @is_cvg_seriesZ _ _ h^-1 C1. have Cu : (series (h^-1 *: (shx h - sx)) - series s1) x0 @[x0 --> \oo] --> - lim (series (h^-1 *: (shx h - sx))) - lim (series s). - by apply: cvgB. + limn (series (h^-1 *: (shx h - sx))) - limn (series s). + exact: cvgB Ckf Fs1. set w := (fun n : nat => _ in RHS). have -> : w = h^-1 *: (shx h - sx) - s1. apply: funext => i; rewrite !fctE. @@ -250,15 +266,15 @@ suff Cc : lim by apply/funext => i; rewrite /series /= -scaler_sumr. exact/esym/cvg_lim. pose r := (`|x| + `|K|) / 2. -have xLr : `|x| < r by rewrite ltr_pdivl_mulr // mulr2n mulrDr mulr1 ltr_add2l. -have rLx : r < `|K| by rewrite ltr_pdivr_mulr // mulr2n mulrDr mulr1 ltr_add2r. +have xLr : `|x| < r by rewrite ltr_pdivlMr // mulrDr mulr1 ltrD2l. +have rLx : r < `|K| by rewrite ltr_pdivrMr // mulrDr mulr1 ltrD2r. have r_gt0 : 0 < r by apply: le_lt_trans xLr. have rNZ : r != 0by case: ltrgt0P r_gt0. apply: (@lim_cvg_to_0_linear _ (fun n => `|c n| * n%:R * (n.-1)%:R * r ^+ n.-2) (fun h n => c n * (((h + x) ^+ n - x ^+ n) / h - n%:R * x ^+ n.-1)) (r - `|x|)); first by rewrite subr_gt0. -- have : cvg [series `|pseries_diffs (pseries_diffs c) n| * r ^+ n]_n. +- have : cvgn ([series `|pseries_diffs (pseries_diffs c) n| * r ^+ n]_n). apply: is_cvg_pseries_inside_norm CddK _. by rewrite ger0_norm // ltW // (le_lt_trans _ xLr). have -> : (fun n => `|pseries_diffs (pseries_diffs c) n| * r ^+ n) = @@ -284,10 +300,11 @@ apply: (@lim_cvg_to_0_linear _ rewrite mul1r !mulrA; congr (_ * _). by rewrite mulrC mulrA. - move=> h /andP[h_gt0 hLrBx] n. - rewrite normrM -!mulrA ler_wpmul2l //. + rewrite normrM -!mulrA ler_wpM2l //. rewrite (le_trans (pseries_diffs_P3 _ _ (ltW xLr) _))// ?mulrA -?normr_gt0//. - by rewrite (le_trans (ler_norm_add _ _))// -(subrK `|x| r) ler_add2r ltW. -Unshelve. all: by end_near. Qed. + by rewrite (le_trans (ler_normD _ _))// -(subrK `|x| r) lerD2r ltW. +Unshelve. all: by end_near. +Qed. End PseriesDiff. @@ -310,11 +327,11 @@ pose f (x : R) i := (i == 0%nat)%:R + x *+ (i == 1%nat). have F n : (1 < n)%nat -> \sum_(0 <= i < n) (f x i) = 1 + x. move=> /subnK<-. by rewrite addn2 !big_nat_recl //= /f /= mulr1n !mulr0n big1 ?add0r ?addr0. -have -> : 1 + x = lim (series (f x)). +have -> : 1 + x = limn (series (f x)). by apply/esym/lim_near_cst => //; near=> n; apply: F; near: n. apply: ler_lim; first by apply: is_cvg_near_cst; near=> n; apply: F; near: n. exact: is_cvg_series_exp_coeff. -by near=> n; apply: ler_sum => [] [|[|i]] _; +by near=> n; apply: ler_sum => -[|[|i]] _; rewrite /f /exp_coeff /= !(mulr0n, mulr1n, expr0, expr1, divr1, addr0, add0r) // exp_coeff_ge0. Unshelve. all: by end_near. Qed. @@ -326,7 +343,7 @@ Import GRing.Theory. Local Open Scope ring_scope. Lemma expRE : - expR = fun x => lim (pseries (fun n => (fun n => (n`!%:R)^-1) n) x). + expR = fun x => limn (pseries (fun n => (fun n => (n`!%:R)^-1) n) x). Proof. by apply/funext => x; rewrite /pseries -exp_coeffE. Qed. Global Instance is_derive_expR x : is_derive x 1 expR (expR x). @@ -348,6 +365,9 @@ Qed. Lemma derivable_expR x : derivable expR x 1. Proof. by apply: ex_derive; apply: is_derive_exp. Qed. +Lemma derive_expR : 'D_1 expR = expR :> (R -> R). +Proof. by apply/funext => r /=; rewrite derive_val. Qed. + Lemma continuous_expR : continuous (@expR R). Proof. by move=> x; exact/differentiable_continuous/derivable1_diffP/derivable_expR. @@ -367,7 +387,7 @@ Proof. by rewrite -[X in _ X * _ = _]addr0 expRxDyMexpx expR0. Qed. Lemma pexpR_gt1 x : 0 < x -> 1 < expR x. Proof. -by move=> x_gt0; rewrite (lt_le_trans _ (expR_ge1Dx (ltW x_gt0)))// ltr_addl. +by move=> x_gt0; rewrite (lt_le_trans _ (expR_ge1Dx (ltW x_gt0)))// ltrDl. Qed. Lemma expR_gt0 x : 0 < expR x. @@ -380,6 +400,9 @@ Qed. Lemma expR_ge0 x : 0 <= expR x. Proof. by rewrite ltW// expR_gt0. Qed. +Lemma expR_eq0 x : (expR x == 0) = false. +Proof. by rewrite gt_eqF ?expR_gt0. Qed. + Lemma expRN x : expR (- x) = (expR x)^-1. Proof. apply: (mulfI (lt0r_neq0 (expR_gt0 x))). @@ -399,20 +422,20 @@ elim: n x => [x|n IH x] /=; first by rewrite mul0r expr0 expR0. by rewrite exprS -nat1r mulrDl mul1r expRD IH. Qed. -Lemma expR_gt1 x: (1 < expR x) = (0 < x). +Lemma expR_gt1 x : (1 < expR x) = (0 < x). Proof. case: ltrgt0P => [x_gt0| xN|->]; last by rewrite expR0. - by rewrite (pexpR_gt1 x_gt0). - apply/idP/negP. rewrite -[x]opprK expRN -leNgt invf_cp1 ?expR_gt0 //. - by rewrite ltW // pexpR_gt1 // lter_oppE. + by rewrite ltW // pexpR_gt1 // lterNE. Qed. -Lemma expR_lt1 x: (expR x < 1) = (x < 0). +Lemma expR_lt1 x : (expR x < 1) = (x < 0). Proof. case: ltrgt0P => [x_gt0|xN|->]; last by rewrite expR0. - by apply/idP/negP; rewrite -leNgt ltW // expR_gt1. -- by rewrite -[x]opprK expRN invf_cp1 ?expR_gt0 // expR_gt1 lter_oppE. +- by rewrite -[x]opprK expRN invf_cp1 ?expR_gt0 // expR_gt1 lterNE. Qed. Lemma expRB x y : expR (x - y) = expR x / expR y. @@ -421,7 +444,7 @@ Proof. by rewrite expRD expRN. Qed. Lemma ltr_expR : {mono (@expR R) : x y / x < y}. Proof. move=> x y. -by rewrite -[in LHS](subrK x y) expRD ltr_pmull ?expR_gt0 // expR_gt1 subr_gt0. +by rewrite -[in LHS](subrK x y) expRD ltr_pMl ?expR_gt0 // expR_gt1 subr_gt0. Qed. Lemma ler_expR : {mono (@expR R) : x y / x <= y}. @@ -446,10 +469,10 @@ have [x1 x1Ix| |x1 _ /eqP] := @IVT _ (fun y => expR y - x) _ _ 0 x_ge0. - apply: continuousB => // y1; last exact: cst_continuous. by apply/continuous_subspaceT=> ?; exact: continuous_expR. - rewrite expR0; have [_| |] := ltrgtP (1- x) (expR x - x). - + by rewrite subr_le0 x_ge1 subr_ge0 (le_trans _ (expR_ge1Dx _)) ?ler_addr. - + by rewrite ltr_add2r expR_lt1 ltNge x_ge0. + + by rewrite subr_le0 x_ge1 subr_ge0 (le_trans _ (expR_ge1Dx _)) ?lerDr. + + by rewrite ltrD2r expR_lt1 ltNge x_ge0. + rewrite subr_le0 x_ge1 => -> /=; rewrite subr_ge0. - by rewrite (le_trans _ (expR_ge1Dx x_ge0)) ?ler_addr. + by rewrite (le_trans _ (expR_ge1Dx x_ge0)) ?lerDr. - rewrite subr_eq0 => /eqP x1_x; exists x1; split => //. + by rewrite -ler_expR expR0 x1_x. + by rewrite -x1_x expR_ge1Dx // -ler_expR x1_x expR0. @@ -463,15 +486,100 @@ have /expR_total_gt1[y [H1y H2y H3y]] : 1 <= x^-1 by rewrite ltW // !invf_cp1. by exists (-y); rewrite expRN H3y invrK. Qed. +Local Open Scope convex_scope. +Lemma convex_expR (t : {i01 R}) (a b : R^o) : + expR (a <| t |> b) <= (expR a : R^o) <| t |> (expR b : R^o). +Proof. +have [ab|/ltW ba] := leP a b. +- apply: second_derivative_convex => //. + + by move=> x axb; rewrite derive_expR derive_val expR_ge0. + + exact/cvg_at_left_filter/continuous_expR. + + exact/cvg_at_right_filter/continuous_expR. + + by move=> z zab; rewrite derive_expR; exact: derivable_expR. +- rewrite convC [leRHS]convC; apply: second_derivative_convex => //. + + by move=> x axb; rewrite derive_expR derive_val expR_ge0. + + exact/cvg_at_left_filter/continuous_expR. + + exact/cvg_at_right_filter/continuous_expR. + + by move=> z zab; rewrite derive_expR; exact: derivable_expR. +Qed. +Local Close Scope convex_scope. + End expR. +Section expeR. +Context {R : realType}. +Implicit Types (x y : \bar R) (r s : R). + +Local Open Scope ereal_scope. + +Definition expeR x := + match x with | r%:E => (expR r)%:E | +oo => +oo | -oo => 0 end. + +Lemma expeR0 : expeR 0 = 1. Proof. by rewrite /= expR0. Qed. + +Lemma expeR_ge0 x : 0 <= expeR x. +Proof. by case: x => //= r; rewrite lee_fin expR_ge0. Qed. + +Lemma expeR_gt0 x : -oo < x -> 0 < expeR x. +Proof. by case: x => //= r; rewrite lte_fin expR_gt0. Qed. + +Lemma expeR_eq0 x : (expeR x == 0) = (x == -oo). +Proof. by case: x => //= [r|]; rewrite ?eqxx// eqe expR_eq0. Qed. + +Lemma expeRD x y : expeR (x + y) = expeR x * expeR y. +Proof. +case: x => /= [r| |]; last by rewrite mul0e. +- case: y => /= [s| |]; last by rewrite mule0. + + by rewrite expRD EFinM. + + by rewrite mulry gtr0_sg ?mul1e// expR_gt0. +- case: y => /= [s| |]; last by rewrite mule0. + + by rewrite mulyr gtr0_sg ?mul1e// expR_gt0. + + by rewrite mulyy. +Qed. + +Lemma expeR_ge1Dx x : 0 <= x -> 1 + x <= expeR x. +Proof. by case: x => //= r; rewrite -EFinD !lee_fin; exact: expR_ge1Dx. Qed. + +Lemma ltr_expeR : {mono expeR : x y / x < y}. +Proof. +move=> [r| |] [s| |]//=; rewrite ?ltry//. +- by rewrite !lte_fin ltr_expR. +- by rewrite !ltNge lee_fin expR_ge0 leNye. +- by rewrite lte_fin expR_gt0 ltNye. +Qed. + +Lemma ler_expeR : {mono expeR : x y / x <= y}. +Proof. +move=> [r| |] [s| |]//=; rewrite ?leey ?lexx//. +- by rewrite !lee_fin ler_expR. +- by rewrite !leNgt lte_fin expR_gt0 ltNye. +- by rewrite lee_fin expR_ge0 leNye. +Qed. + +Lemma expeR_inj : injective expeR. +Proof. +move=> [r| |] [s| |] => //=. +- by move=> [] /expR_inj ->. +- by case => /eqP; rewrite expR_eq0. +- by case => /esym/eqP; rewrite expR_eq0. +Qed. + +Lemma expeR_total x : 0 <= x -> exists y, expeR y = x. +Proof. +move: x => [r|_|//]; last by exists +oo. +rewrite le_eqVlt => /predU1P[<-|]; first by exists -oo. +by rewrite lte_fin => /expR_total[y <-]; exists y%:E. +Qed. + +End expeR. + Section Ln. Variable R : realType. Implicit Types x : R. Notation exp := (@expR R). -Definition ln x : R := xget 0 [set y | exp y == x ]. +Definition ln x : R := [get y | exp y == x ]. Fact ln0 x : x <= 0 -> ln x = 0. Proof. @@ -479,7 +587,7 @@ rewrite /ln; case: xgetP => //= y _ /eqP yx x0. by have := expR_gt0 y; rewrite yx => /(le_lt_trans x0); rewrite ltxx. Qed. -Lemma expK : cancel exp ln. +Lemma expRK : cancel exp ln. Proof. by move=> x; rewrite /ln; case: xgetP => [x1 _ /eqP/expR_inj //|/(_ x)[]/=]. Qed. @@ -497,7 +605,7 @@ by apply/eqP/idP=> [<-|x0]; [exact: expR_gt0|rewrite lnK// in_itv/= x0]. Qed. Lemma ln1 : ln 1 = 0. -Proof. by apply/expR_inj; rewrite lnK// ?expR0// qualifE. Qed. +Proof. by apply/expR_inj; rewrite lnK// ?expR0// qualifE/=. Qed. Lemma lnM : {in Num.pos &, {morph ln : x y / x * y >-> x + y}}. Proof. @@ -511,7 +619,7 @@ Proof. by move=> x y /lnK {2}<- /lnK {2}<- ->. Qed. Lemma lnV : {in Num.pos, {morph ln : x / x ^-1 >-> - x}}. Proof. move=> x x0; apply: expR_inj; rewrite lnK// ?expRN ?lnK//. -by move: x0; rewrite !qualifE invr_gt0. +by move: x0; rewrite !qualifE/= invr_gt0. Qed. Lemma ln_div : {in Num.pos &, {morph ln : x y / x / y >-> x - y}}. @@ -526,114 +634,509 @@ Proof. by move=> x y x_gt0 y_gt0; rewrite -ltr_expR !lnK. Qed. Lemma ler_ln : {in Num.pos &, {mono ln : x y / x <= y}}. Proof. by move=> x y x_gt0 y_gt0; rewrite -ler_expR !lnK. Qed. -Lemma lnX n x : 0 < x -> ln(x ^+ n) = ln x *+ n. +Lemma lnXn n x : 0 < x -> ln (x ^+ n) = ln x *+ n. Proof. move=> x_gt0; elim: n => [|n ih] /=; first by rewrite expr0 ln1 mulr0n. -by rewrite !exprS lnM ?qualifE// ?exprn_gt0// mulrS ih. +by rewrite !exprS lnM ?qualifE//= ?exprn_gt0// mulrS ih. Qed. Lemma le_ln1Dx x : 0 <= x -> ln (1 + x) <= x. Proof. move=> x_ge0; rewrite -ler_expR lnK ?expR_ge1Dx //. -by apply: lt_le_trans (_ : 0 < 1) _; rewrite // ler_addl. +by apply: lt_le_trans (_ : 0 < 1) _; rewrite // lerDl. Qed. Lemma ln_sublinear x : 0 < x -> ln x < x. Proof. move=> x_gt0; apply: lt_le_trans (_ : ln (1 + x) <= _). - by rewrite -ltr_expR !lnK ?qualifE ?addr_gt0 // ltr_addr. -by rewrite -ler_expR lnK ?qualifE ?addr_gt0// expR_ge1Dx // ltW. + by rewrite -ltr_expR !lnK ?qualifE/= ?addr_gt0 // ltrDr. +by rewrite -ler_expR lnK ?qualifE/= ?addr_gt0// expR_ge1Dx // ltW. Qed. Lemma ln_ge0 x : 1 <= x -> 0 <= ln x. Proof. -by move=> x_ge1; rewrite -ler_expR expR0 lnK// qualifE (lt_le_trans _ x_ge1). +by move=> x_ge1; rewrite -ler_expR expR0 lnK// qualifE/= (lt_le_trans _ x_ge1). Qed. Lemma ln_gt0 x : 1 < x -> 0 < ln x. Proof. -by move=> x_gt1; rewrite -ltr_expR expR0 lnK // qualifE (lt_trans _ x_gt1). +by move=> x_gt1; rewrite -ltr_expR expR0 lnK // qualifE/= (lt_trans _ x_gt1). +Qed. + +Lemma ln_le0 (x : R) : x <= 1 -> ln x <= 0. +Proof. +have [x0|x0 x1] := leP x 0; first by rewrite ln0. +by rewrite -ler_expR expR0 lnK. Qed. Lemma continuous_ln x : 0 < x -> {for x, continuous ln}. Proof. move=> x_gt0; rewrite -[x]lnK//. -apply: nbhs_singleton (near_can_continuous _ _); near=> z; first exact: expK. +apply: nbhs_singleton (near_can_continuous _ _); near=> z; first exact: expRK. by apply: continuous_expR. Unshelve. all: by end_near. Qed. Global Instance is_derive1_ln (x : R) : 0 < x -> is_derive x 1 ln x^-1. Proof. move=> x_gt0; rewrite -[x]lnK//. -apply: (@is_derive_inverse R expR); first by near=> z; apply: expK. +apply: (@is_derive_inverse R expR); first by near=> z; apply: expRK. by near=>z; apply: continuous_expR. by rewrite lnK // lt0r_neq0. Unshelve. all: by end_near. Qed. +Local Open Scope convex_scope. +Lemma concave_ln (t : {i01 R}) (a b : R^o) : 0 < a -> 0 < b -> + (ln a : R^o) <| t |> (ln b : R^o) <= ln (a <| t |> b). +Proof. +move=> a0 b0; have := convex_expR t (ln a) (ln b). +by rewrite !lnK// -(@ler_ln) ?posrE ?expR_gt0 ?conv_gt0// expRK. +Qed. +Local Close Scope convex_scope. + End Ln. -Section ExpFun. +Section PowR. Variable R : realType. -Implicit Types a x : R. +Implicit Types a x y z r : R. + +Definition powR a x := if a == 0 then (x == 0)%:R else expR (x * ln a). + +Local Notation "a `^ x" := (powR a x). + +Lemma expRM x y : expR (x * y) = (expR x) `^ y. +Proof. by rewrite /powR gt_eqF ?expR_gt0// expRK mulrC. Qed. + +Lemma powR_ge0 a x : 0 <= a `^ x. +Proof. by rewrite /powR; case: ifPn => // _; exact: expR_ge0. Qed. + +Lemma powR_gt0 a x : 0 < a -> 0 < a `^ x. +Proof. by move=> a0; rewrite /powR gt_eqF// expR_gt0. Qed. + +Lemma gt0_powR a x : 0 < x -> 0 <= a -> 0 < a `^ x -> 0 < a. +Proof. +move=> x0 a0; rewrite /powR; case: ifPn => [_|a_neq0 _]. + by rewrite gt_eqF//= ltxx. +by rewrite lt_neqAle a0 andbT eq_sym. +Qed. + +Lemma powR0 x : x != 0 -> 0 `^ x = 0. +Proof. by move=> x0; rewrite /powR eqxx (negbTE x0). Qed. + +Lemma powRr1 a : 0 <= a -> a `^ 1 = a. +Proof. +rewrite le_eqVlt => /predU1P[<-|a0]; first by rewrite powR0// oner_eq0. +by rewrite /powR gt_eqF// mul1r lnK// posrE. +Qed. + +Lemma powRr0 a : a `^ 0 = 1. +Proof. by rewrite /powR; case: ifPn; rewrite ?eqxx// mul0r expR0. Qed. + +Lemma powR1 : powR 1 = fun=> 1. +Proof. by apply/funext => x; rewrite /powR oner_eq0 ln1 mulr0 expR0. Qed. + +Lemma powR_eq0 x p : (x `^ p == 0) = (x == 0) && (p != 0). +Proof. +rewrite /powR; have [_|x_neq0] := eqVneq x 0 => //. + by case: (p == 0); rewrite (oner_eq0, eqxx). +by rewrite expR_eq0. +Qed. + +Lemma powR_eq0_eq0 x p : x `^ p = 0 -> x = 0. +Proof. by move=> /eqP; rewrite powR_eq0 => /andP[/eqP]. Qed. + +Lemma ger_powR a : 0 < a <= 1 -> {homo powR a : x y /~ y <= x}. +Proof. +move=> /andP[a0 a1] x y xy. +by rewrite /powR gt_eqF// ler_expR ler_wnM2r// ln_le0. +Qed. + +Lemma ler_powR a : 1 <= a -> {homo powR a : x y / x <= y}. +Proof. +move=> a1 x y xy. +by rewrite /powR gt_eqF ?(lt_le_trans _ a1)// ler_expR ler_wpM2r ?ln_ge0. +Qed. + +Lemma powR_injective r : 0 < r -> {in Num.nneg &, injective (powR ^~ r)}. +Proof. +move=> r0 x y x0 y0; rewrite /powR; case: ifPn => [/eqP ->|xneq0]. + by case: ifPn => [/eqP ->//|_ /eqP]; rewrite (gt_eqF r0) eq_sym expR_eq0. +case: ifPn => [/eqP -> /eqP|yneq0]; first by rewrite (gt_eqF r0) expR_eq0. +by move/expR_inj/mulfI => /(_ (negbT (gt_eqF r0))); apply: ln_inj; + rewrite posrE lt_neqAle eq_sym (xneq0,yneq0). +Qed. + +Lemma ler1_powR a r : 1 <= a -> r <= 1 -> a >= a `^ r. +Proof. +by move=> a1 r1; rewrite (le_trans (ler_powR _ r1)) ?powRr1// (le_trans _ a1). +Qed. + +Lemma le1r_powR a r : 1 <= a -> 1 <= r -> a <= a `^ r. +Proof. +by move=> a1 r1; rewrite (le_trans _ (ler_powR _ r1)) ?powRr1// (le_trans _ a1). +Qed. + +Lemma ger1_powR a r : 0 < a <= 1 -> r <= 1 -> a <= a `^ r. +Proof. +move=> /andP[a0 _a1] r1. +by rewrite (le_trans _ (ger_powR _ r1)) ?powRr1 ?a0// ltW. +Qed. + +Lemma ge1r_powR a r : 0 < a <= 1 -> 1 <= r -> a >= a `^ r. +Proof. +move=> /andP[a0 a1] r1. +by rewrite (le_trans (ger_powR _ r1)) ?powRr1 ?a0// ltW. +Qed. + +Lemma ge0_ler_powR r : 0 <= r -> + {in Num.nneg &, {homo powR ^~ r : x y / x <= y >-> x <= y}}. +Proof. +rewrite le_eqVlt => /predU1P[<- x y _ _ _|]; first by rewrite !powRr0. +move=> a0 x y; rewrite 2!nnegrE !le_eqVlt => /predU1P[<-|x0]. + move=> /predU1P[<- _|y0 _]; first by rewrite eqxx. + by rewrite !powR0 ?(gt_eqF a0)// powR_gt0 ?orbT. +move=> /predU1P[<-|y0]; first by rewrite gt_eqF//= ltNge (ltW x0). +move=> /predU1P[->//|xy]; first by rewrite eqxx. +by apply/orP; right; rewrite /powR !gt_eqF// ltr_expR ltr_pM2l// ltr_ln. +Qed. + +Lemma gt0_ltr_powR r : 0 < r -> + {in Num.nneg &, {homo powR ^~ r : x y / x < y >-> x < y}}. +Proof. +move=> r0 x y x0 y0 xy; have := ge0_ler_powR (ltW r0) x0 y0 (ltW xy). +rewrite le_eqVlt => /orP[/eqP/(powR_injective r0 x0 y0)/eqP|//]. +by rewrite lt_eqF. +Qed. + +Lemma powRM x y r : 0 <= x -> 0 <= y -> (x * y) `^ r = x `^ r * y `^ r. +Proof. +rewrite /powR mulf_eq0. +case: (ltgtP x 0) => // x0 _; case: (ltgtP y 0) => //= y0 _; do ? + by case: eqVneq => [r0|]; rewrite ?r0 ?mul0r ?expR0 ?mulr0 ?mul1r. +by rewrite lnM// mulrDr expRD. +Qed. + +Lemma ge1r_powRZ x y r : 0 < x <= 1 -> 0 <= y -> 1 <= r -> + (x * y) `^ r <= x * (y `^ r). +Proof. +move=> /andP[x0 x1] y0 r1. +by rewrite (powRM _ (ltW _))// ler_wpM2r ?powR_ge0// ge1r_powR// x0. +Qed. -Definition exp_fun a x := expR (x * ln a). +Lemma le1r_powRZ x y r : x >= 1 -> 0 <= y -> 1 <= r -> + (x * y) `^ r >= x * (y `^ r). +Proof. +move=> x1 y0 r1. +by rewrite (powRM _ (le_trans _ x1))// ler_wpM2r ?powR_ge0// le1r_powR// x0. +Qed. + +Lemma powRrM x y z : x `^ (y * z) = (x `^ y) `^ z. +Proof. +rewrite /powR mulf_eq0; have [_|xN0] := eqVneq x 0. + by case: (y == 0); rewrite ?eqxx//= oner_eq0 ln1 mulr0 expR0. +by rewrite expR_eq0 expRK mulrCA mulrA. +Qed. + +Lemma powRAC x y z : (x `^ y) `^ z = (x `^ z) `^ y. +Proof. by rewrite -!powRrM mulrC. Qed. + +Lemma powRD x r s : (r + s == 0) ==> (x != 0) -> x `^ (r + s) = x `^ r * x `^ s. +Proof. +rewrite /powR; case: (eqVneq x 0) => //= [_|x_neq0 _]; + last by rewrite mulrDl expRD. +have [->|] := eqVneq r 0; first by rewrite mul1r add0r. +by rewrite implybF mul0r => _ /negPf ->. +Qed. + +Lemma mulr_powRB1 x p : 0 <= x -> 0 < p -> x * x `^ (p - 1) = x `^ p. +Proof. +rewrite le_eqVlt => /predU1P[<- p0|x0 p0]; first by rewrite mul0r powR0 ?gt_eqF. +by rewrite -{1}(powRr1 (ltW x0))// -powRD addrCA subrr addr0// gt_eqF. +Qed. + +Lemma powRN x r : x `^ (- r) = (x `^ r)^-1. +Proof. +have [r0|r0] := eqVneq r 0%R; first by rewrite r0 oppr0 powRr0 invr1. +have [->|xN0] := eqVneq x 0; first by rewrite !powR0 ?oppr_eq0// invr0. +rewrite -div1r; apply: (canRL (mulfK _)); first by rewrite powR_eq0 (negPf xN0). +by rewrite -powRD ?addNr ?powRr0// xN0 eqxx. +Qed. + +Lemma powRB x r s : (r == s) ==> (x != 0) -> x `^ (r - s) = x `^ r / x `^ s. +Proof. by move=> ?; rewrite powRD ?subr_eq0// powRN. Qed. + +Lemma powR_mulrn a n : 0 <= a -> a `^ n%:R = a ^+ n. +Proof. +move=> a_ge0; elim: n => [|n IHn]; first by rewrite powRr0 expr0. +by rewrite -natr1 powRD ?natr1 ?pnatr_eq0// powRr1// IHn exprSr. +Qed. + +Lemma powR_inv1 a : 0 <= a -> a `^ (-1) = a ^-1. +Proof. by move=> a_ge0; rewrite powRN powRr1. Qed. + +Lemma powR_invn a n : 0 <= a -> a `^ (- n%:R) = a ^- n. +Proof. by move=> a_ge0; rewrite powRN powR_mulrn. Qed. + +Lemma powR_intmul a (z : int) : 0 <= a -> a `^ z%:~R = a ^ z. +Proof. by move=> a0; case: z => n; [exact: powR_mulrn | exact: powR_invn]. Qed. + +Lemma ln_powR a x : ln (a `^ x) = x * ln a. +Proof. +have [->|x0] := eqVneq x 0; first by rewrite powRr0 ln1// mul0r. +have [->|a0] := eqVneq a 0; first by rewrite powR0// ln0// mulr0. +by rewrite /powR (negbTE a0) expRK. +Qed. + +Lemma powR12_sqrt a : 0 <= a -> a `^ (2^-1) = Num.sqrt a. +Proof. +rewrite le_eqVlt => /predU1P[<-|a0]. + by rewrite powR0 ?invr_eq0 ?pnatr_eq0// sqrtr0. +have /eqP : (a `^ (2^-1)) ^+ 2 = (Num.sqrt a) ^+ 2. + rewrite sqr_sqrtr; last exact: ltW. + by rewrite /powR gt_eqF// -expRMm mulrA divrr ?mul1r ?unitfE// lnK. +rewrite eqf_sqr => /predU1P[//|/eqP h]. +have : 0 < a `^ 2^-1 by exact: powR_gt0. +by rewrite h oppr_gt0 ltNge sqrtr_ge0. +Qed. + +Lemma norm_powR a x : 0 <= a -> `|a `^ x| = `|a| `^ x. +Proof. +move=> a0; rewrite /powR; case: ifPn => [/eqP ->|]. + by rewrite normr0 eqxx normr_nat. +rewrite neq_lt ltNge a0/= => {}a0. +by rewrite gtr0_norm ?expR_gt0// gtr0_norm// gt_eqF. +Qed. -Local Notation "a `^ x" := (exp_fun a x). +Lemma lt0_norm_powR a x : a < 0 -> `|a `^ x| = 1. +Proof. +move=> a0; rewrite /powR lt_eqF// gtr0_norm ?expR_gt0//. +by rewrite ln0 ?mulr0 ?expR0// ltW. +Qed. -Lemma exp_fun_gt0 a x : 0 < a `^ x. Proof. by rewrite expR_gt0. Qed. +Lemma conjugate_powR a b p q : 0 <= a -> 0 <= b -> + 0 < p -> 0 < q -> p^-1 + q^-1 = 1 -> + a * b <= a `^ p / p + b `^ q / q. +Proof. +rewrite le_eqVlt => /predU1P[<- b0 p0 q0 _|a0]. + by rewrite mul0r powR0 ?gt_eqF// mul0r add0r divr_ge0 ?powR_ge0 ?ltW. +rewrite le_eqVlt => /predU1P[<-|b0] p0 q0 pq. + by rewrite mulr0 powR0 ?gt_eqF// mul0r addr0 divr_ge0 ?powR_ge0 ?ltW. +have q01 : (q^-1 \in `[0, 1])%R. + by rewrite in_itv/= invr_ge0 (ltW q0)/= -pq ler_wpDl// invr_ge0 ltW. +have ap0 : (0 < a `^ p)%R by rewrite powR_gt0. +have bq0 : (0 < b `^ q)%R by rewrite powR_gt0. +have := @concave_ln _ (@Itv.mk _ `[0, 1] _ q01)%R _ _ ap0 bq0. +have pq' : (p^-1 = 1 - q^-1)%R by rewrite -pq addrK. +rewrite !convRE/= /onem -pq' -ler_expR expRD (mulrC p^-1). +rewrite ln_powR mulrAC divff ?mul1r ?gt_eqF// (mulrC q^-1). +rewrite ln_powR mulrAC divff ?mul1r ?gt_eqF//. +rewrite lnK ?posrE// lnK ?posrE// => /le_trans; apply. +rewrite lnK//; last by rewrite posrE addr_gt0// mulr_gt0// ?invr_gt0. +by rewrite (mulrC _ p^-1) (mulrC _ q^-1). +Qed. -Lemma exp_funr1 a : 0 < a -> a `^ 1 = a. -Proof. by move=> a0; rewrite /exp_fun mul1r lnK. Qed. +End PowR. +Notation "a `^ x" := (powR a x) : ring_scope. -Lemma exp_funr0 a : 0 < a -> a `^ 0 = 1. -Proof. by move=> a0; rewrite /exp_fun mul0r expR0. Qed. +#[deprecated(since="mathcomp-analysis 0.6.5", note="renamed `ge0_ler_powR`")] +Notation gt0_ler_powR := ge0_ler_powR. -Lemma exp_fun1 : exp_fun 1 = fun=> 1. -Proof. by rewrite funeqE => x; rewrite /exp_fun ln1 mulr0 expR0. Qed. +Section poweR. +Local Open Scope ereal_scope. +Context {R : realType}. +Implicit Types (s r : R) (x y : \bar R). -Lemma ler_exp_fun a : 1 < a -> {homo exp_fun a : x y / x <= y}. -Proof. by move=> a1 x y xy; rewrite /exp_fun ler_expR ler_pmul2r // ln_gt0. Qed. +Definition poweR x r := + match x with + | x'%:E => (x' `^ r)%:E + | +oo => if r == 0%R then 1%E else +oo + | -oo => if r == 0%R then 1%E else 0%E + end. -Lemma exp_funD a : 0 < a -> {morph exp_fun a : x y / x + y >-> x * y}. -Proof. by move=> a0 x y; rewrite [in LHS]/exp_fun mulrDl expRD. Qed. +Local Notation "x `^ r" := (poweR x r). -Lemma exp_fun_inv a : 0 < a -> a `^ (-1) = a ^-1. +Lemma poweR_EFin s r : s%:E `^ r = (s `^ r)%:E. +Proof. by []. Qed. + +Lemma poweRyr r : r != 0%R -> +oo `^ r = +oo. +Proof. by move/negbTE => /= ->. Qed. + +Lemma poweRe0 x : x `^ 0 = 1. +Proof. by move: x => [x'| |]/=; rewrite ?powRr0// eqxx. Qed. + +Lemma poweRe1 x : 0 <= x -> x `^ 1 = x. Proof. -move=> a0. -apply/(@mulrI _ a); first by rewrite unitfE gt_eqF. -rewrite -[X in X * _ = _](exp_funr1 a0) -exp_funD // subrr exp_funr0 //. -by rewrite divrr // unitfE gt_eqF. +by move: x => [x'| |]//= x0; rewrite ?powRr1// (negbTE (oner_neq0 _)). Qed. -Lemma exp_fun_mulrn a n : 0 < a -> exp_fun a n%:R = a ^+ n. +Lemma poweRN x r : x \is a fin_num -> x `^ (- r) = (fine x `^ r)^-1%:E. +Proof. by case: x => // x xf; rewrite poweR_EFin powRN. Qed. + +Lemma poweRNyr r : r != 0%R -> -oo `^ r = 0. +Proof. by move=> r0 /=; rewrite (negbTE r0). Qed. + +Lemma poweR_eqy x r : x `^ r = +oo -> x = +oo. +Proof. by case: x => [x| |] //=; case: ifP. Qed. + +Lemma eqy_poweR x r : (0 < r)%R -> x = +oo -> x `^ r = +oo. +Proof. by move: x => [| |]//= r0 _; rewrite gt_eqF. Qed. + +Lemma poweR_lty x r : x < +oo -> x `^ r < +oo. Proof. -move=> a0; elim: n => [|n ih]; first by rewrite mulr0n expr0 exp_funr0. -by rewrite -natr1 exprSr exp_funD// ih exp_funr1. +by move: x => [x| |]//=; rewrite ?ltry//; case: ifPn => // _; rewrite ltry. Qed. -End ExpFun. -Notation "a `^ x" := (exp_fun a x). +Lemma lty_poweRy x r : r != 0%R -> x `^ r < +oo -> x < +oo. +Proof. +by move=> r0; move: x => [x| | _]//=; rewrite ?ltry// (negbTE r0). +Qed. + +Lemma poweR0r r : r != 0%R -> 0 `^ r = 0. +Proof. by move=> r0; rewrite poweR_EFin powR0. Qed. + +Lemma poweR1r r : 1 `^ r = 1. Proof. by rewrite poweR_EFin powR1. Qed. + +Lemma fine_poweR x r : fine (x `^ r) = ((fine x) `^ r)%R. +Proof. +by move: x => [x| |]//=; case: ifPn => [/eqP ->|?]; rewrite ?powRr0 ?powR0. +Qed. + +Lemma poweR_ge0 x r : 0 <= x `^ r. +Proof. by move: x => [x| |]/=; rewrite ?lee_fin ?powR_ge0//; case: ifPn. Qed. + +Lemma poweR_gt0 x r : 0 < x -> 0 < x `^ r. +Proof. +by move: x => [x|_|]//=; [rewrite lte_fin; exact: powR_gt0|case: ifPn]. +Qed. + +Lemma gt0_poweR x r : (0 < r)%R -> 0 <= x -> 0 < x `^ r -> 0 < x. +Proof. +move=> r0; move: x => [x|//|]; rewrite ?leeNe_eq// lee_fin !lte_fin. +exact: gt0_powR. +Qed. + +Lemma poweR_eq0 x r : 0 <= x -> (x `^ r == 0) = ((x == 0) && (r != 0%R)). +Proof. +move: x => [x _|_/=|//]; first by rewrite poweR_EFin eqe powR_eq0. +by case: ifP => //; rewrite onee_eq0. +Qed. + +Lemma poweR_eq0_eq0 x r : 0 <= x -> x `^ r = 0 -> x = 0. +Proof. by move=> + /eqP => /poweR_eq0-> /andP[/eqP]. Qed. + +Lemma gt0_ler_poweR r : (0 <= r)%R -> + {in `[0, +oo] &, {homo poweR ^~ r : x y / x <= y >-> x <= y}}. +Proof. +move=> r0 + y; case=> //= [x /[1!in_itv]/= /andP[xint _]| _ _]. +- case: y => //= [y /[1!in_itv]/= /andP[yint _] xy| _ _]. + + by rewrite !lee_fin ge0_ler_powR. + + by case: eqP => [->|]; rewrite ?powRr0 ?leey. +- by rewrite leye_eq => /eqP ->. +Qed. + +Lemma fin_num_poweR x r : x \is a fin_num -> x `^ r \is a fin_num. +Proof. +by move=> xfin; rewrite ge0_fin_numE ?poweR_lty ?ltey_eq ?xfin// poweR_ge0. +Qed. + +Lemma poweRM x y r : 0 <= x -> 0 <= y -> (x * y) `^ r = x `^ r * y `^ r. +Proof. +have [->|rN0] := eqVneq r 0%R; first by rewrite !poweRe0 mule1. +have powyrM s : (0 <= s)%R -> (+oo * s%:E) `^ r = +oo `^ r * s%:E `^ r. + case: ltgtP => // [s_gt0 _|<- _]; last first. + by rewrite mule0 poweRyr// !poweR0r// mule0. + by rewrite gt0_mulye// poweRyr// gt0_mulye// poweR_gt0. +case: x y => [x| |] [y| |]// x0 y0; first by rewrite /= -EFinM powRM. +- by rewrite muleC powyrM// muleC. +- by rewrite powyrM. +- by rewrite mulyy !poweRyr// mulyy. +Qed. + +Lemma poweRrM x r s : x `^ (r * s) = (x `^ r) `^ s. +Proof. +have [->|s0] := eqVneq s 0%R; first by rewrite mulr0 !poweRe0. +have [->|r0] := eqVneq r 0%R; first by rewrite mul0r poweRe0 poweR1r. +case: x => [x| |]//; first by rewrite /= powRrM. + by rewrite !poweRyr// mulf_neq0. +by rewrite !poweRNyr ?poweR0r ?(negPf s0)// mulf_neq0. +Qed. + +Lemma poweRAC x r s : (x `^ r) `^ s = (x `^ s) `^ r. +Proof. by rewrite -!poweRrM mulrC. Qed. + +Definition poweRD_def x r s := ((r + s == 0)%R ==> + ((x != 0) && ((x \isn't a fin_num) ==> (r == 0%R) && (s == 0%R)))). +Notation "x '`^?' ( r +? s )" := (poweRD_def x r s) : ereal_scope. + +Lemma poweRD_defE x r s : + x `^?(r +? s) = ((r + s == 0)%R ==> + ((x != 0) && ((x \isn't a fin_num) ==> (r == 0%R) && (s == 0%R)))). +Proof. by []. Qed. + +Lemma poweRB_defE x r s : + x `^?(r +? - s) = ((r == s)%R ==> + ((x != 0) && ((x \isn't a fin_num) ==> (r == 0%R) && (s == 0%R)))). +Proof. by rewrite poweRD_defE subr_eq0 oppr_eq0. Qed. + +Lemma add_neq0_poweRD_def x r s : (r + s != 0)%R -> x `^?(r +? s). +Proof. by rewrite poweRD_defE => /negPf->. Qed. + +Lemma add_neq0_poweRB_def x r s : (r != s)%R -> x `^?(r +? - s). +Proof. by rewrite poweRB_defE => /negPf->. Qed. + +Lemma nneg_neq0_poweRD_def x r s : x != 0 -> (r >= 0)%R -> (s >= 0)%R -> + x `^?(r +? s). +Proof. +move=> xN0 rge0 sge0; rewrite /poweRD_def xN0/=. +by case: ltgtP rge0 => // [r_gt0|<-]; case: ltgtP sge0 => // [s_gt0|<-]//=; + rewrite ?addr0 ?add0r ?implybT// gt_eqF//= ?addr_gt0. +Qed. + +Lemma nneg_neq0_poweRB_def x r s : x != 0 -> (r >= 0)%R -> (s <= 0)%R -> + x `^?(r +? - s). +Proof. by move=> *; rewrite nneg_neq0_poweRD_def// oppr_ge0. Qed. + +Lemma poweRD x r s : x `^?(r +? s) -> x `^ (r + s) = x `^ r * x `^ s. +Proof. +rewrite /poweRD_def. +have [->|r0]/= := eqVneq r 0%R; first by rewrite add0r poweRe0 mul1e. +have [->|s0]/= := eqVneq s 0%R; first by rewrite addr0 poweRe0 mule1. +case: x => // [t|/=|/=]; rewrite ?(negPf r0, negPf s0, implybF); last 2 first. +- by move=> /negPf->; rewrite mulyy. +- by move=> /negPf->; rewrite mule0. +rewrite !poweR_EFin eqe => /implyP/(_ _)/andP cnd. +by rewrite powRD//; apply/implyP => /cnd[]. +Qed. + +Lemma poweRB x r s : x `^?(r +? - s) -> x `^ (r - s) = x `^ r * x `^ (- s). +Proof. by move=> rs; rewrite poweRD. Qed. + +Lemma poweR12_sqrt x : 0 <= x -> x `^ 2^-1 = sqrte x. +Proof. +move: x => [x|_|//]; last by rewrite poweRyr. +by rewrite lee_fin => x0 /=; rewrite powR12_sqrt. +Qed. + +End poweR. +Notation "a `^ x" := (poweR a x) : ereal_scope. Section riemannR_series. Variable R : realType. Implicit Types a : R. -Local Open Scope ring_scope. +Local Open Scope real_scope. Definition riemannR a : R ^nat := fun n => (n.+1%:R `^ a)^-1. Arguments riemannR a n /. -Lemma riemannR_gt0 a i : 0 < a -> 0 < riemannR a i. -Proof. move=> ?; by rewrite /riemannR invr_gt0 exp_fun_gt0. Qed. +Lemma riemannR_gt0 a i : 0 <= a -> 0 < riemannR a i. +Proof. by move=> ?; rewrite /riemannR invr_gt0 powR_gt0. Qed. -Lemma dvg_riemannR a : 0 < a <= 1 -> ~ cvg (series (riemannR a)). +Lemma dvg_riemannR a : 0 <= a <= 1 -> ~ cvgn (series (riemannR a)). Proof. -case/andP => a0; rewrite le_eqVlt => /orP[/eqP ->|a1]. - rewrite (_ : riemannR 1 = harmonic); first exact: dvg_harmonic. - by rewrite funeqE => i /=; rewrite exp_funr1. +move=> /andP[a0 a1]. have : forall n, harmonic n <= riemannR a n. - case=> /= [|n]; first by rewrite exp_fun1 invr1. - rewrite -[leRHS]div1r ler_pdivl_mulr ?exp_fun_gt0 // mulrC ler_pdivr_mulr //. - by rewrite mul1r -[leRHS]exp_funr1 // (ler_exp_fun) // ?ltr1n // ltW. + move=> [/=|n]; first by rewrite powR1 invr1. + rewrite -[leRHS]div1r ler_pdivlMr ?powR_gt0// mulrC ler_pdivrMr//. + by rewrite mul1r -[leRHS]powRr1// (ler_powR)// ler1n. move/(series_le_cvg harmonic_ge0 (fun i => ltW (riemannR_gt0 i a0))). by move/contra_not; apply; exact: dvg_harmonic. Qed. diff --git a/theories/forms.v b/theories/forms.v index 881a498b6..fb8f7956f 100644 --- a/theories/forms.v +++ b/theories/forms.v @@ -1,3 +1,4 @@ +From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg fingroup zmodp poly ssrnum. From mathcomp @@ -6,7 +7,10 @@ From mathcomp Require Import fieldext. From mathcomp Require Import vector. -(* From mathcomp Require classfun. *) +(**md**************************************************************************) +(* # Bilinear forms *) +(* (undocumented) *) +(******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. @@ -27,7 +31,7 @@ Reserved Notation "A ^_|_" (at level 8, format "A ^_|_"). Reserved Notation "A _|_ B" (at level 69, format "A _|_ B"). Reserved Notation "eps_theta .-sesqui" (at level 2, format "eps_theta .-sesqui"). -Notation "u '``_' i" := (u (GRing.zero (Zp_zmodType O)) i) : ring_scope. +Notation "u '``_' i" := (u (GRing.zero [the zmodType of 'I_1]) i) : ring_scope. Notation "''e_' i" := (delta_mx 0 i) (format "''e_' i", at level 3) : ring_scope. @@ -39,123 +43,73 @@ Structure revop X Y Z (f : Y -> X -> Z) := RevOp { _ : forall x, f x =1 fun_of_revop^~ x }. -Lemma eq_map_mx (R S : ringType) m n (M : 'M[R]_(m,n)) - (g f : R -> S) : f =1 g -> M ^ f = M ^ g. -Proof. by move=> eq_fg; apply/matrixP=> i j; rewrite !mxE. Qed. - -Lemma map_mx_id (R : ringType) m n (M : 'M[R]_(m,n)) : M ^ id = M. -Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. - Lemma eq_map_mx_id (R : ringType) m n (M : 'M[R]_(m,n)) (f : R -> R) : f =1 id -> M ^ f = M. Proof. by move=> /eq_map_mx->; rewrite map_mx_id. Qed. -Module Bilinear. - -Section ClassDef. - -Variables (R : ringType) (U U' : lmodType R) (V : zmodType) (s s' : R -> V -> V). -Implicit Type phUU'V : phant (U -> U' -> V). - -Local Coercion GRing.Scale.op : GRing.Scale.law >-> Funclass. -Definition axiom (f : U -> U' -> V) (s_law : GRing.Scale.law s) (eqs : s = s_law) - (s'_law : GRing.Scale.law s') (eqs' : s' = s'_law) := - ((forall u', GRing.Linear.axiom (f^~ u') eqs) - * (forall u, GRing.Linear.axiom (f u) eqs'))%type. - -Record class_of (f : U -> U' -> V) : Prop := Class { - basel : forall u', GRing.Linear.class_of s (f^~ u'); - baser : forall u, GRing.Linear.class_of s' (f u) +HB.mixin Record isBilinear (R : ringType) (U U' : lmodType R) (V : zmodType) + (s : R -> V -> V) (s' : R -> V -> V) (f : U -> U' -> V) := { + additivel_subproof : forall u', additive (f^~ u'); + additiver_subproof : forall u, additive (f u); + linearl_subproof : forall u', scalable_for s (f^~ u'); + linearr_subproof : forall u, scalable_for s' (f u); }. -Lemma class_of_axiom f s_law s'_law Ds Ds' : - @axiom f s_law Ds s'_law Ds' -> class_of f. -Proof. -by pose coa := GRing.Linear.class_of_axiom; move=> [/(_ _) /coa ? /(_ _) /coa]. -Qed. +HB.structure Definition Bilinear (R : ringType) (U U' : lmodType R) (V : zmodType) + (s : R -> V -> V) (s' : R -> V -> V) := + {f of isBilinear R U U' V s s' f}. -Structure map phUU'V := Pack {apply; _ : class_of apply}. -Local Coercion apply : map >-> Funclass. +Definition bilinear_for (R : ringType) (U U' : lmodType R) (V : zmodType) + (s : GRing.Scale.law R V) (s' : GRing.Scale.law R V) (f : U -> U' -> V) := + ((forall u', GRing.linear_for (s : R -> V -> V) (f^~ u')) + * (forall u, GRing.linear_for s' (f u)))%type. -Definition class (phUU'V : _) (cF : map phUU'V) := - let: Pack _ c as cF' := cF return class_of cF' in c. +HB.factory Record bilinear_isBilinear (R : ringType) (U U' : lmodType R) (V : zmodType) + (s : GRing.Scale.law R V) (s' : GRing.Scale.law R V) (f : U -> U' -> V) := { + bilinear_subproof : bilinear_for s s' f; +}. -Canonical additiver phU'V phUU'V (u : U) cF := GRing.Additive.Pack phU'V - (baser (@class phUU'V cF) u). -Canonical linearr phU'V phUU'V (u : U) cF := GRing.Linear.Pack phU'V - (baser (@class phUU'V cF) u). +HB.builders Context R U U' V s s' f of bilinear_isBilinear R U U' V s s' f. +HB.instance Definition _ := isBilinear.Build R U U' V s s' f + (fun u' => additive_linear (bilinear_subproof.1 u')) + (fun u => additive_linear (bilinear_subproof.2 u)) + (fun u' => scalable_linear (bilinear_subproof.1 u')) + (fun u => scalable_linear (bilinear_subproof.2 u)). +HB.end. -(* Fact applyr_key : unit. Proof. exact. Qed. *) -Definition applyr_head t (f : U -> U' -> V) u v := let: tt := t in f v u. -Notation applyr := (@applyr_head tt). - -Canonical additivel phUV phUU'V (u' : U') (cF : map _) := - @GRing.Additive.Pack _ _ phUV (applyr cF u') (basel (@class phUU'V cF) u'). -Canonical linearl phUV phUU'V (u' : U') (cF : map _) := - @GRing.Linear.Pack _ _ _ _ phUV (applyr cF u') (basel (@class phUU'V cF) u'). - -Definition pack (phUV : phant (U -> V)) (phU'V : phant (U' -> V)) - (revf : U' -> U -> V) (rf : revop revf) f (g : U -> U' -> V) of (g = fun_of_revop rf) := - fun (bFl : U' -> GRing.Linear.map s phUV) flc of (forall u', revf u' = bFl u') & - (forall u', phant_id (GRing.Linear.class (bFl u')) (flc u')) => - fun (bFr : U -> GRing.Linear.map s' phU'V) frc of (forall u, g u = bFr u) & - (forall u, phant_id (GRing.Linear.class (bFr u)) (frc u)) => - @Pack (Phant _) f (Class flc frc). - - -(* (* Support for right-to-left rewriting with the generic linearZ rule. *) *) -(* Notation mapUV := (map (Phant (U -> U' -> V))). *) -(* Definition map_class := mapUV. *) -(* Definition map_at (a : R) := mapUV. *) -(* Structure map_for a s_a := MapFor {map_for_map : mapUV; _ : s a = s_a}. *) -(* Definition unify_map_at a (f : map_at a) := MapFor f (erefl (s a)). *) -(* Structure wrapped := Wrap {unwrap : mapUV}. *) -(* Definition wrap (f : map_class) := Wrap f. *) - -End ClassDef. - -Module Exports. -Delimit Scope linear_ring_scope with linR. -Notation bilinear_for s s' f := (axiom f (erefl s) (erefl s')). +Module BilinearExports. Notation bilinear f := (bilinear_for *:%R *:%R f). Notation biscalar f := (bilinear_for *%R *%R f). -Notation bilmorphism_for s s' f := (class_of s s' f). -Notation bilmorphism f := (bilmorphism_for *:%R *:%R f). -Coercion class_of_axiom : axiom >-> bilmorphism_for. -Coercion baser : bilmorphism_for >-> Funclass. -Coercion apply : map >-> Funclass. -Notation "{ 'bilinear' fUV | s & s' }" := (map s s' (Phant fUV)) +Module Bilinear. +Definition map (R : ringType) (U U' : lmodType R) (V : zmodType) + (s : R -> V -> V) (s' : R -> V -> V) + (phUU'V : phant (U -> U' -> V)) := Bilinear.type U U' s s'. +End Bilinear. +Notation "{ 'bilinear' fUV | s & s' }" := (Bilinear.map s s' (Phant fUV)) (at level 0, format "{ 'bilinear' fUV | s & s' }") : ring_scope. -Notation "{ 'bilinear' fUV | s }" := (map s.1 s.2 (Phant fUV)) +Notation "{ 'bilinear' fUV | s }" := (Bilinear.map s.1 s.2 (Phant fUV)) (at level 0, format "{ 'bilinear' fUV | s }") : ring_scope. Notation "{ 'bilinear' fUV }" := {bilinear fUV | *:%R & *:%R} (at level 0, format "{ 'bilinear' fUV }") : ring_scope. Notation "{ 'biscalar' U }" := {bilinear U -> U -> _ | *%R & *%R} (at level 0, format "{ 'biscalar' U }") : ring_scope. -Notation "[ 'bilinear' 'of' f 'as' g ]" := - (@pack _ _ _ _ _ _ _ _ _ _ f g erefl _ _ - (fun=> erefl) (fun=> idfun) _ _ (fun=> erefl) (fun=> idfun)). -Notation "[ 'bilinear' 'of' f ]" := [bilinear of f as f] +Notation "[ 'bilinear' 'of' f 'as' g ]" := (Bilinear.clone _ _ _ _ _ _ f g) + (at level 0, format "[ 'bilinear' 'of' f 'as' g ]") : form_scope. +Notation "[ 'bilinear' 'of' f ]" := (Bilinear.clone _ _ _ _ _ _ f _) (at level 0, format "[ 'bilinear' 'of' f ]") : form_scope. -Coercion additiver : map >-> GRing.Additive.map. -Coercion linearr : map >-> GRing.Linear.map. -Canonical additiver. -Canonical linearr. -Canonical additivel. -Canonical linearl. -Notation applyr := (@applyr_head _ _ _ _ tt). -(* Canonical additive. *) -(* (* Support for right-to-left rewriting with the generic linearZ rule. *) *) -(* Coercion map_for_map : map_for >-> map. *) -(* Coercion unify_map_at : map_at >-> map_for. *) -(* Canonical unify_map_at. *) -(* Coercion unwrap : wrapped >-> map. *) -(* Coercion wrap : map_class >-> wrapped. *) -(* Canonical wrap. *) -End Exports. +End BilinearExports. +Export BilinearExports. -End Bilinear. -Include Bilinear.Exports. +Section applyr. + +Variables (R : ringType) (U U' : lmodType R) (V : zmodType) (s s' : R -> V -> V). + +(* Fact applyr_key : unit. Proof. exact. Qed. *) +Definition applyr_head t (f : U -> U' -> V) u v := let: tt := t in f v u. + +End applyr. + +Notation applyr := (applyr_head tt). Section BilinearTheory. @@ -166,48 +120,74 @@ Section GenericProperties. Variables (U U' : lmodType R) (V : zmodType) (s : R -> V -> V) (s' : R -> V -> V). Variable f : {bilinear U -> U' -> V | s & s'}. -Lemma linear0r z : f z 0 = 0. Proof. by rewrite raddf0. Qed. -Lemma linearNr z : {morph f z : x / - x}. Proof. exact: raddfN. Qed. -Lemma linearDr z : {morph f z : x y / x + y}. Proof. exact: raddfD. Qed. -Lemma linearBr z : {morph f z : x y / x - y}. Proof. exact: raddfB. Qed. -Lemma linearMnr z n : {morph f z : x / x *+ n}. Proof. exact: raddfMn. Qed. -Lemma linearMNnr z n : {morph f z : x / x *- n}. Proof. exact: raddfMNn. Qed. -Lemma linear_sumr z I r (P : pred I) E : +Section GenericPropertiesr. + +Variable z : U. + +#[local, non_forgetful_inheritance] +HB.instance Definition _ := + GRing.isAdditive.Build _ _ (f z) (@additiver_subproof _ _ _ _ _ _ f z). +#[local, non_forgetful_inheritance] +HB.instance Definition _ := + GRing.isScalable.Build _ _ _ _ (f z) (@linearr_subproof _ _ _ _ _ _ f z). + +Lemma linear0r : f z 0 = 0. Proof. by rewrite raddf0. Qed. +Lemma linearNr : {morph f z : x / - x}. Proof. exact: raddfN. Qed. +Lemma linearDr : {morph f z : x y / x + y}. Proof. exact: raddfD. Qed. +Lemma linearBr : {morph f z : x y / x - y}. Proof. exact: raddfB. Qed. +Lemma linearMnr n : {morph f z : x / x *+ n}. Proof. exact: raddfMn. Qed. +Lemma linearMNnr n : {morph f z : x / x *- n}. Proof. exact: raddfMNn. Qed. +Lemma linear_sumr I r (P : pred I) E : f z (\sum_(i <- r | P i) E i) = \sum_(i <- r | P i) f z (E i). Proof. exact: raddf_sum. Qed. -Lemma linearZr_LR z : scalable_for s' (f z). Proof. exact: linearZ_LR. Qed. -Lemma linearPr z a : {morph f z : u v / a *: u + v >-> s' a u + v}. +Lemma linearZr_LR : scalable_for s' (f z). Proof. exact: linearZ_LR. Qed. +Lemma linearPr a : {morph f z : u v / a *: u + v >-> s' a u + v}. Proof. exact: linearP. Qed. +End GenericPropertiesr. + Lemma applyrE x : applyr f x =1 f^~ x. Proof. by []. Qed. -Lemma linear0l z : f 0 z = 0. Proof. by rewrite -applyrE raddf0. Qed. -Lemma linearNl z : {morph f^~ z : x / - x}. +Section GenericPropertiesl. + +Variable z : U'. + +#[local, non_forgetful_inheritance] +HB.instance Definition _ := + GRing.isAdditive.Build _ _ (applyr f z) (@additivel_subproof _ _ _ _ _ _ f z). +#[local, non_forgetful_inheritance] +HB.instance Definition _ := + GRing.isScalable.Build _ _ _ _ (applyr f z) (@linearl_subproof _ _ _ _ _ _ f z). + +Lemma linear0l : f 0 z = 0. Proof. by rewrite -applyrE raddf0. Qed. +Lemma linearNl : {morph f^~ z : x / - x}. Proof. by move=> ?; rewrite -applyrE raddfN. Qed. -Lemma linearDl z : {morph f^~ z : x y / x + y}. +Lemma linearDl : {morph f^~ z : x y / x + y}. Proof. by move=> ??; rewrite -applyrE raddfD. Qed. -Lemma linearBl z : {morph f^~ z : x y / x - y}. +Lemma linearBl : {morph f^~ z : x y / x - y}. Proof. by move=> ??; rewrite -applyrE raddfB. Qed. -Lemma linearMnl z n : {morph f^~ z : x / x *+ n}. +Lemma linearMnl n : {morph f^~ z : x / x *+ n}. Proof. by move=> ?; rewrite -applyrE raddfMn. Qed. -Lemma linearMNnl z n : {morph f^~ z : x / x *- n}. +Lemma linearMNnl n : {morph f^~ z : x / x *- n}. Proof. by move=> ?; rewrite -applyrE raddfMNn. Qed. -Lemma linear_suml z I r (P : pred I) E : +Lemma linear_suml I r (P : pred I) E : f (\sum_(i <- r | P i) E i) z = \sum_(i <- r | P i) f (E i) z. Proof. by rewrite -applyrE raddf_sum. Qed. -Lemma linearZl_LR z : scalable_for s (f^~ z). +Lemma linearZl_LR : scalable_for s (f^~ z). Proof. by move=> ??; rewrite -applyrE linearZ_LR. Qed. -Lemma linearPl z a : {morph f^~ z : u v / a *: u + v >-> s a u + v}. +Lemma linearPl a : {morph f^~ z : u v / a *: u + v >-> s a u + v}. Proof. by move=> ??; rewrite -applyrE linearP. Qed. +End GenericPropertiesl. + End GenericProperties. Section BidirectionalLinearZ. Variables (U : lmodType R) (V : zmodType) (s : R -> V -> V). -Variables (S : ringType) (h : S -> V -> V) (h_law : GRing.Scale.law h). +Variables (S : ringType) (h : GRing.Scale.law S V). (* Lemma linearZr z c a (h_c := GRing.Scale.op h_law c) (f : GRing.Linear.map_for U s a h_c) u : *) (* f z (a *: u) = h_c (GRing.Linear.wrap (f z) u). *) @@ -220,7 +200,21 @@ End BilinearTheory. Canonical rev_mulmx (R : ringType) m n p := @RevOp _ _ _ (@mulmxr R m n p) (@mulmx R m n p) (fun _ _ => erefl). -Canonical mulmx_bilinear (R : comRingType) m n p := [bilinear of @mulmx R m n p]. +Lemma mulmx_is_bilinear (R : comRingType) m n p : + bilinear_for + (GRing.Scale.Law.clone _ _ *:%R _) (GRing.Scale.Law.clone _ _ *:%R _) + (@mulmx R m n p). +Proof. +split=> [u'|u] a x y /=. +- by rewrite mulmxDl scalemxAl. +- by rewrite mulmxDr scalemxAr. +Qed. + +HB.instance Definition _ (R : comRingType) m n p := + bilinear_isBilinear.Build R + [the lmodType R of 'M[R]_(m, n)] [the lmodType R of 'M[R]_(n, p)] + [the zmodType of 'M[R]_(m, p)] _ _ (@mulmx R m n p) + (mulmx_is_bilinear R m n p). (* Section classfun. *) (* Import mathcomp.character.classfun. *) @@ -340,7 +334,7 @@ Proof. rewrite /form [M in LHS](sesquiP _) // -mulmxA !mxE rmorph_sum mulr_sumr. apply: eq_bigr => /= i _; rewrite !(mxE, mulr_sumr, mulr_suml, rmorph_sum). apply: eq_bigr => /= j _; rewrite !mxE !rmorphM mulrCA -!mulrA. -by congr (_ * _); rewrite mulrA mulrC thetaK. +by congr (_ * _); rewrite mulrA mulrC /= thetaK. Qed. Lemma form_eq0C u v : ('[u, v] == 0) = ('[v, u] == 0). @@ -483,9 +477,9 @@ End Sesquilinear. Notation "eps_theta .-sesqui" := (sesqui _ eps_theta) : ring_scope. -Notation symmetric_form := (false, [rmorphism of idfun]).-sesqui. -Notation skew := (true, [rmorphism of idfun]).-sesqui. -Notation hermitian := (false, @conjC _).-sesqui. +Notation symmetric_form := (false, idfun).-sesqui. +Notation skew := (true, idfun).-sesqui. +Notation hermitian := (false, @Num.conj_op _).-sesqui. (* Section ClassificationForm. *) diff --git a/theories/hoelder.v b/theories/hoelder.v new file mode 100644 index 000000000..2385f9e1f --- /dev/null +++ b/theories/hoelder.v @@ -0,0 +1,508 @@ +(* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) +From HB Require Import structures. +From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval finmap. +From mathcomp Require Import mathcomp_extra boolp classical_sets functions. +From mathcomp Require Import cardinality fsbigop . +Require Import signed reals ereal topology normedtype sequences real_interval. +Require Import esum measure lebesgue_measure lebesgue_integral numfun exp. +Require Import convex itv. + +(**md**************************************************************************) +(* # Hoelder's Inequality *) +(* *) +(* This file provides Hoelder's inequality. *) +(* ``` *) +(* 'N[mu]_p[f] := (\int[mu]_x (`|f x| `^ p)%:E) `^ p^-1 *) +(* The corresponding definition is Lnorm. *) +(* ``` *) +(* *) +(******************************************************************************) + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Import numFieldTopology.Exports. + +Local Open Scope classical_set_scope. +Local Open Scope ring_scope. + +Reserved Notation "'N[ mu ]_ p [ F ]" + (at level 5, F at level 36, mu at level 10, + format "'[' ''N[' mu ]_ p '/ ' [ F ] ']'"). +(* for use as a local notation when the measure is in context: *) +Reserved Notation "'N_ p [ F ]" + (at level 5, F at level 36, format "'[' ''N_' p '/ ' [ F ] ']'"). + +Declare Scope Lnorm_scope. + +HB.lock Definition Lnorm {d} {T : measurableType d} {R : realType} + (mu : {measure set T -> \bar R}) (p : \bar R) (f : T -> R) := + match p with + | p%:E => (if p == 0%R then + mu (f @^-1` (setT `\ 0%R)) + else + (\int[mu]_x (`|f x| `^ p)%:E) `^ p^-1)%E + | +oo%E => (if mu [set: T] > 0 then ess_sup mu (normr \o f) else 0)%E + | -oo%E => 0%E + end. +Canonical locked_Lnorm := Unlockable Lnorm.unlock. +Arguments Lnorm {d T R} mu p f. + +Section Lnorm_properties. +Context d {T : measurableType d} {R : realType}. +Variable mu : {measure set T -> \bar R}. +Local Open Scope ereal_scope. +Implicit Types (p : \bar R) (f g : T -> R) (r : R). + +Local Notation "'N_ p [ f ]" := (Lnorm mu p f). + +Lemma Lnorm1 f : 'N_1[f] = \int[mu]_x `|f x|%:E. +Proof. +rewrite unlock oner_eq0 invr1// poweRe1//. + by apply: eq_integral => t _; rewrite powRr1. +by apply: integral_ge0 => t _; rewrite powRr1. +Qed. + +Lemma Lnorm_ge0 p f : 0 <= 'N_p[f]. +Proof. +rewrite unlock; move: p => [r/=|/=|//]. + by case: ifPn => // r0; exact: poweR_ge0. +by case: ifPn => // /ess_sup_ge0; apply => t/=. +Qed. + +Lemma eq_Lnorm p f g : f =1 g -> 'N_p[f] = 'N_p[g]. +Proof. by move=> fg; congr Lnorm; exact/funext. Qed. + +Lemma Lnorm_eq0_eq0 r f : (0 < r)%R -> measurable_fun setT f -> + 'N_r%:E[f] = 0 -> ae_eq mu [set: T] (fun t => (`|f t| `^ r)%:E) (cst 0). +Proof. +move=> r0 mf; rewrite unlock (gt_eqF r0) => /poweR_eq0_eq0 fp. +apply/ae_eq_integral_abs => //=. + apply: measurableT_comp => //. + apply: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ r)) => //. + exact: measurableT_comp. +under eq_integral => x _ do rewrite ger0_norm ?powR_ge0//. +by rewrite fp//; apply: integral_ge0 => t _; rewrite lee_fin powR_ge0. +Qed. + +Lemma powR_Lnorm f r : r != 0%R -> + 'N_r%:E[f] `^ r = \int[mu]_x (`| f x | `^ r)%:E. +Proof. +move=> r0; rewrite unlock (negbTE r0) -poweRrM mulVf// poweRe1//. +by apply: integral_ge0 => x _; rewrite lee_fin// powR_ge0. +Qed. + +End Lnorm_properties. + +#[global] +Hint Extern 0 (0 <= Lnorm _ _ _) => solve [apply: Lnorm_ge0] : core. + +Notation "'N[ mu ]_ p [ f ]" := (Lnorm mu p f). + +Section lnorm. +(* l-norm is just L-norm applied to counting *) +Context d {T : measurableType d} {R : realType}. +Local Open Scope ereal_scope. +Local Notation "'N_ p [ f ]" := (Lnorm [the measure _ _ of counting] p f). + +Lemma Lnorm_counting p (f : R^nat) : (0 < p)%R -> + 'N_p%:E [f] = (\sum_(k p0; rewrite unlock gt_eqF// ge0_integral_count// => k. +by rewrite lee_fin powR_ge0. +Qed. + +End lnorm. + +Section hoelder. +Context d {T : measurableType d} {R : realType}. +Variable mu : {measure set T -> \bar R}. +Local Open Scope ereal_scope. +Implicit Types (p q : R) (f g : T -> R). + +Let measurableT_comp_powR f p : + measurable_fun [set: T] f -> measurable_fun setT (fun x => f x `^ p)%R. +Proof. exact: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ p)). Qed. + +Local Notation "'N_ p [ f ]" := (Lnorm mu p f). + +Let integrable_powR f p : (0 < p)%R -> + measurable_fun [set: T] f -> 'N_p%:E[f] != +oo -> + mu.-integrable [set: T] (fun x => (`|f x| `^ p)%:E). +Proof. +move=> p0 mf foo; apply/integrableP; split. + apply: measurableT_comp => //; apply: measurableT_comp_powR. + exact: measurableT_comp. +rewrite ltey; apply: contra foo. +move=> /eqP/(@eqy_poweR _ _ p^-1); rewrite invr_gt0 => /(_ p0) <-. +rewrite unlock (gt_eqF p0); apply/eqP; congr (_ `^ _). +by apply/eq_integral => t _; rewrite [RHS]gee0_abs// lee_fin powR_ge0. +Qed. + +Let hoelder0 f g p q : measurable_fun setT f -> measurable_fun setT g -> + (0 < p)%R -> (0 < q)%R -> (p^-1 + q^-1 = 1)%R -> + 'N_p%:E[f] = 0 -> 'N_1[(f \* g)%R] <= 'N_p%:E[f] * 'N_q%:E[g]. +Proof. +move=> mf mg p0 q0 pq f0; rewrite f0 mul0e Lnorm1 [leLHS](_ : _ = 0)//. +rewrite (ae_eq_integral (cst 0)) => [|//||//|]; first by rewrite integral0. +- by do 2 apply: measurableT_comp => //; exact: measurable_funM. +- apply: filterS (Lnorm_eq0_eq0 p0 mf f0) => x /(_ I)[] /powR_eq0_eq0 + _. + by rewrite normrM => ->; rewrite mul0r. +Qed. + +Let normalized p f x := `|f x| / fine 'N_p%:E[f]. + +Let normalized_ge0 p f x : (0 <= normalized p f x)%R. +Proof. by rewrite /normalized divr_ge0// fine_ge0// Lnorm_ge0. Qed. + +Let measurable_normalized p f : measurable_fun [set: T] f -> + measurable_fun [set: T] (normalized p f). +Proof. by move=> mf; apply: measurable_funM => //; exact: measurableT_comp. Qed. + +Let integral_normalized f p : (0 < p)%R -> 0 < 'N_p%:E[f] -> + mu.-integrable [set: T] (fun x => (`|f x| `^ p)%:E) -> + \int[mu]_x (normalized p f x `^ p)%:E = 1. +Proof. +move=> p0 fpos ifp. +transitivity (\int[mu]_x (`|f x| `^ p / fine ('N_p%:E[f] `^ p))%:E). + apply: eq_integral => t _. + rewrite powRM//; last by rewrite invr_ge0 fine_ge0// Lnorm_ge0. + rewrite -[in LHS]powR_inv1; last by rewrite fine_ge0 // Lnorm_ge0. + by rewrite fine_poweR powRAC -powR_inv1 // powR_ge0. +have fp0 : 0 < \int[mu]_x (`|f x| `^ p)%:E. + rewrite unlock (gt_eqF p0) in fpos. + apply: gt0_poweR fpos; rewrite ?invr_gt0//. + by apply integral_ge0 => x _; rewrite lee_fin; exact: powR_ge0. +rewrite unlock (gt_eqF p0) -poweRrM mulVf ?(gt_eqF p0)// (poweRe1 (ltW fp0))//. +under eq_integral do rewrite EFinM muleC. +have foo : \int[mu]_x (`|f x| `^ p)%:E < +oo. + move/integrableP: ifp => -[_]. + by under eq_integral do rewrite gee0_abs// ?lee_fin ?powR_ge0//. +rewrite integralZl//; apply/eqP; rewrite eqe_pdivr_mull ?mule1. +- by rewrite fineK// gt0_fin_numE. +- by rewrite gt_eqF// fine_gt0// foo andbT. +Qed. + +Lemma hoelder f g p q : measurable_fun setT f -> measurable_fun setT g -> + (0 < p)%R -> (0 < q)%R -> (p^-1 + q^-1 = 1)%R -> + 'N_1[(f \* g)%R] <= 'N_p%:E[f] * 'N_q%:E[g]. +Proof. +move=> mf mg p0 q0 pq. +have [f0|f0] := eqVneq 'N_p%:E[f] 0%E; first exact: hoelder0. +have [g0|g0] := eqVneq 'N_q%:E[g] 0%E. + rewrite muleC; apply: le_trans; last by apply: hoelder0 => //; rewrite addrC. + by under eq_Lnorm do rewrite /= mulrC. +have {f0}fpos : 0 < 'N_p%:E[f] by rewrite lt0e f0 Lnorm_ge0. +have {g0}gpos : 0 < 'N_q%:E[g] by rewrite lt0e g0 Lnorm_ge0. +have [foo|foo] := eqVneq 'N_p%:E[f] +oo%E; first by rewrite foo gt0_mulye ?leey. +have [goo|goo] := eqVneq 'N_q%:E[g] +oo%E; first by rewrite goo gt0_muley ?leey. +pose F := normalized p f; pose G := normalized q g. +rewrite [leLHS](_ : _ = 'N_1[(F \* G)%R] * 'N_p%:E[f] * 'N_q%:E[g]); last first. + rewrite !Lnorm1. + under [in RHS]eq_integral. + move=> x _. + rewrite /F /G /= /normalized (mulrC `|f x|)%R mulrA -(mulrA (_^-1)). + rewrite (mulrC (_^-1)) -mulrA ger0_norm; last first. + by rewrite mulr_ge0// divr_ge0 ?(fine_ge0, Lnorm_ge0, invr_ge0). + by rewrite mulrC -normrM EFinM; over. + rewrite ge0_integralZl//; last 2 first. + - by do 2 apply: measurableT_comp => //; exact: measurable_funM. + - by rewrite lee_fin mulr_ge0// invr_ge0 fine_ge0// Lnorm_ge0. + rewrite -muleA muleC muleA EFinM muleCA 2!muleA. + rewrite (_ : _ * 'N_p%:E[f] = 1) ?mul1e; last first. + rewrite -[X in _ * X]fineK; last by rewrite ge0_fin_numE ?ltey// Lnorm_ge0. + by rewrite -EFinM mulVr ?unitfE ?gt_eqF// fine_gt0// fpos/= ltey. + rewrite (_ : 'N_q%:E[g] * _ = 1) ?mul1e// muleC. + rewrite -[X in _ * X]fineK; last by rewrite ge0_fin_numE ?ltey// Lnorm_ge0. + by rewrite -EFinM mulVr ?unitfE ?gt_eqF// fine_gt0// gpos/= ltey. +rewrite -(mul1e ('N_p%:E[f] * _)) -muleA lee_pmul ?mule_ge0 ?Lnorm_ge0//. +rewrite [leRHS](_ : _ = \int[mu]_x (F x `^ p / p + G x `^ q / q)%:E). + rewrite Lnorm1 ae_ge0_le_integral //. + - do 2 apply: measurableT_comp => //. + by apply: measurable_funM => //; exact: measurable_normalized. + - by move=> x _; rewrite lee_fin addr_ge0// divr_ge0// ?powR_ge0// ltW. + - by apply: measurableT_comp => //; apply: measurable_funD => //; + apply: measurable_funM => //; apply: measurableT_comp_powR => //; + exact: measurable_normalized. + apply/aeW => x _; rewrite lee_fin ger0_norm ?conjugate_powR ?normalized_ge0//. + by rewrite mulr_ge0// normalized_ge0. +under eq_integral do rewrite EFinD mulrC (mulrC _ (_^-1)). +rewrite ge0_integralD//; last 4 first. +- by move=> x _; rewrite lee_fin mulr_ge0// ?invr_ge0 ?powR_ge0// ltW. +- do 2 apply: measurableT_comp => //. + by apply: measurableT_comp_powR => //; exact: measurable_normalized. +- by move=> x _; rewrite lee_fin mulr_ge0// ?invr_ge0 ?powR_ge0// ltW. +- do 2 apply: measurableT_comp => //. + by apply: measurableT_comp_powR => //; exact: measurable_normalized. +under eq_integral do rewrite EFinM. +rewrite {1}ge0_integralZl//; last 3 first. +- apply: measurableT_comp => //. + by apply: measurableT_comp_powR => //; exact: measurable_normalized. +- by move=> x _; rewrite lee_fin powR_ge0. +- by rewrite lee_fin invr_ge0 ltW. +under [X in (_ + X)%E]eq_integral => x _ do rewrite EFinM. +rewrite ge0_integralZl//; last 3 first. +- apply: measurableT_comp => //. + by apply: measurableT_comp_powR => //; exact: measurable_normalized. +- by move=> x _; rewrite lee_fin powR_ge0. +- by rewrite lee_fin invr_ge0 ltW. +rewrite integral_normalized//; last exact: integrable_powR. +rewrite integral_normalized//; last exact: integrable_powR. +by rewrite 2!mule1 -EFinD pq. +Qed. + +End hoelder. + +Section hoelder2. +Context {R : realType}. +Local Open Scope ring_scope. + +Lemma hoelder2 (a1 a2 b1 b2 : R) (p q : R) : + 0 <= a1 -> 0 <= a2 -> 0 <= b1 -> 0 <= b2 -> + 0 < p -> 0 < q -> p^-1 + q^-1 = 1 -> + a1 * b1 + a2 * b2 <= (a1 `^ p + a2 `^ p) `^ p^-1 * + (b1 `^ q + b2 `^ q) `^ q^-1. +Proof. +move=> a10 a20 b10 b20 p0 q0 pq. +pose f a b n : R := match n with 0%nat => a | 1%nat => b | _ => 0 end. +have mf a b : measurable_fun setT (f a b) by []. +have := hoelder [the measure _ _ of counting] (mf a1 a2) (mf b1 b2) p0 q0 pq. +rewrite !Lnorm_counting//. +rewrite (nneseries_split 2); last by move=> k; rewrite lee_fin powR_ge0. +rewrite ereal_series_cond eseries0 ?adde0; last first. + by move=> [//|] [//|n _]; rewrite /f /= mulr0 normr0 powR0. +rewrite 2!big_ord_recr /= big_ord0 add0e powRr1 ?normr_ge0 ?powRr1 ?normr_ge0//. +rewrite (nneseries_split 2); last by move=> k; rewrite lee_fin powR_ge0. +rewrite ereal_series_cond eseries0 ?adde0; last first. + by move=> [//|] [//|n _]; rewrite /f /= normr0 powR0// gt_eqF. +rewrite 2!big_ord_recr /= big_ord0 add0e -EFinD poweR_EFin. +rewrite (nneseries_split 2); last by move=> k; rewrite lee_fin powR_ge0. +rewrite ereal_series_cond eseries0 ?adde0; last first. + by move=> [//|] [//|n _]; rewrite /f /= normr0 powR0// gt_eqF. +rewrite 2!big_ord_recr /= big_ord0 add0e -EFinD poweR_EFin. +rewrite -EFinM invr1 powRr1; last by rewrite addr_ge0. +do 2 (rewrite ger0_norm; last by rewrite mulr_ge0). +by do 4 (rewrite ger0_norm; last by []). +Qed. + +End hoelder2. + +Section convex_powR. +Context {R : realType}. +Local Open Scope ring_scope. + +Lemma convex_powR p : 1 <= p -> + convex_function `[0, +oo[%classic (@powR R ^~ p). +Proof. +move=> p1 t x y /[!inE] /= /[!in_itv] /= /[!andbT] x_ge0 y_ge0. +have p0 : 0 < p by rewrite (lt_le_trans _ p1). +rewrite !convRE; set w1 := `1-(t%:inum); set w2 := t%:inum. +have [->|w10] := eqVneq w1 0. + rewrite !mul0r !add0r; have [->|w20] := eqVneq w2 0. + by rewrite !mul0r powR0// gt_eqF. + by rewrite ge1r_powRZ// /w2 lt_neqAle eq_sym w20/=; apply/andP. +have [->|w20] := eqVneq w2 0. + by rewrite !mul0r !addr0 ge1r_powRZ// onem_le1// andbT lt0r w10 onem_ge0. +have [->|p_neq1] := eqVneq p 1. + by rewrite !powRr1// addr_ge0// mulr_ge0// /w2 ?onem_ge0. +have {p_neq1} {}p1 : 1 < p by rewrite lt_neqAle eq_sym p_neq1. +pose q := p / (p - 1). +have q1 : 1 <= q by rewrite /q ler_pdivlMr// ?mul1r ?gerBl// subr_gt0. +have q0 : 0 < q by rewrite (lt_le_trans _ q1). +have pq1 : p^-1 + q^-1 = 1. + rewrite /q invf_div -{1}(div1r p) -mulrDl addrCA subrr addr0. + by rewrite mulfV// gt_eqF. +rewrite -(@powRr1 _ (w1 * x `^ p + w2 * y `^ p)); last first. + by rewrite addr_ge0// mulr_ge0// ?powR_ge0// /w2 ?onem_ge0// itv_ge0. +have -> : 1 = p^-1 * p by rewrite mulVf ?gt_eqF. +rewrite powRrM (ge0_ler_powR (le_trans _ (ltW p1)))//. +- by rewrite nnegrE addr_ge0// mulr_ge0 /w2 ?onem_ge0. +- by rewrite nnegrE powR_ge0. +have -> : w1 * x + w2 * y = w1 `^ (p^-1) * w1 `^ (q^-1) * x + + w2 `^ (p^-1) * w2 `^ (q^-1) * y. + rewrite -!powRD pq1; [|exact/implyP..]. + by rewrite !powRr1// /w2 ?onem_ge0. +apply: (@le_trans _ _ ((w1 * x `^ p + w2 * y `^ p) `^ (p^-1) * + (w1 + w2) `^ q^-1)). + pose a1 := w1 `^ p^-1 * x. pose a2 := w2 `^ p^-1 * y. + pose b1 := w1 `^ q^-1. pose b2 := w2 `^ q^-1. + have : a1 * b1 + a2 * b2 <= (a1 `^ p + a2 `^ p) `^ p^-1 * + (b1 `^ q + b2 `^ q) `^ q^-1. + by apply: hoelder2 => //; rewrite ?mulr_ge0 ?powR_ge0. + rewrite ?powRM ?powR_ge0 -?powRrM ?mulVf ?powRr1 ?gt_eqF ?onem_ge0/w2//. + by rewrite mulrAC (mulrAC _ y) => /le_trans; exact. +by rewrite {2}/w1 {2}/w2 subrK powR1 mulr1. +Qed. + +End convex_powR. + +Section minkowski. +Context d (T : measurableType d) (R : realType). +Variable mu : {measure set T -> \bar R}. +Implicit Types (f g : T -> R) (p : R). + +Let convex_powR_abs_half f g p x : 1 <= p -> + `| 2^-1 * f x + 2^-1 * g x | `^ p <= + 2^-1 * `| f x | `^ p + 2^-1 * `| g x | `^ p. +Proof. +move=> p1; rewrite (@le_trans _ _ ((2^-1 * `| f x | + 2^-1 * `| g x |) `^ p))//. + rewrite ge0_ler_powR ?nnegrE ?(le_trans _ p1)//. + by rewrite (le_trans (ler_normD _ _))// 2!normrM ger0_norm. +rewrite {1 3}(_ : 2^-1 = 1 - 2^-1); last by rewrite {2}(splitr 1) div1r addrK. +rewrite (@convex_powR _ _ p1 (@Itv.mk _ _ _ _)) ?inE/= ?in_itv/= ?normr_ge0//. +by rewrite /Itv.itv_cond/= in_itv/= invr_ge0 ler0n invf_le1 ?ler1n. +Qed. + +Let measurableT_comp_powR f p : + measurable_fun setT f -> measurable_fun setT (fun x => f x `^ p)%R. +Proof. exact: (@measurableT_comp _ _ _ _ _ _ (@powR R ^~ p)). Qed. + +Local Notation "'N_ p [ f ]" := (Lnorm mu p f). +Local Open Scope ereal_scope. + +Let minkowski1 f g p : measurable_fun setT f -> measurable_fun setT g -> + 'N_1[(f \+ g)%R] <= 'N_1[f] + 'N_1[g]. +Proof. +move=> mf mg. +rewrite !Lnorm1 -ge0_integralD//; [|by do 2 apply: measurableT_comp..]. +rewrite ge0_le_integral//. +- by do 2 apply: measurableT_comp => //; exact: measurable_funD. +- by move=> x _; rewrite lee_fin. +- by apply/measurableT_comp/measurable_funD; exact/measurableT_comp. +- by move=> x _; rewrite lee_fin ler_normD. +Qed. + +Let minkowski_lty f g p : + measurable_fun setT f -> measurable_fun setT g -> (1 <= p)%R -> + 'N_p%:E[f] < +oo -> 'N_p%:E[g] < +oo -> 'N_p%:E[(f \+ g)%R] < +oo. +Proof. +move=> mf mg p1 Nfoo Ngoo. +have p0 : p != 0%R by rewrite gt_eqF// (lt_le_trans _ p1). +have h x : (`| f x + g x | `^ p <= + 2 `^ (p - 1) * (`| f x | `^ p + `| g x | `^ p))%R. + have := convex_powR_abs_half (fun x => 2 * f x)%R (fun x => 2 * g x)%R x p1. + rewrite !normrM (@ger0_norm _ 2)// !mulrA mulVf// !mul1r => /le_trans; apply. + rewrite !powRM// !mulrA -powR_inv1// -powRD ?pnatr_eq0 ?implybT//. + by rewrite (addrC _ p) -mulrDr. +rewrite unlock (gt_eqF (lt_le_trans _ p1))// poweR_lty//. +pose x := \int[mu]_x (2 `^ (p - 1) * (`|f x| `^ p + `|g x| `^ p))%:E. +apply: (@le_lt_trans _ _ x). + rewrite ge0_le_integral//=. + - by move=> t _; rewrite lee_fin// powR_ge0. + - apply/EFin_measurable_fun/measurableT_comp_powR/measurableT_comp => //. + exact: measurable_funD. + - by move=> t _; rewrite lee_fin mulr_ge0 ?addr_ge0 ?powR_ge0. + - by apply/EFin_measurable_fun/measurable_funM/measurable_funD => //; + exact/measurableT_comp_powR/measurableT_comp. + - by move=> ? _; rewrite lee_fin. +rewrite {}/x; under eq_integral do rewrite EFinM. +rewrite ge0_integralZl_EFin ?powR_ge0//; last 2 first. + - by move=> x _; rewrite lee_fin addr_ge0// powR_ge0. + - by apply/EFin_measurable_fun/measurable_funD => //; + exact/measurableT_comp_powR/measurableT_comp. +rewrite lte_mul_pinfty ?lee_fin ?powR_ge0//. +under eq_integral do rewrite EFinD. +rewrite ge0_integralD//; last 4 first. + - by move=> x _; rewrite lee_fin powR_ge0. + - exact/EFin_measurable_fun/measurableT_comp_powR/measurableT_comp. + - by move=> x _; rewrite lee_fin powR_ge0. + - exact/EFin_measurable_fun/measurableT_comp_powR/measurableT_comp. +by rewrite lte_add_pinfty// -powR_Lnorm ?(gt_eqF (lt_trans _ p1))// poweR_lty. +Qed. + +Lemma minkowski f g p : + measurable_fun setT f -> measurable_fun setT g -> (1 <= p)%R -> + 'N_p%:E[(f \+ g)%R] <= 'N_p%:E[f] + 'N_p%:E[g]. +Proof. +move=> mf mg; rewrite le_eqVlt => /predU1P[<-|p1]; first exact: minkowski1. +have [->|Nfoo] := eqVneq 'N_p%:E[f] +oo. + by rewrite addye ?leey// -ltNye (lt_le_trans _ (Lnorm_ge0 _ _ _)). +have [->|Ngoo] := eqVneq 'N_p%:E[g] +oo. + by rewrite addey ?leey// -ltNye (lt_le_trans _ (Lnorm_ge0 _ _ _)). +have Nfgoo : 'N_p%:E[(f \+ g)%R] < +oo. + by rewrite minkowski_lty// ?ltW// ltey; [exact: Nfoo|exact: Ngoo]. +suff : 'N_p%:E[(f \+ g)%R] `^ p <= ('N_p%:E[f] + 'N_p%:E[g]) * + 'N_p%:E[(f \+ g)%R] `^ p * (fine 'N_p%:E[(f \+ g)%R])^-1%:E. + have [-> _|Nfg0] := eqVneq 'N_p%:E[(f \+ g)%R] 0. + by rewrite adde_ge0 ?Lnorm_ge0. + rewrite lee_pdivl_mulr ?fine_gt0// ?lt0e ?Nfg0 ?Lnorm_ge0//. + rewrite -{1}(@fineK _ ('N_p%:E[(f \+ g)%R] `^ p)); last first. + by rewrite fin_num_poweR// ge0_fin_numE// Lnorm_ge0. + rewrite -(invrK (fine _)) lee_pdivr_mull; last first. + rewrite invr_gt0 fine_gt0// (poweR_lty _ Nfgoo) andbT poweR_gt0//. + by rewrite lt0e Nfg0 Lnorm_ge0. + rewrite fineK ?ge0_fin_numE ?Lnorm_ge0// => /le_trans; apply. + rewrite lee_pdivr_mull; last first. + by rewrite fine_gt0// poweR_lty// andbT poweR_gt0// lt0e Nfg0 Lnorm_ge0. + by rewrite fineK// 1?muleC// fin_num_poweR// ge0_fin_numE ?Lnorm_ge0. +have p0 : (0 < p)%R by exact: (lt_trans _ p1). +rewrite powR_Lnorm ?gt_eqF//. +under eq_integral => x _ do rewrite -mulr_powRB1//. +apply: (@le_trans _ _ + (\int[mu]_x ((`|f x| + `|g x|) * `|f x + g x| `^ (p - 1))%:E)). + rewrite ge0_le_integral//. + - by move=> ? _; rewrite lee_fin mulr_ge0// powR_ge0. + - apply: measurableT_comp => //; apply: measurable_funM. + exact/measurableT_comp/measurable_funD. + exact/measurableT_comp_powR/measurableT_comp/measurable_funD. + - by move=> ? _; rewrite lee_fin mulr_ge0// powR_ge0. + - apply/measurableT_comp => //; apply: measurable_funM. + by apply/measurable_funD => //; exact: measurableT_comp. + exact/measurableT_comp_powR/measurableT_comp/measurable_funD. + - by move=> ? _; rewrite lee_fin ler_wpM2r// ?powR_ge0// ler_normD. +under eq_integral=> ? _ do rewrite mulrDl EFinD. +rewrite ge0_integralD//; last 4 first. + - by move=> x _; rewrite lee_fin mulr_ge0// powR_ge0. + - apply: measurableT_comp => //; apply: measurable_funM. + exact: measurableT_comp. + exact/measurableT_comp_powR/measurableT_comp/measurable_funD. + - by move=> x _; rewrite lee_fin mulr_ge0// powR_ge0. + - apply: measurableT_comp => //; apply: measurable_funM. + exact: measurableT_comp. + exact/measurableT_comp_powR/measurableT_comp/measurable_funD. +rewrite [leRHS](_ : _ = ('N_p%:E[f] + 'N_p%:E[g]) * + (\int[mu]_x (`|f x + g x| `^ p)%:E) `^ `1-(p^-1)). + rewrite muleDl; last 2 first. + - rewrite fin_num_poweR// -powR_Lnorm ?gt_eqF// fin_num_poweR//. + by rewrite ge0_fin_numE ?Lnorm_ge0. + - by rewrite ge0_adde_def// inE Lnorm_ge0. + apply: lee_add. + - pose h := (@powR R ^~ (p - 1) \o normr \o (f \+ g))%R; pose i := (f \* h)%R. + rewrite [leLHS](_ : _ = 'N_1[i]%R); last first. + rewrite Lnorm1; apply: eq_integral => x _. + by rewrite normrM (ger0_norm (powR_ge0 _ _)). + rewrite [X in _ * X](_ : _ = 'N_(p / (p - 1))%:E[h]); last first. + rewrite unlock mulf_eq0 gt_eqF//= invr_eq0 subr_eq0 (gt_eqF p1). + rewrite onemV ?gt_eqF// invf_div; apply: congr2; last by []. + apply: eq_integral => x _; congr EFin. + rewrite norm_powR// normr_id -powRrM mulrCA divff ?mulr1//. + by rewrite subr_eq0 gt_eqF. + apply: (@hoelder _ _ _ _ _ _ p (p / (p - 1))) => //. + + exact/measurableT_comp_powR/measurableT_comp/measurable_funD. + + by rewrite divr_gt0// subr_gt0. + + by rewrite invf_div -onemV ?gt_eqF// addrCA subrr addr0. + - pose h := (fun x => `|f x + g x| `^ (p - 1))%R; pose i := (g \* h)%R. + rewrite [leLHS](_ : _ = 'N_1[i]); last first. + rewrite Lnorm1; apply: eq_integral => x _ . + by rewrite normrM norm_powR// normr_id. + rewrite [X in _ * X](_ : _ = 'N_((1 - p^-1)^-1)%:E[h])//; last first. + rewrite unlock invrK invr_eq0 subr_eq0 eq_sym invr_eq1 (gt_eqF p1). + apply: congr2; last by []. + apply: eq_integral => x _; congr EFin. + rewrite -/(onem p^-1) onemV ?gt_eqF// norm_powR// normr_id -powRrM. + by rewrite invf_div mulrCA divff ?subr_eq0 ?gt_eqF// ?mulr1. + apply: (le_trans (@hoelder _ _ _ _ _ _ p (1 - p^-1)^-1 _ _ _ _ _)) => //. + + exact/measurableT_comp_powR/measurableT_comp/measurable_funD. + + by rewrite invr_gt0 onem_gt0// invf_lt1. + + by rewrite invrK addrCA subrr addr0. +rewrite -muleA; congr (_ * _). +under [X in X * _]eq_integral=> x _ do rewrite mulr_powRB1 ?subr_gt0//. +rewrite poweRD; last by rewrite poweRD_defE gt_eqF ?implyFb// subr_gt0 invf_lt1. +rewrite poweRe1; last by apply: integral_ge0 => x _; rewrite lee_fin powR_ge0. +congr (_ * _); rewrite poweRN. +- by rewrite unlock gt_eqF// fine_poweR. +- by rewrite -powR_Lnorm ?gt_eqF// fin_num_poweR// ge0_fin_numE ?Lnorm_ge0. +Qed. + +End minkowski. diff --git a/theories/itv.v b/theories/itv.v new file mode 100644 index 000000000..2911b9299 --- /dev/null +++ b/theories/itv.v @@ -0,0 +1,904 @@ +(* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) +From HB Require Import structures. +From mathcomp Require Import ssreflect ssrfun ssrbool. +From mathcomp Require Import ssrnat eqtype choice order ssralg ssrnum ssrint. +From mathcomp Require Import interval. +From mathcomp Require Import mathcomp_extra boolp. +Require Import signed. + +(**md**************************************************************************) +(* # Numbers within an intervel *) +(* *) +(* This file develops tools to make the manipulation of numbers within *) +(* a known interval easier, thanks to canonical structures. This adds types *) +(* like {itv R & `[a, b]}, a notation e%:itv that infers an enclosing *) +(* interval for expression e according to existing canonical instances and *) +(* %:inum to cast back from type {itv R & i} to R. *) +(* For instance, x : {i01 R}, we have (1 - x%:inum)%:itv : {i01 R} *) +(* automatically inferred. *) +(* *) +(* ## types for values within known interval *) +(* ``` *) +(* {i01 R} == interface type for elements in R that live in `[0, 1]; *) +(* R must have a numDomainType structure. *) +(* Allows to solve automatically goals of the form x >= 0 *) +(* and x <= 1 if x is canonically a {i01 R}. {i01 R} is *) +(* canonically stable by common operations. *) +(* {itv R & i} == more generic type of values in interval i : interval int *) +(* R must have a numDomainType structure. This type is shown *) +(* to be a porderType. *) +(* ``` *) +(* *) +(* ## casts from/to values within known interval *) +(* ``` *) +(* x%:itv == explicitly casts x to the most precise known {itv R & i} *) +(* according to existing canonical instances. *) +(* x%:i01 == explicitly casts x to {i01 R} according to existing *) +(* canonical instances. *) +(* x%:inum == explicit cast from {itv R & i} to R. *) +(* ``` *) +(* *) +(* ## sign proofs *) +(* ``` *) +(* [itv of x] == proof that x is in interval inferred by x%:itv *) +(* [lb of x] == proof that lb < x or lb <= x with lb the lower bound *) +(* inferred by x%:itv *) +(* [ub of x] == proof that x < ub or x <= ub with ub the upper bound *) +(* inferred by x%:itv *) +(* [lbe of x] == proof that lb <= x *) +(* [ube of x] == proof that x <= ub *) +(* ``` *) +(* *) +(* ## constructors *) +(* ``` *) +(* ItvNum xin == builds a {itv R & i} from a proof xin : x \in i *) +(* where x : R *) +(* ``` *) +(* *) +(* A number of canonical instances are provided for common operations, if *) +(* your favorite operator is missing, look below for examples on how to add *) +(* the appropriate Canonical. *) +(* Canonical instances are also provided according to types, as a *) +(* fallback when no known operator appears in the expression. Look to *) +(* itv_top_typ below for an example on how to add your favorite type. *) +(******************************************************************************) + +Reserved Notation "{ 'itv' R & i }" + (at level 0, R at level 200, i at level 200, format "{ 'itv' R & i }"). +Reserved Notation "{ 'i01' R }" + (at level 0, R at level 200, format "{ 'i01' R }"). + +Reserved Notation "x %:itv" (at level 2, format "x %:itv"). +Reserved Notation "x %:i01" (at level 2, format "x %:i01"). +Reserved Notation "x %:inum" (at level 2, format "x %:inum"). +Reserved Notation "[ 'itv' 'of' x ]" (format "[ 'itv' 'of' x ]"). +Reserved Notation "[ 'lb' 'of' x ]" (format "[ 'lb' 'of' x ]"). +Reserved Notation "[ 'ub' 'of' x ]" (format "[ 'ub' 'of' x ]"). +Reserved Notation "[ 'lbe' 'of' x ]" (format "[ 'lbe' 'of' x ]"). +Reserved Notation "[ 'ube' 'of' x ]" (format "[ 'ube' 'of' x ]"). + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. +Import Order.TTheory Order.Syntax. +Import GRing.Theory Num.Theory. + +Local Open Scope ring_scope. +Local Open Scope order_scope. + +Definition wider_itv (x y : interval int) := subitv y x. + +Module Itv. +Section Itv. +Context (R : numDomainType). + +Definition map_itv_bound S T (f : S -> T) (b : itv_bound S) : itv_bound T := + match b with + | BSide b x => BSide b (f x) + | BInfty b => BInfty _ b + end. + +Definition map_itv S T (f : S -> T) (i : interval S) : interval T := + let 'Interval l u := i in Interval (map_itv_bound f l) (map_itv_bound f u). + +Lemma le_map_itv_bound (x y : itv_bound int) : + x <= y -> + map_itv_bound (fun x => x%:~R : R) x <= map_itv_bound (fun x => x%:~R : R) y. +Proof. +move: x y => [xb x | []xb //=]; last by case: xb. +case=> [yb y /=|//]. +by rewrite /Order.le/=; case: (_ ==> _) => /=; rewrite ?ler_int// ltr_int. +Qed. + +Lemma subitv_map_itv (x y : interval int) : + x <= y -> + map_itv (fun x => x%:~R : R) x <= map_itv (fun x => x%:~R : R) y. +Proof. +move: x y => [lx ux] [ly uy] /andP[lel leu]. +apply/andP; split; exact: le_map_itv_bound. +Qed. + +Definition itv_cond (i : interval int) (x : R) := + x \in map_itv (fun x => x%:~R : R) i. + +Record def (i : interval int) := Def { + r :> R; + #[canonical=no] + P : itv_cond i r +}. + +End Itv. + +Notation spec i x := (itv_cond i%Z%R x). + +Record typ := Typ { + sort : numDomainType; + #[canonical=no] + sort_itv : interval int; + #[canonical=no] + allP : forall x : sort, spec sort_itv x +}. + +Definition mk {R} i r P : @def R i := + @Def R i r P. + +Definition from {R i} + {x : @def R i} (phx : phantom R x) := x. + +Definition fromP {R i} + {x : @def R i} (phx : phantom R x) := P x. + +Module Exports. +Notation "{ 'itv' R & i }" := (def R i%Z) : type_scope. +Notation "{ 'i01' R }" := (def R `[Posz 0, Posz 1]) : type_scope. +Notation "x %:itv" := (from (Phantom _ x)) : ring_scope. +Notation "[ 'itv' 'of' x ]" := (fromP (Phantom _ x)) : ring_scope. +Notation inum := r. +Notation "x %:inum" := (r x) : ring_scope. +Arguments r {R i}. +End Exports. +End Itv. +Export Itv.Exports. + +Section POrder. +Variables (R : numDomainType) (i : interval int). +Local Notation nR := {itv R & i}. +HB.instance Definition _ := [isSub for @Itv.r R i]. +HB.instance Definition _ := [Choice of nR by <:]. +HB.instance Definition _ := [SubChoice_isSubPOrder of nR by <: + with ring_display]. +End POrder. +(* TODO: numDomainType on sT ? *) + +Lemma itv_top_typ_subproof (R : numDomainType) (x : R) : + Itv.spec `]-oo, +oo[ x. +Proof. by []. Qed. + +Canonical itv_top_typ (R : numDomainType) := Itv.Typ (@itv_top_typ_subproof R). + +Lemma typ_inum_subproof (xt : Itv.typ) (x : Itv.sort xt) : + Itv.spec (Itv.sort_itv xt) x. +Proof. by move: xt x => []. Qed. + +(* This adds _ <- Itv.r ( typ_inum ) + to canonical projections (c.f., Print Canonical Projections + Itv.r) meaning that if no other canonical instance (with a + registered head symbol) is found, a canonical instance of + Itv.typ, like the ones above, will be looked for. *) +Canonical typ_inum (xt : Itv.typ) (x : Itv.sort xt) := + Itv.mk (typ_inum_subproof x). + +Notation unify_itv ix iy := (unify wider_itv ix iy). + +Section Theory. +Context {R : numDomainType} {i : interval int}. +Local Notation sT := {itv R & i}. +Implicit Type x : sT. + +Lemma itv_intro {x} : x%:inum = x%:inum :> R. Proof. by []. Qed. + +Definition empty_itv := `[Posz 1, Posz 0]. + +Lemma itv_bottom x : unify_itv empty_itv i -> False. +Proof. +move: x => [x /subitvP /(_ x)]; rewrite in_itv/= lexx => /(_ erefl) xi. +move=> /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). +by rewrite in_itv/= => /andP[] /le_trans /[apply]; rewrite ler10. +Qed. + +Lemma itv_gt0 x : unify_itv `]Posz 0, +oo[ i -> 0%R < x%:inum :> R. +Proof. +move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). +by rewrite in_itv/= andbT. +Qed. + +Lemma itv_le0F x : unify_itv `]Posz 0, +oo[ i -> x%:inum <= 0%R :> R = false. +Proof. +move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). +by rewrite in_itv/= andbT => /lt_geF. +Qed. + +Lemma itv_lt0 x : unify_itv `]-oo, Posz 0[ i -> x%:inum < 0%R :> R. +Proof. +move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). +by rewrite in_itv. +Qed. + +Lemma itv_ge0F x : unify_itv `]-oo, Posz 0[ i -> 0%R <= x%:inum :> R = false. +Proof. +move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). +by rewrite in_itv/= => /lt_geF. +Qed. + +Lemma itv_ge0 x : unify_itv `[Posz 0, +oo[ i -> 0%R <= x%:inum :> R. +Proof. +move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). +by rewrite in_itv/= andbT. +Qed. + +Lemma itv_lt0F x : unify_itv `[Posz 0, +oo[ i -> x%:inum < 0%R :> R = false. +Proof. +move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). +by rewrite in_itv/= andbT => /le_gtF. +Qed. + +Lemma itv_le0 x : unify_itv `]-oo, Posz 0] i -> x%:inum <= 0%R :> R. +Proof. +move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). +by rewrite in_itv/=. +Qed. + +Lemma itv_gt0F x : unify_itv `]-oo, Posz 0] i -> 0%R < x%:inum :> R = false. +Proof. +move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). +by rewrite in_itv/= => /le_gtF. +Qed. + +Lemma lt1 x : unify_itv `]-oo, Posz 1[ i -> x%:inum < 1%R :> R. +Proof. +move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). +by rewrite in_itv. +Qed. + +Lemma ge1F x : unify_itv `]-oo, Posz 1[ i -> 1%R <= x%:inum :> R = false. +Proof. +move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). +by rewrite in_itv/= => /lt_geF. +Qed. + +Lemma le1 x : unify_itv `]-oo, Posz 1] i -> x%:inum <= 1%R :> R. +Proof. +move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). +by rewrite in_itv/=. +Qed. + +Lemma gt1F x : unify_itv `]-oo, Posz 1] i -> 1%R < x%:inum :> R = false. +Proof. +move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). +by rewrite in_itv/= => /le_gtF. +Qed. + +Lemma widen_itv_subproof x i' : unify_itv i' i -> Itv.spec i' x%:inum. +Proof. +by move: x => [x /= xi] /(@Itv.subitv_map_itv R) /subitvP /(_ _ xi). +Qed. + +Definition widen_itv x i' (uni : unify_itv i' i) := + Itv.mk (widen_itv_subproof x uni). + +Lemma widen_itvE x (uni : unify_itv i i) : @widen_itv x i uni = x. +Proof. exact/val_inj. Qed. + +End Theory. + +Arguments itv_bottom {R i} _ {_}. +Arguments itv_gt0 {R i} _ {_}. +Arguments itv_le0F {R i} _ {_}. +Arguments itv_lt0 {R i} _ {_}. +Arguments itv_ge0F {R i} _ {_}. +Arguments itv_ge0 {R i} _ {_}. +Arguments itv_lt0F {R i} _ {_}. +Arguments itv_le0 {R i} _ {_}. +Arguments itv_gt0F {R i} _ {_}. +Arguments lt1 {R i} _ {_}. +Arguments ge1F {R i} _ {_}. +Arguments le1 {R i} _ {_}. +Arguments gt1F {R i} _ {_}. +Arguments widen_itv {R i} _ {_ _}. +Arguments widen_itvE {R i} _ {_}. + +#[global] Hint Extern 0 (is_true (0%R < _)%O) => solve [apply: itv_gt0] : core. +#[global] Hint Extern 0 (is_true (_ < 0%R)%O) => solve [apply: itv_lt0] : core. +#[global] Hint Extern 0 (is_true (0%R <= _)%O) => solve [apply: itv_ge0] : core. +#[global] Hint Extern 0 (is_true (_ <= 0%R)%O) => solve [apply: itv_le0] : core. +#[global] Hint Extern 0 (is_true (_ < 1%R)%O) => solve [apply: lt1] : core. +#[global] Hint Extern 0 (is_true (_ <= 1%R)%O) => solve [apply: le1] : core. + +Notation "x %:i01" := (widen_itv x%:itv : {i01 _}) (only parsing) : ring_scope. +Notation "x %:i01" := (@widen_itv _ _ + (@Itv.from _ _ _ (Phantom _ x)) `[Posz 0, Posz 1] _) + (only printing) : ring_scope. + +Local Open Scope ring_scope. + +Section NumDomainStability. +Context {R : numDomainType}. + +Lemma zero_inum_subproof : Itv.spec `[0, 0] (0 : R). +Proof. by rewrite /Itv.itv_cond/= inE. Qed. + +Canonical zero_inum := Itv.mk zero_inum_subproof. + +Lemma one_inum_subproof : Itv.spec `[1, 1] (1 : R). +Proof. by rewrite /Itv.itv_cond/= inE. Qed. + +Canonical one_inum := Itv.mk one_inum_subproof. + +Definition opp_itv_bound_subdef (b : itv_bound int) : itv_bound int := + match b with + | BSide b x => BSide (~~ b) (intZmod.oppz x) + | BInfty b => BInfty _ (~~ b) + end. +Arguments opp_itv_bound_subdef /. + +Lemma opp_itv_ge0_subproof b : + (BLeft 0%R <= opp_itv_bound_subdef b)%O = (b <= BRight 0%R)%O. +Proof. by case: b => [[] b | []//]; rewrite /= !bnd_simp oppr_ge0. Qed. + +Lemma opp_itv_gt0_subproof b : + (BLeft 0%R < opp_itv_bound_subdef b)%O = (b < BRight 0%R)%O. +Proof. +by case: b => [[] b | []//]; rewrite /= !bnd_simp ?oppr_ge0 // oppr_gt0. +Qed. + +Lemma opp_itv_boundr_subproof (x : R) b : + (BRight (- x)%R <= Itv.map_itv_bound intr (opp_itv_bound_subdef b))%O + = (Itv.map_itv_bound intr b <= BLeft x)%O. +Proof. +by case: b => [[] b | []//]; rewrite /= !bnd_simp mulrNz ?lerN2 // ltrN2. +Qed. + +Lemma opp_itv_le0_subproof b : + (opp_itv_bound_subdef b <= BRight 0%R)%O = (BLeft 0%R <= b)%O. +Proof. by case: b => [[] b | []//]; rewrite /= !bnd_simp oppr_le0. Qed. + +Lemma opp_itv_lt0_subproof b : + (opp_itv_bound_subdef b < BRight 0%R)%O = (BLeft 0%R < b)%O. +Proof. +by case: b => [[] b | []//]; rewrite /= !bnd_simp ?oppr_le0 // oppr_lt0. +Qed. + +Lemma opp_itv_boundl_subproof (x : R) b : + (Itv.map_itv_bound intr (opp_itv_bound_subdef b) <= BLeft (- x)%R)%O + = (BRight x <= Itv.map_itv_bound intr b)%O. +Proof. +by case: b => [[] b | []//]; rewrite /= !bnd_simp mulrNz ?lerN2 // ltrN2. +Qed. + +Definition opp_itv_subdef (i : interval int) : interval int := + let 'Interval l u := i in + Interval (opp_itv_bound_subdef u) (opp_itv_bound_subdef l). +Arguments opp_itv_subdef /. + +Lemma opp_inum_subproof (i : interval int) + (x : {itv R & i}) (r := opp_itv_subdef i) : + Itv.spec r (- x%:inum). +Proof. +rewrite {}/r; move: i x => [l u] [x /= /andP[xl xu]]; apply/andP; split. +- by case: u xu => [[] b i | [] //] /=; rewrite /Order.le/= mulrNz; + do ?[by rewrite lerNl opprK|by rewrite ltrNl opprK]. +- by case: l xl => [[] b i | [] //] /=; rewrite /Order.le/= mulrNz; + do ?[by rewrite ltrNl opprK|by rewrite lerNl opprK]. +Qed. + +Canonical opp_inum (i : interval int) (x : {itv R & i}) := + Itv.mk (opp_inum_subproof x). + +Definition add_itv_boundl_subdef (b1 b2 : itv_bound int) : itv_bound int := + match b1, b2 with + | BSide b1 x1, BSide b2 x2 => BSide (b1 && b2) (intZmod.addz x1 x2) + | _, _ => BInfty _ true + end. +Arguments add_itv_boundl_subdef /. + +Definition add_itv_boundr_subdef (b1 b2 : itv_bound int) : itv_bound int := + match b1, b2 with + | BSide b1 x1, BSide b2 x2 => BSide (b1 || b2) (intZmod.addz x1 x2) + | _, _ => BInfty _ false + end. +Arguments add_itv_boundr_subdef /. + +Definition add_itv_subdef (i1 i2 : interval int) : interval int := + let 'Interval l1 u1 := i1 in + let 'Interval l2 u2 := i2 in + Interval (add_itv_boundl_subdef l1 l2) (add_itv_boundr_subdef u1 u2). +Arguments add_itv_subdef /. + +Lemma add_inum_subproof (xi yi : interval int) + (x : {itv R & xi}) (y : {itv R & yi}) + (r := add_itv_subdef xi yi) : + Itv.spec r (x%:inum + y%:inum). +Proof. +rewrite {}/r. +move: xi x yi y => [lx ux] [x /= /andP[xl xu]] [ly uy] [y /= /andP[yl yu]]. +rewrite /Itv.itv_cond in_itv; apply/andP; split. +- move: lx ly xl yl => [xb lx | //] [yb ly | //]. + by move: xb yb => [] []; rewrite /Order.le/= rmorphD/=; + do ?[exact: lerD|exact: ler_ltD|exact: ltr_leD|exact: ltrD]. +- move: ux uy xu yu => [xb ux | //] [yb uy | //]. + by move: xb yb => [] []; rewrite /Order.le/= rmorphD/=; + do ?[exact: lerD|exact: ler_ltD|exact: ltr_leD|exact: ltrD]. +Qed. + +Canonical add_inum (xi yi : interval int) + (x : {itv R & xi}) (y : {itv R & yi}) := + Itv.mk (add_inum_subproof x y). + +End NumDomainStability. + +Section RealDomainStability. +Context {R : realDomainType}. + +Definition itv_bound_signl (b : itv_bound int) : KnownSign.sign := + let b0 := BLeft 0%Z in + (if b == b0 then =0 else if (b <= b0)%O then <=0 else >=0)%snum_sign. + +Definition itv_bound_signr (b : itv_bound int) : KnownSign.sign := + let b0 := BRight 0%Z in + (if b == b0 then =0 else if (b <= b0)%O then <=0 else >=0)%snum_sign. + +Definition interval_sign (i : interval int) : option KnownSign.real := + let 'Interval l u := i in + (match itv_bound_signl l, itv_bound_signr u with + | =0, <=0 + | >=0, =0 + | >=0, <=0 => None + | =0, =0 => Some (KnownSign.Sign =0) + | <=0, =0 + | <=0, <=0 => Some (KnownSign.Sign <=0) + | =0, >=0 + | >=0, >=0 => Some (KnownSign.Sign >=0) + | <=0, >=0 => Some >=<0 + end)%snum_sign. + +Variant interval_sign_spec (l u : itv_bound int) : option KnownSign.real -> Set := + | ISignNone : (u <= l)%O -> interval_sign_spec l u None + | ISignEqZero : l = BLeft 0 -> u = BRight 0 -> + interval_sign_spec l u (Some (KnownSign.Sign =0)) + | ISignNeg : (l < BLeft 0%:Z)%O -> (u <= BRight 0%:Z)%O -> + interval_sign_spec l u (Some (KnownSign.Sign <=0)) + | ISignPos : (BLeft 0%:Z <= l)%O -> (BRight 0%:Z < u)%O -> + interval_sign_spec l u (Some (KnownSign.Sign >=0)) + | ISignBoth : (l < BLeft 0%:Z)%O -> (BRight 0%:Z < u)%O -> + interval_sign_spec l u (Some >=<0%snum_sign). + +Lemma interval_signP l u : + interval_sign_spec l u (interval_sign (Interval l u)). +Proof. +rewrite /interval_sign/itv_bound_signl/itv_bound_signr. +have [lneg|lpos|->] := ltgtP l; have [uneg|upos|->] := ltgtP u. +- apply: ISignNeg => //; exact: ltW. +- exact: ISignBoth. +- exact: ISignNeg. +- by apply/ISignNone/ltW/(lt_le_trans uneg); rewrite leBRight_ltBLeft. +- by apply: ISignPos => //; exact: ltW. +- by apply: ISignNone; rewrite leBRight_ltBLeft. +- by apply: ISignNone; rewrite -ltBRight_leBLeft. +- exact: ISignPos. +- exact: ISignEqZero. +Qed. + +Definition mul_itv_boundl_subdef (b1 b2 : itv_bound int) : itv_bound int := + match b1, b2 with + | BSide true 0%Z, BSide _ _ + | BSide _ _, BSide true 0%Z => BSide true 0%Z + | BSide b1 x1, BSide b2 x2 => BSide (b1 && b2) (intRing.mulz x1 x2) + | _, BInfty _ + | BInfty _, _ => BInfty _ false + end. +Arguments mul_itv_boundl_subdef /. + +Definition mul_itv_boundr_subdef (b1 b2 : itv_bound int) : itv_bound int := + match b1, b2 with + | BSide true 0%Z, _ + | _, BSide true 0%Z => BSide true 0%Z + | BSide false 0%Z, _ + | _, BSide false 0%Z => BSide false 0%Z + | BSide b1 x1, BSide b2 x2 => BSide (b1 || b2) (intRing.mulz x1 x2) + | _, BInfty _ + | BInfty _, _ => BInfty _ false + end. +Arguments mul_itv_boundr_subdef /. + +Lemma mul_itv_boundl_subproof b1 b2 (x1 x2 : R) : + (BLeft 0%:Z <= b1 -> BLeft 0%:Z <= b2 -> + Itv.map_itv_bound intr b1 <= BLeft x1 -> + Itv.map_itv_bound intr b2 <= BLeft x2 -> + Itv.map_itv_bound intr (mul_itv_boundl_subdef b1 b2) <= BLeft (x1 * x2))%O. +Proof. +move: b1 b2 => [[] b1 | []//] [[] b2 | []//] /=; rewrite 4!bnd_simp. +- set bl := match b1 with 0%Z => _ | _ => _ end. + have -> : bl = BLeft (b1 * b2). + rewrite {}/bl; move: b1 b2 => [[|p1]|p1] [[|p2]|p2]; congr BLeft. + by rewrite mulr0. + rewrite -2!(ler0z R) bnd_simp intrM; exact: ler_pM. +- case: b1 => [[|p1]|//]; rewrite -2!(ler0z R) !bnd_simp ?intrM. + by move=> _ geb2 ? ?; apply: mulr_ge0 => //; apply/(le_trans geb2)/ltW. + move=> p1gt0 b2ge0 lep1x1 ltb2x2. + have: (Posz p1.+1)%:~R * x2 <= x1 * x2. + by rewrite ler_pM2r //; apply: le_lt_trans ltb2x2. + by apply: lt_le_trans; rewrite ltr_pM2l // ltr0z. +- case: b2 => [[|p2]|//]; rewrite -2!(ler0z R) !bnd_simp ?intrM. + by move=> geb1 _ ? ?; apply: mulr_ge0 => //; apply/(le_trans geb1)/ltW. + move=> b1ge0 p2gt0 ltb1x1 lep2x2. + have: b1%:~R * x2 < x1 * x2; last exact/le_lt_trans/ler_pM. + by rewrite ltr_pM2r //; apply: lt_le_trans lep2x2; rewrite ltr0z. +- rewrite -2!(ler0z R) bnd_simp intrM; exact: ltr_pM. +Qed. + +Lemma mul_itv_boundrC_subproof b1 b2 : + mul_itv_boundr_subdef b1 b2 = mul_itv_boundr_subdef b2 b1. +Proof. +by move: b1 b2 => [[] [[|?]|?] | []] [[] [[|?]|?] | []] //=; rewrite mulnC. +Qed. + +Lemma mul_itv_boundr_subproof b1 b2 (x1 x2 : R) : + (BLeft 0%R <= BLeft x1 -> BLeft 0%R <= BLeft x2 -> + BRight x1 <= Itv.map_itv_bound intr b1 -> + BRight x2 <= Itv.map_itv_bound intr b2 -> + BRight (x1 * x2) <= Itv.map_itv_bound intr (mul_itv_boundr_subdef b1 b2))%O. +Proof. +move: b1 b2 => [b1b b1 | []] [b2b b2 | []] //=; last first. +- move: b2 b2b => [[|p2]|p2] [] // _ + _ +; rewrite !bnd_simp => le1 le2. + + by move: (le_lt_trans le1 le2); rewrite ltxx. + + by move: (conj le1 le2) => /andP/le_anti <-; rewrite mulr0. +- move: b1 b1b => [[|p1]|p1] [] // + _ + _; rewrite !bnd_simp => le1 le2. + + by move: (le_lt_trans le1 le2); rewrite ltxx. + + by move: (conj le1 le2) => /andP/le_anti <-; rewrite mul0r. +case: b1 => [[|p1]|p1]. +- case: b1b. + by rewrite !bnd_simp => l _ l' _; move: (le_lt_trans l l'); rewrite ltxx. + by move: b2b b2 => [] [[|p2]|p2]; rewrite !bnd_simp; + first (by move=> _ l _ l'; move: (le_lt_trans l l'); rewrite ltxx); + move=> l _ l' _; move: (conj l l') => /andP/le_anti <-; rewrite mul0r. +- rewrite if_same. + case: b2 => [[|p2]|p2]. + + case: b2b => _ + _ +; rewrite !bnd_simp => l l'. + by move: (le_lt_trans l l'); rewrite ltxx. + by move: (conj l l') => /andP/le_anti <-; rewrite mulr0. + + move: b1b b2b => [] []; rewrite !bnd_simp; + rewrite -[intRing.mulz ?[a] ?[b]]/((Posz ?[a]) * ?[b])%R intrM. + * exact: ltr_pM. + * move=> x1ge0 x2ge0 ltx1p1 lex2p2. + have: x1 * p2.+1%:~R < p1.+1%:~R * p2.+1%:~R. + by rewrite ltr_pM2r // ltr0z. + exact/le_lt_trans/ler_pM. + * move=> x1ge0 x2ge0 lex1p1 ltx2p2. + have: p1.+1%:~R * x2 < p1.+1%:~R * p2.+1%:~R. + by rewrite ltr_pM2l // ltr0z. + exact/le_lt_trans/ler_pM. + * exact: ler_pM. + + case: b2b => _ + _; rewrite 2!bnd_simp => l l'. + by move: (le_lt_trans l l'); rewrite ltr0z. + by move: (le_trans l l'); rewrite ler0z. +- case: b1b => + _ + _; rewrite 2!bnd_simp => l l'. + by move: (le_lt_trans l l'); rewrite ltr0z. + by move: (le_trans l l'); rewrite ler0z. +Qed. + +Lemma mul_itv_boundr'_subproof b1 b2 (x1 x2 : R) : + (BLeft 0%:R <= BLeft x1 -> BRight 0%:Z <= b2 -> + BRight x1 <= Itv.map_itv_bound intr b1 -> + BRight x2 <= Itv.map_itv_bound intr b2 -> + BRight (x1 * x2) <= Itv.map_itv_bound intr (mul_itv_boundr_subdef b1 b2))%O. +Proof. +move=> x1ge0 b2ge0 lex1b1 lex2b2. +have [x2ge0 | x2lt0] := leP 0 x2; first exact: mul_itv_boundr_subproof. +have lem0 : (BRight (x1 * x2) <= BRight 0%R)%O. + by rewrite bnd_simp mulr_ge0_le0 // ltW. +apply: le_trans lem0 _. +move: b1 b2 lex1b1 lex2b2 b2ge0 => [b1b b1 | []] [b2b b2 | []] //=; last first. +- by move: b2 b2b => [[|?]|?] []. +- move: b1 b1b => [[|p1]|p1] [] //. + by rewrite leBRight_ltBLeft => /(le_lt_trans x1ge0); rewrite ltxx. +case: b1 => [[|p1]|p1]. +- case: b1b; last by move: b2b b2 => [] [[|]|]. + by rewrite leBRight_ltBLeft => /(le_lt_trans x1ge0); rewrite ltxx. +- rewrite if_same. + case: b2 => [[|p2]|p2]; first (by case: b2b); last by case: b2b. + by rewrite if_same => _ _ _ /=; rewrite leBSide ltrW_lteif // ltr0z. +- rewrite leBRight_ltBLeft => /(le_lt_trans x1ge0). + by case: b1b; rewrite bnd_simp ?ltr0z // ler0z. +Qed. + +Definition mul_itv_subdef (i1 i2 : interval int) : interval int := + let 'Interval l1 u1 := i1 in + let 'Interval l2 u2 := i2 in + let opp := opp_itv_bound_subdef in + let mull := mul_itv_boundl_subdef in + let mulr := mul_itv_boundr_subdef in + match interval_sign i1, interval_sign i2 with + | None, _ | _, None => `[1, 0] + | some s1, Some s2 => + (match s1, s2 with + | =0, _ => `[0, 0] + | _, =0 => `[0, 0] + | >=0, >=0 => Interval (mull l1 l2) (mulr u1 u2) + | <=0, <=0 => Interval (mull (opp u1) (opp u2)) (mulr (opp l1) (opp l2)) + | >=0, <=0 => Interval (opp (mulr u1 (opp l2))) (opp (mull l1 (opp u2))) + | <=0, >=0 => Interval (opp (mulr (opp l1) u2)) (opp (mull (opp u1) l2)) + | >=0, >=<0 => Interval (opp (mulr u1 (opp l2))) (mulr u1 u2) + | <=0, >=<0 => Interval (opp (mulr (opp l1) u2)) (mulr (opp l1) (opp l2)) + | >=<0, >=0 => Interval (opp (mulr (opp l1) u2)) (mulr u1 u2) + | >=<0, <=0 => Interval (opp (mulr u1 (opp l2))) (mulr (opp l1) (opp l2)) + | >=<0, >=<0 => Interval + (Order.min (opp (mulr (opp l1) u2)) + (opp (mulr u1 (opp l2)))) + (Order.max (mulr (opp l1) (opp l2)) + (mulr u1 u2)) + end)%snum_sign + end. +Arguments mul_itv_subdef /. + +Lemma map_itv_bound_min (x y : itv_bound int) : + Itv.map_itv_bound (fun x => x%:~R : R) (Order.min x y) + = Order.min (Itv.map_itv_bound intr x) (Itv.map_itv_bound intr y). +Proof. +have [lexy|ltyx] := leP x y; first by rewrite !minEle Itv.le_map_itv_bound. +by rewrite minElt -if_neg -leNgt Itv.le_map_itv_bound // ltW. +Qed. + +Lemma map_itv_bound_max (x y : itv_bound int) : + Itv.map_itv_bound (fun x => x%:~R : R) (Order.max x y) + = Order.max (Itv.map_itv_bound intr x) (Itv.map_itv_bound intr y). +Proof. +have [lexy|ltyx] := leP x y; first by rewrite !maxEle Itv.le_map_itv_bound. +by rewrite maxElt -if_neg -leNgt Itv.le_map_itv_bound // ltW. +Qed. + +Lemma mul_inum_subproof (xi yi : interval int) + (x : {itv R & xi}) (y : {itv R & yi}) + (r := mul_itv_subdef xi yi) : + Itv.spec r (x%:inum * y%:inum). +Proof. +rewrite {}/r. +move: xi x yi y => [lx ux] [x /= /andP[+ +]] [ly uy] [y /= /andP[+ +]]. +rewrite -/(interval_sign (Interval lx ux)). +rewrite -/(interval_sign (Interval ly uy)). +have empty10 (z : R) l u : (u <= l)%O -> + (Itv.map_itv_bound [eta intr] l <= BLeft z)%O -> + (BRight z <= Itv.map_itv_bound [eta intr] u)%O -> False. + move=> leul; rewrite leBRight_ltBLeft => /le_lt_trans /[apply]. + rewrite lt_def => /andP[/[swap]] => + /ltac:(apply/negP). + rewrite negbK; move: leul => /(Itv.le_map_itv_bound R) le1 le2. + by apply/eqP/le_anti; rewrite le1. +pose opp := opp_itv_bound_subdef. +pose mull := mul_itv_boundl_subdef. +pose mulr := mul_itv_boundr_subdef. +have [leuxlx|-> ->|lxneg uxneg|lxpos uxpos|lxneg uxpos] := interval_signP. +- move=> + + /ltac:(exfalso); exact: empty10. +- rewrite 2!bnd_simp => lex1 lex2 ley1 ley2. + have -> : x = 0 by apply: le_anti; rewrite lex1 lex2. + rewrite mul0r. + case: interval_signP; [|by move=> _ _; rewrite /Itv.itv_cond in_itv/= lexx..]. + by move=> leul; exfalso; move: ley1 ley2; apply: empty10. +- move=> lelxx lexux. + have xneg : x <= 0. + move: (le_trans lexux (Itv.le_map_itv_bound R uxneg)). + by rewrite /= bnd_simp. + have [leuyly|-> ->|lyneg uyneg|lypos uypos|lyneg uypos] := interval_signP. + + move=> + + /ltac:(exfalso); exact: empty10. + + rewrite 2!bnd_simp => ley1 ley2. + have -> : y = 0 by apply: le_anti; rewrite ley1 ley2. + by rewrite mulr0 /Itv.itv_cond in_itv/= lexx. + + move=> lelyy leyuy. + have yneg : y <= 0. + move: (le_trans leyuy (Itv.le_map_itv_bound R uyneg)). + by rewrite /= bnd_simp. + rewrite -[Interval _ _]/(Interval (mull (opp ux) (opp uy)) + (mulr (opp lx) (opp ly))). + rewrite -mulrNN /Itv.itv_cond itv_boundlr. + rewrite mul_itv_boundl_subproof ?mul_itv_boundr_subproof //. + * by rewrite bnd_simp oppr_ge0. + * by rewrite bnd_simp oppr_ge0. + * by rewrite opp_itv_boundr_subproof. + * by rewrite opp_itv_boundr_subproof. + * by rewrite opp_itv_ge0_subproof. + * by rewrite opp_itv_ge0_subproof. + * by rewrite opp_itv_boundl_subproof. + * by rewrite opp_itv_boundl_subproof. + + move=> lelyy leyuy. + have ypos : 0 <= y. + move: (le_trans (Itv.le_map_itv_bound R lypos) lelyy). + by rewrite /= bnd_simp. + rewrite -[Interval _ _]/(Interval (opp (mulr (opp lx) uy)) + (opp (mull (opp ux) ly))). + rewrite -[x * y]opprK -mulNr /Itv.itv_cond itv_boundlr. + rewrite opp_itv_boundl_subproof opp_itv_boundr_subproof. + rewrite mul_itv_boundl_subproof ?mul_itv_boundr_subproof //. + * by rewrite bnd_simp oppr_ge0. + * by rewrite opp_itv_boundr_subproof. + * by rewrite opp_itv_ge0_subproof. + * by rewrite opp_itv_boundl_subproof. + + move=> lelyy leyuy. + rewrite -[Interval _ _]/(Interval (opp (mulr (opp lx) uy)) + (mulr (opp lx) (opp ly))). + rewrite -[x * y]opprK -mulNr /Itv.itv_cond itv_boundlr. + rewrite opp_itv_boundl_subproof -mulrN. + rewrite 2?mul_itv_boundr'_subproof //. + * by rewrite bnd_simp oppr_ge0. + * by rewrite leBRight_ltBLeft opp_itv_gt0_subproof ltBRight_leBLeft ltW. + * by rewrite opp_itv_boundr_subproof. + * by rewrite opp_itv_boundr_subproof. + * by rewrite bnd_simp oppr_ge0. + * by rewrite ltW. + * by rewrite opp_itv_boundr_subproof. +- move=> lelxx lexux. + have xpos : 0 <= x. + move: (le_trans (Itv.le_map_itv_bound R lxpos) lelxx). + by rewrite /= bnd_simp. + have [leuyly|-> ->|lyneg uyneg|lypos uypos|lyneg uypos] := interval_signP. + + move=> + + /ltac:(exfalso); exact: empty10. + + rewrite 2!bnd_simp => ley1 ley2. + have -> : y = 0 by apply: le_anti; rewrite ley1 ley2. + by rewrite mulr0 /Itv.itv_cond in_itv/= lexx. + + move=> lelyy leyuy. + have yneg : y <= 0. + move: (le_trans leyuy (Itv.le_map_itv_bound R uyneg)). + by rewrite /= bnd_simp. + rewrite -[Interval _ _]/(Interval (opp (mulr ux (opp ly))) + (opp (mull lx (opp uy)))). + rewrite -[x * y]opprK -mulrN /Itv.itv_cond itv_boundlr. + rewrite opp_itv_boundl_subproof opp_itv_boundr_subproof. + rewrite mul_itv_boundr_subproof ?mul_itv_boundl_subproof //. + * by rewrite opp_itv_ge0_subproof. + * by rewrite opp_itv_boundl_subproof. + * by rewrite bnd_simp oppr_ge0. + * by rewrite opp_itv_boundr_subproof. + + move=> lelyy leyuy. + have ypos : 0 <= y. + move: (le_trans (Itv.le_map_itv_bound R lypos) lelyy). + by rewrite /= bnd_simp. + rewrite -[Interval _ _]/(Interval (mull lx ly) (mulr ux uy)). + rewrite /Itv.itv_cond itv_boundlr. + by rewrite mul_itv_boundr_subproof ?mul_itv_boundl_subproof. + + move=> lelyy leyuy. + rewrite -[Interval _ _]/(Interval (opp (mulr ux (opp ly))) (mulr ux uy)). + rewrite -[x * y]opprK -mulrN /Itv.itv_cond itv_boundlr. + rewrite opp_itv_boundl_subproof -mulrN opprK. + rewrite 2?mul_itv_boundr'_subproof //. + * by rewrite ltW. + * by rewrite leBRight_ltBLeft opp_itv_gt0_subproof ltBRight_leBLeft ltW. + * by rewrite opp_itv_boundr_subproof. +- move=> lelxx lexux. + have [leuyly|-> ->|lyneg uyneg|lypos uypos|lyneg uypos] := interval_signP. + + move=> + + /ltac:(exfalso); exact: empty10. + + rewrite 2!bnd_simp => ley1 ley2. + have -> : y = 0 by apply: le_anti; rewrite ley1 ley2. + by rewrite mulr0 /Itv.itv_cond in_itv/= lexx. + + move=> lelyy leyuy. + have yneg : y <= 0. + move: (le_trans leyuy (Itv.le_map_itv_bound R uyneg)). + by rewrite /= bnd_simp. + rewrite -[Interval _ _]/(Interval (opp (mulr ux (opp ly))) + (mulr (opp lx) (opp ly))). + rewrite -[x * y]opprK -mulrN /Itv.itv_cond itv_boundlr. + rewrite /mulr mul_itv_boundrC_subproof mulrC opp_itv_boundl_subproof. + rewrite [in X in _ && X]mul_itv_boundrC_subproof -mulrN. + rewrite mul_itv_boundr'_subproof ?mul_itv_boundr'_subproof //. + * by rewrite bnd_simp oppr_ge0. + * by rewrite leBRight_ltBLeft opp_itv_gt0_subproof ltBRight_leBLeft ltW. + * by rewrite opp_itv_boundr_subproof. + * by rewrite opp_itv_boundr_subproof. + * by rewrite bnd_simp oppr_ge0. + * by rewrite ltW. + * by rewrite opp_itv_boundr_subproof. + + move=> lelyy leyuy. + have ypos : 0 <= y. + move: (le_trans (Itv.le_map_itv_bound R lypos) lelyy). + by rewrite /= bnd_simp. + rewrite -[Interval _ _]/(Interval (opp (mulr (opp lx) uy)) (mulr ux uy)). + rewrite -[x * y]opprK -mulNr /Itv.itv_cond itv_boundlr. + rewrite /mulr mul_itv_boundrC_subproof mulrC opp_itv_boundl_subproof. + rewrite [in X in _ && X]mul_itv_boundrC_subproof -mulrN opprK. + rewrite mul_itv_boundr'_subproof ?mul_itv_boundr'_subproof //. + * by rewrite ltW. + * by rewrite leBRight_ltBLeft opp_itv_gt0_subproof ltBRight_leBLeft ltW. + * by rewrite opp_itv_boundr_subproof. + + move=> lelyy leyuy. + rewrite -[Interval _ _]/(Interval + (Order.min (opp (mulr (opp lx) uy)) + (opp (mulr ux (opp ly)))) + (Order.max (mulr (opp lx) (opp ly)) + (mulr ux uy))). + rewrite /Itv.itv_cond itv_boundlr. + rewrite map_itv_bound_min map_itv_bound_max le_minl le_maxr. + rewrite -[x * y]opprK !opp_itv_boundl_subproof. + rewrite -[in X in ((X || _) && _)]mulNr -[in X in ((_ || X) && _)]mulrN. + rewrite -[in X in (_ && (X || _))]mulrNN !opprK. + have [xpos|xneg] := leP 0 x. + * rewrite [in X in ((_ || X) && _)]mul_itv_boundr'_subproof ?orbT //=; + rewrite ?[in X in (_ || X)]mul_itv_boundr'_subproof ?orbT //. + - by rewrite ltW. + - by rewrite leBRight_ltBLeft opp_itv_gt0_subproof ltBRight_leBLeft ltW. + - by rewrite opp_itv_boundr_subproof. + * rewrite [in X in ((X || _) && _)]mul_itv_boundr'_subproof //=; + rewrite ?[in X in (X || _)]mul_itv_boundr'_subproof //. + - by rewrite bnd_simp oppr_ge0 ltW. + - by rewrite leBRight_ltBLeft opp_itv_gt0_subproof ltBRight_leBLeft ltW. + - by rewrite opp_itv_boundr_subproof. + - by rewrite opp_itv_boundr_subproof. + - by rewrite bnd_simp oppr_ge0 ltW. + - by rewrite ltW. + - by rewrite opp_itv_boundr_subproof. +Qed. + +Canonical mul_inum (xi yi : interval int) + (x : {itv R & xi}) (y : {itv R & yi}) := + Itv.mk (mul_inum_subproof x y). + +End RealDomainStability. + +Section Morph. +Context {R : numDomainType} {i : interval int}. +Local Notation nR := {itv R & i}. +Implicit Types x y : nR. +Local Notation inum := (@inum R i). + +Lemma inum_eq : {mono inum : x y / x == y}. Proof. by []. Qed. +Lemma inum_le : {mono inum : x y / (x <= y)%O}. Proof. by []. Qed. +Lemma inum_lt : {mono inum : x y / (x < y)%O}. Proof. by []. Qed. + +End Morph. + +Section Test1. + +Variable R : numDomainType. +Variable x : {i01 R}. + +Goal 0%:i01 = 1%:i01 :> {i01 R}. +Proof. +Abort. + +Goal (- x%:inum)%:itv = (- x%:inum)%:itv :> {itv R & `[-1, 0]}. +Proof. +Abort. + +Goal (1 - x%:inum)%:i01 = x. +Proof. +Abort. + +End Test1. + +Section Test2. + +Variable R : realDomainType. +Variable x y : {i01 R}. + +Goal (x%:inum * y%:inum)%:i01 = x%:inum%:i01. +Proof. +Abort. + +End Test2. + +Module Test3. +Section Test3. +Variable R : realDomainType. + +Definition s_of_pq (p q : {i01 R}) : {i01 R} := + (1 - ((1 - p%:inum)%:i01%:inum * (1 - q%:inum)%:i01%:inum))%:i01. + +Lemma s_of_p0 (p : {i01 R}) : s_of_pq p 0%:i01 = p. +Proof. +apply/val_inj => /=. +by rewrite subr0 mulr1 opprB addrCA subrr addr0. +Qed. + +Canonical onem_itv01 (p : {i01 R}) : {i01 R} := + @Itv.mk _ _ (onem p%:inum) [itv of 1 - p%:inum]. + +Definition s_of_pq' (p q : {i01 R}) : {i01 R} := + (`1- (`1-(p%:inum) * `1-(q%:inum)))%:i01. + +End Test3. +End Test3. diff --git a/theories/kernel.v b/theories/kernel.v new file mode 100644 index 000000000..e4b3e25e3 --- /dev/null +++ b/theories/kernel.v @@ -0,0 +1,1136 @@ +(* mathcomp analysis (c) 2022 Inria and AIST. License: CeCILL-C. *) +From HB Require Import structures. +From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval finmap. +From mathcomp Require Import mathcomp_extra boolp classical_sets functions. +From mathcomp Require Import cardinality fsbigop. +Require Import reals ereal signed topology normedtype sequences esum measure. +Require Import numfun lebesgue_measure lebesgue_integral. + +(**md**************************************************************************) +(* # Kernels *) +(* *) +(* This file provides a formation of kernels, s-finite kernels, finite *) +(* kernels, subprobability kernels, and probability kernels. The main *) +(* formalized result is the fact that s-finite kernels are stable by *) +(* composition. *) +(* Reference: *) +(* - R. Affeldt, C. Cohen, A. Saito. Semantics of probabilistic programs *) +(* using s-finite kernels in Coq. CPP 2023 *) +(* *) +(* ``` *) +(* R.-ker X ~> Y == kernel from X to Y where X and Y are of type *) +(* measurableType *) +(* The HB class is Kernel. *) +(* measure_fam_uub k == the kernel k is uniformly upper-bounded *) +(* R.-sfker X ~> Y == s-finite kernel *) +(* The HB class is SFiniteKernel. *) +(* R.-fker X ~> Y == finite kernel *) +(* The HB class is FiniteKernel. *) +(* R.-spker X ~> Y == subprobability kernel *) +(* The HB class is SubProbabilityKernel. *) +(* R.-pker X ~> Y == probability kernel *) +(* The HB class is ProbabilityKernel. *) +(* kseries == countable sum of kernels *) +(* It is declared as an instance of the structure *) +(* Kernel. It is also an instance of the structure *) +(* SFiniteKernel if the sum is over s-finite kernels. *) +(* kzero == kernel defined using the mzero measure *) +(* kdirac mf == kernel defined by a measurable function *) +(* mset U r == the set of probability measures mu such that *) +(* mu U < r *) +(* pset == the sets mset U r with U measurable and r \in [0,1] *) +(* pprobability == the measurable type generated by pset *) +(* kprobability m == kernel defined by a probability measure *) +(* kadd k1 k2 == lifting of the addition of measures to kernels *) +(* l \; k == composition of kernels *) +(* ``` *) +(* *) +(******************************************************************************) + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Import numFieldTopology.Exports. + +Local Open Scope classical_set_scope. +Local Open Scope ring_scope. +Local Open Scope ereal_scope. + +Reserved Notation "R .-ker X ~> Y" + (at level 42, format "R .-ker X ~> Y"). +Reserved Notation "R .-sfker X ~> Y" + (at level 42, format "R .-sfker X ~> Y"). +Reserved Notation "R .-fker X ~> Y" + (at level 42, format "R .-fker X ~> Y"). +Reserved Notation "R .-spker X ~> Y" + (at level 42, format "R .-spker X ~> Y"). +Reserved Notation "R .-pker X ~> Y" + (at level 42, format "R .-pker X ~> Y"). + +HB.mixin Record isKernel d d' (X : measurableType d) (Y : measurableType d') + (R : realType) (k : X -> {measure set Y -> \bar R}) := { + measurable_kernel : + forall U, measurable U -> measurable_fun [set: X] (k ^~ U) }. + +#[short(type=kernel)] +HB.structure Definition Kernel d d' + (X : measurableType d) (Y : measurableType d') (R : realType) := + { k & isKernel _ _ X Y R k }. +Notation "R .-ker X ~> Y" := (kernel X%type Y R). + +Arguments measurable_kernel {_ _ _ _ _} _. + +Lemma kernel_measurable_eq_cst d d' (T : measurableType d) + (T' : measurableType d') (R : realType) (f : R.-ker T ~> T') k : + measurable [set t | f t [set: T'] == k]. +Proof. +rewrite [X in measurable X](_ : _ = (f ^~ setT) @^-1` [set k]); last first. + by apply/seteqP; split => t/= /eqP. +have /(_ measurableT [set k]) := measurable_kernel f setT measurableT. +by rewrite setTI; exact. +Qed. + +Lemma kernel_measurable_neq_cst d d' (T : measurableType d) + (T' : measurableType d') (R : realType) (f : R.-ker T ~> T') k : + measurable [set t | f t [set: T'] != k]. +Proof. +rewrite [X in measurable X](_ : _ = (f ^~ setT) @^-1` [set~ k]); last first. + by apply/seteqP; split => t /eqP. +have /(_ measurableT [set~ k]) := measurable_kernel f setT measurableT. +by rewrite setTI; apply => //; exact: measurableC. +Qed. + +Lemma kernel_measurable_fun_eq_cst d d' (T : measurableType d) + (T' : measurableType d') (R : realType) (f : R.-ker T ~> T') k : + measurable_fun [set: T] (fun t => f t [set: T'] == k). +Proof. +move=> _ /= B mB; rewrite setTI. +have [/eqP->|/eqP->|/eqP->|/eqP->] := set_bool B. +- exact: kernel_measurable_eq_cst. +- rewrite (_ : _ @^-1` _ = [set b | f b setT != k]); last first. + by apply/seteqP; split => [t /negbT//|t /negbTE]. + exact: kernel_measurable_neq_cst. +- by rewrite preimage_set0. +- by rewrite preimage_setT. +Qed. + +Lemma eq_kernel d d' (T : measurableType d) (T' : measurableType d') + (R : realType) (k1 k2 : R.-ker T ~> T') : + (forall x U, k1 x U = k2 x U) -> k1 = k2. +Proof. +move: k1 k2 => [m1 [[?]]] [m2 [[?]]] /= k12. +have ? : m1 = m2. + by apply/funext => t; apply/eq_measure; apply/funext => U; rewrite k12. +by subst m1; f_equal; f_equal; f_equal; apply/Prop_irrelevance. +Qed. + +Section kseries. +Context d d' (X : measurableType d) (Y : measurableType d') (R : realType). +Variable k : (R.-ker X ~> Y)^nat. + +Definition kseries : X -> {measure set Y -> \bar R} := + fun x => [the measure _ _ of mseries (k ^~ x) 0]. + +Lemma measurable_fun_kseries (U : set Y) : + measurable U -> measurable_fun [set: X] (kseries ^~ U). +Proof. +move=> mU. +by apply: ge0_emeasurable_fun_sum => // n; exact/measurable_kernel. +Qed. + +HB.instance Definition _ := + isKernel.Build _ _ _ _ _ kseries measurable_fun_kseries. + +End kseries. + +Lemma integral_kseries d d' (X : measurableType d) (Y : measurableType d') + (R : realType) (k : (R.-ker X ~> Y)^nat) (f : Y -> \bar R) x : + (forall y, 0 <= f y) -> + measurable_fun [set: Y] f -> + \int[kseries k x]_y (f y) = \sum_(i f0 mf; rewrite /kseries/= ge0_integral_measure_series. +Qed. + +Section measure_fam_uub. +Context d d' (X : measurableType d) (Y : measurableType d') (R : numFieldType). +Variable k : X -> {measure set Y -> \bar R}. + +Definition measure_fam_uub := exists r, forall x, k x [set: Y] < r%:E. + +Lemma measure_fam_uubP : measure_fam_uub <-> + exists r : {posnum R}, forall x, k x [set: Y] < r%:num%:E. +Proof. +split => [|] [r kr]; last by exists r%:num. +suff r_gt0 : (0 < r)%R by exists (PosNum r_gt0). +by rewrite -lte_fin; apply: (le_lt_trans _ (kr point)). +Qed. + +End measure_fam_uub. + +HB.mixin Record Kernel_isSFinite_subdef d d' + (X : measurableType d) (Y : measurableType d') (R : realType) + (k : X -> {measure set Y -> \bar R}) := { + sfinite_kernel_subdef : exists2 s : (R.-ker X ~> Y)^nat, + forall n, measure_fam_uub (s n) & + forall x U, measurable U -> k x U = kseries s x U }. + +HB.structure Definition SFiniteKernel d d' + (X : measurableType d) (Y : measurableType d') (R : realType) := + { k of @Kernel _ _ _ _ R k & + Kernel_isSFinite_subdef _ _ X Y R k }. +Notation "R .-sfker X ~> Y" := (SFiniteKernel.type X%type Y R). +Arguments sfinite_kernel_subdef {_ _ _ _ _} _. + +Lemma eq_sfkernel d d' (T : measurableType d) (T' : measurableType d') + (R : realType) (k1 k2 : R.-sfker T ~> T') : + (forall x U, k1 x U = k2 x U) -> k1 = k2. +Proof. +move: k1 k2 => [m1 [[?] [?]]] [m2 [[?] [?]]] /= k12. +have ? : m1 = m2. + by apply/funext => t; apply/eq_measure; apply/funext => U; rewrite k12. +by subst m1; f_equal; f_equal; f_equal; apply/Prop_irrelevance. +Qed. + +HB.mixin Record SFiniteKernel_isFinite d d' + (X : measurableType d) (Y : measurableType d') (R : realType) + (k : X -> {measure set Y -> \bar R}) := { + measure_uub : measure_fam_uub k }. + +#[short(type=finite_kernel)] +HB.structure Definition FiniteKernel d d' + (X : measurableType d) (Y : measurableType d') (R : realType) := + { k of @SFiniteKernel _ _ _ _ _ k & + SFiniteKernel_isFinite _ _ X Y R k }. +Notation "R .-fker X ~> Y" := (finite_kernel X%type Y R). +Arguments measure_uub {_ _ _ _ _} _. + +HB.factory Record Kernel_isFinite d d' + (X : measurableType d) (Y : measurableType d') (R : realType) + (k : X -> {measure set Y -> \bar R}) of isKernel _ _ _ _ _ k := { + measure_uub : measure_fam_uub k }. + +Section kzero. +Context d d' (X : measurableType d) (Y : measurableType d') (R : realType). + +Definition kzero : X -> {measure set Y -> \bar R} := + fun _ : X => [the measure _ _ of mzero]. + +Let measurable_fun_kzero U : measurable U -> + measurable_fun [set: X] (kzero ^~ U). +Proof. by move=> ?/=; exact: measurable_cst. Qed. + +HB.instance Definition _ := + @isKernel.Build _ _ X Y R kzero measurable_fun_kzero. + +Lemma kzero_uub : measure_fam_uub kzero. +Proof. by exists 1%R => /= t; rewrite /mzero/=. Qed. + +End kzero. + +HB.builders Context d d' (X : measurableType d) (Y : measurableType d') + (R : realType) k of Kernel_isFinite d d' X Y R k. + +Let sfinite_finite : + exists2 k_ : (R.-ker _ ~> _)^nat, forall n, measure_fam_uub (k_ n) & + forall x U, measurable U -> k x U = mseries (k_ ^~ x) 0 U. +Proof. +exists (fun n => if n is O then [the _.-ker _ ~> _ of k] else + [the _.-ker _ ~> _ of @kzero _ _ X Y R]). + by case => [|_]; [exact: measure_uub|exact: kzero_uub]. +move=> t U mU/=; rewrite /mseries. +rewrite (nneseries_split 1%N)// big_ord_recl/= big_ord0 adde0. +rewrite ereal_series (@eq_eseriesr _ _ (fun=> 0%E)); last by case. +by rewrite eseries0// adde0. +Qed. + +HB.instance Definition _ := + @Kernel_isSFinite_subdef.Build d d' X Y R k sfinite_finite. + +HB.instance Definition _ := + @SFiniteKernel_isFinite.Build d d' X Y R k measure_uub. + +HB.end. + +Section sfinite. +Context d d' (X : measurableType d) (Y : measurableType d'). +Variables (R : realType) (k : R.-sfker X ~> Y). + +Let s : (X -> {measure set Y -> \bar R})^nat := + let: exist2 x _ _ := cid2 (sfinite_kernel_subdef k) in x. + +Let ms n : @isKernel d d' X Y R (s n). +Proof. +split; rewrite /s; case: cid2 => /= s' s'_uub kE. +exact: measurable_kernel. +Qed. + +HB.instance Definition _ n := ms n. + +Let s_uub n : measure_fam_uub (s n). +Proof. by rewrite /s; case: cid2. Qed. + +HB.instance Definition _ n := @Kernel_isFinite.Build d d' X Y R (s n) (s_uub n). + +Lemma sfinite_kernel : exists s : (R.-fker X ~> Y)^nat, + forall x U, measurable U -> k x U = kseries s x U. +Proof. +exists (fun n => [the _.-fker _ ~> _ of s n]) => x U mU. +by rewrite /s /= /s; by case: cid2 => ? ? ->. +Qed. + +End sfinite. + +Lemma sfinite_kernel_measure d d' (Z : measurableType d) (X : measurableType d') + (R : realType) (k : R.-sfker Z ~> X) (z : Z) : + sfinite_measure (k z). +Proof. +have [s ks] := sfinite_kernel k. +exists (s ^~ z). + move=> n; have [r snr] := measure_uub (s n). + by apply: lty_fin_num_fun; rewrite (lt_le_trans (snr _))// leey. +by move=> U mU; rewrite ks. +Qed. + +HB.instance Definition _ + d d' (X : measurableType d) (Y : measurableType d') (R : realType) := + @Kernel_isFinite.Build _ _ _ _ R (@kzero _ _ X Y R) + (@kzero_uub _ _ X Y R). + +HB.factory Record Kernel_isSFinite d d' + (X : measurableType d) (Y : measurableType d') (R : realType) + (k : X -> {measure set Y -> \bar R}) of isKernel _ _ _ _ _ k := { + sfinite : exists s : (R.-fker X ~> Y)^nat, + forall x U, measurable U -> k x U = kseries s x U }. + +HB.builders Context d d' (X : measurableType d) (Y : measurableType d') + (R : realType) k of Kernel_isSFinite d d' X Y R k. + +Lemma sfinite_subdef : Kernel_isSFinite_subdef d d' X Y R k. +Proof. +split; have [s sE] := sfinite; exists s => //. +by move=> n; exact: measure_uub. +Qed. + +HB.instance Definition _ := (*@isSFinite0.Build d d' X Y R k*) sfinite_subdef. + +HB.end. + +Section sfkseries. +Context d d' (X : measurableType d) (Y : measurableType d') (R : realType). +Variables k : (R.-sfker X ~> Y)^nat. + +Let sfinite_kseries : exists2 k_ : (R.-ker _ ~> _)^nat, + forall n, measure_fam_uub (k_ n) & + forall x U, measurable U -> kseries k x U = mseries (k_ ^~ x) 0 U. +Proof. +have /ppcard_eqP[f] : ([set: nat] #= [set: nat * nat])%card. + by rewrite card_eq_sym; exact: card_nat2. +pose p n : (R.-fker X ~> Y)^nat := sval (cid (sfinite_kernel (k n))). +exists (fun i => p (f i).1 (f i).2). + move=> n; have [r Hr] := measure_uub (p (f n).1 (f n).2). + by exists r => x /=; exact: Hr. +move=> x U mU; rewrite /kseries /mseries/= /mseries/=. +have kE i : k i x U = \sum_(j k_ ->. +transitivity (\esum_(l in [set: nat] `*` [set: nat]) p l.1 l.2 x U). + rewrite (_ : _ `*` _ = setT `*`` (fun=> setT)); last by apply/seteqP; split. + rewrite -(@esum_esum _ _ _ _ _ (fun i j => p i j x U))//. + rewrite nneseries_esum// -fun_true; apply: eq_esum => i _. + by rewrite kE// nneseries_esum. +rewrite (reindex_esum [set: nat] _ f)//; last first. + have := @bijTT _ _ f. + by rewrite -setTT_bijective/= -[in X in set_bij _ X _ -> _](@setMTT nat nat). +by rewrite nneseries_esum// fun_true; exact: eq_esum. +Qed. + +HB.instance Definition _ := + Kernel_isSFinite_subdef.Build _ _ _ _ R (kseries k) sfinite_kseries. +End sfkseries. + +HB.mixin Record FiniteKernel_isSubProbability d d' + (X : measurableType d) (Y : measurableType d') (R : realType) + (k : X -> {measure set Y -> \bar R}) := { + sprob_kernel : ereal_sup [set k x [set: Y] | x in [set: X]] <= 1 }. + +#[short(type=sprobability_kernel)] +HB.structure Definition SubProbabilityKernel + d d' (X : measurableType d) (Y : measurableType d') (R : realType) := + { k of @FiniteKernel _ _ _ _ _ k & + FiniteKernel_isSubProbability _ _ X Y R k }. +Notation "R .-spker X ~> Y" := (sprobability_kernel X%type Y R). + +HB.factory Record Kernel_isSubProbability d d' + (X : measurableType d) (Y : measurableType d') (R : realType) + (k : X -> {measure set Y -> \bar R}) of isKernel _ _ X Y R k := { + sprob_kernel : ereal_sup [set k x [set: Y] | x in [set: X]] <= 1 }. + +HB.builders Context d d' (X : measurableType d) (Y : measurableType d') + (R : realType) k of Kernel_isSubProbability d d' X Y R k. + +Let finite : @Kernel_isFinite d d' X Y R k. +Proof. +split; exists 2%R => /= ?; rewrite (@le_lt_trans _ _ 1%:E) ?lte_fin ?ltr1n//. +by rewrite (le_trans _ sprob_kernel)//; exact: ereal_sup_ub. +Qed. + +HB.instance Definition _ := finite. + +HB.instance Definition _ := + @FiniteKernel_isSubProbability.Build _ _ _ _ _ k sprob_kernel. + +HB.end. + +HB.mixin Record SubProbability_isProbability d d' + (X : measurableType d) (Y : measurableType d') (R : realType) + (k : X -> {measure set Y -> \bar R}) := { + prob_kernel : forall x, k x [set: Y] = 1 }. + +#[short(type=probability_kernel)] +HB.structure Definition ProbabilityKernel d d' + (X : measurableType d) (Y : measurableType d') (R : realType) := + { k of @SubProbabilityKernel _ _ _ _ _ k & + SubProbability_isProbability _ _ X Y R k }. +Notation "R .-pker X ~> Y" := (probability_kernel X%type Y R). + +HB.factory Record Kernel_isProbability d d' + (X : measurableType d) (Y : measurableType d') (R : realType) + (k : X -> {measure set Y -> \bar R}) of isKernel _ _ X Y R k := { + prob_kernel : forall x, k x [set: Y] = 1 }. + +HB.builders Context d d' (X : measurableType d) (Y : measurableType d') + (R : realType) k of Kernel_isProbability d d' X Y R k. + +Let sprob_kernel : @Kernel_isSubProbability d d' X Y R k. +Proof. +by split; apply: ub_ereal_sup => x [y _ <-{x}]; rewrite prob_kernel. +Qed. + +HB.instance Definition _ := sprob_kernel. + +HB.instance Definition _ := + @SubProbability_isProbability.Build _ _ _ _ _ k prob_kernel. + +HB.end. + +Lemma finite_kernel_measure d d' (X : measurableType d) + (Y : measurableType d') (R : realType) (k : R.-fker X ~> Y) (x : X) : + fin_num_fun (k x). +Proof. +have [r k_r] := measure_uub k. +by apply: lty_fin_num_fun; rewrite (@lt_trans _ _ r%:E) ?ltey. +Qed. + +(* see measurable_prod_subset in lebesgue_integral.v; + the differences between the two are: + - m2 is a kernel instead of a measure (the proof uses the + measurability of each measure of the family) + - as a consequence, m2D_bounded holds for all x *) +Section measurable_prod_subset_kernel. +Context d d' (X : measurableType d) (Y : measurableType d') (R : realType). +Implicit Types A : set (X * Y). + +Section xsection_kernel. +Variable (k : R.-ker X ~> Y) (D : set Y) (mD : measurable D). +Let kD x := mrestr (k x) mD. +HB.instance Definition _ x := Measure.on (kD x). +Let phi A := fun x => kD x (xsection A x). +Let XY := [set A | measurable A /\ measurable_fun [set: X] (phi A)]. + +Let phiM (A : set X) B : phi (A `*` B) = (fun x => kD x B * (\1_A x)%:E). +Proof. +rewrite funeqE => x; rewrite indicE /phi/=. +have [xA|xA] := boolP (x \in A); first by rewrite mule1 in_xsectionM. +by rewrite mule0 notin_xsectionM// set0I measure0. +Qed. + +Lemma measurable_prod_subset_xsection_kernel : + (forall x, exists M, forall X, measurable X -> kD x X < M%:E) -> + measurable `<=` XY. +Proof. +move=> kD_ub; rewrite measurable_prod_measurableType. +set C := [set A `*` B | A in measurable & B in measurable]. +have CI : setI_closed C. + move=> _ _ [X1 mX1 [X2 mX2 <-]] [Y1 mY1 [Y2 mY2 <-]]. + exists (X1 `&` Y1); first exact: measurableI. + by exists (X2 `&` Y2); [exact: measurableI|rewrite setMI]. +have CT : C setT by exists setT => //; exists setT => //; rewrite setMTT. +have CXY : C `<=` XY. + move=> _ [A mA [B mB <-]]; split; first exact: measurableM. + rewrite phiM. + apply: emeasurable_funM => //; first exact/measurable_kernel/measurableI. + by apply/EFin_measurable_fun; rewrite (_ : \1_ _ = mindic R mA). +suff monoB : monotone_class setT XY by exact: monotone_class_subset. +split => //; [exact: CXY| |exact: xsection_ndseq_closed]. +move=> A B BA [mA mphiA] [mB mphiB]; split; first exact: measurableD. +suff : phi (A `\` B) = (fun x => phi A x - phi B x). + by move=> ->; exact: emeasurable_funB. +rewrite funeqE => x; rewrite /phi/= xsectionD// measureD. +- by rewrite setIidr//; exact: le_xsection. +- exact: measurable_xsection. +- exact: measurable_xsection. +- have [M kM] := kD_ub x. + rewrite (lt_le_trans (kM (xsection A x) _)) ?leey//. + exact: measurable_xsection. +Qed. + +End xsection_kernel. + +End measurable_prod_subset_kernel. + +(* see measurable_fun_xsection in lebesgue_integral.v + the difference is that this section uses a finite kernel m2 + instead of a sigma-finite measure m2 *) +Section measurable_fun_xsection_finite_kernel. +Context d d' (X : measurableType d) (Y : measurableType d') (R : realType). +Variable k : R.-fker X ~> Y. +Implicit Types A : set (X * Y). + +Let phi A := fun x => k x (xsection A x). +Let XY := [set A | measurable A /\ measurable_fun [set: X] (phi A)]. + +Lemma measurable_fun_xsection_finite_kernel A : + A \in measurable -> measurable_fun [set: X] (phi A). +Proof. +move: A; suff : measurable `<=` XY by move=> + A; rewrite inE => /[apply] -[]. +move=> /= A mA; rewrite /XY/=; split => //; rewrite (_ : phi _ = + (fun x => mrestr (k x) measurableT (xsection A x))); last first. + by apply/funext => x//=; rewrite /mrestr setIT. +apply measurable_prod_subset_xsection_kernel => // x. +have [r hr] := measure_uub k; exists r => B mB. +by rewrite (le_lt_trans _ (hr x)) // /mrestr /= setIT le_measure// inE. +Qed. + +End measurable_fun_xsection_finite_kernel. + +Section measurable_fun_integral_finite_sfinite. +Context d d' (X : measurableType d) (Y : measurableType d') (R : realType). +Variable k : X * Y -> \bar R. + +Lemma measurable_fun_xsection_integral + (l : X -> {measure set Y -> \bar R}) + (k_ : ({nnsfun [the measurableType _ of X * Y] >-> R})^nat) + (ndk_ : nondecreasing_seq (k_ : (X * Y -> R)^nat)) + (k_k : forall z, (k_ n z)%:E @[n --> \oo] --> k z) : + (forall n r, + measurable_fun [set: X] (fun x => l x (xsection (k_ n @^-1` [set r]) x))) -> + measurable_fun [set: X] (fun x => \int[l x]_y k (x, y)). +Proof. +move=> h. +rewrite (_ : (fun x => _) = + (fun x => limn_esup (fun n => \int[l x]_y (k_ n (x, y))%:E))); last first. + apply/funext => x. + transitivity (lim (\int[l x]_y (k_ n (x, y))%:E @[n --> \oo])); last first. + rewrite is_cvg_limn_esupE//. + apply: ereal_nondecreasing_is_cvgn => m n mn. + apply: ge0_le_integral => //. + - by move=> y _; rewrite lee_fin. + - exact/EFin_measurable_fun/measurableT_comp. + - by move=> y _; rewrite lee_fin. + - exact/EFin_measurable_fun/measurableT_comp. + - by move=> y _; rewrite lee_fin; exact/lefP/ndk_. + rewrite -monotone_convergence//. + - by apply: eq_integral => y _; apply/esym/cvg_lim => //; exact: k_k. + - by move=> n; exact/EFin_measurable_fun/measurableT_comp. + - by move=> n y _; rewrite lee_fin. + - by move=> y _ m n mn; rewrite lee_fin; exact/lefP/ndk_. +apply: measurable_fun_limn_esup => n. +rewrite [X in measurable_fun _ X](_ : _ = (fun x => \int[l x]_y + (\sum_(r \in range (k_ n)) + r * \1_(k_ n @^-1` [set r]) (x, y))%:E)); last first. + by apply/funext => x; apply: eq_integral => y _; rewrite fimfunE. +rewrite [X in measurable_fun _ X](_ : _ = (fun x => \sum_(r \in range (k_ n)) + (\int[l x]_y (r * \1_(k_ n @^-1` [set r]) (x, y))%:E))); last first. + apply/funext => x; rewrite -ge0_integral_fsum//. + - by apply: eq_integral => y _; rewrite -fsumEFin. + - move=> r. + apply/EFin_measurable_fun/measurableT_comp => [//|]. + exact/measurableT_comp. + - by move=> m y _; rewrite nnfun_muleindic_ge0. +apply: emeasurable_fun_fsum => // r. +rewrite [X in measurable_fun _ X](_ : _ = (fun x => r%:E * + \int[l x]_y (\1_(k_ n @^-1` [set r]) (x, y))%:E)); last first. + apply/funext => x; under eq_integral do rewrite EFinM. + have [r0|r0] := leP 0%R r. + rewrite ge0_integralZl//; last by move=> y _; rewrite lee_fin. + exact/EFin_measurable_fun/measurableT_comp. + rewrite integral0_eq; last first. + by move=> y _; rewrite preimage_nnfun0// indic0 mule0. + by rewrite integral0_eq ?mule0// => y _; rewrite preimage_nnfun0// indic0. +apply/measurable_funeM. +rewrite (_ : (fun x => _) = (fun x => l x (xsection (k_ n @^-1` [set r]) x))). + exact/h. +apply/funext => x; rewrite integral_indic//; last first. + rewrite (_ : (fun x => _) = xsection (k_ n @^-1` [set r]) x). + exact: measurable_xsection. + by rewrite /xsection; apply/seteqP; split=> y/= /[!inE]. +congr (l x _); apply/funext => y1/=; rewrite /xsection/= inE. +by apply/propext; tauto. +Qed. + +Lemma measurable_fun_integral_finite_kernel (l : R.-fker X ~> Y) + (k0 : forall z, 0 <= k z) (mk : measurable_fun [set: X * Y] k) : + measurable_fun [set: X] (fun x => \int[l x]_y k (x, y)). +Proof. +have [k_ [ndk_ k_k]] := approximation measurableT mk (fun x _ => k0 x). +apply: (measurable_fun_xsection_integral ndk_ (k_k ^~ Logic.I)) => n r. +have [l_ hl_] := measure_uub l. +by apply: measurable_fun_xsection_finite_kernel => // /[!inE]. +Qed. + +Lemma measurable_fun_integral_sfinite_kernel (l : R.-sfker X ~> Y) + (k0 : forall t, 0 <= k t) (mk : measurable_fun [set: X * Y] k) : + measurable_fun [set: X] (fun x => \int[l x]_y k (x, y)). +Proof. +have [k_ [ndk_ k_k]] := approximation measurableT mk (fun xy _ => k0 xy). +apply: (measurable_fun_xsection_integral ndk_ (k_k ^~ Logic.I)) => n r. +have [l_ hl_] := sfinite_kernel l. +rewrite (_ : (fun x => _) = (fun x => + mseries (l_ ^~ x) 0 (xsection (k_ n @^-1` [set r]) x))); last first. + by apply/funext => x; rewrite hl_//; exact/measurable_xsection. +apply: ge0_emeasurable_fun_sum => // m. +by apply: measurable_fun_xsection_finite_kernel => // /[!inE]. +Qed. + +End measurable_fun_integral_finite_sfinite. +Arguments measurable_fun_xsection_integral {_ _ _ _ _} k l. +Arguments measurable_fun_integral_finite_kernel {_ _ _ _ _} k l. +Arguments measurable_fun_integral_sfinite_kernel {_ _ _ _ _} k l. + +Section kdirac. +Context d d' (X : measurableType d) (Y : measurableType d') (R : realType). +Variable f : X -> Y. + +Definition kdirac (mf : measurable_fun [set: X] f) + : X -> {measure set Y -> \bar R} := + fun x => [the measure _ _ of dirac (f x)]. + +Hypothesis mf : measurable_fun [set: X] f. + +Let measurable_fun_kdirac U : measurable U -> + measurable_fun [set: X] (kdirac mf ^~ U). +Proof. +move=> mU; apply/EFin_measurable_fun. +by rewrite (_ : (fun x => _) = mindic R mU \o f)//; exact/measurableT_comp. +Qed. + +HB.instance Definition _ := isKernel.Build _ _ _ _ _ (kdirac mf) + measurable_fun_kdirac. + +Let kdirac_prob x : kdirac mf x setT = 1. +Proof. by rewrite /kdirac/= diracT. Qed. + +HB.instance Definition _ := Kernel_isProbability.Build _ _ _ _ _ + (kdirac mf) kdirac_prob. + +End kdirac. +Arguments kdirac {d d' X Y R f}. + +Section dist_salgebra_instance. +Context d (T : measurableType d) (R : realType). + +Let p0 : probability T R := [the probability _ _ of dirac point]. + +HB.instance Definition _ := gen_eqMixin (probability T R). +HB.instance Definition _ := gen_choiceMixin (probability T R). +HB.instance Definition _ := isPointed.Build (probability T R) p0. + +Definition mset (U : set T) (r : R) := [set mu : probability T R | mu U < r%:E]. + +Lemma lt0_mset (U : set T) (r : R) : (r < 0)%R -> mset U r = set0. +Proof. +move=> r0; apply/seteqP; split => // x/=. +by apply/negP; rewrite -leNgt (@le_trans _ _ 0)// lee_fin ltW. +Qed. + +Lemma gt1_mset (U : set T) (r : R) : + measurable U -> (1 < r)%R -> mset U r = [set: probability T R]. +Proof. +move=> mU r1; apply/seteqP; split => // x/= _. +by rewrite /mset/= (le_lt_trans (probability_le1 _ _)). +Qed. + +Definition pset : set (set (probability T R)) := + [set mset U r | r in `[0%R,1%R] & U in measurable]. + +Definition pprobability : measurableType pset.-sigma := + [the measurableType _ of salgebraType pset]. + +End dist_salgebra_instance. + +Section kprobability. +Context d d' (X : measurableType d) (Y : measurableType d') (R : realType). +Variable P : X -> pprobability Y R. + +Definition kprobability (mP : measurable_fun [set: X] P) + : X -> {measure set Y -> \bar R} := P. + +Hypothesis mP : measurable_fun [set: X] P. + +Let measurable_fun_kprobability U : measurable U -> + measurable_fun [set: X] (kprobability mP ^~ U). +Proof. +move=> mU. +apply: (measurability (ErealGenInftyO.measurableE R)) => _ /= -[_ [r ->] <-]. +rewrite setTI preimage_itv_infty_o -/(P @^-1` mset U r). +have [r0|r0] := leP 0%R r; last by rewrite lt0_mset// preimage_set0. +have [r1|r1] := leP r 1%R; last by rewrite gt1_mset// preimage_setT. +move: mP => /(_ measurableT (mset U r)); rewrite setTI; apply. +by apply: sub_sigma_algebra; exists r => /=; [rewrite in_itv/= r0|exists U]. +Qed. + +HB.instance Definition _ := + @isKernel.Build _ _ X Y R (kprobability mP) measurable_fun_kprobability. + +Let kprobability_prob x : kprobability mP x [set: Y] = 1. +Proof. by rewrite /kprobability/= probability_setT. Qed. + +HB.instance Definition _ := + @Kernel_isProbability.Build _ _ X Y R (kprobability mP) kprobability_prob. + +End kprobability. + +Section kadd. +Context d d' (X : measurableType d) (Y : measurableType d') (R : realType). +Variables k1 k2 : R.-ker X ~> Y. + +Definition kadd : X -> {measure set Y -> \bar R} := + fun x => [the measure _ _ of measure_add (k1 x) (k2 x)]. + +Let measurable_fun_kadd U : measurable U -> + measurable_fun [set: X] (kadd ^~ U). +Proof. +move=> mU; rewrite /kadd. +rewrite (_ : (fun _ => _) = (fun x => k1 x U + k2 x U)); last first. + by apply/funext => x; rewrite -measure_addE. +by apply: emeasurable_funD; exact/measurable_kernel. +Qed. + +HB.instance Definition _ := + @isKernel.Build _ _ _ _ _ kadd measurable_fun_kadd. +End kadd. + +Section sfkadd. +Context d d' (X : measurableType d) (Y : measurableType d') (R : realType). +Variables k1 k2 : R.-sfker X ~> Y. + +Let sfinite_kadd : exists2 k_ : (R.-ker _ ~> _)^nat, + forall n, measure_fam_uub (k_ n) & + forall x U, measurable U -> + kadd k1 k2 x U = mseries (k_ ^~ x) 0 U. +Proof. +have [f1 hk1] := sfinite_kernel k1; have [f2 hk2] := sfinite_kernel k2. +exists (fun n => [the _.-ker _ ~> _ of kadd (f1 n) (f2 n)]). + move=> n. + have [r1 f1r1] := measure_uub (f1 n). + have [r2 f2r2] := measure_uub (f2 n). + exists (r1 + r2)%R => x/=. + by rewrite /msum !big_ord_recr/= big_ord0 add0e EFinD lte_add. +move=> x U mU. +rewrite /kadd/= -/(measure_add (k1 x) (k2 x)) measure_addE hk1//= hk2//=. +rewrite /mseries -nneseriesD//; apply: eq_eseriesr => n _ /=. +by rewrite -/(measure_add (f1 n x) (f2 n x)) measure_addE. +Qed. + +HB.instance Definition _ t := + Kernel_isSFinite_subdef.Build _ _ _ _ R (kadd k1 k2) sfinite_kadd. +End sfkadd. + +Section fkadd. +Context d d' (X : measurableType d) (Y : measurableType d') (R : realType). +Variables k1 k2 : R.-fker X ~> Y. + +Let kadd_finite_uub : measure_fam_uub (kadd k1 k2). +Proof. +have [f1 hk1] := measure_uub k1; have [f2 hk2] := measure_uub k2. +exists (f1 + f2)%R => x; rewrite /kadd /=. +rewrite -/(measure_add (k1 x) (k2 x)). +by rewrite measure_addE EFinD; exact: lte_add. +Qed. + +HB.instance Definition _ t := + Kernel_isFinite.Build _ _ _ _ R (kadd k1 k2) kadd_finite_uub. +End fkadd. + +Lemma measurable_fun_mnormalize d d' (X : measurableType d) + (Y : measurableType d') (R : realType) (k : R.-ker X ~> Y) : + measurable_fun [set: X] (fun x => + [the probability _ _ of mnormalize (k x) point] : pprobability Y R). +Proof. +apply: (@measurability _ _ _ _ _ _ + (@pset _ _ _ : set (set (pprobability Y R)))) => //. +move=> _ -[_ [r r01] [Ys mYs <-]] <-. +rewrite /mnormalize /mset /preimage/=. +apply: emeasurable_fun_infty_o => //. +rewrite /mnormalize/=. +rewrite (_ : (fun x => _) = (fun x => if (k x setT == 0) || (k x setT == +oo) + then \d_point Ys else k x Ys * ((fine (k x setT))^-1)%:E)); last first. + by apply/funext => x/=; case: ifPn. +apply: measurable_fun_if => //. +- apply: (measurable_fun_bool true) => //. + rewrite (_ : _ @^-1` _ = [set t | k t setT == 0] `|` + [set t | k t setT == +oo]); last first. + by apply/seteqP; split=> x /= /orP//. + by apply: measurableU; exact: kernel_measurable_eq_cst. +- apply/emeasurable_funM; first exact/measurable_funTS/measurable_kernel. + apply/EFin_measurable_fun; rewrite setTI. + apply: (@measurable_comp _ _ _ _ _ _ [set r : R | r != 0%R]). + + exact: open_measurable. + + by move=> /= _ [x /norP[s0 soo]] <-; rewrite -eqe fineK ?ge0_fin_numE ?ltey. + + apply: open_continuous_measurable_fun => //; apply/in_setP => x /= x0. + exact: inv_continuous. + + by apply: measurableT_comp => //; exact/measurable_funS/measurable_kernel. +Qed. + +Section knormalize. +Context d d' (X : measurableType d) (Y : measurableType d') (R : realType). +Variable f : R.-ker X ~> Y. + +Definition knormalize (P : probability Y R) : X -> {measure set Y -> \bar R} := + fun x => [the measure _ _ of mnormalize (f x) P]. + +Variable P : probability Y R. + +Let measurable_fun_knormalize U : + measurable U -> measurable_fun [set: X] (knormalize P ^~ U). +Proof. +move=> mU; rewrite /knormalize/= /mnormalize /=. +rewrite (_ : (fun _ => _) = (fun x => + if f x setT == 0 then P U else if f x setT == +oo then P U + else f x U * (fine (f x setT))^-1%:E)); last first. + apply/funext => x; case: ifPn => [/orP[->//|->]|]; first by case: ifPn. + by rewrite negb_or=> /andP[/negbTE -> /negbTE ->]. +apply: measurable_fun_if => //; [exact: kernel_measurable_fun_eq_cst|]. +apply: measurable_fun_if => //. +- rewrite setTI [X in measurable X](_ : _ = [set t | f t setT != 0]). + exact: kernel_measurable_neq_cst. + by apply/seteqP; split => [x /negbT//|x /negbTE]. +- apply: (@measurable_funS _ _ _ _ setT) => //. + exact: kernel_measurable_fun_eq_cst. +- apply: emeasurable_funM. + by have := measurable_kernel f U mU; exact: measurable_funS. + apply/EFin_measurable_fun. + apply: (@measurable_comp _ _ _ _ _ _ [set r : R | r != 0%R]) => //. + + exact: open_measurable. + + move=> /= r [t] [] [_ ft0] ftoo ftr; apply/eqP => r0. + move: (ftr); rewrite r0 => /eqP; rewrite fine_eq0 ?ft0//. + by rewrite ge0_fin_numE// lt_neqAle leey ftoo. + + apply: open_continuous_measurable_fun => //; apply/in_setP => x /= x0. + exact: inv_continuous. + + apply: measurableT_comp => //=. + by have := measurable_kernel f _ measurableT; exact: measurable_funS. +Qed. + +HB.instance Definition _ := isKernel.Build _ _ _ _ R (knormalize P) + measurable_fun_knormalize. + +Let knormalize1 x : knormalize P x [set: Y] = 1. +Proof. by rewrite /knormalize/= probability_setT. Qed. + +HB.instance Definition _ := + @Kernel_isProbability.Build _ _ _ _ _ (knormalize P) knormalize1. + +End knormalize. + +Section kcomp_def. +Context d1 d2 d3 (X : measurableType d1) (Y : measurableType d2) + (Z : measurableType d3) (R : realType). +Variable l : X -> {measure set Y -> \bar R}. +Variable k : (X * Y)%type -> {measure set Z -> \bar R}. + +Definition kcomp x U := \int[l x]_y k (x, y) U. + +End kcomp_def. + +Section kcomp_is_measure. +Context d1 d2 d3 (X : measurableType d1) (Y : measurableType d2) + (Z : measurableType d3) (R : realType). +Variable l : R.-ker X ~> Y. +Variable k : R.-ker [the measurableType _ of X * Y] ~> Z. + +Let kcomp0 x : kcomp l k x set0 = 0. +Proof. +by rewrite /kcomp (eq_integral (cst 0)) ?integral0// => y _; rewrite measure0. +Qed. + +Let kcomp_ge0 x U : 0 <= kcomp l k x U. Proof. exact: integral_ge0. Qed. + +Let kcomp_sigma_additive x : semi_sigma_additive (kcomp l k x). +Proof. +move=> U mU tU mUU; rewrite [X in _ --> X](_ : _ = + \int[l x]_y (\sum_(n V _. + by apply/esym/cvg_lim => //; exact/measure_semi_sigma_additive. +apply/cvg_closeP; split. + by apply: is_cvg_nneseries => n _; exact: integral_ge0. +rewrite closeE// integral_nneseries// => n. +exact: measurableT_comp (measurable_kernel k _ (mU n)) _. +Qed. + +HB.instance Definition _ x := isMeasure.Build _ _ R + (kcomp l k x) (kcomp0 x) (kcomp_ge0 x) (@kcomp_sigma_additive x). + +Definition mkcomp : X -> {measure set Z -> \bar R} := fun x => + [the measure _ _ of kcomp l k x]. + +End kcomp_is_measure. + +Notation "l \; k" := (mkcomp l k) : ereal_scope. + +Module KCOMP_FINITE_KERNEL. + +Section kcomp_finite_kernel_kernel. +Context d d' d3 (X : measurableType d) (Y : measurableType d') + (Z : measurableType d3) (R : realType) (l : R.-fker X ~> Y) + (k : R.-ker [the measurableType _ of X * Y] ~> Z). + +Lemma measurable_fun_kcomp_finite U : + measurable U -> measurable_fun [set: X] ((l \; k) ^~ U). +Proof. +move=> mU; apply: (measurable_fun_integral_finite_kernel (k ^~ U)) => //=. +exact/measurable_kernel. +Qed. + +HB.instance Definition _ := + isKernel.Build _ _ X Z R (l \; k) measurable_fun_kcomp_finite. + +End kcomp_finite_kernel_kernel. + +Section kcomp_finite_kernel_finite. +Context d d' d3 (X : measurableType d) (Y : measurableType d') + (Z : measurableType d3) (R : realType). +Variable l : R.-fker X ~> Y. +Variable k : R.-fker [the measurableType _ of X * Y] ~> Z. + +Let mkcomp_finite : measure_fam_uub (kcomp l k). +Proof. +have /measure_fam_uubP[r hr] := measure_uub k. +have /measure_fam_uubP[s hs] := measure_uub l. +apply/measure_fam_uubP; exists (PosNum [gt0 of (r%:num * s%:num)%R]) => x /=. +apply: (@le_lt_trans _ _ (\int[l x]__ r%:num%:E)). + apply: ge0_le_integral => //. + - exact: measurableT_comp (measurable_kernel k _ measurableT) _. + - by move=> y _; exact/ltW/hr. +by rewrite integral_cst//= EFinM lte_pmul2l. +Qed. + +HB.instance Definition _ := + Kernel_isFinite.Build _ _ X Z R (l \; k) mkcomp_finite. + +End kcomp_finite_kernel_finite. +End KCOMP_FINITE_KERNEL. + +Section kcomp_sfinite_kernel. +Context d d' d3 (X : measurableType d) (Y : measurableType d') + (Z : measurableType d3) (R : realType). +Variable l : R.-sfker X ~> Y. +Variable k : R.-sfker [the measurableType _ of X * Y] ~> Z. + +Import KCOMP_FINITE_KERNEL. + +Lemma mkcomp_sfinite : exists k_ : (R.-fker X ~> Z)^nat, + forall x U, measurable U -> (l \; k) x U = kseries k_ x U. +Proof. +have [k_ hk_] := sfinite_kernel k; have [l_ hl_] := sfinite_kernel l. +have [kl hkl] : exists kl : (R.-fker X ~> Z) ^nat, forall x U, + \esum_(i in setT) (l_ i.2 \; k_ i.1) x U = \sum_(i [the _.-fker _ ~> _ of l_ (f i).2 \; k_ (f i).1]) => x U. + by rewrite (reindex_esum [set: nat] _ f)// nneseries_esum// fun_true. +exists kl => x U mU. +transitivity (([the _.-ker _ ~> _ of kseries l_] \; + [the _.-ker _ ~> _ of kseries k_]) x U). + rewrite /= /kcomp [in RHS](eq_measure_integral (l x)); last first. + by move=> *; rewrite hl_. + by apply: eq_integral => y _; rewrite hk_. +rewrite /= /kcomp/= integral_nneseries//=; last first. + by move=> n; exact: measurableT_comp (measurable_kernel (k_ n) _ mU) _. +transitivity (\sum_(i i _; rewrite integral_kseries//. + by exact: measurableT_comp (measurable_kernel (k_ i) _ mU) _. +rewrite /mseries -hkl/=. +rewrite (_ : setT = setT `*`` (fun=> setT)); last by apply/seteqP; split. +rewrite -(@esum_esum _ _ _ _ _ (fun i j => (l_ j \; k_ i) x U))//. +rewrite nneseries_esum; last by move=> n _; exact: nneseries_ge0. +by rewrite fun_true; apply: eq_esum => /= i _; rewrite nneseries_esum// fun_true. +Qed. + +Lemma measurable_fun_mkcomp_sfinite U : measurable U -> + measurable_fun [set: X] ((l \; k) ^~ U). +Proof. +move=> mU; apply: (measurable_fun_integral_sfinite_kernel (k ^~ U)) => //. +exact/measurable_kernel. +Qed. + +End kcomp_sfinite_kernel. + +Module KCOMP_SFINITE_KERNEL. +Section kcomp_sfinite_kernel. +Context d d' d3 (X : measurableType d) (Y : measurableType d') + (Z : measurableType d3) (R : realType). +Variable l : R.-sfker X ~> Y. +Variable k : R.-sfker [the measurableType _ of X * Y] ~> Z. + +HB.instance Definition _ := + isKernel.Build _ _ X Z R (l \; k) (measurable_fun_mkcomp_sfinite l k). + +#[export] +HB.instance Definition _ := + Kernel_isSFinite.Build _ _ X Z R (l \; k) (mkcomp_sfinite l k). + +End kcomp_sfinite_kernel. +End KCOMP_SFINITE_KERNEL. +HB.export KCOMP_SFINITE_KERNEL. + +Section measurable_fun_preimage_integral. +Context d d' (X : measurableType d) (Y : measurableType d') (R : realType). +Variables (k : Y -> \bar R) + (k_ : ({nnsfun Y >-> R}) ^nat) + (ndk_ : nondecreasing_seq (k_ : (Y -> R)^nat)) + (k_k : forall z, [set: Y] z -> (k_ n z)%:E @[n --> \oo] --> k z). + +Let k_2 : (X * Y -> R)^nat := fun n => k_ n \o snd. + +Let k_2_ge0 n x : (0 <= k_2 n x)%R. Proof. by []. Qed. + +HB.instance Definition _ n := @isNonNegFun.Build _ _ _ (k_2_ge0 n). + +Let mk_2 n : measurable_fun [set: X * Y] (k_2 n). +Proof. by apply: measurableT_comp => //; exact: measurable_snd. Qed. + +HB.instance Definition _ n := @isMeasurableFun.Build _ _ _ _ (mk_2 n). + +Let fk_2 n : finite_set (range (k_2 n)). +Proof. +have := fimfunP (k_ n). +suff : range (k_ n) = range (k_2 n) by move=> <-. +by apply/seteqP; split => r [y ?] <-; [exists (point, y)|exists y.2]. +Qed. + +HB.instance Definition _ n := @FiniteImage.Build _ _ _ (fk_2 n). + +Lemma measurable_fun_preimage_integral (l : X -> {measure set Y -> \bar R}) : + (forall n r, measurable_fun [set: X] (l ^~ (k_ n @^-1` [set r]))) -> + measurable_fun [set: X] (fun x => \int[l x]_z k z). +Proof. +move=> h; apply: (measurable_fun_xsection_integral (k \o snd) l + (fun n => [the {nnsfun _ >-> _} of k_2 n])) => /=. +- by rewrite /k_2 => m n mn; apply/lefP => -[x y] /=; exact/lefP/ndk_. +- by move=> [x y]; exact: k_k. +- move=> n r _ /= B mB. + have := h n r measurableT B mB; rewrite !setTI. + suff : (l ^~ (k_ n @^-1` [set r])) @^-1` B = + (fun x => l x (xsection (k_2 n @^-1` [set r]) x)) @^-1` B by move=> ->. + by apply/seteqP; split => x/=; + rewrite (comp_preimage _ snd (k_ n)) xsection_preimage_snd. +Qed. + +End measurable_fun_preimage_integral. + +Lemma measurable_fun_integral_kernel + d d' (X : measurableType d) (Y : measurableType d') (R : realType) + (l : X -> {measure set Y -> \bar R}) + (ml : forall U, measurable U -> measurable_fun [set: X] (l ^~ U)) + (* NB: l is really just a kernel *) + (k : Y -> \bar R) (k0 : forall z, 0 <= k z) (mk : measurable_fun [set: Y] k) : + measurable_fun [set: X] (fun x => \int[l x]_y k y). +Proof. +have [k_ [ndk_ k_k]] := approximation measurableT mk (fun x _ => k0 x). +by apply: (measurable_fun_preimage_integral ndk_ k_k) => n r; exact/ml. +Qed. + +Section integral_kcomp. +Context d d2 d3 (X : measurableType d) (Y : measurableType d2) + (Z : measurableType d3) (R : realType). +Variables (l : R.-sfker X ~> Y) + (k : R.-sfker [the measurableType _ of X * Y] ~> Z). + +Let integral_kcomp_indic x E (mE : measurable E) : + \int[kcomp l k x]_z (\1_E z)%:E = \int[l x]_y (\int[k (x, y)]_z (\1_E z)%:E). +Proof. +rewrite integral_indic//= /kcomp. +by apply: eq_integral => y _; rewrite integral_indic. +Qed. + +Let integral_kcomp_nnsfun x (f : {nnsfun Z >-> R}) : + \int[kcomp l k x]_z (f z)%:E = \int[l x]_y (\int[k (x, y)]_z (f z)%:E). +Proof. +under [in LHS]eq_integral do rewrite fimfunE -fsumEFin//. +rewrite ge0_integral_fsum//; last 2 first. + - move=> r; apply/EFin_measurable_fun/measurableT_comp => [//|]. + have fr : measurable (f @^-1` [set r]) by exact/measurable_sfunP. + by rewrite (_ : \1__ = mindic R fr). + - by move=> r z _; rewrite EFinM nnfun_muleindic_ge0. +under [in RHS]eq_integral. + move=> y _. + under eq_integral. + by move=> z _; rewrite fimfunE -fsumEFin//; over. + rewrite /= ge0_integral_fsum//; last 2 first. + - move=> r; apply/EFin_measurable_fun/measurableT_comp => [//|]. + have fr : measurable (f @^-1` [set r]) by exact/measurable_sfunP. + by rewrite (_ : \1__ = mindic R fr). + - by move=> r z _; rewrite EFinM nnfun_muleindic_ge0. + under eq_fsbigr. + move=> r _. + rewrite (integralZl_indic _ (fun r => f @^-1` [set r]))//; last first. + by move=> r0; rewrite preimage_nnfun0. + rewrite integral_indic// setIT. + over. + over. +rewrite /= ge0_integral_fsum//; last 2 first. + - move=> r; apply: measurable_funeM. + exact: measurableT_comp (measurable_kernel k (f @^-1` [set r]) _) _. + - move=> n y _. + have := mulemu_ge0 (fun n => f @^-1` [set n]). + by apply; exact: preimage_nnfun0. +apply: eq_fsbigr => r _. +rewrite (integralZl_indic _ (fun r => f @^-1` [set r]))//; last first. + exact: preimage_nnfun0. +rewrite /= integral_kcomp_indic; last exact/measurable_sfunP. +have [r0|r0] := leP 0%R r. + rewrite ge0_integralZl//; last first. + exact: measurableT_comp (measurable_kernel k (f @^-1` [set r]) _) _. + by congr (_ * _); apply: eq_integral => y _; rewrite integral_indic// setIT. +rewrite integral0_eq ?mule0; last first. + move=> y _; rewrite integral0_eq// => z _. + by rewrite preimage_nnfun0// indic0. +by rewrite integral0_eq// => y _; rewrite preimage_nnfun0// measure0 mule0. +Qed. + +Lemma integral_kcomp x f : (forall z, 0 <= f z) -> measurable_fun [set: Z] f -> + \int[kcomp l k x]_z f z = \int[l x]_y (\int[k (x, y)]_z f z). +Proof. +move=> f0 mf. +have [f_ [ndf_ f_f]] := approximation measurableT mf (fun z _ => f0 z). +transitivity (\int[kcomp l k x]_z (lim ((f_ n z)%:E @[n --> \oo]))). + by apply/eq_integral => z _; apply/esym/cvg_lim => //=; exact: f_f. +rewrite monotone_convergence//; last 3 first. + by move=> n; exact/EFin_measurable_fun. + by move=> n z _; rewrite lee_fin. + by move=> z _ a b /ndf_ /lefP ab; rewrite lee_fin. +rewrite (_ : (fun _ => _) = + (fun n => \int[l x]_y (\int[k (x, y)]_z (f_ n z)%:E)))//; last first. + by apply/funext => n; rewrite integral_kcomp_nnsfun. +transitivity (\int[l x]_y lim ((\int[k (x, y)]_z (f_ n z)%:E) @[n --> \oo])). + rewrite -monotone_convergence//; last 3 first. + - move=> n; apply: measurable_fun_integral_kernel => //. + + by move=> U mU; exact: measurableT_comp (measurable_kernel k _ mU) _. + + by move=> z; rewrite lee_fin. + + exact/EFin_measurable_fun. + - by move=> n y _; apply: integral_ge0 => // z _; rewrite lee_fin. + - move=> y _ a b ab; apply: ge0_le_integral => //. + + by move=> z _; rewrite lee_fin. + + exact/EFin_measurable_fun. + + by move=> z _; rewrite lee_fin. + + exact/EFin_measurable_fun. + + by move: ab => /ndf_ /lefP ab z _; rewrite lee_fin. +apply: eq_integral => y _; rewrite -monotone_convergence//; last 3 first. + - by move=> n; exact/EFin_measurable_fun. + - by move=> n z _; rewrite lee_fin. + - by move=> z _ a b /ndf_ /lefP; rewrite lee_fin. +by apply: eq_integral => z _; apply/cvg_lim => //; exact: f_f. +Qed. + +End integral_kcomp. diff --git a/theories/landau.v b/theories/landau.v index 5a001ac51..c9fb5b13a 100644 --- a/theories/landau.v +++ b/theories/landau.v @@ -1,26 +1,22 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) +From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrnum. -From mathcomp.classical Require Import boolp classical_sets functions. -From mathcomp.classical Require Import mathcomp_extra. +From mathcomp Require Import mathcomp_extra boolp classical_sets functions. Require Import ereal reals signed topology normedtype prodnormedzmodule. -(******************************************************************************) -(* BACHMANN-LANDAU NOTATIONS : BIG AND LITTLE O *) -(******************************************************************************) -(******************************************************************************) -(* F is a filter, K is an absRingType and V W X Y Z are normed spaces over K *) -(* alternatively, K can be equal to the reals R (from the standard library *) -(* for now) *) +(**md**************************************************************************) +(* # Bachmann-Landau notations: $f=o(e)$, $f=O(e)$ *) +(* *) (* This library is very asymmetric, in multiple respects: *) (* - most rewrite rules can only be rewritten from left to right. *) -(* e.g. an equation 'o_F f = 'O_G g can be used only from LEFT TO RIGHT *) +(* e.g., an equation 'o_F f = 'O_G g can be used only from LEFT TO RIGHT *) (* - conversely most small 'o_F f in your goal are very specific, *) (* only 'a_F f is mutable *) (* *) -(* - most notations are either parse only or print only. *) -(* Indeed all the 'O_F notations contain a function which is NOT displayed. *) -(* This might be confusing as sometimes you might get 'O_F g = 'O_F g *) -(* and not be able to solve by reflexivity. *) +(* Most notations are either parse only or print only. *) +(* Indeed all the 'O_F notations contain a function which is NOT displayed. *) +(* This might be confusing as sometimes you might get 'O_F g = 'O_F g *) +(* and not be able to solve by reflexivity. *) (* - In order to have a look at the hidden function, rewrite showo. *) (* - Do not use showo during a normal proof. *) (* - All theorems should be stated so that when an impossible reflexivity *) @@ -28,12 +24,15 @@ Require Import ereal reals signed topology normedtype prodnormedzmodule. (* know you should use eqOE in order to generalize your 'O_F g *) (* to an arbitrary 'O_F g *) (* *) +(* In this file, F is a filter and V W X Y Z are normed spaces over K. *) +(* *) (* To prove that f is a bigO of g near F, you should go back to filter *) (* reasoning only as a last resort. To do so, use the view eqOP. Similarly, *) (* you can use eqaddOP to prove that f is equal to g plus a bigO of e near F *) (* using filter reasoning. *) (* *) -(* Parsable notations: *) +(* ## Parsable notations *) +(* ``` *) (* [bigO of f] == recovers the canonical structure of big-o of f *) (* expands to itself *) (* f =O_F h == f is a bigO of h near F, *) @@ -57,37 +56,44 @@ Require Import ereal reals signed topology normedtype prodnormedzmodule. (* 'O == pattern to match a bigO with a generic F *) (* f x =O_(x \near F) e x == alternative way of stating f =O_F e (provably *) (* equal using the lemma eqOEx *) +(* ``` *) +(* *) +(* WARNING: The piece of syntax "=O_(" is only valid in the syntax *) +(* "=O_(x \near F)", not in the syntax "=O_(x : U)". *) (* *) -(* Printing only notations: *) +(* ## Printing only notations: *) +(* ``` *) (* {O_F f} == the type of functions that are a bigO of f near F *) (* 'a_O_F f == an existential bigO, must come from (apply: eqOE) *) (* 'O_F f == a generic bigO, with a function you should not rely on, *) (* but there is no way you can use eqOE on it. *) +(* ``` *) +(* The former works exactly same by with littleo instead of bigO. *) (* *) -(* The former works exactly the same by with littleo instead of bigO. *) -(* *) -(* Asymptotic equivalence: *) +(* ## Asymptotic equivalence *) +(* ``` *) (* f ~_ F g == function f is asymptotically equivalent to *) (* function g for filter F, i.e., f = g +o_ F g *) (* f ~~_ F g == f == g +o_ F g (i.e., as a boolean relation) *) -(* --> asymptotic equivalence proved to be an equivalence relation *) +(* ``` *) +(* Asymptotic equivalence is proved to be an equivalence relation. *) (* *) -(* Big-Omega and big-Theta notations on the model of bigO and littleo: *) -(* {Omega_F f} == the type of functions that are a big Omega of f near F *) -(* [bigOmega of f] == recovers the canonical structure of big-Omega of f *) -(* [Omega_F e of f] == returns a function with a bigOmega canonical structure *) -(* provably equal to f if f is indeed a bigOmega of e *) -(* or e otherwise *) +(* ## Big-Omega and big-Theta notations on the model of bigO and littleo *) +(* ``` *) +(* {Omega_F f} == the type of functions that are a big Omega of f *) +(* near F *) +(* [bigOmega of f] == recovers the canonical structure of big-Omega of f *) +(* [Omega_F e of f] == returns a function with a bigOmega canonical *) +(* structure provably equal to f if f is indeed a *) +(* bigOmega of e or e otherwise *) (* f \is 'Omega_F(e) == f : T -> V is a bigOmega of e : T -> W near F *) (* f =Omega_F h == f : T -> V is a bigOmega of h : T -> V near F *) -(* --> lemmas: relation with big-O, transitivity, product of functions, etc. *) +(* ``` *) +(* Lemmas: relation with big-O, transitivity, product of functions, etc. *) (* *) (* Similar notations available for big-Theta. *) -(* --> lemmas: relations with big-O and big-Omega, reflexivity, symmetry, *) -(* transitivity, product of functions, etc. *) -(* *) -(* WARNING: The piece of syntax "=O_(" is only valid in the syntax *) -(* "=O_(x \near F)", not in the syntax "=O_(x : U)". *) +(* Lemmas: relations with big-O and big-Omega, reflexivity, symmetry, *) +(* transitivity, product of functions, etc. *) (* *) (******************************************************************************) Set Implicit Arguments. @@ -295,24 +301,24 @@ Lemma showo : (gen_tag = tt) * (the_tag = tt) * (a_tag = tt). Proof. by []. Qed. Section Domination. Context {K : numDomainType} {T : Type} {V W : normedModType K}. -Let littleo_def (F : set (set T)) (f : T -> V) (g : T -> W) := +Let littleo_def (F : set_system T) (f : T -> V) (g : T -> W) := forall eps, 0 < eps -> \forall x \near F, `|f x| <= eps * `|g x|. -Structure littleo_type (F : set (set T)) (g : T -> W) := Littleo { +Structure littleo_type (F : set_system T) (g : T -> W) := Littleo { littleo_fun :> T -> V; _ : `[< littleo_def F littleo_fun g >] }. Notation "{o_ F f }" := (littleo_type F f). -Canonical littleo_subtype (F : set (set T)) (g : T -> W) := - [subType for (@littleo_fun F g)]. +HB.instance Definition _ (F : set_system T) (g : T -> W) := + [isSub for @littleo_fun F g]. -Lemma littleo_class (F : set (set T)) (g : T -> W) (f : {o_F g}) : +Lemma littleo_class (F : set_system T) (g : T -> W) (f : {o_F g}) : `[< littleo_def F f g >]. Proof. by case: f => ?. Qed. Hint Resolve littleo_class : core. -Definition littleo_clone (F : set (set T)) (g : T -> W) (f : T -> V) (fT : {o_F g}) c +Definition littleo_clone (F : set_system T) (g : T -> W) (f : T -> V) (fT : {o_F g}) c of phant_id (littleo_class fT) c := @Littleo F g f c. Notation "[littleo 'of' f 'for' fT ]" := (@littleo_clone _ _ f fT _ idfun). Notation "[littleo 'of' f ]" := (@littleo_clone _ _ f _ _ idfun). @@ -328,8 +334,8 @@ Canonical littleo0 (F : filter_on T) g := Littleo (asboolT (@littleo0_subproof F g _)). Definition the_littleo (_ : unit) (F : filter_on T) - (phF : phantom (set (set T)) F) f h := littleo_fun (insubd (littleo0 F h) f). -Notation PhantomF := (Phantom (set (set T))). + (phF : phantom (set_system T) F) f h := littleo_fun (insubd (littleo0 F h) f). +Notation PhantomF := (Phantom (set_system T)). Arguments the_littleo : simpl never, clear implicits. Notation mklittleo tag x := (the_littleo tag _ (PhantomF x)). @@ -372,7 +378,7 @@ Notation "fx == gx '+o_(' x \near F ')' hx" := Notation "fx '==o_(' x \near F ')' hx" := (fx == (mklittleo the_tag F (fun x => fx) (fun x => hx) x)). -Lemma littleoP (F : set (set T)) (g : T -> W) (f : {o_F g}) : littleo_def F f g. +Lemma littleoP (F : set_system T) (g : T -> W) (f : {o_F g}) : littleo_def F f g. Proof. exact/asboolP. Qed. Hint Extern 0 (littleo_def _ _ _) => solve[apply: littleoP] : core. Hint Extern 0 (nbhs _ _) => solve[apply: littleoP] : core. @@ -380,17 +386,17 @@ Hint Extern 0 (prop_near1 _) => solve[apply: littleoP] : core. Hint Extern 0 (prop_near2 _) => solve[apply: littleoP] : core. Lemma littleoE (tag : unit) (F : filter_on T) - (phF : phantom (set (set T)) F) f h : + (phF : phantom (set_system T) F) f h : littleo_def F f h -> the_littleo tag F phF f h = f. Proof. by move=> /asboolP?; rewrite /the_littleo /insubd insubT. Qed. Canonical the_littleo_littleo (tag : unit) (F : filter_on T) - (phF : phantom (set (set T)) F) f h := [littleo of the_littleo tag F phF f h]. + (phF : phantom (set_system T) F) f h := [littleo of the_littleo tag F phF f h]. -Variant littleo_spec (F : set (set T)) (g : T -> W) : (T -> V) -> Type := +Variant littleo_spec (F : set_system T) (g : T -> W) : (T -> V) -> Type := LittleoSpec f of littleo_def F f g : littleo_spec F g f. -Lemma littleo (F : set (set T)) (g : T -> W) (f : {o_F g}) : littleo_spec F g f. +Lemma littleo (F : set_system T) (g : T -> W) (f : {o_F g}) : littleo_spec F g f. Proof. by constructor; apply/(@littleoP F). Qed. Lemma opp_littleo_subproof (F : filter_on T) e (df : {o_F e}) : @@ -461,39 +467,39 @@ End Domination. Section Domination_numFieldType. Context {K : numFieldType} {T : Type} {V W : normedModType K}. -Let bigO_def (F : set (set T)) (f : T -> V) (g : T -> W) := +Let bigO_def (F : set_system T) (f : T -> V) (g : T -> W) := \forall k \near +oo, \forall x \near F, `|f x| <= k * `|g x|. -Let bigO_ex_def (F : set (set T)) (f : T -> V) (g : T -> W) := +Let bigO_ex_def (F : set_system T) (f : T -> V) (g : T -> W) := exists2 k, k > 0 & \forall x \near F, `|f x| <= k * `|g x|. -Lemma bigO_exP (F : set (set T)) (f : T -> V) (g : T -> W) : +Lemma bigO_exP (F : set_system T) (f : T -> V) (g : T -> W) : Filter F -> bigO_ex_def F f g <-> bigO_def F f g. Proof. split=> [[k k0 fOg] | [k [kreal fOg]]]. exists k; rewrite realE (ltW k0) /=; split=> // l ltkl; move: fOg. - by apply: filter_app; near=> x => /le_trans; apply; rewrite ler_wpmul2r // ltW. + by apply: filter_app; near=> x => /le_trans; apply; rewrite ler_wpM2r // ltW. exists (Num.max 1 `|k + 1|) => //. apply: fOg; rewrite (@lt_le_trans _ _ `|k + 1|) //. - by rewrite (@lt_le_trans _ _ (k + 1)) ?ltr_addl // real_ler_norm ?realD. + by rewrite (@lt_le_trans _ _ (k + 1)) ?ltrDl // real_ler_norm ?realD. by rewrite comparable_le_maxr ?real_comparable// lexx orbT. Unshelve. end_near. Qed. -Structure bigO_type (F : set (set T)) (g : T -> W) := BigO { +Structure bigO_type (F : set_system T) (g : T -> W) := BigO { bigO_fun :> T -> V; _ : `[< bigO_def F bigO_fun g >] }. Notation "{O_ F f }" := (bigO_type F f). -Canonical bigO_subtype (F : set (set T)) (g : T -> W) := - [subType for (@bigO_fun F g)]. +HB.instance Definition _ (F : set_system T) (g : T -> W) := + [isSub for @bigO_fun F g]. -Lemma bigO_class (F : set (set T)) (g : T -> W) (f : {O_F g}) : +Lemma bigO_class (F : set_system T) (g : T -> W) (f : {O_F g}) : `[< bigO_def F f g >]. Proof. by case: f => ?. Qed. Hint Resolve bigO_class : core. -Definition bigO_clone (F : set (set T)) (g : T -> W) (f : T -> V) (fT : {O_F g}) c +Definition bigO_clone (F : set_system T) (g : T -> W) (f : T -> V) (fT : {O_F g}) c of phant_id (bigO_class fT) c := @BigO F g f c. Notation "[bigO 'of' f 'for' fT ]" := (@bigO_clone _ _ f fT _ idfun). Notation "[bigO 'of' f ]" := (@bigO_clone _ _ f _ _ idfun). @@ -507,11 +513,11 @@ Unshelve. all: by end_near. Qed. Canonical bigO0 (F : filter_on T) g := BigO (asboolT (@bigO0_subproof F g _)). Definition the_bigO (u : unit) (F : filter_on T) - (phF : phantom (set (set T)) F) f h := bigO_fun (insubd (bigO0 F h) f). + (phF : phantom (set_system T) F) f h := bigO_fun (insubd (bigO0 F h) f). Arguments the_bigO : simpl never, clear implicits. (* duplicate from Section Domination *) -Notation PhantomF := (Phantom (set (set T))). +Notation PhantomF := (Phantom (set_system T)). Notation mkbigO tag x := (the_bigO tag _ (PhantomF x)). (* Parsing *) Notation "[O_ x e 'of' f ]" := (mkbigO gen_tag x f e). @@ -552,21 +558,21 @@ Notation "fx == gx '+O_(' x \near F ')' hx" := Notation "fx '==O_(' x \near F ')' hx" := (fx == (mkbigO the_tag F (fun x => fx) (fun x => hx) x)). -Lemma bigOP (F : set (set T)) (g : T -> W) (f : {O_F g}) : bigO_def F f g. +Lemma bigOP (F : set_system T) (g : T -> W) (f : {O_F g}) : bigO_def F f g. Proof. exact/asboolP. Qed. Hint Extern 0 (bigO_def _ _ _) => solve[apply: bigOP] : core. Hint Extern 0 (nbhs _ _) => solve[apply: bigOP] : core. Hint Extern 0 (prop_near1 _) => solve[apply: bigOP] : core. Hint Extern 0 (prop_near2 _) => solve[apply: bigOP] : core. -Lemma bigOE (tag : unit) (F : filter_on T) (phF : phantom (set (set T)) F) f h : +Lemma bigOE (tag : unit) (F : filter_on T) (phF : phantom (set_system T) F) f h : bigO_def F f h -> the_bigO tag F phF f h = f. Proof. by move=> /asboolP?; rewrite /the_bigO /insubd insubT. Qed. Canonical the_bigO_bigO (tag : unit) (F : filter_on T) - (phF : phantom (set (set T)) F) f h := [bigO of the_bigO tag F phF f h]. + (phF : phantom (set_system T) F) f h := [bigO of the_bigO tag F phF f h]. -Variant bigO_spec (F : set (set T)) (g : T -> W) : (T -> V) -> Prop := +Variant bigO_spec (F : set_system T) (g : T -> W) : (T -> V) -> Prop := BigOSpec f (k : {posnum K}) of (\forall x \near F, `|f x| <= k%:num * `|g x|) : bigO_spec F g f. @@ -594,8 +600,8 @@ Proof. by move: x; rewrite -/(- _ =1 _) {1}oppO. Qed. Lemma add_bigO_subproof (F : filter_on T) e (df dg : {O_F e}) : bigO_def F (df \+ dg) e. Proof. -near=> k; near=> x; apply: le_trans (ler_norm_add _ _) _. -by rewrite (splitr k) mulrDl ler_add //; near: x; near: k; +near=> k; near=> x; apply: le_trans (ler_normD _ _) _. +by rewrite (splitr k) mulrDl lerD //; near: x; near: k; [apply: near_pinfty_div2 (bigOP df)|apply: near_pinfty_div2 (bigOP dg)]. Unshelve. all: by end_near. Qed. @@ -688,7 +694,7 @@ Proof. by apply: eqOE; rewrite littleo_eqo. Qed. Canonical littleo_is_bigO (F : filter_on T) (e : T -> W) (f : {o_F e}) := BigO (asboolT (eqO_bigO (littleo_eqO f))). Canonical the_littleo_bigO (tag : unit) (F : filter_on T) - (phF : phantom (set (set T)) F) f h := [bigO of the_littleo tag phF f h]. + (phF : phantom (set_system T) F) f h := [bigO of the_littleo tag phF f h]. End Domination_numFieldType. @@ -704,7 +710,7 @@ Notation "[bigO 'of' f ]" := (@bigO_clone _ _ _ _ _ _ f _ _ idfun). Arguments the_littleo {_ _ _ _} _ _ _ _ _ : simpl never. Arguments the_bigO {_ _ _ _} _ _ _ _ _ : simpl never. -Local Notation PhantomF x := (Phantom _ [filter of x]). +Local Notation PhantomF x := (Phantom _ (nbhs x)). Notation mklittleo tag x := (the_littleo tag _ (PhantomF x)). (* Parsing *) @@ -788,11 +794,16 @@ Notation "fx == gx '+O_(' x \near F ')' hx" := Notation "fx '==O_(' x \near F ')' hx" := (fx == (mkbigO the_tag F (fun x => fx) (fun x => hx) x)). -#[global] Hint Extern 0 (_ = 'o__ _) => apply: eqoE; reflexivity : core. -#[global] Hint Extern 0 (_ = 'O__ _) => apply: eqOE; reflexivity : core. -#[global] Hint Extern 0 (_ = 'O__ _) => apply: eqoO; reflexivity : core. -#[global] Hint Extern 0 (_ = _ + 'o__ _) => apply: eqaddoE; reflexivity : core. -#[global] Hint Extern 0 (_ = _ + 'O__ _) => apply: eqaddOE; reflexivity : core. +#[global] Hint Extern 0 (_ = the_littleo the_tag _ _ _ _) => + apply: eqoE; reflexivity : core. +#[global] Hint Extern 0 (_ = the_bigO the_tag _ _ _ _) => + apply: eqOE; reflexivity : core. +#[global] Hint Extern 0 (_ = the_bigO the_tag _ _ _ _) => + apply: eqoO; reflexivity : core. +#[global] Hint Extern 0 (_ = _ + the_littleo the_tag _ _ _ _) => + apply: eqaddoE; reflexivity : core. +#[global] Hint Extern 0 (_ = _ + the_bigO the_tag _ _ _ _) => + apply: eqaddOE; reflexivity : core. #[global] Hint Extern 0 (\forall k \near +oo, \forall x \near _, is_true (`|_ x| <= k * `|_ x|)) => solve[apply: bigOP] : core. #[global] Hint Extern 0 (nbhs _ _) => solve[apply: bigOP] : core. @@ -813,14 +824,14 @@ Section Domination_numFieldType. Context {K : numFieldType} {T : Type} {V W : normedModType K}. (* duplicate from Section Domination *) -Let littleo_def (F : set (set T)) (f : T -> V) (g : T -> W) := +Let littleo_def (F : set_system T) (f : T -> V) (g : T -> W) := forall eps, 0 < eps -> \forall x \near F, `|f x| <= eps * `|g x|. Lemma add_littleo_subproof (F : filter_on T) e (df dg : {o_F e}) : littleo_def F (df \+ dg) e. Proof. by move=> _/posnumP[eps]; near do [ - rewrite [eps%:num]splitr mulrDl (le_trans (ler_norm_add _ _)) // ler_add //]; + rewrite [eps%:num]splitr mulrDl (le_trans (ler_normD _ _)) // lerD //]; apply: littleoP. Unshelve. all: by end_near. Qed. @@ -846,7 +857,7 @@ Lemma scale_littleo_subproof (F : filter_on T) e (df : {o_F e}) a : Proof. have [->|a0] := eqVneq a 0; first by rewrite scale0r. move=> _ /posnumP[eps]; have aa := normr_eq0 a; near=> x => /=. -rewrite normrZ -ler_pdivl_mull ?lt_def ?aa ?a0 //= mulrA; near: x. +rewrite normrZ -ler_pdivlMl ?lt_def ?aa ?a0 //= mulrA; near: x. by apply: littleoP; rewrite mulr_gt0 // invr_gt0 ?lt_def ?aa ?a0 /=. Unshelve. all: by end_near. Qed. @@ -874,7 +885,7 @@ have [->|a0] := eqVneq a 0. move=> _/posnumP[eps]. have ea : 0 < eps%:num / `| a | by rewrite divr_gt0 // normr_gt0. have [g /(_ _ ea) ?] := littleo; near=> y. -rewrite normrZ -ler_pdivl_mulr; first by rewrite mulrAC; near: y. +rewrite normrZ -ler_pdivlMr; first by rewrite mulrAC; near: y. by rewrite lt_def normr_eq0 a0 normr_ge0. Unshelve. all: by end_near. Qed. @@ -890,9 +901,9 @@ split=> fFl. apply/cvgrPdist_lt=> _/posnumP[eps]. have lt_eps x : x <= (eps%:num / 2%:R) * `|1 : K^o|%real -> x < eps%:num. rewrite normr1 mulr1 => /le_lt_trans; apply. - by rewrite ltr_pdivr_mulr // ltr_pmulr // ltr1n. + by rewrite ltr_pdivrMr // ltr_pMr // ltr1n. near=> x do rewrite [X in X x]fFl opprD addNKr normrN lt_eps //. -by rewrite /= !near_simpl; apply: littleoP; rewrite divr_gt0. +by apply: littleoP; rewrite divr_gt0. Unshelve. all: by end_near. Qed. Lemma eqolim (F : filter_on T) (f : T -> V) (l : V) e : @@ -917,7 +928,7 @@ Lemma littleo_bigO_eqo {F : filter_on T} Proof. move->; apply/eqoP => _/posnumP[e]; have [k c] := bigO _ g. apply: filter_app; near=> x do [ - rewrite -!ler_pdivr_mull//; apply: le_trans; rewrite ler_pdivr_mull// mulrA]. + rewrite -!ler_pdivrMl//; apply: le_trans; rewrite ler_pdivrMl// mulrA]. exact: littleoP. Unshelve. all: by end_near. Qed. Arguments littleo_bigO_eqo {F}. @@ -927,7 +938,7 @@ Lemma bigO_littleo_eqo {F : filter_on T} (g : T -> W) (f : T -> V) (h : T -> X) Proof. move->; apply/eqoP => _/posnumP[e]; have [k c] := bigO. apply: filter_app; near=> x => /le_trans; apply. -by rewrite -ler_pdivl_mull // mulrA; near: x; apply: littleoP. +by rewrite -ler_pdivlMl // mulrA; near: x; apply: littleoP. Unshelve. all: by end_near. Qed. Arguments bigO_littleo_eqo {F}. @@ -975,8 +986,8 @@ Lemma bigO_bigO_eqO {F : filter_on T} (g : T -> W) (f : T -> V) (h : T -> X) : Proof. move->; apply/eqOP; have [k c1 kOg] := bigO _ g. have [k' c2 k'Ok] := bigO _ k. near=> c; move: k'Ok kOg; apply: filter_app2; near=> x => lek'c2k. -rewrite -(@ler_pmul2l _ c2%:num) // mulrA => /(le_trans lek'c2k) /le_trans. -by apply; rewrite ler_pmul//; near: c; exact: nbhs_pinfty_ge. +rewrite -(@ler_pM2l _ c2%:num) // mulrA => /(le_trans lek'c2k) /le_trans. +by apply; rewrite ler_pM//; near: c; exact: nbhs_pinfty_ge. Unshelve. all: by end_near. Qed. Arguments bigO_bigO_eqO {F}. @@ -1042,7 +1053,7 @@ Lemma mulo (F : filter_on pT) (h1 h2 f g : pT -> R^o) : Proof. rewrite [in RHS]littleoE // => _/posnumP[e]; near=> x. rewrite [`|_|]normrM -(sqr_sqrtr (ge0 e)) expr2. -rewrite (@normrM _ (h1 x) (h2 x)) mulrACA ler_pmul //; near: x; +rewrite (@normrM _ (h1 x) (h2 x)) mulrACA ler_pM //; near: x; by have [/= h] := littleo; apply. Unshelve. all: by end_near. Qed. @@ -1051,8 +1062,8 @@ Lemma mulO (F : filter_on pT) (h1 h2 f g : pT -> R^o) : Proof. rewrite [RHS]bigOE//; have [ O1 k1 Oh1] := bigO; have [ O2 k2 Oh2] := bigO. near=> k; move: Oh1 Oh2; apply: filter_app2; near=> x => leOh1 leOh2. -rewrite [`|_|]normrM (le_trans (ler_pmul _ _ leOh1 leOh2)) //. -by rewrite mulrACA [`|_| in leRHS]normrM ler_wpmul2r // ?mulr_ge0. +rewrite [`|_|]normrM (le_trans (ler_pM _ _ leOh1 leOh2)) //. +by rewrite mulrACA [`|_| in leRHS]normrM ler_wpM2r // ?mulr_ge0. Unshelve. all: by end_near. Qed. End rule_of_products_rcfType. @@ -1066,8 +1077,8 @@ Lemma mulo_numClosedFieldType (F : filter_on pT) (h1 h2 f g : pT -> R^o) : [o_F h1 of f] * [o_F h2 of g] =o_F (h1 * h2). Proof. rewrite [in RHS]littleoE // => _/posnumP[e]; near=> x. -rewrite [`|_|]normrM -(sqrCK (ge0 e)) expr2 sqrtCM ?qualifE//. -rewrite (@normrM _ (h1 x) (h2 x)) mulrACA ler_pmul //; near: x; +rewrite [`|_|]normrM -(sqrCK (ge0 e)) expr2 sqrtCM ?qualifE//=. +rewrite (@normrM _ (h1 x) (h2 x)) mulrACA ler_pM //; near: x; by have [/= h] := littleo; apply. Unshelve. all: by end_near. Qed. @@ -1076,15 +1087,15 @@ Lemma mulO_numClosedFieldType (F : filter_on pT) (h1 h2 f g : pT -> R^o) : Proof. rewrite [RHS]bigOE//; have [ O1 k1 Oh1] := bigO; have [ O2 k2 Oh2] := bigO. near=> k; move: Oh1 Oh2; apply: filter_app2; near=> x => leOh1 leOh2. -rewrite [`|_|]normrM (le_trans (ler_pmul _ _ leOh1 leOh2)) //. -by rewrite mulrACA [`|_| in leRHS]normrM ler_wpmul2r // ?mulr_ge0. +rewrite [`|_|]normrM (le_trans (ler_pM _ _ leOh1 leOh2)) //. +by rewrite mulrACA [`|_| in leRHS]normrM ler_wpM2r // ?mulr_ge0. Unshelve. all: by end_near. Qed. End rule_of_products_numClosedFieldType. Section Linear3. Context (R : realFieldType) (U : normedModType R) (V : normedModType R) - (s : R -> V -> V) (s_law : GRing.Scale.law s). + (s : GRing.Scale.law R V). Hypothesis (normm_s : forall k x, `|s k x| = `|k| * `|x|). (* Split in multiple bits *) @@ -1095,7 +1106,7 @@ Hypothesis (normm_s : forall k x, `|s k x| = `|k| * `|x|). Local Notation "'+oo'" := (@pinfty_nbhs R). -Lemma linear_for_continuous (f : {linear U -> V | GRing.Scale.op s_law}) : +Lemma linear_for_continuous (f : {linear U -> V | GRing.Scale.Law.sort s}) : (f : _ -> _) =O_ (0 : U) (cst (1 : R^o)) -> continuous f. Proof. move=> /eqO_exP [_/posnumP[k0] Of1] x. @@ -1104,7 +1115,7 @@ rewrite (near_shift 0) /= subr0; near=> y => /=. rewrite -linearB opprD addrC addrNK linearN normrN; near: y. suff flip : \forall k \near +oo, forall x, `|f x| <= k * `|x|. near +oo => k; near=> y. - rewrite (le_lt_trans (near flip k _ _)) // -ltr_pdivl_mull; last first. + rewrite (le_lt_trans (near flip k _ _)) // -ltr_pdivlMl; last first. by near: k; exists 0. near: y; apply/nbhs_normP. eexists; last by move=> ?; rewrite /= sub0r normrN; apply. @@ -1115,18 +1126,17 @@ case: (ler0P `|y|) => [|y0]. by rewrite normr_le0 => /eqP->; rewrite linear0 !normr0 mulr0. have ky0 : 0 <= k0%:num / (k * `|y|). by rewrite pmulr_rge0 // invr_ge0 mulr_ge0 // ltW //; near: k; exists 0. -rewrite -[leRHS]mulr1 -ler_pdivr_mull ?pmulr_rgt0 //. -rewrite -(ler_pmul2l [gt0 of k0%:num]) mulr1 mulrA -[_ / _]ger0_norm //. +rewrite -[leRHS]mulr1 -ler_pdivrMl ?pmulr_rgt0 //. +rewrite -(ler_pM2l [gt0 of k0%:num]) mulr1 mulrA -[_ / _]ger0_norm //. rewrite -normm_s. -have <- : GRing.Scale.op s_law =2 s by rewrite GRing.Scale.opE. -rewrite -linearZ fk //= distrC subr0 normrZ ger0_norm //. -rewrite invfM mulrA mulfVK ?lt0r_neq0 // ltr_pdivr_mulr //. -by rewrite -ltr_pdivr_mull//. +rewrite -linearZ fk //= /= distrC subr0 normrZ ger0_norm //. +rewrite invfM mulrA mulfVK ?lt0r_neq0 // ltr_pdivrMr //. +by rewrite -ltr_pdivrMl//. Unshelve. all: by end_near. Qed. End Linear3. -Arguments linear_for_continuous {R U V s s_law normm_s} f _. +Arguments linear_for_continuous {R U V s normm_s} f _. Lemma linear_continuous (R : realFieldType) (U : normedModType R) (V : normedModType R) (f : {linear U -> V}) : @@ -1134,7 +1144,7 @@ Lemma linear_continuous (R : realFieldType) (U : normedModType R) Proof. by apply: linear_for_continuous => ? ?; rewrite normrZ. Qed. Lemma linear_for_mul_continuous (R : realFieldType) (U : normedModType R) - (f : {linear U -> R | (@GRing.mul [ringType of R^o])}) : + (f : {linear U -> R^o | @GRing.mul R^o}) : (f : _ -> _) =O_ (0 : U) (cst (1 : R^o)) -> continuous f. Proof. by apply: linear_for_continuous => ? ?; rewrite normrZ. Qed. @@ -1156,12 +1166,12 @@ Lemma equivoRL (W' : normedModType K) F (f g : T -> V) (h : T -> W') : f ~_F g -> [o_F g of h] =o_F f. Proof. move=> ->; apply/eqoP; move=> _/posnumP[eps]; near=> x. -rewrite -ler_pdivr_mull // -[X in g + X]opprK oppo. +rewrite -ler_pdivrMl // -[X in g + X]opprK oppo. rewrite (le_trans _ (ler_dist_dist _ _)) //. -rewrite [leRHS]ger0_norm ?ler_subr_addr ?add0r; last first. +rewrite [leRHS]ger0_norm ?lerBrDr ?add0r; last first. by rewrite -[leRHS]mul1r; near: x; apply: littleoP. rewrite [leRHS]splitr [_ / 2]mulrC. -by rewrite ler_add ?ler_pdivr_mull ?mulrA //; near: x; apply: littleoP. +by rewrite lerD ?ler_pdivrMl ?mulrA //; near: x; apply: littleoP. Unshelve. all: by end_near. Qed. Lemma equiv_sym F (f g : T -> V) : f ~_F g -> g ~_F f. @@ -1198,25 +1208,25 @@ Section big_omega. Context {K : realFieldType} {T : Type} {V : normedModType K}. Implicit Types W : normedModType K. -Let bigOmega_def W (F : set (set T)) (f : T -> V) (g : T -> W) := +Let bigOmega_def W (F : set_system T) (f : T -> V) (g : T -> W) := exists2 k, k > 0 & \forall x \near F, `|f x| >= k * `|g x|. -Structure bigOmega_type {W} (F : set (set T)) (g : T -> W) := BigOmega { +Structure bigOmega_type {W} (F : set_system T) (g : T -> W) := BigOmega { bigOmega_fun :> T -> V; _ : `[< bigOmega_def F bigOmega_fun g >] }. Notation "{Omega_ F g }" := (@bigOmega_type _ F g). -Canonical bigOmega_subtype {W} (F : set (set T)) (g : T -> W) := - [subType for (@bigOmega_fun W F g)]. +HB.instance Definition _ {W} (F : set_system T) (g : T -> W) := + [isSub for @bigOmega_fun W F g]. -Lemma bigOmega_class {W} (F : set (set T)) (g : T -> W) (f : {Omega_F g}) : +Lemma bigOmega_class {W} (F : set_system T) (g : T -> W) (f : {Omega_F g}) : `[< bigOmega_def F f g >]. Proof. by case: f => ?. Qed. Hint Resolve bigOmega_class : core. -Definition bigOmega_clone {W} (F : set (set T)) (g : T -> W) (f : T -> V) +Definition bigOmega_clone {W} (F : set_system T) (g : T -> W) (f : T -> V) (fT : {Omega_F g}) c of phant_id (bigOmega_class fT) c := @BigOmega W F g f c. Notation "[bigOmega 'of' f 'for' fT ]" := (@bigOmega_clone _ _ _ f fT _ idfun). Notation "[bigOmega 'of' f ]" := (@bigOmega_clone _ _ _ f _ _ idfun). @@ -1230,7 +1240,7 @@ Definition bigOmega_refl (F : filter_on T) g := BigOmega (asboolT (@bigOmega_refl_subproof F g _)). Definition the_bigOmega (u : unit) (F : filter_on T) - (phF : phantom (set (set T)) F) f g := + (phF : phantom (set_system T) F) f g := bigOmega_fun (insubd (bigOmega_refl F g) f). Arguments the_bigOmega : simpl never, clear implicits. @@ -1238,15 +1248,15 @@ Notation mkbigOmega tag x := (the_bigOmega tag _ (PhantomF x)). Notation "[Omega_ x e 'of' f ]" := (mkbigOmega gen_tag x f e). (* parsing *) Notation "[Omega '_' x e 'of' f ]" := (the_bigOmega _ _ (PhantomF x) f e). -Definition is_bigOmega {W} (F : set (set T)) (g : T -> W) := +Definition is_bigOmega {W} (F : set_system T) (g : T -> W) := [qualify f : T -> V | `[< bigOmega_def F f g >] ]. -Fact is_bigOmega_key {W} (F : set (set T)) (g : T -> W) : pred_key (is_bigOmega F g). +Fact is_bigOmega_key {W} (F : set_system T) (g : T -> W) : pred_key (is_bigOmega F g). Proof. by []. Qed. -Canonical is_bigOmega_keyed {W} (F : set (set T)) (g : T -> W) := +Canonical is_bigOmega_keyed {W} (F : set_system T) (g : T -> W) := KeyedQualifier (is_bigOmega_key F g). Notation "'Omega_ F g" := (is_bigOmega F g). -Lemma bigOmegaP {W} (F : set (set T)) (g : T -> W) (f : {Omega_F g}) : +Lemma bigOmegaP {W} (F : set_system T) (g : T -> W) (f : {Omega_F g}) : bigOmega_def F f g. Proof. exact/asboolP. Qed. Hint Extern 0 (bigOmega_def _ _ _) => solve[apply: bigOmegaP] : core. @@ -1257,9 +1267,9 @@ Hint Extern 0 (prop_near2 _) => solve[apply: bigOmegaP] : core. Notation "f '=Omega_' F h" := (f%function = mkbigOmega the_tag F f h). Canonical the_bigOmega_bigOmega (tag : unit) (F : filter_on T) - (phF : phantom (set (set T)) F) f h := [bigOmega of the_bigOmega tag F phF f h]. + (phF : phantom (set_system T) F) f h := [bigOmega of the_bigOmega tag F phF f h]. -Variant bigOmega_spec {W} (F : set (set T)) (g : T -> W) : (T -> V) -> Prop := +Variant bigOmega_spec {W} (F : set_system T) (g : T -> W) : (T -> V) -> Prop := BigOmegaSpec f (k : {posnum K}) of (\forall x \near F, `|f x| >= k%:num * `|g x|) : bigOmega_spec F g f. @@ -1277,8 +1287,8 @@ rewrite propeqE; split => [| /eqO_exP[x x0 Hx] ]; [rewrite qualifE => /asboolP[x x0 Hx]; apply/eqO_exP | rewrite qualifE; apply/asboolP]; exists x^-1; rewrite ?invr_gt0 //; near=> y. - by rewrite ler_pdivl_mull //; near: y. -by rewrite ler_pdivr_mull //; near: y. + by rewrite ler_pdivlMl //; near: y. +by rewrite ler_pdivrMl //; near: y. Unshelve. all: by end_near. Qed. Lemma eqOmegaE (F : filter_on T) (f e : T -> V) : @@ -1314,7 +1324,7 @@ Lemma addOmega (R : realFieldType) (F : filter_on pT) (f g h : _ -> R^o) Proof. rewrite 2!eqOmegaE !eqOmegaO => /eqOP hOf; apply/eqOP. apply: filter_app hOf; near=> k; apply: filter_app; near=> x => /le_trans. -by apply; rewrite ler_pmul2l // !ger0_norm // ?addr_ge0 // ler_addl. +by apply; rewrite ler_pM2l // !ger0_norm // ?addr_ge0 // lerDl. Unshelve. all: by end_near. Qed. Lemma mulOmega (R : realFieldType) (F : filter_on pT) (h1 h2 f g : pT -> R^o) : @@ -1324,10 +1334,10 @@ rewrite eqOmegaE eqOmegaO [in RHS]bigOE //. have [W1 k1 ?] := bigOmega; have [W2 k2 ?] := bigOmega. near=> k; near=> x; rewrite [`|_|]normrM. rewrite (@le_trans _ _ ((k2%:num * k1%:num)^-1 * `|(W1 * W2) x|)) //. - rewrite invrM ?unitfE ?gtr_eqF // -mulrA ler_pdivl_mull //. - rewrite ler_pdivl_mull // (mulrA k1%:num) mulrCA (@normrM _ (W1 x)). - by rewrite ler_pmul ?mulr_ge0 //; near: x. -by rewrite ler_wpmul2r // ltW //. + rewrite invrM ?unitfE ?gtr_eqF // -mulrA ler_pdivlMl //. + rewrite ler_pdivlMl // (mulrA k1%:num) mulrCA (@normrM _ (W1 x)). + by rewrite ler_pM ?mulr_ge0 //; near: x. +by rewrite ler_wpM2r // ltW //. Unshelve. all: by end_near. Qed. End big_omega_in_R. @@ -1337,26 +1347,26 @@ Section big_theta. Context {K : realFieldType} {T : Type} {V : normedModType K}. Implicit Types W : normedModType K. -Let bigTheta_def W (F : set (set T)) (f : T -> V) (g : T -> W) := +Let bigTheta_def W (F : set_system T) (f : T -> V) (g : T -> W) := exists2 k, (k.1 > 0) && (k.2 > 0) & \forall x \near F, k.1 * `|g x| <= `|f x| /\ `|f x| <= k.2 * `|g x|. -Structure bigTheta_type {W} (F : set (set T)) (g : T -> W) := BigTheta { +Structure bigTheta_type {W} (F : set_system T) (g : T -> W) := BigTheta { bigTheta_fun :> T -> V; _ : `[< bigTheta_def F bigTheta_fun g >] }. Notation "{Theta_ F g }" := (@bigTheta_type _ F g). -Canonical bigTheta_subtype {W} (F : set (set T)) (g : T -> W) := - [subType for (@bigTheta_fun W F g)]. +HB.instance Definition _ {W} (F : set_system T) (g : T -> W) := + [isSub for @bigTheta_fun W F g]. -Lemma bigTheta_class {W} (F : set (set T)) (g : T -> W) (f : {Theta_F g}) : +Lemma bigTheta_class {W} (F : set_system T) (g : T -> W) (f : {Theta_F g}) : `[< bigTheta_def F f g >]. Proof. by case: f => ?. Qed. Hint Resolve bigTheta_class : core. -Definition bigTheta_clone {W} (F : set (set T)) (g : T -> W) (f : T -> V) +Definition bigTheta_clone {W} (F : set_system T) (g : T -> W) (f : T -> V) (fT : {Theta_F g}) c of phant_id (bigTheta_class fT) c := @BigTheta W F g f c. Notation "[bigTheta 'of' f 'for' fT ]" := (@bigTheta_clone _ _ _ f fT _ idfun). Notation "[bigTheta 'of' f ]" := (@bigTheta_clone _ _ _ f _ _ idfun). @@ -1370,7 +1380,7 @@ Definition bigTheta_refl (F : filter_on T) g := BigTheta (asboolT (@bigTheta_refl_subproof F g _)). Definition the_bigTheta (u : unit) (F : filter_on T) - (phF : phantom (set (set T)) F) f g := + (phF : phantom (set_system T) F) f g := bigTheta_fun (insubd (bigTheta_refl F g) f). Arguments the_bigOmega : simpl never, clear implicits. @@ -1378,15 +1388,15 @@ Notation mkbigTheta tag x := (@the_bigTheta tag _ (PhantomF x)). Notation "[Theta_ x e 'of' f ]" := (mkbigTheta gen_tag x f e). (* parsing *) Notation "[Theta '_' x e 'of' f ]" := (the_bigTheta _ _ (PhantomF x) f e). -Definition is_bigTheta {W} (F : set (set T)) (g : T -> W) := +Definition is_bigTheta {W} (F : set_system T) (g : T -> W) := [qualify f : T -> V | `[< bigTheta_def F f g >] ]. -Fact is_bigTheta_key {W} (F : set (set T)) (g : T -> W) : pred_key (is_bigTheta F g). +Fact is_bigTheta_key {W} (F : set_system T) (g : T -> W) : pred_key (is_bigTheta F g). Proof. by []. Qed. -Canonical is_bigTheta_keyed {W} (F : set (set T)) (g : T -> W) := +Canonical is_bigTheta_keyed {W} (F : set_system T) (g : T -> W) := KeyedQualifier (is_bigTheta_key F g). Notation "'Theta_ F g" := (@is_bigTheta _ F g). -Lemma bigThetaP {W} (F : set (set T)) (g : T -> W) (f : {Theta_F g}) : +Lemma bigThetaP {W} (F : set_system T) (g : T -> W) (f : {Theta_F g}) : bigTheta_def F f g. Proof. exact/asboolP. Qed. Hint Extern 0 (bigTheta_def _ _ _) => solve[apply: bigThetaP] : core. @@ -1395,9 +1405,9 @@ Hint Extern 0 (prop_near1 _) => solve[apply: bigThetaP] : core. Hint Extern 0 (prop_near2 _) => solve[apply: bigThetaP] : core. Canonical the_bigTheta_bigTheta (tag : unit) (F : filter_on T) - (phF : phantom (set (set T)) F) f h := [bigTheta of @the_bigTheta tag F phF f h]. + (phF : phantom (set_system T) F) f h := [bigTheta of @the_bigTheta tag F phF f h]. -Variant bigTheta_spec {W} (F : set (set T)) (g : T -> W) : (T -> V) -> Prop := +Variant bigTheta_spec {W} (F : set_system T) (g : T -> W) : (T -> V) -> Prop := BigThetaSpec f (k1 : {posnum K}) (k2 : {posnum K}) of (\forall x \near F, k1%:num * `|g x| <= `|f x|) & (\forall x \near F, `|f x| <= k2%:num * `|g x|) : @@ -1474,7 +1484,7 @@ rewrite -eqOmegaE; apply: addOmega. - by move=> ?; rewrite /the_bigO val_insubd /=; case: ifP. - rewrite eqOmegaE eqOmegaO; have [T1 k1 k2 ? ?] := bigTheta. rewrite bigOE //; apply/bigO_exP; exists k1%:num^-1 => //. - by near do rewrite ler_pdivl_mull //. + by near do rewrite ler_pdivlMl //. Unshelve. all: by end_near. Qed. Lemma mulTheta (F : filter_on pT) (h1 h2 f g : pT -> R^o) : @@ -1486,10 +1496,10 @@ rewrite eqOmegaO [in RHS]bigOE //. have [T1 k1 l1 P1 ?] := bigTheta; have [T2 k2 l2 P2 ?] := bigTheta. near=> k; first near=> x. rewrite [`|_|]normrM (@le_trans _ _ ((k2%:num * k1%:num)^-1 * `|(T1 * T2) x|)) //. - rewrite invrM ?unitfE ?gtr_eqF // -mulrA ler_pdivl_mull //. - rewrite ler_pdivl_mull // (mulrA k1%:num) mulrCA (@normrM _ (T1 x)) ler_pmul //; + rewrite invrM ?unitfE ?gtr_eqF // -mulrA ler_pdivlMl //. + rewrite ler_pdivlMl // (mulrA k1%:num) mulrCA (@normrM _ (T1 x)) ler_pM //; by [rewrite mulr_ge0 //|near: x]. -by rewrite ler_wpmul2r // ltW //. +by rewrite ler_wpM2r // ltW //. Unshelve. all: by end_near. Qed. End big_theta_in_R. diff --git a/theories/lebesgue_integral.v b/theories/lebesgue_integral.v index 434461dc0..8b0893855 100644 --- a/theories/lebesgue_integral.v +++ b/theories/lebesgue_integral.v @@ -1,13 +1,13 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval finmap. -From mathcomp.classical Require Import boolp classical_sets functions. -From mathcomp.classical Require Import cardinality fsbigop mathcomp_extra. -Require Import signed reals ereal topology normedtype sequences esum measure. -Require Import lebesgue_measure numfun. +From mathcomp Require Import mathcomp_extra boolp classical_sets functions. +From mathcomp Require Import cardinality fsbigop . +Require Import signed reals ereal topology normedtype sequences real_interval. +Require Import esum measure lebesgue_measure numfun. -(******************************************************************************) -(* Lebesgue Integral *) +(**md**************************************************************************) +(* # Lebesgue Integral *) (* *) (* This file contains a formalization of the Lebesgue integral. It starts *) (* with simple functions and their integral, provides basic operations *) @@ -16,12 +16,20 @@ Require Import lebesgue_measure numfun. (* measurable functions, proves the approximation theorem, the properties of *) (* their integral (semi-linearity, non-decreasingness), the monotone *) (* convergence theorem, and Fatou's lemma. Finally, it proves the linearity *) -(* properties of the integral, the dominated convergence theorem and Fubini's *) -(* theorem. *) +(* properties of the integral, the dominated convergence theorem and *) +(* Fubini's theorem, etc. *) +(* *) +(* Main notation: *) +(* | Coq notation | | Meaning | *) +(* |----------------------:|--|:-------------------------------- *) +(* | \int[mu]_(x in D) f x |==| $\int_D f(x)\mathbf{d}\mu(x)$ *) +(* | \int[mu]_x f x |==| $\int f(x)\mathbf{d}\mu(x)$ *) (* *) (* Main reference: *) (* - Daniel Li, Intégration et applications, 2016 *) (* *) +(* Detailed contents: *) +(* ```` *) (* {mfun T >-> R} == type of real-valued measurable functions *) (* {sfun T >-> R} == type of simple functions *) (* {nnsfun T >-> R} == type of non-negative simple functions *) @@ -38,13 +46,20 @@ Require Import lebesgue_measure numfun. (* Rintegral mu D f := fine (\int[mu]_(x in D) f x). *) (* mu.-integrable D f == f is measurable over D and the integral of f *) (* w.r.t. D is < +oo *) -(* ae_eq D f g == f is equal to g almost everywhere *) (* m1 \x m2 == product measure over T1 * T2, m1 is a measure *) (* measure over T1, and m2 is a sigma finite *) (* measure over T2 *) (* m1 \x^ m2 == product measure over T1 * T2, m2 is a measure *) (* measure over T1, and m1 is a sigma finite *) (* measure over T2 *) +(* locally_integrable D f == the real number-valued function f is locally *) +(* integrable on D *) +(* iavg f A := "average" of the real-valued function f over *) +(* the set A *) +(* HL_maximal == the Hardy–Littlewood maximal operator *) +(* input: real number-valued function *) +(* output: extended real number-valued function *) +(* ```` *) (* *) (******************************************************************************) @@ -76,6 +91,13 @@ HB.mixin Record isMeasurableFun d (aT : measurableType d) (rT : realType) }. HB.structure Definition MeasurableFun d aT rT := {f of @isMeasurableFun d aT rT f}. + +(* HB.mixin Record isMeasurableFun d (aT : measurableType d) (rT : realType) (f : aT -> rT) := { *) +(* measurable_funP : measurable_fun setT f *) +(* }. *) +(* #[global] Hint Resolve fimfun_inP : core. *) + +(* HB.structure Definition MeasurableFun d aT rT := {f of @isMeasurableFun d aT rT f}. *) Reserved Notation "{ 'mfun' aT >-> T }" (at level 0, format "{ 'mfun' aT >-> T }"). Reserved Notation "[ 'mfun' 'of' f ]" @@ -85,6 +107,7 @@ Notation "[ 'mfun' 'of' f ]" := [the {mfun _ >-> _} of f] : form_scope. #[global] Hint Resolve measurable_funP : core. HB.structure Definition SimpleFun d (aT : measurableType d) (rT : realType) := +(* HB.structure Definition SimpleFun d (aT (*rT*) : measurableType d) (rT : realType) := *) {f of @isMeasurableFun d aT rT f & @FiniteImage aT rT f}. Reserved Notation "{ 'sfun' aT >-> T }" (at level 0, format "{ 'sfun' aT >-> T }"). @@ -97,6 +120,21 @@ Lemma measurable_sfunP {d} {aT : measurableType d} {rT : realType} (f : {mfun aT >-> rT}) (Y : set rT) : measurable Y -> measurable (f @^-1` Y). Proof. by move=> mY; rewrite -[f @^-1` _]setTI; exact: measurable_funP. Qed. + +HB.mixin Record isNonNegFun (aT : Type) (rT : numDomainType) (f : aT -> rT) := { + fun_ge0 : forall x, 0 <= f x +}. +HB.structure Definition NonNegFun aT rT := {f of @isNonNegFun aT rT f}. +Reserved Notation "{ 'nnfun' aT >-> T }" + (at level 0, format "{ 'nnfun' aT >-> T }"). +Reserved Notation "[ 'nnfun' 'of' f ]" + (at level 0, format "[ 'nnfun' 'of' f ]"). +Notation "{ 'nnfun' aT >-> T }" := (@NonNegFun.type aT T) : form_scope. +Notation "[ 'nnfun' 'of' f ]" := [the {nnfun _ >-> _} of f] : form_scope. +#[global] Hint Extern 0 (is_true (0 <= _)) => solve [apply: fun_ge0] : core. + +(* HB.structure Definition NonNegSimpleFun d (aT : measurableType d) (rT : realType) := *) + HB.structure Definition NonNegSimpleFun d (aT : measurableType d) (rT : realType) := {f of @SimpleFun d _ _ f & @NonNegFun aT rT f}. @@ -104,9 +142,100 @@ Reserved Notation "{ 'nnsfun' aT >-> T }" (at level 0, format "{ 'nnsfun' aT >-> T }"). Reserved Notation "[ 'nnsfun' 'of' f ]" (at level 0, format "[ 'nnsfun' 'of' f ]"). -Notation "{ 'nnsfun' aT >-> T }" := (@NonNegSimpleFun.type _ aT T) : form_scope. +Notation "{ 'nnsfun' aT >-> T }" := (@NonNegSimpleFun.type _ aT%type T) : form_scope. Notation "[ 'nnsfun' 'of' f ]" := [the {nnsfun _ >-> _} of f] : form_scope. +Section ring. +Context (aT : pointedType) (rT : ringType). + +Lemma fimfun_mulr_closed : mulr_closed (@fimfun aT rT). +Proof. +split=> [|f g]; rewrite !inE/=; first exact: finite_image_cst. +by move=> fA gA; apply: (finite_image11 (fun x y => x * y)). +Qed. +HB.instance Definition _ := GRing.isMulClosed.Build _ fimfun fimfun_mulr_closed. +HB.instance Definition _ := [SubZmodule_isSubRing of {fimfun aT >-> rT} by <:]. + +Implicit Types (f g : {fimfun aT >-> rT}). + +Lemma fimfunM f g : f * g = f \* g :> (_ -> _). Proof. by []. Qed. +Lemma fimfun1 : (1 : {fimfun aT >-> rT}) = cst 1 :> (_ -> _). Proof. by []. Qed. +Lemma fimfun_prod I r (P : {pred I}) (f : I -> {fimfun aT >-> rT}) (x : aT) : + (\sum_(i <- r | P i) f i) x = \sum_(i <- r | P i) f i x. +Proof. by elim/big_rec2: _ => //= i y ? Pi <-. Qed. +Lemma fimfunX f n : f ^+ n = (fun x => f x ^+ n) :> (_ -> _). +Proof. +by apply/funext => x; elim: n => [|n IHn]//; rewrite !exprS fimfunM/= IHn. +Qed. + +Lemma indic_fimfun_subproof X : @FiniteImage aT rT \1_X. +Proof. +split; apply: (finite_subfset [fset 0; 1]%fset) => x [tt /=]. +by rewrite !inE indicE; case: (_ \in _) => _ <-; rewrite ?eqxx ?orbT. +Qed. +HB.instance Definition _ X := indic_fimfun_subproof X. +Definition indic_fimfun (X : set aT) := [the {fimfun aT >-> rT} of \1_X]. + +HB.instance Definition _ k f := FImFun.copy (k \o* f) (f * cst_fimfun k). +Definition scale_fimfun k f := [the {fimfun aT >-> rT} of k \o* f]. + +End ring. +Arguments indic_fimfun {aT rT} _. + +Section comring. +Context (aT : pointedType) (rT : comRingType). +HB.instance Definition _ := [SubRing_isSubComRing of {fimfun aT >-> rT} by <:]. + +Implicit Types (f g : {fimfun aT >-> rT}). +HB.instance Definition _ f g := FImFun.copy (f \* g) (f * g). +End comring. + +Lemma fimfunE T (R : ringType) (f : {fimfun T >-> R}) x : + f x = \sum_(y \in range f) (y * \1_(f @^-1` [set y]) x). +Proof. +rewrite (fsbigD1 (f x))// /= indicE mem_set// mulr1 fsbig1 ?addr0//. +by move=> y [fy /= /nesym yfx]; rewrite indicE memNset ?mulr0. +Qed. + +Lemma fimfunEord T (R : ringType) (f : {fimfun T >-> R}) + (s := fset_set (f @` setT)) : + forall x, f x = \sum_(i < #|`s|) (s`_i * \1_(f @^-1` [set s`_i]) x). +Proof. +move=> x; rewrite fimfunE fsbig_finite//= (big_nth 0)/= big_mkord. +exact: eq_bigr. +Qed. + +Lemma trivIset_preimage1 {aT rT} D (f : aT -> rT) : + trivIset D (fun x => f @^-1` [set x]). +Proof. by move=> y z _ _ [x [<- <-]]. Qed. + +Lemma trivIset_preimage1_in {aT} {rT : choiceType} (D : set rT) (A : set aT) + (f : aT -> rT) : trivIset D (fun x => A `&` f @^-1` [set x]). +Proof. by move=> y z _ _ [x [[_ <-] [_ <-]]]. Qed. + +Section fimfun_bin. +Variables (d : measure_display) (T : measurableType d). +Variables (R : numDomainType) (f g : {fimfun T >-> R}). + +Lemma max_fimfun_subproof : @FiniteImage T R (f \max g). +Proof. by split; apply: (finite_image11 maxr). Qed. +HB.instance Definition _ := max_fimfun_subproof. + +End fimfun_bin. + +HB.factory Record FiniteDecomp (T : pointedType) (R : ringType) (f : T -> R) := + { fimfunE : exists (r : seq R) (A_ : R -> set T), + forall x, f x = \sum_(y <- r) (y * \1_(A_ y) x) }. +HB.builders Context T R f of @FiniteDecomp T R f. + Lemma finite_subproof: @FiniteImage T R f. + Proof. + split; have [r [A_ fE]] := fimfunE. + suff -> : f = \sum_(y <- r) cst_fimfun y * indic_fimfun (A_ y) by []. + by apply/funext=> x; rewrite fE fimfun_sum. + Qed. + HB.instance Definition _ := finite_subproof. +HB.end. + Section mfun_pred. Context {d} {aT : measurableType d} {rT : realType}. Definition mfun : {pred aT -> rT} := mem [set f | measurable_fun setT f]. @@ -135,23 +264,33 @@ Qed. Lemma mfun_valP f (Pf : f \in mfun) : mfun_Sub Pf = f :> (_ -> _). Proof. by []. Qed. -Canonical mfun_subType := SubType T _ _ mfun_rect mfun_valP. +HB.instance Definition _ := isSub.Build _ _ T mfun_rect mfun_valP. Lemma mfuneqP (f g : {mfun aT >-> rT}) : f = g <-> f =1 g. Proof. by split=> [->//|fg]; apply/val_inj/funext. Qed. -Definition mfuneqMixin := [eqMixin of {mfun aT >-> rT} by <:]. -Canonical mfuneqType := EqType {mfun aT >-> rT} mfuneqMixin. -Definition mfunchoiceMixin := [choiceMixin of {mfun aT >-> rT} by <:]. -Canonical mfunchoiceType := ChoiceType {mfun aT >-> rT} mfunchoiceMixin. +HB.instance Definition _ := [Choice of {mfun aT >-> rT} by <:]. Lemma cst_mfun_subproof x : @isMeasurableFun d aT rT (cst x). -Proof. by split; apply: measurable_fun_cst. Qed. +Proof. by split. Qed. HB.instance Definition _ x := @cst_mfun_subproof x. Definition cst_mfun x := [the {mfun aT >-> rT} of cst x]. Lemma mfun_cst x : @cst_mfun x =1 cst x. Proof. by []. Qed. +HB.instance Definition _ := @isMeasurableFun.Build _ _ rT + (@normr rT rT) (@measurable_normr rT setT). + +HB.instance Definition _ := + isMeasurableFun.Build _ _ _ (@expR rT) (@measurable_expR rT). + +Lemma measurableT_comp_subproof (f : {mfun _ >-> rT}) (g : {mfun aT >-> rT}) : + measurable_fun setT (f \o g). +Proof. apply: measurableT_comp. exact. apply: @measurable_funP _ _ _ g. Qed. + +HB.instance Definition _ (f : {mfun _ >-> rT}) (g : {mfun aT >-> rT}) := + isMeasurableFun.Build _ _ _ (f \o g) (measurableT_comp_subproof _ _). + End mfun. Section ring. @@ -160,20 +299,13 @@ Context d (aT : measurableType d) (rT : realType). Lemma mfun_subring_closed : subring_closed (@mfun _ aT rT). Proof. split=> [|f g|f g]; rewrite !inE/=. -- exact: measurable_fun_cst. +- exact: measurable_cst. - exact: measurable_funB. - exact: measurable_funM. Qed. -Canonical mfun_add := AddrPred mfun_subring_closed. -Canonical mfun_zmod := ZmodPred mfun_subring_closed. -Canonical mfun_mul := MulrPred mfun_subring_closed. -Canonical mfun_subring := SubringPred mfun_subring_closed. -Definition mfun_zmodMixin := [zmodMixin of {mfun aT >-> rT} by <:]. -Canonical mfun_zmodType := ZmodType {mfun aT >-> rT} mfun_zmodMixin. -Definition mfun_ringMixin := [ringMixin of {mfun aT >-> rT} by <:]. -Canonical mfun_ringType := RingType {mfun aT >-> rT} mfun_ringMixin. -Definition mfun_comRingMixin := [comRingMixin of {mfun aT >-> rT} by <:]. -Canonical mfun_comRingType := ComRingType {mfun aT >-> rT} mfun_comRingMixin. +HB.instance Definition _ := GRing.isSubringClosed.Build _ mfun + mfun_subring_closed. +HB.instance Definition _ := [SubChoice_isSubComRing of {mfun aT >-> rT} by <:]. Implicit Types (f g : {mfun aT >-> rT}). @@ -222,19 +354,23 @@ HB.instance Definition _ k f := MeasurableFun.copy (k \o* f) (f * cst_mfun k). Definition scale_mfun k f := [the {mfun aT >-> rT} of k \o* f]. Lemma max_mfun_subproof f g : @isMeasurableFun d aT rT (f \max g). -Proof. by split; apply: measurable_fun_max. Qed. +Proof. by split; apply: measurable_maxr. Qed. HB.instance Definition _ f g := max_mfun_subproof f g. Definition max_mfun f g := [the {mfun aT >-> _} of f \max g]. End ring. Arguments indic_mfun {d aT rT} _. -Lemma measurable_fun_indic d (T : measurableType d) (R : realType) +Lemma measurable_indic d (T : measurableType d) (R : realType) (D A : set T) : measurable A -> measurable_fun D (\1_A : T -> R). Proof. by move=> mA; apply/measurable_funTS; rewrite (_ : \1__ = mindic R mA). Qed. +#[global] Hint Extern 0 (measurable_fun _ (\1__ : _ -> _)) => + (exact: measurable_indic ) : core. +#[deprecated(since="mathcomp-analysis 0.6.3", note="use `measurable_indic` instead")] +Notation measurable_fun_indic := measurable_indic (only parsing). Section sfun_pred. Context {d} {aT : measurableType d} {rT : realType}. @@ -272,15 +408,12 @@ Qed. Lemma sfun_valP f (Pf : f \in sfun) : sfun_Sub Pf = f :> (_ -> _). Proof. by []. Qed. -Canonical sfun_subType := SubType T _ _ sfun_rect sfun_valP. +HB.instance Definition _ := isSub.Build _ _ T sfun_rect sfun_valP. Lemma sfuneqP (f g : {sfun aT >-> rT}) : f = g <-> f =1 g. Proof. by split=> [->//|fg]; apply/val_inj/funext. Qed. -Definition sfuneqMixin := [eqMixin of {sfun aT >-> rT} by <:]. -Canonical sfuneqType := EqType {sfun aT >-> rT} sfuneqMixin. -Definition sfunchoiceMixin := [choiceMixin of {sfun aT >-> rT} by <:]. -Canonical sfunchoiceType := ChoiceType {sfun aT >-> rT} sfunchoiceMixin. +HB.instance Definition _ := [Choice of {sfun aT >-> rT} by <:]. (* TODO: BUG: HB *) (* HB.instance Definition _ (x : rT) := @cst_mfun_subproof aT rT x. *) @@ -312,16 +445,9 @@ by split=> [|f g|f g]; rewrite ?inE/= ?rpred1//; move=> /andP[/= mf ff] /andP[/= mg fg]; rewrite !(rpredB, rpredM). Qed. -Canonical sfun_add := AddrPred sfun_subring_closed. -Canonical sfun_zmod := ZmodPred sfun_subring_closed. -Canonical sfun_mul := MulrPred sfun_subring_closed. -Canonical sfun_subring := SubringPred sfun_subring_closed. -Definition sfun_zmodMixin := [zmodMixin of {sfun aT >-> rT} by <:]. -Canonical sfun_zmodType := ZmodType {sfun aT >-> rT} sfun_zmodMixin. -Definition sfun_ringMixin := [ringMixin of {sfun aT >-> rT} by <:]. -Canonical sfun_ringType := RingType {sfun aT >-> rT} sfun_ringMixin. -Definition sfun_comRingMixin := [comRingMixin of {sfun aT >-> rT} by <:]. -Canonical sfun_comRingType := ComRingType {sfun aT >-> rT} sfun_comRingMixin. +HB.instance Definition _ := GRing.isSubringClosed.Build _ sfun + sfun_subring_closed. +HB.instance Definition _ := [SubChoice_isSubComRing of {sfun aT >-> rT} by <:]. Implicit Types (f g : {sfun aT >-> rT}). @@ -393,6 +519,23 @@ rewrite /preimage /= => [fxfy gzf]. by rewrite gzf -fxfy addrC subrK. Qed. +Section simple_bounded. +Context d (T : measurableType d) (R : realType). + +Lemma simple_bounded (f : {sfun T >-> R}) : bounded_fun f. +Proof. +have /finite_seqP[r fr] := fimfunP f. +exists (fine (\big[maxe/-oo%E]_(i <- r) `|i|%:E)). +split; rewrite ?num_real// => x mx z _; apply/ltW/(le_lt_trans _ mx). +have ? : f z \in r by have := imageT f z; rewrite fr. +rewrite -[leLHS]/(fine `|f z|%:E) fine_le//. + have := @bigmaxe_fin_num _ (map normr r) `|f z|. + by rewrite big_map => ->//; apply/mapP; exists (f z). +by rewrite (bigmax_sup_seq _ _ (lexx _)). +Qed. + +End simple_bounded. + Section nnsfun_functions. Context d (T : measurableType d) (R : realType). @@ -562,9 +705,7 @@ by apply: (mulemu_ge0 (fun x => f @^-1` [set x])); exact: preimage_nnfun0. Qed. End mulem_ge0. -(**********************************) -(* Definition of Simple Integrals *) -(**********************************) +(** Definition of Simple Integrals *) Section simple_fun_raw_integral. Local Open Scope ereal_scope. @@ -706,9 +847,9 @@ End le_sintegral. Lemma is_cvg_sintegral d (T : measurableType d) (R : realType) (m : {measure set T -> \bar R}) (f : {nnsfun T >-> R}^nat) : - (forall x, nondecreasing_seq (f ^~ x)) -> cvg (sintegral m \o f). + (forall x, nondecreasing_seq (f ^~ x)) -> cvgn (sintegral m \o f). Proof. -move=> nd_f; apply/cvg_ex; eexists; apply/ereal_nondecreasing_cvg => a b ab. +move=> nd_f; apply/cvg_ex; eexists; apply/ereal_nondecreasing_cvgn => a b ab. by apply: le_sintegral => // => x; exact/nd_f. Qed. @@ -732,7 +873,7 @@ Context d (T : measurableType d) (R : realType). Variable mu : {measure set T -> \bar R}. Variables (g : {nnsfun T >-> R}^nat) (f : {nnsfun T >-> R}). Hypothesis nd_g : forall x, nondecreasing_seq (g^~ x). -Hypothesis gf : forall x, cvg (g^~ x) -> f x <= lim (g^~ x). +Hypothesis gf : forall x, cvgn (g^~ x) -> f x <= limn (g^~ x). Let fleg c : (set T)^nat := fun n => [set x | c * f x <= g n x]. @@ -750,8 +891,8 @@ rewrite /fleg [X in _ X](_ : _ = \big[setU/set0]_(y <- fset_set (range f)) apply: bigsetU_measurable => r _; apply: bigsetU_measurable => r' crr'. exact/measurableI/measurable_sfunP. rewrite predeqE => t; split => [/= cfgn|]. -- rewrite -bigcup_set; exists (f t); first by rewrite /= in_fset_set//= mem_set. - rewrite -bigcup_set_cond; exists (g n t) => //=. +- rewrite -bigcup_seq; exists (f t); first by rewrite /= in_fset_set//= mem_set. + rewrite -bigcup_seq_cond; exists (g n t) => //=. by rewrite in_fset_set// mem_set. - rewrite bigsetU_fset_set// => -[r [x _ fxr]]. rewrite bigsetU_fset_set_cond// => -[r' [[x' _ gnx'r'] crr']]. @@ -762,7 +903,7 @@ Let g1 c n : {nnsfun T >-> R} := proj_nnsfun f (mfleg c n). Let le_ffleg c : {homo (fun p x => g1 c p x): m n / (m <= n)%N >-> (m <= n)%O}. Proof. -move=> m n mn; apply/asboolP => t; rewrite /g1/= ler_pmul// 2!mindicE/= ler_nat. +move=> m n mn; apply/asboolP => t; rewrite /g1/= ler_pM// 2!mindicE/= ler_nat. have [|//] := boolP (t \in fleg c m); rewrite inE => cnt. by have := nd_fleg c mn => /subsetPset/(_ _ cnt) cmt; rewrite mem_set. Qed. @@ -772,22 +913,22 @@ Proof. move=> c1; rewrite predeqE => x; split=> // _. have := @fun_ge0 _ _ f x; rewrite le_eqVlt => /predU1P[|] gx0. by exists O => //; rewrite /fleg /=; rewrite -gx0 mulr0 fun_ge0. -have [cf|df] := pselect (cvg (g^~ x)). - have cfg : lim (g^~ x) > c * f x. - by rewrite (lt_le_trans _ (gf cf)) // gtr_pmull. +have [cf|df] := pselect (cvgn (g^~ x)). + have cfg : limn (g^~ x) > c * f x. + by rewrite (lt_le_trans _ (gf cf)) // gtr_pMl. suff [n cfgn] : exists n, g n x >= c * f x by exists n. move/(@lt_lim _ _ _ (nd_g x) cf) : cfg => [n _ nf]. by exists n; apply: nf => /=. -have /cvgryPge/(_ (c * f x))[n _ ncfgn]:= nondecreasing_dvg_lt (nd_g x) df. +have /cvgryPge/(_ (c * f x))[n _ ncfgn]:= nondecreasing_dvgn_lt (nd_g x) df. by exists n => //; rewrite /fleg /=; apply: ncfgn => /=. Qed. Local Open Scope ereal_scope. -Lemma nd_sintegral_lim_lemma : sintegral mu f <= lim (sintegral mu \o g). +Lemma nd_sintegral_lim_lemma : sintegral mu f <= limn (sintegral mu \o g). Proof. suff ? : forall c, (0 < c < 1)%R -> - c%:E * sintegral mu f <= lim (sintegral mu \o g). + c%:E * sintegral mu f <= limn (sintegral mu \o g). by apply/lee_mul01Pr => //; exact: sintegral_ge0. move=> c /andP[c0 c1]. have cg1g n : c%:E * sintegral mu (g1 c n) <= sintegral mu (g n). @@ -796,14 +937,14 @@ have cg1g n : c%:E * sintegral mu (g1 c n) <= sintegral mu (g n). suff : forall m x, (c * g1 c m x <= g m x)%R by move=> /(_ n t). move=> m x; rewrite /g1 /proj_nnsfun/= mindicE. by have [|] := boolP (_ \in _); [rewrite inE mulr1|rewrite 2!mulr0 fun_ge0]. -suff {cg1g}<- : lim (fun n => sintegral mu (g1 c n)) = sintegral mu f. - have is_cvg_g1 : cvg (fun n => sintegral mu (g1 c n)). +suff {cg1g}<- : limn (fun n => sintegral mu (g1 c n)) = sintegral mu f. + have is_cvg_g1 : cvgn (fun n => sintegral mu (g1 c n)). by apply: is_cvg_sintegral => //= x m n /(le_ffleg c)/lefP/(_ x). rewrite -limeMl // lee_lim//; first exact: is_cvgeMl. - by apply: is_cvg_sintegral => // m n mn; apply/lefP => t; apply: nd_g. - by apply: nearW; exact: cg1g. -suff : (fun n => sintegral mu (g1 c n)) --> sintegral mu f by apply/cvg_lim. -rewrite [X in X --> _](_ : _ = fun n => \sum_(x <- fset_set (range f)) +suff : sintegral mu (g1 c n) @[n \oo] --> sintegral mu f by apply/cvg_lim. +rewrite [X in X @ \oo --> _](_ : _ = fun n => \sum_(x <- fset_set (range f)) x%:E * mu (f @^-1` [set x] `&` fleg c n)); last first. rewrite funeqE => n; rewrite sintegralE. transitivity (\sum_(x \in range f) x%:E * mu (g1 c n @^-1` [set x])). @@ -847,20 +988,20 @@ Context d (T : measurableType d) (R : realType). Variable mu : {measure set T -> \bar R}. Variables (g : {nnsfun T >-> R}^nat) (f : {nnsfun T >-> R}). Hypothesis nd_g : forall x, nondecreasing_seq (g^~ x). -Hypothesis gf : forall x, g ^~ x --> f x. +Hypothesis gf : forall x, g ^~ x @ \oo --> f x. -Let limg x : lim (g^~x) = f x. -Proof. by apply/cvg_lim; [exact: Rhausdorff| exact: gf]. Qed. +Let limg x : limn (g^~ x) = f x. +Proof. by apply/cvg_lim => //; exact: gf. Qed. -Lemma nd_sintegral_lim : sintegral mu f = lim (sintegral mu \o g). +Lemma nd_sintegral_lim : sintegral mu f = limn (sintegral mu \o g). Proof. apply/eqP; rewrite eq_le; apply/andP; split. by apply: nd_sintegral_lim_lemma => // x; rewrite -limg. have : nondecreasing_seq (sintegral mu \o g). by move=> m n mn; apply: le_sintegral => // x; exact/nd_g. -move=> /ereal_nondecreasing_cvg/cvg_lim -> //. +move=> /ereal_nondecreasing_cvgn/cvg_lim -> //. apply: ub_ereal_sup => _ [n _ <-] /=; apply: le_sintegral => // x. -rewrite -limg // (nondecreasing_cvg_le (nd_g x)) //. +rewrite -limg // (nondecreasing_cvgn_le (nd_g x)) //. by apply/cvg_ex; exists (f x); exact: gf. Qed. @@ -1051,42 +1192,42 @@ Variables (mu : {measure set T -> \bar R}) (f : T -> \bar R) Hypothesis f0 : forall x, 0 <= f x. Hypothesis mf : measurable_fun setT f. Hypothesis nd_g : forall x, nondecreasing_seq (g^~x). -Hypothesis gf : forall x, EFin \o g^~x --> f x. +Hypothesis gf : forall x, EFin \o g^~ x @ \oo --> f x. Local Open Scope ereal_scope. -Lemma nd_ge0_integral_lim : \int[mu]_x f x = lim (sintegral mu \o g). +Lemma nd_ge0_integral_lim : \int[mu]_x f x = limn (sintegral mu \o g). Proof. rewrite ge0_integralTE//. apply/eqP; rewrite eq_le; apply/andP; split; last first. apply: lime_le; first exact: is_cvg_sintegral. near=> n; apply: ereal_sup_ub; exists (g n) => //= => x. - have <- : lim (EFin \o g ^~ x) = f x by apply/cvg_lim => //; exact: gf. - have : (EFin \o g ^~ x) --> ereal_sup (range (EFin \o g ^~ x)). - by apply: ereal_nondecreasing_cvg => p q pq /=; rewrite lee_fin; exact/nd_g. + have <- : limn (EFin \o g ^~ x) = f x by apply/cvg_lim => //; exact: gf. + have : EFin \o g ^~ x @ \oo --> ereal_sup (range (EFin \o g ^~ x)). + by apply: ereal_nondecreasing_cvgn => p q pq /=; rewrite lee_fin; exact/nd_g. by move/cvg_lim => -> //; apply: ereal_sup_ub; exists n. have := leey (\int[mu]_x (f x)). rewrite le_eqVlt => /predU1P[|] mufoo; last first. - have : \int[mu]_x (f x) \is a fin_num. - by rewrite ge0_fin_numE//; exact: integral_ge0. + have : \int[mu]_x (f x) \is a fin_num by rewrite ge0_fin_numE// integral_ge0. rewrite ge0_integralTE// => /ub_ereal_sup_adherent h. - apply: lee_adde => e; have {h} [/= _ [G Gf <-]] := h _ [gt0 of e%:num]. + apply/lee_addgt0Pr => _/posnumP[e]. + have {h} [/= _ [G Gf <-]] := h _ [gt0 of e%:num]. rewrite EFinN lte_subl_addr// => fGe. - have : forall x, cvg (g^~ x) -> (G x <= lim (g ^~ x))%R. + have : forall x, cvgn (g^~ x) -> (G x <= limn (g ^~ x))%R. move=> x cg; rewrite -lee_fin -(EFin_lim cg). by have /cvg_lim gxfx := @gf x; rewrite (le_trans (Gf _))// gxfx. move=> /(nd_sintegral_lim_lemma mu nd_g)/(lee_add2r e%:num%:E). by apply: le_trans; exact: ltW. -suff : lim (sintegral mu \o g) = +oo. +suff : limn (sintegral mu \o g) = +oo. by move=> ->; rewrite -ge0_integralTE// mufoo. apply/eqyP => r r0. have [G [Gf rG]] : exists h : {nnsfun T >-> R}, (forall x, (h x)%:E <= f x) /\ (r%:E <= sintegral mu h). have : r%:E < \int[mu]_x (f x). move: (mufoo) => /eqyP/(_ _ (addr_gt0 r0 r0)). - by apply: lt_le_trans => //; rewrite lte_fin ltr_addr. + by apply: lt_le_trans => //; rewrite lte_fin ltrDr. rewrite ge0_integralTE// => /ereal_sup_gt[x [/= G Gf Gx rx]]. by exists G; split => //; rewrite (le_trans (ltW rx)) // Gx. -have : forall x, cvg (g^~ x) -> (G x <= lim (g^~ x))%R. +have : forall x, cvgn (g^~ x) -> (G x <= limn (g^~ x))%R. move=> x cg; rewrite -lee_fin -(EFin_lim cg). by have /cvg_lim gxfx := @gf x; rewrite (le_trans (Gf _)) // gxfx. by move/(nd_sintegral_lim_lemma mu nd_g) => Gg; rewrite (le_trans rG). @@ -1119,27 +1260,27 @@ Lemma bigsetU_dyadic_itv n : `[n%:R, n.+1%:R[%classic = \big[setU/set0]_(n * 2 ^ n.+1 <= k < n.+1 * 2 ^ n.+1) [set` I n.+1 k]. Proof. rewrite predeqE => r; split => [/= /[!in_itv]/= /andP[nr rn1]|]. -- rewrite -bigcup_set /=; exists `|floor (r * 2 ^+ n.+1)|%N. +- rewrite -bigcup_seq /=; exists `|floor (r * 2 ^+ n.+1)|%N. rewrite /= mem_index_iota; apply/andP; split. rewrite -ltez_nat gez0_abs ?floor_ge0; last first. by rewrite mulr_ge0// (le_trans _ nr). apply: (@le_trans _ _ (floor (n * 2 ^ n.+1)%:R)); last first. - by apply: le_floor; rewrite natrM natrX ler_pmul2r. + by apply: le_floor; rewrite natrM natrX ler_pM2r. by rewrite floor_natz intz. rewrite -ltz_nat gez0_abs; last first. by rewrite floor_ge0 mulr_ge0// (le_trans _ nr). rewrite -(@ltr_int R) (le_lt_trans (floor_le _))//. - by rewrite PoszM intrM -natrX ltr_pmul2r. + by rewrite PoszM intrM -natrX ltr_pM2r. rewrite /= in_itv /=; apply/andP; split. - rewrite ler_pdivr_mulr// (le_trans _ (floor_le _))//. + rewrite ler_pdivrMr// (le_trans _ (floor_le _))//. by rewrite -(@gez0_abs (floor _))// floor_ge0 mulr_ge0// (le_trans _ nr). - rewrite ltr_pdivl_mulr// (lt_le_trans (lt_succ_floor _))//. - rewrite -[in leRHS]natr1 ler_add2r// -(@gez0_abs (floor _))// floor_ge0. + rewrite ltr_pdivlMr// (lt_le_trans (lt_succ_floor _))//. + rewrite -[in leRHS]natr1 lerD2r// -(@gez0_abs (floor _))// floor_ge0. by rewrite mulr_ge0// (le_trans _ nr). -- rewrite -bigcup_set => -[/= k] /[!mem_index_iota] /andP[nk kn]. +- rewrite -bigcup_seq => -[/= k] /[!mem_index_iota] /andP[nk kn]. rewrite in_itv /= => /andP[knr rkn]; rewrite in_itv /=; apply/andP; split. - by rewrite (le_trans _ knr)// ler_pdivl_mulr// -natrX -natrM ler_nat. - by rewrite (lt_le_trans rkn)// ler_pdivr_mulr// -natrX -natrM ler_nat. + by rewrite (le_trans _ knr)// ler_pdivlMr// -natrX -natrM ler_nat. + by rewrite (lt_le_trans rkn)// ler_pdivrMr// -natrX -natrM ler_nat. Qed. Lemma dyadic_itv_image n T (f : T -> \bar R) x : @@ -1152,7 +1293,7 @@ move=> fxn; have fxfin : f x \is a fin_num. have : f x \in EFin @` `[n%:R, n.+1%:R[%classic. rewrite inE /=; exists (fine (f x)); last by rewrite fineK. by rewrite in_itv /= -lee_fin -lte_fin (fineK fxfin). -rewrite (bigsetU_dyadic_itv n) inE /= => -[r]; rewrite -bigcup_set => -[k /=]. +rewrite (bigsetU_dyadic_itv n) inE /= => -[r]; rewrite -bigcup_seq => -[k /=]. rewrite mem_index_iota => nk Ir rfx. by exists k; split; [rewrite !(mulnC (2 ^ n.+1)%N)|rewrite !inE /=; exists r]. Qed. @@ -1178,7 +1319,7 @@ Definition approx : (T -> R)^nat := fun n x => Let mA n k : measurable (A n k). Proof. rewrite /A; case: ifPn => [kn|_]//; rewrite -preimage_comp. -by apply: mf => //; apply/measurable_EFin; exact: measurable_itv. +by apply: mf => //; apply/measurable_image_EFin; exact: measurable_itv. Qed. Let trivIsetA n : trivIset setT (A n). @@ -1195,7 +1336,7 @@ rewrite predeqE => t; split => // -[/=] [_]. rewrite inE => -[r /=]; rewrite in_itv /= => /andP[r1 r2] rft [_]. rewrite inE => -[s /=]; rewrite in_itv /= => /andP[s1 s2]. rewrite -rft => -[sr]; rewrite {}sr {s} in s1 s2. -by have := le_lt_trans s1 r2; rewrite ltr_pmul2r// ltr_nat ltnS leqNgt ij. +by have := le_lt_trans s1 r2; rewrite ltr_pM2r// ltr_nat ltnS leqNgt ij. Qed. Let f0_A0 n (i : 'I_(n * 2 ^ n)) x : f x = 0%:E -> i != O :> nat -> @@ -1203,7 +1344,7 @@ Let f0_A0 n (i : 'I_(n * 2 ^ n)) x : f x = 0%:E -> i != O :> nat -> Proof. move=> fx0 i0; rewrite indicE memNset// /A ltn_ord => -[Dx/=] /[1!inE]/= -[r]. rewrite in_itv/= fx0 => + r0; move/eqP : r0 => /[1!eqe] /eqP -> /andP[+ _]. -by rewrite ler_pdivr_mulr// mul0r lern0 (negbTE i0). +by rewrite ler_pdivrMr// mul0r lern0 (negbTE i0). Qed. Let fgen_A0 n x (i : 'I_(n * 2 ^ n)) : (n%:R%:E <= f x)%E -> @@ -1211,7 +1352,7 @@ Let fgen_A0 n x (i : 'I_(n * 2 ^ n)) : (n%:R%:E <= f x)%E -> Proof. move=> fxn; rewrite indicE /A ltn_ord memNset// => -[Dx/=] /[1!inE]/= -[r]. rewrite in_itv/= => /andP[_ h] rfx; move: fxn; rewrite -rfx lee_fin; apply/negP. -rewrite -ltNge (lt_le_trans h)// -natrX ler_pdivr_mulr// -natrM ler_nat. +rewrite -ltNge (lt_le_trans h)// -natrX ler_pdivrMr// -natrM ler_nat. by rewrite (leq_trans (ltn_ord i)). Qed. @@ -1250,7 +1391,7 @@ Let fpos_approx_neq0 x : D x -> (0%E < f x < +oo)%E -> \forall n \near \oo, approx n x != 0. Proof. move=> Dx /andP[fx_gt0 fxoo]. -have fxfin : f x \is a fin_num by rewrite ge0_fin_numE// ltW. +have fxfin : f x \is a fin_num by rewrite gt0_fin_numE. rewrite -(fineK fxfin) lte_fin in fx_gt0; near=> n. rewrite /approx paddr_eq0//; last 2 first. by apply: sumr_ge0 => i _; rewrite mulr_ge0. @@ -1258,21 +1399,24 @@ rewrite /approx paddr_eq0//; last 2 first. rewrite psumr_eq0//; last by move=> i _; rewrite mulr_ge0. apply/negP => /andP[/allP An0]; rewrite mulf_eq0 => /orP[|]. by apply/negP; near: n; exists 1%N => //= m /=; rewrite lt0n pnatr_eq0. -rewrite indicE mem_set ?oner_eq0// /B /= leNgt; split=> //; apply/negP => fxn. +rewrite pnatr_eq0 => /eqP. +have [//|] := boolP (x \in B n). +rewrite notin_set /B /setI /= => /not_andP[] // /negP. +rewrite -ltNge => fxn _. have K : (`|floor (fine (f x) * 2 ^+ n)| < n * 2 ^ n)%N. rewrite -ltz_nat gez0_abs; last by rewrite floor_ge0 mulr_ge0// ltW. rewrite -(@ltr_int R); rewrite (le_lt_trans (floor_le _))// PoszM intrM. - by rewrite -natrX ltr_pmul2r// -lte_fin (fineK fxfin). + by rewrite -natrX ltr_pM2r// -lte_fin (fineK fxfin). have /[!mem_index_enum]/(_ isT) := An0 (Ordinal K). rewrite implyTb indicE mem_set ?mulr1; last first. rewrite /A K /= inE; split=> //=; exists (fine (f x)); last by rewrite fineK. rewrite in_itv /=; apply/andP; split. - rewrite ler_pdivr_mulr// (le_trans _ (floor_le _))//. + rewrite ler_pdivrMr// (le_trans _ (floor_le _))//. by rewrite -(@gez0_abs (floor _))// floor_ge0 mulr_ge0// ltW. - rewrite ltr_pdivl_mulr// (lt_le_trans (lt_succ_floor _))// -[in leRHS]natr1. - by rewrite ler_add2r// -{1}(@gez0_abs (floor _))// floor_ge0// mulr_ge0// ltW. + rewrite ltr_pdivlMr// (lt_le_trans (lt_succ_floor _))// -[in leRHS]natr1. + by rewrite lerD2r// -{1}(@gez0_abs (floor _))// floor_ge0// mulr_ge0// ltW. rewrite mulf_eq0// -exprVn; apply/negP; rewrite negb_or expf_neq0//= andbT. -rewrite pnatr_eq0 -lt0n absz_gt0 floor_neq0// -ler_pdivr_mulr//. +rewrite pnatr_eq0 -lt0n absz_gt0 floor_neq0// -ler_pdivrMr//. apply/orP; right; apply/ltW; near: n. exact: near_infty_natSinv_expn_lt (PosNum fx_gt0). Unshelve. all: by end_near. Qed. @@ -1331,8 +1475,8 @@ have [fxn|fxn] := ltP (f x) n%:R%:E. by rewrite /A /= k2n inE; split => //=; rewrite inE/=; exists r. rewrite xAn1k mulr1 big1 ?addr0; last first. by move=> i ik2n; rewrite (disj_A0 (Ordinal k2n)) // mulr0. - rewrite -(natr1 _ k.*2) mulrDl exprS -mul2n natrM -mulf_div divrr ?unitfE//. - by rewrite !mul1r ler_addl. + rewrite -(@natr1 _ k.*2) mulrDl exprS -mul2n natrM -mulf_div divrr ?unitfE//. + by rewrite !mul1r lerDl. have /orP[{}fxn|{}fxn] : ((n%:R%:E <= f x < n.+1%:R%:E) || (n.+1%:R%:E <= f x))%E. - by move: fxn; case: leP => /= [_ _|_ ->//]; rewrite orbT. @@ -1346,7 +1490,7 @@ have /orP[{}fxn|{}fxn] : have xAn1k : x \in A n.+1 k by rewrite inE /A kn2. rewrite indicE xAn1k mulr1 big1 ?addr0; last first. by move=> i /= ikn2; rewrite (disj_A0 (Ordinal kn2)) // mulr0. - by rewrite -natrX ler_pdivl_mulr// mulrC -natrM ler_nat; case/andP : k1. + by rewrite -natrX ler_pdivlMr// mulrC -natrM ler_nat; case/andP : k1. - have xBn : x \in B n by rewrite /B inE /= (le_trans _ fxn) // lee_fin ler_nat. rewrite /approx indicE xBn mulr1. have xBn1 : x \in B n.+1 by rewrite /B /= inE. @@ -1356,10 +1500,10 @@ have /orP[{}fxn|{}fxn] : Qed. Lemma cvg_approx x (f0 : forall x, D x -> (0 <= f x)%E) : D x -> - (f x < +oo)%E -> (approx^~ x) --> fine (f x). + (f x < +oo)%E -> approx^~ x @ \oo --> fine (f x). Proof. move=> Dx fxoo; have fxfin : f x \is a fin_num by rewrite ge0_fin_numE// f0. -apply/(@cvgrPdist_lt _ [normedModType R of R^o]) => _/posnumP[e]. +apply/(@cvgrPdist_lt _ [the normedModType R of R^o]) => _/posnumP[e]. have [fx0|fx0] := eqVneq (f x) 0%E. by near=> n; rewrite f0_approx0 // fx0 /= subrr normr0. have /(fpos_approx_neq0 Dx)[m _ Hm] : (0 < f x < +oo)%E by rewrite lt0e fx0 f0. @@ -1378,13 +1522,13 @@ have [approx_nx0|[k [/andP[k0 kn2n] ? ->]]] := f_ub_approx fxn. rewrite inE /= => -[r /=]; rewrite in_itv /= => /andP[k1 k2] rfx. rewrite (@le_lt_trans _ _ (1 / 2 ^+ n)) //. rewrite ler_norml; apply/andP; split. - rewrite ler_subr_addl -mulrBl -lee_fin (fineK fxfin) -rfx lee_fin. - by rewrite (le_trans _ k1)// ler_pmul2r// ler_subl_addl ler_addr. - by rewrite ler_subl_addr -mulrDl -lee_fin nat1r fineK// ltW// -rfx lte_fin. + rewrite lerBrDl -mulrBl -lee_fin (fineK fxfin) -rfx lee_fin. + by rewrite (le_trans _ k1)// ler_pM2r// lerBlDl lerDr. + by rewrite lerBlDr -mulrDl -lee_fin nat1r fineK// ltW// -rfx lte_fin. by near: n; exact: near_infty_natSinv_expn_lt. Unshelve. all: by end_near. Qed. -Lemma le_approx k x (f0 : forall x, (0 <= f x)%E) : D x -> +Lemma le_approx k x (f0 : forall x, D x -> (0 <= f x)%E) : D x -> ((approx k x)%:E <= f x)%E. Proof. move=> Dx; have [fixoo|] := ltP (f x) (+oo%E); last first. @@ -1393,14 +1537,14 @@ have nd_ag : {homo approx ^~ x : n m / (n <= m)%N >-> n <= m}. by move=> m n mn; exact/lefP/nd_approx. have fi0 y : D y -> (0 <= f y)%E by move=> ?; exact: f0. have cvg_af := cvg_approx fi0 Dx fixoo. -have is_cvg_af : cvg (approx ^~ x) by apply/cvg_ex; eexists; exact: cvg_af. -have {is_cvg_af} := nondecreasing_cvg_le nd_ag is_cvg_af k. +have is_cvg_af : cvgn (approx ^~ x) by apply/cvg_ex; eexists; exact: cvg_af. +have {is_cvg_af} := nondecreasing_cvgn_le nd_ag is_cvg_af k. rewrite -lee_fin => /le_trans; apply. -rewrite -(@fineK _ (f x)); last by rewrite ge0_fin_numE. +rewrite -(@fineK _ (f x)); last by rewrite ge0_fin_numE// f0. by move/(cvg_lim (@Rhausdorff R)) : cvg_af => ->. Qed. -Lemma dvg_approx x : D x -> f x = +oo%E -> ~ cvg (approx^~ x : _ -> R^o). +Lemma dvg_approx x : D x -> f x = +oo%E -> ~ cvgn (approx^~ x : _ -> R^o). Proof. move=> Dx fxoo; have approx_x n : approx n x = n%:R. rewrite /approx foo_B1// mulr1 big1 ?add0r// => /= i _. @@ -1409,29 +1553,29 @@ case/cvg_ex => /= l; have [l0|l0] := leP 0%R l. - move=> /cvgrPdist_lt/(_ _ ltr01) -[n _]. move=> /(_ (`|ceil l|.+1 + n)%N) /= /(_ (leq_addl _ _)). rewrite approx_x. - apply/negP; rewrite -leNgt distrC (le_trans _ (ler_sub_norm_add _ _)) //. - rewrite normrN ler_subr_addl addSnnS [leRHS]ger0_norm ?ler0n//. - rewrite natrD ler_add// ?ler1n// ger0_norm // (le_trans (ceil_ge _)) //. + apply/negP; rewrite -leNgt distrC (le_trans _ (lerB_normD _ _)) //. + rewrite normrN lerBrDl addSnnS [leRHS]ger0_norm ?ler0n//. + rewrite natrD lerD// ?ler1n// ger0_norm // (le_trans (ceil_ge _)) //. by rewrite -(@gez0_abs (ceil _)) // ceil_ge0. - move/cvgrPdist_lt => /(_ _ ltr01) -[n _]. move=> /(_ (`|floor l|.+1 + n)%N) /= /(_ (leq_addl _ _)). rewrite approx_x. - apply/negP; rewrite -leNgt distrC (le_trans _ (ler_sub_norm_add _ _)) //. - rewrite normrN ler_subr_addl addSnnS [leRHS]ger0_norm ?ler0n//. - rewrite natrD ler_add// ?ler1n// ler0_norm //; last by rewrite ltW. + apply/negP; rewrite -leNgt distrC (le_trans _ (lerB_normD _ _)) //. + rewrite normrN lerBrDl addSnnS [leRHS]ger0_norm ?ler0n//. + rewrite natrD lerD// ?ler1n// ler0_norm //; last by rewrite ltW. rewrite (@le_trans _ _ (- floor l)%:~R) //. - by rewrite mulrNz ler_oppl opprK floor_le. + by rewrite mulrNz lerNl opprK floor_le. by rewrite -(@lez0_abs (floor _)) // floor_le0 // ltW. Qed. Lemma ecvg_approx (f0 : forall x, D x -> (0 <= f x)%E) x : - D x -> EFin \o approx^~x --> f x. + D x -> EFin \o approx^~x @ \oo --> f x. Proof. move=> Dx; have := leey (f x); rewrite le_eqVlt => /predU1P[|] fxoo. have dvg_approx := dvg_approx Dx fxoo. have : {homo approx ^~ x : n m / (n <= m)%N >-> n <= m}. by move=> m n mn; have := nd_approx mn => /lefP; exact. - move/nondecreasing_dvg_lt => /(_ dvg_approx). + move/nondecreasing_dvgn_lt => /(_ dvg_approx). by rewrite fxoo => ?; apply/cvgeryP. rewrite -(@fineK _ (f x)); first exact: (cvg_comp (cvg_approx f0 Dx fxoo)). by rewrite ge0_fin_numE// f0. @@ -1456,7 +1600,7 @@ by apply: eq_bigr => i _; case: Bool.bool_dec => [h|/negP]; [|rewrite ltn_ord]. Qed. Lemma cvg_nnsfun_approx (f0 : forall x, D x -> (0 <= f x)%E) x : - D x -> EFin \o nnsfun_approx^~x --> f x. + D x -> EFin \o nnsfun_approx^~x @ \oo --> f x. Proof. by move=> Dx; under eq_fun do rewrite nnsfun_approxE; exact: ecvg_approx. Qed. @@ -1469,7 +1613,7 @@ Qed. Lemma approximation : (forall t, D t -> (0 <= f t)%E) -> exists g : {nnsfun T >-> R}^nat, nondecreasing_seq (g : (T -> R)^nat) /\ - (forall x, D x -> EFin \o g^~x --> f x). + (forall x, D x -> EFin \o g^~ x @ \oo --> f x). Proof. exists nnsfun_approx; split; [exact: nd_nnsfun_approx|]. by move=> x Dx; exact: cvg_nnsfun_approx. @@ -1477,6 +1621,7 @@ Qed. End approximation. + Section semi_linearity0. Local Open Scope ereal_scope. Context d (T : measurableType d) (R : realType). @@ -1485,7 +1630,7 @@ Variables f1 f2 : T -> \bar R. Hypothesis f10 : forall x, D x -> 0 <= f1 x. Hypothesis mf1 : measurable_fun D f1. -Lemma ge0_integralM_EFin k : (0 <= k)%R -> +Lemma ge0_integralZl_EFin k : (0 <= k)%R -> \int[mu]_(x in D) (k%:E * f1 x) = k%:E * \int[mu]_(x in D) f1 x. Proof. rewrite integral_mkcond erestrict_scale [in RHS]integral_mkcond => k0. @@ -1503,13 +1648,15 @@ rewrite (@nd_ge0_integral_lim _ _ _ mu (fun x => k%:E * h1 x) kg). [exact/(lef_at x nd_g)|exact: gh1]. by under eq_fun do rewrite (sintegralrM mu k (g _)). - by move=> t; rewrite mule_ge0. -- by move=> x m n mn; rewrite /kg ler_pmul//; exact/lefP/nd_g. +- by move=> x m n mn; rewrite /kg ler_pM//; exact/lefP/nd_g. - move=> x. - rewrite [X in X --> _](_ : _ = (fun n => k%:E * (g n x)%:E)) ?funeqE//. + rewrite [X in X @ \oo --> _](_ : _ = (fun n => k%:E * (g n x)%:E)) ?funeqE//. by apply: cvgeMl => //; exact: gh1. Qed. End semi_linearity0. +#[deprecated(since="mathcomp-analysis 0.6.4", note="use `ge0_integralZl_EFin` instead")] +Notation ge0_integralM_EFin := ge0_integralZl_EFin (only parsing). Section semi_linearity. Local Open Scope ereal_scope. @@ -1580,38 +1727,27 @@ have h1tfin : h1 t \is a fin_num. have := gh1 t. rewrite -(fineK h1tfin) => /fine_cvgP[ft_near]. set u_ := (X in X --> _) => u_h1 g1h1. -have <- : lim u_ = fine (h1 t) by apply/cvg_lim => //; exact: Rhausdorff. -rewrite lee_fin; apply: nondecreasing_cvg_le. +have <- : lim u_ = fine (h1 t) by exact/cvg_lim. +rewrite lee_fin; apply: nondecreasing_cvgn_le. by move=> // a b ab; rewrite /u_ /=; exact/lefP/nd_g1. by apply/cvg_ex; eexists; exact: u_h1. Unshelve. all: by end_near. Qed. End semi_linearity. -Lemma emeasurable_funN d (T : measurableType d) (R : realType) D (f : T -> \bar R) : - measurable D -> measurable_fun D f -> measurable_fun D (fun x => - f x)%E. -Proof. -by move=> mD mf; apply: measurable_funT_comp => //; exact: emeasurable_fun_minus. -Qed. - Section approximation_sfun. Context d (T : measurableType d) (R : realType) (f : T -> \bar R). Variables (D : set T) (mD : measurable D) (mf : measurable_fun D f). Lemma approximation_sfun : - exists g : {sfun T >-> R}^nat, (forall x, D x -> EFin \o g^~x --> f x). -Proof. -have fp0 : (forall x, 0 <= f^\+ x)%E by []. -have mfp : measurable_fun D f^\+%E. - by apply: emeasurable_fun_max => //; exact: measurable_fun_cst. -have fn0 : (forall x, 0 <= f^\- x)%E by []. -have mfn : measurable_fun D f^\-%E. - by apply: emeasurable_fun_max => //; - [exact: emeasurable_funN | exact: measurable_fun_cst]. -have [fp_ [fp_nd fp_cvg]] := approximation mD mfp (fun x _ => fp0 x). -have [fn_ [fn_nd fn_cvg]] := approximation mD mfn (fun x _ => fn0 x). + exists g : {sfun T >-> R}^nat, (forall x, D x -> EFin \o g^~ x @ \oo --> f x). +Proof. +have [fp_ [fp_nd fp_cvg]] := + approximation mD (measurable_funepos mf) (fun=> ltac:(by [])). +have [fn_ [fn_nd fn_cvg]] := + approximation mD (measurable_funeneg mf) (fun=> ltac:(by [])). exists (fun n => [the {sfun T >-> R} of fp_ n \+ cst (-1) \* fn_ n]) => x /=. -rewrite [X in X --> _](_ : _ = +rewrite [X in X @ \oo --> _](_ : _ = EFin \o fp_^~ x \+ (-%E \o EFin \o fn_^~ x))%E; last first. by apply/funext => n/=; rewrite EFinD mulN1r. by move=> Dx; rewrite (funeposneg f); apply: cvgeD; @@ -1620,6 +1756,128 @@ Qed. End approximation_sfun. +Section lusin. +Hint Extern 0 (hausdorff_space _) => (exact: Rhausdorff ) : core. +Local Open Scope ereal_scope. +Context (rT : realType) (A : set rT). +Let mu := [the measure _ _ of @lebesgue_measure rT]. +Let R := [the measurableType _ of measurableTypeR rT]. +Hypothesis mA : measurable A. +Hypothesis finA : mu A < +oo. + +Let lusin_simple (f : {sfun R >-> rT}) (eps : rT) : (0 < eps)%R -> + exists K, [/\ compact K, K `<=` A, mu (A `\` K) < eps%:E & + {within K, continuous f}]. +Proof. +move: eps=> _/posnumP[eps]; have [N /card_fset_set rfN] := fimfunP f. +pose Af x : set R := A `&` f @^-1` [set x]. +have mAf x : measurable (Af x) by exact: measurableI. +have finAf x : mu (Af x) < +oo. + by rewrite (le_lt_trans _ finA)// le_measure// ?inE//; exact: subIsetl. +have eNpos : (0 < eps%:num/N.+1%:R)%R by []. +have dK' x := lebesgue_regularity_inner (mAf x) (finAf x) eNpos. +pose dK x : set R := projT1 (cid (dK' x)); pose J i : set R := Af i `\` dK i. +have dkP x := projT2 (cid (dK' x)). +have mdK i : measurable (dK i). + by apply: closed_measurable; apply: compact_closed => //; case: (dkP i). +have mJ i : measurable (J i) by apply: measurableD => //; exact: measurableI. +have dKsub z : dK z `<=` f @^-1` [set z]. + by case: (dkP z) => _ /subset_trans + _; apply => ? []. +exists (\bigcup_(i in range f) dK i); split. +- by rewrite -bigsetU_fset_set//; apply: bigsetU_compact=>// i _; case: (dkP i). +- by move=> z [y _ dy]; have [_ /(_ _ dy) []] := dkP y. +- have -> : A `\` \bigcup_(i in range f) dK i = \bigcup_(i in range f) J i. + rewrite -bigcupDr /= ?eqEsubset; last by exists (f point), point. + split => z; first by move=> /(_ (f z)) [//| ? ?]; exists (f z). + case => ? [? _ <-] [[zab /= <- nfz]] ? [r _ <-]; split => //. + by move: nfz; apply: contra_not => /[dup] /dKsub ->. + apply: (@le_lt_trans _ _ (\sum_(i \in range f) mu (J i))). + by apply: content_sub_fsum => //; exact: fin_bigcup_measurable. + apply: le_lt_trans. + apply: (@lee_fsum _ _ _ _ (fun=> (eps%:num / N.+1%:R)%:E * 1%:E)) => //. + by move=> i ?; rewrite mule1; apply: ltW; have [_ _] := dkP i. + rewrite /=-ge0_mule_fsumr // -esum_fset // finite_card_sum // -EFinM lte_fin. + by rewrite rfN -mulrA gtr_pMr // mulrC ltr_pdivrMr // mul1r ltr_nat. +- suff : closed (\bigcup_(i in range f) dK i) /\ + {within \bigcup_(i in range f) dK i, continuous f} by case. + rewrite -bigsetU_fset_set //. + apply: (@big_ind _ (fun U => closed U /\ {within U, continuous f})). + + by split; [exact: closed0 | exact: continuous_subspace0]. + + by move=> ? ? [? ?][? ?]; split; [exact: closedU|exact: withinU_continuous]. + + move=> i _; split; first by apply: compact_closed; have [] := dkP i. + apply: (continuous_subspaceW (dKsub i)). + apply: (@subspace_eq_continuous _ _ _ (fun=> i)). + by move=> ? /set_mem ->. + by apply: continuous_subspaceT => ?; exact: cvg_cst. +Qed. + +Let measurable_almost_continuous' (f : R -> R) (eps : rT) : + (0 < eps)%R -> measurable_fun A f -> exists K, + [/\ measurable K, K `<=` A, mu (A `\` K) < eps%:E & + {within K, continuous f}]. +Proof. +move: eps=> _/posnumP[eps] mf; pose f' := EFin \o f. +have mf' : measurable_fun A f' by exact/EFin_measurable_fun. +have [/= g_ gf'] := @approximation_sfun _ R rT _ _ mA mf'. +pose e2n n := (eps%:num / 2) / (2 ^ n.+1)%:R. +have e2npos n : (0 < e2n n)%R by rewrite divr_gt0. +have gK' n := @lusin_simple (g_ n) (e2n n) (e2npos n). +pose gK n := projT1 (cid (gK' n)); have gKP n := projT2 (cid (gK' n)). +pose K := \bigcap_i gK i; have mgK n : measurable (gK n). + by apply: closed_measurable; apply: compact_closed => //; have [] := gKP n. +have mK : measurable K by exact: bigcap_measurable. +have Kab : K `<=` A by move=> z /(_ O I); have [_ + _ _] := gKP O; apply. +have []// := @pointwise_almost_uniform _ rT R mu g_ f K (eps%:num / 2). +- by move=> n; exact: measurable_funTS. +- exact: (measurable_funS _ Kab). +- by rewrite (@le_lt_trans _ _ (mu A))// le_measure// ?inE. +- by move=> z Kz; have /fine_fcvg := gf' z (Kab _ Kz); rewrite -fmap_comp compA. +move=> D [/= mD Deps KDf]; exists (K `\` D); split => //. +- exact: measurableD. +- exact: subset_trans Kab. +- rewrite setDDr; apply: le_lt_trans => /=. + by apply: measureU2 => //; apply: measurableI => //; apply: measurableC. + rewrite [_%:num]splitr EFinD; apply: lee_lt_add => //=; first 2 last. + + by rewrite (@le_lt_trans _ _ (mu D)) ?le_measure ?inE//; exact: measurableI. + + rewrite ge0_fin_numE// (@le_lt_trans _ _ (mu A))// le_measure ?inE//. + exact: measurableD. + rewrite setDE setC_bigcap setI_bigcupr. + apply: (@le_trans _ _(\sum_(k //; [|apply: bigcup_measurable => + _]. + by move=> k /=; apply: measurableD => //; apply: mgK. + by move=> k /=; apply: measurableD => //; apply: mgK. + apply: (@le_trans _ _(\sum_(k // k _; apply: ltW; have [] := gKP k. +apply: (@uniform_limit_continuous_subspace _ _ _ (g_ @ \oo)) => //. +near_simpl; apply: nearW => // n; apply: (@continuous_subspaceW _ _ _ (gK n)). + by move=> z [+ _]; apply. +by have [] := projT2 (cid (gK' n)). +Qed. + +Lemma measurable_almost_continuous (f : R -> R) (eps : rT) : + (0 < eps)%R -> measurable_fun A f -> exists K, + [/\ compact K, K `<=` A, mu (A `\` K) < eps%:E & + {within K, continuous f}]. +Proof. +move: eps=> _/posnumP[eps] mf; have e2pos : (0 < eps%:num/2)%R by []. +have [K [mK KA ? ?]] := measurable_almost_continuous' e2pos mf. +have Kfin : mu K < +oo by rewrite (le_lt_trans _ finA)// le_measure ?inE. +have [D /= [cD DK KDe]] := lebesgue_regularity_inner mK Kfin e2pos. +exists D; split => //; last exact: (continuous_subspaceW DK). + exact: (subset_trans DK). +have -> : A `\` D = (A `\` K) `|` (K `\` D). + rewrite eqEsubset; split => z. + by case: (pselect (K z)) => // ? [? ?]; [right | left]. + case; case=> az nz; split => //; [by move: z nz {az}; apply/subsetC|]. + exact: KA. +apply: le_lt_trans. + apply: measureU2; apply: measurableD => //; apply: closed_measurable. + by apply: compact_closed; first exact: Rhausdorff. +by rewrite [_ eps]splitr EFinD lte_add. +Qed. + +End lusin. + Section emeasurable_fun. Local Open Scope ereal_scope. Context d (T : measurableType d) (R : realType). @@ -1675,7 +1933,7 @@ Lemma emeasurable_fun_sum D I s (h : I -> (T -> \bar R)) : measurable_fun D (fun x => \sum_(i <- s) h i x). Proof. elim: s => [|s t ih] mf. - by under eq_fun do rewrite big_nil; exact: measurable_fun_cst. + by under eq_fun do rewrite big_nil; exact: measurable_cst. under eq_fun do rewrite big_cons //=; apply: emeasurable_funD => //. exact: ih. Qed. @@ -1694,16 +1952,16 @@ Lemma ge0_emeasurable_fun_sum D (h : nat -> (T -> \bar R)) : measurable_fun D (fun x => \sum_(i h0 mh; rewrite [X in measurable_fun _ X](_ : _ = - (fun x => lim_esup (fun n => \sum_(0 <= i < n) h i x))); last first. - apply/funext=> x; rewrite is_cvg_lim_esupE//. + (fun x => limn_esup (fun n => \sum_(0 <= i < n) h i x))); last first. + apply/funext=> x; rewrite is_cvg_limn_esupE//. exact: is_cvg_ereal_nneg_natsum. -by apply: measurable_fun_lim_esup => k; exact: emeasurable_fun_sum. +by apply: measurable_fun_limn_esup => k; exact: emeasurable_fun_sum. Qed. Lemma emeasurable_funB D f g : measurable_fun D f -> measurable_fun D g -> measurable_fun D (f \- g). Proof. -by move=> mf mg mD; apply: emeasurable_funD => //; exact: emeasurable_funN. +by move=> mf mg mD; apply: emeasurable_funD => //; exact: measurableT_comp. Qed. Lemma emeasurable_funM D f g : @@ -1760,10 +2018,46 @@ Qed. Lemma measurable_funeM D (f : T -> \bar R) (k : \bar R) : measurable_fun D f -> measurable_fun D (fun x => k * f x)%E. -Proof. by move=> mf; exact/(emeasurable_funM _ mf)/measurable_fun_cst. Qed. +Proof. by move=> mf; exact/(emeasurable_funM _ mf). Qed. End emeasurable_fun. +Section measurable_fun_measurable2. +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType). +Variables (D : set T) (mD : measurable D). +Implicit Types f g : T -> \bar R. + +Lemma emeasurable_fun_lt f g : measurable_fun D f -> measurable_fun D g -> + measurable (D `&` [set x | f x < g x]). +Proof. +move=> mf mg; under eq_set do rewrite -sube_gt0. +by apply: emeasurable_fun_o_infty => //; exact: emeasurable_funB. +Qed. + +Lemma emeasurable_fun_le f g : measurable_fun D f -> measurable_fun D g -> + measurable (D `&` [set x | f x <= g x]). +Proof. +move=> mf mg; under eq_set do rewrite -sube_le0. +by apply: emeasurable_fun_infty_c => //; exact: emeasurable_funB. +Qed. + +Lemma emeasurable_fun_eq f g : measurable_fun D f -> measurable_fun D g -> + measurable (D `&` [set x | f x = g x]). +Proof. +move=> mf mg; rewrite set_eq_le setIIr. +by apply: measurableI; apply: emeasurable_fun_le. +Qed. + +Lemma emeasurable_fun_neq f g : measurable_fun D f -> measurable_fun D g -> + measurable (D `&` [set x | f x != g x]). +Proof. +move=> mf mg; rewrite set_neq_lt setIUr. +by apply: measurableU; exact: emeasurable_fun_lt. +Qed. + +End measurable_fun_measurable2. + Section ge0_integral_sum. Local Open Scope ereal_scope. Context d (T : measurableType d) (R : realType). @@ -1813,7 +2107,7 @@ Variables (D : set T) (mD : measurable D) (g' : (T -> \bar R)^nat). Hypothesis mg' : forall n, measurable_fun D (g' n). Hypothesis g'0 : forall n x, D x -> 0 <= g' n x. Hypothesis nd_g' : forall x, D x -> nondecreasing_seq (g'^~ x). -Let f' := fun x => lim (g'^~ x). +Let f' := fun x => limn (g'^~ x). Let g n := (g' n \_ D). @@ -1827,10 +2121,12 @@ Proof. by move=> m n mn; rewrite /g/patch; case: ifP => // /set_mem /nd_g' ->. Qed. -Let f := fun x => lim (g^~ x). +Let f := fun x => limn (g^~ x). -Let is_cvg_g t : cvg (g^~ t). -Proof. by move=> ?; apply: ereal_nondecreasing_is_cvg => m n ?; apply/nd_g. Qed. +Let is_cvg_g t : cvgn (g^~ t). +Proof. +by move=> ?; apply: ereal_nondecreasing_is_cvgn => m n ?; exact/nd_g. +Qed. Local Definition g2' n : (T -> R)^nat := approx setT (g n). Local Definition g2 n : {nnsfun T >-> R}^nat := nnsfun_approx measurableT (mg n). @@ -1840,9 +2136,9 @@ Local Definition max_g2' : (T -> R)^nat := Local Definition max_g2 : {nnsfun T >-> R}^nat := fun k => bigmax_nnsfun (g2^~ k) k. -Let is_cvg_g2 n t : cvg (EFin \o (g2 n ^~ t)). +Let is_cvg_g2 n t : cvgn (EFin \o (g2 n ^~ t)). Proof. -apply: ereal_nondecreasing_is_cvg => a b ab. +apply: ereal_nondecreasing_is_cvgn => a b ab. by rewrite lee_fin 2!nnsfun_approxE; exact/lefP/nd_approx. Qed. @@ -1859,9 +2155,9 @@ move=> i /=; rewrite neq_lt; apply/orP/idP => [[//|]|]; last by left. by move=> /(leq_trans (ltn_ord i)); rewrite ltnn. Qed. -Let is_cvg_max_g2 t : cvg (EFin \o max_g2 ^~ t). +Let is_cvg_max_g2 t : cvgn (EFin \o max_g2 ^~ t). Proof. -apply: ereal_nondecreasing_is_cvg => m n mn; rewrite lee_fin. +apply: ereal_nondecreasing_is_cvgn => m n mn; rewrite lee_fin. exact/lefP/nd_max_g2. Qed. @@ -1870,49 +2166,47 @@ Proof. rewrite bigmax_nnsfunE. apply: (@le_trans _ _ (\big[maxe/0%:E]_(i < k) g k x)); last first. by apply/bigmax_leP; split => //; apply: g0D. -rewrite (@big_morph _ _ EFin 0%:E maxe) //; last by move=> *; rewrite maxEFin. +rewrite (big_morph _ (@EFin_max R) erefl) //. apply: le_bigmax2 => i _; rewrite nnsfun_approxE /=. by rewrite (le_trans (le_approx _ _ _)) => //; exact/nd_g/ltnW. Qed. -Let lim_max_g2_f t : lim (EFin \o max_g2 ^~ t) <= f t. -Proof. -apply: lee_lim => //=; [apply: is_cvg_max_g2|apply: is_cvg_g|]. -by near=> n; exact/max_g2_g. +Let lim_max_g2_f t : limn (EFin \o max_g2 ^~ t) <= f t. +Proof. by apply: lee_lim => //=; near=> n; exact/max_g2_g. Unshelve. all: by end_near. Qed. -Let lim_g2_max_g2 t n : lim (EFin\o g2 n ^~ t) <= lim (EFin \o max_g2 ^~ t). +Let lim_g2_max_g2 t n : limn (EFin \o g2 n ^~ t) <= limn (EFin \o max_g2 ^~ t). Proof. -apply: lee_lim => //; [apply: is_cvg_g2|apply: is_cvg_max_g2|]. +apply: lee_lim => //. near=> k; rewrite /= bigmax_nnsfunE lee_fin. have nk : (n < k)%N by near: k; exists n.+1. exact: (bigmax_sup (Ordinal nk)). Unshelve. all: by end_near. Qed. -Let cvg_max_g2_f t : EFin \o max_g2 ^~ t --> f t. +Let cvg_max_g2_f t : EFin \o max_g2 ^~ t @ \oo --> f t. Proof. have /cvg_ex[l g_l] := @is_cvg_max_g2 t. suff : l == f t by move=> /eqP <-. rewrite eq_le; apply/andP; split. by rewrite /f (le_trans _ (lim_max_g2_f _)) // (cvg_lim _ g_l). have := leey l; rewrite le_eqVlt => /predU1P[->|loo]; first by rewrite leey. -rewrite -(cvg_lim _ g_l) //= lime_le => //; first exact: is_cvg_g. +rewrite -(cvg_lim _ g_l) //= lime_le => //. near=> n. have := leey (g n t); rewrite le_eqVlt => /predU1P[|] fntoo. have h := @dvg_approx _ _ _ setT _ t Logic.I fntoo. - have g2oo : lim (EFin \o g2 n ^~ t) = +oo. + have g2oo : limn (EFin \o g2 n ^~ t) = +oo. apply/cvg_lim => //; apply/cvgeryP. under [in X in X --> _]eq_fun do rewrite nnsfun_approxE. have : {homo (approx setT (g n))^~ t : n0 m / (n0 <= m)%N >-> (n0 <= m)%R}. exact/lef_at/nd_approx. - by move/nondecreasing_dvg_lt => /(_ h). - have -> : lim (EFin \o max_g2 ^~ t) = +oo. + by move/nondecreasing_dvgn_lt => /(_ h). + have -> : limn (EFin \o max_g2 ^~ t) = +oo. by have := lim_g2_max_g2 t n; rewrite g2oo leye_eq => /eqP. by rewrite leey. - have approx_g_g := @cvg_approx _ _ _ setT _ t (fun t _ => g0 n t) Logic.I fntoo. - suff : lim (EFin \o g2 n ^~ t) = g n t. + suff : limn (EFin \o g2 n ^~ t) = g n t. by move=> <-; exact: (le_trans _ (lim_g2_max_g2 t n)). - have /cvg_lim <- // : EFin \o (approx setT (g n)) ^~ t --> g n t. + have /cvg_lim <- // : EFin \o (approx setT (g n)) ^~ t @ \oo --> g n t. move/cvg_comp : approx_g_g; apply. by rewrite -(@fineK _ (g n t))// ge0_fin_numE// g0. rewrite (_ : _ \o _ = EFin \o approx setT (g n) ^~ t)// funeqE => m. @@ -1920,7 +2214,7 @@ have := leey (g n t); rewrite le_eqVlt => /predU1P[|] fntoo. Unshelve. all: by end_near. Qed. Lemma monotone_convergence : - \int[mu]_(x in D) (f' x) = lim (fun n => \int[mu]_(x in D) (g' n x)). + \int[mu]_(x in D) (f' x) = limn (fun n => \int[mu]_(x in D) (g' n x)). Proof. rewrite integral_mkcond. under [in RHS]eq_fun do rewrite integral_mkcond -/(g _). @@ -1933,30 +2227,30 @@ apply/eqP; rewrite eq_le; apply/andP; split; last first. by move=> *; exact: nd_g. have ub n : \int[mu]_x g n x <= \int[mu]_x f x. apply: ge0_le_integral => //. - - move=> x _; apply: lime_ge => //; first exact: is_cvg_g. + - move=> x _; apply: lime_ge => //. by apply: nearW => k; exact/g0. - apply: emeasurable_fun_cvg mg _ => x _. - exact: ereal_nondecreasing_is_cvg. - - move=> x Dx; apply: lime_ge => //; first exact: is_cvg_g. + exact: ereal_nondecreasing_is_cvgn. + - move=> x Dx; apply: lime_ge => //. near=> m; have nm : (n <= m)%N by near: m; exists n. exact/nd_g. - by apply: lime_le => //; [exact:ereal_nondecreasing_is_cvg|exact:nearW]. + by apply: lime_le => //; [exact:ereal_nondecreasing_is_cvgn|exact:nearW]. rewrite (@nd_ge0_integral_lim _ _ _ mu _ max_g2) //; last 2 first. - - move=> t; apply: lime_ge => //; first exact: is_cvg_g. + - move=> t; apply: lime_ge => //. by apply: nearW => n; exact: g0. - by move=> t m n mn; exact/lefP/nd_max_g2. apply: lee_lim. - by apply: is_cvg_sintegral => // t m n mn; exact/lefP/nd_max_g2. -- apply: ereal_nondecreasing_is_cvg => // n m nm; apply: ge0_le_integral => //. +- apply: ereal_nondecreasing_is_cvgn => // n m nm; apply: ge0_le_integral => //. by move=> *; exact/nd_g. - apply: nearW => n; rewrite ge0_integralTE//. by apply: ereal_sup_ub; exists (max_g2 n) => // t; exact: max_g2_g. Unshelve. all: by end_near. Qed. Lemma cvg_monotone_convergence : - (fun n => \int[mu]_(x in D) g' n x) --> \int[mu]_(x in D) f' x. + \int[mu]_(x in D) g' n x @[n \oo] --> \int[mu]_(x in D) f' x. Proof. -rewrite monotone_convergence; apply: ereal_nondecreasing_is_cvg => m n mn. +rewrite monotone_convergence; apply: ereal_nondecreasing_is_cvgn => m n mn. by apply: ge0_le_integral => // t Dt; [exact: g'0|exact: g'0|exact: nd_g']. Qed. @@ -1982,27 +2276,27 @@ Qed. End integral_nneseries. -(* generalization of ge0_integralM_EFin to a constant potentially +oo +(* generalization of ge0_integralZl_EFin to a constant potentially +oo using the monotone convergence theorem *) -Section ge0_integralM. +Section ge0_integralZl. Local Open Scope ereal_scope. Context d (T : measurableType d) (R : realType). Variable mu : {measure set T -> \bar R}. Variables (D : set T) (mD : measurable D) (f : T -> \bar R). Hypothesis mf : measurable_fun D f. -Lemma ge0_integralM (k : \bar R) : (forall x, D x -> 0 <= f x) -> +Lemma ge0_integralZl (k : \bar R) : (forall x, D x -> 0 <= f x) -> 0 <= k -> \int[mu]_(x in D) (k * f x)%E = k * \int[mu]_(x in D) (f x). Proof. -move=> f0; move: k => [k|_|//]; first exact: ge0_integralM_EFin. +move=> f0; move: k => [k|_|//]; first exact: ge0_integralZl_EFin. pose g : (T -> \bar R)^nat := fun n x => n%:R%:E * f x. have mg n : measurable_fun D (g n) by apply: measurable_funeM. have g0 n x : D x -> 0 <= g n x. by move=> Dx; apply: mule_ge0; [rewrite lee_fin|exact:f0]. have nd_g x : D x -> nondecreasing_seq (g^~x). by move=> Dx m n mn; rewrite lee_wpmul2r ?f0// lee_fin ler_nat. -pose h := fun x => lim (g^~ x). -transitivity (\int[mu]_(x in D) lim (g^~ x)). +pose h := fun x => limn (g^~ x). +transitivity (\int[mu]_(x in D) limn (g^~ x)). apply: eq_integral => x Dx; apply/esym/cvg_lim => //. have [fx0|fx0|fx0] := ltgtP 0 (f x). - rewrite gt0_mulye//; apply/cvgeyPgey; near=> M. @@ -2010,7 +2304,7 @@ transitivity (\int[mu]_(x in D) lim (g^~ x)). rewrite /g; case: (f x) fx0 => [r r0|_|//]; last first. exists 1%N => // m /= m0. by rewrite mulry gtr0_sg// ?mul1e ?leey// ltr0n. - near=> n; rewrite lee_fin -ler_pdivr_mulr//. + near=> n; rewrite lee_fin -ler_pdivrMr//. near: n; exists `|ceil (M / r)|%N => // m /=. rewrite -(ler_nat R); apply: le_trans. by rewrite natr_absz ger0_norm ?ceil_ge// ceil_ge0// divr_ge0// ?ltW. @@ -2019,16 +2313,16 @@ transitivity (\int[mu]_(x in D) lim (g^~ x)). rewrite /g; case: (f x) fx0 => [r r0|//|_]; last first. exists 1%N => // m /= m0. by rewrite mulrNy gtr0_sg// ?ltr0n// mul1e ?leNye. - near=> n; rewrite lee_fin -ler_ndivr_mulr//. + near=> n; rewrite lee_fin -ler_ndivrMr//. near: n; exists `|ceil (M / r)|%N => // m /=. rewrite -(ler_nat R); apply: le_trans. rewrite natr_absz ger0_norm ?ceil_ge// ceil_ge0// -mulrNN. - by rewrite mulr_ge0// ler_oppr oppr0// ltW// invr_lt0. + by rewrite mulr_ge0// lerNr oppr0// ltW// invr_lt0. - rewrite -fx0 mule0 /g -fx0 [X in X @ _ --> _](_ : _ = cst 0). exact: cvg_cst. by rewrite funeqE => n /=; rewrite mule0. rewrite (monotone_convergence mu mD mg g0 nd_g). -under eq_fun do rewrite /g ge0_integralM_EFin//. +under eq_fun do rewrite /g ge0_integralZl_EFin//. have : 0 <= \int[mu]_(x in D) (f x) by exact: integral_ge0. rewrite le_eqVlt => /predU1P[<-|if_gt0]. by rewrite mule0; under eq_fun do rewrite mule0; rewrite lim_cst. @@ -2048,7 +2342,9 @@ rewrite lee_fin natr_absz ger0_norm ?ceil_ge// ceil_ge0//. by rewrite mulr_ge0// ?invr_ge0//; apply/fine_ge0/integral_ge0. Unshelve. all: by end_near. Qed. -End ge0_integralM. +End ge0_integralZl. +#[deprecated(since="mathcomp-analysis 0.6.4", note="use `ge0_integralZl` instead")] +Notation ge0_integralM := ge0_integralZl (only parsing). Section integral_indic. Local Open Scope ereal_scope. @@ -2064,12 +2360,12 @@ Qed. End integral_indic. -Section integralM_indic. +Section integralZl_indic. Local Open Scope ereal_scope. Context d (T : measurableType d) (R : realType). Variables (m : {measure set T -> \bar R}) (D : set T) (mD : measurable D). -Lemma integralM_indic (f : R -> set T) (k : R) : +Lemma integralZl_indic (f : R -> set T) (k : R) : ((k < 0)%R -> f k = set0) -> measurable (f k) -> \int[m]_(x in D) (k * \1_(f k) x)%:E = k%:E * \int[m]_(x in D) (\1_(f k) x)%:E. @@ -2078,21 +2374,24 @@ move=> fk0 mfk; have [k0|k0] := ltP k 0%R. rewrite integral0_eq//; last by move=> x _; rewrite fk0// indic0 mulr0. by rewrite integral0_eq ?mule0// => x _; rewrite fk0// indic0. under eq_integral do rewrite EFinM. -rewrite ge0_integralM//. -- exact/EFin_measurable_fun/measurable_fun_indic. -- by move=> y _; rewrite lee_fin. +rewrite ge0_integralZl//; first exact/EFin_measurable_fun. +by move=> y _; rewrite lee_fin. Qed. -Lemma integralM_indic_nnsfun (f : {nnsfun T >-> R}) (k : R) : +Lemma integralZl_indic_nnsfun (f : {nnsfun T >-> R}) (k : R) : \int[m]_(x in D) (k * \1_(f @^-1` [set k]) x)%:E = k%:E * \int[m]_(x in D) (\1_(f @^-1` [set k]) x)%:E. Proof. -rewrite (@integralM_indic (fun k => f @^-1` [set k]))// => k0. +rewrite (@integralZl_indic (fun k => f @^-1` [set k]))// => k0. by rewrite preimage_nnfun0. Qed. -End integralM_indic. -Arguments integralM_indic {d T R m D} mD f. +End integralZl_indic. +Arguments integralZl_indic {d T R m D} mD f. +#[deprecated(since="mathcomp-analysis 0.6.4", note="use `integralZl_indic` instead")] +Notation integralM_indic := integralZl_indic (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.4", note="use `integralZl_indic_nnsfun` instead")] +Notation integralM_indic_nnsfun := integralZl_indic_nnsfun (only parsing). Section integral_mscale. Local Open Scope ereal_scope. @@ -2110,10 +2409,9 @@ Let integral_mscale_nnsfun (h : {nnsfun T >-> R}) : Proof. under [LHS]eq_integral do rewrite fimfunE -fsumEFin//. rewrite [LHS]ge0_integral_fsum//; last 2 first. - - move=> r. - exact/EFin_measurable_fun/measurable_funrM/measurable_fun_indic. + - by move=> r; exact/EFin_measurable_fun/measurableT_comp. - by move=> n x _; rewrite EFinM nnfun_muleindic_ge0. -rewrite -[RHS]ge0_integralM//; last 2 first. +rewrite -[RHS]ge0_integralZl//; last 2 first. - exact/EFin_measurable_fun/measurable_funTS. - by move=> x _; rewrite lee_fin. under [RHS]eq_integral. @@ -2121,12 +2419,11 @@ under [RHS]eq_integral. by move=> r; rewrite EFinM nnfun_muleindic_ge0. over. rewrite [RHS]ge0_integral_fsum//; last 2 first. - - move=> r; apply/EFin_measurable_fun/measurable_funrM/measurable_funrM. - exact/measurable_fun_indic. + - by move=> r; apply/EFin_measurable_fun; do 2 apply/measurableT_comp => //. - by move=> n x _; rewrite EFinM mule_ge0// nnfun_muleindic_ge0. -apply eq_fsbigr => r _; rewrite ge0_integralM//. -- by rewrite !integralM_indic_nnsfun//= integral_mscale_indic// muleCA. -- exact/EFin_measurable_fun/measurable_funrM/measurable_fun_indic. +apply: eq_fsbigr => r _; rewrite ge0_integralZl//. +- by rewrite !integralZl_indic_nnsfun//= integral_mscale_indic// muleCA. +- exact/EFin_measurable_fun/measurableT_comp. - by move=> t _; rewrite nnfun_muleindic_ge0. Qed. @@ -2135,27 +2432,27 @@ Lemma ge0_integral_mscale (mf : measurable_fun D f) : \int[mscale k m]_(x in D) f x = k%:num%:E * \int[m]_(x in D) f x. Proof. move=> f0; have [f_ [ndf_ f_f]] := approximation mD mf f0. -transitivity (lim (fun n => \int[mscale k m]_(x in D) (f_ n x)%:E)). +transitivity (limn (fun n => \int[mscale k m]_(x in D) (f_ n x)%:E)). rewrite -monotone_convergence//=. - - by apply eq_integral => x /[!inE] xD; apply/esym/cvg_lim => //=; exact: f_f. + - by apply: eq_integral => x /[!inE] xD; apply/esym/cvg_lim => //=; exact: f_f. - by move=> n; exact/EFin_measurable_fun/measurable_funTS. - by move=> n x _; rewrite lee_fin. - by move=> x _ a b /ndf_ /lefP; rewrite lee_fin. rewrite (_ : \int[m]_(x in D) _ = - lim (fun n => \int[m]_(x in D) (f_ n x)%:E)); last first. + limn (fun n => \int[m]_(x in D) (f_ n x)%:E)); last first. rewrite -monotone_convergence//=. - by apply: eq_integral => x /[!inE] xD; apply/esym/cvg_lim => //; exact: f_f. - by move=> n; exact/EFin_measurable_fun/measurable_funTS. - by move=> n x _; rewrite lee_fin. - by move=> x _ a b /ndf_ /lefP; rewrite lee_fin. rewrite -limeMl//. - by congr (lim _); apply/funext => n /=; rewrite integral_mscale_nnsfun. -apply/ereal_nondecreasing_is_cvg => a b ab; apply ge0_le_integral => //. + by congr (limn _); apply/funext => n /=; rewrite integral_mscale_nnsfun. +apply/ereal_nondecreasing_is_cvgn => a b ab; apply: ge0_le_integral => //. - by move=> x _; rewrite lee_fin. - exact/EFin_measurable_fun/measurable_funTS. - by move=> x _; rewrite lee_fin. - exact/EFin_measurable_fun/measurable_funTS. - by move=> x _; rewrite lee_fin; move/ndf_ : ab => /lefP. +- by move=> x _; rewrite lee_fin; move/ndf_ : ab => /lefP. Qed. End integral_mscale. @@ -2168,22 +2465,23 @@ Variable (f : (T -> \bar R)^nat). Hypothesis mf : forall n, measurable_fun D (f n). Hypothesis f0 : forall n x, D x -> 0 <= f n x. -Lemma fatou : \int[mu]_(x in D) lim_einf (f^~ x) <= - lim_einf (fun n => \int[mu]_(x in D) f n x). +Lemma fatou : \int[mu]_(x in D) limn_einf (f^~ x) <= + limn_einf (fun n => \int[mu]_(x in D) f n x). Proof. pose g n := fun x => einfs (f ^~ x) n. have mg := measurable_fun_einfs mf. have g0 n x : D x -> 0 <= g n x. by move=> Dx; apply: lb_ereal_inf => _ [m /= nm <-]; exact: f0. -rewrite monotone_convergence //; last first. +under eq_integral do rewrite limn_einf_lim. +rewrite limn_einf_lim monotone_convergence //; last first. move=> x Dx m n mn /=; apply: le_ereal_inf => _ /= [p /= np <-]. by exists p => //=; rewrite (leq_trans mn). apply: lee_lim. -- apply/cvg_ex; eexists; apply/ereal_nondecreasing_cvg => a b ab. +- apply/cvg_ex; eexists; apply/ereal_nondecreasing_cvgn => a b ab. apply: ge0_le_integral => //; [exact: g0| exact: mg| exact: g0| exact: mg|]. move=> x Dx; apply: le_ereal_inf => _ [n /= bn <-]. by exists n => //=; rewrite (leq_trans ab). -- apply/cvg_ex; eexists; apply/ereal_nondecreasing_cvg => a b ab. +- apply/cvg_ex; eexists; apply/ereal_nondecreasing_cvgn => a b ab. apply: le_ereal_inf => // _ [n /= bn <-]. by exists n => //=; rewrite (leq_trans ab). - apply: nearW => m. @@ -2207,14 +2505,14 @@ Lemma integralN D (f : T -> \bar R) : \int[mu]_(x in D) - f x = - \int[mu]_(x in D) f x. Proof. have [f_fin _|] := boolP (\int[mu]_(x in D) f^\- x \is a fin_num). - rewrite integralE// [in RHS]integralE// oppeD ?fin_numN// oppeK addeC. + rewrite integralE// [in RHS]integralE// fin_num_oppeD ?fin_numN// oppeK addeC. by rewrite funenegN. rewrite fin_numE negb_and 2!negbK => /orP[nfoo|/eqP nfoo]. exfalso; move/negP : nfoo; apply; rewrite -leeNy_eq; apply/negP. by rewrite -ltNge (lt_le_trans _ (integral_ge0 _ _)). rewrite nfoo adde_defEninfty -leye_eq -ltNge ltey_eq => /orP[f_fin|/eqP pfoo]. - rewrite integralE// [in RHS]integralE// nfoo [in RHS]addeC oppeD//. - by rewrite funenegN. + rewrite integralE [in RHS]integralE nfoo [in RHS]addeC/= funenegN. + by rewrite addye// eqe_oppLR/= (andP (eqbLR (fin_numE _) f_fin)).2. by rewrite integralE// [in RHS]integralE// funeposN funenegN nfoo pfoo. Qed. @@ -2222,8 +2520,8 @@ Lemma integral_ge0N (D : set T) (f : T -> \bar R) : (forall x, D x -> 0 <= f x) -> \int[mu]_(x in D) - f x = - \int[mu]_(x in D) f x. Proof. -move=> f0; rewrite integralN// (eq_integral _ _ (ge0_funenegE _))// integral0. -by rewrite oppe0 fin_num_adde_def. +move=> f0; rewrite integralN // (eq_integral _ _ (ge0_funenegE _))// integral0. +by rewrite oppe0 fin_num_adde_defl. Qed. End integralN. @@ -2260,7 +2558,7 @@ Qed. Local Lemma integral_csty : mu D != 0 -> \int[mu]_(x in D) (cst +oo) x = +oo. Proof. move=> muD0; pose g : (T -> \bar R)^nat := fun n => cst n%:R%:E. -have <- : (fun t => lim (g^~ t)) = cst +oo. +have <- : (fun t => limn (g^~ t)) = cst +oo. rewrite funeqE => t; apply/cvg_lim => //=. apply/cvgeryP/cvgryPge => M; exists `|ceil M|%N => //= m. rewrite /= -(ler_nat R); apply: le_trans. @@ -2272,12 +2570,11 @@ rewrite monotone_convergence //. exists 1%N => // m /= m0; move: muDoo; rewrite leye_eq => /eqP ->. by rewrite mulry gtr0_sg ?mul1e ?leey// ltr0n. exists `|ceil (M / fine (mu D))|%N => // m /=. - rewrite -(ler_nat R) => MDm. - rewrite -(@fineK _ (mu D)); last by rewrite ge0_fin_numE. + rewrite -(ler_nat R) => MDm; rewrite -(@fineK _ (mu D)) ?ge0_fin_numE//. rewrite -lee_pdivr_mulr; last by rewrite fine_gt0// lt0e muD0 measure_ge0. - rewrite lee_fin; apply: le_trans MDm. + rewrite lee_fin (le_trans _ MDm)//. by rewrite natr_absz (le_trans (ceil_ge _))// ler_int ler_norm. -- by move=> n; exact: measurable_fun_cst. +- by move=> n; exact: measurable_cst. - by move=> n x Dx; rewrite lee_fin. - by move=> t Dt n m nm; rewrite /g lee_fin ler_nat. Qed. @@ -2301,7 +2598,7 @@ Lemma integral_pushforward (f : Y -> \bar R) : Proof. move=> mf f0. have [f_ [ndf_ f_f]] := approximation measurableT mf (fun t _ => f0 t). -transitivity (lim (fun n => \int[pushforward mu mphi]_x (f_ n x)%:E)). +transitivity (limn (fun n => \int[pushforward mu mphi]_x (f_ n x)%:E)). rewrite -monotone_convergence//. - by apply: eq_integral => y _; apply/esym/cvg_lim => //; exact: f_f. - by move=> n; exact/EFin_measurable_fun. @@ -2309,8 +2606,7 @@ transitivity (lim (fun n => \int[pushforward mu mphi]_x (f_ n x)%:E)). - by move=> y _ m n mn; rewrite lee_fin; apply/lefP/ndf_. rewrite (_ : (fun _ => _) = (fun n => \int[mu]_x (EFin \o f_ n \o phi) x)). rewrite -monotone_convergence//; last 3 first. - - move=> n /=; apply: measurable_funT_comp; first exact: measurable_fun_EFin. - by apply: measurable_funT_comp => //; exact: measurable_sfun. + - by move=> n /=; apply: measurableT_comp => //; exact: measurableT_comp. - by move=> n x _ /=; rewrite lee_fin. - by move=> x _ m n mn; rewrite lee_fin; exact/lefP/ndf_. by apply: eq_integral => x _ /=; apply/cvg_lim => //; exact: f_f. @@ -2322,20 +2618,16 @@ transitivity (\sum_(k \in range (f_ n)) \int[mu]_x (k * \1_((f_ n @^-1` [set k]) \o phi) x)%:E). under eq_integral do rewrite fimfunE -fsumEFin//. rewrite ge0_integral_fsum//; last 2 first. - - move=> y; apply/EFin_measurable_fun; apply: measurable_funM. - exact: measurable_fun_cst. - by rewrite (_ : \1_ _ = mindic R (measurable_sfunP (f_ n) (measurable_set1 y))). + - by move=> y; apply/EFin_measurable_fun; exact: measurable_funM. - by move=> y x _; rewrite nnfun_muleindic_ge0. - apply eq_fsbigr => r _; rewrite integralM_indic_nnsfun// integral_indic//=. - rewrite (integralM_indic _ (fun r => f_ n @^-1` [set r] \o phi))//. + apply: eq_fsbigr => r _; rewrite integralZl_indic_nnsfun// integral_indic//=. + rewrite (integralZl_indic _ (fun r => f_ n @^-1` [set r] \o phi))//. by congr (_ * _); rewrite [RHS](@integral_indic). by move=> r0; rewrite preimage_nnfun0. rewrite -ge0_integral_fsum//; last 2 first. - - move=> r; apply/EFin_measurable_fun; apply: measurable_funM. - exact: measurable_fun_cst. - by rewrite (_ : \1_ _ = mindic R (mfnphi r)). + - by move=> r; apply/EFin_measurable_fun; exact: measurable_funM. - by move=> r x _; rewrite nnfun_muleindic_ge0. -by apply eq_integral => x _; rewrite fsumEFin// -fimfunE. +by apply: eq_integral => x _; rewrite fsumEFin// -fimfunE. Qed. End transfer. @@ -2350,7 +2642,7 @@ Let ge0_integral_dirac (f : T -> \bar R) (mf : measurable_fun D f) D a -> \int[\d_a]_(x in D) (f x) = f a. Proof. move=> Da; have [f_ [ndf_ f_f]] := approximation mD mf f0. -transitivity (lim (fun n => \int[\d_ a]_(x in D) (f_ n x)%:E)). +transitivity (limn (fun n => \int[\d_ a]_(x in D) (f_ n x)%:E)). rewrite -monotone_convergence//. - apply: eq_integral => x Dx; apply/esym/cvg_lim => //; apply: f_f. by rewrite inE in Dx. @@ -2362,26 +2654,26 @@ rewrite (_ : (fun _ => _) = (fun n => (f_ n a)%:E)). apply/funext => n. under eq_integral do rewrite fimfunE// -fsumEFin//. rewrite ge0_integral_fsum//. -- under eq_fsbigr do rewrite integralM_indic_nnsfun//. +- under eq_fsbigr do rewrite integralZl_indic_nnsfun//. rewrite /= (fsbigD1 (f_ n a))//=; last by exists a. rewrite integral_indic//= diracE mem_set// mule1. rewrite fsbig1 ?adde0// => r /= [_ rfna]. rewrite integral_indic//= diracE memNset ?mule0//=. by apply/not_andP; left; exact/nesym. -- by move=> r; exact/EFin_measurable_fun/measurable_funrM/measurable_fun_indic. +- by move=> r; exact/EFin_measurable_fun/measurableT_comp. - by move=> r x _; rewrite nnfun_muleindic_ge0. Qed. Lemma integral_dirac (f : T -> \bar R) (mf : measurable_fun D f) : - \int[\d_ a]_(x in D) f x = (\1_D a)%:E * f a. + \int[\d_ a]_(x in D) f x = \d_a D * f a. Proof. have [/[!inE] aD|aD] := boolP (a \in D). - rewrite integralE ge0_integral_dirac//; last exact/emeasurable_fun_funepos. - rewrite ge0_integral_dirac//; last exact/emeasurable_fun_funeneg. - by rewrite [in RHS](funeposneg f) indicE mem_set// mul1e. -rewrite indicE (negbTE aD) mul0e -(integral_measure_zero D f)//. -apply: eq_measure_integral => //= S mS DS; rewrite /dirac indicE memNset// => /DS. -by rewrite notin_set in aD. + rewrite integralE ge0_integral_dirac//; last exact/measurable_funepos. + rewrite ge0_integral_dirac//; last exact/measurable_funeneg. + by rewrite [in RHS](funeposneg f) diracE mem_set// mul1e. +rewrite diracE (negbTE aD) mul0e -(integral_measure_zero D f)//. +apply: eq_measure_integral => //= S mS DS; rewrite /dirac indicE memNset//. +by move=> /DS/mem_set; exact/negP. Qed. End integral_dirac. @@ -2396,7 +2688,7 @@ Let integral_measure_sum_indic (E D : set T) (mE : measurable E) (mD : measurable D) : \int[m]_(x in E) (\1_D x)%:E = \sum_(n < N) \int[m_ n]_(x in E) (\1_D x)%:E. Proof. -rewrite integral_indic//= /msum/=; apply eq_bigr => i _. +rewrite integral_indic//= /msum/=; apply: eq_bigr => i _. by rewrite integral_indic// setIT. Qed. @@ -2405,16 +2697,15 @@ Let integralT_measure_sum (f : {nnsfun T >-> R}) : Proof. under eq_integral do rewrite fimfunE -fsumEFin//. rewrite ge0_integral_fsum//; last 2 first. - - move=> r /=; apply: measurable_funT_comp => //. - exact/measurable_funrM/measurable_fun_indic. + - by move=> r /=; apply: measurableT_comp => //; exact: measurableT_comp. - by move=> r t _; rewrite EFinM nnfun_muleindic_ge0. transitivity (\sum_(i \in range f) (\sum_(n < N) i%:E * \int[m_ n]_x (\1_(f @^-1` [set i]) x)%:E)). - apply eq_fsbigr => r _. - rewrite integralM_indic_nnsfun// integral_measure_sum_indic//. - by rewrite ge0_sume_distrr// => n _; apply integral_ge0 => t _; rewrite lee_fin. -rewrite fsbig_finite//= exchange_big/=; apply eq_bigr => i _. -rewrite integralT_nnsfun sintegralE fsbig_finite//=; apply eq_bigr => r _. + apply: eq_fsbigr => r _. + rewrite integralZl_indic_nnsfun// integral_measure_sum_indic//. + by rewrite ge0_sume_distrr// => n _; apply: integral_ge0 => t _; rewrite lee_fin. +rewrite fsbig_finite//= exchange_big/=; apply: eq_bigr => i _. +rewrite integralT_nnsfun sintegralE fsbig_finite//=; apply: eq_bigr => r _. by congr (_ * _); rewrite integral_indic// setIT. Qed. @@ -2426,7 +2717,7 @@ rewrite integral_mkcond. transitivity (\int[m]_x (proj_nnsfun f mD x)%:E). by apply: eq_integral => t _ /=; rewrite /patch mindicE; case: ifPn => // tD; rewrite ?mulr1 ?mulr0. -rewrite integralT_measure_sum; apply eq_bigr => i _. +rewrite integralT_measure_sum; apply: eq_bigr => i _. rewrite [RHS]integral_mkcond; apply: eq_integral => t _. rewrite /= /patch /mindic indicE. by case: (boolP (t \in D)) => tD; rewrite ?mulr1 ?mulr0. @@ -2463,23 +2754,24 @@ rewrite (_ : _ m_ N.+1 = measure_add [the measure _ _ of msum m_ N] (m_ N)); las have mf_ n : measurable_fun D (fun x => (f_ n x)%:E). exact/measurable_funTS/EFin_measurable_fun. have f_ge0 n x : D x -> 0 <= (f_ n x)%:E by move=> Dx; rewrite lee_fin. -have cvg_f_ (m : {measure set T -> \bar R}) : cvg (fun x => \int[m]_(x0 in D) (f_ x x0)%:E). - apply: ereal_nondecreasing_is_cvg => a b ab. - apply ge0_le_integral => //; [exact: f_ge0|exact: f_ge0|]. +have cvg_f_ (m : {measure set T -> \bar R}) : + cvgn (fun x => \int[m]_(x0 in D) (f_ x x0)%:E). + apply: ereal_nondecreasing_is_cvgn => a b ab. + apply: ge0_le_integral => //; [exact: f_ge0|exact: f_ge0|]. by move=> t Dt; rewrite lee_fin; apply/lefP/f_nd. -transitivity (lim (fun n => - \int[measure_add [the measure _ _ of msum m_ N] (m_ N)]_(x in D) (f_ n x)%:E)). +transitivity (limn (fun n => + \int[measure_add (msum m_ N) (m_ N)]_(x in D) (f_ n x)%:E)). rewrite -monotone_convergence//; last first. by move=> t Dt a b ab; rewrite lee_fin; exact/lefP/f_nd. - by apply eq_integral => t /[!inE] Dt; apply/esym/cvg_lim => //; exact: f_f. -transitivity (lim (fun n => + by apply: eq_integral => t /[!inE] Dt; apply/esym/cvg_lim => //; exact: f_f. +transitivity (limn (fun n => \int[msum m_ N]_(x in D) (f_ n x)%:E + \int[m_ N]_(x in D) (f_ n x)%:E)). - by congr (lim _); apply/funext => n; by rewrite integral_measure_add_nnsfun. + by congr (limn _); apply/funext => n; by rewrite integral_measure_add_nnsfun. rewrite limeD//; do?[exact: cvg_f_]; last first. by apply: ge0_adde_def; rewrite inE; apply: lime_ge => //; do?[exact: cvg_f_]; apply: nearW => n; apply: integral_ge0 => //; exact: f_ge0. by congr (_ + _); (rewrite -monotone_convergence//; [ - apply eq_integral => t /[!inE] Dt; apply/cvg_lim => //; exact: f_f | + apply: eq_integral => t /[!inE] Dt; apply/cvg_lim => //; exact: f_f | move=> t Dt a b ab; rewrite lee_fin; exact/lefP/f_nd]). Qed. @@ -2505,7 +2797,7 @@ Let m := mseries m_ O. Let integral_measure_series_indic (D : set T) (mD : measurable D) : \int[m]_x (\1_D x)%:E = \sum_(n i _. +rewrite integral_indic// setIT /m/= /mseries; apply: eq_eseriesr => i _. by rewrite integral_indic// setIT. Qed. @@ -2515,21 +2807,21 @@ Lemma integral_measure_series_nnsfun (D : set T) (mD : measurable D) Proof. under eq_integral do rewrite fimfunE -fsumEFin//. rewrite ge0_integral_fsum//; last 2 first. - - move=> r /=; apply: measurable_funT_comp => //. - exact/measurable_funrM/measurable_fun_indic. + - by move=> r /=; apply: measurableT_comp => //; exact: measurableT_comp. - by move=> r t _; rewrite EFinM nnfun_muleindic_ge0. transitivity (\sum_(i \in range f) (\sum_(n r _. - rewrite integralM_indic_nnsfun// integral_measure_series_indic// nneseriesrM//. - by move=> n _; apply integral_ge0 => t _; rewrite lee_fin. + apply: eq_fsbigr => r _. + rewrite integralZl_indic_nnsfun// integral_measure_series_indic// nneseriesZl//. + by move=> n _; apply: integral_ge0 => t _; rewrite lee_fin. rewrite fsbig_finite//= -nneseries_sum; last first. move=> r j _. have [r0|r0] := leP 0%R r. - by rewrite mule_ge0//; apply integral_ge0 => // t _; rewrite lee_fin. - by rewrite integral0_eq// => x _; rewrite preimage_nnfun0// indicE in_set0. -apply: eq_eseries => k _. -rewrite integralT_nnsfun sintegralE fsbig_finite//=; apply eq_bigr => r _. + by rewrite mule_ge0//; apply: integral_ge0 => // t _; rewrite lee_fin. + rewrite integral0_eq ?mule0// => x _. + by rewrite preimage_nnfun0// indicE in_set0. +apply: eq_eseriesr => k _. +rewrite integralT_nnsfun sintegralE fsbig_finite//=; apply: eq_bigr => r _. by congr (_ * _); rewrite integral_indic// setIT. Qed. @@ -2565,8 +2857,8 @@ apply/eqP; rewrite eq_le; apply/andP; split; last first. rewrite ge0_integralE//=; apply: ub_ereal_sup => /= _ [g /= gf] <-. rewrite -integralT_nnsfun (integral_measure_series_nnsfun _ mD). apply: lee_nneseries => n _. - by apply integral_ge0 => // x _; rewrite lee_fin. -rewrite [leRHS]integral_mkcond; apply ge0_le_integral => //. + by apply: integral_ge0 => // x _; rewrite lee_fin. +rewrite [leRHS]integral_mkcond; apply: ge0_le_integral => //. - by move=> x _; rewrite lee_fin. - exact/EFin_measurable_fun. - by move=> x _; rewrite erestrict_ge0. @@ -2623,28 +2915,30 @@ rewrite integral_mkcond integral0_eq// => x _. by rewrite /restrict; case: ifPn => //; rewrite in_set0. Qed. -Lemma ge0_integral_bigsetU (F : (set T)^nat) (f : T -> \bar R) n : - (forall n, measurable (F n)) -> - let D := \big[setU/set0]_(i < n) F i in +Lemma ge0_integral_bigsetU (I : eqType) (F : I -> set T) (f : T -> \bar R) + (s : seq I) : (forall n, measurable (F n)) -> uniq s -> + trivIset [set` s] F -> + let D := \big[setU/set0]_(i <- s) F i in measurable_fun D f -> (forall x, D x -> 0 <= f x) -> - trivIset `I_n F -> - \int[mu]_(x in D) f x = \sum_(i < n) \int[mu]_(x in F i) f x. -Proof. -move=> mF. -elim: n => [|n ih] D mf f0 tF; first by rewrite /D 2!big_ord0 integral_set0. -rewrite /D big_ord_recr/= integral_setU//; last 4 first. - - exact: bigsetU_measurable. - - by move: mf; rewrite /D big_ord_recr. - - by move: f0; rewrite /D big_ord_recr. - - apply/eqP; move: (trivIset_bigsetUI tF (ltnSn n) (leqnn n)). - rewrite [in X in X -> _](eq_bigl xpredT)// => i. - by rewrite (leq_trans (ltn_ord i)). -rewrite ih ?big_ord_recr//. -- apply: measurable_funS mf => //; first exact: bigsetU_measurable. - by rewrite /D big_ord_recr /=; apply: subsetUl. -- by move=> t Dt; apply: f0; rewrite /D big_ord_recr/=; left. -- by apply: sub_trivIset tF => x; exact: leq_trans. + \int[mu]_(x in D) f x = \sum_(i <- s) \int[mu]_(x in F i) f x. +Proof. +move=> mF; elim: s => [|h t ih] us tF D mf f0. + by rewrite /D 2!big_nil integral_set0. +rewrite /D big_cons integral_setU//. +- rewrite big_cons ih//. + + by move: us => /= /andP[]. + + by apply: sub_trivIset tF => /= i /= it; rewrite inE it orbT. + + apply: measurable_funS mf => //; first exact: bigsetU_measurable. + by rewrite /D big_cons; exact: subsetUr. + + by move=> x UFx; apply: f0; rewrite /D big_cons; right. +- exact: bigsetU_measurable. +- by move: mf; rewrite /D big_cons. +- by move: f0; rewrite /D big_cons. +- apply/eqP; rewrite big_distrr/= big_seq big1// => i it. + move/trivIsetP : tF; apply => //=; rewrite ?mem_head//. + + by rewrite inE it orbT. + + by apply/eqP => hi; move: us => /=; rewrite hi it. Qed. Lemma le_integral_abse (D : set T) (mD : measurable D) (g : T -> \bar R) a : @@ -2652,14 +2946,13 @@ Lemma le_integral_abse (D : set T) (mD : measurable D) (g : T -> \bar R) a : a%:E * mu (D `&` [set x | `|g x| >= a%:E]) <= \int[mu]_(x in D) `|g x|. Proof. move=> mg a0; have ? : measurable (D `&` [set x | a%:E <= `|g x|]). - by apply: emeasurable_fun_c_infty => //; exact: measurable_funT_comp. + by apply: emeasurable_fun_c_infty => //; exact: measurableT_comp. apply: (@le_trans _ _ (\int[mu]_(x in D `&` [set x | `|g x| >= a%:E]) `|g x|)). rewrite -integral_cstr//; apply: ge0_le_integral => //. - by move=> x _ /=; exact/ltW. - - exact/EFin_measurable_fun/measurable_fun_cst. - - by apply: measurable_funT_comp => //; exact: measurable_funS mg. + - by apply: measurableT_comp => //; exact: measurable_funS mg. - by move=> x /= []. -by apply: subset_integral => //; exact: measurable_funT_comp. +by apply: subset_integral => //; exact: measurableT_comp. Qed. End subset_integral. @@ -2677,13 +2970,23 @@ End Rintegral. Notation "\int [ mu ]_ ( x 'in' D ) f" := (Rintegral mu D (fun x => f)) : ring_scope. Notation "\int [ mu ]_ x f" := (Rintegral mu setT (fun x => f)) : ring_scope. -Section integrable. -Local Open Scope ereal_scope. -Context d (T : measurableType d) (R : realType). +HB.lock Definition integrable {d} {T : measurableType d} {R : realType} + (mu : set T -> \bar R) D f := + `[< measurable_fun D f /\ (\int[mu]_(x in D) `|f x| < +oo)%E >]. +Canonical integrable_unlockable := Unlockable integrable.unlock. -Definition integrable (mu : set T -> \bar R) D f := - measurable_fun D f /\ (\int[mu]_(x in D) `|f x| < +oo). +Lemma integrableP d T R mu D f : + reflect (measurable_fun D f /\ (\int[mu]_(x in D) `|f x| < +oo)%E) + (@integrable d T R mu D f). +Proof. by rewrite unlock; apply/(iffP (asboolP _)). Qed. +Lemma measurable_int d T R mu D f : + @integrable d T R mu D f -> measurable_fun D f. +Proof. by rewrite unlock => /asboolP[]. Qed. + +Section integrable_theory. +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType). Variables (mu : {measure set T -> \bar R}). Variables (D : set T) (mD : measurable D). Implicit Type f g : T -> \bar R. @@ -2692,55 +2995,69 @@ Notation mu_int := (integrable mu D). Lemma integrable0 : mu_int (cst 0). Proof. -split; first exact: measurable_fun_cst. -under eq_integral do rewrite (gee0_abs (lexx 0)). +apply/integrableP; split=> //; under eq_integral do rewrite (gee0_abs (lexx 0)). by rewrite integral0. Qed. Lemma eq_integrable f g : {in D, f =1 g} -> mu_int f -> mu_int g. Proof. -move=> fg [mf fi]; split; first exact: eq_measurable_fun mf. +move=> fg /integrableP[mf fi]; apply/integrableP; split. + exact: eq_measurable_fun mf. rewrite (le_lt_trans _ fi)//; apply: ge0_le_integral=> //. - by apply: measurable_funT_comp => //; exact: eq_measurable_fun mf. - by apply: measurable_funT_comp => //; exact: eq_measurable_fun mf. + by apply: measurableT_comp => //; exact: eq_measurable_fun mf. + by apply: measurableT_comp => //; exact: eq_measurable_fun mf. by move=> x Dx; rewrite fg// inE. Qed. Lemma le_integrable f g : measurable_fun D f -> (forall x, D x -> `|f x| <= `|g x|) -> mu_int g -> mu_int f. Proof. -move=> mf fg [mfg goo]; split => //; rewrite (le_lt_trans _ goo) //. -by apply: ge0_le_integral => //; exact: measurable_funT_comp. +move=> mf fg /integrableP[mfg goo]; apply/integrableP; split => //. +by apply: le_lt_trans goo; apply: ge0_le_integral => //; exact: measurableT_comp. Qed. Lemma integrableN f : mu_int f -> mu_int (-%E \o f). Proof. -move=> [mf foo]; split; last by rewrite /comp; under eq_fun do rewrite abseN. -by rewrite /comp; apply: measurable_funT_comp =>//; exact: emeasurable_fun_minus. +move=> /integrableP[mf foo]; apply/integrableP; split; last first. + by rewrite /comp; under eq_fun do rewrite abseN. +by rewrite /comp; apply: measurableT_comp =>//; exact: measurable_oppe. Qed. -Lemma integrablerM (k : R) f : mu_int f -> mu_int (fun x => k%:E * f x). +Lemma integrableZl (k : R) f : mu_int f -> mu_int (fun x => k%:E * f x). Proof. -move=> [mf foo]; split; first exact: measurable_funeM. +move=> /integrableP[mf foo]; apply/integrableP; split. + exact: measurable_funeM. under eq_fun do rewrite abseM. -by rewrite ge0_integralM// ?lte_mul_pinfty//; exact: measurable_funT_comp. +by rewrite ge0_integralZl// ?lte_mul_pinfty//; exact: measurableT_comp. Qed. -Lemma integrableMr (k : R) f : mu_int f -> mu_int (f \* cst k%:E). +Lemma integrableZr (k : R) f : mu_int f -> mu_int (f \* cst k%:E). Proof. -by move=> mf; apply: eq_integrable (integrablerM k mf) => // x; rewrite muleC. +by move=> mf; apply: eq_integrable (integrableZl k mf) => // x; rewrite muleC. Qed. Lemma integrableD f g : mu_int f -> mu_int g -> mu_int (f \+ g). Proof. -move=> [mf foo] [mg goo]; split; first exact: emeasurable_funD. +move=> /integrableP[mf foo] /integrableP[mg goo]; apply/integrableP; split. + exact: emeasurable_funD. apply: (@le_lt_trans _ _ (\int[mu]_(x in D) (`|f x| + `|g x|))). apply: ge0_le_integral => //. - - by apply: measurable_funT_comp => //; exact: emeasurable_funD. - - by apply: emeasurable_funD; apply: measurable_funT_comp. + - by apply: measurableT_comp => //; exact: emeasurable_funD. + - by move=> ? ?; apply: adde_ge0. + - by apply: emeasurable_funD; apply: measurableT_comp. - by move=> *; exact: lee_abs_add. by rewrite ge0_integralD //; [exact: lte_add_pinfty| - exact: measurable_funT_comp|exact: measurable_funT_comp]. + exact: measurableT_comp|exact: measurableT_comp]. +Qed. + +Lemma integrable_sum (s : seq (T -> \bar R)) : + (forall h, h \in s -> mu_int h) -> mu_int (fun x => \sum_(h <- s) h x). +Proof. +elim: s => [_|h s ih hs]. + by under eq_fun do rewrite big_nil; exact: integrable0. +under eq_fun do rewrite big_cons; apply: integrableD => //. +- by apply: hs; rewrite in_cons eqxx. +- by apply: ih => k ks; apply: hs; rewrite in_cons ks orbT. Qed. Lemma integrableB f g : mu_int f -> mu_int g -> mu_int (f \- g). @@ -2749,10 +3066,10 @@ Proof. by move=> fi gi; exact/(integrableD fi)/integrableN. Qed. Lemma integrable_add_def f : mu_int f -> \int[mu]_(x in D) f^\+ x +? - \int[mu]_(x in D) f^\- x. Proof. -move=> [mf]; rewrite -[fun x => _]/(abse \o f) fune_abse => foo. +move=> /integrableP[mf]; rewrite -[fun x => _]/(abse \o f) fune_abse => foo. rewrite ge0_integralD // in foo; last 2 first. - - exact: emeasurable_fun_funepos. - - exact: emeasurable_fun_funeneg. +- exact: measurable_funepos. +- exact: measurable_funeneg. apply: ltpinfty_adde_def. - by apply: le_lt_trans foo; rewrite lee_addl// integral_ge0. - by rewrite inE (@le_lt_trans _ _ 0)// lee_oppl oppe0 integral_ge0. @@ -2760,28 +3077,30 @@ Qed. Lemma integrable_funepos f : mu_int f -> mu_int f^\+. Proof. -move=> [Df foo]; split; first exact: emeasurable_fun_funepos. +move=> /integrableP[Df foo]; apply/integrableP; split. + exact: measurable_funepos. apply: le_lt_trans foo; apply: ge0_le_integral => //. -- by apply/measurable_funT_comp => //; exact: emeasurable_fun_funepos. -- exact/measurable_funT_comp. +- by apply/measurableT_comp => //; exact: measurable_funepos. +- exact/measurableT_comp. - by move=> t Dt; rewrite -/((abse \o f) t) fune_abse gee0_abs// lee_addl. Qed. Lemma integrable_funeneg f : mu_int f -> mu_int f^\-. Proof. -move=> [Df foo]; split; first exact: emeasurable_fun_funeneg. +move=> /integrableP[Df foo]; apply/integrableP; split. + exact: measurable_funeneg. apply: le_lt_trans foo; apply: ge0_le_integral => //. -- by apply/measurable_funT_comp => //; exact: emeasurable_fun_funeneg. -- exact/measurable_funT_comp. +- by apply/measurableT_comp => //; exact: measurable_funeneg. +- exact/measurableT_comp. - by move=> t Dt; rewrite -/((abse \o f) t) fune_abse gee0_abs// lee_addr. Qed. Lemma integral_funeneg_lt_pinfty f : mu_int f -> \int[mu]_(x in D) f^\- x < +oo. Proof. -move=> [mf]; apply: le_lt_trans; apply: ge0_le_integral => //. -- by apply: emeasurable_fun_funeneg => //; exact: emeasurable_funN. -- exact: measurable_funT_comp. +move=> /integrableP[mf]; apply: le_lt_trans; apply: ge0_le_integral => //. +- exact: measurable_funeneg. +- exact: measurableT_comp. - move=> x Dx; have [fx0|/ltW fx0] := leP (f x) 0. rewrite lee0_abs// /funeneg. by move: fx0; rewrite -{1}oppe0 -lee_oppr => /max_idPl ->. @@ -2792,9 +3111,9 @@ Qed. Lemma integral_funepos_lt_pinfty f : mu_int f -> \int[mu]_(x in D) f^\+ x < +oo. Proof. -move=> [mf]; apply: le_lt_trans; apply: ge0_le_integral => //. -- by apply: emeasurable_fun_funepos => //; exact: emeasurable_funN. -- exact: measurable_funT_comp. +move=> /integrableP[mf]; apply: le_lt_trans; apply: ge0_le_integral => //. +- exact: measurable_funepos. +- exact: measurableT_comp. - move=> x Dx; have [fx0|/ltW fx0] := leP (f x) 0. rewrite lee0_abs// /funepos. by move: (fx0) => /max_idPr ->; rewrite -lee_oppr oppe0. @@ -2804,30 +3123,34 @@ Qed. Lemma integrable_neg_fin_num f : mu_int f -> \int[mu]_(x in D) f^\- x \is a fin_num. Proof. -move=> fi. +move=> /integrableP fi. rewrite fin_numElt; apply/andP; split. by rewrite (@lt_le_trans _ _ 0) ?lte_ninfty//; exact: integral_ge0. case: fi => mf; apply: le_lt_trans; apply: ge0_le_integral => //. -- exact/emeasurable_fun_funeneg. -- exact/measurable_funT_comp. +- exact/measurable_funeneg. +- exact/measurableT_comp. - by move=> x Dx; rewrite -/((abse \o f) x) (fune_abse f) lee_addr. Qed. Lemma integrable_pos_fin_num f : mu_int f -> \int[mu]_(x in D) f^\+ x \is a fin_num. Proof. -move=> fi. +move=> /integrableP fi. rewrite fin_numElt; apply/andP; split. by rewrite (@lt_le_trans _ _ 0) ?lte_ninfty//; exact: integral_ge0. case: fi => mf; apply: le_lt_trans; apply: ge0_le_integral => //. -- exact/emeasurable_fun_funepos. -- exact/measurable_funT_comp. +- exact/measurable_funepos. +- exact/measurableT_comp. - by move=> x Dx; rewrite -/((abse \o f) x) (fune_abse f) lee_addl. Qed. -End integrable. +End integrable_theory. Notation "mu .-integrable" := (integrable mu) : type_scope. Arguments eq_integrable {d T R mu D} mD f. +#[deprecated(since="mathcomp-analysis 0.6.4", note="use `integrableZl` instead")] +Notation integrablerM := integrableZl (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.4", note="use `integrableZr` instead")] +Notation integrableMr := integrableZr (only parsing). Section sequence_measure. Local Open Scope ereal_scope. @@ -2843,19 +3166,19 @@ Lemma integral_measure_series (D : set T) (mD : measurable D) (f : T -> \bar R) \int[m]_(x in D) f x = \sum_(n fi mf fmoo fpoo; rewrite integralE. -rewrite ge0_integral_measure_series//; last exact/emeasurable_fun_funepos. -rewrite ge0_integral_measure_series//; last exact/emeasurable_fun_funeneg. +rewrite ge0_integral_measure_series//; last exact/measurable_funepos. +rewrite ge0_integral_measure_series//; last exact/measurable_funeneg. transitivity (\sum_(n n _; rewrite fineK//; + by congr (_ - _); apply: eq_eseriesr => n _; rewrite fineK//; [exact: integrable_pos_fin_num|exact: integrable_neg_fin_num]. have fineKn : \sum_(n n _; congr abse; rewrite fineK//. + apply: eq_eseriesr => n _; congr abse; rewrite fineK//. exact: integrable_neg_fin_num. have fineKp : \sum_(n n _; congr abse; rewrite fineK//. + apply: eq_eseriesr => n _; congr abse; rewrite fineK//. exact: integrable_pos_fin_num. rewrite nneseries_esum; last by move=> n _; exact/fine_ge0/integral_ge0. rewrite nneseries_esum; last by move=> n _; exact/fine_ge0/integral_ge0. @@ -2864,23 +3187,23 @@ rewrite -esumB//; last 4 first. - by rewrite /summable /= -nneseries_esum// -fineKn; exact: fmoo. - by move=> n _; exact/fine_ge0/integral_ge0. - by move=> n _; exact/fine_ge0/integral_ge0. -rewrite -summable_nneseries_esum; last first. - rewrite /summable. +rewrite -summable_eseries_esum; last first. apply: (@le_lt_trans _ _ (\esum_(i in (fun=> true)) `|(fine (\int[m_ i]_(x in D) f x))%:E|)). - apply: le_esum => k _; rewrite -EFinB -fineB// -?integralE//; + by apply: le_esum => k _; rewrite -EFinB -fineB// -?integralE//; [exact: integrable_pos_fin_num|exact: integrable_neg_fin_num]. rewrite -nneseries_esum; last by []. - apply: (@le_lt_trans _ _ (\sum_(n // n _. + apply: (@le_lt_trans _ _ + (\sum_(n // n _. rewrite integralE fineB// ?EFinB. - exact: (le_trans (lee_abs_sub _ _)). - exact: integrable_pos_fin_num. - exact: integrable_neg_fin_num. apply: lte_add_pinfty; first by rewrite -fineKp. by rewrite -fineKn; exact: fmoo. -by apply eq_eseries => k _; rewrite !fineK// -?integralE//; +by apply: eq_eseriesr => k _; rewrite !fineK// -?integralE//; [exact: integrable_neg_fin_num|exact: integrable_pos_fin_num]. Qed. @@ -2899,8 +3222,9 @@ Lemma ge0_integral_bigcup (F : (set _)^nat) (f : T -> \bar R) : trivIset setT F -> \int[mu]_(x in D) f x = \sum_(i mF D fi f0 tF; pose f_ N := f \_ (\big[setU/set0]_(0 <= i < N) F i). -have lim_f_ t : f_ ^~ t --> (f \_ D) t. +move=> mF D /integrableP fi f0 tF. +pose f_ N := f \_ (\big[setU/set0]_(0 <= i < N) F i). +have lim_f_ t : f_ ^~ t @ \oo --> (f \_ D) t. rewrite [X in _ --> X](_ : _ = ereal_sup (range (f_ ^~ t))); last first. apply/eqP; rewrite eq_le; apply/andP; split. rewrite /restrict; case: ifPn => [|_]. @@ -2910,10 +3234,10 @@ have lim_f_ t : f_ ^~ t --> (f \_ D) t. by rewrite /f_ patchN// big_mkord big_ord0 inE/= in_set0. apply: ub_ereal_sup => x [n _ <-]. by rewrite /f_ restrict_lee// big_mkord; exact: bigsetU_bigcup. - apply: ereal_nondecreasing_cvg => a b ab. + apply: ereal_nondecreasing_cvgn => a b ab. rewrite /f_ !big_mkord restrict_lee //; last exact: subset_bigsetU. by move=> x Dx; apply: f0 => //; exact: bigsetU_bigcup Dx. -transitivity (\int[mu]_x lim (f_ ^~ x)). +transitivity (\int[mu]_x limn (f_ ^~ x)). rewrite integral_mkcond; apply: eq_integral => x _. by apply/esym/cvg_lim => //; exact: lim_f_. rewrite monotone_convergence//; last 3 first. @@ -2926,29 +3250,32 @@ rewrite monotone_convergence//; last 3 first. - move=> x _ a b ab; apply: restrict_lee. by move=> y; rewrite big_mkord => Dy; apply: f0; exact: bigsetU_bigcup Dy. by rewrite 2!big_mkord; apply: subset_bigsetU. -transitivity (lim (fun N => \int[mu]_(x in \big[setU/set0]_(i < N) F i) f x)). - congr (lim _); rewrite funeqE => n. - by rewrite /f_ [in RHS]integral_mkcond big_mkord. -congr (lim _); rewrite funeqE => /= n; rewrite ge0_integral_bigsetU ?big_mkord//. +transitivity (limn (fun N => \int[mu]_(x in \big[setU/set0]_(i < N) F i) f x)). + by apply/congr_lim/funext => n; rewrite /f_ [in RHS]integral_mkcond big_mkord. +apply/congr_lim/funext => /= n. +rewrite -(big_mkord xpredT) ge0_integral_bigsetU ?big_mkord//. +- exact: iota_uniq. +- exact: sub_trivIset tF. - case: fi => + _; apply: measurable_funS => //; first exact: bigcup_measurable. exact: bigsetU_bigcup. - by move=> y Dy; apply: f0; exact: bigsetU_bigcup Dy. -- exact: sub_trivIset tF. Qed. Lemma integrableS (E D : set T) (f : T -> \bar R) : measurable E -> measurable D -> D `<=` E -> mu.-integrable E f -> mu.-integrable D f. Proof. -move=> mE mD DE [mf ifoo]; split; first exact: measurable_funS mf. +move=> mE mD DE /integrableP[mf ifoo]; apply/integrableP; split. + exact: measurable_funS mf. apply: le_lt_trans ifoo; apply: subset_integral => //. -exact: measurable_funT_comp. +exact: measurableT_comp. Qed. Lemma integrable_mkcond D f : measurable D -> mu.-integrable D f <-> mu.-integrable setT (f \_ D). Proof. -move=> mD; rewrite /integrable [in X in X <-> _]integral_mkcond. +move=> mD. +rewrite unlock; apply: asbool_equiv; rewrite [in X in X <-> _]integral_mkcond. under [in X in X <-> _]eq_integral do rewrite restrict_abse. split => [|] [mf foo]. - by split; [exact/(measurable_restrict _ _ _ _).1| @@ -2960,11 +3287,26 @@ Qed. End integrable_lemmas. Arguments integrable_mkcond {d T R mu D} f. +Lemma finite_measure_integrable_cst d (T : measurableType d) (R : realType) + (mu : {finite_measure set T -> \bar R}) k : + mu.-integrable [set: T] (EFin \o cst k). +Proof. +apply/integrableP; split; first exact/EFin_measurable_fun. +have [k0|k0] := leP 0 k. +- under eq_integral do rewrite /= ger0_norm//. + rewrite integral_cstr//= lte_mul_pinfty// fin_num_fun_lty//. + exact: fin_num_measure. +- under eq_integral do rewrite /= ltr0_norm//. + rewrite integral_cstr//= lte_mul_pinfty//. + by rewrite lee_fin lerNr oppr0 ltW. + by rewrite fin_num_fun_lty//; exact: fin_num_measure. +Qed. + Section integrable_ae. Local Open Scope ereal_scope. Context d (T : measurableType d) (R : realType). Variables (mu : {measure set T -> \bar R}) (D : set T) (mD : measurable D). -Variable (f : T -> \bar R). +Variable f : T -> \bar R. Hypotheses fint : mu.-integrable D f. Lemma integrable_ae : {ae mu, forall x, D x -> f x \is a fin_num}. @@ -2973,49 +3315,45 @@ have [muD0|muD0] := eqVneq (mu D) 0. by exists D; split => // t /= /not_implyP[]. pose E := [set x | `|f x| = +oo /\ D x ]. have mE : measurable E. - rewrite [X in measurable X](_ : _ = D `&` f @^-1` [set -oo; +oo]). - by apply: fint.1 => //; exact: measurableU. - rewrite predeqE => t; split=> [[/eqP ftoo Dt]|[Dt]]. - split => //. - by move: ftoo; rewrite /preimage /= eqe_absl => /andP[/orP[|]/eqP]; tauto. - by rewrite /preimage /= => -[|]; rewrite /E /= => ->. + rewrite (_ : E = D `&` f @^-1` [set -oo; +oo]). + by apply: (measurable_int fint) => //; exact: measurableU. + rewrite /E predeqE => t; split=> [[/eqP]|[Dt [|]/= ->//]]. + by rewrite eqe_absl leey andbT /preimage/= => /orP[|]/eqP; tauto. have [ET|ET] := eqVneq E setT. have foo t : `|f t| = +oo by have [] : E t by rewrite ET. - move: fint.2. - suff: \int[mu]_(x in D) `|f x| = +oo by move=> ->; rewrite ltxx. + suff: \int[mu]_(x in D) `|f x| = +oo. + by case: (integrableP _ _ _ fint) => _; rewrite ltey => /eqP. by rewrite -(integral_csty mD muD0)//; exact: eq_integral. suff: mu E = 0. - move=> muE0; exists E; split => // t /= /not_implyP[Dt ftfin]; split => //. - apply/eqP; rewrite eqe_absl leey andbT. - by move/negP : ftfin; rewrite fin_numE negb_and 2!negbK orbC. + move=> muE0; exists E; split => // t /= /not_implyP[Dt]. + by rewrite fin_num_abs => /negP; rewrite -leNgt leye_eq => /eqP. have [->|/set0P E0] := eqVneq E set0; first by rewrite measure0. have [M M0 muM] : exists2 M, (0 <= M)%R & forall n, n%:R%:E * mu (E `&` D) <= M%:E. exists (fine (\int[mu]_(x in D) `|f x|)); first exact/fine_ge0/integral_ge0. - move=> n. - rewrite -integral_indic// -ge0_integralM//; last 2 first. - - by apply: measurable_funT_comp=> //; exact/measurable_fun_indic. + move=> n; rewrite -integral_indic// -ge0_integralZl//; last 2 first. + - exact: measurableT_comp. - by move=> *; rewrite lee_fin. rewrite fineK//; last first. - by case: fint => _ foo; rewrite ge0_fin_numE//; exact: integral_ge0. + case: (integrableP _ _ _ fint) => _ foo. + by rewrite ge0_fin_numE// integral_ge0. apply: ge0_le_integral => //. - by move=> *; rewrite lee_fin /indic. - - exact/EFin_measurable_fun/measurable_funrM/measurable_fun_indic. - - by apply: measurable_funT_comp => //; case: fint. + - exact/EFin_measurable_fun/measurableT_comp. + - by apply: measurableT_comp => //; apply: measurable_int fint. - move=> x Dx; rewrite /= indicE. have [|xE] := boolP (x \in E); last by rewrite mule0. by rewrite /E inE /= => -[->]; rewrite leey. -apply/eqP/negPn/negP => /eqP muED0. -move/not_forallP : muM; apply. +apply/eqP/negPn/negP => /eqP muED0; move/not_forallP : muM; apply. have [muEDoo|] := ltP (mu (E `&` D)) +oo; last first. by rewrite leye_eq => /eqP ->; exists 1%N; rewrite mul1e leye_eq. exists `|ceil (M * (fine (mu (E `&` D)))^-1)|%N.+1. apply/negP; rewrite -ltNge. rewrite -[X in _ * X](@fineK _ (mu (E `&` D))); last first. by rewrite fin_numElt muEDoo (lt_le_trans _ (measure_ge0 _ _)). -rewrite lte_fin -ltr_pdivr_mulr. +rewrite lte_fin -ltr_pdivrMr. rewrite -natr1 natr_absz ger0_norm. - by rewrite (le_lt_trans (ceil_ge _))// ltr_addl. + by rewrite (le_lt_trans (ceil_ge _))// ltrDl. by rewrite ceil_ge0// divr_ge0//; apply/le0R/measure_ge0; exact: measurableI. rewrite -lte_fin fineK. rewrite lt0e measure_ge0 andbT. @@ -3026,49 +3364,56 @@ Qed. End integrable_ae. -Section linearityM. +Section linearity. Local Open Scope ereal_scope. Context d (T : measurableType d) (R : realType). Variables (mu : {measure set T -> \bar R}) (D : set T) (mD : measurable D). Variable (f : T -> \bar R). Hypothesis intf : mu.-integrable D f. -Lemma integralM r : +Let mesf : measurable_fun D f. Proof. exact: measurable_int intf. Qed. + +Lemma integralZl r : \int[mu]_(x in D) (r%:E * f x) = r%:E * \int[mu]_(x in D) f x. Proof. have [r0|r0|->] := ltgtP r 0%R; last first. by under eq_fun do rewrite mul0e; rewrite mul0e integral0. - rewrite [in LHS]integralE// gt0_funeposM// gt0_funenegM//. - rewrite (ge0_integralM_EFin _ _ _ _ (ltW r0)) //; last first. - by apply: emeasurable_fun_funepos => //; case: intf. - rewrite (ge0_integralM_EFin _ _ _ _ (ltW r0)) //; last first. - by apply: emeasurable_fun_funeneg => //; case: intf. + rewrite (ge0_integralZl_EFin _ _ _ _ (ltW r0)) //; last first. + exact: measurable_funepos. + rewrite (ge0_integralZl_EFin _ _ _ _ (ltW r0)) //; last first. + exact: measurable_funeneg. rewrite -muleBr 1?[in RHS]integralE//. - by apply: integrable_add_def; case: intf. + exact: integrable_add_def. - rewrite [in LHS]integralE// lt0_funeposM// lt0_funenegM//. - rewrite ge0_integralM_EFin //; last 2 first. - + by apply: emeasurable_fun_funeneg => //; case: intf. - + by rewrite -ler_oppr oppr0 ltW. - rewrite ge0_integralM_EFin //; last 2 first. - + by apply: emeasurable_fun_funepos => //; case: intf. - + by rewrite -ler_oppr oppr0 ltW. + rewrite ge0_integralZl_EFin //; last 2 first. + + exact: measurable_funeneg. + + by rewrite -lerNr oppr0 ltW. + rewrite ge0_integralZl_EFin //; last 2 first. + + exact: measurable_funepos. + + by rewrite -lerNr oppr0 ltW. rewrite -mulNe -EFinN opprK addeC EFinN mulNe -muleBr //; last first. - by apply: integrable_add_def; case: intf. + exact: integrable_add_def. by rewrite [in RHS]integralE. Qed. -End linearityM. +End linearity. +#[deprecated(since="mathcomp-analysis 0.6.4", note="use `integralZl` instead")] +Notation integralM := integralZl (only parsing). Section linearity. Local Open Scope ereal_scope. Context d (T : measurableType d) (R : realType). Variables (mu : {measure set T -> \bar R}) (D : set T) (mD : measurable D). -Variable (f1 f2 : T -> R). +Variables f1 f2 : T -> R. Let g1 := EFin \o f1. Let g2 := EFin \o f2. Hypothesis if1 : mu.-integrable D g1. Hypothesis if2 : mu.-integrable D g2. +Let mf1 : measurable_fun D g1. Proof. exact: measurable_int if1. Qed. +Let mf2 : measurable_fun D g2. Proof. exact: measurable_int if2. Qed. + Lemma integralD_EFin : \int[mu]_(x in D) (g1 \+ g2) x = \int[mu]_(x in D) g1 x + \int[mu]_(x in D) g2 x. @@ -3083,66 +3428,60 @@ suff: \int[mu]_(x in D) ((g1 \+ g2)^\+ x) + \int[mu]_(x in D) (g1^\- x) + \int[mu]_(x in D) (g1^\+ x) + \int[mu]_(x in D) (g2^\+ x) \is a fin_num. rewrite ge0_fin_numE//. by rewrite lte_add_pinfty//; exact: integral_funepos_lt_pinfty. - by apply: adde_ge0; exact: integral_ge0. + by rewrite adde_ge0// integral_ge0. have g12neg : \int[mu]_(x in D) (g1^\- x) + \int[mu]_(x in D) (g2^\- x) \is a fin_num. rewrite ge0_fin_numE//. by rewrite lte_add_pinfty// ; exact: integral_funeneg_lt_pinfty. - by apply: adde_ge0; exact: integral_ge0. + by rewrite adde_ge0// integral_ge0. rewrite -sube_eq; last 2 first. - rewrite ge0_fin_numE. apply: lte_add_pinfty; last exact: integral_funeneg_lt_pinfty. apply: lte_add_pinfty; last exact: integral_funeneg_lt_pinfty. - have : mu.-integrable D (g1 \+ g2) by apply: integrableD. - exact: integral_funepos_lt_pinfty. - apply: adde_ge0; last exact: integral_ge0. - by apply: adde_ge0; exact: integral_ge0. - - by rewrite adde_defC fin_num_adde_def. + exact: integral_funepos_lt_pinfty (integrableD _ _ _). + rewrite adde_ge0//; last exact: integral_ge0. + by rewrite adde_ge0// integral_ge0. + - by rewrite fin_num_adde_defr. rewrite -(addeA (\int[mu]_(x in D) (g1 \+ g2)^\+ x)). - rewrite (addeC (\int[mu]_(x in D) (g1 \+ g2)^\+ x)). - rewrite -addeA (addeC (\int[mu]_(x in D) g1^\- x + \int[mu]_(x in D) g2^\- x)). - rewrite eq_sym -(sube_eq g12pos); last by rewrite fin_num_adde_def. - move/eqP => <-. - rewrite oppeD; last first. + rewrite (addeC (\int[mu]_(x in D) (g1 \+ g2)^\+ x)) -[eqbLHS]addeA. + rewrite (addeC (\int[mu]_(x in D) g1^\- x + \int[mu]_(x in D) g2^\- x)). + rewrite eq_sym -(sube_eq g12pos) ?fin_num_adde_defl// => /eqP <-. + rewrite fin_num_oppeD; last first. rewrite ge0_fin_numE; first exact: integral_funeneg_lt_pinfty if2. exact: integral_ge0. - rewrite -addeA (addeCA (\int[mu]_(x in D) (g2^\+ x) )). - by rewrite addeA -(integralE _ _ g1) -(integralE _ _ g2). + by rewrite addeACA (integralE _ _ g1) (integralE _ _ g2). have : (g1 \+ g2)^\+ \+ g1^\- \+ g2^\- = (g1 \+ g2)^\- \+ g1^\+ \+ g2^\+. rewrite funeqE => x. apply/eqP; rewrite -2!addeA [in eqRHS]addeC -sube_eq; last 2 first. - by rewrite /funepos /funeneg /g1 /g2 /= !maxEFin. - by rewrite /funepos /funeneg /g1 /g2 /= !maxEFin. + by rewrite /funepos /funeneg -!fine_max. + by rewrite /funepos /funeneg -!fine_max. rewrite addeAC eq_sym -sube_eq; last 2 first. - by rewrite /funepos /funeneg !maxEFin. - by rewrite /funepos /funeneg !maxEFin. + by rewrite /funepos /funeneg -!fine_max. + by rewrite /funepos /funeneg -!fine_max. apply/eqP. rewrite -[LHS]/((g1^\+ \+ g2^\+ \- (g1^\- \+ g2^\-)) x) -funeD_posD. by rewrite -[RHS]/((_ \- _) x) -funeD_Dpos. move/(congr1 (fun y => \int[mu]_(x in D) (y x) )). rewrite (ge0_integralD mu mD); last 4 first. - by move=> x _; rewrite adde_ge0. - - apply: emeasurable_funD. - by apply/emeasurable_fun_funepos/emeasurable_funD; [case: if1|case: if2]. - by apply: emeasurable_fun_funeneg; case: if1. + - apply: emeasurable_funD; last exact: measurable_funeneg. + exact/measurable_funepos/emeasurable_funD. - by []. - - by apply: emeasurable_fun_funeneg; case: if2. + - exact: measurable_funeneg. rewrite (ge0_integralD mu mD); last 4 first. - by []. - - by apply/emeasurable_fun_funepos/emeasurable_funD; [case: if1|case: if2]. + - exact/measurable_funepos/emeasurable_funD. - by []. - - by apply/emeasurable_fun_funepos/emeasurable_funN => //; case: if1. + - exact/measurable_funepos/measurableT_comp. move=> ->. rewrite (ge0_integralD mu mD); last 4 first. - by move=> x _; exact: adde_ge0. - - apply: emeasurable_funD. - by apply/emeasurable_fun_funeneg/emeasurable_funD; [case: if1|case: if2]. - by apply: emeasurable_fun_funepos; case: if1. + - apply: emeasurable_funD; last exact: measurable_funepos. + exact/measurable_funeneg/emeasurable_funD. - by []. - - by apply: emeasurable_fun_funepos; case: if2. -rewrite (ge0_integralD mu mD) //. -- by apply/emeasurable_fun_funeneg/emeasurable_funD => //; [case: if1|case: if2]. -- by apply: emeasurable_fun_funepos; case: if1. + - exact: measurable_funepos. +rewrite (ge0_integralD mu mD) //; last exact: measurable_funepos. +exact/measurable_funeneg/emeasurable_funD. Qed. End linearity. @@ -3159,7 +3498,7 @@ move=> if1 if2; rewrite (integralD_EFin mD if1); last first. by rewrite -integralN//; exact: integrable_add_def. Qed. -Lemma le_abse_integral d (R : realType) (T : measurableType d) +Lemma le_abse_integral d (T : measurableType d) (R : realType) (mu : {measure set T -> \bar R}) (D : set T) (f : T -> \bar R) (mD : measurable D) : measurable_fun D f -> (`| \int[mu]_(x in D) (f x) | <= \int[mu]_(x in D) `|f x|)%E. @@ -3169,7 +3508,20 @@ rewrite integralE (le_trans (lee_abs_sub _ _))// gee0_abs; last first. exact: integral_ge0. rewrite gee0_abs; last exact: integral_ge0. by rewrite -ge0_integralD // -?fune_abse//; - [exact: emeasurable_fun_funepos | exact: emeasurable_fun_funeneg]. + [exact: measurable_funepos | exact: measurable_funeneg]. +Qed. + +Lemma abse_integralP d (T : measurableType d) (R : realType) + (mu : {measure set T -> \bar R}) (D : set T) (f : T -> \bar R) : + measurable D -> measurable_fun D f -> + (`| \int[mu]_(x in D) f x | < +oo <-> \int[mu]_(x in D) `|f x| < +oo)%E. +Proof. +move=> mD mf; split => [|] foo; last first. + exact: (le_lt_trans (le_abse_integral mu mD mf) foo). +under eq_integral do rewrite -/((abse \o f) _) fune_abse. +rewrite ge0_integralD//;[|exact/measurable_funepos|exact/measurable_funeneg]. +move: foo; rewrite integralE/= -fin_num_abs fin_numB => /andP[fpoo fnoo]. +by rewrite lte_add_pinfty// ltey_eq ?fpoo ?fnoo. Qed. Section integral_indic. @@ -3191,98 +3543,6 @@ Proof. by rewrite -integral_setI_indic// setIid. Qed. End integral_indic. -Section ae_eq. -Local Open Scope ereal_scope. -Context d (T : measurableType d) (R : realType). -Variables (mu : {measure set T -> \bar R}) (D : set T). -Implicit Types f g h i : T -> \bar R. - -Definition ae_eq f g := {ae mu, forall x, D x -> f x = g x}. - -Lemma ae_eq0 f g : measurable D -> mu D = 0 -> ae_eq f g. -Proof. by move=> mD D0; exists D; split => // t/= /not_implyP[]. Qed. - -Lemma ae_eq_comp (j : \bar R -> \bar R) f g : - ae_eq f g -> ae_eq (j \o f) (j \o g). -Proof. -move=> [N [mN N0 subN]]; exists N; split => //. -by apply: subset_trans subN; apply: subsetC => x /= /[apply] ->. -Qed. - -Lemma ae_eq_funeposneg f g : ae_eq f g <-> ae_eq f^\+ g^\+ /\ ae_eq f^\- g^\-. -Proof. -split=> [[N [mN N0 DfgN]]|[[A [mA A0 DfgA] [B [mB B0 DfgB]]]]]. - by split; exists N; split => // x Dfgx; apply: DfgN => /=; - apply: contra_not Dfgx => /= /[apply]; rewrite /funepos /funeneg => ->. -exists (A `|` B); rewrite null_set_setU//; split=> //; first exact: measurableU. -move=> x /= /not_implyP[Dx fgx]; apply: contrapT => /not_orP[Ax Bx]. -have [fgpx|fgnx] : f^\+ x <> g^\+ x \/ f^\- x <> g^\- x. - apply: contrapT => /not_orP[/contrapT fgpx /contrapT fgnx]. - by apply: fgx; rewrite (funeposneg f) (funeposneg g) fgpx fgnx. -- by apply: Ax; exact/DfgA/not_implyP. -- by apply: Bx; exact/DfgB/not_implyP. -Qed. - -Lemma ae_eq_sym f g : ae_eq f g -> ae_eq g f. -Proof. -move=> [N1 [mN1 N10 subN1]]; exists N1; split => // x /= Dba; apply: subN1 => /=. -by apply: contra_not Dba => [+ Dx] => ->. -Qed. - -Lemma ae_eq_trans f g h : ae_eq f g -> ae_eq g h -> ae_eq f h. -Proof. -move=> [N1 [mN1 N10 abN1]] [N2 [mN2 N20 bcN2]]; exists (N1 `|` N2); split => //. -- exact: measurableU. -- by rewrite null_set_setU. -- rewrite -(setCK N1) -(setCK N2) -setCI; apply: subsetC => x [N1x N2x] /= Dx. - move/subsetC : abN1 => /(_ _ N1x); rewrite setCK /= => ->//. - by move/subsetC : bcN2 => /(_ _ N2x); rewrite setCK /= => ->. -Qed. - -Lemma ae_eq_sub f g h i : ae_eq f g -> ae_eq h i -> ae_eq (f \- h) (g \- i). -Proof. -move=> [N1 [mN1 N10 abN1]] [N2 [mN2 N20 bcN2]]; exists (N1 `|` N2); split => //. -- exact: measurableU. -- by rewrite null_set_setU. -- rewrite -(setCK N1) -(setCK N2) -setCI; apply: subsetC => x [N1x N2x] /= Dx. - move/subsetC : abN1 => /(_ _ N1x); rewrite setCK /= => ->//. - by move/subsetC : bcN2 => /(_ _ N2x); rewrite setCK /= => ->. -Qed. - -Lemma ae_eq_mul2r f g h : ae_eq f g -> ae_eq (f \* h) (g \* h). -Proof. -move=> [N1 [mN1 N10 abN1]]; exists N1; split => // x /= /not_implyP[Dx]. -move=> acbc; apply: abN1 => /=; apply/not_implyP; split => //. -by apply: contra_not acbc => ->. -Qed. - -Lemma ae_eq_mul2l f g h : ae_eq f g -> ae_eq (h \* f) (h \* g). -Proof. -move=> /ae_eq_mul2r-/(_ h); under eq_fun do rewrite muleC. -by under [in X in ae_eq _ X -> _]eq_fun do rewrite muleC. -Qed. - -Lemma ae_eq_mul1l f g : ae_eq f (cst 1) -> ae_eq g (g \* f). -Proof. -move=> /ae_eq_mul2l-/(_ g)/ae_eq_sym. -by under [in X in ae_eq X _ -> _]eq_fun do rewrite mule1. -Qed. - -Lemma ae_eq_mul f g h : ae_eq f g -> ae_eq (f \* h) (g \* h). -Proof. -move=> [N1 [mN1 N10 abN1]]; exists N1; split => // x /= /not_implyP[Dx]. -move=> acbc; apply: abN1 => /=; apply/not_implyP; split => //. -by apply: contra_not acbc => ->. -Qed. - -Lemma ae_eq_abse f g : ae_eq f g -> ae_eq (abse \o f) (abse \o g). -Proof. -move=> [N [mN N0 subN]]; exists N; split => //; apply: subset_trans subN. -by apply: subsetC => x /= /[apply] ->. -Qed. - -End ae_eq. - Section ae_eq_integral. Local Open Scope ereal_scope. Context d (T : measurableType d) (R : realType) @@ -3304,14 +3564,13 @@ have le_f_M t : D t -> `|f t| <= M%:E * (f' t)%:E. by rewrite notin_set=> /not_andP[//|/negP/negPn/eqP ->]; rewrite abse0 mule0. have : 0 <= \int[mu]_(x in D) `|f x| <= `|M|%:E * mu Df_neq0. rewrite integral_ge0//= /Df_neq0 -{2}(setIid D) setIAC -integral_indic//. - rewrite -/Df_neq0 -ge0_integralM//; last 2 first. - - by apply: measurable_funT_comp=> //; exact: measurable_fun_indic. + rewrite -/Df_neq0 -ge0_integralZl//; last 2 first. + - exact: measurableT_comp. - by move=> x ?; rewrite lee_fin. apply: ge0_le_integral => //. - - exact: measurable_funT_comp. + - exact: measurableT_comp. - by move=> x Dx; rewrite mule_ge0// lee_fin. - - apply: emeasurable_funM; first exact: measurable_fun_cst. - by apply: measurable_funT_comp => //; exact: measurable_fun_indic. + - by apply: emeasurable_funM => //; exact: measurableT_comp. - move=> x Dx. rewrite (le_trans (le_f_M _ Dx))// lee_fin /f' indicE. by case: (_ \in _) => //; rewrite ?mulr1 ?mulr0// ler_norm. @@ -3329,7 +3588,7 @@ move=> mf; split=> [iDf0|Df0]. exists (D `&` [set x | f x != 0]); split; [exact: emeasurable_neq| |by move=> t /= /not_implyP [Dt /eqP ft0]]. have muDf a : (0 < a)%R -> mu (D `&` [set x | a%:E <= `|f x|]) = 0. - move=> a0; apply/eqP; rewrite eq_le measure_ge0 ?andbT. + move=> a0; apply/eqP; rewrite -measure_le0. by have := le_integral_abse mu mD mf a0; rewrite iDf0 pmule_rle0 ?lte_fin. rewrite [X in mu X](_ : _ = \bigcup_n (D `&` [set x | `|f x| >= n.+1%:R^-1%:E])); last first. @@ -3339,25 +3598,25 @@ move=> mf; split=> [iDf0|Df0]. pose m := `|ceil (fine `|f t|)^-1|%N. have ftfin : `|f t|%E \is a fin_num by rewrite ge0_fin_numE// ltey. exists m => //; split => //=. - rewrite -(@fineK _ `|f t|) // lee_fin -ler_pinv; last 2 first. + rewrite -(@fineK _ `|f t|) // lee_fin -ler_pV2; last 2 first. - rewrite inE unitfE fine_eq0// abse_eq0 ft0/= fine_gt0//. by rewrite lt0e abse_ge0 abse_eq0 ft0 ltey. - by rewrite inE unitfE invr_eq0 pnatr_eq0 /= invr_gt0. rewrite invrK /m -natr1 natr_absz ger0_norm ?ceil_ge0//. - rewrite (@le_trans _ _ ((fine `|f t|)^-1 + 1)%R) ?ler_addl//. - by rewrite ler_add2r// ceil_ge. + rewrite (@le_trans _ _ ((fine `|f t|)^-1 + 1)%R) ?lerDl//. + by rewrite lerD2r// ceil_ge. by split => //; apply: contraTN nft => /eqP ->; rewrite abse0 -ltNge. - transitivity (lim (fun n => mu (D `&` [set x | `|f x| >= n.+1%:R^-1%:E]))). + transitivity (limn (fun n => mu (D `&` [set x | `|f x| >= n.+1%:R^-1%:E]))). apply/esym/cvg_lim => //; apply: nondecreasing_cvg_mu. - move=> i; apply: emeasurable_fun_c_infty => //. - exact: measurable_funT_comp. + exact: measurableT_comp. - apply: bigcupT_measurable => i. - by apply: emeasurable_fun_c_infty => //; exact: measurable_funT_comp. + by apply: emeasurable_fun_c_infty => //; exact: measurableT_comp. - move=> m n mn; apply/subsetPset; apply: setIS => t /=. - by apply: le_trans; rewrite lee_fin lef_pinv // ?ler_nat // posrE. + by apply: le_trans; rewrite lee_fin lef_pV2 // ?ler_nat // posrE. by rewrite (_ : (fun _ => _) = cst 0) ?lim_cst//= funeqE => n /=; rewrite muDf. pose f_ := fun n x => mine `|f x| n%:R%:E. -have -> : (fun x => `|f x|) = (fun x => lim (f_^~ x)). +have -> : (fun x => `|f x|) = (fun x => limn (f_^~ x)). rewrite funeqE => x; apply/esym/cvg_lim => //; apply/cvg_ballP => _/posnumP[e]. near=> n; rewrite /ball /= /ereal_ball /= /f_. have [->|fxoo] := eqVneq `|f x|%E +oo. @@ -3369,10 +3628,9 @@ have -> : (fun x => `|f x|) = (fun x => lim (f_^~ x)). rewrite lee_fin; near: n; exists (Num.bound (fine `|f x|)) => //= n/=. by rewrite -(ler_nat R); apply: le_trans; exact/ltW/archi_boundP. by rewrite min_l// subrr normr0. -transitivity (lim (fun n => \int[mu]_(x in D) (f_ n x) )). +transitivity (limn (fun n => \int[mu]_(x in D) (f_ n x) )). apply/esym/cvg_lim => //; apply: cvg_monotone_convergence => //. - - move=> n; apply: emeasurable_fun_min => //; first exact: measurable_funT_comp. - exact: measurable_fun_cst. + - by move=> n; apply: measurable_mine => //; exact: measurableT_comp. - by move=> n t Dt; rewrite /f_ lexI abse_ge0 //= lee_fin. - move=> t Dt m n mn; rewrite /f_ lexI. have [ftm|ftm] := leP `|f t|%E m%:R%:E. @@ -3390,8 +3648,7 @@ have f_bounded n x : D x -> `|f_ n x| <= n%:R%:E. by rewrite gee0_abs// lee_fin. have if_0 n : \int[mu]_(x in D) `|f_ n x| = 0. apply: (@ae_eq_integral_abs_bounded _ _ _ n%:R) => //. - by apply: emeasurable_fun_min => //; - [exact: measurable_funT_comp|exact: measurable_fun_cst]. + by apply: measurable_mine => //; exact: measurableT_comp. exact: f_bounded. rewrite (_ : (fun _ => _) = cst 0) // ?lim_cst// funeqE => n. by rewrite -(if_0 n); apply: eq_integral => x _; rewrite gee0_abs// /f_. @@ -3406,7 +3663,7 @@ rewrite (eq_integral (fun x => `|f x * (\1_N x)%:E|)); last first. by move=> t _; rewrite abseM (@gee0_abs _ (\1_N t)%:E)// lee_fin. apply/ae_eq_integral_abs => //. apply: emeasurable_funM => //; first exact: (measurable_funS mD). - exact/EFin_measurable_fun/measurable_fun_indic. + exact/EFin_measurable_fun. exists N; split => // t /= /not_implyP[_]; rewrite indicE. by have [|] := boolP (t \in N); rewrite ?inE ?mule0. Qed. @@ -3431,8 +3688,8 @@ move=> mN mD mf muN0. pose mCN := measurableC mN. pose oneCN : {nnsfun T >-> R} := [the {nnsfun T >-> R} of mindic R mCN]. pose oneN : {nnsfun T >-> R} := [the {nnsfun T >-> R} of mindic R mN]. -have intone : mu.-integrable D (fun x => f x * (oneN x)%:E). - split. +have /integrableP intone : mu.-integrable D (fun x => f x * (oneN x)%:E). + apply/integrableP; split. apply: emeasurable_funM=> //; apply/EFin_measurable_fun. exact: measurable_funTS. rewrite (eq_integral (fun x => `|f x| * (\1_N x)%:E)); last first. @@ -3441,15 +3698,15 @@ have intone : mu.-integrable D (fun x => f x * (oneN x)%:E). - exact: measurableI. - by apply: (subset_measure0 _ _ _ muN0) => //; exact: measurableI. have h1 : mu.-integrable D f <-> mu.-integrable D (fun x => f x * (oneCN x)%:E). - split=> [intf|intCf]. - split. + split=> [/integrableP intf | /integrableP intCf]. + apply/integrableP; split. apply: emeasurable_funM=> //; apply/EFin_measurable_fun => //. exact: measurable_funTS. rewrite (eq_integral (fun x => `|f x| * (\1_(~` N) x)%:E)); last first. by move=> t _; rewrite abseM (@gee0_abs _ (\1_(~` N) t)%:E) // lee_fin. rewrite -integral_setI_indic//; case: intf => _; apply: le_lt_trans. - by apply: subset_integral => //; [exact:measurableI|exact:measurable_funT_comp]. - split => //; rewrite (funID mN f) -/oneCN -/oneN. + by apply: subset_integral => //; [exact:measurableI|exact:measurableT_comp]. + apply/integrableP; split => //; rewrite (funID mN f) -/oneCN -/oneN. have ? : measurable_fun D (fun x : T => f x * (oneCN x)%:E). by apply: emeasurable_funM=> //; exact/EFin_measurable_fun/measurable_funTS. have ? : measurable_fun D (fun x : T => f x * (oneN x)%:E). @@ -3458,23 +3715,23 @@ have h1 : mu.-integrable D f <-> mu.-integrable D (fun x => f x * (oneCN x)%:E). apply: (@le_lt_trans _ _ (\int[mu]_(x in D) (`|f x * (oneCN x)%:E| + `|f x * (oneN x)%:E|))). apply: ge0_le_integral => //. - - by apply: measurable_funT_comp => //; exact: emeasurable_funD. - - by apply: emeasurable_funD; exact: measurable_funT_comp. + - by apply: measurableT_comp => //; exact: emeasurable_funD. + - by move=> ? ?; apply: adde_ge0. + - by apply: emeasurable_funD; exact: measurableT_comp. - by move=> *; rewrite lee_abs_add. - rewrite ge0_integralD//; - [|exact: measurable_funT_comp|exact: measurable_funT_comp]. + rewrite ge0_integralD//; [|exact: measurableT_comp|exact: measurableT_comp]. by apply: lte_add_pinfty; [case: intCf|case: intone]. have h2 : mu.-integrable (D `\` N) f <-> mu.-integrable D (fun x => f x * (oneCN x)%:E). - split=> [intCf|intCf]. + split=> [/integrableP intCf | /integrableP intCf]; apply/integrableP. split. apply: emeasurable_funM=> //; apply/EFin_measurable_fun => //. exact: measurable_funTS. rewrite (eq_integral (fun x => `|f x| * (\1_(~` N) x)%:E)); last first. by move=> t _; rewrite abseM (@gee0_abs _ (\1_(~` N) t)%:E)// lee_fin. rewrite -integral_setI_indic //; case: intCf => _; apply: le_lt_trans. - apply: subset_integral=> //; [exact: measurableI|exact: measurableD|]. - by apply: measurable_funT_comp => //; apply: measurable_funS mf => // ? []. + apply: subset_integral => //; [exact: measurableI|exact: measurableD|]. + by apply: measurableT_comp => //; apply: measurable_funS mf => // ? []. split. move=> mDN A mA; rewrite setDE (setIC D) -setIA; apply: measurableI => //. exact: mf. @@ -3484,7 +3741,7 @@ have h2 : mu.-integrable (D `\` N) f <-> by apply: (iff_trans h1); exact: iff_sym. Qed. -Lemma negligible_integral (D N : set T) (f : T -> \bar R) : +Lemma ge0_negligible_integral (D N : set T) (f : T -> \bar R) : measurable N -> measurable D -> measurable_fun D f -> (forall x, D x -> 0 <= f x) -> mu N = 0 -> \int[mu]_(x in D) f x = \int[mu]_(x in D `\` N) f x. @@ -3509,17 +3766,15 @@ Qed. Lemma ge0_ae_eq_integral (D : set T) (f g : T -> \bar R) : measurable D -> measurable_fun D f -> measurable_fun D g -> (forall x, D x -> 0 <= f x) -> (forall x, D x -> 0 <= g x) -> - ae_eq D f g -> \int[mu]_(x in D) (f x) = \int[mu]_(x in D) (g x). + ae_eq D f g -> \int[mu]_(x in D) (f x) = \int[mu]_(x in D) (g x). Proof. move=> mD mf mg f0 g0 [N [mN N0 subN]]. rewrite integralEindic// [RHS]integralEindic//. -rewrite (negligible_integral mN)//; last 2 first. - - apply: emeasurable_funM => //. - exact/EFin_measurable_fun/measurable_fun_indic. +rewrite (ge0_negligible_integral mN)//; last 2 first. + - by apply: emeasurable_funM => //; exact/EFin_measurable_fun. - by move=> x Dx; apply: mule_ge0 => //; [exact: f0|rewrite lee_fin]. -rewrite [RHS](negligible_integral mN)//; last 2 first. - - apply: emeasurable_funM => //. - exact/EFin_measurable_fun/measurable_fun_indic. +rewrite [RHS](ge0_negligible_integral mN)//; last 2 first. + - by apply: emeasurable_funM => //; exact/EFin_measurable_fun. - by move=> x Dx; apply: mule_ge0 => //; [exact: g0|rewrite lee_fin]. - apply: eq_integral => x;rewrite in_setD => /andP[_ xN]. apply: contrapT; rewrite indicE; have [|?] := boolP (x \in D). @@ -3535,10 +3790,10 @@ Lemma ae_eq_integral (D : set T) (g f : T -> \bar R) : Proof. move=> mD mf mg /ae_eq_funeposneg[Dfgp Dfgn]. rewrite integralE// [in RHS]integralE//; congr (_ - _). - by apply: ge0_ae_eq_integral => //; [exact: emeasurable_fun_funepos| - exact: emeasurable_fun_funepos]. -by apply: ge0_ae_eq_integral => //; [exact: emeasurable_fun_funeneg| - exact: emeasurable_fun_funeneg]. + by apply: ge0_ae_eq_integral => //; [exact: measurable_funepos| + exact: measurable_funepos]. +by apply: ge0_ae_eq_integral => //; [exact: measurable_funeneg| + exact: measurable_funeneg]. Qed. End ae_eq_integral. @@ -3551,8 +3806,7 @@ Lemma integral_cst d (T : measurableType d) (R : realType) forall r, \int[mu]_(x in D) (cst r) x = r * mu D. Proof. move=> mD; have [D0 r|D0 [r| |]] := eqVneq (mu D) 0. - by rewrite (ae_eq_integral (cst 0))// ?integral0 ?D0 ?mule0//; - [exact: measurable_fun_cst|exact: measurable_fun_cst|exact: ae_eq0]. + by rewrite (ae_eq_integral (cst 0))// ?integral0 ?D0 ?mule0//; exact: ae_eq0. - by rewrite integral_cstr. - by rewrite integral_csty// gt0_mulye// lt0e D0/=. - by rewrite integral_cstNy// gt0_mulNye// lt0e D0/=. @@ -3568,18 +3822,17 @@ Lemma le_integral_comp_abse d (T : measurableType d) (R : realType) (f a%:E) * mu (D `&` [set x | (`|g x| >= a%:E)%E]) <= \int[mu]_(x in D) f `|g x|. Proof. move=> mg a0; have ? : measurable (D `&` [set x | (a%:E <= `|g x|)%E]). - by apply: emeasurable_fun_c_infty => //; exact: measurable_funT_comp. + by apply: emeasurable_fun_c_infty => //; exact: measurableT_comp. apply: (@le_trans _ _ (\int[mu]_(x in D `&` [set x | `|g x| >= a%:E]) f `|g x|)). rewrite -integral_cst//; apply: ge0_le_integral => //. - by move=> x _ /=; rewrite f0 // lee_fin ltW. - - exact/measurable_fun_cst. - by move=> x _ /=; rewrite f0. - - apply: measurable_funT_comp => //; apply: measurable_funT_comp => //. + - apply: measurableT_comp => //; apply: measurableT_comp => //. exact: measurable_funS mg. - by move=> x /= [Dx]; apply: f_nd; rewrite inE /= in_itv /= andbT// lee_fin ltW. apply: subset_integral => //; last by move=> x _ /=; rewrite f0. -by apply: measurable_funT_comp => //; exact: measurable_funT_comp. +by apply: measurableT_comp => //; exact: measurableT_comp. Qed. Local Close Scope ereal_scope. @@ -3608,7 +3861,7 @@ rewrite [X in measurable X](_ : _ = D `&` ~` N `&` (f @^-1` `]x%:E, +oo[) - by move=> [[]]. apply: measurableU. - rewrite setIAC; apply: measurableI; last exact/measurableC. - exact/mf/emeasurable_itv_bnd_pinfty. + exact/mf/emeasurable_itv. - by apply: cmu; exists N; split => //; rewrite setIAC; apply: subIset; right. Qed. @@ -3621,13 +3874,16 @@ Variables (mu : {measure set T -> \bar R}) (D : set T) (mD : measurable D). Variables (f1 f2 : T -> \bar R). Hypotheses (if1 : mu.-integrable D f1) (if2 : mu.-integrable D f2). +Let mf1 : measurable_fun D f1. Proof. exact: measurable_int if1. Qed. +Let mf2 : measurable_fun D f2. Proof. exact: measurable_int if2. Qed. + Lemma integralD : \int[mu]_(x in D) (f1 x + f2 x) = \int[mu]_(x in D) f1 x + \int[mu]_(x in D) f2 x. Proof. pose A := D `&` [set x | f1 x \is a fin_num]. pose B := D `&` [set x | f2 x \is a fin_num]. -have mA : measurable A by apply: emeasurable_fin_num => //; case: if1. -have mB : measurable B by apply: emeasurable_fin_num => //; case: if2. +have mA : measurable A by exact: emeasurable_fin_num. +have mB : measurable B by exact: emeasurable_fin_num. have mAB : measurable (A `&` B) by apply: measurableI. pose g1 := (fine \o f1 \_ (A `&` B))%R. pose g2 := (fine \o f2 \_ (A `&` B))%R. @@ -3638,6 +3894,7 @@ have ig1 : mu.-integrable D (EFin \o g1). rewrite /g1 funeqE => x //=; rewrite !/restrict; case: ifPn => //. rewrite 2!in_setI => /andP[/andP[xA f1xfin] _] /=. by rewrite fineK//; rewrite inE in f1xfin. +have mg1 := measurable_int ig1. have ig2 : mu.-integrable D (EFin \o g2). rewrite (_ : _ \o _ = f2 \_ (A `&` B)) //. apply: (integrableS measurableT)=>//; apply/(integrable_mkcond _ _).1 => //. @@ -3645,45 +3902,27 @@ have ig2 : mu.-integrable D (EFin \o g2). rewrite /g2 funeqE => x //=; rewrite !/restrict; case: ifPn => //. rewrite in_setI => /andP[_]; rewrite in_setI => /andP[xB f2xfin] /=. by rewrite fineK//; rewrite inE in f2xfin. +have mg2 := measurable_int ig2. transitivity (\int[mu]_(x in D) (EFin \o (g1 \+ g2)%R) x). apply: ae_eq_integral => //. - - by apply: emeasurable_funD => //; [case: if1|case: if2]. + - exact: emeasurable_funD. - rewrite (_ : _ \o _ = (EFin \o g1) \+ (EFin \o g2))//. - by apply: emeasurable_funD => //; [case: ig1|case: ig2]. - - have [N1 [mN1 N10 subN1]] := integrable_ae mD if1. - have [N2 [mN2 N20 subN2]] := integrable_ae mD if2. - exists (N1 `|` N2); split; [exact: measurableU|by rewrite null_set_setU|]. - rewrite -(setCK N1) -(setCK N2) -setCI. - apply: subsetC => x [N1x N2x] /= Dx. - move/subsetC : subN1 => /(_ x N1x); rewrite setCK /= => /(_ Dx) f1x. - move/subsetC : subN2 => /(_ x N2x); rewrite setCK /= => /(_ Dx) f2x. - rewrite /g1 /g2 /restrict /=; have [|] := boolP (x \in A `&` B). - by rewrite in_setI => /andP[xA xB] /=; rewrite EFinD !fineK. + exact: emeasurable_funD. + - apply: (filterS2 _ _ (integrable_ae mD if1) (integrable_ae mD if2)). + move=> x + + Dx => /(_ Dx) f1fin /(_ Dx) f2fin /=. + rewrite EFinD /g1 /g2 /restrict /=; have [|] := boolP (x \in A `&` B). + by rewrite in_setI => /andP[xA xB] /=; rewrite !fineK. by rewrite in_setI negb_and => /orP[|]; rewrite in_setI negb_and /= (mem_set Dx)/= notin_set/=. - rewrite (_ : _ \o _ = (EFin \o g1) \+ (EFin \o g2))// integralD_EFin//. - congr (_ + _). - + apply: ae_eq_integral => //; [by case: ig1|by case: if1|]. - have [N1 [mN1 N10 subN1]] := integrable_ae mD if1. - have [N2 [mN2 N20 subN2]] := integrable_ae mD if2. - exists (N1 `|` N2); split; [exact: measurableU|by rewrite null_set_setU|]. - rewrite -(setCK N1) -(setCK N2) -setCI. - apply: subsetC => x [N1x N2x] /= Dx. - move/subsetC : subN1 => /(_ x N1x); rewrite setCK /= => /(_ Dx) f1x. - move/subsetC : subN2 => /(_ x N2x); rewrite setCK /= => /(_ Dx) f2x. - rewrite /g1 /= /restrict. + congr (_ + _); apply: ae_eq_integral => //. + + apply: (filterS2 _ _ (integrable_ae mD if1) (integrable_ae mD if2)). + move=> x + + Dx => /(_ Dx) f1fin /(_ Dx) f2fin /=; rewrite /g1 /restrict /=. have [/=|] := boolP (x \in A `&` B); first by rewrite fineK. by rewrite in_setI negb_and => /orP[|]; - rewrite in_setI negb_and /= (mem_set Dx) /= notin_set. - + apply: ae_eq_integral => //;[by case: ig2|by case: if2|]. - have [N1 [mN1 N10 subN1]] := integrable_ae mD if1. - have [N2 [mN2 N20 subN2]] := integrable_ae mD if2. - exists (N1 `|` N2); split; [exact: measurableU|by rewrite null_set_setU|]. - rewrite -(setCK N1) -(setCK N2) -setCI. - apply: subsetC => x [N1x N2x] /= Dx. - move/subsetC : subN1 => /(_ x N1x); rewrite setCK /= => /(_ Dx) f1x. - move/subsetC : subN2 => /(_ x N2x); rewrite setCK /= => /(_ Dx) f2x. - rewrite /g2 /= /restrict. + rewrite in_setI negb_and /= (mem_set Dx) /= notin_set/=. + + apply: (filterS2 _ _ (integrable_ae mD if1) (integrable_ae mD if2)). + move=> x + + Dx => /(_ Dx) f1fin /(_ Dx) f2fin /=; rewrite /g2 /restrict /=. have [/=|] := boolP (x \in A `&` B); first by rewrite fineK. by rewrite in_setI negb_and => /orP[|]; rewrite in_setI negb_and /= (mem_set Dx) /= notin_set. @@ -3707,6 +3946,31 @@ Qed. End integralB. +Section negligible_integral. +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType) + (mu : {measure set T -> \bar R}). + +Lemma negligible_integral (D N : set T) (f : T -> \bar R) : + measurable N -> measurable D -> mu.-integrable D f -> + mu N = 0 -> \int[mu]_(x in D) f x = \int[mu]_(x in D `\` N) f x. +Proof. +move=> mN mD mf muN0; rewrite [f]funeposneg ?integralB //; first last. +- exact: integrable_funeneg. +- exact: integrable_funepos. +- apply: (integrableS mD) => //; first exact: measurableD. + exact: integrable_funeneg. +- apply: (integrableS mD) => //; first exact: measurableD. + exact: integrable_funepos. +- exact: measurableD. +congr (_ - _); apply: ge0_negligible_integral => //; apply: measurable_int. + exact: (integrable_funepos mD mf). +exact: (integrable_funeneg mD mf). +Qed. + +End negligible_integral. +Add Search Blacklist "ge0_negligible_integral". + Section integrable_fune. Context d (T : measurableType d) (R : realType). Variables (mu : {measure set T -> \bar R}) (D : set T) (mD : measurable D). @@ -3726,21 +3990,23 @@ Lemma integral_fune_fin_num (f : T -> \bar R) : Proof. move=> h; apply/fin_numPlt; rewrite integral_fune_lt_pinfty// andbC/= -/(- +oo). rewrite lte_oppl -integralN; first exact/integral_fune_lt_pinfty/integrableN. -by rewrite fin_num_adde_def// fin_numN integrable_neg_fin_num. +by rewrite fin_num_adde_defl// fin_numN integrable_neg_fin_num. Qed. End integrable_fune. + Section integral_counting. Local Open Scope ereal_scope. -Variables (R : realType). +Variable R : realType. -Lemma counting_dirac (A : set nat) : counting R A = \sum_(n \bar R. Proof. have -> : \sum_(n \bar R. rewrite nneseries_esum// (_ : [set _ | _] = setT); last exact/seteqP. rewrite [in LHS](esumID A)// !setTI [X in _ + X](_ : _ = 0) ?adde0//. - by apply esum1 => i Ai; rewrite /= /dirac indicE memNset. + by apply: esum1 => i Ai; rewrite /= /dirac indicE memNset. rewrite /counting/=; case: ifPn => /asboolP finA. by rewrite -finite_card_dirac. by rewrite infinite_card_dirac. @@ -3751,30 +4017,39 @@ Lemma summable_integral_dirac (a : nat -> \bar R) : summable setT a -> Proof. move=> sa. apply: (@le_lt_trans _ _ (\sum_(i // n _; rewrite integral_dirac//. + apply: lee_nneseries => // n _; rewrite integral_dirac//. move: (@summable_pinfty _ _ _ _ sa n Logic.I). by case: (a n) => //= r _; rewrite indicE/= mem_set// mul1r. -move: (sa); rewrite /summable (_ : [set: nat] = (fun=> true))//; last exact/seteqP. -rewrite -nneseries_esum//; apply: le_lt_trans. +move: (sa); rewrite /summable -fun_true -nneseries_esum//; apply: le_lt_trans. by apply lee_nneseries => // n _ /=; case: (a n) => //; rewrite leey. Qed. Lemma integral_count (a : nat -> \bar R) : summable setT a -> - \int[counting R]_t (a t) = \sum_(k sa. transitivity (\int[mseries (fun n => [the measure _ _ of \d_ n]) O]_t a t). congr (integral _ _ _); apply/funext => A. by rewrite /= counting_dirac. rewrite (@integral_measure_series _ _ R (fun n => [the measure _ _ of \d_ n]) setT)//=. -- apply: eq_eseries => i _; rewrite integral_dirac//=. - by rewrite indicE mem_set// mul1e. -- move=> n; split; first by []. - by rewrite integral_dirac//= indicE mem_set// mul1e; exact: (summable_pinfty sa). +- by apply: eq_eseriesr=> i _; rewrite integral_dirac//= diracT mul1e. +- move=> n; apply/integrableP; split=> [//|]. + by rewrite integral_dirac//= diracT mul1e (summable_pinfty sa). - by apply: summable_integral_dirac => //; exact: summable_funeneg. - by apply: summable_integral_dirac => //; exact: summable_funepos. Qed. +Lemma ge0_integral_count (a : nat -> \bar R) : (forall k, 0 <= a k) -> + \int[counting]_t (a t) = \sum_(k sa. +transitivity (\int[mseries (fun n => [the measure _ _ of \d_ n]) O]_t a t). + congr (integral _ _ _); apply/funext => A. + by rewrite /= counting_dirac. +rewrite (@ge0_integral_measure_series _ _ R (fun n => [the measure _ _ of \d_ n]) setT)//=. +by apply: eq_eseriesr=> i _; rewrite integral_dirac//= diracT mul1e. +Qed. + End integral_counting. Section subadditive_countable. @@ -3782,14 +4057,12 @@ Local Open Scope ereal_scope. Context d (T : measurableType d) (R : realType). Variable (mu : {measure set T -> \bar R}). -Lemma integrable_abse (D : set T) : measurable D -> - forall f : T -> \bar R, mu.-integrable D f -> mu.-integrable D (abse \o f). +Lemma integrable_abse (D : set T) (f : T -> \bar R) : + mu.-integrable D f -> mu.-integrable D (abse \o f). Proof. -move=> mD f [mf fi]; split; first exact: measurable_funT_comp. -apply: le_lt_trans fi; apply: ge0_le_integral => //. -- by apply: measurable_funT_comp => //; exact: measurable_funT_comp. -- exact: measurable_funT_comp. -- by move=> t Dt //=; rewrite abse_id. +move=> /integrableP[mf foo]; apply/integrableP; split. + exact: measurableT_comp. +by under eq_integral do rewrite abse_id. Qed. Lemma integrable_summable (F : (set T)^nat) (g : T -> \bar R): @@ -3800,14 +4073,14 @@ Proof. move=> tF mF fi. rewrite /summable -(_ : [set _ | true] = setT); last exact/seteqP. rewrite -nneseries_esum//. -case: (fi) => _; rewrite ge0_integral_bigcup//; last first. - by apply: integrable_abse => //; exact: bigcup_measurable. +case: (integrableP _ _ _ fi) => _. +rewrite ge0_integral_bigcup//; last exact: integrable_abse. apply: le_lt_trans; apply: lee_lim. - exact: is_cvg_ereal_nneg_natsum_cond. - by apply: is_cvg_ereal_nneg_natsum_cond => n _ _; exact: integral_ge0. - apply: nearW => n; apply: lee_sum => m _; apply: le_abse_integral => //. - by apply: measurable_funS fi.1 => //; [exact: bigcup_measurable| - exact: bigcup_sup]. + apply: measurable_funS (measurable_int fi) => //; [exact: bigcup_measurable|]. + exact: bigcup_sup. Qed. Lemma integral_bigcup (F : (set _)^nat) (g : T -> \bar R) : @@ -3818,9 +4091,9 @@ Proof. move=> tF mF fi. have ? : \int[mu]_(x in \bigcup_i F i) g x \is a fin_num. rewrite fin_numElt -(lte_absl _ +oo). - apply: le_lt_trans fi.2; apply: le_abse_integral => //. + apply: le_lt_trans (integrableP _ _ _ fi).2; apply: le_abse_integral => //. exact: bigcupT_measurable. - exact: fi.1. + exact: measurable_int fi. transitivity (\int[mu]_(x in \bigcup_i F i) g^\+ x - \int[mu]_(x in \bigcup_i F i) g^\- x)%E. rewrite -integralB; last 3 first. @@ -3830,7 +4103,7 @@ transitivity (\int[mu]_(x in \bigcup_i F i) g^\+ x - by apply: eq_integral => t Ft; rewrite [in LHS](funeposneg g). transitivity (\sum_(i // i; rewrite [RHS]integralE. + by apply: eq_eseriesr => // i; rewrite [RHS]integralE. transitivity ((\sum_(i n _; exact: integral_ge0. - by move=> n _; exact: integral_ge0. -rewrite summable_nneseries; last first. +rewrite summable_eseries; last first. under [X in summable _ X]eq_fun do rewrite -integralE. by rewrite fun_true; exact: integrable_summable. by congr (_ - _)%E; rewrite nneseries_esum// set_true. @@ -3861,7 +4134,7 @@ Context d (T : measurableType d) (R : realType). Variables (mu : {measure set T -> \bar R}) (D : set T) (mD : measurable D). Variables (f_ : (T -> \bar R)^nat) (f : T -> \bar R) (g : T -> \bar R). Hypothesis mf_ : forall n, measurable_fun D (f_ n). -Hypothesis f_f : forall x, D x -> f_ ^~ x --> f x. +Hypothesis f_f : forall x, D x -> f_ ^~ x @ \oo --> f x. Hypothesis fing : forall x, D x -> g x \is a fin_num. Hypothesis ig : mu.-integrable D g. Hypothesis absfg : forall n x, D x -> `|f_ n x| <= g x. @@ -3874,21 +4147,21 @@ Proof. exact: (emeasurable_fun_cvg _ _ mf_ f_f). Qed. Local Lemma dominated_integrable : mu.-integrable D f. Proof. -split => //; have Dfg x : D x -> `| f x | <= g x. +apply/integrableP; split => //; have Dfg x : D x -> `| f x | <= g x. move=> Dx; have /(@cvg_lim _) <- // : `|f_ n x| @[n --> \oo] --> `|f x|. by apply: cvg_abse => //; exact: f_f. apply: lime_le => //. - by apply: is_cvg_abse; apply/cvg_ex; eexists; exact: f_f. - by apply: nearW => n; exact: absfg. -move: ig => [mg]; apply: le_lt_trans; apply: ge0_le_integral => //. -- exact: measurable_funT_comp. -- exact: measurable_funT_comp. +move: ig => /integrableP[mg]; apply: le_lt_trans; apply: ge0_le_integral => //. +- exact: measurableT_comp. +- exact: measurableT_comp. - by move=> x Dx /=; rewrite (gee0_abs (g0 Dx)); exact: Dfg. Qed. Let g_ n x := `|f_ n x - f x|. -Let cvg_g_ x : D x -> g_ ^~ x --> 0. +Let cvg_g_ x : D x -> g_ ^~ x @ \oo --> 0. Proof. move=> Dx; rewrite -abse0; apply: cvg_abse. move: (f_f Dx); case: (f x) => [r|/=|/=]. @@ -3918,67 +4191,66 @@ Qed. Let mgg n : measurable_fun D (fun x => 2%:E * g x - g_ n x). Proof. -apply/emeasurable_funB => //; first by apply: measurable_funeM; case: ig. -by apply/measurable_funT_comp => //; exact: emeasurable_funB. +apply/emeasurable_funB => //; [by apply/measurable_funeM/(measurable_int ig)|]. +by apply/measurableT_comp => //; exact: emeasurable_funB. Qed. Let gg_ge0 n x : D x -> 0 <= 2%:E * g x - g_ n x. Proof. by move=> Dx; rewrite gg_. Qed. -Local Lemma dominated_cvg0 : [sequence \int[mu]_(x in D) g_ n x]_n --> 0. +Local Lemma dominated_cvg0 : [sequence \int[mu]_(x in D) g_ n x]_n @ \oo --> 0. Proof. have := fatou mu mD mgg gg_ge0. rewrite [X in X <= _ -> _](_ : _ = \int[mu]_(x in D) (2%:E * g x) ); last first. apply: eq_integral => t; rewrite inE => Dt. - rewrite lim_einf_shift//; last by rewrite fin_numM// fing. - rewrite is_cvg_lim_einfE//; last first. + rewrite limn_einf_shift//; last by rewrite fin_numM// fing. + rewrite is_cvg_limn_einfE//; last first. by apply: is_cvgeN; apply/cvg_ex; eexists; exact: cvg_g_. rewrite [X in _ + X](_ : _ = 0) ?adde0//; apply/cvg_lim => //. by rewrite -(oppe0); apply: cvgeN; exact: cvg_g_. have i2g : \int[mu]_(x in D) (2%:E * g x) < +oo. - rewrite integralM// lte_mul_pinfty// ?lee_fin//; case: ig => _. +rewrite integralZl// lte_mul_pinfty// ?lee_fin//; case: (integrableP _ _ _ ig) => _. apply: le_lt_trans; rewrite le_eqVlt; apply/orP; left; apply/eqP. by apply: eq_integral => t Dt; rewrite gee0_abs// g0//; rewrite inE in Dt. have ? : \int[mu]_(x in D) (2%:E * g x) \is a fin_num. by rewrite ge0_fin_numE// integral_ge0// => ? ?; rewrite mule_ge0 ?lee_fin ?g0. rewrite [X in _ <= X -> _](_ : _ = \int[mu]_(x in D) (2%:E * g x) + - - lim_esup (fun n => \int[mu]_(x in D) g_ n x)); last first. + limn_esup (fun n => \int[mu]_(x in D) g_ n x)); last first. rewrite (_ : (fun _ => _) = (fun n => \int[mu]_(x in D) (2%:E * g x) + \int[mu]_(x in D) - g_ n x)); last first. rewrite funeqE => n; rewrite integralB//. - by rewrite -integral_ge0N// => x Dx//; rewrite /g_. - - exact: integrablerM. + - exact: integrableZl. - have integrable_normfn : mu.-integrable D (abse \o f_ n). - apply: le_integrable ig => //. - - exact: measurable_funT_comp. - - by move=> x Dx /=; rewrite abse_id (le_trans (absfg _ Dx))// lee_abs. + apply: le_integrable ig => //; first exact: measurableT_comp. + by move=> x Dx /=; rewrite abse_id (le_trans (absfg _ Dx))// lee_abs. suff: mu.-integrable D (fun x => `|f_ n x| + `|f x|). apply: le_integrable => //. - - by apply: measurable_funT_comp => //; exact: emeasurable_funB. + - by apply: measurableT_comp => //; exact: emeasurable_funB. - move=> x Dx. by rewrite /g_ abse_id (le_trans (lee_abs_sub _ _))// lee_abs. apply: integrableD; [by []| by []|]. apply: le_integrable dominated_integrable => //. - - exact: measurable_funT_comp. + - exact: measurableT_comp. - by move=> x Dx; rewrite /= abse_id. - rewrite lim_einf_shift // -lim_einfN; congr (_ + lim_einf _). + rewrite limn_einf_shift // -limn_einfN; congr (_ + limn_einf _). by rewrite funeqE => n /=; rewrite -integral_ge0N// => x Dx; rewrite /g_. rewrite addeC -lee_subl_addr// subee// lee_oppr oppe0 => lim_ge0. -by apply/lim_esup_le_cvg => // n; rewrite integral_ge0// => x _; rewrite /g_. +by apply/limn_esup_le_cvg => // n; rewrite integral_ge0// => x _; rewrite /g_. Qed. Local Lemma dominated_cvg : - (fun n => \int[mu]_(x in D) f_ n x) --> \int[mu]_(x in D) f x. + \int[mu]_(x in D) f_ n x @[n \oo] --> \int[mu]_(x in D) f x. Proof. have h n : `| \int[mu]_(x in D) f_ n x - \int[mu]_(x in D) f x | <= \int[mu]_(x in D) g_ n x. rewrite -(integralB _ _ dominated_integrable)//; last first. by apply: le_integrable ig => // x Dx /=; rewrite (gee0_abs (g0 Dx)) absfg. by apply: le_abse_integral => //; exact: emeasurable_funB. -suff: (fun n => `| \int[mu]_(x in D) f_ n x - \int[mu]_(x in D) f x |) --> 0. +suff: `| \int[mu]_(x in D) f_ n x - \int[mu]_(x in D) f x | @[n \oo] --> 0. move/cvg_abse0P/cvge_sub0; apply. rewrite fin_numElt (_ : -oo = - +oo)// -lte_absl. - case: dominated_integrable => ?; apply: le_lt_trans. + move: dominated_integrable => /integrableP[?]; apply: le_lt_trans. by apply: (le_trans _ (@le_abse_integral _ _ _ mu D f mD _)). apply: (@squeeze_cvge _ _ _ _ (cst 0) _ (fun n => \int[mu]_(x in D) g_ n x)). - by apply: nearW => n; rewrite abse_ge0//=; exact: h. @@ -3996,15 +4268,15 @@ Variables (mu : {measure set T -> \bar R}) (D : set T) (mD : measurable D). Variables (f_ : (T -> \bar R)^nat) (f : T -> \bar R) (g : T -> \bar R). Hypothesis mf_ : forall n, measurable_fun D (f_ n). Hypothesis mf : measurable_fun D f. -Hypothesis f_f : {ae mu, forall x, D x -> f_ ^~ x --> f x}. +Hypothesis f_f : {ae mu, forall x, D x -> f_ ^~ x @ \oo --> f x}. Hypothesis ig : mu.-integrable D g. Hypothesis f_g : {ae mu, forall x n, D x -> `|f_ n x| <= g x}. Let g_ n x := `|f_ n x - f x|. Theorem dominated_convergence : [/\ mu.-integrable D f, - [sequence \int[mu]_(x in D) (g_ n x)]_n --> 0 & - [sequence \int[mu]_(x in D) (f_ n x)]_n --> \int[mu]_(x in D) (f x) ]. + [sequence \int[mu]_(x in D) (g_ n x)]_n @ \oo --> 0 & + [sequence \int[mu]_(x in D) (f_ n x)]_n @ \oo --> \int[mu]_(x in D) (f x) ]. Proof. have [N1 [mN1 N10 subN1]] := f_f. have [N2 [mN2 N20 subN2]] := f_g. @@ -4015,7 +4287,7 @@ have N0 : mu N = 0. by rewrite null_set_setU// ?null_set_setU//; exact: measurableU. pose f' := f \_ (D `\` N); pose g' := g \_ (D `\` N). pose f_' := fun n => f_ n \_ (D `\` N). -have f_f' x : D x -> f_' ^~ x --> f' x. +have f_f' x : D x -> f_' ^~ x @ \oo --> f' x. move=> Dx; rewrite /f_' /f' /restrict in_setD mem_set//=. have [/= xN|/= xN] := boolP (x \in N); first exact: cvg_cst. apply: contraPP (xN) => h; apply/negP; rewrite negbK inE; left; left. @@ -4038,24 +4310,27 @@ have finv x : D x -> g' x \is a fin_num. apply: contrapT => fing; move: xN; apply/negP; rewrite negbK inE; right. by apply: subN3 => /= /(_ Dx). split. -- have if' : mu.-integrable D f' by exact: (dominated_integrable _ f_' _ g'). - split => //. +- have /integrableP if' : mu.-integrable D f'. + exact: (dominated_integrable _ f_' _ g'). + apply/integrableP; split => //. move: if' => [?]; apply: le_lt_trans. rewrite le_eqVlt; apply/orP; left; apply/eqP/ae_eq_integral => //; - [exact: measurable_funT_comp|exact: measurable_funT_comp|]. + [exact: measurableT_comp|exact: measurableT_comp|]. exists N; split => //; rewrite -(setCK N); apply: subsetC => x Nx Dx. by rewrite /f' /restrict mem_set. - have := @dominated_cvg0 _ _ _ _ _ mD _ _ _ mu_ f_f' finv ig' f_g'. - set X := (X in _ -> X --> _); rewrite [X in X --> _ -> _](_ : _ = X) //. + set X := (X in _ -> X @ \oo --> _). + rewrite [X in X @ \oo --> _ -> _](_ : _ = X) //. apply/funext => n; apply: ae_eq_integral => //. - + apply: measurable_funT_comp => //; apply: emeasurable_funB => //. + + apply: measurableT_comp => //; apply: emeasurable_funB => //. apply/(measurable_restrict _ (measurableD _ _) _ _).1 => //. by apply: (measurable_funS mD) => // x []. - + by rewrite /g_; apply: measurable_funT_comp => //; exact: emeasurable_funB. + + by rewrite /g_; apply: measurableT_comp => //; exact: emeasurable_funB. + exists N; split => //; rewrite -(setCK N); apply: subsetC => x /= Nx Dx. by rewrite /f_' /f' /restrict mem_set. - have := @dominated_cvg _ _ _ _ _ mD _ _ _ mu_ f_f' finv ig' f_g'. - set X := (X in _ -> X --> _); rewrite [X in X --> _ -> _](_ : _ = X) //; last first. + set X := (X in _ -> X @ \oo --> _). + rewrite [X in X @ \oo --> _ -> _](_ : _ = X) //; last first. apply/funext => n; apply: ae_eq_integral => //. exists N; split => //; rewrite -(setCK N); apply: subsetC => x /= Nx Dx. by rewrite /f_' /restrict mem_set. @@ -4069,9 +4344,124 @@ Qed. End dominated_convergence_theorem. -(******************************************************************************) -(* * product measure *) -(******************************************************************************) +Section ae_ge0_le_integral. +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType). +Variable mu : {measure set T -> \bar R}. +Variables (D : set T) (mD : measurable D) (f1 f2 : T -> \bar R). +Hypothesis f10 : forall x, D x -> 0 <= f1 x. +Hypothesis mf1 : measurable_fun D f1. +Hypothesis f20 : forall x, D x -> 0 <= f2 x. +Hypothesis mf2 : measurable_fun D f2. + +Lemma ae_ge0_le_integral : {ae mu, forall x, D x -> f1 x <= f2 x} -> + \int[mu]_(x in D) f1 x <= \int[mu]_(x in D) f2 x. +Proof. +move=> [N [mN muN f1f2N]]; rewrite (ge0_negligible_integral _ _ _ _ muN)//. +rewrite [leRHS](ge0_negligible_integral _ _ _ _ muN)//. +apply: ge0_le_integral; first exact: measurableD. +- by move=> t [Dt _]; exact: f10. +- exact: measurable_funS mf1. +- by move=> t [Dt _]; exact: f20. +- exact: measurable_funS mf2. +- by move=> t [Dt Nt]; move/subsetCl : f1f2N; apply. +Qed. + +End ae_ge0_le_integral. + +Section integral_bounded. +Context d {T : measurableType d} {R : realType}. +Variable mu : {measure set T -> \bar R}. +Local Open Scope ereal_scope. + +Lemma integral_le_bound (D : set T) (f : T -> \bar R) (M : \bar R) : + measurable D -> measurable_fun D f -> 0 <= M -> + {ae mu, forall x, D x -> `|f x| <= M} -> + \int[mu]_(x in D) `|f x| <= M * mu D. +Proof. +move=> mD mf M0 dfx; rewrite -integral_cst => //. +by apply: ae_ge0_le_integral => //; exact: measurableT_comp. +Qed. + +End integral_bounded. +Arguments integral_le_bound {d T R mu D f} M. + +Section integral_ae_eq. +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType) (mu : {measure set T -> \bar R}). + +Let integral_measure_lt (D : set T) (mD : measurable D) (g f : T -> \bar R) : + mu.-integrable D f -> mu.-integrable D g -> + (forall E, E `<=` D -> measurable E -> + \int[mu]_(x in E) f x = \int[mu]_(x in E) g x) -> + mu (D `&` [set x | g x < f x]) = 0. +Proof. +move=> itf itg fg; pose E j := D `&` [set x | f x - g x >= j.+1%:R^-1%:E]. +have msf := measurable_int itf. +have msg := measurable_int itg. +have mE j : measurable (E j). + rewrite /E; apply: emeasurable_fun_le => //. + by apply/(emeasurable_funD msf)/measurableT_comp => //; case: mg. +have muE j : mu (E j) = 0. + apply/eqP; rewrite -measure_le0. + have fg0 : \int[mu]_(x in E j) (f \- g) x = 0. + rewrite integralB//; last 2 first. + by apply: integrableS itf => //; exact: subIsetl. + by apply: integrableS itg => //; exact: subIsetl. + rewrite fg//; last apply: subIsetl. + rewrite subee// fin_num_abs (le_lt_trans (le_abse_integral _ _ _))//. + by apply: measurable_funS msg => //; first exact: subIsetl. + apply: le_lt_trans (integrableP _ _ _ itg).2; apply: subset_integral => //. + exact: measurableT_comp msg. + exact: subIsetl. + suff : mu (E j) <= j.+1%:R%:E * \int[mu]_(x in E j) (f \- g) x. + by rewrite fg0 mule0. + apply: (@le_trans _ _ (j.+1%:R%:E * \int[mu]_(x in E j) j.+1%:R^-1%:E)). + by rewrite integral_cst// muleA -EFinM divrr ?unitfE// mul1e. + rewrite lee_pmul//; first exact: integral_ge0. + apply: ge0_le_integral => //; [| |by move=> x []]. + - by move=> x [_/=]; exact: le_trans. + - apply: emeasurable_funB. + + by apply: measurable_funS msf => //; exact: subIsetl. + + by apply: measurable_funS msg => //; exact: subIsetl. +have nd_E : {homo E : n0 m / (n0 <= m)%N >-> (n0 <= m)%O}. + move=> i j ij; apply/subsetPset => x [Dx /= ifg]; split => //. + by move: ifg; apply: le_trans; rewrite lee_fin lef_pV2// ?posrE// ler_nat. +rewrite set_lte_bigcup. +have /cvg_lim h1 : (mu \o E) x @[x --> \oo]--> 0. + by apply: cvg_near_cst; exact: nearW. +have := @nondecreasing_cvg_mu _ _ _ mu E mE (bigcupT_measurable E mE) nd_E. +by move/cvg_lim => h2; rewrite setI_bigcupr -h2// h1. +Qed. + +Lemma integral_ae_eq (D : set T) (mD : measurable D) (g f : T -> \bar R) : + mu.-integrable D f -> measurable_fun D g -> + (forall E, E `<=` D -> measurable E -> + \int[mu]_(x in E) f x = \int[mu]_(x in E) g x) -> + ae_eq mu D f g. +Proof. +move=> fi mg fg; have mf := measurable_int fi; have gi : mu.-integrable D g. + apply/integrableP; split => //; apply/abse_integralP => //; rewrite -fg//. + by apply/abse_integralP => //; case/integrableP : fi. +have mugf : mu (D `&` [set x | g x < f x]) = 0 by apply: integral_measure_lt. +have mufg : mu (D `&` [set x | f x < g x]) = 0. + by apply: integral_measure_lt => // E ED mE; rewrite fg. +have h : ~` [set x | D x -> f x = g x] = D `&` [set x | f x != g x]. + apply/seteqP; split => [x/= /not_implyP[? /eqP]//|x/= [Dx fgx]]. + by apply/not_implyP; split => //; exact/eqP. +apply/negligibleP. + by rewrite h; apply: emeasurable_fun_neq. +rewrite h set_neq_lt setIUr measureU//. +- by rewrite [X in X + _]mufg add0e [LHS]mugf. +- exact: emeasurable_fun_lt. +- exact: emeasurable_fun_lt. +- apply/seteqP; split => [x [[Dx/= + [_]]]|//]. + by move=> /lt_trans => /[apply]; rewrite ltxx. +Qed. + +End integral_ae_eq. + +(** Product measure *) Section measurable_section. Context d1 d2 (T1 : measurableType d1) (T2 : measurableType d2) (R : realType). @@ -4080,13 +4470,13 @@ Implicit Types (A : set (T1 * T2)). Lemma measurable_xsection A x : measurable A -> measurable (xsection A x). Proof. move=> mA; rewrite (xsection_indic R) -(setTI (_ @^-1` _)). -by apply: measurable_fun_prod1 => //; exact/measurable_fun_indic. +exact: measurableT_comp. Qed. Lemma measurable_ysection A y : measurable A -> measurable (ysection A y). Proof. move=> mA; rewrite (ysection_indic R) -(setTI (_ @^-1` _)). -by apply: measurable_fun_prod2 => //; exact/measurable_fun_indic. +exact: measurableT_comp. Qed. End measurable_section. @@ -4096,15 +4486,19 @@ Context d1 d2 (T1 : measurableType d1) (T2 : measurableType d2) (R : realType). Implicit Types A : set (T1 * T2). Section xsection. -Variables (pt2 : T2) (m2 : {measure set T2 -> \bar R}). -Let phi A := m2 \o xsection A. +Variables (pt2 : T2) (m2 : T1 -> {measure set T2 -> \bar R}). +(* the generalization from m2 : {measure set T2 -> \bar R}t to + T1 -> {measure set T2 -> \bar R} is needed to develop the theory + of kernels; the original type was sufficient for the development + of the theory of integration *) +Let phi A x := m2 x (xsection A x). Let B := [set A | measurable A /\ measurable_fun setT (phi A)]. Lemma xsection_ndseq_closed : ndseq_closed B. Proof. move=> F ndF; rewrite /B /= => BF; split. by apply: bigcupT_measurable => n; have [] := BF n. -have phiF x : (fun i => phi (F i) x) --> phi (\bigcup_i F i) x. +have phiF x : phi (F i) x @[i \oo] --> phi (\bigcup_i F i) x. rewrite /phi /= xsection_bigcup; apply: nondecreasing_cvg_mu. - by move=> n; apply: measurable_xsection; case: (BF n). - by apply: bigcupT_measurable => i; apply: measurable_xsection; case: (BF i). @@ -4124,7 +4518,7 @@ Lemma ysection_ndseq_closed : ndseq_closed B. Proof. move=> F ndF; rewrite /B /= => BF; split. by apply: bigcupT_measurable => n; have [] := BF n. -have psiF x : (fun i => psi (F i) x) --> psi (\bigcup_i F i) x. +have psiF x : psi (F i) x @[i \oo] --> psi (\bigcup_i F i) x. rewrite /psi /= ysection_bigcup; apply: nondecreasing_cvg_mu. - by move=> n; apply: measurable_ysection; case: (BF n). - by apply: bigcupT_measurable => i; apply: measurable_ysection; case: (BF i). @@ -4165,7 +4559,7 @@ have CB : C `<=` B. rewrite funeqE => x; rewrite indicE /phi /m2/= /mrestr. have [xX1|xX1] := boolP (x \in X1); first by rewrite mule1 in_xsectionM. by rewrite mule0 notin_xsectionM// set0I measure0. - exact/measurable_funeM/EFin_measurable_fun/measurable_fun_indic. + exact/measurable_funeM/EFin_measurable_fun. suff monoB : monotone_class setT B by exact: monotone_class_subset. split => //; [exact: CB| |exact: xsection_ndseq_closed]. move=> X Y XY [mX mphiX] [mY mphiY]; split; first exact: measurableD. @@ -4206,7 +4600,7 @@ have CB : C `<=` B. rewrite funeqE => y; rewrite indicE /psi /m1/= /mrestr. have [yX2|yX2] := boolP (y \in X2); first by rewrite mule1 in_ysectionM. by rewrite mule0 notin_ysectionM// set0I measure0. - exact/measurable_funeM/EFin_measurable_fun/measurable_fun_indic. + exact/measurable_funeM/EFin_measurable_fun. suff monoB : monotone_class setT B by exact: monotone_class_subset. split => //; [exact: CB| |exact: ysection_ndseq_closed]. move=> X Y XY [mX mphiX] [mY mphiY]; split; first exact: measurableD. @@ -4247,8 +4641,7 @@ have m2Fn_bounded : exists M, forall X, measurable X -> (m2Fn X < M%:E)%E. exists (fine (m2Fn (F n)) + 1) => Y mY. rewrite [in ltRHS]EFinD lte_spadder// fineK; last first. by rewrite ge0_fin_numE ?measure_ge0//= /mrestr/= setIid. - rewrite /= /mrestr/= setIid; apply: le_measure => //; rewrite inE//. - exact: measurableI. + by rewrite /= /mrestr/= setIid le_measure// inE//; exact: measurableI. pose phi' A := m2Fn \o xsection A. pose B' := [set A | measurable A /\ measurable_fun setT (phi' A)]. have subset_B' : measurable `<=` B' by exact: measurable_prod_subset_xsection. @@ -4283,8 +4676,7 @@ have m1Fn_bounded : exists M, forall X, measurable X -> (m1Fn X < M%:E)%E. exists (fine (m1Fn (F n)) + 1) => Y mY. rewrite [in ltRHS]EFinD lte_spadder// fineK; last first. by rewrite ge0_fin_numE ?measure_ge0// /m1Fn/= /mrestr setIid. - rewrite /m1Fn/= /mrestr setIid; apply: le_measure => //; rewrite inE//=. - exact: measurableI. + by rewrite /m1Fn/= /mrestr setIid le_measure// inE//=; exact: measurableI. pose psi' A := m1Fn \o ysection A. pose B' := [set A | measurable A /\ measurable_fun setT (psi' A)]. have subset_B' : measurable `<=` B' by exact: measurable_prod_subset_ysection. @@ -4298,7 +4690,7 @@ End measurable_fun_ysection. Section product_measures. Context d1 d2 (T1 : measurableType d1) (T2 : measurableType d2) (R : realType). -Context (m1 : {measure set T1 -> \bar R}) (m2 : {measure set T2 -> \bar R}). +Context (m1 : set T1 -> \bar R) (m2 : set T2 -> \bar R). Definition product_measure1 := (fun A => \int[m1]_x (m2 \o xsection A) x)%E. Definition product_measure2 := (fun A => \int[m2]_x (m1 \o ysection A) x)%E. @@ -4354,9 +4746,9 @@ move=> mA1 mA2 /=; rewrite /product_measure1 /=. rewrite (eq_integral (fun x => m2 A2 * (\1_A1 x)%:E)); last first. by move=> x _; rewrite indicE; have [xA1|xA1] /= := boolP (x \in A1); [rewrite in_xsectionM// mule1|rewrite mule0 notin_xsectionM]. -rewrite ge0_integralM//; last by move=> x _; rewrite lee_fin. +rewrite ge0_integralZl//; last by move=> x _; rewrite lee_fin. - by rewrite muleC integral_indic// setIT. -- by apply: measurable_funT_comp => //; exact/measurable_fun_indic. +- exact: measurableT_comp. Qed. End product_measure1E. @@ -4367,41 +4759,54 @@ Context d1 d2 (T1 : measurableType d1) (T2 : measurableType d2) (R : realType). Variable m1 : {sigma_finite_measure set T1 -> \bar R}. Variable m2 : {sigma_finite_measure set T2 -> \bar R}. +Let product_measure_sigma_finite : sigma_finite setT (m1 \x m2). +Proof. +have /sigma_finiteP[F TF [ndF Foo]] := sigma_finiteT m1. +have /sigma_finiteP[G TG [ndG Goo]] := sigma_finiteT m2. +exists (fun n => F n `*` G n). + rewrite -setMTT TF TG predeqE => -[x y]; split. + move=> [/= [n _ Fnx] [k _ Gky]]; exists (maxn n k) => //; split. + - by move: x Fnx; exact/subsetPset/ndF/leq_maxl. + - by move: y Gky; exact/subsetPset/ndG/leq_maxr. + by move=> [n _ []/= ? ?]; split; exists n. +move=> k; have [? ?] := Foo k; have [? ?] := Goo k. +split; first exact: measurableM. +by rewrite product_measure1E// lte_mul_pinfty// ge0_fin_numE. +Qed. + +HB.instance Definition _ := Measure_isSigmaFinite.Build _ _ _ (m1 \x m2) + product_measure_sigma_finite. + Lemma product_measure_unique - (m' : {measure set [the semiRingOfSetsType _ of (T1 * T2)%type] -> \bar R}) : + (m' : {measure set [the semiRingOfSetsType _ of T1 * T2] -> \bar R}) : (forall A1 A2, measurable A1 -> measurable A2 -> m' (A1 `*` A2) = m1 A1 * m2 A2) -> forall X : set (T1 * T2), measurable X -> (m1 \x m2) X = m' X. Proof. -move=> m'E; pose m := product_measure1 m1 m2. -have /sigma_finiteP [F1 F1_T [F1_nd F1_oo]] := sigma_finiteT m1. -have /sigma_finiteP [F2 F2_T [F2_nd F2_oo]] := sigma_finiteT m2. -have UF12T : \bigcup_k (F1 k `*` F2 k) = setT. - rewrite -setMTT F1_T F2_T predeqE => -[x y]; split. +move=> m'E. +have /sigma_finiteP[F TF [ndF Foo]] := sigma_finiteT m1. +have /sigma_finiteP[G TG [ndG Goo]] := sigma_finiteT m2. +have UFGT : \bigcup_k (F k `*` G k) = setT. + rewrite -setMTT TF TG predeqE => -[x y]; split. by move=> [n _ []/= ? ?]; split; exists n. - move=> [/= [n _ F1nx] [k _ F2ky]]; exists (maxn n k) => //; split. - - by move: x F1nx; apply/subsetPset/F1_nd; rewrite leq_maxl. - - by move: y F2ky; apply/subsetPset/F2_nd; rewrite leq_maxr. -have mF1F2 n : measurable (F1 n `*` F2 n) /\ m (F1 n `*` F2 n) < +oo. - have [? ?] := F1_oo n; have [? ?] := F2_oo n. - split; first exact: measurableM. - by rewrite /m product_measure1E // lte_mul_pinfty// ge0_fin_numE. -have sm : sigma_finite setT m by exists (fun n => F1 n `*` F2 n). -pose C : set (set (T1 * T2)) := [set C | - exists A1, measurable A1 /\ exists A2, measurable A2 /\ C = A1 `*` A2]. + move=> [/= [n _ Fnx] [k _ Gky]]; exists (maxn n k) => //; split. + - by move: x Fnx; exact/subsetPset/ndF/leq_maxl. + - by move: y Gky; exact/subsetPset/ndG/leq_maxr. +pose C : set (set (T1 * T2)) := + [set C | exists A, measurable A /\ exists B, measurable B /\ C = A `*` B]. have CI : setI_closed C. move=> /= _ _ [X1 [mX1 [X2 [mX2 ->]]]] [Y1 [mY1 [Y2 [mY2 ->]]]]. rewrite -setMI; exists (X1 `&` Y1); split; first exact: measurableI. by exists (X2 `&` Y2); split => //; exact: measurableI. -move=> X mX; apply: (measure_unique C (fun n => F1 n `*` F2 n)) => //. +move=> X mX; apply: (measure_unique C (fun n => F n `*` G n)) => //. - rewrite measurable_prod_measurableType //; congr (<>). - rewrite predeqE; split => [[A1 mA1 [A2 mA2 <-]]|[A1 [mA1 [A2 [mA2 ->]]]]]. - by exists A1; split => //; exists A2; split. - by exists A1 => //; exists A2. -- move=> n; rewrite /C /=; exists (F1 n); split; first by have [] := F1_oo n. - by exists (F2 n); split => //; have [] := F2_oo n. + rewrite predeqE; split => [[A mA [B mB <-]]|[A [mA [B [mB ->]]]]]. + by exists A; split => //; exists B. + by exists A => //; exists B. +- move=> n; rewrite /C /=; exists (F n); split; first by have [] := Foo n. + by exists (G n); split => //; have [] := Goo n. - by move=> A [A1 [mA1 [A2 [mA2 ->]]]]; rewrite m'E//= product_measure1E. -- move=> k; have [? ?] := F1_oo k; have [? ?] := F2_oo k. +- move=> k; have [? ?] := Foo k; have [? ?] := Goo k. by rewrite /= product_measure1E// lte_mul_pinfty// ge0_fin_numE. Qed. @@ -4455,8 +4860,8 @@ Proof. have mA1A2 : measurable (A1 `*` A2) by apply: measurableM. transitivity (\int[m2]_y (m1 \o ysection (A1 `*` A2)) y) => //. rewrite (_ : _ \o _ = fun y => m1 A1 * (\1_A2 y)%:E). - rewrite ge0_integralM//; last 2 first. - - by apply: measurable_funT_comp => //; exact/measurable_fun_indic. + rewrite ge0_integralZl//; last 2 first. + - exact: measurableT_comp. - by move=> y _; rewrite lee_fin. by rewrite integral_indic ?setIT ?mul1e. rewrite funeqE => y; rewrite indicE. @@ -4466,6 +4871,223 @@ Qed. End product_measure2E. +Section simple_density_L1. +Context d (T : measurableType d) (R : realType). +Variables (mu : {measure set T -> \bar R}) (E : set T) (mE : measurable E). + +Local Open Scope ereal_scope. + +Lemma measurable_bounded_integrable (f : T -> R^o) : + mu E < +oo -> measurable_fun E f -> + [bounded f x | x in E] -> mu.-integrable E (EFin \o f). +Proof. +move=> Afin mfA bdA; apply/integrableP; split; first exact/EFin_measurable_fun. +have [M [_ mrt]] := bdA; apply: le_lt_trans. + apply: (integral_le_bound (`|M| + 1)%:E) => //; first exact: measurableT_comp. + by apply: aeW => z Az; rewrite lee_fin mrt// ltr_pwDr// ler_norm. +by rewrite lte_mul_pinfty. +Qed. + +Let sfun_dense_L1_pos (f : T -> \bar R) : + mu.-integrable E f -> (forall x, E x -> 0 <= f x) -> + exists g_ : {sfun T >-> R}^nat, + [/\ forall n, mu.-integrable E (EFin \o g_ n), + forall x, E x -> EFin \o g_^~ x @ \oo --> f x & + (fun n => \int[mu]_(z in E) `|f z - (g_ n z)%:E|) @ \oo --> 0]. +Proof. +move=> intf fpos; case/integrableP: (intf) => mfE _. +pose g_ n := nnsfun_approx mE mfE n. +have [] // := @dominated_convergence _ _ _ mu _ mE (fun n => EFin \o g_ n) f f. +- by move=> ?; apply/EFin_measurable_fun/measurable_funTS. +- apply: aeW => ? ?; under eq_fun => ? do rewrite /g_ nnsfun_approxE. + exact: ecvg_approx. +- apply: aeW => /= ? ? ?; rewrite ger0_norm // /g_ nnsfun_approxE. + exact: le_approx. +move=> _ /= fg0 gfcvg; exists g_; split. +- move=> n; apply: (le_integrable mE _ _ intf). + exact/EFin_measurable_fun/measurable_funTS. + move=> ? ?; rewrite /g_ !gee0_abs ?lee_fin//; last exact: fpos. + by rewrite /= nnsfun_approxE le_approx. +- exact: cvg_nnsfun_approx. +- by apply: cvg_trans fg0; under eq_fun => ? do under eq_fun => t do + rewrite EFinN -[_ - _]oppeK fin_num_oppeB // abseN addeC. +Qed. + +Lemma approximation_sfun_integrable (f : T -> \bar R): + mu.-integrable E f -> + exists g_ : {sfun T >-> R}^nat, + [/\ forall n, mu.-integrable E (EFin \o g_ n), + forall x, E x -> EFin \o g_^~ x @ \oo --> f x & + (fun n => \int[mu]_(z in E) `|f z - (g_ n z)%:E|) @ \oo --> 0]. +Proof. +move=> intf. +have [//|p_ [intp pf pl1]] := sfun_dense_L1_pos (integrable_funepos mE intf). +have [//|n_ [intn nf nl1]] := sfun_dense_L1_pos (integrable_funeneg mE intf). +exists (fun n => p_ n - n_ n)%R; split. +- move=> n; rewrite /comp; under eq_fun => ? do rewrite sfunB /= EFinB. + by apply: integrableB => //; [exact: intp | exact: intn]. +- move=> ? ?; rewrite /comp; under eq_fun => ? do rewrite sfunB /= EFinB. + rewrite [f]funeposneg; apply: cvgeB => //;[|exact: pf|exact:nf]. + exact: add_def_funeposneg. +have fpn z n : f z - ((p_ n - n_ n) z)%:E = + (f^\+ z - (p_ n z)%:E) - (f^\- z - (n_ n z)%:E). + rewrite sfunB EFinB fin_num_oppeB // {1}[f]funeposneg -addeACA. + by congr (_ _); rewrite fin_num_oppeB. +case/integrableP: (intf) => mf _. +have mfpn n : mu.-integrable E (fun z => f z - ((p_ n - n_ n) z)%:E). + under eq_fun => ? do rewrite fpn; apply: integrableB => //. + by apply: integrableB => //; [exact: integrable_funepos | exact: intp]. + by apply: integrableB => //; [exact: integrable_funeneg | exact: intn]. +apply/fine_cvgP; split => //. + near=> N; case/integrableP: (mfpn N) => _; rewrite ge0_fin_numE //. + exact: integral_ge0. +apply/cvg_ballP=> _/posnumP[eps]; have e2p : (0 < eps%:num/2)%R by []. +case/fine_cvgP: pl1 => + /cvg_ballP/(_ _ e2p); apply: filter_app2. +case/fine_cvgP: nl1 => + /cvg_ballP/(_ _ e2p); apply: filter_app2. +near=> n; rewrite /ball /=; do 3 rewrite distrC subr0. +move=> finfn ne2 finfp pe2; rewrite [_%:num]splitr. +rewrite (le_lt_trans _ (ltrD pe2 ne2))// (le_trans _ (ler_normD _ _))//. +under [fun z => _ (f^\+ z + _)]eq_fun => ? do rewrite EFinN. +under [fun z => _ (f^\- z + _)]eq_fun => ? do rewrite EFinN. +have mfp : mu.-integrable E (fun z => `|f^\+ z - (p_ n z)%:E|). + apply/integrable_abse/integrableB => //; first exact: integrable_funepos. + exact: intp. +have mfn : mu.-integrable E (fun z => `|f^\- z - (n_ n z)%:E|). + apply/integrable_abse/integrableB => //; first exact: integrable_funeneg. + exact: intn. +rewrite -[x in (_ <= `|x|)%R]fineD // -integralD //. +rewrite !ger0_norm ?fine_ge0 ?integral_ge0 ?fine_le//. +- by apply: integral_fune_fin_num => //; exact/integrable_abse/mfpn. +- by apply: integral_fune_fin_num => //; exact: integrableD. +- apply: ge0_le_integral => //. + + by apply: measurableT_comp => //; case/integrableP: (mfpn n). + + by move=> x Ex; rewrite adde_ge0. + + by apply: emeasurable_funD; [move: mfp | move: mfn]; case/integrableP. + + by move=> ? ?; rewrite fpn; exact: lee_abs_sub. + + by move=> x Ex; rewrite adde_ge0. +Unshelve. all: by end_near. Qed. +End simple_density_L1. + +Section continuous_density_L1. +Context (rT : realType). +Let mu := [the measure _ _ of @lebesgue_measure rT]. +Let R := [the measurableType _ of measurableTypeR rT]. +Local Open Scope ereal_scope. + +Lemma compact_finite_measure (A : set R^o) : compact A -> mu A < +oo. +Proof. +move=> /[dup]/compact_measurable => mA /compact_bounded[N [_ N1x]]. +have AN1 : (A `<=` `[- (`|N| + 1), `|N| + 1])%R. + by move=> z Az; rewrite set_itvcc /= -ler_norml N1x// ltr_pwDr// ler_norm. +rewrite (le_lt_trans (le_measure _ _ _ AN1)) ?inE//=. +by rewrite lebesgue_measure_itv/= lte_fin gtrN// EFinD ltry. +Qed. + +Lemma continuous_compact_integrable (f : R -> R^o) (A : set R^o) : + compact A -> {within A, continuous f} -> mu.-integrable A (EFin \o f). +Proof. +move=> cptA ctsfA; apply: measurable_bounded_integrable. +- exact: compact_measurable. +- exact: compact_finite_measure. +- by apply: subspace_continuous_measurable_fun => //; exact: compact_measurable. +- have /compact_bounded[M [_ mrt]] := continuous_compact ctsfA cptA. + by exists M; split; rewrite ?num_real // => ? ? ? ?; exact: mrt. +Qed. + +Lemma approximation_continuous_integrable (E : set R) (f : R -> R^o): + measurable E -> mu E < +oo -> mu.-integrable E (EFin \o f) -> + exists g_ : (rT -> rT)^nat, + [/\ forall n, continuous (g_ n), + forall n, mu.-integrable E (EFin \o g_ n) & + \int[mu]_(z in E) `|(f z - g_ n z)%:E| @[n --> \oo] --> 0]. +Proof. +move=> mE Efin intf. +have mf : measurable_fun E f by case/integrableP : intf => /EFin_measurable_fun. +suff apxf eps : exists h : rT -> rT, (eps > 0)%R -> + [/\ continuous h, + mu.-integrable E (EFin \o h) & + \int[mu]_(z in E) `|(f z - h z)%:E| < eps%:E]. + pose g_ n := projT1 (cid (apxf n.+1%:R^-1)); exists g_; split. + - by move=> n; have [] := projT2 (cid (apxf n.+1%:R^-1)). + - by move=> n; have [] := projT2 (cid (apxf n.+1%:R^-1)). + apply/cvg_ballP => eps epspos. + have /cvg_ballP/(_ eps epspos)[N _ Nball] := @cvge_harmonic rT. + exists N => //; apply: (subset_trans Nball) => n. + rewrite /ball /= /ereal_ball contract0 !sub0r !normrN => /(lt_trans _); apply. + rewrite ?ger0_norm; first last. + - by rewrite -le_expandLR // ?inE ?normr0// expand0 integral_ge0. + - by rewrite -le_expandLR // ?inE ?normr0// expand0. + have [] := projT2 (cid (apxf n.+1%:R^-1)) => // _ _ ipaxfn. + by rewrite -lt_expandRL ?contractK// inE contract_le1. +have [|] := ltP 0%R eps; last by exists point. +move: eps => _/posnumP[eps]. +have [g [gfe2 ig]] : exists g : {sfun R >-> rT}, + \int[mu]_(z in E) `|(f z - g z)%:E| < (eps%:num / 2)%:E /\ + mu.-integrable E (EFin \o g). + have [g_ [intG ?]] := approximation_sfun_integrable mE intf. + move/fine_fcvg/cvg_ballP/(_ (eps%:num / 2)) => -[] // n _ Nb; exists (g_ n). + have fg_fin_num : \int[mu]_(z in E) `|(f z - g_ n z)%:E| \is a fin_num. + rewrite integral_fune_fin_num// integrable_abse//. + by under eq_fun do rewrite EFinB; apply: integrableB => //; exact: intG. + split; last exact: intG. + have /= := Nb _ (leqnn n); rewrite /ball/= sub0r normrN -fine_abse// -lte_fin. + by rewrite fineK ?abse_fin_num// => /le_lt_trans; apply; exact: lee_abs. +have mg : measurable_fun E g. + by apply: (measurable_funS measurableT) => //; exact: measurable_funP. +have [M Mpos Mbd] : (exists2 M, 0 < M & forall x, `|g x| <= M)%R. + have [M [_ /= bdM]] := simple_bounded g. + exists (`|M| + 1)%R; first exact: ltr_pwDr. + by move=> x; rewrite bdM// ltr_pwDr// ler_norm. +have [] // := @measurable_almost_continuous _ _ mE _ g (eps%:num / 2 / (M *+ 2)). + by rewrite divr_gt0// mulrn_wgt0. +move=> A [cptA AE /= muAE ctsAF]. +have [] := continuous_bounded_extension _ _ Mpos ctsAF. +- exact: pseudometric_normal. +- by apply: compact_closed => //; exact: Rhausdorff. +- by move=> ? ?; exact: Mbd. +have mA : measurable A := compact_measurable cptA. +move=> h [gh ctsh hbdM]; have mh : measurable_fun E h. + by apply: subspace_continuous_measurable_fun=> //; exact: continuous_subspaceT. +have intg : mu.-integrable E (EFin \o h). + apply: measurable_bounded_integrable => //. + exists M; split; rewrite ?num_real // => x Mx y _ /=. + by rewrite (le_trans _ (ltW Mx)). +exists h; split => //; rewrite [eps%:num]splitr; apply: le_lt_trans. + pose fgh x := `|(f x - g x)%:E| + `|(g x - h x)%:E|. + apply: (@ge0_le_integral _ _ _ mu _ mE _ fgh) => //. + - apply: (measurable_funS mE) => //; do 2 apply: measurableT_comp => //. + exact: measurable_funB. + - by move=> z _; rewrite adde_ge0. + - apply: measurableT_comp => //; apply: measurable_funD => //; + apply: (measurable_funS mE) => //; (apply: measurableT_comp => //); + exact: measurable_funB. + - move=> x _; rewrite -(subrK (g x) (f x)) -(addrA (_ + _)%R) lee_fin. + by rewrite ler_normD. +rewrite integralD//; first last. +- by apply: integrable_abse; under eq_fun do rewrite EFinB; apply: integrableB. +- by apply: integrable_abse; under eq_fun do rewrite EFinB; apply: integrableB. +rewrite EFinD lte_add// -(setDKU AE) integral_setU => //; first last. +- by rewrite /disj_set setDKI. +- rewrite setDKU //; do 2 apply: measurableT_comp => //. + exact: measurable_funB. +- exact: measurableD. +rewrite (@ae_eq_integral _ _ _ mu A (cst 0)) //; first last. +- by apply: aeW => z Az; rewrite (gh z) ?inE// subrr abse0. +- apply: (measurable_funS mE) => //; do 2 apply: measurableT_comp => //. + exact: measurable_funB. +rewrite integral0 adde0. +apply: (le_lt_trans (integral_le_bound (M *+ 2)%:E _ _ _ _)) => //. +- exact: measurableD. +- apply: (measurable_funS mE) => //; apply: measurableT_comp => //. + exact: measurable_funB. +- by rewrite lee_fin mulrn_wge0// ltW. +- apply: aeW => z [Ez _]; rewrite /= lee_fin mulr2n. + by rewrite (le_trans (ler_normB _ _))// lerD. +by rewrite -lte_pdivl_mull ?mulrn_wgt0// muleC -EFinM. +Qed. + +End continuous_density_L1. + Section fubini_functions. Local Open Scope ereal_scope. Context d1 d2 (T1 : measurableType d1) (T2 : measurableType d2) (R : realType). @@ -4552,14 +5174,14 @@ Proof. rewrite funeqE => x; rewrite /F /fubini_F [in LHS]/=. under eq_fun do rewrite fimfunE -fsumEFin//. rewrite ge0_integral_fsum //; last 2 first. - - move=> i; apply/EFin_measurable_fun => //; apply: measurable_funrM => //. - exact/measurable_fun_prod1/measurable_fun_indic. + - move=> i; apply/EFin_measurable_fun/measurableT_comp => //=. + exact: measurableT_comp. - by move=> r y _; rewrite EFinM nnfun_muleindic_ge0. apply: eq_fsbigr => i; rewrite inE => -[/= t _ <-{i}]. under eq_fun do rewrite EFinM. -rewrite ge0_integralM//; last by rewrite lee_fin. +rewrite ge0_integralZl//; last by rewrite lee_fin. - by rewrite -/((m2 \o xsection _) x) -indic_fubini_tonelli_FE. -- exact/EFin_measurable_fun/measurable_fun_prod1/measurable_fun_indic. +- exact/EFin_measurable_fun/measurableT_comp. - by move=> y _; rewrite lee_fin. Qed. @@ -4575,14 +5197,14 @@ Proof. rewrite funeqE => y; rewrite /G /fubini_G [in LHS]/=. under eq_fun do rewrite fimfunE -fsumEFin//. rewrite ge0_integral_fsum //; last 2 first. - - move=> i; apply/EFin_measurable_fun => //; apply: measurable_funrM => //. - exact/measurable_fun_prod2/measurable_fun_indic. + - move=> i; apply/EFin_measurable_fun/measurableT_comp => //=. + exact: measurableT_comp. - by move=> r x _; rewrite EFinM nnfun_muleindic_ge0. apply: eq_fsbigr => i; rewrite inE => -[/= t _ <-{i}]. under eq_fun do rewrite EFinM. -rewrite ge0_integralM//; last by rewrite lee_fin. +rewrite ge0_integralZl//; last by rewrite lee_fin. - by rewrite -/((m1 \o ysection _) y) -indic_fubini_tonelli_GE. -- exact/EFin_measurable_fun/measurable_fun_prod2/measurable_fun_indic. +- exact/EFin_measurable_fun/measurableT_comp. - by move=> x _; rewrite lee_fin. Qed. @@ -4601,16 +5223,16 @@ Proof. under [LHS]eq_integral do rewrite EFinf; rewrite ge0_integral_fsum //; last 2 first. - move=> r. - exact/EFin_measurable_fun/measurable_funrM/measurable_fun_indic. + apply/EFin_measurable_fun/measurableT_comp => //=. - by move=> r /= z _; exact: nnfun_muleindic_ge0. transitivity (\sum_(k \in range f) \int[m1]_x (k%:E * (fubini_F m2 (EFin \o \1_(f @^-1` [set k])) x))). apply: eq_fsbigr => i; rewrite inE => -[z _ <-{i}]. - rewrite ge0_integralM//; last 3 first. - - exact/EFin_measurable_fun/measurable_fun_indic. + rewrite ge0_integralZl//; last 3 first. + - exact/EFin_measurable_fun. - by move=> /= x _; rewrite lee_fin. - by rewrite lee_fin. - rewrite indic_fubini_tonelli1// -ge0_integralM//; last by rewrite lee_fin. + rewrite indic_fubini_tonelli1// -ge0_integralZl//; last by rewrite lee_fin. - exact: indic_measurable_fun_fubini_tonelli_F. - by move=> /= x _; exact: indic_fubini_tonelli_F_ge0. rewrite -ge0_integral_fsum //; last 2 first. @@ -4618,7 +5240,8 @@ rewrite -ge0_integral_fsum //; last 2 first. - move=> r x _; rewrite /fubini_F. have [r0|r0] := leP 0%R r. by rewrite mule_ge0//; exact: indic_fubini_tonelli_F_ge0. - by rewrite integral0_eq// => y _; rewrite preimage_nnfun0//= indicE in_set0. + rewrite integral0_eq ?mule0// => y _. + by rewrite preimage_nnfun0//= indicE in_set0. apply: eq_integral => x _; rewrite sfun_fubini_tonelli_FE. by under eq_fsbigr do rewrite indic_fubini_tonelli_FE//. Qed. @@ -4628,16 +5251,16 @@ Proof. under [LHS]eq_integral do rewrite EFinf; rewrite ge0_integral_fsum //; last 2 first. - move=> i. - exact/EFin_measurable_fun/measurable_funrM/measurable_fun_indic. + apply/EFin_measurable_fun/measurableT_comp => //=. - by move=> r /= z _; exact: nnfun_muleindic_ge0. transitivity (\sum_(k \in range f) \int[m2]_x (k%:E * (fubini_G m1 (EFin \o \1_(f @^-1` [set k])) x))). apply: eq_fsbigr => i; rewrite inE => -[z _ <-{i}]. - rewrite ge0_integralM//; last 3 first. - - exact/EFin_measurable_fun/measurable_fun_indic. + rewrite ge0_integralZl//; last 3 first. + - exact/EFin_measurable_fun. - by move=> /= x _; rewrite lee_fin. - by rewrite lee_fin. - rewrite indic_fubini_tonelli2// -ge0_integralM//; last by rewrite lee_fin. + rewrite indic_fubini_tonelli2// -ge0_integralZl//; last by rewrite lee_fin. - exact: indic_measurable_fun_fubini_tonelli_G. - by move=> /= x _; exact: indic_fubini_tonelli_G_ge0. rewrite -ge0_integral_fsum //; last 2 first. @@ -4645,7 +5268,8 @@ rewrite -ge0_integral_fsum //; last 2 first. - move=> r y _; rewrite /fubini_G. have [r0|r0] := leP 0%R r. by rewrite mule_ge0//; exact: indic_fubini_tonelli_G_ge0. - by rewrite integral0_eq// => x _; rewrite preimage_nnfun0//= indicE in_set0. + rewrite integral0_eq ?mule0// => x _. + by rewrite preimage_nnfun0//= indicE in_set0. apply: eq_integral => x _; rewrite sfun_fubini_tonelli_GE. by under eq_fsbigr do rewrite indic_fubini_tonelli_GE//. Qed. @@ -4678,10 +5302,10 @@ apply: (emeasurable_fun_cvg (F_ g)) => //. - by move=> n; exact: sfun_measurable_fun_fubini_tonelli_F. - move=> x _. rewrite /F_ /F /fubini_F [in X in _ --> X](_ : (fun _ => _) = - fun y => lim (EFin \o g ^~ (x, y))); last first. + fun y => limn (EFin \o g ^~ (x, y))); last first. by rewrite funeqE => y; apply/esym/cvg_lim => //; exact: g_f. apply: cvg_monotone_convergence => //. - - by move=> n; apply/EFin_measurable_fun => //; exact/measurable_fun_prod1. + - by move=> n; apply/EFin_measurable_fun => //; exact/measurableT_comp. - by move=> n y _; rewrite lee_fin//; exact: fun_ge0. - by move=> y _ a b ab; rewrite lee_fin; exact/lefP/g_nd. Qed. @@ -4692,10 +5316,10 @@ have [g [g_nd /= g_f]] := approximation measurableT mf (fun x _ => f0 x). apply: (emeasurable_fun_cvg (G_ g)) => //. - by move=> n; exact: sfun_measurable_fun_fubini_tonelli_G. - move=> y _; rewrite /G_ /G /fubini_G [in X in _ --> X](_ : (fun _ => _) = - fun x => lim (EFin \o g ^~ (x, y))); last first. + fun x => limn (EFin \o g ^~ (x, y))); last first. by rewrite funeqE => x; apply/esym/cvg_lim => //; exact: g_f. apply: cvg_monotone_convergence => //. - - by move=> n; apply/EFin_measurable_fun => //; exact/measurable_fun_prod2. + - by move=> n; apply/EFin_measurable_fun => //; exact/measurableT_comp. - by move=> n x _; rewrite lee_fin; exact: fun_ge0. - by move=> x _ a b ab; rewrite lee_fin; exact/lefP/g_nd. Qed. @@ -4703,65 +5327,66 @@ Qed. Lemma fubini_tonelli1 : \int[m1 \x m2]_z f z = \int[m1]_x F x. Proof. have [g [g_nd /= g_f]] := approximation measurableT mf (fun x _ => f0 x). -have F_F x : F x = lim (F_ g ^~ x). - rewrite [RHS](_ : _ = lim (fun n => \int[m2]_y (EFin \o g n) (x, y)))//. +have F_F x : F x = limn (F_ g ^~ x). + rewrite [RHS](_ : _ = limn (fun n => \int[m2]_y (EFin \o g n) (x, y)))//. rewrite -monotone_convergence//; last 3 first. - - by move=> n; exact/EFin_measurable_fun/measurable_fun_prod1. + - by move=> n; exact/EFin_measurable_fun/measurableT_comp. - by move=> n /= y _; rewrite lee_fin; exact: fun_ge0. - by move=> y /= _ a b; rewrite lee_fin => /g_nd/lefP; exact. by apply: eq_integral => y _; apply/esym/cvg_lim => //; exact: g_f. -rewrite [RHS](_ : _ = lim (fun n => \int[m1 \x m2]_z (EFin \o g n) z)). +rewrite [RHS](_ : _ = limn (fun n => \int[m1 \x m2]_z (EFin \o g n) z)). rewrite -monotone_convergence //; last 3 first. - by move=> n; exact/EFin_measurable_fun. - by move=> n /= x _; rewrite lee_fin; exact: fun_ge0. - by move=> y /= _ a b; rewrite lee_fin => /g_nd/lefP; exact. by apply: eq_integral => /= x _; apply/esym/cvg_lim => //; exact: g_f. rewrite [LHS](_ : _ = - lim (fun n => \int[m1]_x (\int[m2]_y (EFin \o g n) (x, y)))). - by congr (lim _); rewrite funeqE => n; rewrite sfun_fubini_tonelli1. -rewrite [RHS](_ : _ = lim (fun n => \int[m1]_x F_ g n x))//. + limn (fun n => \int[m1]_x (\int[m2]_y (EFin \o g n) (x, y)))). + set r := fun _ => _; set l := fun _ => _; have -> // : l = r. + by apply/funext => n; rewrite /l /r sfun_fubini_tonelli1. +rewrite [RHS](_ : _ = limn (fun n => \int[m1]_x F_ g n x))//. rewrite -monotone_convergence //; first exact: eq_integral. - by move=> n; exact: sfun_measurable_fun_fubini_tonelli_F. - move=> n x _; apply: integral_ge0 => // y _ /=; rewrite lee_fin. exact: fun_ge0. - move=> x /= _ a b ab; apply: ge0_le_integral => //. + by move=> y _; rewrite lee_fin; exact: fun_ge0. - + exact/EFin_measurable_fun/measurable_fun_prod1. + + exact/EFin_measurable_fun/measurableT_comp. + by move=> *; rewrite lee_fin; exact: fun_ge0. - + exact/EFin_measurable_fun/measurable_fun_prod1. + + exact/EFin_measurable_fun/measurableT_comp. + by move=> y _; rewrite lee_fin; move/g_nd : ab => /lefP; exact. Qed. Lemma fubini_tonelli2 : \int[m1 \x m2]_z f z = \int[m2]_y G y. Proof. have [g [g_nd /= g_f]] := approximation measurableT mf (fun x _ => f0 x). -have G_G y : G y = lim (G_ g ^~ y). +have G_G y : G y = limn (G_ g ^~ y). rewrite /G /fubini_G. - rewrite [RHS](_ : _ = lim (fun n => \int[m1]_x (EFin \o g n) (x, y)))//. + rewrite [RHS](_ : _ = limn (fun n => \int[m1]_x (EFin \o g n) (x, y)))//. rewrite -monotone_convergence//; last 3 first. - - by move=> n; exact/EFin_measurable_fun/measurable_fun_prod2. + - by move=> n; exact/EFin_measurable_fun/measurableT_comp. - by move=> n /= x _; rewrite lee_fin; exact: fun_ge0. - by move=> x /= _ a b; rewrite lee_fin => /g_nd/lefP; exact. by apply: eq_integral => x _; apply/esym/cvg_lim => //; exact: g_f. -rewrite [RHS](_ : _ = lim (fun n => \int[m1 \x m2]_z (EFin \o g n) z)). +rewrite [RHS](_ : _ = limn (fun n => \int[m1 \x m2]_z (EFin \o g n) z)). rewrite -monotone_convergence //; last 3 first. - by move=> n; exact/EFin_measurable_fun. - by move=> n /= x _; rewrite lee_fin; exact: fun_ge0. - by move=> y /= _ a b; rewrite lee_fin => /g_nd/lefP; exact. by apply: eq_integral => /= x _; apply/esym/cvg_lim => //; exact: g_f. -rewrite [LHS](_ : _ = lim +rewrite [LHS](_ : _ = limn (fun n => \int[m2]_y (\int[m1]_x (EFin \o g n) (x, y)))). - congr (lim _); rewrite funeqE => n. - by rewrite sfun_fubini_tonelli sfun_fubini_tonelli2. -rewrite [RHS](_ : _ = lim (fun n => \int[m2]_y G_ g n y))//. + set r := fun _ => _; set l := fun _ => _; have -> // : l = r. + by apply/funext => n; rewrite /l /r sfun_fubini_tonelli sfun_fubini_tonelli2. +rewrite [RHS](_ : _ = limn (fun n => \int[m2]_y G_ g n y))//. rewrite -monotone_convergence //; first exact: eq_integral. - by move=> n; exact: sfun_measurable_fun_fubini_tonelli_G. - by move=> n y _; apply: integral_ge0 => // x _ /=; rewrite lee_fin fun_ge0. - move=> y /= _ a b ab; apply: ge0_le_integral => //. + by move=> x _; rewrite lee_fin fun_ge0. - + exact/EFin_measurable_fun/measurable_fun_prod2. + + exact/EFin_measurable_fun/measurableT_comp. + by move=> *; rewrite lee_fin fun_ge0. - + exact/EFin_measurable_fun/measurable_fun_prod2. + + exact/EFin_measurable_fun/measurableT_comp. + by move=> x _; rewrite lee_fin; move/g_nd : ab => /lefP; exact. Qed. @@ -4786,35 +5411,35 @@ Variable m2 : {sigma_finite_measure set T2 -> \bar R}. Variable f : T1 * T2 -> \bar R. Hypothesis imf : (m1 \x m2).-integrable setT f. -Let mf : measurable_fun setT f := imf.1. +Let mf : measurable_fun setT f. Proof. exact: measurable_int imf. Qed. (* NB: only relies on mf *) Lemma fubini1a : (m1 \x m2).-integrable setT f <-> \int[m1]_x \int[m2]_y `|f (x, y)| < +oo. Proof. -split=> [[_]|] ioo. -- by rewrite -(fubini_tonelli1 (abse \o f))//=; exact: measurable_funT_comp. -- by split=> //; rewrite fubini_tonelli1//; exact: measurable_funT_comp. +split=> [/integrableP[_]|] ioo; [|apply/integrableP; split=> [//|]]. +- by rewrite -(fubini_tonelli1 (abse \o f))//=; exact: measurableT_comp. +- by rewrite fubini_tonelli1//; exact: measurableT_comp. Qed. Lemma fubini1b : (m1 \x m2).-integrable setT f <-> \int[m2]_y \int[m1]_x `|f (x, y)| < +oo. Proof. -split=> [[_]|] ioo. -- by rewrite -(fubini_tonelli2 (abse \o f))//=; exact: measurable_funT_comp. -- by split=> //; rewrite fubini_tonelli2//; exact: measurable_funT_comp. +split=> [/integrableP[_]|] ioo; [|apply/integrableP; split=> [//|]]. +- by rewrite -(fubini_tonelli2 (abse \o f))//=; exact: measurableT_comp. +- by rewrite fubini_tonelli2//; exact: measurableT_comp. Qed. Let measurable_fun1 : measurable_fun setT (fun x => \int[m2]_y `|f (x, y)|). Proof. apply: (measurable_fun_fubini_tonelli_F (abse \o f)) => //=. -exact: measurable_funT_comp. +exact: measurableT_comp. Qed. Let measurable_fun2 : measurable_fun setT (fun y => \int[m1]_x `|f (x, y)|). Proof. apply: (measurable_fun_fubini_tonelli_G (abse \o f)) => //=. -exact: measurable_funT_comp. +exact: measurableT_comp. Qed. (* /NB: only relies on mf *) @@ -4822,26 +5447,28 @@ Lemma ae_integrable1 : {ae m1, forall x, m2.-integrable setT (fun y => f (x, y))}. Proof. have : m1.-integrable setT (fun x => \int[m2]_y `|f (x, y)|). - split => //; rewrite (le_lt_trans _ (fubini1a.1 imf))// ge0_le_integral //. - - exact: measurable_funT_comp. + apply/integrableP; split => //. + rewrite (le_lt_trans _ (fubini1a.1 imf))// ge0_le_integral //. + - exact: measurableT_comp. - by move=> *; exact: integral_ge0. - by move=> *; rewrite gee0_abs//; exact: integral_ge0. -move/integrable_ae => /(_ measurableT) [N [mN N0 subN]]; exists N; split => //. -apply/(subset_trans _ subN)/subsetC => x /= /(_ Logic.I) im2f. -by split; [exact/measurable_fun_prod1|by move/fin_numPlt : im2f => /andP[]]. +move/integrable_ae => /(_ measurableT); apply: filterS => x /= /(_ I) im2f. +apply/integrableP; split; first exact/measurableT_comp. +by move/fin_numPlt : im2f => /andP[]. Qed. Lemma ae_integrable2 : {ae m2, forall y, m1.-integrable setT (fun x => f (x, y))}. Proof. have : m2.-integrable setT (fun y => \int[m1]_x `|f (x, y)|). - split => //; rewrite (le_lt_trans _ (fubini1b.1 imf))// ge0_le_integral //. - - exact: measurable_funT_comp. + apply/integrableP; split => //. + rewrite (le_lt_trans _ (fubini1b.1 imf))// ge0_le_integral //. + - exact: measurableT_comp. - by move=> *; exact: integral_ge0. - by move=> *; rewrite gee0_abs//; exact: integral_ge0. -move/integrable_ae => /(_ measurableT) [N [mN N0 subN]]; exists N; split => //. -apply/(subset_trans _ subN)/subsetC => x /= /(_ Logic.I) im1f. -by split; [exact/measurable_fun_prod2|move/fin_numPlt : im1f => /andP[]]. +move/integrable_ae => /(_ measurableT); apply: filterS => x /= /(_ I) im2f. +apply/integrableP; split; first exact/measurableT_comp. +by move/fin_numPlt : im2f => /andP[]. Qed. Let F := fubini_F m2 f. @@ -4853,12 +5480,12 @@ Let FE : F = Fplus \- Fminus. Proof. apply/funext=> x; exact: integralE. Qed. Let measurable_Fplus : measurable_fun setT Fplus. Proof. -by apply: measurable_fun_fubini_tonelli_F => //; exact: emeasurable_fun_funepos. +by apply: measurable_fun_fubini_tonelli_F => //; exact: measurable_funepos. Qed. Let measurable_Fminus : measurable_fun setT Fminus. Proof. -by apply: measurable_fun_fubini_tonelli_F => //; exact: emeasurable_fun_funeneg. +by apply: measurable_fun_fubini_tonelli_F => //; exact: measurable_funeneg. Qed. Lemma measurable_fubini_F : measurable_fun setT F. @@ -4869,31 +5496,33 @@ Qed. Let integrable_Fplus : m1.-integrable setT Fplus. Proof. -split=> //; apply: le_lt_trans (fubini1a.1 imf); apply: ge0_le_integral => //. -- exact: measurable_funT_comp. +apply/integrableP; split=> //. +apply: le_lt_trans (fubini1a.1 imf); apply: ge0_le_integral => //. +- exact: measurableT_comp. - by move=> x _; exact: integral_ge0. - move=> x _; apply: le_trans. - apply: le_abse_integral => //; apply: emeasurable_fun_funepos => //. - exact: measurable_fun_prod1. + apply: le_abse_integral => //; apply: measurable_funepos => //. + exact: measurableT_comp. apply: ge0_le_integral => //. - - apply: measurable_funT_comp => //. - by apply: emeasurable_fun_funepos => //; exact: measurable_fun_prod1. - - by apply: measurable_funT_comp => //; exact/measurable_fun_prod1. + - apply: measurableT_comp => //. + by apply: measurable_funepos => //; exact: measurableT_comp. + - by apply: measurableT_comp => //; exact/measurableT_comp. - by move=> y _; rewrite gee0_abs// -/((abse \o f) (x, y)) fune_abse lee_addl. Qed. Let integrable_Fminus : m1.-integrable setT Fminus. Proof. -split=> //; apply: le_lt_trans (fubini1a.1 imf); apply: ge0_le_integral => //. -- exact: measurable_funT_comp. +apply/integrableP; split=> //. +apply: le_lt_trans (fubini1a.1 imf); apply: ge0_le_integral => //. +- exact: measurableT_comp. - by move=> *; exact: integral_ge0. - move=> x _; apply: le_trans. - apply: le_abse_integral => //; apply: emeasurable_fun_funeneg => //. - exact: measurable_fun_prod1. + apply: le_abse_integral => //; apply: measurable_funeneg => //. + exact: measurableT_comp. apply: ge0_le_integral => //. - + apply: measurable_funT_comp => //; apply: emeasurable_fun_funeneg => //. - exact: measurable_fun_prod1. - + by apply: measurable_funT_comp => //; exact: measurable_fun_prod1. + + apply: measurableT_comp => //; apply: measurable_funeneg => //. + exact: measurableT_comp. + + by apply: measurableT_comp => //; exact: measurableT_comp. + by move=> y _; rewrite gee0_abs// -/((abse \o f) (x, y)) fune_abse lee_addr. Qed. @@ -4909,12 +5538,12 @@ Let GE : G = Gplus \- Gminus. Proof. apply/funext=> x; exact: integralE. Qed. Let measurable_Gplus : measurable_fun setT Gplus. Proof. -by apply: measurable_fun_fubini_tonelli_G => //; exact: emeasurable_fun_funepos. +by apply: measurable_fun_fubini_tonelli_G => //; exact: measurable_funepos. Qed. Let measurable_Gminus : measurable_fun setT Gminus. Proof. -by apply: measurable_fun_fubini_tonelli_G => //; exact: emeasurable_fun_funeneg. +by apply: measurable_fun_fubini_tonelli_G => //; exact: measurable_funeneg. Qed. Lemma measurable_fubini_G : measurable_fun setT G. @@ -4922,46 +5551,48 @@ Proof. by rewrite GE; exact: emeasurable_funB. Qed. Let integrable_Gplus : m2.-integrable setT Gplus. Proof. -split=> //; apply: le_lt_trans (fubini1b.1 imf); apply: ge0_le_integral => //. -- exact: measurable_funT_comp. +apply/integrableP; split=> //. +apply: le_lt_trans (fubini1b.1 imf); apply: ge0_le_integral => //. +- exact: measurableT_comp. - by move=> *; exact: integral_ge0. - move=> y _; apply: le_trans. - apply: le_abse_integral => //; apply: emeasurable_fun_funepos => //. - exact: measurable_fun_prod2. + apply: le_abse_integral => //; apply: measurable_funepos => //. + exact: measurableT_comp. apply: ge0_le_integral => //. - - apply: measurable_funT_comp => //. - by apply: emeasurable_fun_funepos => //; exact: measurable_fun_prod2. - - by apply: measurable_funT_comp => //; exact: measurable_fun_prod2. + - apply: measurableT_comp => //. + by apply: measurable_funepos => //; exact: measurableT_comp. + - by apply: measurableT_comp => //; exact: measurableT_comp. - by move=> x _; rewrite gee0_abs// -/((abse \o f) (x, y)) fune_abse lee_addl. Qed. Let integrable_Gminus : m2.-integrable setT Gminus. Proof. -split=> //; apply: le_lt_trans (fubini1b.1 imf); apply: ge0_le_integral => //. -- exact: measurable_funT_comp. +apply/integrableP; split=> //. +apply: le_lt_trans (fubini1b.1 imf); apply: ge0_le_integral => //. +- exact: measurableT_comp. - by move=> *; exact: integral_ge0. - move=> y _; apply: le_trans. - apply: le_abse_integral => //; apply: emeasurable_fun_funeneg => //. - exact: measurable_fun_prod2. + apply: le_abse_integral => //; apply: measurable_funeneg => //. + exact: measurableT_comp. apply: ge0_le_integral => //. - + apply: measurable_funT_comp => //. - by apply: emeasurable_fun_funeneg => //; exact: measurable_fun_prod2. - + by apply: measurable_funT_comp => //; exact: measurable_fun_prod2. + + apply: measurableT_comp => //. + by apply: measurable_funeneg => //; exact: measurableT_comp. + + by apply: measurableT_comp => //; exact: measurableT_comp. + by move=> x _; rewrite gee0_abs// -/((abse \o f) (x, y)) fune_abse lee_addr. Qed. Lemma fubini1 : \int[m1]_x F x = \int[m1 \x m2]_z f z. Proof. -rewrite FE integralB// [in RHS]integralE//. -rewrite fubini_tonelli1//; last exact: emeasurable_fun_funepos. -by rewrite fubini_tonelli1//; exact: emeasurable_fun_funeneg. +rewrite FE integralB; [|by[]|exact: integrable_Fplus|exact: integrable_Fminus]. +by rewrite [in RHS]integralE ?fubini_tonelli1//; + [exact: measurable_funeneg|exact: measurable_funepos]. Qed. Lemma fubini2 : \int[m2]_x G x = \int[m1 \x m2]_z f z. Proof. -rewrite GE integralB// [in RHS]integralE//. -rewrite fubini_tonelli2//; last exact: emeasurable_fun_funepos. -by rewrite fubini_tonelli2//; exact: emeasurable_fun_funeneg. +rewrite GE integralB; [|by[]|exact: integrable_Gplus|exact: integrable_Gminus]. +by rewrite [in RHS]integralE ?fubini_tonelli2//; + [exact: measurable_funeneg|exact: measurable_funepos]. Qed. Theorem Fubini : @@ -4969,3 +5600,436 @@ Theorem Fubini : Proof. by rewrite fubini1 -fubini2. Qed. End fubini. + +Section sfinite_fubini. +Local Open Scope ereal_scope. +Context d d' (X : measurableType d) (Y : measurableType d') (R : realType). +Variables (m1 : {sfinite_measure set X -> \bar R}). +Variables (m2 : {sfinite_measure set Y -> \bar R}). +Variables (f : X * Y -> \bar R) (f0 : forall xy, 0 <= f xy). +Hypothesis mf : measurable_fun setT f. + +Lemma sfinite_Fubini : + \int[m1]_x \int[m2]_y f (x, y) = \int[m2]_y \int[m1]_x f (x, y). +Proof. +pose s1 := sfinite_measure_seq m1. +pose s2 := sfinite_measure_seq m2. +rewrite [LHS](eq_measure_integral [the measure _ _ of mseries s1 0]); last first. + by move=> A mA _; rewrite /=; exact: sfinite_measure_seqP. +transitivity (\int[mseries s1 0]_x \int[mseries s2 0]_y f (x, y)). + apply: eq_integral => x _; apply: eq_measure_integral => ? ? _. + exact: sfinite_measure_seqP. +transitivity (\sum_(n t _; exact: integral_ge0. + rewrite [X in measurable_fun _ X](_ : _ = + fun x => \sum_(n x. + by rewrite ge0_integral_measure_series//; exact/measurableT_comp. + apply: ge0_emeasurable_fun_sum; first by move=> k x; exact: integral_ge0. + by move=> k; apply: measurable_fun_fubini_tonelli_F. + apply: eq_eseriesr => n _; apply: eq_integral => x _. + by rewrite ge0_integral_measure_series//; exact/measurableT_comp. +transitivity (\sum_(n n _; rewrite integral_nneseries//. + by move=> m; exact: measurable_fun_fubini_tonelli_F. + by move=> m x _; exact: integral_ge0. +transitivity (\sum_(n n _; apply: eq_eseriesr => m _. + by rewrite fubini_tonelli//; exact: finite_measure_sigma_finite. +transitivity (\sum_(n n _; rewrite ge0_integral_measure_series//. + by move=> y _; exact: integral_ge0. + exact: measurable_fun_fubini_tonelli_G. +transitivity (\int[mseries s2 0]_y \sum_(n n; apply: measurable_fun_fubini_tonelli_G. + by move=> n y _; exact: integral_ge0. +transitivity (\int[mseries s2 0]_y \int[mseries s1 0]_x f (x, y)). + apply: eq_integral => y _. + by rewrite ge0_integral_measure_series//; exact/measurableT_comp. +transitivity (\int[m2]_y \int[mseries s1 0]_x f (x, y)). + by apply: eq_measure_integral => A mA _ /=; rewrite sfinite_measure_seqP. +apply: eq_integral => y _; apply: eq_measure_integral => A mA _ /=. +by rewrite sfinite_measure_seqP. +Qed. + +End sfinite_fubini. +Arguments sfinite_Fubini {d d' X Y R} m1 m2 f. + +Section lebesgue_differentiation_continuous. +Context (rT : realType). +Let mu := [the measure _ _ of @lebesgue_measure rT]. +Let R := [the measurableType _ of measurableTypeR rT]. + +Let ballE (x : R) (r : {posnum rT}) : + ball x r%:num = `](x - r%:num), (x + r%:num)[%classic :> set rT. +Proof. +rewrite -ball_normE /ball_ set_itvoo. +by under eq_set => ? do rewrite ltr_distlC. +Qed. + +Lemma lebesgue_differentiation_continuous (f : R -> rT^o) (A : set R) (x : R) : + open A -> mu.-integrable A (EFin \o f) -> {for x, continuous f} -> A x -> + (fun r => 1 / (r *+ 2) * \int[mu]_(z in ball x r) f z) @ 0^'+ --> + (f x : R^o). +Proof. +have ball_itvr r : 0 < r -> `[x - r, x + r] `\` ball x r = [set x + r; x - r]. + move: r => _/posnumP[r]. + rewrite -setU1itv ?bnd_simp ?lerBlDr -?addrA ?ler_wpDr//. + rewrite -setUitv1 ?bnd_simp ?ltrBlDr -?addrA ?ltr_pwDr//. + rewrite setUA setUC setUA setDUl !ballE setDv setU0 setDidl// -subset0. + by move=> z /= [[]] ->; rewrite in_itv/= ltxx// andbF. +have ball_itv2 r : 0 < r -> ball x r = `[x - r, x + r] `\` [set x + r; x - r]. + move: r => _/posnumP[r]. + rewrite -ball_itvr // setDD setIC; apply/esym/setIidPl. + by rewrite ballE set_itvcc => ?/=; rewrite in_itv => /andP [/ltW -> /ltW ->]. +have ritv r : 0 < r -> mu `[x - r, x + r]%classic = (r *+ 2)%:E. + move=> /gt0_cp rE; rewrite /= lebesgue_measure_itv/= lte_fin. + rewrite ler_ltD // ?rE // -EFinD; congr (_ _). + by rewrite opprB addrAC [_ - _]addrC addrA subrr add0r. +move=> oA intf ctsfx Ax. +apply: cvg_zero. +apply/cvgrPdist_le => eps epos; apply: filter_app (@nbhs_right_gt rT 0). +move/cvgrPdist_le/(_ eps epos)/at_right_in_segment : ctsfx; apply: filter_app. +apply: filter_app (open_itvcc_subset oA Ax). +have mA : measurable A := open_measurable oA. +near=> r => xrA; rewrite addrfctE opprfctE => feps rp. +have cptxr : compact `[x - r, x + r] := @segment_compact _ _ _. +rewrite distrC subr0. +have -> : \int[mu]_(z in ball x r) f z = \int[mu]_(z in `[x - r, x + r]) f z. + rewrite ball_itv2 //; congr (fine _); rewrite -negligible_integral //. + - by apply/measurableU; exact: measurable_set1. + - exact: (integrableS mA). + - by rewrite measureU0//; exact: lebesgue_measure_set1. +have r20 : 0 <= 1 / (r *+ 2) by rewrite ?divr_ge0 // mulrn_wge0. +have -> : f x = 1 / (r *+ 2) * \int[mu]_(z in `[x - r, x + r]) cst (f x) z. + rewrite /Rintegral /= integral_cst /= ?ritv // mulrC mul1r. + by rewrite -mulrA divff ?mulr1//; apply: lt0r_neq0; rewrite mulrn_wgt0. +have intRf : mu.-integrable `[x - r, x + r] (EFin \o f). + exact: (@integrableS _ _ _ mu _ _ _ _ _ xrA intf). +rewrite /= -mulrBr -fineB; first last. +- rewrite integral_fune_fin_num// continuous_compact_integrable// => ?. + exact: cvg_cst. +- by rewrite integral_fune_fin_num. +rewrite -integralB_EFin //; first last. + by apply: continuous_compact_integrable => // ?; exact: cvg_cst. +under [fun _ => _ + _ ]eq_fun => ? do rewrite -EFinD. +have int_fx : mu.-integrable `[x - r, x + r] (fun z => (f z - f x)%:E). + under [fun z => (f z - _)%:E]eq_fun => ? do rewrite EFinB. + rewrite integrableB// continuous_compact_integrable// => ?. + exact: cvg_cst. +rewrite normrM [ `|_/_| ]ger0_norm // -fine_abse //; first last. + by rewrite integral_fune_fin_num. +suff : (\int[mu]_(z in `[(x - r)%R, (x + r)%R]) `|f z - f x|%:E <= + (r *+ 2 * eps)%:E)%E. + move=> intfeps; apply: le_trans. + apply: (ler_pM r20 _ (le_refl _)); first exact: fine_ge0. + apply: fine_le; last apply: le_abse_integral => //. + - by rewrite abse_fin_num integral_fune_fin_num. + - by rewrite integral_fune_fin_num// integrable_abse. + - by case/integrableP : int_fx. + rewrite div1r ler_pdivrMl ?mulrn_wgt0 // -[_ * _]/(fine (_%:E)). + by rewrite fine_le// integral_fune_fin_num// integrable_abse. +apply: le_trans. +- apply: (@integral_le_bound _ _ _ _ _ (fun z => (f z - f x)%:E) eps%:E) => //. + + by case/integrableP: int_fx. + + exact: ltW. + + by apply: aeW => ? ?; rewrite /= lee_fin distrC feps. +by rewrite ritv //= -EFinM lee_fin mulrC. +Unshelve. all: by end_near. Qed. + +End lebesgue_differentiation_continuous. + +Section locally_integrable. +Context {R : realType}. +Implicit Types (D : set R) (f g : R -> R). +Local Open Scope ereal_scope. + +Local Notation mu := lebesgue_measure. + +Definition locally_integrable D f := [/\ measurable_fun D f, open D & + forall K, K `<=` D -> compact K -> \int[mu]_(x in K) `|f x|%:E < +oo]. + +Lemma integrable_locally D f : open D -> + mu.-integrable D (EFin \o f) -> locally_integrable D f. +Proof. +move=> oD /integrableP[mf foo]; split => //; first exact/EFin_measurable_fun. +move=> K KD cK; rewrite (le_lt_trans _ foo)// subset_integral//=. +- exact: compact_measurable. +- exact: open_measurable. +- apply/EFin_measurable_fun; apply: measurableT_comp => //. + exact/EFin_measurable_fun. +Qed. + +Lemma locally_integrableN D f : + locally_integrable D f -> locally_integrable D (\- f)%R. +Proof. +move=> [mf oD foo]; split => //; first exact: measurableT_comp. +by move=> K KD cK; under eq_integral do rewrite normrN; exact: foo. +Qed. + +Lemma locally_integrableD D f g : + locally_integrable D f -> locally_integrable D g -> + locally_integrable D (f \+ g)%R. +Proof. +move=> [mf oD foo] [mg _ goo]; split => //; first exact: measurable_funD. +move=> K KD cK. +suff : lebesgue_measure.-integrable K ((EFin \o f) \+ (EFin \o g)). + by case/integrableP. +apply: integrableD => //=; first exact: compact_measurable. +- apply/integrableP; split; last exact: foo. + apply/EFin_measurable_fun; apply: measurable_funS mf => //. + exact: open_measurable. +- apply/integrableP; split; last exact: goo. + apply/EFin_measurable_fun; apply: measurable_funS mg => //. + exact: open_measurable. +Qed. + +Lemma locally_integrableB D f g : + locally_integrable D f -> locally_integrable D g -> + locally_integrable D (f \- g)%R. +Proof. +by move=> lf lg; apply: locally_integrableD => //; exact: locally_integrableN. +Qed. + +End locally_integrable. + +Section iavg. +Context {R : realType}. +Implicit Types (D A : set R) (f g : R -> R). +Local Open Scope ereal_scope. + +Local Notation mu := lebesgue_measure. + +Definition iavg f A := (fine (mu A))^-1%:E * \int[mu]_(y in A) `| (f y)%:E |. + +Lemma iavg0 f : iavg f set0 = 0. +Proof. by rewrite /iavg integral_set0 mule0. Qed. + +Lemma iavg_ge0 f A : 0 <= iavg f A. +Proof. +by rewrite /iavg mule_ge0 ?integral_ge0// lee_fin invr_ge0// fine_ge0. +Qed. + +Lemma iavg_restrict f D A : measurable D -> measurable A -> + iavg (f \_ D) A = ((fine (mu A))^-1)%:E * \int[mu]_(y in D `&` A) `|f y|%:E. +Proof. +move=> mD mA; rewrite /iavg setIC integral_setI_indic//=; congr *%E. +apply: eq_integral => /= y yx1. +by rewrite patch_indic/= normrM EFinM (@ger0_norm _ (\1_D _)). +Qed. + +Lemma iavgD f g A : measurable A -> mu A < +oo -> + measurable_fun A f -> measurable_fun A g -> + iavg (f \+ g)%R A <= iavg f A + iavg g A. +Proof. +move=> mA Aoo mf mg; have [r0|r0] := eqVneq (mu A) 0. + by rewrite /iavg r0/= invr0 !mul0e adde0. +rewrite -muleDr//=; last by rewrite ge0_adde_def// inE integral_ge0. +rewrite lee_pmul2l//; last first. + by rewrite lte_fin invr_gt0// fine_gt0// Aoo andbC/= lt0e r0/=. +rewrite -ge0_integralD//=; [|by do 2 apply: measurableT_comp..]. +apply: ge0_le_integral => //=. +- by do 2 apply: measurableT_comp => //; exact: measurable_funD. +- by move=> /= x _; rewrite adde_ge0. +- by apply: measurableT_comp => //; apply: measurable_funD => //; + exact: measurableT_comp. +- by move=> /= x _; exact: ler_normD. +Qed. + +End iavg. + +Section hardy_littlewood. +Context {R : realType}. +Notation mu := (@lebesgue_measure R). +Implicit Types (D : set R) (f : R -> R). +Local Open Scope ereal_scope. + +Definition HL_maximal f (x : R) : \bar R := + ereal_sup [set iavg f (ball x r) | r in `]0, +oo[%classic%R]. + +Local Notation HL := HL_maximal. + +Lemma HL_maximal_ge0 f D : locally_integrable D f -> + forall x, 0 <= HL (f \_ D) x. +Proof. +move=> Df x; apply: ereal_sup_le => //=. +pose k := \int[mu]_(x in D `&` ball x 1) `|f x|%:E. +exists ((fine (mu (ball x 1)))^-1%:E * k); last first. + rewrite mule_ge0//; last exact: integral_ge0. + by rewrite lee_fin// invr_ge0// fine_ge0. +exists 1%R; first by rewrite in_itv/= ltr01. +rewrite iavg_restrict//; last exact: measurable_ball. +by case: Df => _ /open_measurable. +Qed. + +Lemma HL_maximalT_ge0 f : locally_integrable setT f -> forall x, 0 <= HL f x. +Proof. by move=> + x => /HL_maximal_ge0 /(_ x); rewrite patch_setT. Qed. + +Let locally_integrable_ltbally (f : R -> R) (x r : R) : + locally_integrable setT f -> \int[mu]_(y in ball x r) `|(f y)%:E| < +oo. +Proof. +move=> [mf _ locf]; have [r0|r0] := leP r 0%R. + by rewrite (ball0 _ _).2// integral_set0. +rewrite (le_lt_trans _ (locf (closed_ball x r) _ (closed_ballR_compact _)))//. +apply: subset_integral => //; first exact: measurable_ball. +- by apply: measurable_closed_ball; exact/ltW. +- apply: measurable_funTS; apply/measurableT_comp => //=. + exact: measurableT_comp. +- exact: subset_closed_ball. +Qed. + +Lemma lower_semicontinuous_HL_maximal f : + locally_integrable setT f -> lower_semicontinuous (HL f). +Proof. +move=> [mf ? locf]; apply/lower_semicontinuousP => a. +have [a0|a0] := lerP 0 a; last first. + rewrite [X in open X](_ : _ = setT); first exact: openT. + by apply/seteqP; split=> // x _; exact: (lt_le_trans _ (HL_maximalT_ge0 _ _)). +rewrite openE /= => x /= /ereal_sup_gt[_ [r r0] <-] afxr. +rewrite /= in_itv /= andbT in r0. +rewrite /iavg in afxr; set k := \int[_]_(_ in _) _ in afxr. +apply: nbhs_singleton; apply: nbhs_interior; rewrite nbhsE /=. +have k_gt0 : 0 < k. + rewrite lt0e integral_ge0// andbT; apply/negP => /eqP k0. + by move: afxr; rewrite k0 mule0 lte_fin ltNge a0. +move: a0; rewrite le_eqVlt => /predU1P[a0|a0]. + move: afxr; rewrite -{a}a0 => xrk. + near (0%R : R)^'+ => d. + have xrdk : 0 < (fine (mu (ball x (r + d))))^-1%:E * k. + rewrite mule_gt0// lte_fin invr_gt0// fine_gt0//. + rewrite lebesgue_measure_ball; last by rewrite addr_ge0// ltW. + by rewrite ltry andbT lte_fin pmulrn_lgt0// addr_gt0. + exists (ball x d). + by split; [exact: ball_open|exact: ballxx]. + move=> y; rewrite /ball/= => xyd. + have ? : ball x r `<=` ball y (r + d). + move=> /= z; rewrite /ball/= => xzr; rewrite -(subrK x y) -(addrA (y - x)%R). + by rewrite (le_lt_trans (ler_normD _ _))// addrC ltrD// distrC. + have ? : k <= \int[mu]_(y in ball y (r + d)) `|(f y)%:E|. + apply: subset_integral =>//; [exact:measurable_ball|exact:measurable_ball|]. + apply: measurable_funTS; apply: measurableT_comp => //=. + by apply/measurableT_comp => //=; case: locf. + have : iavg f (ball y (r + d)) <= HL f y. + apply: ereal_sup_ub => /=; exists (r + d)%R => //. + by rewrite in_itv/= andbT addr_gt0. + apply/lt_le_trans/(lt_le_trans xrdk); rewrite /iavg. + do 2 (rewrite lebesgue_measure_ball; last by rewrite addr_ge0// ltW). + rewrite lee_wpmul2l// lee_fin invr_ge0// fine_ge0// lee_fin pmulrn_rge0//. + by rewrite addr_gt0. +have ka_pos : fine k / a \is Num.pos. + by rewrite posrE divr_gt0// fine_gt0 // k_gt0/= locally_integrable_ltbally. +have k_fin_num : k \is a fin_num. + by rewrite ge0_fin_numE ?locally_integrable_ltbally// integral_ge0. +have kar : (0 < 2^-1 * (fine k / a) - r)%R. + move: afxr; rewrite -{1}(fineK k_fin_num) -lte_pdivr_mulr; last first. + by rewrite fine_gt0// k_gt0/= ltey_eq k_fin_num. + rewrite (lebesgue_measure_ball _ (ltW r0))//. + rewrite -!EFinM !lte_fin -invf_div ltf_pV2 ?posrE ?pmulrn_lgt0//. + rewrite /= -[in X in X -> _]mulr_natl -ltr_pdivlMl//. + by rewrite -[in X in X -> _]subr_gt0. +near (0%R : R)^'+ => d. +have axrdk : a%:E < (fine (mu (ball x (r + d))))^-1%:E * k. + rewrite lebesgue_measure_ball//; last by rewrite addr_ge0// ltW. + rewrite -(fineK k_fin_num) -lte_pdivr_mulr; last first. + by rewrite fine_gt0// k_gt0/= locally_integrable_ltbally. + rewrite -!EFinM !lte_fin -invf_div ltf_pV2//; last first. + by rewrite posrE fine_gt0// ltry andbT lte_fin pmulrn_lgt0// addr_gt0. + rewrite -mulr_natl -ltr_pdivlMl// -ltrBrDl. + by near: d; exact: nbhs_right_lt. +exists (ball x d). + by split; [exact: ball_open|exact: ballxx]. +move=> y; rewrite /ball/= => xyd. +have ? : ball x r `<=` ball y (r + d). + move=> /= z; rewrite /ball/= => xzr; rewrite -(subrK x y) -(addrA (y - x)%R). + by rewrite (le_lt_trans (ler_normD _ _))// addrC ltrD// distrC. +have ? : k <= \int[mu]_(z in ball y (r + d)) `|(f z)%:E|. + apply: subset_integral => //; [exact: measurable_ball|exact: measurable_ball|]. + by apply: measurable_funTS; do 2 apply: measurableT_comp => //. +have afxrdi : a%:E < (fine (mu (ball x (r + d))))^-1%:E * + \int[mu]_(z in ball y (r + d)) `|(f z)%:E|. + by rewrite (lt_le_trans axrdk)// lee_wpmul2l// lee_fin invr_ge0// fine_ge0. +have /lt_le_trans : a%:E < iavg f (ball y (r + d)). + apply: (lt_le_trans afxrdi); rewrite /iavg. + do 2 (rewrite lebesgue_measure_ball; last by rewrite addr_ge0// ltW). + rewrite lee_wpmul2l// lee_fin invr_ge0// fine_ge0//= lee_fin pmulrn_rge0//. + by rewrite addr_gt0. +apply; apply: ereal_sup_ub => /=. +by exists (r + d)%R => //; rewrite in_itv/= andbT addr_gt0. +Unshelve. all: by end_near. Qed. + +Lemma measurable_HL_maximal f : + locally_integrable setT f -> measurable_fun setT (HL f). +Proof. +move=> lf; apply: lower_semicontinuous_measurable. +exact: lower_semicontinuous_HL_maximal. +Qed. + +Let norm1 D f := \int[mu]_(y in D) `|(f y)%:E|. + +Lemma maximal_inequality f c : + locally_integrable setT f -> (0 < c)%R -> + mu [set x | HL f x > c%:E] <= (3%:R / c)%:E * norm1 setT f. +Proof. +move=> /= locf c0. +have r_proof x : HL f x > c%:E -> {r | (0 < r)%R & + \int[mu]_(y in ball x r) `|(f y)%:E| > c%:E * mu (ball x r)}. + move=> /ereal_sup_gt/cid2[y /= /cid2[r]]. + rewrite in_itv/= andbT => rg0 <-{y} Hc; exists r => //. + rewrite -(@fineK _ (mu (ball x r))) ?ge0_fin_numE//; last first. + by rewrite lebesgue_measure_ball ?ltry// ltW. + rewrite -lte_pdivl_mulr// 1?muleC// fine_gt0//. + by rewrite lebesgue_measure_ball 1?ltW// ltry lte_fin mulrn_wgt0. +rewrite lebesgue_regularity_inner_sup//; last first. + rewrite -[X in measurable X]setTI; apply: emeasurable_fun_o_infty => //. + exact: measurable_HL_maximal. +apply: ub_ereal_sup => /= x /= [K [cK Kcmf <-{x}]]. +pose r_ x := + if pselect (HL f x > c%:E) is left H then s2val (r_proof _ H) else 1%R. +have r_pos (x : R) : (0 < r_ x)%R. + by rewrite /r_; case: pselect => //= cMfx; case: (r_proof _ cMfx). +have cMfx_int x : c%:E < HL f x -> + \int[mu]_(y in ball x (r_ x)) `|(f y)|%:E > c%:E * mu (ball x (r_ x)). + move=> cMfx; rewrite /r_; case: pselect => //= => {}cMfx. + by case: (r_proof _ cMfx). +set B := fun r => ball r (r_ r). +have {}Kcmf : K `<=` cover [set i | HL f i > c%:E] (fun i => ball i (r_ i)). + by move=> r /Kcmf /= cMfr; exists r => //; exact: ballxx. +have {Kcmf}[D Dsub Kcover] : finite_subset_cover [set i | c%:E < HL f i] + (fun i => ball i (r_ i)) K. + move: cK; rewrite compact_cover => /(_ _ _ _ _ Kcmf); apply. + by move=> /= x cMfx; exact/ball_open/r_pos. +have KDB : K `<=` cover [set` D] B. + by apply: (subset_trans Kcover) => /= x [r Dr] rx; exists r. +have is_ballB i : is_ball (B i) by exact: is_ball_ball. +have Bset0 i : B i !=set0 by exists i; exact: ballxx. +have [E [uE ED tEB DE]] := @vitali_lemma_finite_cover _ _ B is_ballB Bset0 D. +rewrite (@le_trans _ _ (3%:R%:E * \sum_(i <- E) mu (B i)))//. + have {}DE := subset_trans KDB DE. + apply: (le_trans (@content_sub_additive _ _ _ [the measure _ _ of mu] + K (fun i => 3%:R *` B (nth 0%R E i)) (size E) _ _ _)) => //. + - by move=> k ?; rewrite scale_ballE//; exact: measurable_ball. + - by apply: closed_measurable; apply: compact_closed => //; exact: Rhausdorff. + - apply: (subset_trans DE); rewrite /cover bigcup_seq. + by rewrite (big_nth 0%R)//= big_mkord. + - rewrite ge0_sume_distrr//= (big_nth 0%R) big_mkord; apply: lee_sum => i _. + rewrite scale_ballE// !lebesgue_measure_ball ?mulr_ge0 ?(ltW (r_pos _))//. + by rewrite -mulrnAr EFinM. +rewrite !EFinM -muleA lee_wpmul2l//=. +apply: (@le_trans _ _ + (\sum_(i <- E) c^-1%:E * \int[mu]_(y in B i) `|(f y)|%:E)). + rewrite [in leLHS]big_seq [in leRHS]big_seq; apply: lee_sum => r /ED /Dsub /[!inE] rD. + by rewrite -lee_pdivr_mull ?invr_gt0// invrK /B/=; exact/ltW/cMfx_int. +rewrite -ge0_sume_distrr//; last by move=> x _; rewrite integral_ge0. +rewrite lee_wpmul2l//; first by rewrite lee_fin invr_ge0 ltW. +rewrite -ge0_integral_bigsetU//=. +- apply: subset_integral => //. + + by apply: bigsetU_measurable => ? ?; exact: measurable_ball. + + by apply: measurableT_comp => //; apply: measurableT_comp => //; case: locf. +- by move=> n; exact: measurable_ball. +- apply: measurableT_comp => //; apply: measurable_funTS. + by apply: measurableT_comp => //; case: locf. +Qed. + +End hardy_littlewood. diff --git a/theories/lebesgue_measure.v b/theories/lebesgue_measure.v index ea3012391..a670be30e 100644 --- a/theories/lebesgue_measure.v +++ b/theories/lebesgue_measure.v @@ -1,33 +1,36 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval. From mathcomp Require Import finmap fingroup perm rat. -From mathcomp.classical Require Import boolp classical_sets functions. -From mathcomp.classical Require Import cardinality fsbigop mathcomp_extra. +From mathcomp Require Import mathcomp_extra boolp classical_sets functions. +From mathcomp Require Import cardinality fsbigop. Require Import reals ereal signed topology numfun normedtype. From HB Require Import structures. -Require Import sequences esum measure real_interval realfun. +Require Import sequences esum measure real_interval realfun exp. +Require Export lebesgue_stieltjes_measure. -(******************************************************************************) -(* Lebesgue Measure *) +(**md**************************************************************************) +(* # Lebesgue Measure *) (* *) (* This file contains a formalization of the Lebesgue measure using the *) -(* Caratheodory's theorem available in measure.v and further develops the *) -(* theory of measurable functions. *) +(* Measure Extension theorem from measure.v, further develops the theory of *) +(* of measurable functions, and prove properties of the Lebesgue measure *) +(* such as Vitali's covering lemma (infinite case), i.e., given a Vitali *) +(* cover $V$ of $A$, there exists a countable subcollection $D \subseteq V$ *) +(* of pairwise disjoint closed balls such that *) +(* $\lambda(A \setminus \bigcup_k D_k) = 0$. *) (* *) -(* Main reference: *) +(* Main references: *) (* - Daniel Li, Intégration et applications, 2016 *) (* - Achim Klenke, Probability Theory 2nd edition, 2014 *) (* *) -(* hlength A == length of the hull of the set of real numbers A *) -(* ocitv == set of open-closed intervals ]x, y] where *) -(* x and y are real numbers *) +(* ``` *) (* lebesgue_measure == the Lebesgue measure *) -(* *) (* ps_infty == inductive definition of the powerset *) (* {0, {-oo}, {+oo}, {-oo,+oo}} *) (* emeasurable G == sigma-algebra over \bar R built out of the *) (* measurables G of a sigma-algebra over R *) (* elebesgue_measure == the Lebesgue measure extended to \bar R *) +(* ``` *) (* *) (* The modules RGenOInfty, RGenInftyO, RGenCInfty, RGenOpens provide proofs *) (* of equivalence between the sigma-algebra generated by list of intervals *) @@ -38,6 +41,11 @@ Require Import sequences esum measure real_interval realfun. (* of equivalence between emeasurable and the sigma-algebras generated open *) (* rays and closed rays. *) (* *) +(* ``` *) +(* vitali_cover A B V == V is a Vitali cover of A, here B is a *) +(* collection of non-empty closed balls *) +(* ``` *) +(* *) (******************************************************************************) Set Implicit Arguments. @@ -49,16 +57,17 @@ Import numFieldTopology.Exports. Local Open Scope classical_set_scope. Local Open Scope ring_scope. -Reserved Notation "R .-ocitv" (at level 1, format "R .-ocitv"). -Reserved Notation "R .-ocitv.-measurable" - (at level 2, format "R .-ocitv.-measurable"). - +(* This module contains a direct construction of the Lebesgue measure that is + kept here for archival purpose. The Lebesgue measure is actually defined as + an instance of the Lebesgue-Stieltjes measure. *) +Module LebesgueMeasure. Section hlength. +Context {R : realType}. Local Open Scope ereal_scope. -Variable R : realType. Implicit Types i j : interval R. -Definition hlength (A : set R) : \bar R := let i := Rhull A in i.2 - i.1. +Definition hlength (A : set (ocitv_type R)) : \bar R := + let i := Rhull A in (i.2 : \bar R) - i.1. Lemma hlength0 : hlength (set0 : set R) = 0. Proof. by rewrite /hlength Rhull0 /= subee. Qed. @@ -72,7 +81,8 @@ Qed. Lemma hlength_setT : hlength setT = +oo%E :> \bar R. Proof. by rewrite /hlength RhullT. Qed. -Lemma hlength_itv i : hlength [set` i] = if i.2 > i.1 then i.2 - i.1 else 0. +Lemma hlength_itv i : + hlength [set` i] = if i.2 > i.1 then (i.2 : \bar R) - i.1 else 0. Proof. case: ltP => [/lt_ereal_bnd/neitvP i12|]; first by rewrite /hlength set_itvK. rewrite le_eqVlt => /orP[|/lt_ereal_bnd i12]; last first. @@ -95,7 +105,7 @@ by move=> _; rewrite hlength_itv /= ltNyr. by move=> _; rewrite hlength_itv. Qed. -Lemma finite_hlengthE i : neitv i -> hlength [set` i] < +oo -> +Lemma finite_hlength_itv i : neitv i -> hlength [set` i] < +oo -> hlength [set` i] = (fine i.2)%:E - (fine i.1)%:E. Proof. move=> i0 ioo; have [ri1 ri2] := hlength_finite_fin_num i0 ioo. @@ -112,7 +122,7 @@ Lemma hlength_bnd_infty b r : hlength [set` Interval (BSide b r) +oo%O] = +oo :> \bar R. Proof. by rewrite hlength_itv /= ltry. Qed. -Lemma pinfty_hlength i : hlength [set` i] = +oo -> +Lemma infinite_hlength_itv i : hlength [set` i] = +oo -> (exists s r, i = Interval -oo%O (BSide s r) \/ i = Interval (BSide s r) +oo%O) \/ i = `]-oo, +oo[. Proof. @@ -123,14 +133,13 @@ rewrite hlength_itv; case: i => -[ba a|[]] [bb b|[]] //= => [|_|_|]. - by right. Qed. -Lemma hlength_ge0 i : 0 <= hlength [set` i]. +Lemma hlength_itv_ge0 i : 0 <= hlength [set` i]. Proof. rewrite hlength_itv; case: ifPn => //; case: (i.1 : \bar _) => [r| |]. - by rewrite suber_ge0//; exact: ltW. - by rewrite ltNge leey. -- by case: (i.2 : \bar _) => //= [r _]; rewrite leey. +- by move=> i2gtNy; rewrite addey//; case: (i.2 : \bar R) i2gtNy. Qed. -Local Hint Extern 0 (0%:E <= hlength _) => solve[apply: hlength_ge0] : core. Lemma hlength_Rhull (A : set R) : hlength [set` Rhull A] = hlength A. Proof. by rewrite /hlength Rhull_involutive. Qed. @@ -138,7 +147,7 @@ Proof. by rewrite /hlength Rhull_involutive. Qed. Lemma le_hlength_itv i j : {subset i <= j} -> hlength [set` i] <= hlength [set` j]. Proof. set I := [set` i]; set J := [set` j]. -have [->|/set0P I0] := eqVneq I set0; first by rewrite hlength0 hlength_ge0. +have [->|/set0P I0] := eqVneq I set0; first by rewrite hlength0 hlength_itv_ge0. have [J0|/set0P J0] := eqVneq J set0. by move/subset_itvP; rewrite -/J J0 subset0 -/I => ->. move=> /subset_itvP ij; apply: lee_sub => /=. @@ -150,7 +159,7 @@ move=> /subset_itvP ij; apply: lee_sub => /=. have [lj /=|lj] := asboolP (has_lbound J); last by rewrite leNye. have [li /=|li] := asboolP (has_lbound I); last first. by move: li; have := subset_has_lbound ij lj. -rewrite lee_fin ler_oppl opprK le_sup// ?has_inf_supN//; last exact/nonemptyN. +rewrite lee_fin lerNl opprK le_sup// ?has_inf_supN//; last exact/nonemptyN. move=> r [r' Ir' <-{r}]; exists (- r')%R. by split => //; exists r' => //; apply: ij. Qed. @@ -161,80 +170,13 @@ move=> a b /le_Rhull /le_hlength_itv. by rewrite (hlength_Rhull a) (hlength_Rhull b). Qed. -End hlength. -Arguments hlength {R}. -#[global] Hint Extern 0 (0%:E <= hlength _) => solve[apply: hlength_ge0] : core. - -Section itv_semiRingOfSets. -Variable R : realType. -Implicit Types (I J K : set R). -Definition ocitv_type : Type := R. - -Definition ocitv := [set `]x.1, x.2]%classic | x in [set: R * R]]. - -Lemma is_ocitv a b : ocitv `]a, b]%classic. -Proof. by exists (a, b); split => //=; rewrite in_itv/= andbT. Qed. -Hint Extern 0 (ocitv _) => solve [apply: is_ocitv] : core. - -Lemma ocitv0 : ocitv set0. -Proof. by exists (1, 0); rewrite //= set_itv_ge ?bnd_simp//= ltr10. Qed. -Hint Resolve ocitv0 : core. - -Lemma ocitvP X : ocitv X <-> X = set0 \/ exists2 x, x.1 < x.2 & X = `]x.1, x.2]%classic. -Proof. -split=> [[x _ <-]|[->//|[x xlt ->]]]//. -case: (boolP (x.1 < x.2)) => x12; first by right; exists x. -by left; rewrite set_itv_ge. -Qed. - -Lemma ocitvD : semi_setD_closed ocitv. -Proof. -move=> _ _ [a _ <-] /ocitvP[|[b ltb]] ->. - rewrite setD0; exists [set `]a.1, a.2]%classic]. - by split=> [//|? ->//||? ? -> ->//]; rewrite bigcup_set1. -rewrite setDE setCitv/= setIUr -!set_itvI. -rewrite /Order.meet/= /Order.meet/= /Order.join/= - ?(andbF, orbF)/= ?(meetEtotal, joinEtotal). -rewrite -negb_or le_total/=; set c := minr _ _; set d := maxr _ _. -have inside : a.1 < c -> d < a.2 -> `]a.1, c] `&` `]d, a.2] = set0. - rewrite -subset0 lt_minr lt_maxl => /andP[a12 ab1] /andP[_ ba2] x /= []. - have b1a2 : b.1 <= a.2 by rewrite ltW// (lt_trans ltb). - have a1b2 : a.1 <= b.2 by rewrite ltW// (lt_trans _ ltb). - rewrite /c /d (min_idPr _)// (max_idPr _)// !in_itv /=. - move=> /andP[a1x xb1] /andP[b2x xa2]. - by have := lt_le_trans b2x xb1; case: ltgtP ltb. -exists ((if a.1 < c then [set `]a.1, c]%classic] else set0) `|` - (if d < a.2 then [set `]d, a.2]%classic] else set0)); split. -- by rewrite finite_setU; do! case: ifP. -- by move=> ? []; case: ifP => ? // ->//=. -- by rewrite bigcup_setU; congr (_ `|` _); - case: ifPn => ?; rewrite ?bigcup_set1 ?bigcup_set0// set_itv_ge. -- move=> I J/=; case: ifP => //= ac; case: ifP => //= da [] // -> []// ->. - by rewrite inside// => -[]. - by rewrite setIC inside// => -[]. -Qed. - -Lemma ocitvI : setI_closed ocitv. -Proof. -move=> _ _ [a _ <-] [b _ <-]; rewrite -set_itvI/=. -rewrite /Order.meet/= /Order.meet /Order.join/= - ?(andbF, orbF)/= ?(meetEtotal, joinEtotal). -by rewrite -negb_or le_total/=. -Qed. - -Definition ocitv_display : Type -> measure_display. Proof. exact. Qed. - -HB.instance Definition _ := - @isSemiRingOfSets.Build (ocitv_display R) - ocitv_type (Pointed.class R) ocitv ocitv0 ocitvI ocitvD. - -Notation "R .-ocitv" := (ocitv_display R) : measure_display_scope. -Notation "R .-ocitv.-measurable" := (measurable : set (set (ocitv_type))) : - classical_set_scope. - -Lemma hlength_ge0' (I : set ocitv_type) : (0 <= hlength I)%E. +Lemma hlength_ge0 I : (0 <= hlength I)%E. Proof. by rewrite -hlength0 le_hlength. Qed. +End hlength. +#[local] Hint Extern 0 (is_true (0%R <= hlength _)) => + solve[apply: hlength_ge0] : core. + (* Unused *) (* Lemma hlength_semi_additive2 : semi_additive2 hlength. *) (* Proof. *) @@ -266,7 +208,12 @@ Proof. by rewrite -hlength0 le_hlength. Qed. (* by rewrite lt_geF ?midf_lt//= andbF le_gtF ?midf_le//= ltW. *) (* Qed. *) -Lemma hlength_semi_additive : semi_additive (hlength : set ocitv_type -> _). +Section hlength_extension. +Context {R : realType}. + +Notation hlength := (@hlength R). + +Lemma hlength_semi_additive : measure.semi_additive hlength. Proof. move=> /= I n /(_ _)/cid2-/all_sig[b]/all_and2[_]/(_ _)/esym-/funext {I}->. move=> Itriv [[/= a1 a2] _] /esym /[dup] + ->. @@ -331,41 +278,41 @@ apply/andP; split=> //; apply: contraTneq xbj => ->. by rewrite in_itv/= le_gtF// (itvP xabi). Qed. -HB.instance Definition _ := isContent.Build _ R _ - (hlength : set ocitv_type -> _) (@hlength_ge0') hlength_semi_additive. +HB.instance Definition _ := isContent.Build _ _ R + hlength hlength_ge0 hlength_semi_additive. Hint Extern 0 ((_ .-ocitv).-measurable _) => solve [apply: is_ocitv] : core. Lemma hlength_sigma_sub_additive : - sigma_sub_additive (hlength : set ocitv_type -> _). + sigma_sub_additive (hlength : set (ocitv_type R) -> _). Proof. move=> I A /(_ _)/cid2-/all_sig[b]/all_and2[_]/(_ _)/esym AE. move=> [a _ <-]; rewrite hlength_itv ?lte_fin/= -EFinB => lebig. case: ifPn => a12; last by rewrite nneseries_esum// esum_ge0. -apply: lee_adde => e. +apply/lee_addgt0Pr => _ /posnumP[e]. rewrite [e%:num]splitr [in leRHS]EFinD addeA -lee_subl_addr//. apply: le_trans (epsilon_trick _ _ _) => //=. have eVn_gt0 n : 0 < e%:num / 2 / (2 ^ n.+1)%:R. by rewrite divr_gt0// ltr0n// expn_gt0. have eVn_ge0 n := ltW (eVn_gt0 n). -pose Aoo i : set ocitv_type := +pose Aoo i : set (ocitv_type R) := `](b i).1, (b i).2 + e%:num / 2 / (2 ^ i.+1)%:R[%classic. -pose Aoc i : set ocitv_type := +pose Aoc i : set (ocitv_type R) := `](b i).1, (b i).2 + e%:num / 2 / (2 ^ i.+1)%:R]%classic. have: `[a.1 + e%:num / 2, a.2] `<=` \bigcup_i Aoo i. apply: (@subset_trans _ `]a.1, a.2]). move=> x; rewrite /= !in_itv /= => /andP[+ -> //]. - by move=> /lt_le_trans-> //; rewrite ltr_addl. + by move=> /lt_le_trans-> //; rewrite ltrDl. apply: (subset_trans lebig); apply: subset_bigcup => i _; rewrite AE /Aoo/=. move=> x /=; rewrite !in_itv /= => /andP[-> /le_lt_trans->]//=. - by rewrite ltr_addl. + by rewrite ltrDl. have := @segment_compact _ (a.1 + e%:num / 2) a.2; rewrite compact_cover. move=> /[apply]-[i _|X _ Xc]; first exact: interval_open. have: `](a.1 + e%:num / 2), a.2] `<=` \bigcup_(i in [set` X]) Aoc i. move=> x /subset_itv_oc_cc /Xc [i /= Xi] Aooix. by exists i => //; apply: subset_itv_oo_oc Aooix. have /[apply] := @content_sub_fsum _ _ _ - [the content _ _ of hlength : set ocitv_type -> _] _ [set` X]. + [the content _ _ of hlength : set (ocitv_type R) -> _] _ [set` X]. move=> /(_ _ _ _)/Box[]//=; apply: le_le_trans. rewrite hlength_itv ?lte_fin -?EFinD/= -addrA -opprD. by case: ltP => //; rewrite lee_fin subr_le0. @@ -375,56 +322,38 @@ rewrite fsbig_finite//= set_fsetK//. rewrite lee_sum // => i _; rewrite ?AE// !hlength_itv/= ?lte_fin -?EFinD/=. do !case: ifPn => //= ?; do ?by rewrite ?adde_ge0 ?lee_fin// ?subr_ge0// ?ltW. by rewrite addrAC. -by rewrite addrAC lee_fin ler_add// subr_le0 leNgt. +by rewrite addrAC lee_fin lerD// subr_le0 leNgt. Qed. -Lemma hlength_sigma_finite : sigma_finite [set: ocitv_type] hlength. +HB.instance Definition _ := Content_SubSigmaAdditive_isMeasure.Build _ _ _ + hlength hlength_sigma_sub_additive. + +Lemma hlength_sigma_finite : sigma_finite setT (hlength : set (ocitv_type R) -> _). Proof. -exists (fun k : nat => `] (- k%:R)%R, k%:R]%classic). - apply/esym; rewrite -subTset => x _ /=; exists `|(floor `|x| + 1)%R|%N => //=. - rewrite in_itv/= !natr_absz intr_norm intrD. - suff: `|x| < `|(floor `|x|)%:~R + 1| by rewrite ltr_norml => /andP[-> /ltW->]. - rewrite [ltRHS]ger0_norm//; last by rewrite addr_ge0// ler0z floor_ge0. - by rewrite (le_lt_trans _ (lt_succ_floor _)) ?ler_norm. +exists (fun k : nat => `] (- k%:R)%R, k%:R]%classic); first by rewrite bigcup_itvT. by move=> k; split => //; rewrite hlength_itv/= -EFinB; case: ifP; rewrite ltry. Qed. -Definition lebesgue_measure := Hahn_ext - [the content _ _ of hlength : set ocitv_type -> _]. - -Let lebesgue_measure0 : lebesgue_measure set0 = 0%E. -Proof. by []. Qed. +Definition lebesgue_measure := measure_extension hlength. +HB.instance Definition _ := Measure.on lebesgue_measure. -Let lebesgue_measure_ge0 : forall x, (0 <= lebesgue_measure x)%E. -Proof. exact: measure.Hahn_ext_ge0. Qed. +Let sigmaT_finite_lebesgue_measure : sigma_finite setT lebesgue_measure. +Proof. exact/measure_extension_sigma_finite/hlength_sigma_finite. Qed. -Let lebesgue_measure_semi_sigma_additive : semi_sigma_additive lebesgue_measure. -Proof. exact/measure.Hahn_ext_sigma_additive/hlength_sigma_sub_additive. Qed. +HB.instance Definition _ := @isSigmaFinite.Build _ _ _ + lebesgue_measure sigmaT_finite_lebesgue_measure. -HB.instance Definition _ := isMeasure.Build _ _ _ lebesgue_measure - lebesgue_measure0 lebesgue_measure_ge0 lebesgue_measure_semi_sigma_additive. +End hlength_extension. -End itv_semiRingOfSets. -Arguments lebesgue_measure {R}. +End LebesgueMeasure. -Notation "R .-ocitv" := (ocitv_display R) : measure_display_scope. -Notation "R .-ocitv.-measurable" := (measurable : set (set (ocitv_type R))) : - classical_set_scope. - -Section lebesgue_measure. -Variable R : realType. -Let gitvs := [the measurableType _ of salgebraType (@ocitv R)]. - -Lemma lebesgue_measure_unique (mu : {measure set gitvs -> \bar R}) : - (forall X, ocitv X -> hlength X = mu X) -> - forall X, measurable X -> lebesgue_measure X = mu X. -Proof. -move=> muE X mX; apply: Hahn_ext_unique => //=. -- exact: hlength_sigma_sub_additive. -- exact: hlength_sigma_finite. -Qed. - -End lebesgue_measure. +Definition lebesgue_measure {R : realType} : + set [the measurableType _.-sigma of + salgebraType R.-ocitv.-measurable] -> \bar R := + [the measure _ _ of lebesgue_stieltjes_measure [the cumulative _ of idfun]]. +HB.instance Definition _ (R : realType) := Measure.on (@lebesgue_measure R). +HB.instance Definition _ (R : realType) := + SigmaFiniteMeasure.on (@lebesgue_measure R). Section ps_infty. Context {T : Type}. @@ -503,9 +432,8 @@ rewrite predeqE => i /=; split=> [[r [n _ fn1r <-{i}]]|[n _ [r fn1r <-{i}]]]; by [exists n => //; exists r | exists r => //; exists n]. Qed. -Definition ereal_isMeasurable : - isMeasurable default_measure_display (\bar R) := - isMeasurable.Build _ _ (Pointed.class _) +Definition ereal_isMeasurable : isMeasurable default_measure_display (\bar R) := + isMeasurable.Build _ _ emeasurable0 emeasurableC bigcupT_emeasurable. End salgebra_ereal. @@ -515,7 +443,7 @@ Variable R : realDomainType. Implicit Types (y : R) (b : bool). Local Open Scope ereal_scope. -Lemma punct_eitv_bnd_pinfty b y : [set` Interval (BSide b y%:E) +oo%O] = +Lemma punct_eitv_bndy b y : [set` Interval (BSide b y%:E) +oo%O] = EFin @` [set` Interval (BSide b y) +oo%O] `|` [set +oo]. Proof. rewrite predeqE => x; split; rewrite /= in_itv andbT. @@ -526,7 +454,7 @@ rewrite predeqE => x; split; rewrite /= in_itv andbT. + by case: b => /=; rewrite ?(ltry, leey). Qed. -Lemma punct_eitv_ninfty_bnd b y : [set` Interval -oo%O (BSide b y%:E)] = +Lemma punct_eitv_Nybnd b y : [set` Interval -oo%O (BSide b y%:E)] = [set -oo%E] `|` EFin @` [set x | x \in Interval -oo%O (BSide b y)]. Proof. rewrite predeqE => x; split; rewrite /= in_itv. @@ -551,68 +479,6 @@ Qed. End puncture_ereal_itv. -Lemma set1_bigcap_oc (R : realType) (r : R) : - [set r] = \bigcap_i `]r - i.+1%:R^-1, r]%classic. -Proof. -apply/seteqP; split=> [x ->|]. - by move=> i _/=; rewrite in_itv/= lexx ltr_subl_addr ltr_addl invr_gt0 ltr0n. -move=> x rx; apply/esym/eqP; rewrite eq_le (itvP (rx 0%N _))// andbT. -apply/ler_addgt0Pl => e e_gt0; rewrite -ler_subl_addl ltW//. -have := rx `|floor e^-1%R|%N I; rewrite /= in_itv => /andP[/le_lt_trans->]//. -rewrite ler_add2l ler_opp2 -lef_pinv ?invrK//; last by rewrite qualifE. -by rewrite -natr1 natr_absz ger0_norm ?floor_ge0 ?invr_ge0 1?ltW// lt_succ_floor. -Qed. - -Lemma itv_bnd_open_bigcup (R : realType) b (r s : R) : - [set` Interval (BSide b r) (BLeft s)] = - \bigcup_n [set` Interval (BSide b r) (BRight (s - n.+1%:R^-1))]. -Proof. -apply/seteqP; split => [x/=|]; last first. - move=> x [n _ /=] /[!in_itv] /andP[-> /le_lt_trans]; apply. - by rewrite ltr_subl_addr ltr_addl invr_gt0 ltr0n. -rewrite in_itv/= => /andP[sx xs]; exists `|ceil ((s - x)^-1)|%N => //=. -rewrite in_itv/= sx/= ler_subr_addl addrC -ler_subr_addl. -rewrite -[in X in _ <= X](invrK (s - x)) ler_pinv. -- rewrite -natr1 natr_absz ger0_norm; last first. - by rewrite ceil_ge0// invr_ge0 subr_ge0 ltW. - by rewrite (@le_trans _ _ (ceil (s - x)^-1)%:~R)// ?ler_addl// ceil_ge. -- by rewrite inE unitfE ltr0n andbT pnatr_eq0. -- by rewrite inE invr_gt0 subr_gt0 xs andbT unitfE invr_eq0 subr_eq0 gt_eqF. -Qed. - -Lemma itv_open_bnd_bigcup (R : realType) b (r s : R) : - [set` Interval (BRight s) (BSide b r)] = - \bigcup_n [set` Interval (BLeft (s + n.+1%:R^-1)) (BSide b r)]. -Proof. -have /(congr1 (fun x => -%R @` x)) := itv_bnd_open_bigcup (~~ b) (- r) (- s). -rewrite opp_itv_bnd_bnd/= !opprK negbK => ->; rewrite image_bigcup. -apply eq_bigcupr => k _; apply/seteqP; split=> [_/= [y ysr] <-|x/= xsr]. - by rewrite oppr_itv/= opprD. -by exists (- x); rewrite ?oppr_itv//= opprK// negbK opprB opprK addrC. -Qed. - -Lemma itv_bnd_infty_bigcup (R : realType) b (x : R) : - [set` Interval (BSide b x) +oo%O] = - \bigcup_i [set` Interval (BSide b x) (BRight (x + i%:R))]. -Proof. -apply/seteqP; split=> y; rewrite /= !in_itv/= andbT; last first. - by move=> [k _ /=]; move: b => [|] /=; rewrite in_itv/= => /andP[//] /ltW. -move=> xy; exists `|ceil (y - x)|%N => //=; rewrite in_itv/= xy/= -ler_subl_addl. -rewrite !natr_absz/= ger0_norm ?ceil_ge0 ?subr_ge0 ?ceil_ge//. -by case: b xy => //= /ltW. -Qed. - -Lemma itv_infty_bnd_bigcup (R : realType) b (x : R) : - [set` Interval -oo%O (BSide b x)] = - \bigcup_i [set` Interval (BLeft (x - i%:R)) (BSide b x)]. -Proof. -have /(congr1 (fun x => -%R @` x)) := itv_bnd_infty_bigcup (~~ b) (- x). -rewrite opp_itv_bnd_infty negbK opprK => ->; rewrite image_bigcup. -apply eq_bigcupr => k _; apply/seteqP; split=> [_ /= -[r rbxk <-]|y/= yxkb]. - by rewrite oppr_itv/= opprB addrC. -by exists (- y); [rewrite oppr_itv/= negbK opprD opprK|rewrite opprK]. -Qed. - Section salgebra_R_ssets. Variable R : realType. @@ -620,9 +486,10 @@ Definition measurableTypeR := salgebraType (R.-ocitv.-measurable). Definition measurableR : set (set R) := (R.-ocitv.-measurable).-sigma.-measurable. +HB.instance Definition _ := Pointed.on R. HB.instance Definition R_isMeasurable : isMeasurable default_measure_display R := - @isMeasurable.Build _ measurableTypeR (Pointed.class R) measurableR + @isMeasurable.Build _ measurableTypeR measurableR measurable0 (@measurableC _ _) (@bigcupT_measurable _ _). (*HB.instance (Real.sort R) R_isMeasurable.*) @@ -635,24 +502,24 @@ Qed. Lemma measurable_itv (i : interval R) : measurable [set` i]. Proof. -have moc (a b : R) : measurable `]a, b]%classic. +have moc (a b : R) : measurable `]a, b]. by apply: sub_sigma_algebra; apply: is_ocitv. -have mopoo (x : R) : measurable `]x, +oo[%classic. +have mopoo (x : R) : measurable `]x, +oo[. by rewrite itv_bnd_infty_bigcup; exact: bigcup_measurable. -have mnooc (x : R) : measurable `]-oo, x]%classic. +have mnooc (x : R) : measurable `]-oo, x]. by rewrite -setCitvr; exact/measurableC. -have ooE (a b : R) : `]a, b[%classic = `]a, b]%classic `\ b. +have ooE (a b : R) : `]a, b[%classic = `]a, b] `\ b. case: (boolP (a < b)) => ab; last by rewrite !set_itv_ge ?set0D. by rewrite -setUitv1// setUDK// => x [->]; rewrite /= in_itv/= ltxx andbF. -have moo (a b : R) : measurable `]a, b[%classic. +have moo (a b : R) : measurable `]a, b[. by rewrite ooE; exact: measurableD. -have mcc (a b : R) : measurable `[a, b]%classic. +have mcc (a b : R) : measurable `[a, b]. case: (boolP (a <= b)) => ab; last by rewrite set_itv_ge. by rewrite -setU1itv//; apply/measurableU. -have mco (a b : R) : measurable `[a, b[%classic. +have mco (a b : R) : measurable `[a, b[. case: (boolP (a < b)) => ab; last by rewrite set_itv_ge. by rewrite -setU1itv//; apply/measurableU. -have oooE (b : R) : `]-oo, b[%classic = `]-oo, b]%classic `\ b. +have oooE (b : R) : `]-oo, b[%classic = `]-oo, b] `\ b. by rewrite -setUitv1// setUDK// => x [->]; rewrite /= in_itv/= ltxx. case: i => [[[] a|[]] [[] b|[]]] => //; do ?by rewrite set_itv_ge. - by rewrite -setU1itv//; exact/measurableU. @@ -675,7 +542,7 @@ This was producing a warning but the alternative was failing with Coq 8.12 with # Please report at http://coq.inria.fr/bugs/. *) -Lemma measurable_EFin (A : set R) : measurableR A -> measurable (EFin @` A). +Lemma measurable_image_EFin (A : set R) : measurableR A -> measurable (EFin @` A). Proof. by move=> mA; exists A => //; exists set0; [constructor|rewrite setU0]. Qed. @@ -683,7 +550,7 @@ Qed. Lemma emeasurable_set1 (x : \bar R) : measurable [set x]. Proof. case: x => [r| |]. -- by rewrite -image_set1; apply: measurable_EFin; apply: measurable_set1. +- by rewrite -image_set1; apply: measurable_image_EFin; apply: measurable_set1. - exists set0 => //; [exists [set +oo%E]; [by constructor|]]. by rewrite image_set0 set0U. - exists set0 => //; [exists [set -oo%E]; [by constructor|]]. @@ -694,39 +561,46 @@ Qed. Lemma __deprecated__itv_cpinfty_pinfty : `[+oo%E, +oo[%classic = [set +oo%E] :> set (\bar R). Proof. by rewrite itv_cyy. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed `itv_cyy`")] -Notation itv_cpinfty_pinfty := __deprecated__itv_cpinfty_pinfty. +Notation itv_cpinfty_pinfty := __deprecated__itv_cpinfty_pinfty (only parsing). Lemma __deprecated__itv_opinfty_pinfty : `]+oo%E, +oo[%classic = set0 :> set (\bar R). Proof. by rewrite itv_oyy. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed `itv_oyy`")] -Notation itv_opinfty_pinfty := __deprecated__itv_opinfty_pinfty. +Notation itv_opinfty_pinfty := __deprecated__itv_opinfty_pinfty (only parsing). Lemma __deprecated__itv_cninfty_pinfty : `[-oo%E, +oo[%classic = setT :> set (\bar R). Proof. by rewrite itv_cNyy. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed `itv_cNyy`")] -Notation itv_cninfty_pinfty := __deprecated__itv_cninfty_pinfty. +Notation itv_cninfty_pinfty := __deprecated__itv_cninfty_pinfty (only parsing). Lemma __deprecated__itv_oninfty_pinfty : `]-oo%E, +oo[%classic = ~` [set -oo]%E :> set (\bar R). Proof. by rewrite itv_oNyy. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed `itv_oNyy`")] -Notation itv_oninfty_pinfty := __deprecated__itv_oninfty_pinfty. +Notation itv_oninfty_pinfty := __deprecated__itv_oninfty_pinfty (only parsing). -Lemma emeasurable_itv_bnd_pinfty b (y : \bar R) : +Let emeasurable_itv_bndy b (y : \bar R) : measurable [set` Interval (BSide b y) +oo%O]. Proof. move: y => [y| |]. - exists [set` Interval (BSide b y) +oo%O]; first exact: measurable_itv. - by exists [set +oo%E]; [constructor|rewrite -punct_eitv_bnd_pinfty]. + by exists [set +oo%E]; [constructor|rewrite -punct_eitv_bndy]. - by case: b; rewrite ?itv_oyy ?itv_cyy. - case: b; first by rewrite itv_cNyy. by rewrite itv_oNyy; exact/measurableC. Qed. -Lemma emeasurable_itv_ninfty_bnd b (y : \bar R) : +Let emeasurable_itv_Nybnd b (y : \bar R) : measurable [set` Interval -oo%O (BSide b y)]. +Proof. by rewrite -setCitvr; exact/measurableC/emeasurable_itv_bndy. Qed. + +Lemma emeasurable_itv (i : interval (\bar R)) : + measurable ([set` i]%classic : set \bar R). Proof. -by rewrite -setCitvr; exact/measurableC/emeasurable_itv_bnd_pinfty. +rewrite -[X in measurable X]setCK; apply: measurableC. +rewrite set_interval.setCitv /=; apply: measurableU => [|]. +- by move: i => [[b1 i1|[|]] i2] /=; rewrite ?set_interval.set_itvE. +- by move: i => [i1 [b2 i2|[|]]] /=; rewrite ?set_interval.set_itvE. Qed. Definition elebesgue_measure : set \bar R -> \bar R := @@ -735,7 +609,7 @@ Definition elebesgue_measure : set \bar R -> \bar R := Lemma elebesgue_measure0 : elebesgue_measure set0 = 0%E. Proof. by rewrite /elebesgue_measure set0D image_set0 measure0. Qed. -Lemma measurable_fine (X : set \bar R) : measurable X -> +Lemma measurable_image_fine (X : set \bar R) : measurable X -> measurable [set fine x | x in X `\` [set -oo; +oo]%E]. Proof. case => Y mY [X' [ | <-{X} | <-{X} | <-{X} ]]. @@ -768,13 +642,13 @@ rewrite [X in lebesgue_measure X](_ : _ = rewrite predeqE => r; split. by move=> [x [[n _ Fnx xoo <-]]]; exists n => //; exists x. by move=> [n _ [x [Fnx xoo <-{r}]]]; exists x => //; split => //; exists n. -apply: (@measure_semi_sigma_additive _ _ _ [the measure _ _ of (@lebesgue_measure R)] +apply: (@measure_semi_sigma_additive _ _ _ (@lebesgue_measure R) (fun n => fine @` (F n `\` [set -oo; +oo]%E))). - move=> n; have := mF n. move=> [X mX [X' mX']] XX'Fn. - apply: measurable_fine. + apply: measurable_image_fine. rewrite -XX'Fn. - apply: measurableU; first exact: measurable_EFin. + apply: measurableU; first exact: measurable_image_EFin. by case: mX' => //; exact: measurableU. - move=> i j _ _ [x [[a [Fia aoo ax] [b [Fjb boo] bx]]]]. move: tF => /(_ i j Logic.I Logic.I); apply. @@ -831,8 +705,14 @@ End salgebra_R_ssets. #[global] Hint Extern 0 (measurable [set _]) => solve [apply: measurable_set1| apply: emeasurable_set1] : core. +#[global] +Hint Extern 0 (measurable [set` _] ) => exact: measurable_itv : core. +#[deprecated(since="mathcomp-analysis 0.6.2", note="use `emeasurable_itv` instead")] +Notation emeasurable_itv_bnd_pinfty := emeasurable_itv (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.2", note="use `emeasurable_itv` instead")] +Notation emeasurable_itv_ninfty_bnd := emeasurable_itv (only parsing). -Lemma measurable_fun_fine (R : realType) (D : set (\bar R)) : measurable D -> +Lemma measurable_fine (R : realType) (D : set (\bar R)) : measurable D -> measurable_fun D fine. Proof. move=> mD _ /= B mB; rewrite [X in measurable X](_ : _ `&` _ = if 0%R \in B then @@ -844,40 +724,45 @@ move=> mD _ /= B mB; rewrite [X in measurable X](_ : _ `&` _ = if 0%R \in B then - by case: ifPn => [_ [Dr [[s + [sr]]|[]//]]|_ [Dr [s + [sr]]]]; rewrite sr. - by case: ifPn => [/[!inE] B0 [Doo [[]//|]] [//|_]|B0 [Doo//] []]. - by case: ifPn => [/[!inE] B0 [Doo [[]//|]] [//|_]|B0 [Doo//] []]. -case: ifPn => B0; apply/measurableI => //; last exact: measurable_EFin. -by apply: measurableU; [exact: measurable_EFin|exact: measurableU]. +case: ifPn => B0; apply/measurableI => //; last exact: measurable_image_EFin. +by apply: measurableU; [exact: measurable_image_EFin|exact: measurableU]. Qed. +#[global] Hint Extern 0 (measurable_fun _ fine) => + solve [exact: measurable_fine] : core. +#[deprecated(since="mathcomp-analysis 0.6.3", note="use `measurable_fine` instead")] +Notation measurable_fun_fine := measurable_fine (only parsing). Section lebesgue_measure_itv. Variable R : realType. Let lebesgue_measure_itvoc (a b : R) : - (lebesgue_measure (`]a, b] : set R) = hlength `]a, b])%classic. + (lebesgue_measure (`]a, b] : set R) = + wlength [the cumulative _ of idfun] `]a, b])%classic. Proof. -rewrite /lebesgue_measure/= /Hahn_ext measurable_mu_extE//; last first. - by exists (a, b). -exact: hlength_sigma_sub_additive. +rewrite /lebesgue_measure/= /lebesgue_stieltjes_measure/= /measure_extension/=. +by rewrite measurable_mu_extE//; exact: is_ocitv. Qed. Let lebesgue_measure_itvoo_subr1 (a : R) : lebesgue_measure (`]a - 1, a[%classic : set R) = 1%E. Proof. -rewrite itv_bnd_open_bigcup//; transitivity (lim (lebesgue_measure \o +rewrite itv_bnd_open_bigcup//; transitivity (limn (lebesgue_measure \o (fun k => `]a - 1, a - k.+1%:R^-1]%classic : set R))). apply/esym/cvg_lim => //; apply: nondecreasing_cvg_mu. - by move=> ?; exact: measurable_itv. - by apply: bigcup_measurable => k _; exact: measurable_itv. - move=> n m nm; apply/subsetPset => x /=; rewrite !in_itv/= => /andP[->/=]. - by move/le_trans; apply; rewrite ler_sub// ler_pinv ?ler_nat//; + by move/le_trans; apply; rewrite lerB// ler_pV2 ?ler_nat//; rewrite inE ltr0n andbT unitfE. rewrite (_ : _ \o _ = (fun n => (1 - n.+1%:R^-1)%:E)); last first. apply/funext => n /=; rewrite lebesgue_measure_itvoc. - have [->|n0] := eqVneq n 0%N; first by rewrite invr1 subrr set_itvoc0. - rewrite hlength_itv/= lte_fin ifT; last first. - by rewrite ler_lt_sub// invr_lt1 ?unitfE// ltr1n ltnS lt0n. - by rewrite !(EFinB,EFinN) oppeB// addeAC addeA subee// add0e. + have [->|n0] := eqVneq n 0%N. + by rewrite invr1 subrr set_itvoc0 wlength0. + rewrite wlength_itv/= lte_fin ifT; last first. + by rewrite ler_ltB// invr_lt1 ?unitfE// ltr1n ltnS lt0n. + by rewrite !(EFinB,EFinN) fin_num_oppeB// addeAC addeA subee// add0e. apply/cvg_lim => //=; apply/fine_cvgP; split => /=; first exact: nearW. -apply/(@cvgrPdist_lt _ [pseudoMetricNormedZmodType R of R^o]) => _/posnumP[e]. +apply/(@cvgrPdist_lt _ [the pseudoMetricNormedZmodType R of R^o]) => _/posnumP[e]. near=> n; rewrite opprB addrCA subrr addr0 ger0_norm//. by near: n; exact: near_infty_natSinv_lt. Unshelve. all: by end_near. Qed. @@ -888,109 +773,114 @@ suff : (lebesgue_measure (`]a - 1, a]%classic%R : set R) = lebesgue_measure (`]a - 1, a[%classic%R : set R) + lebesgue_measure [set a])%E. rewrite lebesgue_measure_itvoo_subr1 lebesgue_measure_itvoc => /eqP. - rewrite hlength_itv lte_fin ltr_subl_addr ltr_addl ltr01. - rewrite [in X in X == _]/= EFinN EFinB oppeB// addeA subee// add0e. - rewrite addeC -sube_eq//; last by rewrite fin_num_adde_def. - by rewrite subee// => /eqP. -rewrite -setUitv1// ?bnd_simp; last by rewrite ltr_subl_addr ltr_addl. -rewrite measureU//; first exact: measurable_itv. -apply/seteqP; split => // x []/=; rewrite in_itv/= => + xa. -by rewrite xa ltxx andbF. + rewrite wlength_itv lte_fin ltrBlDr ltrDl ltr01. + rewrite [in X in X == _]/= EFinN EFinB fin_num_oppeB// addeA subee// add0e. + by rewrite addeC -sube_eq ?fin_num_adde_defl// subee// => /eqP. +rewrite -setUitv1// ?bnd_simp; last by rewrite ltrBlDr ltrDl. +rewrite measureU //; apply/seteqP; split => // x []/=. +by rewrite in_itv/= => + xa; rewrite xa ltxx andbF. Qed. Let lebesgue_measure_itvoo (a b : R) : - (lebesgue_measure (`]a, b[ : set R) = hlength `]a, b[)%classic. + (lebesgue_measure (`]a, b[ : set R) = + wlength [the cumulative _ of idfun] `]a, b[)%classic. Proof. have [ab|ba] := ltP a b; last by rewrite set_itv_ge ?measure0// -leNgt. have := lebesgue_measure_itvoc a b. -rewrite 2!hlength_itv => <-; rewrite -setUitv1// measureU//. +rewrite 2!wlength_itv => <-; rewrite -setUitv1// measureU//. - by have /= -> := lebesgue_measure_set1 b; rewrite adde0. -- exact: measurable_itv. - by apply/seteqP; split => // x [/= + xb]; rewrite in_itv/= xb ltxx andbF. Qed. Let lebesgue_measure_itvcc (a b : R) : - (lebesgue_measure (`[a, b] : set R) = hlength `[a, b])%classic. + (lebesgue_measure (`[a, b] : set R) = + wlength [the cumulative _ of idfun] `[a, b])%classic. Proof. have [ab|ba] := leP a b; last by rewrite set_itv_ge ?measure0// -leNgt. have := lebesgue_measure_itvoc a b. -rewrite 2!hlength_itv => <-; rewrite -setU1itv// measureU//. +rewrite 2!wlength_itv => <-; rewrite -setU1itv// measureU//. - by have /= -> := lebesgue_measure_set1 a; rewrite add0e. -- exact: measurable_itv. - by apply/seteqP; split => // x [/= ->]; rewrite in_itv/= ltxx. Qed. Let lebesgue_measure_itvco (a b : R) : - (lebesgue_measure (`[a, b[ : set R) = hlength `[a, b[)%classic. + (lebesgue_measure (`[a, b[ : set R) = + wlength [the cumulative _ of idfun] `[a, b[)%classic. Proof. have [ab|ba] := ltP a b; last by rewrite set_itv_ge ?measure0// -leNgt. have := lebesgue_measure_itvoo a b. -rewrite 2!hlength_itv => <-; rewrite -setU1itv// measureU//. +rewrite 2!wlength_itv => <-; rewrite -setU1itv// measureU//. - by have /= -> := lebesgue_measure_set1 a; rewrite add0e. -- exact: measurable_itv. - by apply/seteqP; split => // x [/= ->]; rewrite in_itv/= ltxx. Qed. Let lebesgue_measure_itv_bnd (x y : bool) (a b : R) : lebesgue_measure ([set` Interval (BSide x a) (BSide y b)] : set R) = - hlength [set` Interval (BSide x a) (BSide y b)]. + wlength [the cumulative _ of idfun] [set` Interval (BSide x a) (BSide y b)]. Proof. by move: x y => [|] [|]; [exact: lebesgue_measure_itvco | exact: lebesgue_measure_itvcc | exact: lebesgue_measure_itvoo | exact: lebesgue_measure_itvoc]. Qed. -Let limnatR : lim (fun k => (k%:R)%:E : \bar R) = +oo%E. +Let limnatR : lim (((k%:R)%:E : \bar R) @[k --> \oo]) = +oo%E. Proof. by apply/cvg_lim => //; apply/cvgenyP. Qed. Let lebesgue_measure_itv_bnd_infty x (a : R) : lebesgue_measure ([set` Interval (BSide x a) +oo%O] : set R) = +oo%E. Proof. -rewrite itv_bnd_infty_bigcup; transitivity (lim (lebesgue_measure \o +rewrite itv_bnd_infty_bigcup; transitivity (limn (lebesgue_measure \o (fun k => [set` Interval (BSide x a) (BRight (a + k%:R))] : set R))). apply/esym/cvg_lim => //; apply: nondecreasing_cvg_mu. + by move=> k; exact: measurable_itv. + by apply: bigcup_measurable => k _; exact: measurable_itv. + move=> m n mn; apply/subsetPset => r/=; rewrite !in_itv/= => /andP[->/=]. - by move=> /le_trans; apply; rewrite ler_add// ler_nat. + by move=> /le_trans; apply; rewrite lerD// ler_nat. rewrite (_ : _ \o _ = (fun k => k%:R%:E))//. -apply/funext => n /=; rewrite lebesgue_measure_itv_bnd hlength_itv/=. +apply/funext => n /=; rewrite lebesgue_measure_itv_bnd wlength_itv/=. rewrite lte_fin; have [->|n0] := eqVneq n 0%N; first by rewrite addr0 ltxx. -by rewrite ltr_addl ltr0n lt0n n0 EFinD addeAC EFinN subee ?add0e. +by rewrite ltrDl ltr0n lt0n n0 EFinD addeAC EFinN subee ?add0e. Qed. Let lebesgue_measure_itv_infty_bnd y (b : R) : lebesgue_measure ([set` Interval -oo%O (BSide y b)] : set R) = +oo%E. Proof. -rewrite itv_infty_bnd_bigcup; transitivity (lim (lebesgue_measure \o +rewrite itv_infty_bnd_bigcup; transitivity (limn (lebesgue_measure \o (fun k => [set` Interval (BLeft (b - k%:R)) (BSide y b)] : set R))). apply/esym/cvg_lim => //; apply: nondecreasing_cvg_mu. + by move=> k; exact: measurable_itv. + by apply: bigcup_measurable => k _; exact: measurable_itv. + move=> m n mn; apply/subsetPset => r/=; rewrite !in_itv/= => /andP[+ ->]. - by rewrite andbT; apply: le_trans; rewrite ler_sub// ler_nat. + by rewrite andbT; apply: le_trans; rewrite lerB// ler_nat. rewrite (_ : _ \o _ = (fun k : nat => k%:R%:E))//. -apply/funext => n /=; rewrite lebesgue_measure_itv_bnd hlength_itv/= lte_fin. +apply/funext => n /=; rewrite lebesgue_measure_itv_bnd wlength_itv/= lte_fin. have [->|n0] := eqVneq n 0%N; first by rewrite subr0 ltxx. -rewrite ltr_subl_addr ltr_addl ltr0n lt0n n0 EFinN EFinB oppeB// addeA subee//. -by rewrite add0e. +rewrite ltrBlDr ltrDl ltr0n lt0n n0 EFinN EFinB fin_num_oppeB// addeA. +by rewrite subee// add0e. +Qed. + +Let lebesgue_measure_itv_infty_infty : + lebesgue_measure ([set` Interval -oo%O +oo%O] : set R) = +oo%E. +Proof. +rewrite set_itv_infty_infty -(setUv (`]-oo, 0[)) setCitv. +rewrite [X in _ `|` (X `|` _) ]set_itvE set0U measureU//; last first. + apply/seteqP; split => //= x [] /= /[swap]. + by rewrite !in_itv/= andbT ltNge => ->//. +rewrite [X in (X + _)%E]lebesgue_measure_itv_infty_bnd. +by rewrite [X in (_ + X)%E]lebesgue_measure_itv_bnd_infty. Qed. Lemma lebesgue_measure_itv (i : interval R) : - lebesgue_measure ([set` i] : set R) = hlength [set` i]. + lebesgue_measure ([set` i] : set R) = + (if i.1 < i.2 then (i.2 : \bar R) - i.1 else 0)%E. Proof. -move: i => [[x a|[|]]] [y b|[|]]; first exact: lebesgue_measure_itv_bnd. +move: i => [[x a|[|]]] [y b|[|]]. + by rewrite lebesgue_measure_itv_bnd wlength_itv. - by rewrite set_itvE ?measure0. -- by rewrite lebesgue_measure_itv_bnd_infty hlength_bnd_infty. -- by rewrite lebesgue_measure_itv_infty_bnd hlength_infty_bnd. +- by rewrite lebesgue_measure_itv_bnd_infty/= ltry. +- by rewrite lebesgue_measure_itv_infty_bnd/= ltNyr. - by rewrite set_itvE ?measure0. -- rewrite set_itvE hlength_setT. - rewrite (_ : setT = [set` `]-oo, 0[] `|` [set` `[0, +oo[]); last first. - by apply/seteqP; split=> // => x _; have [x0|x0] := leP 0 x; [right|left]; - rewrite /= in_itv//= x0. - rewrite measureU//=; try exact: measurable_itv. - + by rewrite lebesgue_measure_itv_infty_bnd lebesgue_measure_itv_bnd_infty. - + by apply/seteqP; split => // x []/=; rewrite !in_itv/= andbT leNgt => ->. +- by rewrite lebesgue_measure_itv_infty_infty. - by rewrite set_itvE ?measure0. - by rewrite set_itvE ?measure0. - by rewrite set_itvE ?measure0. @@ -998,6 +888,38 @@ Qed. End lebesgue_measure_itv. +Section measurable_ball. +Variable R : realType. + +Lemma measurable_ball (x : R) e : measurable (ball x e). +Proof. by rewrite ball_itv; exact: measurable_itv. Qed. + +Lemma lebesgue_measure_ball (x r : R) : (0 <= r)%R -> + lebesgue_measure (ball x r) = (r *+ 2)%:E. +Proof. +rewrite le_eqVlt => /predU1P[ <-|r0]. + by rewrite (ball0 _ _).2// measure0 mul0rn. +rewrite ball_itv lebesgue_measure_itv/= lte_fin ltrBlDr -addrA ltrDl. +by rewrite addr_gt0 // -EFinD addrAC opprD opprK addrA subrr add0r -mulr2n. +Qed. + +Lemma measurable_closed_ball (x : R) r : measurable (closed_ball x r). +Proof. +have [r0|r0] := leP r 0; first by rewrite closed_ball0. +by rewrite closed_ball_itv. +Qed. + +Lemma lebesgue_measure_closed_ball (x r : R) : 0 <= r -> + lebesgue_measure (closed_ball x r) = (r *+ 2)%:E. +Proof. +rewrite le_eqVlt => /predU1P[<-|r0]; first by rewrite mul0rn closed_ball0// measure0. +rewrite closed_ball_itv// lebesgue_measure_itv/= lte_fin -ltrBlDl addrAC. +rewrite subrr add0r gtrN// ?mulr_gt0// -EFinD; congr (_%:E). +by rewrite opprB addrAC addrCA subrr addr0 -mulr2n. +Qed. + +End measurable_ball. + Lemma lebesgue_measure_rat (R : realType) : lebesgue_measure (range ratr : set R) = 0%E. Proof. @@ -1022,24 +944,16 @@ Hypotheses (mD : measurable D) (mf : measurable_fun D f). Implicit Types y : \bar R. Lemma emeasurable_fun_c_infty y : measurable (D `&` [set x | y <= f x]). -Proof. -by rewrite -preimage_itv_c_infty; exact/mf/emeasurable_itv_bnd_pinfty. -Qed. +Proof. by rewrite -preimage_itv_c_infty; exact/mf/emeasurable_itv. Qed. Lemma emeasurable_fun_o_infty y : measurable (D `&` [set x | y < f x]). -Proof. -by rewrite -preimage_itv_o_infty; exact/mf/emeasurable_itv_bnd_pinfty. -Qed. +Proof. by rewrite -preimage_itv_o_infty; exact/mf/emeasurable_itv. Qed. Lemma emeasurable_fun_infty_o y : measurable (D `&` [set x | f x < y]). -Proof. -by rewrite -preimage_itv_infty_o; exact/mf/emeasurable_itv_ninfty_bnd. -Qed. +Proof. by rewrite -preimage_itv_infty_o; exact/mf/emeasurable_itv. Qed. Lemma emeasurable_fun_infty_c y : measurable (D `&` [set x | f x <= y]). -Proof. -by rewrite -preimage_itv_infty_c; exact/mf/emeasurable_itv_ninfty_bnd. -Qed. +Proof. by rewrite -preimage_itv_infty_c; exact/mf/emeasurable_itv. Qed. Lemma emeasurable_fin_num : measurable (D `&` [set x | f x \is a fin_num]). Proof. @@ -1051,7 +965,7 @@ rewrite [X in measurable X](_ : _ = rewrite predeqE => t; split => [/= [Dt ft]|]. have [ft0|ft0] := leP 0%R (fine (f t)). exists `|ceil (fine (f t))|%N => //=; split => //; split. - by rewrite -{2}(fineK ft)// lee_fin (le_trans _ ft0)// ler_oppl oppr0. + by rewrite -{2}(fineK ft)// lee_fin (le_trans _ ft0)// lerNl oppr0. by rewrite natr_absz ger0_norm ?ceil_ge0// -(fineK ft) lee_fin ceil_ge. exists `|floor (fine (f t))|%N => //=; split => //; split. rewrite natr_absz ltr0_norm ?floor_lt0// EFinN. @@ -1095,8 +1009,7 @@ case: a => [a r _|[_|//]]. by rewrite -setCitvr; apply: measurableC; apply: measurable_itv_bnd_infty. Qed. -Lemma measurableE : - (R.-ocitv.-measurable).-sigma.-measurable = G.-sigma.-measurable. +Lemma measurableE : (@ocitv R).-sigma.-measurable = G.-sigma.-measurable. Proof. rewrite eqEsubset; split => A. apply: smallest_sub; first exact: smallest_sigma_algebra. @@ -1133,8 +1046,7 @@ case: a => [a r _|[//|_]]. by rewrite -setCitvl; apply: measurableC; apply: measurable_itv_bnd_infty. Qed. -Lemma measurableE : - (R.-ocitv.-measurable).-sigma.-measurable = G.-sigma.-measurable. +Lemma measurableE : (@ocitv R).-sigma.-measurable = G.-sigma.-measurable. Proof. rewrite eqEsubset; split => A. apply: smallest_sub; first exact: smallest_sigma_algebra. @@ -1170,8 +1082,7 @@ case: a => [a r _|[_|//]]. by rewrite -setCitvr; apply: measurableC; apply: measurable_itv_bnd_infty. Qed. -Lemma measurableE : - (R.-ocitv.-measurable).-sigma.-measurable = G.-sigma.-measurable. +Lemma measurableE : (@ocitv R).-sigma.-measurable = G.-sigma.-measurable. Proof. rewrite eqEsubset; split => A. apply: smallest_sub; first exact: smallest_sigma_algebra. @@ -1221,8 +1132,7 @@ move: a b => [] []; rewrite -[X in measurable X]setCK setCitv; exact: measurable_itv_infty_bnd|exact: measurable_itv_bnd_infty]. Qed. -Lemma measurableE : - (R.-ocitv.-measurable).-sigma.-measurable = G.-sigma.-measurable. +Lemma measurableE : (@ocitv R).-sigma.-measurable = G.-sigma.-measurable. Proof. rewrite eqEsubset; split => A. apply: smallest_sub; first exact: smallest_sigma_algebra. @@ -1268,15 +1178,15 @@ rewrite predeqE => x; split=> [|]. - move: x => [s /=| _ n _|//]. + rewrite in_itv /= andbT lee_fin => rs n _ /=; rewrite in_itv/= andbT. case: b => /=. - * by rewrite lee_fin ler_subl_addl (le_trans rs)// ler_addr. - * by rewrite lte_fin ltr_subl_addl (le_lt_trans rs)// ltr_addr. + * by rewrite lee_fin lerBlDl (le_trans rs)// lerDr. + * by rewrite lte_fin ltrBlDl (le_lt_trans rs)// ltrDr. + by rewrite /= in_itv /= andbT; case: b => /=; rewrite lteey. - move: x => [s| |/(_ 0%N Logic.I)] /=; rewrite ?in_itv/= ?leey//; last first. by case: b. move=> h; rewrite lee_fin leNgt andbT; apply/negP => /ltr_add_invr[k skr]. have {h} := h k Logic.I; rewrite /= in_itv /= andbT; case: b => /=. - + by rewrite lee_fin ler_subl_addr leNgt skr. - + by rewrite lte_fin ltr_subl_addr ltNge (ltW skr). + + by rewrite lee_fin lerBlDr leNgt skr. + + by rewrite lte_fin ltrBlDr ltNge (ltW skr). Qed. Lemma eitv_infty_bnd b r : `]-oo, r%:E]%classic = @@ -1286,8 +1196,8 @@ rewrite predeqE => x; split=> [|]. - move: x => [s /=|//|_ n _]. + rewrite in_itv /= lee_fin => sr n _; rewrite /= in_itv /= -EFinD. case: b => /=. - * by rewrite lte_fin (le_lt_trans sr)// ltr_addl. - * by rewrite lee_fin (le_trans sr)// ler_addl. + * by rewrite lte_fin (le_lt_trans sr)// ltrDl. + * by rewrite lee_fin (le_trans sr)// lerDl. + by rewrite /= in_itv /= -EFinD; case: b => //=; rewrite lteNye. - move: x => [s|/(_ 0%N Logic.I)|]/=; rewrite !in_itv/= ?leNye//; last first. by case: b. @@ -1297,21 +1207,20 @@ rewrite predeqE => x; split=> [|]. + by rewrite lee_fin leNgt rks. Qed. -Lemma eset1_ninfty : +Lemma eset1Ny : [set -oo] = \bigcap_k `]-oo, (-k%:R%:E)[%classic :> set (\bar R). Proof. rewrite eqEsubset; split=> [_ -> i _ |]; first by rewrite /= in_itv /= ltNyr. move=> [r|/(_ O Logic.I)|]//. move=> /(_ `|floor r|%N Logic.I); rewrite /= in_itv/= ltNge. rewrite lee_fin; have [r0|r0] := leP 0%R r. - by rewrite (le_trans _ r0) // ler_oppl oppr0 ler0n. -rewrite ler_oppl -abszN natr_absz gtr0_norm; last first. - by rewrite ltr_oppr oppr0 floor_lt0. -by rewrite mulrNz ler_oppl opprK floor_le. + by rewrite (le_trans _ r0) // lerNl oppr0 ler0n. +rewrite lerNl -abszN natr_absz gtr0_norm; last first. + by rewrite ltrNr oppr0 floor_lt0. +by rewrite mulrNz lerNl opprK floor_le. Qed. -Lemma eset1_pinfty : - [set +oo] = \bigcap_k `]k%:R%:E, +oo[%classic :> set (\bar R). +Lemma eset1y : [set +oo] = \bigcap_k `]k%:R%:E, +oo[%classic :> set (\bar R). Proof. rewrite eqEsubset; split=> [_ -> i _/=|]; first by rewrite in_itv /= ltry. move=> [r| |/(_ O Logic.I)] // /(_ `|ceil r|%N Logic.I); rewrite /= in_itv /=. @@ -1331,21 +1240,21 @@ Local Open Scope ereal_scope. Definition G := [set A : set \bar R | exists r, A = `]r%:E, +oo[%classic]. -Lemma measurable_set1_ninfty : G.-sigma.-measurable [set -oo]. +Lemma measurable_set1Ny : G.-sigma.-measurable [set -oo]. Proof. -rewrite eset1_ninfty; apply: bigcap_measurable => i _. +rewrite eset1Ny; apply: bigcap_measurable => i _. rewrite -setCitvr; apply: measurableC; rewrite (eitv_bnd_infty false). apply: bigcap_measurable => j _; apply: sub_sigma_algebra. by exists (- (i%:R + j.+1%:R^-1))%R; rewrite opprD. Qed. -Lemma measurable_set1_pinfty : G.-sigma.-measurable [set +oo]. +Lemma measurable_set1y : G.-sigma.-measurable [set +oo]. Proof. -rewrite eset1_pinfty; apply: bigcapT_measurable => i. +rewrite eset1y; apply: bigcapT_measurable => i. by apply: sub_sigma_algebra; exists i%:R. Qed. -Lemma measurableE : emeasurable (R.-ocitv.-measurable) = G.-sigma.-measurable. +Lemma measurableE : emeasurable (@ocitv R) = G.-sigma.-measurable. Proof. apply/seteqP; split; last first. apply: smallest_sub. @@ -1356,23 +1265,20 @@ apply/seteqP; split; last first. exists `]r, +oo[%classic. rewrite RGenOInfty.measurableE. exact: RGenOInfty.measurable_itv_bnd_infty. - by exists [set +oo]; [constructor|rewrite -punct_eitv_bnd_pinfty]. + by exists [set +oo]; [constructor|rewrite -punct_eitv_bndy]. move=> A [B mB [C mC]] <-; apply: measurableU; last first. - case: mC; [by []|exact: measurable_set1_ninfty - |exact: measurable_set1_pinfty|]. - - by apply: measurableU; [exact: measurable_set1_ninfty| - exact: measurable_set1_pinfty]. + case: mC; [by []|exact: measurable_set1Ny|exact: measurable_set1y|]. + - by apply: measurableU; [exact: measurable_set1Ny|exact: measurable_set1y]. rewrite RGenOInfty.measurableE in mB. have smB := smallest_sub _ _ mB. (* BUG: elim/smB : _. fails !! *) apply: (smB (G.-sigma.-measurable \o (image^~ EFin))); last first. move=> _ [r ->]/=; rewrite EFin_itv_bnd_infty; apply: measurableD. by apply: sub_sigma_algebra => /=; exists r. - exact: measurable_set1_pinfty. + exact: measurable_set1y. split=> /= [|D mD|F mF]; first by rewrite image_set0. - rewrite setTD EFin_setC; apply: measurableD; first exact: measurableC. - by apply: measurableU; [exact: measurable_set1_ninfty| - exact: measurable_set1_pinfty]. + by apply: measurableU; [exact: measurable_set1Ny| exact: measurable_set1y]. - by rewrite EFin_bigcup; apply: bigcup_measurable => i _ ; exact: mF. Qed. @@ -1387,21 +1293,21 @@ Local Open Scope ereal_scope. Definition G := [set A : set \bar R | exists r, A = `[r%:E, +oo[%classic]. -Lemma measurable_set1_ninfty : G.-sigma.-measurable [set -oo]. +Lemma measurable_set1Ny : G.-sigma.-measurable [set -oo]. Proof. -rewrite eset1_ninfty; apply: bigcapT_measurable=> i; rewrite -setCitvr. +rewrite eset1Ny; apply: bigcapT_measurable=> i; rewrite -setCitvr. by apply: measurableC; apply: sub_sigma_algebra; exists (- i%:R)%R. Qed. -Lemma measurable_set1_pinfty : G.-sigma.-measurable [set +oo]. +Lemma measurable_set1y : G.-sigma.-measurable [set +oo]. Proof. -rewrite eset1_pinfty; apply: bigcap_measurable => i _. +rewrite eset1y; apply: bigcap_measurable => i _. rewrite -setCitvl; apply: measurableC; rewrite (eitv_infty_bnd true). apply: bigcap_measurable => j _; rewrite -setCitvr; apply: measurableC. by apply: sub_sigma_algebra; exists (i%:R + j.+1%:R^-1)%R. Qed. -Lemma measurableE : emeasurable (R.-ocitv.-measurable) = G.-sigma.-measurable. +Lemma measurableE : emeasurable (@ocitv R) = G.-sigma.-measurable. Proof. apply/seteqP; split; last first. apply: smallest_sub. @@ -1411,23 +1317,20 @@ apply/seteqP; split; last first. move=> _ [r ->]/=; exists `[r, +oo[%classic. rewrite RGenOInfty.measurableE. exact: RGenOInfty.measurable_itv_bnd_infty. - by exists [set +oo]; [constructor | rewrite -punct_eitv_bnd_pinfty]. + by exists [set +oo]; [constructor|rewrite -punct_eitv_bndy]. move=> _ [A' mA' [C mC]] <-; apply: measurableU; last first. - case: mC; [by []|exact: measurable_set1_ninfty| - exact: measurable_set1_pinfty|]. - by apply: measurableU; [exact: measurable_set1_ninfty| - exact: measurable_set1_pinfty]. + case: mC; [by []|exact: measurable_set1Ny| exact: measurable_set1y|]. + by apply: measurableU; [exact: measurable_set1Ny|exact: measurable_set1y]. rewrite RGenCInfty.measurableE in mA'. have smA' := smallest_sub _ _ mA'. (* BUG: elim/smA' : _. fails !! *) apply: (smA' (G.-sigma.-measurable \o (image^~ EFin))); last first. move=> _ [r ->]/=; rewrite EFin_itv_bnd_infty; apply: measurableD. by apply: sub_sigma_algebra => /=; exists r. - exact: measurable_set1_pinfty. + exact: measurable_set1y. split=> /= [|D mD|F mF]; first by rewrite image_set0. - rewrite setTD EFin_setC; apply: measurableD; first exact: measurableC. - by apply: measurableU; [exact: measurable_set1_ninfty| - exact: measurable_set1_pinfty]. + by apply: measurableU; [exact: measurable_set1Ny|exact: measurable_set1y]. - by rewrite EFin_bigcup; apply: bigcup_measurable => i _; exact: mF. Qed. @@ -1440,7 +1343,7 @@ Variable R : realType. Definition G := [set A : set \bar R | exists r, A = `]-oo, r%:E[%classic]. -Lemma measurableE : emeasurable (R.-ocitv.-measurable) = G.-sigma.-measurable. +Lemma measurableE : emeasurable (@ocitv R) = G.-sigma.-measurable. Proof. rewrite ErealGenCInfty.measurableE eqEsubset; split => A. apply: smallest_sub; first exact: smallest_sigma_algebra. @@ -1495,9 +1398,9 @@ Proof. by move/is_intervalP => ->; exact: measurable_itv. Qed. Section coutinuous_measurable. Variable R : realType. -Lemma open_measurable (U : set R) : open U -> measurable U. +Lemma open_measurable (A : set R) : open A -> measurable A. Proof. -move=> /open_bigcup_rat ->; rewrite bigcup_mkcond; apply: bigcupT_measurable_rat. +move=>/open_bigcup_rat ->; rewrite bigcup_mkcond; apply: bigcupT_measurable_rat. move=> q; case: ifPn => // qfab; apply: is_interval_measurable => //. exact: is_interval_bigcup_ointsub. Qed. @@ -1509,12 +1412,20 @@ move=> mD /open_subspaceP [V [oV] VD]; rewrite setIC -VD. by apply: measurableI => //; exact: open_measurable. Qed. +Lemma closed_measurable (A : set R) : closed A -> measurable A. +Proof. by move/closed_openC/open_measurable/measurableC; rewrite setCK. Qed. + +Lemma compact_measurable (A : set R) : compact A -> measurable A. +Proof. +by move/compact_closed => /(_ (@Rhausdorff R)); exact: closed_measurable. +Qed. + Lemma subspace_continuous_measurable_fun (D : set R) (f : subspace D -> R) : measurable D -> continuous f -> measurable_fun D f. Proof. move=> mD /continuousP cf; apply: (measurability (RGenOpens.measurableE R)). move=> _ [_ [a [b ->] <-]]; apply: open_measurable_subspace => //. -by exact/cf/interval_open. +exact/cf/interval_open. Qed. Corollary open_continuous_measurable_fun (D : set R) (f : R -> R) : @@ -1532,16 +1443,25 @@ Qed. End coutinuous_measurable. +Lemma lower_semicontinuous_measurable {R : realType} (f : R -> \bar R) : + lower_semicontinuous f -> measurable_fun setT f. +Proof. +move=> scif; apply: (measurability (ErealGenOInfty.measurableE R)). +move=> /= _ [_ [a ->]] <-; apply: measurableI => //; apply: open_measurable. +by rewrite preimage_itv_o_infty; move/lower_semicontinuousP : scif; exact. +Qed. + Section standard_measurable_fun. +Variable R : realType. +Implicit Types D : set R. -Lemma measurable_fun_opp (R : realType) : measurable_fun [set: R] -%R. +Lemma measurable_oppr D : measurable_fun D (-%R). Proof. -apply: continuous_measurable_fun. -by have := @opp_continuous R [the normedModType R of R^o]. +apply: measurable_funTS => /=; apply: continuous_measurable_fun. +exact: (@opp_continuous R [the normedModType R of R^o]). Qed. -Lemma measurable_fun_normr (R : realType) (D : set R) : - measurable_fun D (@normr _ R). +Lemma measurable_normr D : measurable_fun D (@normr _ R). Proof. move=> mD; apply: (measurability (RGenOInfty.measurableE R)) => //. move=> /= _ [_ [x ->] <-]; apply: measurableI => //. @@ -1552,18 +1472,53 @@ have [x0|x0] := leP 0 x. - have [r0|r0] := leP 0 r; [rewrite ger0_norm|rewrite ltr0_norm] => // xr; rewrite 2!in_itv/=. + by right; rewrite xr. - + by left; rewrite ltr_oppr. + + by left; rewrite ltrNr. - move=> rx /=. - by rewrite ler0_norm 1?ltr_oppr// (le_trans (ltW rx))// ler_oppl oppr0. + by rewrite ler0_norm 1?ltrNr// (le_trans (ltW rx))// lerNl oppr0. - by rewrite in_itv /= andbT => xr; rewrite (lt_le_trans _ (ler_norm _)). rewrite [X in measurable X](_ : _ = setT)// predeqE => r. by split => // _; rewrite /= in_itv /= andbT (lt_le_trans x0). Qed. -End standard_measurable_fun. +Lemma measurable_mulrl D (k : R) : measurable_fun D ( *%R k). +Proof. +apply: measurable_funTS => /=. +by apply: continuous_measurable_fun; exact: mulrl_continuous. +Qed. + +Lemma measurable_mulrr D (k : R) : measurable_fun D (fun x => x * k). +Proof. +apply: measurable_funTS => /=. +by apply: continuous_measurable_fun; exact: mulrr_continuous. +Qed. +Lemma measurable_exprn D n : measurable_fun D (fun x => x ^+ n). +Proof. +apply measurable_funTS => /=. +by apply continuous_measurable_fun; exact: exprn_continuous. +Qed. + +End standard_measurable_fun. +#[global] Hint Extern 0 (measurable_fun _ (-%R)) => + solve [exact: measurable_oppr] : core. #[global] Hint Extern 0 (measurable_fun _ normr) => - solve [exact: measurable_fun_normr] : core. + solve [exact: measurable_normr] : core. +#[global] Hint Extern 0 (measurable_fun _ ( *%R _)) => + solve [exact: measurable_mulrl] : core. +#[global] Hint Extern 0 (measurable_fun _ (fun x => x ^+ _)) => + solve [exact: measurable_exprn] : core. +#[deprecated(since="mathcomp-analysis 0.6.3", note="use `measurable_exprn` instead")] +Notation measurable_fun_sqr := measurable_exprn (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.3", note="use `measurable_oppr` instead")] +Notation measurable_fun_opp := measurable_oppr (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.3", note="use `measurable_oppr` instead")] +Notation measurable_funN := measurable_oppr (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.3", note="use `measurable_normr` instead")] +Notation measurable_fun_normr := measurable_normr (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.3", note="use `measurable_exprn` instead")] +Notation measurable_fun_exprn := measurable_exprn (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.3", note="use `measurable_mulrl` instead")] +Notation measurable_funrM := measurable_mulrl (only parsing). Section measurable_fun_realType. Context d (T : measurableType d) (R : realType). @@ -1580,70 +1535,60 @@ rewrite [X in measurable X](_ : _ = \bigcup_(q : rat) - by rewrite -preimage_itv_o_infty; apply: mf => //; apply: measurable_itv. - by rewrite -preimage_itv_o_infty; apply: mg => //; apply: measurable_itv. rewrite predeqE => x; split => [|[r _] []/= [Dx rfx]] /= => [[Dx]|[_]]. - rewrite -ltr_subl_addr => /rat_in_itvoo[r]; rewrite inE /= => /itvP h. + rewrite -ltrBlDr => /rat_in_itvoo[r]; rewrite inE /= => /itvP h. exists r => //; rewrite setIACA setIid; split => //; split => /=. by rewrite h. - by rewrite ltr_subl_addr addrC -ltr_subl_addr h. -by rewrite ltr_subl_addr=> afg; rewrite (lt_le_trans afg)// addrC ler_add2r ltW. -Qed. - -Lemma measurable_funrM D f (k : R) : measurable_fun D f -> - measurable_fun D (fun x => k * f x). -Proof. -apply: (@measurable_funT_comp _ _ _ _ _ _ ( *%R k)). -by apply: continuous_measurable_fun; apply: mulrl_continuous. -Qed. - -Lemma measurable_funN D f : measurable_fun D f -> measurable_fun D (-%R \o f). -Proof. -move=> mf mD; rewrite (_ : _ \o _ = (fun x => - 1 * f x)). - exact: measurable_funrM. -by under eq_fun do rewrite mulN1r. + by rewrite ltrBlDr addrC -ltrBlDr h. +by rewrite ltrBlDr=> afg; rewrite (lt_le_trans afg)// addrC lerD2r ltW. Qed. Lemma measurable_funB D f g : measurable_fun D f -> measurable_fun D g -> measurable_fun D (f \- g). -Proof. -by move=> ? ? ?; apply: measurable_funD => //; exact: measurable_funN. -Qed. - -Lemma measurable_fun_exprn D n f : - measurable_fun D f -> measurable_fun D (fun x => f x ^+ n). -Proof. -apply: measurable_funT_comp ((@GRing.exp R)^~ n) _ _ _. -by apply: continuous_measurable_fun; apply: exprn_continuous. -Qed. - -Lemma measurable_fun_sqr D f : - measurable_fun D f -> measurable_fun D (fun x => f x ^+ 2). -Proof. exact: measurable_fun_exprn. Qed. +Proof. by move=> ? ?; apply: measurable_funD =>//; exact: measurableT_comp. Qed. Lemma measurable_funM D f g : measurable_fun D f -> measurable_fun D g -> measurable_fun D (f \* g). Proof. -move=> mf mg mD; rewrite (_ : (_ \* _) = (fun x => 2%:R^-1 * (f x + g x) ^+ 2) - \- (fun x => 2%:R^-1 * (f x ^+ 2)) \- (fun x => 2%:R^-1 * ( g x ^+ 2))). - apply: measurable_funB => //; last first. - by apply: measurable_funrM => //; exact: measurable_fun_sqr. - apply: measurable_funB => //; last first. - by apply: measurable_funrM => //; exact: measurable_fun_sqr. - apply: measurable_funrM => //. - by apply: measurable_fun_sqr => //; exact: measurable_funD. +move=> mf mg; rewrite (_ : (_ \* _) = (fun x => 2%:R^-1 * (f x + g x) ^+ 2) + \- (fun x => 2%:R^-1 * (f x ^+ 2)) \- (fun x => 2%:R^-1 * (g x ^+ 2))). + apply: measurable_funB; first apply: measurable_funB. + - apply: measurableT_comp => //. + by apply: measurableT_comp (measurable_exprn _) _; exact: measurable_funD. + - apply: measurableT_comp => //. + exact: measurableT_comp (measurable_exprn _) _. + - apply: measurableT_comp => //. + exact: measurableT_comp (measurable_exprn _) _. rewrite funeqE => x /=; rewrite -2!mulrBr sqrrD (addrC (f x ^+ 2)) -addrA. rewrite -(addrA (f x * g x *+ 2)) -opprB opprK (addrC (g x ^+ 2)) addrK. by rewrite -(mulr_natr (f x * g x)) -(mulrC 2) mulrA mulVr ?mul1r// unitfE. Qed. -Lemma measurable_fun_max D f g : +Lemma measurable_fun_ltr D f g : measurable_fun D f -> measurable_fun D g -> + measurable_fun D (fun x => f x < g x). +Proof. +move=> mf mg mD Y mY; have [| | |] := set_bool Y => /eqP ->. +- under eq_fun do rewrite -subr_gt0. + rewrite preimage_true -preimage_itv_o_infty. + by apply: (measurable_funB mg mf) => //; exact: measurable_itv. +- under eq_fun do rewrite ltNge -subr_ge0. + rewrite preimage_false set_predC setCK -preimage_itv_c_infty. + by apply: (measurable_funB mf mg) => //; exact: measurable_itv. +- by rewrite preimage_set0 setI0. +- by rewrite preimage_setT setIT. +Qed. + +Lemma measurable_maxr D f g : measurable_fun D f -> measurable_fun D g -> measurable_fun D (f \max g). Proof. -move=> mf mg mD; apply (measurability (RGenCInfty.measurableE R)) => //. -move=> _ [_ [x ->] <-]; rewrite [X in measurable X](_ : _ = - (D `&` f @^-1` `[x, +oo[) `|` (D `&` g @^-1` `[x, +oo[)); last first. - rewrite predeqE => t /=; split. - by rewrite /= !in_itv /= !andbT le_maxr => -[Dx /orP[|]]; tauto. - by move=> [|]; rewrite !in_itv/= !andbT le_maxr => -[Dx ->]//; rewrite orbT. -by apply: measurableU; [apply: mf|apply: mg] =>//; apply: measurable_itv. +by move=> mf mg mD; move: (mD); apply: measurable_fun_if => //; + [exact: measurable_fun_ltr|exact: measurable_funS mg|exact: measurable_funS mf]. +Qed. + +Lemma measurable_minr D f g : + measurable_fun D f -> measurable_fun D g -> measurable_fun D (f \min g). +Proof. +by move=> mf mg mD; move: (mD); apply: measurable_fun_if => //; + [exact: measurable_fun_ltr|exact: measurable_funS mf|exact: measurable_funS mg]. Qed. Lemma measurable_fun_sups D (h : (T -> R)^nat) n : @@ -1666,16 +1611,16 @@ move=> _ [_ [x ->] <-]; rewrite infs_preimage // setI_bigcupr. by apply: bigcup_measurable => k /= nk; apply: mf => //; exact: measurable_itv. Qed. -Lemma measurable_fun_lim_sup D (h : (T -> R)^nat) : +Lemma measurable_fun_limn_sup D (h : (T -> R)^nat) : (forall t, D t -> has_ubound (range (h ^~ t))) -> (forall t, D t -> has_lbound (range (h ^~ t))) -> (forall n, measurable_fun D (h n)) -> - measurable_fun D (fun x => lim_sup (h ^~ x)). + measurable_fun D (fun x => limn_sup (h ^~ x)). Proof. move=> f_ub f_lb mf. have : {in D, (fun x => inf [set sups (h ^~ x) n | n in [set n | 0 <= n]%N]) - =1 (fun x => lim_sup (h^~ x))}. - move=> t; rewrite inE => Dt; apply/esym/cvg_lim; first exact: Rhausdorff. + =1 (fun x => limn_sup (h^~ x))}. + move=> t; rewrite inE => Dt; apply/esym/cvg_lim => //. rewrite [X in _ --> X](_ : _ = inf (range (sups (h^~t)))). by apply: cvg_sups_inf; [exact: f_ub|exact: f_lb]. by congr (inf [set _ | _ in _]); rewrite predeqE. @@ -1687,43 +1632,85 @@ by move=> k; exact: measurable_fun_sups. Qed. Lemma measurable_fun_cvg D (h : (T -> R)^nat) f : - (forall m, measurable_fun D (h m)) -> (forall x, D x -> h ^~ x --> f x) -> + (forall m, measurable_fun D (h m)) -> (forall x, D x -> h ^~ x @ \oo --> f x) -> measurable_fun D f. Proof. -move=> mf_ f_f; have fE x : D x -> f x = lim_sup (h ^~ x). +move=> mf_ f_f; have fE x : D x -> f x = limn_sup (h ^~ x). move=> Dx; have /cvg_lim <-// := @cvg_sups _ (h ^~ x) (f x) (f_f _ Dx). - exact: Rhausdorff. -apply: (@eq_measurable_fun _ _ _ _ D (fun x => lim_sup (h ^~ x))). +apply: (@eq_measurable_fun _ _ _ _ D (fun x => limn_sup (h ^~ x))). by move=> x; rewrite inE => Dx; rewrite -fE. -apply: (@measurable_fun_lim_sup _ h) => // t Dt. -- apply/bounded_fun_has_ubound/(@cvg_seq_bounded _ [normedModType R of R^o]). - by apply/cvg_ex; eexists; exact: f_f. -- apply/bounded_fun_has_lbound/(@cvg_seq_bounded _ [normedModType R of R^o]). - by apply/cvg_ex; eexists; exact: f_f. +apply: (@measurable_fun_limn_sup _ h) => // t Dt. +- by apply/bounded_fun_has_ubound/cvg_seq_bounded/cvg_ex; eexists; exact: f_f. +- by apply/bounded_fun_has_lbound/cvg_seq_bounded/cvg_ex; eexists; exact: f_f. Qed. End measurable_fun_realType. +#[deprecated(since="mathcomp-analysis 0.6.6", note="renamed `measurable_fun_limn_sup`")] +Notation measurable_fun_lim_sup := measurable_fun_limn_sup (only parsing). + +Lemma measurable_ln (R : realType) : measurable_fun [set~ (0:R)] (@ln R). +Proof. +rewrite (_ : [set~ 0] = `]-oo, 0[ `|` `]0, +oo[); last first. + by rewrite -(setCitv `[0, 0]); apply/seteqP; split => [|]x/=; + rewrite in_itv/= -eq_le eq_sym; [move/eqP/negbTE => ->|move/negP/eqP]. +apply/measurable_funU => //; split. +- apply/(@measurable_restrict _ _ _ _ _ setT) => //. + rewrite (_ : _ \_ _ = cst (0:R))//; apply/funext => y; rewrite patchE. + by case: ifPn => //; rewrite inE/= in_itv/= => y0; rewrite ln0// ltW. +- have : {in `]0, +oo[%classic, continuous (@ln R)}. + by move=> x; rewrite inE/= in_itv/= andbT => x0; exact: continuous_ln. + rewrite -continuous_open_subspace; last exact: interval_open. + by move/subspace_continuous_measurable_fun; apply; exact: measurable_itv. +Qed. +#[global] Hint Extern 0 (measurable_fun _ (@ln _)) => + solve [apply: measurable_ln] : core. +#[deprecated(since="mathcomp-analysis 0.6.3", note="use `measurable_ln` instead")] +Notation measurable_fun_ln := measurable_ln (only parsing). + +Lemma measurable_expR (R : realType) : measurable_fun [set: R] expR. +Proof. by apply: continuous_measurable_fun; exact: continuous_expR. Qed. +#[global] Hint Extern 0 (measurable_fun _ expR) => + solve [apply: measurable_expR] : core. + +Lemma measurable_powR (R : realType) p : + measurable_fun [set: R] (@powR R ^~ p). +Proof. +apply: measurable_fun_if => //. +- apply: (measurable_fun_bool true); rewrite (_ : _ @^-1` _ = [set 0])//. + by apply/seteqP; split => [_ /eqP ->//|_ -> /=]; rewrite eqxx. +- rewrite setTI; apply: measurableT_comp => //. + rewrite (_ : _ @^-1` _ = [set~ 0]); first exact: measurableT_comp. + by apply/seteqP; split => [x /negP/negP/eqP|x x0]//=; exact/negbTE/eqP. +Qed. +#[global] Hint Extern 0 (measurable_fun _ (@powR _ ^~ _)) => + solve [apply: measurable_powR] : core. +#[deprecated(since="mathcomp-analysis 0.6.3", note="use `measurable_powR` instead")] +Notation measurable_fun_power_pos := measurable_powR (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.4", note="use `measurable_powR` instead")] +Notation measurable_power_pos := measurable_powR (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.3", note="use `measurable_maxr` instead")] +Notation measurable_fun_max := measurable_maxr (only parsing). Section standard_emeasurable_fun. Variable R : realType. -Lemma measurable_fun_EFin (D : set R) : measurable_fun D EFin. +Lemma measurable_EFin (D : set R) : measurable_fun D EFin. Proof. move=> mD; apply: (measurability (ErealGenOInfty.measurableE R)) => //. move=> /= _ [_ [x ->]] <-; apply: measurableI => //. by rewrite preimage_itv_o_infty EFin_itv; exact: measurable_itv. Qed. -Lemma measurable_fun_abse (D : set (\bar R)) : measurable_fun D abse. +Lemma measurable_abse (D : set (\bar R)) : measurable_fun D abse. Proof. move=> mD; apply: (measurability (ErealGenOInfty.measurableE R)) => //. move=> /= _ [_ [x ->] <-]. -rewrite [X in _ @^-1` X](punct_eitv_bnd_pinfty _ x) preimage_setU setIUr. +rewrite [X in _ @^-1` X](punct_eitv_bndy _ x) preimage_setU setIUr. apply: measurableU; last first. by rewrite preimage_abse_pinfty; apply: measurableI => //; exact: measurableU. apply: measurableI => //; exists (normr @^-1` `]x, +oo[%classic). rewrite -[X in measurable X]setTI. - by apply: measurable_fun_normr => //; exact: measurable_itv. + by apply: measurable_normr => //; exact: measurable_itv. exists set0; first by constructor. rewrite setU0 predeqE => -[y| |]; split => /= => -[r]; rewrite ?/= /= ?in_itv /= ?andbT => xr//. @@ -1731,56 +1718,61 @@ rewrite setU0 predeqE => -[y| |]; split => /= => -[r]; + by move=> [ry]; exists y => //=; rewrite /= in_itv/= andbT -ry. Qed. -Lemma emeasurable_fun_minus (D : set (\bar R)) : +Lemma measurable_oppe (D : set (\bar R)) : measurable_fun D (-%E : \bar R -> \bar R). Proof. move=> mD; apply: (measurability (ErealGenCInfty.measurableE R)) => //. move=> _ [_ [x ->] <-]; rewrite (_ : _ @^-1` _ = `]-oo, (- x)%:E]%classic). - by apply: measurableI => //; exact: emeasurable_itv_ninfty_bnd. + by apply: measurableI => //; exact: emeasurable_itv. by rewrite predeqE => y; rewrite preimage_itv !in_itv/= andbT in_itv lee_oppr. Qed. End standard_emeasurable_fun. #[global] Hint Extern 0 (measurable_fun _ abse) => - solve [exact: measurable_fun_abse] : core. + solve [exact: measurable_abse] : core. #[global] Hint Extern 0 (measurable_fun _ EFin) => - solve [exact: measurable_fun_EFin] : core. + solve [exact: measurable_EFin] : core. +#[global] Hint Extern 0 (measurable_fun _ (-%E)) => + solve [exact: measurable_oppe] : core. +#[deprecated(since="mathcomp-analysis 0.6.3", note="use `measurable_oppe` instead")] +Notation emeasurable_fun_minus := measurable_oppe (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.3", note="use `measurable_abse` instead")] +Notation measurable_fun_abse := measurable_abse (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.3", note="use `measurable_EFin` instead")] +Notation measurable_fun_EFin := measurable_EFin (only parsing). (* NB: real-valued function *) Lemma EFin_measurable_fun d (T : measurableType d) (R : realType) (D : set T) (g : T -> R) : measurable_fun D (EFin \o g) <-> measurable_fun D g. Proof. -split=> [mf mD A mA|]; last by move=> mg; exact: measurable_funT_comp. +split=> [mf mD A mA|]; last by move=> mg; exact: measurableT_comp. rewrite [X in measurable X](_ : _ = D `&` (EFin \o g) @^-1` (EFin @` A)). by apply: mf => //; exists A => //; exists set0; [constructor|rewrite setU0]. congr (_ `&` _);rewrite eqEsubset; split=> [|? []/= _ /[swap] -[->//]]. by move=> ? ?; exact: preimage_image. Qed. +Lemma measurable_er_map d (T : measurableType d) (R : realType) (f : R -> R) + : measurable_fun setT f -> measurable_fun [set: \bar R] (er_map f). +Proof. +move=> mf;rewrite (_ : er_map _ = + fun x => if x \is a fin_num then (f (fine x))%:E else x); last first. + by apply: funext=> -[]. +apply: measurable_fun_ifT => //=. ++ apply: (measurable_fun_bool true). + rewrite /preimage/= -[X in measurable X]setTI. + exact/emeasurable_fin_num. ++ exact/EFin_measurable_fun/measurableT_comp. +Qed. +#[deprecated(since="mathcomp-analysis 0.6.3", note="renamed `measurable_er_map`")] +Notation measurable_fun_er_map := measurable_er_map (only parsing). + Section emeasurable_fun. Local Open Scope ereal_scope. Context d (T : measurableType d) (R : realType). Implicit Types (D : set T). -Lemma emeasurable_fun_bool (D : set T) (f : T -> bool) b : - measurable (f @^-1` [set b]) -> measurable_fun D f. -Proof. -have FNT : [set false] = [set~ true] by apply/seteqP; split => -[]//=. -wlog {b}-> : b / b = true. - case: b => [|h]; first exact. - by rewrite FNT -preimage_setC => /measurableC; rewrite setCK; exact: h. -move=> mfT mD /= Y; have := @subsetT _ Y; rewrite setT_bool => YT. -have [-> _|-> _|-> _ |-> _] := subset_set2 YT. -- by rewrite preimage0 ?setI0. -- by apply: measurableI => //; exact: mfT. -- rewrite -[X in measurable X]setCK; apply: measurableC; rewrite setCI. - apply: measurableU; first exact: measurableC. - by rewrite FNT preimage_setC setCK; exact: mfT. -- by rewrite -setT_bool preimage_setT setIT. -Qed. -Arguments emeasurable_fun_bool {D f} b. - Lemma measurable_fun_einfs D (f : (T -> \bar R)^nat) : (forall n, measurable_fun D (f n)) -> forall n, measurable_fun D (fun x => einfs (f ^~ x) n). @@ -1788,7 +1780,7 @@ Proof. move=> mf n mD. apply: (measurability (ErealGenCInfty.measurableE R)) => //. move=> _ [_ [x ->] <-]; rewrite einfs_preimage -bigcapIr; last by exists n => /=. -by apply: bigcap_measurable => ? ?; exact/mf/emeasurable_itv_bnd_pinfty. +by apply: bigcap_measurable => ? ?; exact/mf/emeasurable_itv. Qed. Lemma measurable_fun_esups D (f : (T -> \bar R)^nat) : @@ -1797,10 +1789,10 @@ Lemma measurable_fun_esups D (f : (T -> \bar R)^nat) : Proof. move=> mf n mD; apply: (measurability (ErealGenOInfty.measurableE R)) => //. move=> _ [_ [x ->] <-];rewrite esups_preimage setI_bigcupr. -by apply: bigcup_measurable => ? ?; exact/mf/emeasurable_itv_bnd_pinfty. +by apply: bigcup_measurable => ? ?; exact/mf/emeasurable_itv. Qed. -Lemma emeasurable_fun_max D (f g : T -> \bar R) : +Lemma measurable_maxe D (f g : T -> \bar R) : measurable_fun D f -> measurable_fun D g -> measurable_fun D (fun x => maxe (f x) (g x)). Proof. @@ -1812,63 +1804,624 @@ move=> _ [_ [x ->] <-]; rewrite [X in measurable X](_ : _ = tauto. by move=> [|]; rewrite !/= /= !in_itv/= !andbT le_maxr; move=> [Dx ->]//; rewrite orbT. -by apply: measurableU; [exact/mf/emeasurable_itv_bnd_pinfty| - exact/mg/emeasurable_itv_bnd_pinfty]. +by apply: measurableU; [exact/mf/emeasurable_itv| exact/mg/emeasurable_itv]. Qed. -Lemma emeasurable_funN D (f : T -> \bar R) : - measurable_fun D f -> measurable_fun D (\- f). -Proof. by apply: measurable_funT_comp => //; exact: emeasurable_fun_minus. Qed. - -Lemma emeasurable_fun_funepos D (f : T -> \bar R) : +Lemma measurable_funepos D (f : T -> \bar R) : measurable_fun D f -> measurable_fun D f^\+. -Proof. -by move=> mf; apply: emeasurable_fun_max => //; exact: measurable_fun_cst. -Qed. +Proof. by move=> mf; exact: measurable_maxe. Qed. -Lemma emeasurable_fun_funeneg D (f : T -> \bar R) : +Lemma measurable_funeneg D (f : T -> \bar R) : measurable_fun D f -> measurable_fun D f^\-. -Proof. -by move=> mf; apply: emeasurable_fun_max => //; - [exact: emeasurable_funN|exact: measurable_fun_cst]. -Qed. +Proof. by move=> mf; apply: measurable_maxe => //; exact: measurableT_comp. Qed. -Lemma emeasurable_fun_min D (f g : T -> \bar R) : +Lemma measurable_mine D (f g : T -> \bar R) : measurable_fun D f -> measurable_fun D g -> measurable_fun D (fun x => mine (f x) (g x)). Proof. -move=> /emeasurable_funN mf /emeasurable_funN mg. -have /emeasurable_funN := emeasurable_fun_max mf mg. -by apply eq_measurable_fun => i Di; rewrite -oppe_min oppeK. +move=> mf mg; rewrite (_ : (fun _ => _) = (fun x => - maxe (- f x) (- g x))). + apply: measurableT_comp => //. + by apply: measurable_maxe; exact: measurableT_comp. +by rewrite funeqE => x; rewrite oppe_max !oppeK. Qed. -Lemma measurable_fun_lim_esup D (f : (T -> \bar R)^nat) : +Lemma measurable_fun_limn_esup D (f : (T -> \bar R)^nat) : (forall n, measurable_fun D (f n)) -> - measurable_fun D (fun x => lim_esup (f ^~ x)). + measurable_fun D (fun x => limn_esup (f ^~ x)). Proof. move=> mf mD; rewrite (_ : (fun _ => _) = (fun x => ereal_inf [set esups (f^~ x) n | n in [set n | n >= 0]%N])). by apply: measurable_fun_einfs => // k; exact: measurable_fun_esups. -rewrite funeqE => t; apply/cvg_lim => //. +rewrite funeqE => t; rewrite limn_esup_lim; apply/cvg_lim => //. rewrite [X in _ --> X](_ : _ = ereal_inf (range (esups (f^~t)))). exact: cvg_esups_inf. by congr (ereal_inf [set _ | _ in _]); rewrite predeqE. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", - note="renamed `measurable_fun_lim_esup`")] -Notation measurable_fun_elim_sup := measurable_fun_lim_esup. - Lemma emeasurable_fun_cvg D (f_ : (T -> \bar R)^nat) (f : T -> \bar R) : (forall m, measurable_fun D (f_ m)) -> - (forall x, D x -> f_ ^~ x --> f x) -> measurable_fun D f. + (forall x, D x -> f_ ^~ x @ \oo --> f x) -> measurable_fun D f. Proof. -move=> mf_ f_f; have fE x : D x -> f x = lim_esup (f_^~ x). +move=> mf_ f_f; have fE x : D x -> f x = limn_esup (f_^~ x). + rewrite limn_esup_lim. by move=> Dx; have /cvg_lim <-// := @cvg_esups _ (f_^~x) (f x) (f_f x Dx). -apply: (measurable_fun_ext (fun x => lim_esup (f_ ^~ x))) => //. +apply: (eq_measurable_fun (fun x => limn_esup (f_ ^~ x))) => //. by move=> x; rewrite inE => Dx; rewrite fE. -exact: measurable_fun_lim_esup. +exact: measurable_fun_limn_esup. Qed. - End emeasurable_fun. Arguments emeasurable_fun_cvg {d T R D} f_. + +#[deprecated(since="mathcomp-analysis 0.6.3", note="use `measurableT_comp` instead")] +Notation emeasurable_funN := measurableT_comp (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.3", note="use `measurable_maxe` instead")] +Notation emeasurable_fun_max := measurable_maxe (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.3", note="use `measurable_mine` instead")] +Notation emeasurable_fun_min := measurable_mine (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.3", note="use `measurable_funepos` instead")] +Notation emeasurable_fun_funepos := measurable_funepos (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.3", note="use `measurable_funeneg` instead")] +Notation emeasurable_fun_funeneg := measurable_funeneg (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", note="renamed `measurable_fun_limn_esup`")] +Notation measurable_fun_lim_esup := measurable_fun_limn_esup (only parsing). + +Section lebesgue_regularity. +Context {R : realType}. +Let mu := [the measure _ _ of @lebesgue_measure R]. + +Local Open Scope ereal_scope. + +Lemma lebesgue_regularity_outer (D : set R) (eps : R) : + measurable D -> mu D < +oo -> (0 < eps)%R -> + exists U : set R, [/\ open U , D `<=` U & mu (U `\` D) < eps%:E]. +Proof. +move=> mD muDpos epspos. +have /ereal_inf_lt[z [M' covDM sMz zDe]] : mu D < mu D + (eps / 2)%:E. + by rewrite lte_spaddre ?lte_fin ?divr_gt0// ge0_fin_numE. +pose e2 n := (eps / 2) / (2 ^ n.+1)%:R. +have e2pos n : (0 < e2 n)%R by rewrite ?divr_gt0. +pose M n := if pselect (M' n = set0) then set0 else + (`] inf (M' n), sup (M' n) + e2 n [%classic)%R. +have muM n : mu (M n) <= mu (M' n) + (e2 n)%:E. + rewrite /M; case: pselect => /= [->|]. + by rewrite measure0 add0e lee_fin ltW. + have /ocitvP[-> //| [[a b /= alb -> ab0]]] : ocitv (M' n). + by case: covDM => /(_ n). + rewrite inf_itv// sup_itv//. + have -> : (`]a, (b + e2 n)%R[ = `]a, b] `|` `]b, (b + e2 n)%R[ )%classic. + apply: funext=> r /=; rewrite (@itv_splitU _ _ (BRight b)). + by rewrite propeqE; split=> /orP. + by rewrite !bnd_simp (ltW alb)/= ltr_pwDr. + rewrite measureU/=. + - rewrite !lebesgue_measure_itv/= !lte_fin alb ltr_pwDr//=. + by rewrite -(EFinD (b + e2 n)) (addrC b) addrK. + - by apply: sub_sigma_algebra; exact: is_ocitv. + - by apply: open_measurable; exact: interval_open. + - rewrite eqEsubset; split => // r []/andP [_ +] /andP[+ _] /=. + by rewrite !bnd_simp => /le_lt_trans /[apply]; rewrite ltxx. +pose U := \bigcup_n M n. +exists U; have DU : D `<=` U. + case: (covDM) => _ /subset_trans; apply; apply: subset_bigcup. + rewrite /M => n _ x; case: pselect => [/= -> //|]. + have /ocitvP [-> //| [[/= a b alb -> mn]]] : ocitv (M' n). + by case: covDM => /(_ n). + rewrite /= !in_itv/= => /andP[ax xb]; rewrite ?inf_itv ?sup_itv//. + by rewrite ax/= (le_lt_trans xb)// ltr_pwDr. +have mM n : measurable (M n). + rewrite /M; case: pselect; first by move=> /= _; exact: measurable0. + by move=> /= _; apply: open_measurable; apply: interval_open. +have muU : mu U < mu D + eps%:E. + apply: (@le_lt_trans _ _ (\sum_(n //; rewrite divr_ge0// ltW. + rewrite {2}[eps]splitr EFinD addeA lte_le_add//. + rewrite (le_lt_trans _ zDe)// -sMz lee_nneseries// => i _. + rewrite /= -wlength_Rhull wlength_itv !er_map_idfun. + rewrite -lebesgue_measure_itv le_measure//= ?inE. + - by case: covDM => /(_ i) + _; exact: sub_sigma_algebra. + - exact: measurable_itv. + - exact: sub_Rhull. +split => //. + apply: bigcup_open => n _. + by rewrite /M; case: pselect => /= _; [exact: open0|exact: interval_open]. +rewrite measureD//=. +- by rewrite setIidr// lte_subel_addl// ge0_fin_numE// (lt_le_trans muU)// leey. +- by apply: bigcup_measurable => k _; exact: mM. +- by rewrite (lt_le_trans muU)// leey. +Qed. + +Lemma lebesgue_nearly_bounded (D : set R) (eps : R) : + measurable D -> mu D < +oo -> (0 < eps)%R -> + exists ab : R * R, mu (D `\` [set` `[ab.1,ab.2]]) < eps%:E. +Proof. +move=> mD Dfin epspos; pose Dn n := D `&` [set` `[-(n%:R), n%:R]]%R. +have mDn n : measurable (Dn n) by exact: measurableI. +have : mu \o Dn @ \oo --> mu (\bigcup_n Dn n). + apply: nondecreasing_cvg_mu => //. + - by apply: bigcup_measurable => // ? _; exact: mDn. + - move=> n m nm; apply/subsetPset; apply: setIS => z /=; rewrite !in_itv/=. + move=> /andP[nz zn]; rewrite (le_trans _ nz)/= ?(le_trans zn) ?ler_nat//. + by rewrite lerNl opprK ler_nat. +rewrite -setI_bigcupr; rewrite bigcup_itvT setIT. +have finDn n : mu (Dn n) \is a fin_num. + rewrite ge0_fin_numE// (le_lt_trans _ Dfin)//. + by rewrite le_measure// ?inE//=; [exact: mDn|exact: subIsetl]. +have finD : mu D \is a fin_num by rewrite fin_num_abs gee0_abs. +rewrite -[mu D]fineK// => /fine_cvg/(_ (interior (ball (fine (mu D)) eps)))[]. + exact/nbhs_interior/nbhsx_ballx. +move=> n _ /(_ _ (leqnn n))/interior_subset muDN. +exists (-n%:R, n%:R)%R; rewrite measureD//=. +move: muDN; rewrite /ball/= /ereal_ball/= -fineB//=; last exact: finDn. +rewrite -lte_fin; apply: le_lt_trans. +have finDDn : mu D - mu (Dn n) \is a fin_num + by rewrite ?fin_numB ?finD /= ?(finDn n). +rewrite -fine_abse // gee0_abs ?sube_ge0 ?finD ?(finDn _) //. + by rewrite -[_ - _]fineK // lte_fin fine. +by rewrite le_measure// ?inE//; [exact: measurableI |exact: subIsetl]. +Qed. + +Lemma lebesgue_regularity_inner (D : set R) (eps : R) : + measurable D -> mu D < +oo -> (0 < eps)%R -> + exists V : set R, [/\ compact V , V `<=` D & mu (D `\` V) < eps%:E]. +Proof. +move=> mD finD epspos. +wlog : eps epspos D mD finD / exists ab : R * R, D `<=` `[ab.1, ab.2]%classic. + move=> WL; have [] := @lebesgue_nearly_bounded _ (eps / 2)%R mD finD. + by rewrite divr_gt0. + case=> a b /= muDabe; have [] := WL (eps / 2) _ (D `&` `[a,b]). + - by rewrite divr_gt0. + - exact: measurableI. + - by rewrite (le_lt_trans _ finD)// le_measure// inE//; exact: measurableI. + - by exists (a, b). + move=> V [/= cptV VDab Dabeps2]; exists (V `&` `[a, b]); split. + - apply: (subclosed_compact _ cptV) => //; apply: closedI. + by apply: compact_closed => //; exact: Rhausdorff. + exact: interval_closed. + - by move=> ? [/VDab []]. + rewrite setDIr (setU_id2r ((D `&` `[a, b]) `\` V)); last first. + move=> z ; rewrite setDE setCI setCK => -[?|?]; + by apply/propext; split => [[]|[[]]]. + have mV : measurable V. + by apply: closed_measurable; apply: compact_closed => //; exact: Rhausdorff. + rewrite [eps]splitr EFinD (measureU mu) // ?lte_add //. + - by apply: measurableD => //; exact: measurableI. + - exact: measurableD. + - by rewrite eqEsubset; split => z // [[[_ + _] [_]]]. +case=> -[a b] /= Dab; pose D' := `[a,b] `\` D. +have mD' : measurable D' by exact: measurableD. +have [] := lebesgue_regularity_outer mD' _ epspos. + rewrite (@le_lt_trans _ _ (mu `[a,b]%classic))//. + by rewrite le_measure ?inE//; exact: subIsetl. + by rewrite /= lebesgue_measure_itv/= -EFinD -(fun_if EFin) ltry. +move=> U [oU /subsetC + mDeps]; rewrite setCI setCK => nCD'. +exists (`[a, b] `&` ~` U); split. +- apply: (subclosed_compact _ (@segment_compact _ a b)) => //. + by apply: closedI; [exact: interval_closed | exact: open_closedC]. +- by move=> z [abz] /nCD'[]. +- rewrite setDE setCI setIUr setCK. + rewrite [_ `&` ~` _ ](iffRL (disjoints_subset _ _)) ?setCK // set0U. + move: mDeps; rewrite /D' ?setDE setCI setIUr setCK [U `&` D]setIC. + move => /(le_lt_trans _); apply; apply: le_measure; last by move => ?; right. + by rewrite inE; apply: measurableI => //; exact: open_measurable. + rewrite inE; apply: measurableU. + by apply: measurableI; [exact: open_measurable|exact: measurableC]. + by apply: measurableI => //; exact: open_measurable. +Qed. + +Let lebesgue_regularity_innerE_bounded (A : set R) : measurable A -> + mu A < +oo -> + mu A = ereal_sup [set mu K | K in [set K | compact K /\ K `<=` A]]. +Proof. +move=> mA muA; apply/eqP; rewrite eq_le; apply/andP; split; last first. + by apply: ub_ereal_sup => /= x [B /= [cB BA <-{x}]]; exact: le_outer_measure. +apply/lee_addgt0Pr => e e0. +have [B [cB BA /= ABe]] := lebesgue_regularity_inner mA muA e0. +rewrite -{1}(setDKU BA) (@le_trans _ _ (mu B + mu (A `\` B)))//. + by rewrite setUC outer_measureU2. +by rewrite lee_add//; [apply: ereal_sup_ub => /=; exists B|exact/ltW]. +Qed. + +Lemma lebesgue_regularity_inner_sup (D : set R) : measurable D -> + mu D = ereal_sup [set mu K | K in [set K | compact K /\ K `<=` D]]. +Proof. +move=> mD; have [?|] := ltP (mu D) +oo. + exact: lebesgue_regularity_innerE_bounded. +have /sigma_finiteP [F RFU [Fsub ffin]] := + sigmaT_finite_lebesgue_stieltjes_measure [the @cumulative R of idfun] + (*TODO: sigma_finiteT mu should be enough but does not seem to work with older + versions of MathComp/Coq (Coq <= 8.15?) *). +rewrite leye_eq => /eqP /[dup] + ->. +have {1}-> : D = \bigcup_n (F n `&` D) by rewrite -setI_bigcupl -RFU setTI. +move=> FDp; apply/esym/eq_infty => M. +have : (fun n => mu (F n `&` D)) @ \oo --> +oo. + rewrite -FDp; apply: nondecreasing_cvg_mu. + - by move=> i; apply: measurableI => //; exact: (ffin i).1. + - by apply: bigcup_measurable => i _; exact: (measurableI _ _ (ffin i).1). + - by move=> n m nm; apply/subsetPset; apply: setSI; exact/subsetPset/Fsub. +move/cvgey_ge => /(_ (M + 1)%R) [N _ /(_ _ (lexx N))]. +have [mFN FNoo] := ffin N. +have [] := @lebesgue_regularity_inner (F N `&` D) _ _ _ ltr01. +- exact: measurableI. +- by rewrite (le_lt_trans _ (ffin N).2)//= measureIl. +move=> V [/[dup] /compact_measurable mV cptV VFND] FDV1 M1FD. +rewrite (@le_trans _ _ (mu V))//; last first. + apply: ereal_sup_ub; exists V => //=; split => //. + exact: (subset_trans VFND (@subIsetr _ _ _)). +rewrite -(@lee_add2lE _ 1)// {1}addeC -EFinD (le_trans M1FD)//. +rewrite /mu (@measureDI _ _ _ _ (F N `&` D) _ _ mV)/=; last exact: measurableI. +rewrite ltW// lte_le_add // ?ge0_fin_numE //; last first. + by rewrite measureIr//; apply: measurableI. +by rewrite -setIA (le_lt_trans _ (ffin N).2)// measureIl//; exact: measurableI. +Qed. + +End lebesgue_regularity. + +Section egorov. + +Context d {R : realType} {T : measurableType d}. +Context (mu : {measure set T -> \bar R}). + +Local Open Scope ereal_scope. + +(*TODO : this generalizes to any metric space with a borel measure*) +Lemma pointwise_almost_uniform + (f_ : (T -> R)^nat) (g : T -> R) (A : set T) (eps : R): + (forall n, measurable_fun A (f_ n)) -> measurable_fun A g -> + measurable A -> mu A < +oo -> (forall x, A x -> f_ ^~ x @\oo --> g x) -> + (0 < eps)%R -> exists B, [/\ measurable B, mu B < eps%:E & + {uniform A `\` B, f_ @\oo --> g}]. +Proof. +move=> mf mg mA finA fptwsg epspos; pose h q (z : T) : R := `|f_ q z - g z|%R. +have mfunh q : measurable_fun A (h q). + by apply: measurableT_comp; [exact: measurable_normr |exact: measurable_funB]. +pose E k n := \bigcup_(i in [set j : nat | (n <= j)%N ]) + (A `&` [set x | (h i x >= k.+1%:R^-1)%R]). +have Einc k : nonincreasing_seq (E k). + move=> n m nm; apply/asboolP => z [i] /= /(leq_trans _) mi [? ?]. + by exists i => //; apply: mi. +have mE k n : measurable (E k n). + apply: bigcup_measurable => q /= ?. + have -> : [set x | h q x >= k.+1%:R^-1]%R = (h q)@^-1` (`[k.+1%:R^-1, +oo[). + by rewrite eqEsubset; split => z; rewrite /= in_itv /= Bool.andb_true_r. + exact: mfunh. +have nEcvg x k : exists n, A x -> (~` (E k n)) x. + case : (pselect (A x)); last by move => ?; exists point. + move=> Ax; have [] := fptwsg _ Ax (interior (ball (g x) (k.+1%:R^-1))). + by apply: open_nbhs_nbhs; split; [exact: open_interior|exact: nbhsx_ballx]. + move=> N _ Nk; exists N.+1 => _; rewrite /E setC_bigcup => i /= /ltnW Ni. + apply/not_andP; right; apply/negP; rewrite /h -real_ltNge // distrC. + by case: (Nk _ Ni) => _/posnumP[?]; apply; exact: ball_norm_center. +have Ek0 k : (\bigcap_n (E k n)) = set0. + rewrite eqEsubset; split => // z /=; suff : (~` \bigcap_n E k n) z by done. + rewrite setC_bigcap; case : (pselect (A z)) => [Az | nAz]. + by have [N /(_ Az) ?] := nEcvg z k; exists N. + by exists O; rewrite // /E setC_bigcup => n ? []. +have badn' : forall k, exists n, mu (E k n) < ((eps/2) / (2 ^ k.+1)%:R)%:E. + move=> k; pose ek :R := eps/2 / (2 ^ k.+1)%:R. + have : mu \o E k @\oo --> mu set0. + rewrite -(Ek0 k); apply: nonincreasing_cvg_mu => //. + - apply: (le_lt_trans _ finA); apply: le_measure; rewrite ?inE //. + by move=> ? [? _ []]. + - by apply: bigcap_measurable => ?. + rewrite measure0; case/fine_cvg/(_ (interior (ball (0:R) ek))%R). + apply: open_nbhs_nbhs; split; first exact: open_interior. + by apply: nbhsx_ballx; rewrite !divr_gt0. + move=> N _ /(_ N (leqnn _))/interior_subset muEN; exists N; move: muEN. + rewrite /ball /= distrC subr0 ger0_norm // -[x in x < _]fineK ?ge0_fin_numE//. + by apply:(le_lt_trans _ finA); apply: le_measure; rewrite ?inE// => ? [? _ []]. +pose badn k := projT1 (cid (badn' k)); exists (\bigcup_k (E k (badn k))); split. +- exact: bigcup_measurable. +- apply: (@le_lt_trans _ _ (eps/2)%R%:E); first last. + by rewrite lte_fin ltr_pdivrMr // ltr_pMr // Rint_ltr_addr1 // ?Rint1. + apply: le_trans. + apply: (measure_sigma_sub_additive _ (fun k => mE k (badn k)) _ _) => //. + exact: bigcup_measurable. + apply: le_trans; first last. + by apply: (@epsilon_trick0 R _ xpredT); rewrite divr_ge0 //; exact: ltW. + by rewrite lee_nneseries // => n _; exact/ltW/(projT2 (cid (badn' _))). +apply/uniform_restrict_cvg => /= U /=; rewrite !uniform_nbhsT. +case/nbhs_ex => del /= ballU; apply: filterS; first by move=> ?; exact: ballU. +have [N _ /(_ N)/(_ (leqnn _)) Ndel] := near_infty_natSinv_lt del. +exists (badn N) => // r badNr x. +rewrite /patch; case xAB: (x \in A `\` _) => //; apply: (lt_trans _ Ndel). +move/set_mem: xAB; rewrite setDE; case => Ax; rewrite setC_bigcup => /(_ N I). +rewrite /E setC_bigcup => /(_ r) /=; rewrite /h => /(_ badNr) /not_andP [] //. +by move/negP; rewrite real_ltNge // distrC. +Qed. + +Lemma ae_pointwise_almost_uniform + (f_ : (T -> R)^nat) (g : T -> R) (A : set T) (eps : R): + (forall n, measurable_fun A (f_ n)) -> measurable_fun A g -> + measurable A -> mu A < +oo -> + {ae mu, (forall x, A x -> f_ ^~ x @\oo --> g x)} -> + (0 < eps)%R -> exists B, [/\ measurable B, mu B < eps%:E & + {uniform A `\` B, f_ @\oo --> g}]. +Proof. +move=> mf mg mA Afin [C [mC C0 nC] epspos]. +have [B [mB Beps Bunif]] : exists B, [/\ d.-measurable B, mu B < eps%:E & + {uniform (A `\` C) `\` B, f_ @\oo --> g}]. + apply: pointwise_almost_uniform => //. + - by move=> n; apply : (measurable_funS mA _ (mf n)) => ? []. + - by apply : (measurable_funS mA _ (mg)) => ? []. + - by apply: measurableI => //; exact: measurableC. + - apply: (le_lt_trans _ Afin); apply: le_measure; rewrite ?inE //. + by apply: measurableI => //; exact: measurableC. + - by move=> x; rewrite setDE; case => Ax /(subsetC nC); rewrite setCK; exact. +exists (B `|` C); split. +- exact: measurableU. +- by apply: (le_lt_trans _ Beps); rewrite measureU0. +- by rewrite setUC -setDDl. +Qed. + +End egorov. + +Definition vitali_cover {R : realType} (E : set R) I + (B : I -> set R) (D : set I) := + (forall i, is_ball (B i)) /\ + forall x, E x -> forall e : R, 0 < e -> exists i, + [/\ D i, B i x & (radius (B i))%:num < e]. + +Section vitali_theorem. +Context {R : realType} (A : set R) (B : nat -> set R). +Hypothesis B0 : forall i, (0 < (radius (B i))%:num)%R. +Notation mu := (@lebesgue_measure R). +Local Open Scope ereal_scope. + +Lemma vitali_theorem (V : set nat) : vitali_cover A B V -> + exists D, [/\ countable D, D `<=` V, trivIset D (closure \o B) & + mu (A `\` \bigcup_(k in D) closure (B k)) = 0]. +Proof. +move=> ABV. +wlog VB1 : V ABV / forall i, V i -> ((radius (B i))%:num <= 1)%R. + move=> wlg. + pose V' := V `\` [set i | (radius (B i))%:num > 1]%R. + have : vitali_cover A B V'. + split; [exact: ABV.1|move=> x Ax e e0]. + have : (0 < minr e 1)%R by rewrite lt_minr// e0/=. + move=> /(ABV.2 x Ax)[i [Vi ix ie]]. + exists i; split => //. + - split => //=; rewrite ltNge; apply/negP/negPn. + by rewrite (le_trans (ltW ie))// le_minl lexx orbT. + - by rewrite (lt_le_trans ie)// le_minl lexx. + move/wlg. + have V'B1 i : V' i -> ((radius (B i))%:num <= 1)%R. + by move=> [Vi /=]; rewrite ltNge => /negP/negPn. + move=> /(_ V'B1)[D [cD DV' tD h]]. + by exists D; split => //; apply: (subset_trans DV') => ? []. +have [D [cD DV tDB Dintersect]] := vitali_lemma_infinite ABV.1 B0 VB1. +exists D; split => //. +pose Z r := (A `\` \bigcup_(k in D) closure (B k)) `&` ball (0%R:R) r. +suff: forall r : {posnum R}, mu (Z r%:num) = 0. + move=> Zr; have {}Zr n : mu (Z n%:R) = 0. + move: n => [|n]; first by rewrite /Z (ball0 _ _).2// setI0. + by rewrite (Zr (PosNum (ltr0Sn _ n))). + set F := fun n => Z n%:R. + have : mu (\bigcup_n F n) <= \sum_(i n _; rewrite /F Zr. + by rewrite /F -setI_bigcupr bigcup_ballT setIT measure_le0 => /eqP. +move=> r. +pose E := [set i | D i /\ closure (B i) `&` ball (0%R:R) r%:num !=set0]. +pose F := vitali_collection_partition B E 1. +have E_partition : E = \bigcup_n (F n). + by rewrite -cover_vitali_collection_partition// => i [] /DV /VB1. +have EBr2 n : E n -> closure (B n) `<=` (ball (0:R) (r%:num + 2))%R. + move=> [Dn] [x] => -[Bnx rx] y /= Bny. + move: rx; rewrite /ball /= !sub0r !normrN => rx. + rewrite -(subrK x y) (le_lt_trans (ler_normD _ _))//. + rewrite addrC ltr_leD// -(subrK (cpoint (B n)) y) -(addrA (y - _)%R). + rewrite (le_trans (ler_normD _ _))// (_ : 2 = 1 + 1)%R// lerD//. + rewrite distrC; have := is_ball_closureP (ABV.1 n) Bny. + by move=> /le_trans; apply; rewrite VB1//; exact: DV. + have := is_ball_closureP (ABV.1 n) Bnx. + by move=> /le_trans; apply; rewrite VB1//; exact: DV. +have measurable_closure (C : set R) : is_ball C -> measurable (closure C). + by move=> ballC; rewrite is_ball_closure//; exact: measurable_closed_ball. +move: ABV => [is_ballB ABV]. +have {}EBr2 : \esum_(i in E) mu (closure (B i)) <= + mu (ball (0:R) (r%:num + 2))%R. + rewrite -(set_mem_set E) -nneseries_esum// -measure_bigcup//; last 2 first. + by move=> *; exact: measurable_closure. + by apply: sub_trivIset tDB => ? []. + apply/le_measure; rewrite ?inE; [|exact: measurable_ball|exact: bigcup_sub]. + by apply: bigcup_measurable => *; exact: measurable_closure. +have finite_set_F i : finite_set (F i). + apply: contrapT. + pose M := `|ceil ((r%:num + 2) *+ 2 / (1 / (2 ^ i.+1)%:R))|.+1. + move/(infinite_set_fset M) => [/= C] CsubFi McardC. + have MC : (M%:R * (1 / (2 ^ i.+1)%:R))%:E <= + mu (\bigcup_(j in [set` C]) closure (B j)). + rewrite (measure_bigcup _ [set` C])//; last 2 first. + by move=> ? _; exact: measurable_closure. + by apply: sub_trivIset tDB; by apply: (subset_trans CsubFi) => x [[]]. + rewrite /= nneseries_esum//= set_mem_set// esum_fset// fsbig_finite//=. + rewrite set_fsetK. + apply: (@le_trans _ _ (\sum_(i0 <- C) (1 / (2 ^ i.+1)%:R)%:E)). + under eq_bigr do rewrite -(mul1r (_ / _)) EFinM. + rewrite -ge0_sume_distrl// EFinM lee_wpmul2r// sumEFin lee_fin. + by rewrite -(natr_sum _ _ _ (cst 1%N)) ler_nat -card_fset_sum1. + rewrite big_seq [in leRHS]big_seq; apply: lee_sum => // j. + move=> /CsubFi[_ /andP[+ _]]. + rewrite -lte_fin => /ltW/le_trans; apply. + rewrite (is_ball_closure (is_ballB _))// lebesgue_measure_closed_ball//. + by rewrite lee_fin mulr2n lerDr. + have CFi : mu (\bigcup_(j in [set` C]) closure (B j)) <= + mu (\bigcup_(j in F i) closure (B j)). + apply: le_measure => //; rewrite ?inE. + - rewrite bigcup_fset; apply: bigsetU_measurable => *. + exact: measurable_closure. + - by apply: bigcup_measurable => *; exact: measurable_closure. + - apply: bigcup_sub => j Cj. + exact/(@bigcup_sup _ _ _ _ (closure \o B))/CsubFi. + have Fir2 : mu (\bigcup_(j in F i) closure (B j)) <= + mu (ball (0:R) (r%:num + 2))%R. + rewrite (le_trans _ EBr2)// -(set_mem_set E) -nneseries_esum //. + rewrite E_partition -measure_bigcup//=; last 2 first. + by move=> ? _; exact: measurable_closure. + apply: trivIset_bigcup => //. + by move=> n; apply: sub_trivIset tDB => ? [[]]. + by move=> n m i0 j nm [[Di0 _] _] [[Dj _] _]; exact: tDB. + apply: le_measure; rewrite ?inE. + - by apply: bigcup_measurable => *; exact: measurable_closure. + - by apply: bigcup_measurable => *; exact: measurable_closure. + - by move=> /= x [n Fni Bnx]; exists n => //; exists i. + have {CFi Fir2} := le_trans MC (le_trans CFi Fir2). + apply/negP; rewrite -ltNge lebesgue_measure_ball// lte_fin. + rewrite -(@natr1 _ `| _ |%N) natr_absz ger0_norm ?ceil_ge0// -ltr_pdivrMr//. + by rewrite -ltrBlDr (lt_le_trans _ (ceil_ge _))// ltrBlDr ltrDl. +have mur2_fin_num_ : mu (ball (0:R) (r%:num + 2))%R < +oo. + by rewrite lebesgue_measure_ball// ltry. +have FE : \sum_(n //. + - by move=> i; apply: bigcup_measurable => *; exact: measurable_closure. + - apply: trivIsetT_bigcup => //. + apply/trivIsetP => i j _ _ ij. + by apply: disjoint_vitali_collection_partition => // k -[] /DV /VB1. + by rewrite -E_partition; apply: sub_trivIset tDB => x []. + - rewrite -bigcup_bigcup; apply: bigcup_measurable => k _. + exact: measurable_closure. + apply: (@eq_eseriesr _ (fun n => mu (\bigcup_(i in F n) closure (B i)))). + move=> i _; rewrite bigcup_mkcond measure_semi_bigcup//; last 3 first. + by move=> j; case: ifPn => // _; exact: measurable_closure. + by apply/(trivIset_mkcond _ _).1; apply: sub_trivIset tDB => x [[]]. + rewrite -bigcup_mkcond; apply: bigcup_measurable => k _. + exact: measurable_closure. + rewrite esum_mkcond//= nneseries_esum// -fun_true//=. + by under eq_esum do rewrite (fun_if mu) (measure0 [the measure _ _ of mu]). +apply/eqP; rewrite -measure_le0. +apply/lee_addgt0Pr => _ /posnumP[e]; rewrite add0e. +have [N F5e] : exists N, \sum_(N <= n mu (\bigcup_(i in F k) closure (B i)))) => i _. + rewrite measure_bigcup//=. + - by rewrite nneseries_esum// set_mem_set. + - by move=> j D'ij; exact: measurable_closure. + - by apply: sub_trivIset tDB => // x [[]]. + rewrite FE (@le_lt_trans _ _ (mu (ball (0 : R) (r%:num + 2))%R))//. + rewrite (le_trans _ EBr2)// measure_bigcup//=. + + by rewrite nneseries_esum// set_mem_set. + + by move=> i _; exact: measurable_closure. + + by apply: sub_trivIset tDB => // x []. + have : \sum_(N <= k \oo] --> 0. + exact: nneseries_tail_cvg. + rewrite /f /= => /fine_fcvg /= /cvgrPdist_lt /=. + have : (0 < 5%:R^-1 * e%:num)%R by rewrite mulr_gt0// invr_gt0// ltr0n. + move=> /[swap] /[apply]. + rewrite near_map => -[N _]/(_ _ (leqnn N)) h; exists N; move: h. + rewrite sub0r normrN ger0_norm//; last by rewrite fine_ge0// nneseries_ge0. + rewrite -lte_fin; apply: le_lt_trans. + set X : \bar R := (X in fine X). + have Xoo : X < +oo. + apply: le_lt_trans foo. + by rewrite (nneseries_split N)// lee_addr//; exact: sume_ge0. + rewrite fineK ?ge0_fin_numE//; last exact: nneseries_ge0. + apply: lee_nneseries => //; first by move=> i _; exact: esum_ge0. + move=> n Nn; rewrite measure_bigcup//=. + - by rewrite nneseries_esum// set_mem_set. + - by move=> i _; exact: measurable_closure. + - by apply: sub_trivIset tDB => x [[]]. +pose K := \bigcup_(i in `I_N) \bigcup_(j in F i) closure (B j). +have closedK : closed K. + apply: closed_bigcup => //= i iN; apply: closed_bigcup => //. + by move=> j Fij; exact: closed_closure. +have ZNF5 : Z r%:num `<=` + \bigcup_(i in ~` `I_N) \bigcup_(j in F i) closure (5%:R *` B j). + move=> z Zz. + have Kz : ~ K z. + rewrite /K => -[n /= nN [m] [[Dm _] _] Bmz]. + by case: Zz => -[_ + _]; apply; exists m. + have [i [Vi Biz Bir BiK0]] : exists i, [/\ V i, (closure (B i)) z, + closure (B i) `<=` ball (0%R:R) r%:num & closure (B i) `&` K = set0]. + case: Zz => -[Az notDBz]; rewrite /ball/= sub0r normrN => rz. + have [d dzr zdK0] : exists2 d : {posnum R}, + (d%:num < r%:num - `|z|)%R & closed_ball z d%:num `&` K = set0. + have [d/= d0 dzK] := closed_disjoint_closed_ball closedK Kz. + have rz0 : (0 < minr ((r%:num - `|z|) / 2) (d / 2))%R. + by rewrite lt_minr (divr_gt0 d0)//= andbT divr_gt0// subr_gt0. + exists (PosNum rz0) => /=. + by rewrite lt_minl ltr_pdivrMr// ltr_pMr ?subr_gt0// ltr1n. + apply: dzK => //=. + rewrite sub0r normrN gtr0_norm// lt_minl (ltr_pdivrMr d d)//. + by rewrite ltr_pMr// ltr1n orbT. + have N0_gt0 : (0 < d%:num / 2)%R by rewrite divr_gt0. + have [i [Vi Biz BiN0]] := ABV _ Az _ N0_gt0. + exists i; split => //. + exact: subset_closure. + move=> y Biy; rewrite /ball/= sub0r normrN -(@subrK _ (cpoint (B i)) y). + rewrite (le_lt_trans (ler_normD _ _))//. + rewrite (@le_lt_trans _ _ (d%:num / 2 + `|cpoint (B i)|)%R)//. + rewrite lerD2r// distrC. + by rewrite (le_trans (is_ball_closureP (is_ballB i) Biy))// ltW. + rewrite -(@subrK _ z (cpoint (B i))). + rewrite (@le_lt_trans _ _ (d%:num / 2 + `|cpoint (B i) - z| + `|z|)%R)//. + by rewrite -[leRHS]addrA lerD2l//; exact: ler_normD. + rewrite (@le_lt_trans _ _ (d%:num + `|z|)%R)//. + rewrite [in leRHS](splitr d%:num) -!addrA lerD2l// lerD2r//. + by rewrite (le_trans (ltW (is_ballP (is_ballB i) Biz)))// ltW. + by move: dzr; rewrite -ltrBrDr. + apply: subsetI_eq0 zdK0 => // y Biy. + rewrite closed_ballE//= /closed_ball_/=. + rewrite -(@subrK _ (cpoint (B i)) z) -(addrA (z - _)%R). + rewrite (le_trans (ler_normD _ _))// [in leRHS](splitr d%:num) lerD//. + by rewrite distrC (le_trans (ltW (is_ballP (is_ballB i) Biz)))// ltW. + by rewrite (le_trans (is_ball_closureP (is_ballB i) Biy))// ltW. + have [j [Ej Bij0 Bij5]] : exists j, [/\ E j, + closure (B i) `&` closure (B j) !=set0 & + closure (B i) `<=` closure (5%:R *` B j)]. + have [j [Dj Bij0 Bij2 Bij5]] := Dintersect _ Vi. + exists j; split => //; split => //. + by move: Bij0; rewrite setIC; exact: subsetI_neq0. + have BjK : ~ (closure (B j) `<=` K). + move=> BjK; move/eqP : BiK0. + by apply/negP/set0P; move: Bij0; exact: subsetI_neq0. + have [k NK Fkj] : (\bigcup_(i in ~` `I_N) F i) j. + move: Ej; rewrite E_partition => -[k _ Fkj]. + by exists k => //= kN; apply: BjK => x Bjx; exists k => //; exists j. + by exists k => //; exists j => //; exact: Bij5. +have {}ZNF5 : mu (Z r%:num) <= + \sum_(N <= m //. + move=> n; apply: bigcup_measurable => k _. + by apply: measurable_closure; exact: is_scale_ball. + apply: bigcup_measurable => k _; apply: bigcup_measurable => k' _. + by apply: measurable_closure; exact: is_scale_ball. + apply: lee_nneseries => // n _. + rewrite -[in leRHS](set_mem_set (F n)) -nneseries_esum// bigcup_mkcond. + rewrite eseries_mkcond [leRHS](_ : _ = \sum_(i x. + by under [RHS]eq_bigr do rewrite (fun_if mu) measure0. + apply: measure_sigma_sub_additive => //. + + move=> m; case: ifPn => // _. + by apply: measurable_closure; exact: is_scale_ball. + + apply: bigcup_measurable => k _; case: ifPn => // _. + by apply: measurable_closure; exact: is_scale_ball. +apply/(le_trans ZNF5). +move/ltW: F5e; rewrite [in X in X -> _](@lee_pdivl_mull R 5%:R) ?ltr0n//. +rewrite -nneseriesZl//; last by move=> *; exact: esum_ge0. +apply: le_trans; apply: lee_nneseries => //; first by move=> *; exact: esum_ge0. +move=> n _. +rewrite -(set_mem_set (F n)) -nneseries_esum// -nneseries_esum// -nneseriesZl//. +apply: lee_nneseries => // m mFn. +rewrite (ballE (is_ballB m))// closure_ball lebesgue_measure_closed_ball//. +rewrite scale_ballE// closure_ball lebesgue_measure_closed_ball//. +by rewrite -EFinM mulrnAr. +Qed. + +End vitali_theorem. diff --git a/theories/lebesgue_stieltjes_measure.v b/theories/lebesgue_stieltjes_measure.v new file mode 100644 index 000000000..b25548a94 --- /dev/null +++ b/theories/lebesgue_stieltjes_measure.v @@ -0,0 +1,524 @@ +(* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) +From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval. +From mathcomp Require Import finmap fingroup perm rat. +From HB Require Import structures. +From mathcomp.classical Require Import mathcomp_extra boolp classical_sets. +From mathcomp.classical Require Import functions fsbigop cardinality. +Require Import reals ereal signed topology numfun normedtype sequences esum. +Require Import real_interval measure realfun. + +(**md**************************************************************************) +(* # Lebesgue Stieltjes Measure *) +(* *) +(* This file contains a formalization of the Lebesgue-Stieltjes measure using *) +(* the Measure Extension theorem from measure.v. *) +(* *) +(* Reference: *) +(* - Achim Klenke, Probability Theory 2nd edition, 2014 *) +(* *) +(* ``` *) +(* right_continuous f == the function f is right-continuous *) +(* cumulative R == type of non-decreasing, right-continuous *) +(* functions (with R : numFieldType) *) +(* The HB class is Cumulative. *) +(* instance: idfun *) +(* ocitv_type R == alias for R : realType *) +(* ocitv == set of open-closed intervals ]x, y] where *) +(* x and y are real numbers *) +(* R.-ocitv == display for ocitv_type R *) +(* R.-ocitv.-measurable == semiring of sets of open-closed intervals *) +(* wlength f A := f b - f a with the hull of the set of real *) +(* numbers A being delimited by a and b *) +(* lebesgue_stieltjes_measure f == Lebesgue-Stieltjes measure for f *) +(* f is a cumulative function. *) +(* ``` *) +(* *) +(******************************************************************************) + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Import numFieldTopology.Exports. + +Local Open Scope classical_set_scope. +Local Open Scope ring_scope. + +Reserved Notation "R .-ocitv" (at level 1, format "R .-ocitv"). +Reserved Notation "R .-ocitv.-measurable" + (at level 2, format "R .-ocitv.-measurable"). + +(* TODO: move? *) +Notation right_continuous f := + (forall x, f%function @ at_right x --> f%function x). + +Lemma right_continuousW (R : numFieldType) (f : R -> R) : + continuous f -> right_continuous f. +Proof. by move=> cf x; apply: cvg_within_filter; exact/cf. Qed. + +HB.mixin Record isCumulative (R : numFieldType) (f : R -> R) := { + cumulative_is_nondecreasing : {homo f : x y / x <= y} ; + cumulative_is_right_continuous : right_continuous f }. + +#[short(type=cumulative)] +HB.structure Definition Cumulative (R : numFieldType) := + { f of isCumulative R f }. + +Arguments cumulative_is_nondecreasing {R} _. +Arguments cumulative_is_right_continuous {R} _. + +Lemma nondecreasing_right_continuousP (R : numFieldType) (a : R) (e : R) + (f : cumulative R) : + e > 0 -> exists d : {posnum R}, f (a + d%:num) <= f a + e. +Proof. +move=> e0; move: (cumulative_is_right_continuous f). +move=> /(_ a)/(@cvgr_dist_lt _ [the normedModType R of R^o]). +move=> /(_ _ e0)[] _ /posnumP[d] => h. +exists (PosNum [gt0 of (d%:num / 2)]) => //=. +move: h => /(_ (a + d%:num / 2)) /=. +rewrite opprD addrA subrr distrC subr0 ger0_norm //. +rewrite ltr_pdivrMr// ltr_pMr// ltr1n => /(_ erefl). +rewrite ltrDl divr_gt0// => /(_ erefl). +rewrite ler0_norm; last first. + by rewrite subr_le0 (cumulative_is_nondecreasing f)// lerDl. +by rewrite opprB ltrBlDl => fa; exact: ltW. +Qed. + +Section id_is_cumulative. +Variable R : realType. + +Let id_nd : {homo @idfun R : x y / x <= y}. +Proof. by []. Qed. + +Let id_rc : right_continuous (@idfun R). +Proof. by apply/right_continuousW => x; exact: cvg_id. Qed. + +HB.instance Definition _ := isCumulative.Build R idfun id_nd id_rc. +End id_is_cumulative. +(* /TODO: move? *) + +Section itv_semiRingOfSets. +Variable R : realType. +Implicit Types (I J K : set R). +Definition ocitv_type : Type := R. + +Definition ocitv := [set `]x.1, x.2]%classic | x in [set: R * R]]. + +Lemma is_ocitv a b : ocitv `]a, b]%classic. +Proof. by exists (a, b); split => //=; rewrite in_itv/= andbT. Qed. +Hint Extern 0 (ocitv _) => solve [apply: is_ocitv] : core. + +Lemma ocitv0 : ocitv set0. +Proof. by exists (1, 0); rewrite //= set_itv_ge ?bnd_simp//= ltr10. Qed. +Hint Resolve ocitv0 : core. + +Lemma ocitvP X : ocitv X <-> X = set0 \/ exists2 x, x.1 < x.2 & X = `]x.1, x.2]%classic. +Proof. +split=> [[x _ <-]|[->//|[x xlt ->]]]//. +case: (boolP (x.1 < x.2)) => x12; first by right; exists x. +by left; rewrite set_itv_ge. +Qed. + +Lemma ocitvD : semi_setD_closed ocitv. +Proof. +move=> _ _ [a _ <-] /ocitvP[|[b ltb]] ->. + rewrite setD0; exists [set `]a.1, a.2]%classic]. + by split=> [//|? ->//||? ? -> ->//]; rewrite bigcup_set1. +rewrite setDE setCitv/= setIUr -!set_itvI. +rewrite /Order.meet/= /Order.meet/= /Order.join/= + ?(andbF, orbF)/= ?(meetEtotal, joinEtotal). +rewrite -negb_or le_total/=; set c := minr _ _; set d := maxr _ _. +have inside : a.1 < c -> d < a.2 -> `]a.1, c] `&` `]d, a.2] = set0. + rewrite -subset0 lt_minr lt_maxl => /andP[a12 ab1] /andP[_ ba2] x /= []. + have b1a2 : b.1 <= a.2 by rewrite ltW// (lt_trans ltb). + have a1b2 : a.1 <= b.2 by rewrite ltW// (lt_trans _ ltb). + rewrite /c /d (min_idPr _)// (max_idPr _)// !in_itv /=. + move=> /andP[a1x xb1] /andP[b2x xa2]. + by have := lt_le_trans b2x xb1; case: ltgtP ltb. +exists ((if a.1 < c then [set `]a.1, c]%classic] else set0) `|` + (if d < a.2 then [set `]d, a.2]%classic] else set0)); split. +- by rewrite finite_setU; do! case: ifP. +- by move=> ? []; case: ifP => ? // ->//=. +- by rewrite bigcup_setU; congr (_ `|` _); + case: ifPn => ?; rewrite ?bigcup_set1 ?bigcup_set0// set_itv_ge. +- move=> I J/=; case: ifP => //= ac; case: ifP => //= da [] // -> []// ->. + by rewrite inside// => -[]. + by rewrite setIC inside// => -[]. +Qed. + +Lemma ocitvI : setI_closed ocitv. +Proof. +move=> _ _ [a _ <-] [b _ <-]; rewrite -set_itvI/=. +rewrite /Order.meet/= /Order.meet /Order.join/= + ?(andbF, orbF)/= ?(meetEtotal, joinEtotal). +by rewrite -negb_or le_total/=. +Qed. + +Definition ocitv_display : Type -> measure_display. Proof. exact. Qed. + +HB.instance Definition _ := Pointed.on ocitv_type. +HB.instance Definition _ := + @isSemiRingOfSets.Build (ocitv_display R) + ocitv_type ocitv ocitv0 ocitvI ocitvD. + +End itv_semiRingOfSets. + +Notation "R .-ocitv" := (ocitv_display R) : measure_display_scope. +Notation "R .-ocitv.-measurable" := (measurable : set (set (ocitv_type R))) : + classical_set_scope. + +Local Open Scope measure_display_scope. + +Section wlength. +Context {R : realType}. +Variable (f : R -> R). +Local Open Scope ereal_scope. +Implicit Types i j : interval R. + +Let g : \bar R -> \bar R := er_map f. + +Definition wlength (A : set (ocitv_type R)) : \bar R := + let i := Rhull A in g i.2 - g i.1. + +Lemma wlength0 : wlength (set0 : set R) = 0. +Proof. by rewrite /wlength Rhull0 /= subee. Qed. + +Lemma wlength_singleton (r : R) : wlength `[r, r] = 0. +Proof. +rewrite /wlength /= asboolT// sup_itvcc//= asboolT//. +by rewrite asboolT inf_itvcc//= ?subee// inE. +Qed. + +Lemma wlength_setT : wlength setT = +oo%E :> \bar R. +Proof. by rewrite /wlength RhullT. Qed. + +Lemma wlength_itv i : wlength [set` i] = if i.2 > i.1 then g i.2 - g i.1 else 0. +Proof. +case: ltP => [/lt_ereal_bnd/neitvP i12|]; first by rewrite /wlength set_itvK. +rewrite le_eqVlt => /orP[|/lt_ereal_bnd i12]; last first. + rewrite -wlength0; congr (wlength _). + by apply/eqP/negPn; rewrite -/(neitv _) neitvE -leNgt (ltW i12). +case: i => -[ba a|[|]] [bb b|[|]] //=. +- rewrite /= => /eqP[->{b}]; move: ba bb => -[] []; try + by rewrite set_itvE wlength0. + by rewrite wlength_singleton. +- by move=> _; rewrite set_itvE wlength0. +- by move=> _; rewrite set_itvE wlength0. +Qed. + +Lemma wlength_finite_fin_num i : neitv i -> wlength [set` i] < +oo -> + ((i.1 : \bar R) \is a fin_num) /\ ((i.2 : \bar R) \is a fin_num). +Proof. +move: i => [[ba a|[]] [bb b|[]]] /neitvP //=; do ?by rewrite ?set_itvE ?eqxx. +by move=> _; rewrite wlength_itv /= ltry. +by move=> _; rewrite wlength_itv /= ltNye. +by move=> _; rewrite wlength_itv. +Qed. + +Lemma finite_wlength_itv i : neitv i -> wlength [set` i] < +oo -> + wlength [set` i] = (fine (g i.2))%:E - (fine (g i.1))%:E. +Proof. +move=> i0 ioo; have [i1f i2f] := wlength_finite_fin_num i0 ioo. +rewrite fineK; last first. + by rewrite /g; move: i2f; case: (ereal_of_itv_bound i.2). +rewrite fineK; last first. + by rewrite /g; move: i1f; case: (ereal_of_itv_bound i.1). +rewrite wlength_itv; case: ifPn => //; rewrite -leNgt le_eqVlt => /predU1P[->|]. + by rewrite subee// /g; move: i1f; case: (ereal_of_itv_bound i.1). +by move/lt_ereal_bnd/ltW; rewrite leNgt; move: i0 => /neitvP => ->. +Qed. + +Lemma wlength_itv_bnd (a b : R) (x y : bool) : (a <= b)%R -> + wlength [set` Interval (BSide x a) (BSide y b)] = (f b - f a)%:E. +Proof. +move=> ab; rewrite wlength_itv/= lte_fin lt_neqAle ab andbT. +by have [-> /=|/= ab'] := eqVneq a b; rewrite ?subrr// EFinN EFinB. +Qed. + +Lemma wlength_infty_bnd b r : + wlength [set` Interval -oo%O (BSide b r)] = +oo :> \bar R. +Proof. by rewrite wlength_itv /= ltNye. Qed. + +Lemma wlength_bnd_infty b r : + wlength [set` Interval (BSide b r) +oo%O] = +oo :> \bar R. +Proof. by rewrite wlength_itv /= ltey. Qed. + +Lemma pinfty_wlength_itv i : wlength [set` i] = +oo -> + (exists s r, i = Interval -oo%O (BSide s r) \/ i = Interval (BSide s r) +oo%O) + \/ i = `]-oo, +oo[. +Proof. +rewrite wlength_itv; case: i => -[ba a|[]] [bb b|[]] //= => [|_|_|]. +- by case: ifPn. +- by left; exists ba, a; right. +- by left; exists bb, b; left. +- by right. +Qed. + +Lemma wlength_itv_ge0 (ndf : {homo f : x y / (x <= y)%R}) i : + 0 <= wlength [set` i]. +Proof. +rewrite wlength_itv; case: ifPn => //; case: (i.1 : \bar _) => [r| |]. +- by rewrite suber_ge0// => /ltW /(le_er_map ndf). +- by rewrite ltNge leey. +- case: (i.2 : \bar _) => //=; last by rewrite leey. + by move=> r _; rewrite leey. +Qed. + +Lemma wlength_Rhull (A : set R) : wlength [set` Rhull A] = wlength A. +Proof. by rewrite /wlength Rhull_involutive. Qed. + +Lemma le_wlength_itv (ndf : {homo f : x y / (x <= y)%R}) i j : + {subset i <= j} -> wlength [set` i] <= wlength [set` j]. +Proof. +set I := [set` i]; set J := [set` j]. +have [->|/set0P I0] := eqVneq I set0; first by rewrite wlength0 wlength_itv_ge0. +have [J0|/set0P J0] := eqVneq J set0. + by move/subset_itvP; rewrite -/J J0 subset0 -/I => ->. +move=> /subset_itvP ij; apply: lee_sub => /=. + have [ui|ui] := asboolP (has_ubound I). + have [uj /=|uj] := asboolP (has_ubound J); last by rewrite leey. + rewrite lee_fin; apply: ndf; apply/le_sup => //. + by move=> r Ir; exists r; split => //; apply: ij. + have [uj /=|//] := asboolP (has_ubound J). + by move: ui; have := subset_has_ubound ij uj. +have [lj /=|lj] := asboolP (has_lbound J); last by rewrite leNye. +have [li /=|li] := asboolP (has_lbound I); last first. + by move: li; have := subset_has_lbound ij lj. +rewrite lee_fin; apply/ndf/le_inf => //. +move=> r [r' Ir' <-{r}]; exists (- r')%R. +by split => //; exists r' => //; apply: ij. +Qed. + +Lemma le_wlength (ndf : {homo f : x y / (x <= y)%R}) : + {homo wlength : A B / A `<=` B >-> A <= B}. +Proof. +move=> a b /le_Rhull /(le_wlength_itv ndf). +by rewrite (wlength_Rhull a) (wlength_Rhull b). +Qed. + +End wlength. + +Section wlength_extension. +Context {R : realType}. + +Lemma wlength_semi_additive (f : R -> R) : measure.semi_additive (wlength f). +Proof. +move=> /= I n /(_ _)/cid2-/all_sig[b]/all_and2[_]/(_ _)/esym-/funext {I}->. +move=> Itriv [[/= a1 a2] _] /esym /[dup] + ->. +rewrite wlength_itv ?lte_fin/= -EFinB. +case: ifPn => a12; last first. + pose I i := `](b i).1, (b i).2]%classic. + rewrite set_itv_ge//= -(bigcup_mkord _ I) /I => /bigcup0P I0. + by under eq_bigr => i _ do rewrite I0//= wlength0; rewrite big1. +set A := `]a1, a2]%classic. +rewrite -bigcup_pred; set P := xpredT; rewrite (eq_bigl P)//. +move: P => P; have [p] := ubnP #|P|; elim: p => // p IHp in P a2 a12 A *. +rewrite ltnS => cP /esym AE. +have : A a2 by rewrite /A /= in_itv/= lexx andbT. +rewrite AE/= => -[i /= Pi] a2bi. +case: (boolP ((b i).1 < (b i).2)) => bi; last by rewrite itv_ge in a2bi. +have {}a2bi : a2 = (b i).2. + apply/eqP; rewrite eq_le (itvP a2bi)/=. + suff: A (b i).2 by move=> /itvP->. + by rewrite AE; exists i=> //=; rewrite in_itv/= lexx andbT. +rewrite {a2}a2bi in a12 A AE *. +rewrite (bigD1 i)//= wlength_itv ?lte_fin/= bi !EFinD -addeA. +congr (_ + _)%E; apply/eqP; rewrite addeC -sube_eq// 1?adde_defC//. +rewrite ?EFinN oppeK addeC; apply/eqP. +have [a1bi|a1bi] := eqVneq a1 (b i).1. + rewrite {a1}a1bi in a12 A AE {IHp} *; rewrite subee ?big1// => j. + move=> /andP[Pj Nji]; rewrite wlength_itv ?lte_fin/=; case: ifPn => bj//. + exfalso; have /trivIsetP/(_ j i I I Nji) := Itriv. + pose m := ((b j).1 + (b j).2) / 2%:R. + have mbj : `](b j).1, (b j).2]%classic m. + by rewrite /= !in_itv/= ?(midf_lt, midf_le)//= ltW. + rewrite -subset0 => /(_ m); apply; split=> //. + by suff: A m by []; rewrite AE; exists j. +have a1b2 j : P j -> (b j).1 < (b j).2 -> a1 <= (b j).2. + move=> Pj bj; suff /itvP-> : A (b j).2 by []. + by rewrite AE; exists j => //=; rewrite ?in_itv/= bj/=. +have a1b j : P j -> (b j).1 < (b j).2 -> a1 <= (b j).1. + move=> Pj bj; case: ltP=> // bj1a. + suff : A a1 by rewrite /A/= in_itv/= ltxx. + by rewrite AE; exists j; rewrite //= in_itv/= bj1a//= a1b2. +have bbi2 j : P j -> (b j).1 < (b j).2 -> (b j).2 <= (b i).2. + move=> Pj bj; suff /itvP-> : A (b j).2 by []. + by rewrite AE; exists j => //=; rewrite ?in_itv/= bj/=. +apply/IHp. +- by rewrite lt_neqAle a1bi/= a1b. +- rewrite (leq_trans _ cP)// -(cardID (pred1 i) P). + rewrite [X in (_ < X + _)%N](@eq_card _ _ (pred1 i)); last first. + by move=> j; rewrite !inE andbC; case: eqVneq => // ->. + rewrite ?card1 ?ltnS// subset_leq_card//. + by apply/fintype.subsetP => j; rewrite -topredE/= !inE andbC. +apply/seteqP; split=> /= [x [j/= /andP[Pj Nji]]|x/= xabi]. + case: (boolP ((b j).1 < (b j).2)) => bj; last by rewrite itv_ge. + apply: subitvP; rewrite subitvE ?bnd_simp a1b//= leNgt. + have /trivIsetP/(_ j i I I Nji) := Itriv. + rewrite -subset0 => /(_ (b j).2); apply: contra_notN => /= bi1j2. + by rewrite !in_itv/= bj !lexx bi1j2 bbi2. +have: A x. + rewrite /A/= in_itv/= (itvP xabi)/= ltW//. + by rewrite (le_lt_trans _ bi) ?(itvP xabi). +rewrite AE => -[j /= Pj xbj]. +exists j => //=. +apply/andP; split=> //; apply: contraTneq xbj => ->. +by rewrite in_itv/= le_gtF// (itvP xabi). +Qed. + +Lemma wlength_ge0 (f : cumulative R) (I : set (ocitv_type R)) : + (0 <= wlength f I)%E. +Proof. +by rewrite -(wlength0 f) le_wlength//; exact: cumulative_is_nondecreasing. +Qed. + +#[local] Hint Extern 0 (0%:E <= wlength _ _) => solve[apply: wlength_ge0] : core. + +HB.instance Definition _ (f : cumulative R) := + isContent.Build _ _ R (wlength f) + (wlength_ge0 f) + (wlength_semi_additive f). + +Hint Extern 0 (measurable _) => solve [apply: is_ocitv] : core. + +Lemma cumulative_content_sub_fsum (f : cumulative R) (D : {fset nat}) a0 b0 + (a b : nat -> R) : (forall i, i \in D -> a i <= b i) -> + `]a0, b0] `<=` \big[setU/set0]_(i <- D) `]a i, b i]%classic -> + f b0 - f a0 <= \sum_(i <- D) (f (b i) - f (a i)). +Proof. +move=> Dab h; have [ab|ab] := leP a0 b0; last first. + apply (@le_trans _ _ 0). + by rewrite subr_le0 cumulative_is_nondecreasing// ltW. + rewrite big_seq sumr_ge0// => i iD. + by rewrite subr_ge0 cumulative_is_nondecreasing// Dab. +have mab k : [set` D] k -> R.-ocitv.-measurable `]a k, b k]%classic by []. +move: h; rewrite -bigcup_fset. +move/(@content_sub_fsum _ R _ [the content _ _ of wlength f] _ [set` D] + `]a0, b0]%classic (fun x => `](a x), (b x)]%classic) (finite_fset D) mab + (is_ocitv _ _)) => /=. +rewrite wlength_itv_bnd// -lee_fin => /le_trans; apply. +rewrite -sumEFin fsbig_finite//= set_fsetK// big_seq [in X in (_ <= X)%E]big_seq. +by apply: lee_sum => i iD; rewrite wlength_itv_bnd// Dab. +Qed. + +Lemma wlength_sigma_sub_additive (f : cumulative R) : + sigma_sub_additive (wlength f). +Proof. +move=> I A /(_ _)/cid2-/all_sig[b]/all_and2[_]/(_ _)/esym AE. +move=> [a _ <-]; rewrite wlength_itv ?lte_fin/= -EFinB => lebig. +case: ifPn => a12; last by rewrite nneseries_esum ?esum_ge0. +wlog wlogh : b A AE lebig / forall n, (b n).1 <= (b n).2. + move=> /= h. + set A' := fun n => if (b n).1 >= (b n).2 then set0 else A n. + set b' := fun n => if (b n).1 >= (b n).2 then (0, 0) else b n. + rewrite [X in (_ <= X)%E](_ : _ = \sum_(n k. + rewrite /= /A' AE; case: ifPn => // bn. + by rewrite set_itv_ge//= bnd_simp -leNgt. + apply: (h b'). + - move=> k; rewrite /A'; case: ifPn => // bk. + by rewrite set_itv_ge//= bnd_simp -leNgt /b' bk. + - by rewrite AE /b' (negbTE bk). + - apply: (subset_trans lebig); apply subset_bigcup => k _. + rewrite /A' AE; case: ifPn => bk //. + by rewrite subset0 set_itv_ge//= bnd_simp -leNgt. + - by move=> k; rewrite /b'; case: ifPn => //; rewrite -ltNge => /ltW. +apply/lee_addgt0Pr => _/posnumP[e]. +rewrite [e%:num]splitr [in leRHS]EFinD addeA -lee_subl_addr//. +apply: le_trans (epsilon_trick _ _ _) => //=. +have [c ce] := nondecreasing_right_continuousP a.1 f [gt0 of e%:num / 2]. +have [D De] : exists D : nat -> {posnum R}, forall i, + f ((b i).2 + (D i)%:num) <= f ((b i).2) + (e%:num / 2) / 2 ^ i.+1. + suff : forall i, exists di : {posnum R}, + f ((b i).2 + di%:num) <= f ((b i).2) + (e%:num / 2) / 2 ^ i.+1. + by move/choice => -[g hg]; exists g. + move=> k; apply nondecreasing_right_continuousP => //. + by rewrite divr_gt0 // exprn_gt0. +have acbd : `[ a.1 + c%:num / 2, a.2] `<=` + \bigcup_i `](b i).1, (b i).2 + (D i)%:num[%classic. + apply: (@subset_trans _ `]a.1, a.2]). + move=> r; rewrite /= !in_itv/= => /andP [+ ->]. + by rewrite andbT; apply: lt_le_trans; rewrite ltrDl. + apply: (subset_trans lebig) => r [n _ Anr]; exists n => //. + move: Anr; rewrite AE /= !in_itv/= => /andP [->]/= /le_lt_trans. + by apply; rewrite ltrDl. +have := @segment_compact _ (a.1 + c%:num / 2) a.2; rewrite compact_cover. +have obd k : [set: nat] k -> open `](b k).1, ((b k).2 + (D k)%:num)[%classic. + by move=> _; exact: interval_open. +move=> /(_ _ _ _ obd acbd){obd acbd}. +case=> X _ acXbd. +rewrite /cover in acXbd. +rewrite -EFinD. +apply: (@le_trans _ _ (\sum_(i <- X) (wlength f `](b i).1, (b i).2]%classic) + + \sum_(i <- X) (f ((b i).2 + (D i)%:num)%R - f (b i).2)%:E)%E). + apply: (@le_trans _ _ (f a.2 - f (a.1 + c%:num / 2))%:E). + rewrite lee_fin -addrA -opprD lerB// (le_trans _ ce)//. + rewrite cumulative_is_nondecreasing//. + by rewrite lerD2l ler_pdivrMr// ler_pMr// ler1n. + apply: (@le_trans _ _ + (\sum_(i <- X) (f ((b i).2 + (D i)%:num) - f (b i).1)%:E)%E). + rewrite sumEFin lee_fin cumulative_content_sub_fsum//. + by move=> k kX; rewrite (@le_trans _ _ (b k).2)// lerDl. + apply: subset_trans. + exact/(subset_trans _ acXbd)/subset_itv_oc_cc. + move=> x [k kX] kx; rewrite -bigcup_fset; exists k => //. + by move: x kx; exact: subset_itv_oo_oc. + rewrite addeC -big_split/=; apply: lee_sum => k _. + by rewrite !(EFinB, wlength_itv_bnd)// addeA subeK. +rewrite -big_split/= nneseries_esum//; last by move=> k _; rewrite adde_ge0. +rewrite esum_ge//; exists [set` X] => //; rewrite fsbig_finite//= set_fsetK. +rewrite big_seq [in X in (_ <= X)%E]big_seq; apply: lee_sum => k kX. +by rewrite AE lee_add2l// lee_fin lerBlDl natrX De. +Qed. + +HB.instance Definition _ (f : cumulative R) := + Content_SubSigmaAdditive_isMeasure.Build _ _ _ + (wlength f) (wlength_sigma_sub_additive f). + +Lemma wlength_sigma_finite (f : R -> R) : + sigma_finite [set: (ocitv_type R)] (wlength f). +Proof. +exists (fun k => `](- k%:R), k%:R]%classic). + apply/esym; rewrite -subTset => /= x _ /=. + exists `|(floor `|x|%R + 1)%R|%N; rewrite //= in_itv/=. + rewrite !natr_absz intr_norm intrD -RfloorE. + suff: `|x| < `|Rfloor `|x| + 1| by rewrite ltr_norml => /andP[-> /ltW->]. + rewrite [ltRHS]ger0_norm//. + by rewrite (le_lt_trans _ (lt_succ_Rfloor _))// ?ler_norm. + by rewrite addr_ge0// -Rfloor0 le_Rfloor. +move=> k; split => //; rewrite wlength_itv /= -EFinB. +by case: ifP; rewrite ltey. +Qed. + +Definition lebesgue_stieltjes_measure (f : cumulative R) := + measure_extension [the measure _ _ of wlength f]. +HB.instance Definition _ (f : cumulative R) := + Measure.on (lebesgue_stieltjes_measure f). + +(* TODO: this ought to be turned into a Let but older version of mathcomp/coq + does not seem to allow, try to change asap *) +Lemma sigmaT_finite_lebesgue_stieltjes_measure (f : cumulative R) : + sigma_finite setT (lebesgue_stieltjes_measure f). +Proof. exact/measure_extension_sigma_finite/wlength_sigma_finite. Qed. + +HB.instance Definition _ (f : cumulative R) := @Measure_isSigmaFinite.Build _ _ _ + (lebesgue_stieltjes_measure f) (sigmaT_finite_lebesgue_stieltjes_measure f). + +End wlength_extension. +Arguments lebesgue_stieltjes_measure {R}. + +Section lebesgue_stieltjes_measure. +Variable R : realType. +Let gitvs := [the measurableType _ of salgebraType (@ocitv R)]. + +Lemma lebesgue_stieltjes_measure_unique (f : cumulative R) + (mu : {measure set gitvs -> \bar R}) : + (forall X, ocitv X -> lebesgue_stieltjes_measure f X = mu X) -> + forall X, measurable X -> lebesgue_stieltjes_measure f X = mu X. +Proof. +move=> muE X mX; apply: measure_extension_unique => //=. + exact: wlength_sigma_finite. +by move=> A mA; rewrite -muE// -measurable_mu_extE. +Qed. + +End lebesgue_stieltjes_measure. diff --git a/theories/measure.v b/theories/measure.v index c0d9ea1c1..3aacd9130 100644 --- a/theories/measure.v +++ b/theories/measure.v @@ -1,101 +1,137 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From mathcomp Require Import all_ssreflect all_algebra finmap. -From mathcomp.classical Require Import boolp classical_sets functions. -From mathcomp.classical Require Import cardinality fsbigop mathcomp_extra. +From mathcomp Require Import mathcomp_extra boolp classical_sets functions. +From mathcomp Require Import cardinality fsbigop . Require Import reals ereal signed topology normedtype sequences esum numfun. From HB Require Import structures. -(******************************************************************************) -(* Measure Theory *) +(**md**************************************************************************) +(* # Measure Theory *) (* *) -(* This files provides a formalization of the basics of measure theory. This *) -(* includes the formalization of mathematical structures for measure theory *) -(* and of measures, as well as standard theorems such as the Boole *) -(* inequality, Caratheodory's theorem, the Hahn extension, etc. *) +(* NB: See CONTRIBUTING.md for an introduction to HB concepts and commands. *) (* *) -(* Main references: *) -(* - Daniel Li, Intégration et applications, 2016 *) -(* - Achim Klenke, Probability Theory 2nd edition, 2014 *) +(* This files provides a formalization of the basics of measure theory. This *) +(* includes the formalization of mathematical structures and of measures, as *) +(* well as standard theorems such as the Measure Extension theorem that *) +(* builds a measure given a function defined over a semiring of sets, the *) +(* intermediate outer measure being *) +(* $\inf_F\{ \sum_{k=0}^\infty \mu(F_k) | X \subseteq \bigcup_k F_k\}.$ *) (* *) -(* setI_closed G == the set of sets G is closed under finite *) -(* intersection *) -(* setU_closed G == the set of sets G is closed under finite union *) -(* setC_closed G == the set of sets G is closed under complement *) -(* setD_closed G == the set of sets G is closed under difference *) -(* ndseq_closed G == the set of sets G is closed under non-decreasing *) -(* countable union *) -(* trivIset_closed G == the set of sets G is closed under pairwise-disjoint *) -(* countable union *) +(* Reference: *) +(* - R. Affeldt, C. Cohen. Measure construction by extension in dependent *) +(* type theory with application to integration. JAR 2023 *) +(* - Daniel Li. Intégration et applications. 2016 *) +(* - Achim Klenke. Probability Theory. 2014 *) (* *) -(* setring G == the set of sets G contains the empty set, is *) -(* closed by union, and difference *) -(* <> := smallest setring G *) -(* sigma_algebra D G == the set of sets G forms a sigma algebra on D *) -(* <> == sigma-algebra generated by G on D *) -(* := smallest (sigma_algebra D) G *) -(* <> := <> *) -(* monotone_class D G == G is a monotone class of subsets of D *) -(* <> == monotone class generated by G on D *) -(* <> := <> *) -(* dynkin G == G is a set of sets that form a Dynkin *) -(* (or a lambda) system *) -(* <> == Dynkin system generated by G, i.e., *) -(* smallest dynkin G *) -(* *) -(* * Mathematical structures for measure theory: *) -(* semiRingOfSetsType == the type of semirings of sets; *) -(* the carrier is a set of sets A such that *) -(* "measurable A" holds; *) +(* ## Mathematical structures *) +(* ``` *) +(* semiRingOfSetsType d == the type of semirings of sets *) +(* The carrier is a set of sets A_i such that *) +(* "measurable A_i" holds. *) (* "measurable A" is printed as "d.-measurable A" *) (* where d is a "display parameter" whose purpose *) -(* is to distinguish different measurable's within *) -(* the same context *) -(* ringOfSetsType == the type of rings of sets *) -(* <> is equipped with a canonical structure *) -(* of ring of sets *) -(* G.-ring.-measurable A == A is measurable for the ring of sets <> *) -(* algebraOfSetsType == the type of algebras of sets *) +(* is to distinguish different "measurable" *) +(* predicates in the same context. *) +(* The HB class is SemiRingOfSets. *) +(* ringOfSetsType d == the type of rings of sets *) +(* The HB class is RingOfSets. *) +(* algebraOfSetsType d == the type of algebras of sets *) +(* The HB class is AlgebraOfsets. *) (* measurableType == the type of sigma-algebras *) -(* <> is equipped with a canonical structure *) -(* of measurableType *) -(* G.-sigma.-measurable A == A is measurable for the sigma-algebra <> *) +(* The HB class is Measurable. *) +(* ``` *) (* *) +(* ## Instances of mathematical structures *) +(* ``` *) (* discrete_measurable_unit == the measurableType corresponding to *) (* [set: set unit] *) (* discrete_measurable_bool == the measurableType corresponding to *) (* [set: set bool] *) (* discrete_measurable_nat == the measurableType corresponding to *) (* [set: set nat] *) -(* salgebraType G == the measurableType corresponding to <> *) +(* setring G == the set of sets G contains the empty set, is *) +(* closed by union, and difference *) +(* <> := smallest setring G *) +(* <> is equipped with a structure of ring *) +(* of sets. *) +(* G.-ring.-measurable A == A belongs for the ring of sets <> *) +(* sigma_algebra D G == the set of sets G forms a sigma algebra on D *) +(* <> == sigma-algebra generated by G on D *) +(* := smallest (sigma_algebra D) G *) +(* <> := <> *) +(* <> is equipped with a structure of *) +(* sigma-algebra *) +(* G.-sigma.-measurable A == A is measurable for the sigma-algebra <> *) +(* salgebraType G == the measurableType corresponding to <> *) +(* This is an HB alias. *) +(* mu .-cara.-measurable == sigma-algebra of Caratheodory measurable sets *) +(* ``` *) (* *) -(* measurable_fun D f == the function f with domain D is measurable *) -(* preimage_class D f G == class of the preimages by f of sets in G *) -(* image_class D f G == class of the sets with a preimage by f in G *) +(* ## Structures for functions on classes of sets *) +(* *) +(* A few details about mixins/factories to highlight implementations *) +(* peculiarities: *) (* *) -(* * Measures: *) -(* {content set T -> \bar R} == type of a function over sets of elements of *) -(* type T where R is expected to be a numFieldType such *) -(* that this function maps set0 to 0, is non-negative over *) -(* measurable sets, and is semi-additive *) -(* isContent == corresponding mixin *) -(* Content == corresponding structure *) -(* {measure set T -> \bar R} == type of a function over sets of elements *) -(* of type T where R is expected to be a numFieldType such *) -(* that this function maps set0 to 0, is non-negative over *) -(* measurable sets and is semi-sigma-additive *) -(* isMeasure0 == mixin that extends a content to a measure with the proof *) -(* that it is semi_sigma_additive *) -(* isMeasure == factory corresponding to the type of measures *) -(* Measure == structure corresponding to measures *) -(* finite_measure mu == the measure mu is finite *) -(* {sigma_finite_content set T -> \bar R} == contents that are also sigma *) -(* finite *) -(* {sigma_finite_measure set T -> \bar R} == *) -(* measures that are also sigma finite *) -(* isSigmaFinite == factory corresponding to sigma finiteness *) +(* ``` *) +(* {content set T -> \bar R} == type of contents *) +(* T is expected to be a semiring of sets and R a *) +(* numFieldType. *) +(* The HB class is Content. *) +(* {measure set T -> \bar R} == type of (non-negative) measures *) +(* T is expected to be a semiring of sets and R a *) +(* numFieldType. *) +(* The HB class is Measure. *) +(* Content_SubSigmaAdditive_isMeasure == *) +(* mixin that extends a content to a measure with the *) +(* proof that it is semi_sigma_additive *) +(* Content_isMeasure == factory that extends a content to a measure with *) +(* the proof that it is sub_sigma_additive *) +(* isMeasure == factory corresponding to the "textbook *) +(* definition" of measures *) +(* sfinite_measure == predicate for s-finite measure functions *) +(* {sfinite_measure set T -> \bar R} == type of s-finite measures *) +(* The HB class is SFiniteMeasure. *) +(* sfinite_measure_seq mu == the sequence of finite measures of the *) +(* s-finite measure mu *) +(* Measure_isSFinite_subdef == mixin for s-finite measures *) +(* Measure_isSFinite == factory for s-finite measures *) +(* {sigma_finite_content set T -> \bar R} == contents that are also sigma *) +(* finite *) +(* The HB class is SigmaFiniteContent. *) +(* {sigma_finite_measure set T -> \bar R} == measures that are also sigma *) +(* finite *) +(* The HB class is SigmaFiniteMeasure. *) +(* sigma_finite A f == the measure function f is sigma-finite on the *) +(* A : set T with T a semiring of sets *) +(* fin_num_fun == predicate for finite function over measurable *) +(* sets *) +(* FinNumFun.type == type of functions over semiring of sets *) +(* returning a fin_num *) +(* The HB class is FinNumFun. *) +(* {finite_measure set T -> \bar R} == finite measures *) +(* The HB class is FiniteMeasure. *) +(* SigmaFinite_isFinite == mixin for finite measures *) +(* Measure_isFinite == factory for finite measures *) +(* subprobability T R == subprobability measure over the measurableType *) +(* T with values in \bar R with R : realType *) +(* The HB class is SubProbability. *) +(* probability T R == probability measure over the measurableType T *) +(* with values in \bar with R : realType *) +(* probability == type of probability measures *) +(* The HB class is Probability. *) +(* Measure_isProbability == factor for probability measures *) +(* mnormalize mu == normalization of a measure to a probability *) +(* {outer_measure set T -> \bar R} == type of an outer measure over sets *) +(* of elements of type T : Type where R is *) +(* expected to be a numFieldType *) +(* The HB class is OuterMeasure. *) +(* ``` *) (* *) +(* ## Instances of measures *) +(* ``` *) (* pushforward mf m == pushforward/image measure of m by f, where mf is a *) (* proof that f is measurable *) +(* m has type set T -> \bar R. *) (* \d_a == Dirac measure *) (* msum mu n == the measure corresponding to the sum of the measures *) (* mu_0, ..., mu_{n-1} *) @@ -110,54 +146,129 @@ From HB Require Import structures. (* proof that D is measurable *) (* counting T R == counting measure *) (* *) -(* sigma_finite A f == the measure f is sigma-finite on A : set T with *) -(* T : ringOfSetsType. *) -(* mu.-negligible A == A is mu negligible *) -(* {ae mu, forall x, P x} == P holds almost everywhere for the measure mu *) +(* setI_closed G == the set of sets G is closed under finite *) +(* intersection *) +(* setU_closed G == the set of sets G is closed under finite union *) +(* setC_closed G == the set of sets G is closed under complement *) +(* setD_closed G == the set of sets G is closed under difference *) +(* ndseq_closed G == the set of sets G is closed under non-decreasing *) +(* countable union *) +(* trivIset_closed G == the set of sets G is closed under pairwise-disjoint *) +(* countable union *) +(* ``` *) (* *) -(* {outer_measure set T -> \bar R} == type of an outer measure over sets *) -(* of elements of type T where R is expected to be a *) -(* numFieldType *) -(* isOuterMeasure == corresponding mixin *) -(* OuterMeasure == corresponding structure *) -(* mu.-measurable A == A is Caratheodory measurable for the outer measure *) -(* mu, i.e., *) -(* forall B, mu A = mu (A `&` B) + mu (A `&` ~` B) *) -(* measure_is_complete mu == the measure mu is complete *) +(* ## Hierarchy of s-finite, sigma-finite, finite measures *) +(* ``` *) +(* sfinite_measure == predicate for s-finite measure *) +(* functions *) +(* Measure_isSFinite_subdef == mixin for s-finite measures *) +(* SFiniteMeasure == structure of s-finite measures *) +(* {sfinite_measure set T -> \bar R} == type of s-finite measures *) +(* Measure_isSFinite == factory for s-finite measures *) +(* sfinite_measure_seq mu == the sequence of finite measures of *) +(* the s-finite measure mu *) (* *) -(* * Caratheodory theorem (from an outer measure to a measure): *) -(* caratheodory_type mu := T, where mu : {outer_measure set T -> \bar R} *) -(* it is a canonical mesurableType copy of T *) -(* the restriction of the outer measure mu to the *) -(* sigma algebra of Caratheodory measurable sets is a *) -(* measure *) -(* Remark: sets that are negligible for *) -(* this measure are Caratheodory measurable *) +(* sigma_finite A f == the measure function f is *) +(* sigma-finite on the set A:set T *) +(* with T : semiRingOfSetsType *) +(* isSigmaFinite == mixin corresponding to *) +(* sigma finiteness *) +(* {sigma_finite_content set T -> \bar R} == contents that are also sigma *) +(* finite *) +(* {sigma_finite_measure set T -> \bar R} == measures that are also sigma *) +(* finite *) +(* *) +(* fin_num_fun == predicate for finite function over measurable sets *) +(* SigmaFinite_isFinite == mixin for finite measures *) +(* FiniteMeasure == structure of finite measures *) +(* Measure_isFinite == factory for finite measures *) +(* *) +(* mfrestr mD muDoo == finite measure corresponding to the restriction of *) +(* the measure mu over D with mu D < +oo, *) +(* mD : measurable D, muDoo : mu D < +oo *) +(* *) +(* FiniteMeasure_isSubProbability == mixin corresponding to subprobability *) +(* SubProbability == structure of subprobability *) +(* subprobability T R == subprobability measure over the *) +(* measurableType T with value *) +(* in R : realType *) +(* Measure_isSubProbability == factory for subprobability measures *) +(* *) +(* isProbability == mixin corresponding to probability measures *) +(* Probability == structure of probability measures *) +(* probability T R == probability measure over the *) +(* measurableType T with value in R : realType *) +(* Measure_isProbability == factor for probability measures *) +(* *) +(* monotone_class D G == G is a monotone class of subsets of D *) +(* <> == monotone class generated by G on D *) +(* <> := <> *) +(* dynkin G == G is a set of sets that form a Dynkin *) +(* (or a lambda) system *) +(* <> == Dynkin system generated by G, i.e., *) +(* smallest dynkin G *) (* *) -(* * Caratheodory theorem (from a premeasure to an outer measure): *) -(* measurable_cover X == the set of sequences F such that *) -(* - forall k, F k is measurable *) -(* - X `<=` \bigcup_k (F k) *) -(* mu^* == extension of the measure mu over a semiring of *) -(* sets; it is an outer measure, declared as; we have *) -(* the notation [the outer_measure of mu^*]) *) +(* measurable_fun D f == the function f with domain D is measurable *) +(* preimage_class D f G == class of the preimages by f of sets in G *) +(* image_class D f G == class of the sets with a preimage by f in G *) (* *) -(* * Hahn Extension: *) -(* Hahn_ext mu == extension of the content mu over a semiring of *) -(* sets to a measure over the generated sigma algebra *) -(* (requires a proof of sigma-sub-additivity) *) +(* mu.-negligible A == A is mu negligible *) +(* measure_is_complete mu == the measure mu is complete *) +(* {ae mu, forall x, P x} == P holds almost everywhere for the measure mu, *) +(* declared as an instance of the type of filters *) +(* ae_eq D f g == f is equal to g almost everywhere *) +(* ``` *) (* *) -(* * Product of measurable spaces: *) -(* preimage_classes f1 f2 == sigma-algebra generated by the union of the *) -(* preimages by f1 and the preimages by f2 with *) -(* f1 : T -> T1 and f : T -> T2, T1 and T2 being *) -(* measurableType's *) +(* ## Measure extension theorem *) +(* *) +(* From a premeasure to an outer measure (Measure Extension Theorem part 1): *) +(* ``` *) +(* measurable_cover X == the set of sequences F such that *) +(* - forall k, F k is measurable *) +(* - X `<=` \bigcup_k (F k) *) +(* mu^* == extension of the measure mu over a semiring of *) +(* sets (it is an outer measure) *) +(* ``` *) +(* From an outer measure to a measure (Measure Extension Theorem part 2): *) +(* ``` *) +(* mu.-caratheodory == the set of Caratheodory measurable sets for the *) +(* outer measure mu, i.e., sets A such that *) +(* forall B, mu A = mu (A `&` B) + mu (A `&` ~` B) *) +(* caratheodory_type mu := T, where mu : {outer_measure set T -> \bar R} *) +(* It is a canonical mesurableType copy of T. *) +(* The restriction of the outer measure mu to the *) +(* sigma algebra of Caratheodory measurable sets is a *) +(* measure. *) +(* Remark: sets that are negligible for *) +(* this measure are Caratheodory measurable. *) +(* ``` *) +(* Measure Extension Theorem: *) +(* ``` *) +(* measure_extension mu == extension of the content mu over a semiring of *) +(* sets to a measure over the generated *) +(* sigma algebra (requires a proof of *) +(* sigma-sub-additivity) *) +(* ``` *) +(* *) +(* ## Product of measurable spaces *) +(* ``` *) +(* preimage_classes f1 f2 == sigma-algebra generated by the union of *) +(* the preimages by f1 and the preimages by *) +(* f2 with f1 : T -> T1 and f : T -> T2, T1 *) +(* and T2 being measurableType's *) (* (d1, d2).-prod.-measurable A == A is measurable for the sigma-algebra *) -(* generated from T1 x T2, with T1 and T2 *) -(* measurableType's with resp. display d1 and d2 *) +(* generated from T1 x T2, with T1 and T2 *) +(* measurableType's with resp. display d1 *) +(* and d2 *) +(* ``` *) +(* *) +(* ## Others *) +(* ``` *) +(* m1 `<< m2 == m1 is absolutely continuous w.r.t. m2 or m2 dominates m1 *) +(* ess_sup f == essential supremum of the function f : T -> R where T is a *) +(* measurableType and R is a realType *) +(* ``` *) (* *) -(* probability T R == probability measure over the measurableType T with *) -(* value in R : realType *) (******************************************************************************) Set Implicit Arguments. @@ -215,6 +326,7 @@ Reserved Notation "[ 'outer_measure' 'of' f ]" Reserved Notation "p .-prod" (at level 1, format "p .-prod"). Reserved Notation "p .-prod.-measurable" (at level 2, format "p .-prod.-measurable"). +Reserved Notation "m1 `<< m2" (at level 51). Inductive measure_display := default_measure_display. Declare Scope measure_display_scope. @@ -637,21 +749,17 @@ Qed. End dynkin_lemmas. HB.mixin Record isSemiRingOfSets (d : measure_display) T := { - ptclass : Pointed.class_of T; measurable : set (set T) ; measurable0 : measurable set0 ; measurableI : setI_closed measurable; semi_measurableD : semi_setD_closed measurable; }. -#[short(type=semiRingOfSetsType)] -HB.structure Definition SemiRingOfSets d := {T of isSemiRingOfSets d T}. +#[short(type="semiRingOfSetsType")] +HB.structure Definition SemiRingOfSets d := + {T of Pointed T & isSemiRingOfSets d T}. -Canonical semiRingOfSets_eqType d (T : semiRingOfSetsType d) := EqType T ptclass. -Canonical semiRingOfSets_choiceType d (T : semiRingOfSetsType d) := - ChoiceType T ptclass. -Canonical semiRingOfSets_ptType d (T : semiRingOfSetsType d) := - PointedType T ptclass. +Arguments measurable {d}%measure_display_scope {s} _%classical_set_scope. Lemma measurable_curry (T1 T2 : Type) d (T : semiRingOfSetsType d) (G : T1 * T2 -> set T) (x : T1 * T2) : @@ -662,46 +770,32 @@ Notation "d .-measurable" := (@measurable d%mdisp) : classical_set_scope. Notation "'measurable" := (@measurable default_measure_display) : classical_set_scope. -HB.mixin Record RingOfSets_from_semiRingOfSets d T of isSemiRingOfSets d T := { - measurableU : setU_closed (@measurable d [the semiRingOfSetsType d of T]) }. +HB.mixin Record SemiRingOfSets_isRingOfSets d T of SemiRingOfSets d T := { + measurableU : @setU_closed T measurable +}. -#[short(type=ringOfSetsType)] +#[short(type="ringOfSetsType")] HB.structure Definition RingOfSets d := - {T of RingOfSets_from_semiRingOfSets d T & SemiRingOfSets d T}. - -Canonical ringOfSets_eqType d (T : ringOfSetsType d) := EqType T ptclass. -Canonical ringOfSets_choiceType d (T : ringOfSetsType d) := ChoiceType T ptclass. -Canonical ringOfSets_ptType d (T : ringOfSetsType d) := PointedType T ptclass. + {T of SemiRingOfSets_isRingOfSets d T & SemiRingOfSets d T}. -HB.mixin Record AlgebraOfSets_from_RingOfSets d T of RingOfSets d T := { +HB.mixin Record RingOfSets_isAlgebraOfSets d T of RingOfSets d T := { measurableT : measurable [set: T] }. -#[short(type=algebraOfSetsType)] +#[short(type="algebraOfSetsType")] HB.structure Definition AlgebraOfSets d := - {T of AlgebraOfSets_from_RingOfSets d T & RingOfSets d T}. + {T of RingOfSets_isAlgebraOfSets d T & RingOfSets d T}. -Canonical algebraOfSets_eqType d (T : algebraOfSetsType d) := EqType T ptclass. -Canonical algebraOfSets_choiceType d (T : algebraOfSetsType d) := - ChoiceType T ptclass. -Canonical algebraOfSets_ptType d (T : algebraOfSetsType d) := - PointedType T ptclass. - -HB.mixin Record Measurable_from_algebraOfSets d T of AlgebraOfSets d T := { +HB.mixin Record AlgebraOfSets_isMeasurable d T of AlgebraOfSets d T := { bigcupT_measurable : forall F : (set T)^nat, (forall i, measurable (F i)) -> measurable (\bigcup_i (F i)) }. -#[short(type=measurableType)] +#[short(type="measurableType")] HB.structure Definition Measurable d := - {T of Measurable_from_algebraOfSets d T & AlgebraOfSets d T}. - -Canonical measurable_eqType d (T : measurableType d) := EqType T ptclass. -Canonical measurable_choiceType d (T : measurableType d) := ChoiceType T ptclass. -Canonical measurable_ptType d (T : measurableType d) := PointedType T ptclass. + {T of AlgebraOfSets_isMeasurable d T & AlgebraOfSets d T}. -HB.factory Record isRingOfSets (d : measure_display) T := { - ptclass : Pointed.class_of T; +HB.factory Record isRingOfSets (d : measure_display) T of Pointed T := { measurable : set (set T) ; measurable0 : measurable set0 ; measurableU : setU_closed measurable; @@ -721,16 +815,14 @@ move=> A B Am Bm; exists [set A `\` B]; split; rewrite ?bigcup_set1//. by move=> X Y -> ->. Qed. -HB.instance Definition T_isSemiRingOfSets := - @isSemiRingOfSets.Build d T ptclass measurable measurable0 mI mD. +HB.instance Definition _ := + @isSemiRingOfSets.Build d T measurable measurable0 mI mD. -HB.instance Definition T_isRingOfSets := - RingOfSets_from_semiRingOfSets.Build d T measurableU. +HB.instance Definition _ := SemiRingOfSets_isRingOfSets.Build d T measurableU. HB.end. -HB.factory Record isAlgebraOfSets (d : measure_display) T := { - ptclass : Pointed.class_of T; +HB.factory Record isAlgebraOfSets (d : measure_display) T of Pointed T := { measurable : set (set T) ; measurable0 : measurable set0 ; measurableU : setU_closed measurable; @@ -745,19 +837,17 @@ move=> A B mA mB; rewrite setDE -[A]setCK -setCU. by do ?[apply: measurableU | apply: measurableC]. Qed. -HB.instance Definition T_isRingOfSets := @isRingOfSets.Build d T ptclass +HB.instance Definition T_isRingOfSets := @isRingOfSets.Build d T measurable measurable0 measurableU mD. -Lemma measurableT : measurable (@setT T). +Lemma measurableT : measurable [set: T]. Proof. by rewrite -setC0; apply: measurableC; exact: measurable0. Qed. -HB.instance Definition T_isAlgebraOfSets : AlgebraOfSets_from_RingOfSets d T := - AlgebraOfSets_from_RingOfSets.Build d T measurableT. +HB.instance Definition _ := RingOfSets_isAlgebraOfSets.Build d T measurableT. HB.end. -HB.factory Record isMeasurable (d : measure_display) T := { - ptclass : Pointed.class_of T; +HB.factory Record isMeasurable (d : measure_display) T of Pointed T := { measurable : set (set T) ; measurable0 : measurable set0 ; measurableC : forall A, measurable A -> measurable (~` A) ; @@ -777,11 +867,11 @@ Qed. Lemma mC : setC_closed measurable. Proof. by move=> *; apply: measurableC. Qed. -HB.instance Definition T_isAlgebraOfSets := - @isAlgebraOfSets.Build d T ptclass measurable measurable0 mU mC. +HB.instance Definition _ := @isAlgebraOfSets.Build d T + measurable measurable0 mU mC. -HB.instance Definition T_isMeasurable := - @Measurable_from_algebraOfSets.Build d T measurable_bigcup. +HB.instance Definition _ := + @AlgebraOfSets_isMeasurable.Build d T measurable_bigcup. HB.end. @@ -891,8 +981,10 @@ Let discrete_measurableU (F : (set unit)^nat) : discrete_measurable_unit (\bigcup_i F i). Proof. by []. Qed. +HB.instance Definition _ := isPointed.Build unit tt. + HB.instance Definition _ := @isMeasurable.Build default_measure_display unit - (Pointed.class _) discrete_measurable_unit discrete_measurable0 + discrete_measurable_unit discrete_measurable0 discrete_measurableC discrete_measurableU. End discrete_measurable_unit. @@ -913,7 +1005,7 @@ Let discrete_measurableU (F : (set bool)^nat) : Proof. by []. Qed. HB.instance Definition _ := @isMeasurable.Build default_measure_display bool - (Pointed.class _) discrete_measurable_bool discrete_measurable0 + discrete_measurable_bool discrete_measurable0 discrete_measurableC discrete_measurableU. End discrete_measurable_bool. @@ -933,9 +1025,8 @@ Let discrete_measurable_natU (F : (set nat)^nat) : discrete_measurable_nat (\bigcup_i F i). Proof. by []. Qed. -HB.instance Definition _ := @isMeasurable.Build default_measure_display nat - (Pointed.class _) discrete_measurable_nat discrete_measurable_nat0 - discrete_measurable_natC discrete_measurable_natU. +HB.instance Definition _ := isMeasurable.Build default_measure_display nat + discrete_measurable_nat0 discrete_measurable_natC discrete_measurable_natU. End discrete_measurable_nat. @@ -950,11 +1041,9 @@ Variables (T : pointedType) (G : set (set T)). Lemma sigma_algebraC (A : set T) : <> A -> <> (~` A). Proof. by move=> sGA; rewrite -setTD; exact: sigma_algebraCD. Qed. -Canonical salgebraType_eqType := EqType (salgebraType G) (Equality.class T). -Canonical salgebraType_choiceType := ChoiceType (salgebraType G) (Choice.class T). -Canonical salgebraType_ptType := PointedType (salgebraType G) (Pointed.class T). +HB.instance Definition _ := Pointed.on (salgebraType G). HB.instance Definition _ := @isMeasurable.Build (sigma_display G) - (salgebraType G) (Pointed.class T) + (salgebraType G) <> (@sigma_algebra0 _ setT G) (@sigma_algebraC) (@sigma_algebra_bigcup _ setT G). @@ -977,10 +1066,10 @@ Context d1 d2 d3 (T1 : measurableType d1) (T2 : measurableType d2) (T3 : measurableType d3). Implicit Type D E : set T1. -Lemma measurable_fun_id D : measurable_fun D id. +Lemma measurable_id D : measurable_fun D id. Proof. by move=> mD A mA; apply: measurableI. Qed. -Lemma measurable_fun_comp F (f : T2 -> T3) E (g : T1 -> T2) : +Lemma measurable_comp F (f : T2 -> T3) E (g : T1 -> T2) : measurable F -> g @` E `<=` F -> measurable_fun F f -> measurable_fun E g -> measurable_fun E (f \o g). Proof. @@ -992,35 +1081,40 @@ rewrite (_ : _ `&` _ = E `&` g @^-1` (F `&` f @^-1` A)); last first. by apply/mg => //; exact: mf. Qed. -Lemma measurable_funT_comp (f : T2 -> T3) E (g : T1 -> T2) : +Lemma measurableT_comp (f : T2 -> T3) E (g : T1 -> T2) : measurable_fun setT f -> measurable_fun E g -> measurable_fun E (f \o g). -Proof. exact: measurable_fun_comp. Qed. +Proof. exact: measurable_comp. Qed. Lemma eq_measurable_fun D (f g : T1 -> T2) : {in D, f =1 g} -> measurable_fun D f -> measurable_fun D g. Proof. -move=> Dfg Df mD A mA; rewrite (_ : D `&` _ = D `&` f @^-1` A); first exact: Df. -apply/seteqP; rewrite /preimage; split => [x /= [Dx Agx]|x /= [Dx Afx]]. - by split=> //; rewrite Dfg// inE. -by split=> //; rewrite -Dfg// inE. +by move=> fg mf mD A mA; rewrite [X in measurable X](_ : _ = D `&` f @^-1` A); + [exact: mf|exact/esym/eq_preimage]. Qed. -Lemma measurable_fun_cst D (r : T2) : measurable_fun D (cst r : T1 -> _). +Lemma measurable_cst D (r : T2) : measurable_fun D (cst r : T1 -> _). Proof. by move=> mD /= Y mY; rewrite preimage_cst; case: ifPn; rewrite ?setIT ?setI0. Qed. -Lemma measurable_funU D E (f : T1 -> T2) : - measurable D -> measurable E -> +Lemma measurable_fun_bigcup (E : (set T1)^nat) (f : T1 -> T2) : + (forall i, measurable (E i)) -> + measurable_fun (\bigcup_i E i) f <-> (forall i, measurable_fun (E i) f). +Proof. +move=> mE; split => [|mf /= _ A mA]; last first. + by rewrite setI_bigcupl; apply: bigcup_measurable => i _; exact: mf. +move=> mf i _ A /mf => /(_ (bigcup_measurable (fun k _ => mE k))). +move=> /(measurableI (E i))-/(_ (mE i)). +by rewrite setICA setIA (@setIidr _ _ (E i))//; exact: bigcup_sup. +Qed. + +Lemma measurable_funU D E (f : T1 -> T2) : measurable D -> measurable E -> measurable_fun (D `|` E) f <-> measurable_fun D f /\ measurable_fun E f. Proof. -move=> mD mE; split=> [mDEf|[mDf mEf] mDE A mA]; last first. - by rewrite setIUl; apply: measurableU; [exact: mDf|exact: mEf]. -split. -- move=> {}mD A /mDEf => /(_ (measurableU _ _ mD mE))/(measurableI D)-/(_ mD). - by rewrite setICA setIA setUK. -- move=> {}mE A /mDEf => /(_ (measurableU _ _ mD mE))/(measurableI E)-/(_ mE). - by rewrite setICA setIA setUC setUK. +move=> mD mE; rewrite -bigcup2E; apply: (iff_trans (measurable_fun_bigcup _ _)). + by move=> [//|[//|//=]]. +split=> [mf|[Df Dg] [//|[//|/= _ _ Y mY]]]; last by rewrite set0I. +by split; [exact: (mf 0%N)|exact: (mf 1%N)]. Qed. Lemma measurable_funS E D (f : T1 -> T2) : @@ -1038,13 +1132,6 @@ Lemma measurable_funTS D (f : T1 -> T2) : measurable_fun setT f -> measurable_fun D f. Proof. exact: measurable_funS. Qed. -Lemma measurable_fun_ext D (f g : T1 -> T2) : - {in D, f =1 g} -> measurable_fun D f -> measurable_fun D g. -Proof. -by move=> fg mf mD A mA; rewrite [X in measurable X](_ : _ = D `&` f @^-1` A); - [exact: mf|exact/esym/eq_preimage]. -Qed. - Lemma measurable_restrict D E (f : T1 -> T2) : measurable D -> measurable E -> D `<=` E -> measurable_fun D f <-> measurable_fun E (f \_ D). @@ -1067,13 +1154,13 @@ Lemma measurable_fun_if (g h : T1 -> T2) D (mD : measurable D) measurable_fun D (fun t => if f t then g t else h t). Proof. move=> mx my /= _ B mB; rewrite (_ : _ @^-1` B = - ((f @^-1` [set true]) `&` (g @^-1` B) `&` (f @^-1` [set true])) `|` - ((f @^-1` [set false]) `&` (h @^-1` B) `&` (f @^-1` [set false]))). + ((f @^-1` [set true]) `&` (g @^-1` B)) `|` + ((f @^-1` [set false]) `&` (h @^-1` B))). rewrite setIUr; apply: measurableU. - - by rewrite setIAC setIid setIA; apply: mx => //; exact: mf. - - by rewrite setIAC setIid setIA; apply: my => //; exact: mf. -apply/seteqP; split=> [t /=| t]; first by case: ifPn => ft; [left|right]. -by move=> /= [|]; case: ifPn => ft; case=> -[]. + - by rewrite setIA; apply: mx => //; exact: mf. + - by rewrite setIA; apply: my => //; exact: mf. +apply/seteqP; split=> [t /=| t /= [] [] ->//]. +by case: ifPn => ft; [left|right]. Qed. Lemma measurable_fun_ifT (g h : T1 -> T2) (f : T1 -> bool) @@ -1103,8 +1190,24 @@ have [-> _|-> _|-> _ |-> _] := subset_set2 YT. Qed. End measurable_fun. -Arguments measurable_fun_ext {d1 d2 T1 T2 D} f {g}. +#[global] Hint Extern 0 (measurable_fun _ (fun=> _)) => + solve [apply: measurable_cst] : core. +#[global] Hint Extern 0 (measurable_fun _ (cst _)) => + solve [apply: measurable_cst] : core. +#[global] Hint Extern 0 (measurable_fun _ id) => + solve [apply: measurable_id] : core. +Arguments eq_measurable_fun {d1 d2 T1 T2 D} f {g}. Arguments measurable_fun_bool {d1 T1 D f} b. +#[deprecated(since="mathcomp-analysis 0.6.2", note="renamed `eq_measurable_fun`")] +Notation measurable_fun_ext := eq_measurable_fun (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.3", note="renamed `measurable_id`")] +Notation measurable_fun_id := measurable_id (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.3", note="renamed `measurable_cst`")] +Notation measurable_fun_cst := measurable_cst (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.3", note="renamed `measurable_comp`")] +Notation measurable_fun_comp := measurable_comp (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.3", note="renamed `measurableT_comp`")] +Notation measurable_funT_comp := measurableT_comp (only parsing). Section measurability. @@ -1215,7 +1318,7 @@ Definition semi_additive := forall F n, Definition semi_sigma_additive := forall F, (forall i : nat, measurable (F i)) -> trivIset setT F -> measurable (\bigcup_n F n) -> - (fun n => \sum_(0 <= i < n) mu (F i)) --> mu (\bigcup_n F n). + (fun n => \sum_(0 <= i < n) mu (F i)) @ \oo --> mu (\bigcup_n F n). Definition additive2 := forall A B, measurable A -> measurable B -> A `&` B = set0 -> mu (A `|` B) = mu A + mu B. @@ -1226,7 +1329,7 @@ Definition additive := Definition sigma_additive := forall F, (forall i : nat, measurable (F i)) -> trivIset setT F -> - (fun n => \sum_(0 <= i < n) mu (F i)) --> mu (\bigcup_n F n). + (fun n => \sum_(0 <= i < n) mu (F i)) @ \oo --> mu (\bigcup_n F n). Definition sub_additive := forall (A : set T) (F : nat -> set T) n, (forall k, `I_n k -> measurable (F k)) -> measurable A -> @@ -1238,10 +1341,6 @@ Definition sigma_sub_additive := forall (A : set T) (F : nat -> set T), A `<=` \bigcup_n F n -> mu A <= \sum_(n \bar R) := - exists2 F : (set T)^nat, A = \bigcup_(i : nat) F i & - forall i, measurable (F i) /\ mu (F i) < +oo. - Lemma semi_additiveW : mu set0 = 0 -> semi_additive -> semi_additive2. Proof. move=> mu0 amx A B mA mB + AB; rewrite -bigcup2inE bigcup_mkord. @@ -1280,9 +1379,11 @@ Qed. End ring_additivity. -Lemma semi_sigma_additive_is_additive d - (R : realFieldType (*TODO: numFieldType if possible?*)) - (X : semiRingOfSetsType d) (mu : set X -> \bar R) : +(* NB: realFieldType cannot be weakened to numFieldType in the current + state because cvg_lim requires a topology for \bar R which is + defined for at least realFieldType *) +Lemma semi_sigma_additive_is_additive d (T : semiRingOfSetsType d) + (R : realFieldType) (mu : set T -> \bar R) : mu set0 = 0 -> semi_sigma_additive mu -> semi_additive mu. Proof. move=> mu0 samu A n Am Atriv UAm. @@ -1303,7 +1404,7 @@ by rewrite [X in _ + X]big1 ?adde0// => ?; rewrite -ltn_subRL subnn. Unshelve. all: by end_near. Qed. Lemma semi_sigma_additiveE - (R : numFieldType) d (X : measurableType d) (mu : set X -> \bar R) : + (R : numFieldType) d (T : measurableType d) (mu : set T -> \bar R) : semi_sigma_additive mu = sigma_additive mu. Proof. rewrite propeqE; split=> [amu A mA tA|amu A mA tA mbigcupA]; last exact: amu. @@ -1311,7 +1412,7 @@ by apply: amu => //; exact: bigcupT_measurable. Qed. Lemma sigma_additive_is_additive - (R : realFieldType) d (X : measurableType d) (mu : set X -> \bar R) : + (R : realFieldType) d (T : measurableType d) (mu : set T -> \bar R) : mu set0 = 0 -> sigma_additive mu -> additive mu. Proof. move=> mu0; rewrite -semi_sigma_additiveE -semi_additiveE. @@ -1319,23 +1420,23 @@ exact: semi_sigma_additive_is_additive. Qed. HB.mixin Record isContent d - (R : numFieldType) (T : semiRingOfSetsType d) (mu : set T -> \bar R) := { + (T : semiRingOfSetsType d) (R : numFieldType) (mu : set T -> \bar R) := { measure_ge0 : forall x, 0 <= mu x ; measure_semi_additive : semi_additive mu }. HB.structure Definition Content d - (R : numFieldType) (T : semiRingOfSetsType d) := { - mu & isContent d R T mu }. + (T : semiRingOfSetsType d) (R : numFieldType) := { + mu & isContent d T R mu }. Notation content := Content.type. Notation "{ 'content' 'set' T '->' '\bar' R }" := - (content R T) (at level 36, T, R at next level, + (content T R) (at level 36, T, R at next level, format "{ 'content' 'set' T '->' '\bar' R }") : ring_scope. -Arguments measure_ge0 {d R T} _. +Arguments measure_ge0 {d T R} _. Section content_signed. -Context d (R : numFieldType) (T : semiRingOfSetsType d). +Context d (T : semiRingOfSetsType d) (R : numFieldType). Variable mu : {content set T -> \bar R}. @@ -1347,7 +1448,7 @@ Canonical content_snum S := Signed.mk (content_snum_subproof S). End content_signed. Section content_on_semiring_of_sets. -Context d (R : numFieldType) (T : semiRingOfSetsType d) +Context d (T : semiRingOfSetsType d) (R : numFieldType) (mu : {content set T -> \bar R}). Lemma measure0 : mu set0 = 0. @@ -1412,14 +1513,18 @@ Proof. exact/semi_additiveW. Qed. Hint Resolve measure_semi_additive2 : core. End content_on_semiring_of_sets. -Arguments measure0 {d R T} _. +Arguments measure0 {d T R} _. #[global] Hint Extern 0 - (is_true (0 <= (_ : {content set _ -> \bar _}) _)%E) => + (is_true (0%R <= (_ : {content set _ -> \bar _}) _)%E) => solve [apply: measure_ge0] : core. +#[global] Hint Extern 0 + ((_ : {content set _ -> \bar _}) set0 = 0%R)%E => + solve [apply: measure0] : core. + #[global] -Hint Resolve measure0 measure_semi_additive2 measure_semi_additive : core. +Hint Resolve measure_semi_additive2 measure_semi_additive : core. Section content_on_ring_of_sets. Context d (R : realFieldType)(T : ringOfSetsType d) @@ -1471,17 +1576,16 @@ End content_on_ring_of_sets. #[global] Hint Resolve measureU measure_bigsetU : core. -HB.mixin Record isMeasure0 d - (R : numFieldType) (T : semiRingOfSetsType d) - mu of isContent d R T mu := { +HB.mixin Record Content_isMeasure d (T : semiRingOfSetsType d) + (R : numFieldType) (mu : set T -> \bar R) of Content d mu := { measure_semi_sigma_additive : semi_sigma_additive mu }. #[short(type=measure)] -HB.structure Definition Measure d - (R : numFieldType) (T : semiRingOfSetsType d) := - {mu of isMeasure0 d R T mu & Content d mu}. +HB.structure Definition Measure d (T : semiRingOfSetsType d) + (R : numFieldType) := + {mu of Content_isMeasure d T R mu & Content d mu}. -Notation "{ 'measure' 'set' T '->' '\bar' R }" := (measure R T) +Notation "{ 'measure' 'set' T '->' '\bar' R }" := (measure T%type R) (at level 36, T, R at next level, format "{ 'measure' 'set' T '->' '\bar' R }") : ring_scope. @@ -1497,14 +1601,14 @@ Canonical measure_snum S := Signed.mk (measure_snum_subproof S). End measure_signed. -HB.factory Record isMeasure d - (R : realFieldType) (T : semiRingOfSetsType d) (mu : set T -> \bar R) := { +HB.factory Record isMeasure d (T : semiRingOfSetsType d) (R : realFieldType) + (mu : set T -> \bar R) := { measure0 : mu set0 = 0 ; measure_ge0 : forall x, 0 <= mu x ; measure_semi_sigma_additive : semi_sigma_additive mu }. -HB.builders Context d (R : realFieldType) (T : semiRingOfSetsType d) - (mu : set T -> \bar R) of isMeasure d R T mu. +HB.builders Context d (T : semiRingOfSetsType d) (R : realFieldType) + (mu : set T -> \bar R) of isMeasure _ T R mu. Let semi_additive_mu : semi_additive mu. Proof. @@ -1513,12 +1617,13 @@ apply: semi_sigma_additive_is_additive. - exact: measure_semi_sigma_additive. Qed. -HB.instance Definition _ := isContent.Build d R T mu +HB.instance Definition _ := isContent.Build d T R mu measure_ge0 semi_additive_mu. -HB.instance Definition _ := isMeasure0.Build d R T mu measure_semi_sigma_additive. +HB.instance Definition _ := Content_isMeasure.Build d T R mu + measure_semi_sigma_additive. HB.end. -Lemma eq_measure d (T : measurableType d) (R : realType) +Lemma eq_measure d (T : measurableType d) (R : realFieldType) (m1 m2 : {measure set T -> \bar R}) : (m1 = m2 :> (set T -> \bar R)) -> m1 = m2. Proof. @@ -1539,8 +1644,8 @@ Proof. by move=> Am Atriv /measure_semi_sigma_additive/cvg_lim<-//. Qed. End measure_lemmas. -#[global] Hint Extern 0 (_ set0 = 0) => solve [apply: measure0] : core. -#[global] Hint Extern 0 (is_true (0 <= _)) => solve [apply: measure_ge0] : core. +#[global] Hint Extern 0 (_ set0 = 0%R) => solve [apply: measure0] : core. +#[global] Hint Extern 0 (is_true (0%:E <= _)) => solve [apply: measure_ge0] : core. Section measure_lemmas. Context d (R : realFieldType) (T : measurableType d). @@ -1555,7 +1660,7 @@ Lemma measure_bigcup (D : set nat) F : (forall i, D i -> measurable (F i)) -> trivIset D F -> mu (\bigcup_(n in D) F n) = \sum_(i mF tF; rewrite bigcup_mkcond measure_semi_bigcup. -- by rewrite [in RHS]eseries_mkcond; apply: eq_eseries => n _; case: ifPn. +- by rewrite [in RHS]eseries_mkcond; apply: eq_eseriesr => n _; case: ifPn. - by move=> i; case: ifPn => // /set_mem; exact: mF. - by move/trivIset_mkcond : tF. - by rewrite -bigcup_mkcond; apply: bigcup_measurable. @@ -1567,63 +1672,25 @@ Arguments measure_bigcup {d R T} _ _. #[global] Hint Extern 0 (sigma_additive _) => solve [apply: measure_sigma_additive] : core. -Definition finite_measure d (T : measurableType d) (R : numDomainType) - (mu : set T -> \bar R) := - mu setT < +oo. - -Lemma finite_measure_sigma_finite d (T : measurableType d) (R : realFieldType) - (mu : {measure set T -> \bar R}) : - finite_measure mu -> sigma_finite setT mu. -Proof. -exists (fun i => if i \in [set 0%N] then setT else set0). - by rewrite -bigcup_mkcondr setTI bigcup_const//; exists 0%N. -move=> n; split; first by case: ifPn. -by case: ifPn => // _; rewrite ?measure0//; exact: finite_measure. -Qed. - -HB.mixin Record isSigmaFinite d (R : numFieldType) (T : semiRingOfSetsType d) - (mu : set T -> \bar R) := { - sigma_finiteT : sigma_finite setT mu -}. - -#[short(type="sigma_finite_content")] -HB.structure Definition SigmaFiniteContent d R T := - {mu of isSigmaFinite d R T mu & @Content d R T mu}. -Arguments sigma_finiteT {d R T} s. - -Notation "{ 'sigma_finite_content' 'set' T '->' '\bar' R }" := - (sigma_finite_content R T) - (at level 36, T, R at next level, - format "{ 'sigma_finite_content' 'set' T '->' '\bar' R }") - : ring_scope. - -#[global] -Hint Resolve sigma_finiteT : core. - -#[short(type="sigma_finite_measure")] -HB.structure Definition SigmaFiniteMeasure d R T := - {mu of isSigmaFinite d R T mu & @Measure d R T mu}. - -Notation "{ 'sigma_finite_measure' 'set' T '->' '\bar' R }" := (sigma_finite_measure R T) - (at level 36, T, R at next level, - format "{ 'sigma_finite_measure' 'set' T '->' '\bar' R }") : ring_scope. +Definition pushforward d1 d2 (T1 : measurableType d1) (T2 : measurableType d2) + (R : realFieldType) (m : set T1 -> \bar R) (f : T1 -> T2) + of measurable_fun setT f := fun A => m (f @^-1` A). +Arguments pushforward {d1 d2 T1 T2 R} m {f}. Section pushforward_measure. Local Open Scope ereal_scope. -Context d d' (T1 : measurableType d) (T2 : measurableType d') (f : T1 -> T2). -Variables (R : realFieldType) (m : {measure set T1 -> \bar R}). - -Definition pushforward (mf : measurable_fun setT f) A := m (f @^-1` A). - +Context d d' (T1 : measurableType d) (T2 : measurableType d') + (R : realFieldType). +Variables (m : {measure set T1 -> \bar R}) (f : T1 -> T2). Hypothesis mf : measurable_fun setT f. -Let pushforward0 : pushforward mf set0 = 0. +Let pushforward0 : pushforward m mf set0 = 0. Proof. by rewrite /pushforward preimage_set0 measure0. Qed. -Let pushforward_ge0 A : 0 <= pushforward mf A. +Let pushforward_ge0 A : 0 <= pushforward m mf A. Proof. by apply: measure_ge0; rewrite -[X in measurable X]setIT; apply: mf. Qed. -Let pushforward_sigma_additive : semi_sigma_additive (pushforward mf). +Let pushforward_sigma_additive : semi_sigma_additive (pushforward m mf). Proof. move=> F mF tF mUF; rewrite /pushforward preimage_bigcup. apply: measure_semi_sigma_additive. @@ -1634,7 +1701,7 @@ apply: measure_semi_sigma_additive. Qed. HB.instance Definition _ := isMeasure.Build _ _ _ - (pushforward mf) pushforward0 pushforward_ge0 pushforward_sigma_additive. + (pushforward m mf) pushforward0 pushforward_ge0 pushforward_sigma_additive. End pushforward_measure. @@ -1661,7 +1728,7 @@ move=> F mF tF mUF; rewrite /dirac indicE; have [|aFn] /= := boolP (a \in _). rewrite big_mkord (bigID (xpred1 (Ordinal mn)))//= big_pred1_eq/= big1/=. by rewrite adde0 indicE mem_set//; exact: ballxx. by move=> j ij; rewrite indicE (negbTE (naF _ _)). -rewrite [X in X --> _](_ : _ = cst 0); first exact: cvg_cst. +rewrite [X in X @ \oo --> _](_ : _ = cst 0); first exact: cvg_cst. apply/funext => n; rewrite big1// => i _; rewrite indicE; apply/eqP. by rewrite eqe pnatr_eq0 eqb0; apply: contra aFn => /[!inE] aFn; exists i. Unshelve. all: by end_near. Qed. @@ -1693,6 +1760,13 @@ Section dirac_lemmas. Local Open Scope ereal_scope. Context d (T : measurableType d) (R : realType). +Lemma finite_card_sum (A : set T) : finite_set A -> + \esum_(i in A) 1 = (#|` fset_set A|%:R)%:E :> \bar R. +Proof. +move=> finA; rewrite esum_fset// (eq_fsbigr (cst 1))//. +by rewrite card_fset_sum1// natr_sum -sumEFin fsbig_finite. +Qed. + Lemma finite_card_dirac (A : set T) : finite_set A -> \esum_(i in A) \d_ i A = (#|` fset_set A|%:R)%:E :> \bar R. Proof. @@ -1730,7 +1804,7 @@ Let msum_ge0 B : 0 <= msum B. Proof. by rewrite /msum; apply: sume_ge0. Qed. Let msum_sigma_additive : semi_sigma_additive msum. Proof. move=> F mF tF mUF; rewrite [X in _ --> X](_ : _ = - lim (fun n => \sum_(0 <= i < n) msum (F i))). + lim ((fun n => \sum_(0 <= i < n) msum (F i)) @ \oo)). by apply: is_cvg_ereal_nneg_natsum => k _; exact: sume_ge0. rewrite nneseries_sum//; apply: eq_bigr => /= i _. exact: measure_semi_bigcup. @@ -1754,7 +1828,7 @@ Let mzero_ge0 B : 0 <= mzero B. Proof. by []. Qed. Let mzero_sigma_additive : semi_sigma_additive mzero. Proof. -move=> F mF tF mUF; rewrite [X in X --> _](_ : _ = cst 0); first exact: cvg_cst. +move=> F mF tF mUF; rewrite [X in X @ \oo--> _](_ : _ = cst 0); first exact: cvg_cst. by apply/funext => n; rewrite big1. Qed. @@ -1795,11 +1869,11 @@ Proof. by rewrite /mscale mule_ge0. Qed. Let mscale_sigma_additive : semi_sigma_additive mscale. Proof. -move=> F mF tF mUF; rewrite [X in X --> _](_ : _ = +move=> F mF tF mUF; rewrite [X in X @ \oo --> _](_ : _ = (fun n => (r%:num)%:E * \sum_(0 <= i < n) m (F i))); last first. by apply/funext => k; rewrite ge0_sume_distrr. rewrite /mscale; have [->|r0] := eqVneq r%:num 0%R. - rewrite mul0e [X in X --> _](_ : _ = (fun=> 0)); first exact: cvg_cst. + rewrite mul0e [X in X @ \oo --> _](_ : _ = (fun=> 0)); first exact: cvg_cst. by under eq_fun do rewrite mul0e. by apply: cvgeMl => //; exact: measure_semi_sigma_additive. Qed. @@ -1828,15 +1902,15 @@ Qed. Let mseries_sigma_additive : semi_sigma_additive mseries. Proof. move=> F mF tF mUF; rewrite [X in _ --> X](_ : _ = - lim (fun n => \sum_(0 <= i < n) mseries (F i))); last first. + lim ((fun n => \sum_(0 <= i < n) mseries (F i)) @ \oo)); last first. rewrite [in LHS]/mseries. transitivity (\sum_(n <= k m k (\bigcup_n0 F n0))) => i ni. + apply: (@eq_eseriesr _ (fun k => m k (\bigcup_n0 F n0))) => i ni. exact: measure_semi_bigcup. rewrite ereal_series nneseries_interchange//. - apply: (@eq_eseries R (fun j => \sum_(i \sum_(n <= k \sum_(i \sum_(n <= k i _; rewrite ereal_series. apply: is_cvg_ereal_nneg_natsum => k _. by rewrite /mseries ereal_series; exact: nneseries_ge0. @@ -1857,7 +1931,7 @@ Variables (mu : {measure set T -> \bar R}) (D : set T) (mD : measurable D). Local Notation restr := (mrestr mu mD). -Let restr0 : restr set0 = 0%E. Proof. by rewrite /mrestr set0I measure0. Qed. +Let restr0 : restr set0 = 0%E. Proof. by rewrite /mrestr set0I. Qed. Let restr_ge0 (A : set _) : (0 <= restr A)%E. Proof. by rewrite /restr; apply: measure_ge0; exact: measurableI. Qed. @@ -1878,17 +1952,20 @@ HB.instance Definition _ := isMeasure.Build _ _ _ restr End measure_restr. +Definition counting (T : choiceType) (R : realType) (X : set T) : \bar R := + if `[< finite_set X >] then (#|` fset_set X |)%:R%:E else +oo. +Arguments counting {T R}. + Section measure_count. Context d (T : measurableType d) (R : realType). Variables (D : set T) (mD : measurable D). -Definition counting (X : set T) : \bar R := - if `[< finite_set X >] then (#|` fset_set X |)%:R%:E else +oo. +Local Notation counting := (@counting T R). Let counting0 : counting set0 = 0. Proof. by rewrite /counting asboolT// fset_set0. Qed. -Let counting_ge0 (A : set _) : 0 <= counting A. +Let counting_ge0 (A : set T) : 0 <= counting A. Proof. by rewrite /counting; case: ifPn; rewrite ?lee_fin// lee_pinfty. Qed. Let counting_sigma_additive : semi_sigma_additive counting. @@ -1901,7 +1978,7 @@ have [[i Fi]|infinF] := pselect (exists k, infinite_set (F k)). apply/cvgeyPge => M; near=> n. have ni : (i < n)%N by near: n; exists i.+1. rewrite (bigID (xpred1 i))/= big_mkord (big_pred1 (Ordinal ni))//=. - rewrite [X in X + _]/counting asboolF// addye ?leey//. + rewrite [X in X + _]/(counting _) asboolF// addye ?leey//. by rewrite gt_eqF// (@lt_le_trans _ _ 0)//; exact: sume_ge0. have {infinF}finF : forall i, finite_set (F i) by exact/not_forallP. pose u : nat^nat := fun n => #|` fset_set (F n) |. @@ -1909,7 +1986,7 @@ have sumFE n : \sum_(i < n) counting (F i) = #|` fset_set (\big[setU/set0]_(k < n) F k) |%:R%:E. rewrite -trivIset_sum_card// natr_sum -sumEFin. by apply: eq_bigr => // i _; rewrite /counting asboolT. -have [cvg_u|dvg_u] := pselect (cvg (nseries u)). +have [cvg_u|dvg_u] := pselect (cvg (nseries u @ \oo)). have [N _ Nu] : \forall n \near \oo, u n = 0%N by apply: cvg_nseries_near. rewrite [X in _ --> X](_ : _ = \sum_(i < N) counting (F i)); last first. have -> : \bigcup_i (F i) = \big[setU/set0]_(i < N) F i. @@ -1925,7 +2002,7 @@ have [cvg_u|dvg_u] := pselect (cvg (nseries u)). by rewrite -{1}(subn0 N) big_mkord. rewrite add0n big_seq big1// => i /[!mem_iota] => /andP[NI iNn]. by rewrite /counting asboolT//= -/(u _) Nu. -have {dvg_u}cvg_F : (fun n => \sum_(i < n) counting (F i)) --> +oo. +have {dvg_u}cvg_F : (fun n => \sum_(i < n) counting (F i)) @ \oo --> +oo. rewrite (_ : (fun n => _) = [sequence (\sum_(0 <= i < n) (u i))%:R%:E]_n). exact/cvgenyP/dvg_nseries. apply/funext => n /=; under eq_bigr. @@ -1950,15 +2027,6 @@ HB.instance Definition _ := isMeasure.Build _ _ _ counting End measure_count. -Lemma sigma_finite_counting (R : realType) : - sigma_finite [set: nat] (counting R). -Proof. -exists (fun n => `I_n.+1); first by apply/seteqP; split=> //x _; exists x => /=. -by move=> k; split => //; rewrite /counting/= asboolT// ltry. -Qed. -HB.instance Definition _ R := - @isSigmaFinite.Build _ _ _ (counting R) (sigma_finite_counting R). - Lemma big_trivIset (I : choiceType) D T (R : Type) (idx : R) (op : Monoid.com_law idx) (A : I -> set T) (F : set T -> R) : finite_set D -> trivIset D A -> F set0 = idx -> @@ -2053,11 +2121,10 @@ Section SetRing. Context d {T : semiRingOfSetsType d}. Notation rT := (type T). -Canonical ring_eqType := EqType rT ptclass. -Canonical ring_choiceType := ChoiceType rT ptclass. -Canonical ring_ptType := PointedType rT ptclass. #[export] -HB.instance Definition _ := isRingOfSets.Build (display d) rT ptclass +HB.instance Definition _ := Pointed.on rT. +#[export] +HB.instance Definition _ := isRingOfSets.Build (display d) rT (@setring0 T measurable) (@setringU T measurable) (@setringDI T measurable). Local Notation "d .-ring" := (display d) (at level 1, format "d .-ring"). @@ -2080,7 +2147,7 @@ have mdW A : measurable A -> measurable_fin_trivIset A. have mdI : setI_closed measurable_fin_trivIset. move=> _ _ [A [-> Am Afin Atriv]] [B [-> Bm Bfin Btriv]]. rewrite setI_bigcupl; under eq_bigcupr do rewrite setI_bigcupr. - rewrite bigcup_bigcup -(bigcup_image _ _ id). + rewrite -bigcup_setM -(bigcup_image _ _ id). eexists; split; [reflexivity | | exact/finite_image/finite_setM |]. by move=> _ [X [? ?] <-]; apply: measurableI; [apply: Am|apply: Bm]. apply: trivIset_sets => -[a b] [a' b']/= [Xa Xb] [Xa' Xb']; rewrite setIACA. @@ -2099,7 +2166,7 @@ have mdU : fin_trivIset_closed measurable_fin_trivIset. have /(_ _ (set_mem _))/cid-/(all_sig_cond_dep (fun=> set0)) [G /(_ _ (mem_set _))GP] := Fm _ _. under eq_bigcupr => i Di do case: (GP i Di) => ->. - rewrite bigcup_bigcup_dep -(bigcup_image _ _ id); eexists; split=> //. + rewrite -bigcup_setM_dep -(bigcup_image _ _ id); eexists; split=> //. - by move=> _ [i [Di Gi] <-]; have [_ + _ _] := GP i.1 Di; apply. - by apply: finite_image; apply: finite_setMR=> // i Di; have [] := GP i Di. apply: trivIset_sets => -[i X] [j Y] /= [Di Gi] [Dj Gj] XYN0. @@ -2122,6 +2189,9 @@ rewrite -bigcup2inE; apply: mdU => //; last by move=> [|[]]// _; apply: mdDI. by move=> [|[]]// [|[]]//= _ _ []; rewrite setDE ?setIA => X [] []//. Qed. +Lemma measurable_subring : (d.-measurable : set (set T)) `<=` d.-ring.-measurable. +Proof. by rewrite /measurable => X Xmeas /= M /= [_]; apply. Qed. + Lemma ring_finite_set (A : set rT) : measurable A -> exists B : set (set T), [/\ finite_set B, (forall X, B X -> X !=set0), @@ -2273,9 +2343,7 @@ End content. End SetRing. Module Exports. -Canonical ring_eqType. -Canonical ring_choiceType. -Canonical ring_ptType. +HB.reexport. HB.reexport SetRing. End Exports. End SetRing. @@ -2410,7 +2478,7 @@ Import SetRing. Lemma ring_sigma_sub_additive : sigma_sub_additive mu -> sigma_sub_additive Rmu. Proof. move=> muS; move=> /= D A Am Dm Dsub. -rewrite /Rmu -(eq_eseries (fun _ _ => esum_fset _ _))//; last first. +rewrite /Rmu -(eq_eseriesr (fun _ _ => esum_fset _ _))//; last first. by move=> *; exact: decomp_finite_set. rewrite nneseries_esum ?esum_esum//=; last by move=> *; rewrite esum_ge0. set K := _ `*`` _. @@ -2436,8 +2504,8 @@ have mfD i X : X \in decomp D -> measurable (((f^-1)%FUN i).2 `&` X : set T). apply: (@le_trans _ _ (\sum_(i X /[!(andbT,in_fset_set)]; last exact: decomp_finite_set. + rewrite [leLHS]big_seq [leRHS]big_seq. + rewrite lee_sum// => X /[!in_fset_set]; last exact: decomp_finite_set. move=> XD; have Xm := decomp_measurable Dm XD. by apply: muS => // [i|]; [exact: mfD|exact: DXsub]. apply: lee_lim => /=; do ?apply: is_cvg_nneseries=> //. @@ -2458,14 +2526,34 @@ rewrite -measure_fin_bigcup//=. - by move=> X /= XD; apply: sub_gen_smallest; apply: mfD; rewrite inE. Unshelve. all: by end_near. Qed. -Lemma ring_sigma_additive : sigma_sub_additive mu -> semi_sigma_additive Rmu. +Lemma ring_semi_sigma_additive : sigma_sub_additive mu -> semi_sigma_additive Rmu. Proof. move=> mu_sub; apply: content_ring_sigma_additive. by apply: ring_sigma_sub_additive. Qed. +Lemma semiring_sigma_additive : sigma_sub_additive mu -> semi_sigma_additive mu. +Proof. +move=> /ring_semi_sigma_additive Rmu_sigmadd F Fmeas Ftriv cupFmeas. +have Fringmeas i : d.-ring.-measurable (F i) by apply: measurable_subring. +have := Rmu_sigmadd F Fringmeas Ftriv (measurable_subring cupFmeas). +rewrite SetRing.RmuE//. +by under eq_fun do under eq_bigr do rewrite SetRing.RmuE//=. +Qed. + End ring_sigma_sub_additive_content. +#[key="mu"] +HB.factory Record Content_SubSigmaAdditive_isMeasure d + (R : realType) (T : semiRingOfSetsType d) (mu : set T -> \bar R) of Content d mu := { + measure_sigma_sub_additive : sigma_sub_additive mu }. + +HB.builders Context d (R : realType) (T : semiRingOfSetsType d) + (mu : set T -> \bar R) of Content_SubSigmaAdditive_isMeasure d R T mu. + HB.instance Definition _ := Content_isMeasure.Build d T R mu + (semiring_sigma_additive (measure_sigma_sub_additive)). +HB.end. + Section more_premeasure_ring_lemmas. Context d (R : realType) (T : semiRingOfSetsType d). Variable mu : {measure set T -> \bar R}. @@ -2483,7 +2571,7 @@ have DUBm i : measurable (seqDU B i : set (SetRing.type T)). do 1?apply: bigsetU_measurable => *; apply: sub_gen_smallest. rewrite XE; move: (XE); rewrite seqDU_bigcup_eq. under eq_bigcupr do rewrite -[seqDU B _]cover_decomp//. -rewrite bigcup_bigcup_dep; set K := _ `*`` _. +rewrite -bigcup_setM_dep; set K := _ `*`` _. have /ppcard_eqP[f] : (K #= [set: nat])%card. apply: cardMR_eq_nat=> // i; split; last by apply/set0P; rewrite decompN0. exact/finite_set_countable/decomp_finite_set. @@ -2553,6 +2641,21 @@ Qed. End more_premeasure_ring_lemmas. +Lemma measure_sigma_sub_additive_tail d (R : realType) (T : semiRingOfSetsType d) + (mu : {measure set T -> \bar R}) (A : set T) (F : nat -> set T) N : + (forall n, measurable (F n)) -> measurable A -> + A `<=` \bigcup_(n in ~` `I_N) F n -> + (mu A <= \sum_(N <= n mF mA AF; rewrite eseries_cond eseries_mkcondr. +rewrite (@eq_eseriesr _ _ (fun n => mu (if (N <= n)%N then F n else set0))). +- apply: measure_sigma_sub_additive => //. + + by move=> n; case: ifPn. + + move: AF; rewrite bigcup_mkcond. + by under eq_bigcupr do rewrite mem_not_I. +- by move=> o _; rewrite (fun_if mu) measure0. +Qed. + Section ring_sigma_content. Context d (R : realType) (T : semiRingOfSetsType d) (mu : {measure set T -> \bar R}). @@ -2560,35 +2663,410 @@ Local Notation Rmu := (SetRing.measure mu). Import SetRing. Let ring_sigma_content : semi_sigma_additive Rmu. -Proof. exact/ring_sigma_additive/measure_sigma_sub_additive. Qed. +Proof. exact/ring_semi_sigma_additive/measure_sigma_sub_additive. Qed. -HB.instance Definition _ := isMeasure0.Build _ _ _ Rmu +HB.instance Definition _ := Content_isMeasure.Build _ _ _ Rmu ring_sigma_content. End ring_sigma_content. -Lemma measureIl d (R : realFieldType) (T : semiRingOfSetsType d) - (mu : {content set T -> \bar R}) (A B : set T) : - measurable A -> measurable B -> (mu (A `&` B) <= mu A)%E. -Proof. by move=> mA mB; rewrite le_measure ?inE//; apply: measurableI. Qed. +Definition fin_num_fun d (T : semiRingOfSetsType d) (R : numDomainType) + (mu : set T -> \bar R) := forall U, measurable U -> mu U \is a fin_num. -Lemma measureIr d (R : realFieldType) (T : semiRingOfSetsType d) - (mu : {content set T -> \bar R}) (A B : set T) : - measurable A -> measurable B -> (mu (A `&` B) <= mu B)%E. -Proof. by move=> mA mB; rewrite le_measure ?inE//; apply: measurableI. Qed. +Lemma fin_num_fun_lty d (T : algebraOfSetsType d) (R : realFieldType) + (mu : set T -> \bar R) : fin_num_fun mu -> mu setT < +oo. +Proof. by move=> h; rewrite ltey_eq h. Qed. -Lemma subset_measure0 d (T : semiRingOfSetsType d) (R : realType) - (mu : {content set T -> \bar R}) (A B : set T) : - measurable A -> measurable B -> A `<=` B -> - mu B = 0%E -> mu A = 0%E. +Lemma lty_fin_num_fun d (T : algebraOfSetsType d) + (R : realFieldType) (mu : {measure set T -> \bar R}) : + mu setT < +oo -> fin_num_fun mu. Proof. -move=> mA mB AB B0; apply/eqP; rewrite eq_le measure_ge0// ?andbT -?B0. -by apply: le_measure; rewrite ?inE. +move=> h U mU; rewrite fin_real// (lt_le_trans _ (measure_ge0 mu U))//=. +by rewrite (le_lt_trans _ h)//= le_measure// inE. Qed. -Section measureD. -Context d (R : realFieldType) (T : ringOfSetsType d). -Variable mu : {measure set T -> \bar R}. +Definition sfinite_measure d (T : measurableType d) (R : realType) + (mu : set T -> \bar R) := + exists2 s : {measure set T -> \bar R}^nat, + forall n, fin_num_fun (s n) & + forall U, measurable U -> mu U = mseries s 0 U. + +Definition sigma_finite d (T : semiRingOfSetsType d) (R : numDomainType) + (A : set T) (mu : set T -> \bar R) := + exists2 F : (set T)^nat, A = \bigcup_(i : nat) F i & + forall i, measurable (F i) /\ mu (F i) < +oo. + +Lemma fin_num_fun_sigma_finite d (T : algebraOfSetsType d) + (R : realFieldType) (mu : set T -> \bar R) : mu set0 < +oo -> + fin_num_fun mu -> sigma_finite setT mu. +Proof. +move=> muoo; exists (fun i => if i \in [set 0%N] then setT else set0). + by rewrite -bigcup_mkcondr setTI bigcup_const//; exists 0%N. +by move=> n; split; case: ifPn => // _; rewrite fin_num_fun_lty. +Qed. + +Lemma sfinite_measure_sigma_finite d (T : measurableType d) + (R : realType) (mu : {measure set T -> \bar R}) : + sigma_finite setT mu -> sfinite_measure mu. +Proof. +move=> [F UF mF]; rewrite /sfinite_measure. +have mDF k : measurable (seqDU F k). + apply: measurableD; first exact: (mF k).1. + by apply: bigsetU_measurable => i _; exact: (mF i).1. +exists (fun k => [the measure _ _ of mrestr mu (mDF k)]) => [n|U mU]. +- apply: lty_fin_num_fun => //=. + rewrite /mrestr setTI (@le_lt_trans _ _ (mu (F n)))//. + + apply: le_measure; last exact: subDsetl. + * rewrite inE; apply: measurableD; first exact: (mF n).1. + by apply: bigsetU_measurable => i _; exact: (mF i).1. + * by rewrite inE; exact: (mF n).1. + + exact: (mF n).2. +rewrite /mseries/= /mrestr/=; apply/esym/cvg_lim => //. +rewrite -[X in _ --> mu X]setIT UF seqDU_bigcup_eq setI_bigcupr. +apply: (@measure_sigma_additive _ _ _ mu (fun k => U `&` seqDU F k)). + by move=> i; exact: measurableI. +exact/trivIset_setIl/trivIset_seqDU. +Qed. + +HB.mixin Record Measure_isSFinite_subdef d (T : measurableType d) + (R : realType) (mu : set T -> \bar R) := { + sfinite_measure_subdef : sfinite_measure mu }. + +HB.structure Definition SFiniteMeasure + d (T : measurableType d) (R : realType) := + {mu of @Measure _ T R mu & Measure_isSFinite_subdef _ T R mu }. +Arguments sfinite_measure_subdef {d T R} _. + +Notation "{ 'sfinite_measure' 'set' T '->' '\bar' R }" := + (SFiniteMeasure.type T R) (at level 36, T, R at next level, + format "{ 'sfinite_measure' 'set' T '->' '\bar' R }") : ring_scope. + +HB.mixin Record isSigmaFinite d (T : semiRingOfSetsType d) (R : numFieldType) + (mu : set T -> \bar R) := { sigma_finiteT : sigma_finite setT mu }. + +#[short(type="sigma_finite_content")] +HB.structure Definition SigmaFiniteContent d T R := + { mu of isSigmaFinite d T R mu & @Content d T R mu }. + +Arguments sigma_finiteT {d T R} s. +#[global] Hint Resolve sigma_finiteT : core. + +Notation "{ 'sigma_finite_content' 'set' T '->' '\bar' R }" := + (sigma_finite_content T R) (at level 36, T, R at next level, + format "{ 'sigma_finite_content' 'set' T '->' '\bar' R }") + : ring_scope. + +#[short(type="sigma_finite_measure")] +HB.structure Definition SigmaFiniteMeasure d T R := + { mu of @SFiniteMeasure d T R mu & isSigmaFinite d T R mu }. + +Notation "{ 'sigma_finite_measure' 'set' T '->' '\bar' R }" := + (sigma_finite_measure T R) (at level 36, T, R at next level, + format "{ 'sigma_finite_measure' 'set' T '->' '\bar' R }") + : ring_scope. + +HB.factory Record Measure_isSigmaFinite d (T : measurableType d) (R : realType) + (mu : set T -> \bar R) of isMeasure _ _ _ mu := + { sigma_finiteT : sigma_finite setT mu }. + +HB.builders Context d (T : measurableType d) (R : realType) + mu of @Measure_isSigmaFinite d T R mu. + +Lemma sfinite : sfinite_measure mu. +Proof. by apply: sfinite_measure_sigma_finite; exact: sigma_finiteT. Qed. + +HB.instance Definition _ := @Measure_isSFinite_subdef.Build _ _ _ mu sfinite. + +HB.instance Definition _ := @isSigmaFinite.Build _ _ _ mu sigma_finiteT. + +HB.end. + +Lemma sigma_finite_mzero d (T : measurableType d) (R : realType) : + sigma_finite setT (@mzero d T R). +Proof. by apply: fin_num_fun_sigma_finite => //; rewrite measure0. Qed. + +HB.instance Definition _ d (T : measurableType d) (R : realType) := + @isSigmaFinite.Build d T R mzero (@sigma_finite_mzero d T R). + +Lemma sfinite_mzero d (T : measurableType d) (R : realType) : + sfinite_measure (@mzero d T R). +Proof. by apply: sfinite_measure_sigma_finite; exact: sigma_finite_mzero. Qed. + +HB.instance Definition _ d (T : measurableType d) (R : realType) := + @Measure_isSFinite_subdef.Build d T R mzero (@sfinite_mzero d T R). + +HB.mixin Record SigmaFinite_isFinite d (T : semiRingOfSetsType d) + (R : numDomainType) (k : set T -> \bar R) := + { fin_num_measure : fin_num_fun k }. + +HB.structure Definition FinNumFun d (T : semiRingOfSetsType d) + (R : numFieldType) := { k of SigmaFinite_isFinite _ T R k }. + +HB.structure Definition FiniteMeasure d (T : measurableType d) (R : realType) := + { k of @SigmaFiniteMeasure _ _ _ k & SigmaFinite_isFinite _ T R k }. +Arguments fin_num_measure {d T R} _. + +Notation "{ 'finite_measure' 'set' T '->' '\bar' R }" := + (FiniteMeasure.type T R) (at level 36, T, R at next level, + format "{ 'finite_measure' 'set' T '->' '\bar' R }") : ring_scope. + +HB.factory Record Measure_isFinite d (T : measurableType d) + (R : realType) (k : set T -> \bar R) + of isMeasure _ _ _ k := { fin_num_measure : fin_num_fun k }. + +HB.builders Context d (T : measurableType d) (R : realType) k + of Measure_isFinite d T R k. + +Let sfinite : sfinite_measure k. +Proof. +apply: sfinite_measure_sigma_finite. +by apply: fin_num_fun_sigma_finite; [rewrite measure0|exact: fin_num_measure]. +Qed. + +HB.instance Definition _ := @Measure_isSFinite_subdef.Build d T R k sfinite. + +Let sigma_finite : sigma_finite setT k. +Proof. +by apply: fin_num_fun_sigma_finite; [rewrite measure0|exact: fin_num_measure]. +Qed. + +HB.instance Definition _ := @isSigmaFinite.Build d T R k sigma_finite. + +Let finite : fin_num_fun k. Proof. exact: fin_num_measure. Qed. + +HB.instance Definition _ := @SigmaFinite_isFinite.Build d T R k finite. + +HB.end. + +HB.factory Record Measure_isSFinite d (T : measurableType d) + (R : realType) (k : set T -> \bar R) of isMeasure _ _ _ k := { + sfinite_measure_subdef : exists s : {finite_measure set T -> \bar R}^nat, + forall U, measurable U -> k U = mseries s 0 U }. + +HB.builders Context d (T : measurableType d) (R : realType) + k of Measure_isSFinite d T R k. + +Let sfinite : sfinite_measure k. +Proof. +have [s sE] := sfinite_measure_subdef. +by exists s => //=> n; exact: fin_num_measure. +Qed. + +HB.instance Definition _ := @Measure_isSFinite_subdef.Build d T R k sfinite. + +HB.end. + +Section sfinite_measure. +Context d (T : measurableType d) (R : realType) + (mu : {sfinite_measure set T -> \bar R}). + +Let s : (set T -> \bar R)^nat := + let: exist2 x _ _ := cid2 (sfinite_measure_subdef mu) in x. + +Let s0 n : s n set0 = 0. +Proof. by rewrite /s; case: cid2. Qed. + +Let s_ge0 n x : 0 <= s n x. +Proof. by rewrite /s; case: cid2. Qed. + +Let s_semi_sigma_additive n : semi_sigma_additive (s n). +Proof. +by rewrite /s; case: cid2 => s' s'1 s'2; exact: measure_semi_sigma_additive. +Qed. + +HB.instance Definition _ n := @isMeasure.Build _ _ _ (s n) (s0 n) (s_ge0 n) + (@s_semi_sigma_additive n). + +Let s_fin n : fin_num_fun (s n). +Proof. by rewrite /s; case: cid2 => F finF muE; exact: finF. Qed. + +HB.instance Definition _ n := @Measure_isFinite.Build d T R (s n) (s_fin n). + +Definition sfinite_measure_seq : {finite_measure set T -> \bar R}^nat := + fun n => [the {finite_measure set T -> \bar R} of s n]. + +Lemma sfinite_measure_seqP U : measurable U -> + mu U = mseries sfinite_measure_seq O U. +Proof. +by move=> mU; rewrite /mseries /= /s; case: cid2 => // x xfin ->. +Qed. + +End sfinite_measure. + +Definition mfrestr d (T : measurableType d) (R : realFieldType) (D : set T) + (f : set T -> \bar R) (mD : measurable D) of f D < +oo := + mrestr f mD. + +Section measure_frestr. +Context d (T : measurableType d) (R : realType). +Variables (mu : {measure set T -> \bar R}) (D : set T) (mD : measurable D). +Hypothesis moo : mu D < +oo. + +Local Notation restr := (mfrestr mD moo). + +HB.instance Definition _ := Measure.on restr. + +Let restr_fin : fin_num_fun restr. +Proof. +move=> U mU; rewrite /restr /mrestr ge0_fin_numE ?measure_ge0//. +by rewrite (le_lt_trans _ moo)// le_measure// ?inE//; exact: measurableI. +Qed. + +HB.instance Definition _ := Measure_isFinite.Build _ _ _ restr + restr_fin. + +End measure_frestr. + +HB.mixin Record FiniteMeasure_isSubProbability d (T : measurableType d) + (R : realType) (P : set T -> \bar R) := + { sprobability_setT : P setT <= 1%E }. + +#[short(type=subprobability)] +HB.structure Definition SubProbability d (T : measurableType d) (R : realType) + := {mu of @FiniteMeasure d T R mu & FiniteMeasure_isSubProbability d T R mu }. + +HB.factory Record Measure_isSubProbability d (T : measurableType d) + (R : realType) (P : set T -> \bar R) of isMeasure _ _ _ P := + { sprobability_setT : P setT <= 1%E }. + +HB.builders Context d (T : measurableType d) (R : realType) + P of Measure_isSubProbability d T R P. + +Let finite : @Measure_isFinite d T R P. +Proof. +split; apply: lty_fin_num_fun. +by rewrite (le_lt_trans (@sprobability_setT))// ltey. +Qed. + +HB.instance Definition _ := finite. + +HB.instance Definition _ := + @FiniteMeasure_isSubProbability.Build _ _ _ P sprobability_setT. + +HB.end. + +HB.mixin Record isProbability d (T : measurableType d) (R : realType) + (P : set T -> \bar R) := { probability_setT : P setT = 1%E }. + +#[short(type=probability)] +HB.structure Definition Probability d (T : measurableType d) (R : realType) := + {P of @SubProbability d T R P & isProbability d T R P }. + +Section probability_lemmas. +Context d (T : measurableType d) (R : realType) (P : probability T R). + +Lemma probability_le1 (A : set T) : measurable A -> P A <= 1. +Proof. +move=> mA; rewrite -(@probability_setT _ _ _ P). +by apply: le_measure => //; rewrite ?in_setE. +Qed. + +Lemma probability_setC (A : set T) : measurable A -> P (~` A) = 1 - P A. +Proof. +move=> mA. +rewrite -(@probability_setT _ _ _ P) -(setvU A) measureU ?addeK ?setICl//. +- by rewrite fin_num_measure. +- exact: measurableC. +Qed. + +End probability_lemmas. + +HB.factory Record Measure_isProbability d (T : measurableType d) + (R : realType) (P : set T -> \bar R) of isMeasure _ _ _ P := + { probability_setT : P setT = 1%E }. + +HB.builders Context d (T : measurableType d) (R : realType) + P of Measure_isProbability d T R P. + +Let subprobability : @Measure_isSubProbability d T R P. +Proof. by split; rewrite probability_setT. Qed. + +HB.instance Definition _ := subprobability. + +HB.instance Definition _ := @isProbability.Build _ _ _ P probability_setT. + +HB.end. + +Section mnormalize. +Context d (T : measurableType d) (R : realType). +Variables (mu : {measure set T -> \bar R}) (P : probability T R). + +Definition mnormalize := + let evidence := mu [set: T] in + if (evidence == 0) || (evidence == +oo) then fun U => P U + else fun U => mu U * (fine evidence)^-1%:E. + +Let mnormalize0 : mnormalize set0 = 0. +Proof. +by rewrite /mnormalize; case: ifPn => // _; rewrite measure0 mul0e. +Qed. + +Let mnormalize_ge0 U : 0 <= mnormalize U. +Proof. by rewrite /mnormalize; case: ifPn => //; case: ifPn. Qed. + +Let mnormalize_sigma_additive : semi_sigma_additive mnormalize. +Proof. +move=> F mF tF mUF; rewrite /mnormalize/=. +case: ifPn => [_|_]; first exact: measure_semi_sigma_additive. +rewrite [X in X @ _ --> _](_ : _ = (fun n => \sum_(0 <= i < n) mu (F i)) \* + cst (fine (mu setT))^-1%:E); last first. + by apply/funext => n; rewrite -ge0_sume_distrl. +by apply: cvgeMr => //; exact: measure_semi_sigma_additive. +Qed. + +HB.instance Definition _ := isMeasure.Build _ _ _ mnormalize + mnormalize0 mnormalize_ge0 mnormalize_sigma_additive. + +Let mnormalize1 : mnormalize [set: T] = 1. +Proof. +rewrite /mnormalize; case: ifPn; first by rewrite probability_setT. +rewrite negb_or => /andP[ft0 ftoo]. +have ? : mu setT \is a fin_num by rewrite ge0_fin_numE// ltey. +by rewrite -{1}(@fineK _ (mu setT))// -EFinM divrr// ?unitfE fine_eq0. +Qed. + +HB.instance Definition _ := + Measure_isProbability.Build _ _ _ mnormalize mnormalize1. + +End mnormalize. + +Section pdirac. +Context d (T : measurableType d) (R : realType). + +HB.instance Definition _ x := + Measure_isProbability.Build _ _ _ (@dirac _ T x R) (diracT R x). + +End pdirac. + +Lemma sigma_finite_counting (R : realType) : + sigma_finite [set: nat] (@counting _ R). +Proof. +exists (fun n => `I_n.+1); first by apply/seteqP; split=> //x _; exists x => /=. +by move=> k; split => //; rewrite /counting/= asboolT// ltry. +Qed. +HB.instance Definition _ R := + @isSigmaFinite.Build _ _ _ (@counting _ R) (sigma_finite_counting R). + +Section content_semiRingOfSetsType. +Context d (T : semiRingOfSetsType d) (R : realFieldType). +Variables (mu : {content set T -> \bar R}) (A B : set T). +Hypotheses (mA : measurable A) (mB : measurable B). + +Lemma measureIl : mu (A `&` B) <= mu A. +Proof. by rewrite le_measure ?inE//; apply: measurableI. Qed. + +Lemma measureIr : mu (A `&` B) <= mu B. +Proof. by rewrite le_measure ?inE//; apply: measurableI. Qed. + +Lemma subset_measure0 : A `<=` B -> mu B = 0 -> mu A = 0. +Proof. by move=> ? B0; apply/eqP; rewrite -measure_le0 -B0 le_measure ?inE. Qed. + +End content_semiRingOfSetsType. + +Section content_ringOfSetsType. +Context d (T : ringOfSetsType d) (R : realFieldType). +Variable mu : {content set T -> \bar R}. +Implicit Types A B : set T. Lemma measureDI A B : measurable A -> measurable B -> mu A = mu (A `\` B) + mu (A `&` B). @@ -2610,26 +3088,51 @@ rewrite (measureDI mA mB) addeK// fin_numE 1?gt_eqF 1?lt_eqF//. - by rewrite (lt_le_trans _ (measure_ge0 _ _)). Qed. -End measureD. +Lemma measureU2 A B : measurable A -> measurable B -> + mu (A `|` B) <= mu A + mu B. +Proof. +move=> ? ?; rewrite -bigcup2inE bigcup_mkord. +rewrite (le_trans (@content_sub_additive _ _ _ mu _ (bigcup2 A B) 2%N _ _ _))//. +by move=> -[//|[//|[|]]]. +by apply: bigsetU_measurable => -[] [//|[//|[|]]]. +by rewrite big_ord_recr/= big_ord_recr/= big_ord0 add0e. +Qed. -Lemma measureUfinr d (T : ringOfSetsType d) (R : realFieldType) (A B : set T) - (mu : {measure set T -> \bar R}): - measurable A -> measurable B -> (mu B < +oo)%E -> - mu (A `|` B) = (mu A + mu B - mu (A `&` B))%E. +End content_ringOfSetsType. + +Section measureU. +Context d (T : ringOfSetsType d) (R : realFieldType). +Variable mu : {measure set T -> \bar R}. + +Lemma measureUfinr A B : measurable A -> measurable B -> mu B < +oo -> + mu (A `|` B) = mu A + mu B - mu (A `&` B). Proof. move=> Am Bm mBfin; rewrite -[B in LHS](setDUK (@subIsetl _ _ A)) setUA. rewrite [A `|` _]setUidl; last exact: subIsetr. -rewrite measureU//=; do ?by apply:measurableD; do ?apply: measurableI. - rewrite measureD//; do ?exact: measurableI. - by rewrite addeA setIA setIid setIC. -by rewrite setDE setCI setIUr -!setDE setDv set0U setDIK. +rewrite measureU//=; [|rewrite setDIr setDv set0U ?setDIK//..]. +- by rewrite measureD// ?setIA ?setIid 1?setIC ?addeA//; exact: measurableI. +- exact: measurableD. +Qed. + +Lemma measureUfinl A B : measurable A -> measurable B -> mu A < +oo -> + mu (A `|` B) = mu A + mu B - mu (A `&` B). +Proof. by move=> *; rewrite setUC measureUfinr// setIC [mu B + _]addeC. Qed. + +Lemma null_set_setU A B : measurable A -> measurable B -> + mu A = 0 -> mu B = 0 -> mu (A `|` B) = 0. +Proof. +move=> mA mB A0 B0; rewrite measureUfinl/= ?A0//= ?B0 ?add0e. +by apply/eqP; rewrite oppe_eq0 -measure_le0/= -A0 measureIl. Qed. -Lemma measureUfinl d (T : ringOfSetsType d) (R : realFieldType) (A B : set T) - (mu : {measure set T -> \bar R}): - measurable A -> measurable B -> (mu A < +oo)%E -> - mu (A `|` B) = (mu A + mu B - mu (A `&` B))%E. -Proof. by move=> *; rewrite setUC measureUfinr// setIC [(mu B + _)%E]addeC. Qed. +Lemma measureU0 A B : measurable A -> measurable B -> mu B = 0 -> + mu (A `|` B) = mu A. +Proof. +move=> mA mB B0; rewrite measureUfinr/= ?B0// adde0. +by rewrite (@subset_measure0 _ _ _ _ (A `&` B) B) ?sube0//; exact: measurableI. +Qed. + +End measureU. Lemma eq_measureU d (T : ringOfSetsType d) (R : realFieldType) (A B : set T) (mu mu' : {measure set T -> \bar R}): @@ -2638,26 +3141,21 @@ Lemma eq_measureU d (T : ringOfSetsType d) (R : realFieldType) (A B : set T) mu (A `|` B) = mu' (A `|` B). Proof. move=> mA mB muA muB muAB; have [mu'ANoo|] := ltP (mu' A) +oo. - by rewrite !measureUfinl ?muA ?muB ?muAB. + by rewrite !measureUfinl/= ?muA ?muB ?muAB. rewrite leye_eq => /eqP mu'A; transitivity (+oo : \bar R); apply/eqP. by rewrite -leye_eq -mu'A -muA le_measure ?inE//=; apply: measurableU. by rewrite eq_sym -leye_eq -mu'A le_measure ?inE//=; apply: measurableU. Qed. -Lemma null_set_setU d (R : realFieldType) (T : ringOfSetsType d) - (mu : {measure set T -> \bar R}) (A B : set T) : - measurable A -> measurable B -> mu A = 0%E -> mu B = 0%E -> mu (A `|` B) = 0%E. -Proof. -move=> mA mB A0 B0; rewrite measureUfinl ?A0//= ?B0 ?add0e. -apply/eqP; rewrite oppe_eq0 -measure_le0/=; do ?exact: measurableI. -by rewrite -A0 measureIl. -Qed. +Section measure_continuity. -Lemma nondecreasing_cvg_mu d (R : realFieldType) (T : ringOfSetsType d) +Local Open Scope ereal_scope. + +Lemma nondecreasing_cvg_mu d (T : ringOfSetsType d) (R : realFieldType) (mu : {measure set T -> \bar R}) (F : (set T) ^nat) : (forall i, measurable (F i)) -> measurable (\bigcup_n F n) -> nondecreasing_seq F -> - mu \o F --> mu (\bigcup_n F n). + mu \o F @ \oo --> mu (\bigcup_n F n). Proof. move=> mF mbigcupF ndF. have Binter : trivIset setT (seqD F) := trivIset_seqD ndF. @@ -2667,14 +3165,42 @@ rewrite eq_bigcup_seqD. have mB i : measurable (seqD F i) by elim: i => * //=; apply: measurableD. apply: cvg_trans (measure_semi_sigma_additive _ mB Binter _); last first. by rewrite -eq_bigcup_seqD. -apply: (@cvg_trans _ [filter of (fun n => \sum_(i < n.+1) mu (seqD F i))]). - rewrite [X in _ --> X](_ : _ = mu \o F) // funeqE => n. +apply: (@cvg_trans _ ((fun n => \sum_(i < n.+1) mu (seqD F i)) @ \oo)). + rewrite [X in _ --> X @ \oo](_ : _ = mu \o F) // funeqE => n. by rewrite -measure_semi_additive // -?FE// => -[|k]. move=> S [n _] nS; exists n => // m nm. under eq_fun do rewrite -(big_mkord predT (mu \o seqD F)). exact/(nS m.+1)/(leq_trans nm). Qed. +Lemma nonincreasing_cvg_mu d (T : algebraOfSetsType d) (R : realFieldType) + (mu : {measure set T -> \bar R}) (F : (set T) ^nat) : + mu (F 0%N) < +oo -> + (forall i, measurable (F i)) -> measurable (\bigcap_n F n) -> + nonincreasing_seq F -> mu \o F @ \oo --> mu (\bigcap_n F n). +Proof. +move=> F0pos mF mbigcapF niF; pose G n := F O `\` F n. +have ? : mu (F 0%N) \is a fin_num by rewrite ge0_fin_numE. +have F0E r : mu (F 0%N) - (mu (F 0%N) - r) = r. + by rewrite oppeB ?addeA ?subee ?add0e// fin_num_adde_defr. +rewrite -[x in _ --> x] F0E. +have -> : mu \o F = fun n => mu (F 0%N) - (mu (F 0%N) - mu (F n)). + by apply:funext => n; rewrite F0E. +apply: cvgeB; rewrite ?fin_num_adde_defr//; first exact: cvg_cst. +have -> : \bigcap_n F n = F 0%N `&` \bigcap_n F n. + by rewrite setIidr//; exact: bigcap_inf. +rewrite -measureD // setDE setC_bigcap setI_bigcupr -[x in bigcup _ x]/G. +have -> : (fun n => mu (F 0%N) - mu (F n)) = mu \o G. + by apply: funext => n /=; rewrite measureD// setIidr//; exact/subsetPset/niF. +apply: nondecreasing_cvg_mu. +- by move=> ?; apply: measurableD; exact: mF. +- rewrite -setI_bigcupr; apply: measurableI; first exact: mF. + by rewrite -@setC_bigcap; exact: measurableC. +- by move=> n m NM; apply/subsetPset; apply: setDS; apply/subsetPset/niF. +Qed. + +End measure_continuity. + Section boole_inequality. Context d (R : realFieldType) (T : ringOfSetsType d). Variable mu : {content set T -> \bar R}. @@ -2691,7 +3217,7 @@ End boole_inequality. Notation le_mu_bigsetU := Boole_inequality. Section sigma_finite_lemma. -Context d (R : realFieldType) (T : ringOfSetsType d) (A : set T) +Context d (T : ringOfSetsType d) (R : realFieldType) (A : set T) (mu : {content set T -> \bar R}). Lemma sigma_finiteP : sigma_finite A mu -> @@ -2714,8 +3240,8 @@ Qed. End sigma_finite_lemma. Section generalized_boole_inequality. -Context d (R : realType) (T : ringOfSetsType d). -Variable (mu : {measure set T -> \bar R}). +Context d (T : ringOfSetsType d) (R : realType). +Variable mu : {measure set T -> \bar R}. Theorem generalized_Boole_inequality (A : (set T) ^nat) : (forall i, measurable (A i)) -> measurable (\bigcup_n A n) -> @@ -2726,48 +3252,221 @@ End generalized_boole_inequality. Notation le_mu_bigcup := generalized_Boole_inequality. Section negligible. -Context d (R : realFieldType) (T : ringOfSetsType d). +Context d (T : semiRingOfSetsType d) (R : realFieldType). -Definition negligible (mu : set T -> \bar R) (N : set T) := - exists A : set T, [/\ measurable A, mu A = 0 & N `<=` A]. +Definition negligible (mu : set T -> \bar R) N := + exists A, [/\ measurable A, mu A = 0 & N `<=` A]. Local Notation "mu .-negligible" := (negligible mu). -Lemma negligibleP (mu : {content set _ -> \bar _}) A : - measurable A -> mu.-negligible A <-> mu A = 0. +Variable mu : {content set T -> \bar R}. + +Lemma negligibleP A : measurable A -> mu.-negligible A <-> mu A = 0. Proof. move=> mA; split => [[B [mB mB0 AB]]|mA0]; last by exists A; split. -apply/eqP; rewrite eq_le measure_ge0 // andbT -mB0. -by apply: (le_measure mu) => //; rewrite in_setE. +by apply/eqP; rewrite -measure_le0 -mB0 le_measure ?inE. Qed. -Lemma negligible_set0 (mu : {content set _ -> \bar _}) : mu.-negligible set0. +Lemma negligible_set0 : mu.-negligible set0. Proof. exact/negligibleP. Qed. -Lemma measure_negligible (mu : {content set T -> \bar R}) (A : set T) : +Lemma measure_negligible (A : set T) : measurable A -> mu.-negligible A -> mu A = 0%E. Proof. by move=> mA /negligibleP ->. Qed. -Definition almost_everywhere (mu : set T -> \bar R) (P : T -> Prop) - & (phantom Prop (forall x, P x)) := - mu.-negligible (~` [set x | P x]). -Local Notation "{ 'ae' m , P }" := - (almost_everywhere m (inPhantom P)) : type_scope. +Lemma negligibleS A B : B `<=` A -> mu.-negligible A -> mu.-negligible B. +Proof. +by move=> BA [N [mN N0 AN]]; exists N; split => //; exact: subset_trans AN. +Qed. + +Lemma negligibleI A B : + mu.-negligible A -> mu.-negligible B -> mu.-negligible (A `&` B). +Proof. +move=> [N [mN N0 AN]] [M [mM M0 BM]]; exists (N `&` M); split => //. +- exact: measurableI. +- by apply/eqP; rewrite -measure_le0 -N0 le_measure ?inE//; exact: measurableI. +- exact: setISS. +Qed. + +End negligible. +Notation "mu .-negligible" := (negligible mu) : type_scope. + +Definition measure_is_complete d (T : semiRingOfSetsType d) (R : realFieldType) + (mu : set T -> \bar R) := + mu.-negligible `<=` measurable. + +Section negligible_ringOfSetsType. +Context d (T : ringOfSetsType d) (R : realFieldType). +Variable mu : {content set T -> \bar R}. + +Lemma negligibleU A B : + mu.-negligible A -> mu.-negligible B -> mu.-negligible (A `|` B). +Proof. +move=> [N [mN N0 AN]] [M [mM M0 BM]]; exists (N `|` M); split => //. +- exact: measurableU. +- apply/eqP; rewrite -measure_le0 -N0 -[leRHS]adde0 -M0 -bigsetU_bigcup2. + apply: le_trans. + + apply: (@content_sub_additive _ _ _ _ _ (bigcup2 N M) 2%N) => //. + * by move=> [|[|[|]]]. + * apply: bigsetU_measurable => // i _; rewrite /bigcup2. + by case: ifPn => // i0; case: ifPn. + + by rewrite big_ord_recr/= big_ord_recr/= big_ord0 add0e. +- exact: setUSS. +Qed. + +Lemma negligible_bigsetU (F : (set T)^nat) s (P : pred nat) : + (forall k, P k -> mu.-negligible (F k)) -> + mu.-negligible (\big[setU/set0]_(k <- s | P k) F k). +Proof. +by move=> PF; elim/big_ind : _ => //; + [exact: negligible_set0|exact: negligibleU]. +Qed. + +End negligible_ringOfSetsType. + +Lemma negligible_bigcup d (T : measurableType d) (R : realFieldType) + (mu : {measure set T -> \bar R}) (F : (set T)^nat) : + (forall k, mu.-negligible (F k)) -> mu.-negligible (\bigcup_k F k). +Proof. +move=> mF; exists (\bigcup_k sval (cid (mF k))); split. +- by apply: bigcupT_measurable => // k; have [] := svalP (cid (mF k)). +- rewrite seqDU_bigcup_eq measure_bigcup//; last first. + move=> k _; apply: measurableD; first by case: cid => //= A []. + by apply: bigsetU_measurable => i _; case: cid => //= A []. + rewrite eseries0// => k _. + have [mFk mFk0 ?] := svalP (cid (mF k)). + rewrite measureD//=. + + rewrite mFk0 sub0e eqe_oppLRP oppe0; apply/eqP; rewrite -measure_le0. + rewrite -[leRHS]mFk0 le_measure//= ?inE//; apply: measurableI => //. + by apply: bigsetU_measurable => i _; case: cid => // A []. + + by apply: bigsetU_measurable => i _; case: cid => // A []. + + by rewrite mFk0. +- by apply: subset_bigcup => k _; rewrite /sval/=; by case: cid => //= A []. +Qed. + +Section ae. + +Definition almost_everywhere d (T : semiRingOfSetsType d) (R : realFieldType) + (mu : set T -> \bar R) (P : T -> Prop) := mu.-negligible (~` [set x | P x]). + +Let almost_everywhereT d (T : semiRingOfSetsType d) (R : realFieldType) + (mu : {content set T -> \bar R}) : almost_everywhere mu setT. +Proof. by rewrite /almost_everywhere setCT; exact: negligible_set0. Qed. + +Let almost_everywhereS d (T : semiRingOfSetsType d) (R : realFieldType) + (mu : {measure set T -> \bar R}) A B : A `<=` B -> + almost_everywhere mu A -> almost_everywhere mu B. +Proof. by move=> AB; apply: negligibleS; exact: subsetC. Qed. + +Let almost_everywhereI d (T : ringOfSetsType d) (R : realFieldType) + (mu : {measure set T -> \bar R}) A B : + almost_everywhere mu A -> almost_everywhere mu B -> + almost_everywhere mu (A `&` B). +Proof. +by rewrite /almost_everywhere => mA mB; rewrite setCI; exact: negligibleU. +Qed. + +#[global] +Instance ae_filter_ringOfSetsType d {T : ringOfSetsType d} (R : realFieldType) + (mu : {measure set T -> \bar R}) : Filter (almost_everywhere mu). +Proof. +by split; [exact: almost_everywhereT|exact: almost_everywhereI| + exact: almost_everywhereS]. +Qed. + +#[global] +Instance ae_properfilter_algebraOfSetsType d {T : algebraOfSetsType d} + (R : realFieldType) (mu : {measure set T -> \bar R}) : + mu [set: T] > 0 -> ProperFilter (almost_everywhere mu). +Proof. +move=> muT; split=> [|]; last exact: ae_filter_ringOfSetsType. +rewrite /almost_everywhere setC0 => /(measure_negligible measurableT). +by move/eqP; rewrite -measure_le0 leNgt => /negP. +Qed. + +End ae. + +#[global] Hint Extern 0 (Filter (almost_everywhere _)) => + (apply: ae_filter_ringOfSetsType) : typeclass_instances. -Lemma aeW (mu : {measure set _ -> \bar _}) (P : T -> Prop) : +#[global] Hint Extern 0 (ProperFilter (almost_everywhere _)) => + (apply: ae_properfilter_algebraOfSetsType) : typeclass_instances. + +Definition almost_everywhere_notation d (T : semiRingOfSetsType d) + (R : realFieldType) (mu : set T -> \bar R) (P : T -> Prop) + & (phantom Prop (forall x, P x)) := almost_everywhere mu P. +Notation "{ 'ae' m , P }" := + (almost_everywhere_notation m (inPhantom P)) : type_scope. + +Lemma aeW {d} {T : semiRingOfSetsType d} {R : realFieldType} + (mu : {measure set _ -> \bar R}) (P : T -> Prop) : (forall x, P x) -> {ae mu, forall x, P x}. Proof. move=> aP; have -> : P = setT by rewrite predeqE => t; split. by apply/negligibleP; [rewrite setCT|rewrite setCT measure0]. Qed. -End negligible. +Section ae_eq. +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType). +Variables (mu : {measure set T -> \bar R}) (D : set T). +Implicit Types f g h i : T -> \bar R. -Notation "mu .-negligible" := (negligible mu) : type_scope. +Definition ae_eq f g := {ae mu, forall x, D x -> f x = g x}. + +Lemma ae_eq0 f g : measurable D -> mu D = 0 -> ae_eq f g. +Proof. by move=> mD D0; exists D; split => // t/= /not_implyP[]. Qed. + +Lemma ae_eq_comp (j : \bar R -> \bar R) f g : + ae_eq f g -> ae_eq (j \o f) (j \o g). +Proof. by apply: filterS => x /[apply] /= ->. Qed. + +Lemma ae_eq_funeposneg f g : ae_eq f g <-> ae_eq f^\+ g^\+ /\ ae_eq f^\- g^\-. +Proof. +split=> [fg|[]]. + by rewrite /funepos /funeneg; split; apply: filterS fg => x /[apply] ->. +apply: filterS2 => x + + Dx => /(_ Dx) fg /(_ Dx) gf. +by rewrite (funeposneg f) (funeposneg g) fg gf. +Qed. + +Lemma ae_eq_refl f : ae_eq f f. Proof. exact/aeW. Qed. + +Lemma ae_eq_sym f g : ae_eq f g -> ae_eq g f. +Proof. by apply: filterS => x + Dx => /(_ Dx). Qed. + +Lemma ae_eq_trans f g h : ae_eq f g -> ae_eq g h -> ae_eq f h. +Proof. by apply: filterS2 => x + + Dx => /(_ Dx) ->; exact. Qed. + +Lemma ae_eq_sub f g h i : ae_eq f g -> ae_eq h i -> ae_eq (f \- h) (g \- i). +Proof. by apply: filterS2 => x + + Dx => /(_ Dx) -> /(_ Dx) ->. Qed. + +Lemma ae_eq_mul2r f g h : ae_eq f g -> ae_eq (f \* h) (g \* h). +Proof. by apply: filterS => x /[apply] ->. Qed. + +Lemma ae_eq_mul2l f g h : ae_eq f g -> ae_eq (h \* f) (h \* g). +Proof. by apply: filterS => x /[apply] ->. Qed. + +Lemma ae_eq_mul1l f g : ae_eq f (cst 1) -> ae_eq g (g \* f). +Proof. by apply: filterS => x /[apply] ->; rewrite mule1. Qed. + +Lemma ae_eq_abse f g : ae_eq f g -> ae_eq (abse \o f) (abse \o g). +Proof. by apply: filterS => x /[apply] /= ->. Qed. + +End ae_eq. + +Section ae_eq_lemmas. +Context d (T : measurableType d) (R : realType). +Implicit Types mu : {measure set T -> \bar R}. -Notation "{ 'ae' m , P }" := (almost_everywhere m (inPhantom P)) : type_scope. +Lemma ae_eq_subset mu A B f g : B `<=` A -> ae_eq mu A f g -> ae_eq mu B f g. +Proof. +move=> BA [N [mN N0 fg]]; exists N; split => //. +by apply: subset_trans fg; apply: subsetC => z /= /[swap] /BA ? ->. +Qed. -Definition sigma_subadditive (R : numFieldType) (T : Type) +End ae_eq_lemmas. + +Definition sigma_subadditive {T} {R : numFieldType} (mu : set T -> \bar R) := forall (F : (set T) ^nat), mu (\bigcup_n (F n)) <= \sum_(i ' '\bar' R }" := (outer_measure R T) (at level 36, T, R at next level, format "{ 'outer_measure' 'set' T '->' '\bar' R }") : ring_scope. -#[global] Hint Extern 0 (_ set0 = 0) => solve [apply: outer_measure0] : core. +#[global] Hint Extern 0 (_ set0 = 0%R) => solve [apply: outer_measure0] : core. #[global] Hint Extern 0 (sigma_subadditive _) => solve [apply: outer_measure_sigma_subadditive] : core. @@ -2795,14 +3494,59 @@ Arguments outer_measure_ge0 {R T} _. Arguments le_outer_measure {R T} _. Arguments outer_measure_sigma_subadditive {R T} _. +Lemma outer_measure_sigma_subadditive_tail (T : Type) (R : realType) + (mu : {outer_measure set T -> \bar R}) N (F : (set T) ^nat) : + (mu (\bigcup_(n in ~` `I_N) (F n)) <= \sum_(N <= i if n \in ~` `I_N then F n else set0). +move/le_trans; apply. +rewrite [in leRHS]eseries_cond [in leRHS]eseries_mkcondr; apply: lee_nneseries. +- by move=> k _; exact: outer_measure_ge0. +- move=> k _; rewrite fun_if; case: ifPn => Nk; first by rewrite mem_not_I Nk. + by rewrite mem_not_I (negbTE Nk) outer_measure0. +Qed. + +Section outer_measureU. +Context d (T : semiRingOfSetsType d) (R : realType). +Variable mu : {outer_measure set T -> \bar R}. +Local Open Scope ereal_scope. + +Lemma outer_measure_subadditive (F : nat -> set T) n : + mu (\big[setU/set0]_(i < n) F i) <= \sum_(i < n) mu (F i). +Proof. +pose F' := fun k => if (k < n)%N then F k else set0. +rewrite -(big_mkord xpredT F) big_nat (eq_bigr F')//; last first. + by move=> k /= kn; rewrite /F' kn. +rewrite -big_nat big_mkord. +have := outer_measure_sigma_subadditive mu F'. +rewrite (bigcup_splitn n) (_ : bigcup _ _ = set0) ?setU0; last first. + by rewrite bigcup0 // => k _; rewrite /F' /= ltnNge leq_addr. +move/le_trans; apply. +rewrite (nneseries_split n); last by move=> ?; exact: outer_measure_ge0. +rewrite [X in _ + X](_ : _ = 0) ?adde0//; last first. + rewrite eseries_cond/= eseries_mkcond eseries0//. + by move=> k _; case: ifPn => //; rewrite /F' leqNgt => /negbTE ->. +by apply: lee_sum => i _; rewrite /F' ltn_ord. +Qed. + +Lemma outer_measureU2 A B : mu (A `|` B) <= mu A + mu B. +Proof. +have := outer_measure_subadditive (bigcup2 A B) 2. +by rewrite !big_ord_recl/= !big_ord0 setU0 adde0. +Qed. + +End outer_measureU. + Lemma le_outer_measureIC (R : realFieldType) T (mu : {outer_measure set T -> \bar R}) (A X : set T) : mu X <= mu (X `&` A) + mu (X `&` ~` A). Proof. pose B : (set T) ^nat := bigcup2 (X `&` A) (X `&` ~` A). -have cvg_mu : (fun n => \sum_(i < n) mu (B i)) --> mu (B 0%N) + mu (B 1%N). +have cvg_mu : (fun n => \sum_(i < n) mu (B i)) @ \oo --> mu (B 0%N) + mu (B 1%N). rewrite -2!cvg_shiftS /=. - rewrite [X in X --> _](_ : _ = (fun=> mu (B 0%N) + mu (B 1%N))); last first. + rewrite [X in X @ \oo --> _](_ : _ = (fun=> mu (B 0%N) + mu (B 1%N))); last first. rewrite funeqE => i; rewrite 2!big_ord_recl /= big1 ?adde0 // => j _. by rewrite /B /bigcup2 /=. exact: cvg_cst. @@ -2860,14 +3604,10 @@ have /(lee_add2r (mu (X `&` ~` (A `|` B)))) : have -> : Y = \bigcup_k Z k. rewrite predeqE => t; split=> [[?|?]|[]]; [by exists O|by exists 1%N|]. by move=> [_ ?|[_ ?|//]]; [left|right]. - rewrite (le_trans (outer_measure_sigma_subadditive mu Z)) //. - suff : ((fun n => \sum_(i < n) mu (Z i)) --> - mu (X `&` A) + mu (X `&` B `&` ~` A)). - move/cvg_lim => /=; under [in leLHS]eq_fun do rewrite big_mkord. - by move=> ->. - rewrite -(cvg_shiftn 2) /=; set l := (X in _ --> X). - rewrite [X in X --> _](_ : _ = cst l); first exact: cvg_cst. - rewrite funeqE => i; rewrite addn2 2!big_ord_recl big1 ?adde0 //. + rewrite (le_trans (outer_measure_sigma_subadditive mu Z))//. + rewrite le_eqVlt; apply/orP; left; apply/eqP. + apply/cvg_lim => //; rewrite -(cvg_shiftn 2)/=; apply: cvg_near_cst. + apply: nearW => k; rewrite big_mkord addn2 2!big_ord_recl big1 ?adde0//. by move=> ? _; exact: outer_measure0. have /le_trans : mu (X `&` (A `|` B)) + mu (X `&` ~` (A `|` B)) <= mu Y + mu (X `&` ~` (A `|` B)). @@ -2886,11 +3626,11 @@ move=> mA mB X; apply/eqP; rewrite eq_le. by rewrite le_outer_measureIC andTb caratheodory_measurable_setU_le. Qed. -Lemma caratheodory_measurable_bigsetU (A : (set T) ^nat) : (forall n, M (A n)) -> - forall n, M (\big[setU/set0]_(i < n) A i). +Lemma caratheodory_measurable_bigsetU (A : (set T) ^nat) : + (forall n, M (A n)) -> forall n, M (\big[setU/set0]_(i < n) A i). Proof. -move=> MA; elim=> [|n ih]; first by rewrite big_ord0; exact: caratheodory_measurable_set0. -by rewrite big_ord_recr; apply: caratheodory_measurable_setU. +move=> MA n; elim/big_ind : _ => //; first exact: caratheodory_measurable_set0. +exact: caratheodory_measurable_setU. Qed. Lemma caratheodory_measurable_setI A B : M A -> M B -> M (A `&` B). @@ -2920,12 +3660,12 @@ Let caratheorody_decompIU X : mu (X `&` (A `|` B)) = Proof. rewrite caratheodory_decomp -!addeA; congr (mu _ + _). rewrite -!setIA; congr (_ `&` _). - by rewrite setIC; apply/setIidPl; apply: subIset; left; left. + by rewrite setIC; apply/setIidPl; apply: subIset; left; exact: subsetUl. rewrite addeA addeC [X in mu X + _](_ : _ = set0); last first. by rewrite -setIA -setCU -setIA setICr setI0. rewrite outer_measure0 add0e addeC -!setIA; congr (mu (X `&` _) + mu (X `&` _)). -by rewrite setIC; apply/setIidPl; apply: subIset; right; right. -by rewrite setIC; apply/setIidPl; apply: subIset; left; left. + by rewrite setIC; apply/setIidPl; apply: subIset; right; exact: subsetUr. +by rewrite setIC; apply/setIidPl; apply: subIset; left; exact: subsetUl. Qed. Lemma disjoint_caratheodoryIU X : [disjoint A & B] -> @@ -2958,10 +3698,10 @@ Proof. move=> MA tA X. set A' := \bigcup_k A k; set B := fun n => \big[setU/set0]_(k < n) (A k). suff : forall n, \sum_(k < n) mu (X `&` A k) + mu (X `&` ~` A') <= mu X. - move=> XA; rewrite (_ : lim _ = ereal_sup + move=> XA; rewrite (_ : limn _ = ereal_sup ((fun n => \sum_(k < n) mu (X `&` A k)) @` setT)); last first. under eq_fun do rewrite big_mkord. - apply/cvg_lim => //; apply/ereal_nondecreasing_cvg. + apply/cvg_lim => //; apply: ereal_nondecreasing_cvgn. apply: (lee_sum_nneg_ord (fun n => mu (X `&` A n)) xpredT) => n _. exact: outer_measure_ge0. move XAx : (mu (X `&` ~` A')) => [x| |]. @@ -2969,17 +3709,16 @@ suff : forall n, \sum_(k < n) mu (X `&` A k) + mu (X `&` ~` A') <= mu X. by rewrite EFinN lee_subr_addr // -XAx XA. - suff : mu X = +oo by move=> ->; rewrite leey. by apply/eqP; rewrite -leye_eq -XAx le_outer_measure. - - by rewrite addeC /= leNye. + - by rewrite addeNy leNye. move=> n. apply: (@le_trans _ _ (\sum_(k < n) mu (X `&` A k) + mu (X `&` ~` B n))). - apply/lee_add2l/le_outer_measure; apply: setIS; apply: subsetC => t. - by rewrite /B -bigcup_mkord => -[i ? ?]; exists i. -rewrite [in leRHS](caratheodory_measurable_bigsetU MA n) lee_add2r //. + apply/lee_add2l/le_outer_measure; apply: setIS; exact/subsetC/bigsetU_bigcup. +rewrite [in leRHS](caratheodory_measurable_bigsetU MA n) lee_add2r//. by rewrite caratheodory_additive. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed `caratheodory_lime_le`")] -Notation caratheodory_lim_lee := caratheodory_lime_le. +Notation caratheodory_lim_lee := caratheodory_lime_le (only parsing). Lemma caratheodory_measurable_trivIset_bigcup (A : (set T) ^nat) : (forall n, M (A n)) -> trivIset setT A -> M (\bigcup_k (A k)). @@ -2994,8 +3733,7 @@ Lemma caratheodory_measurable_bigcup (A : (set T) ^nat) : (forall n, M (A n)) -> Proof. move=> MA; rewrite -eq_bigcup_seqD_bigsetU. apply/caratheodory_measurable_trivIset_bigcup; last first. - apply: (@trivIset_seqD _ (fun n => \big[setU/set0]_(i < n.+1) A i)). - by move=> n m nm; exact/subsetPset/subset_bigsetU. + by apply: trivIset_seqD => m n mn; exact/subsetPset/subset_bigsetU. by case=> [|n /=]; [| apply/caratheodory_measurable_setD => //]; exact/caratheodory_measurable_bigsetU. Qed. @@ -3011,8 +3749,9 @@ Proof. exact. Qed. Section caratheodory_sigma_algebra. Variables (R : realType) (T : pointedType) (mu : {outer_measure set T -> \bar R}). +HB.instance Definition _ := Pointed.on (caratheodory_type mu). HB.instance Definition _ := @isMeasurable.Build (caratheodory_display mu) - (caratheodory_type mu) (Pointed.class T) mu.-caratheodory + (caratheodory_type mu) mu.-caratheodory (caratheodory_measurable_set0 mu) (@caratheodory_measurable_setC _ _ mu) (@caratheodory_measurable_bigcup _ _ mu). @@ -3023,13 +3762,9 @@ Notation "mu .-cara" := (caratheodory_display mu) : measure_display_scope. Notation "mu .-cara.-measurable" := (measurable : set (set (caratheodory_type mu))) : classical_set_scope. -Definition measure_is_complete d (R : realType) (T : measurableType d) - (mu : set T -> \bar R) := - forall X, mu.-negligible X -> measurable X. - Section caratheodory_measure. Variables (R : realType) (T : pointedType). -Variable (mu : {outer_measure set T -> \bar R}). +Variable mu : {outer_measure set T -> \bar R}. Let U := caratheodory_type mu. Lemma caratheodory_measure0 : mu (set0 : set U) = 0. @@ -3046,11 +3781,11 @@ suff : forall X, mu X = \sum_(k _) = fun n => \sum_(k < n) mu (A k)); last first. rewrite funeqE => n; rewrite big_mkord; apply: eq_bigr => i _; congr (mu _). - by rewrite setIC; apply/setIidPl => t Ait; exists i. + by rewrite setIC; apply/setIidPl; exact: bigcup_sup. move=> ->; have := fun n (_ : xpredT n) => outer_measure_ge0 mu (A n). - move/is_cvg_nneseries => /cvg_ex[l] hl. + move/(@is_cvg_nneseries _ _ _ 0) => /cvg_ex[l] hl. under [in X in _ --> X]eq_fun do rewrite -(big_mkord xpredT (mu \o A)). - by move/(@cvg_lim _ (@ereal_hausdorff R)) : (hl) => ->. + by move/cvg_lim : (hl) => ->. move=> X. have mB : mu.-cara.-measurable B := caratheodory_measurable_bigcup mA. apply/eqP; rewrite eq_le (caratheodory_lime_le mA tA X) andbT. @@ -3058,7 +3793,8 @@ have /(lee_add2r (mu (X `&` ~` B))) := outer_measure_bigcup_lim mu A X. by rewrite -le_caratheodory_measurable // => ?; rewrite -mB. Qed. -HB.instance Definition _ := isMeasure.Build _ _ _ (mu : set (caratheodory_type mu) -> _) +HB.instance Definition _ := isMeasure.Build _ _ _ + (mu : set (caratheodory_type mu) -> _) caratheodory_measure0 caratheodory_measure_ge0 caratheodory_measure_sigma_additive. @@ -3084,8 +3820,8 @@ Lemma epsilon_trick (R : realType) (A : (\bar R)^nat) e \sum_(i A0 /nonnegP[{}e]. -rewrite (@le_trans _ _ (lim (fun n => (\sum_(0 <= i < n | P i) A i) + - \sum_(0 <= i < n) (e%:num / (2 ^ i.+1)%:R)%:E))) //. +rewrite (@le_trans _ _ (lim ((fun n => (\sum_(0 <= i < n | P i) A i) + + \sum_(0 <= i < n) (e%:num / (2 ^ i.+1)%:R)%:E) @ \oo))) //. rewrite nneseriesD // limeD //. - rewrite lee_add2l //; apply: lee_lim => //. + exact: is_cvg_nneseries. @@ -3094,13 +3830,13 @@ rewrite (@le_trans _ _ (lim (fun n => (\sum_(0 <= i < n | P i) A i) + - exact: is_cvg_nneseries. - exact: is_cvg_nneseries. - exact: adde_def_nneseries. -suff cvggeo : (fun n => \sum_(0 <= i < n) (e%:num / (2 ^ i.+1)%:R)%:E) --> +suff cvggeo : (fun n => \sum_(0 <= i < n) (e%:num / (2 ^ i.+1)%:R)%:E) @ \oo --> e%:num%:E. rewrite limeD //. - by rewrite lee_add2l // (cvg_lim _ cvggeo). - exact: is_cvg_nneseries. - by apply: is_cvg_nneseries => ?; rewrite lee_fin divr_ge0. - - by rewrite (cvg_lim _ cvggeo) //= fin_num_adde_def. + - by rewrite (cvg_lim _ cvggeo) //= fin_num_adde_defl. rewrite (_ : (fun n => _) = EFin \o (fun n => \sum_(0 <= i < n) (e%:num / (2 ^ (i + 1))%:R))%R); last first. rewrite funeqE => n /=; rewrite (@big_morph _ _ EFin 0 adde)//. @@ -3110,6 +3846,17 @@ have := cvg_geometric_series_half e%:num O. by rewrite expr0 divr1; apply: cvg_trans. Unshelve. all: by end_near. Qed. +Lemma epsilon_trick0 (R : realType) (eps : R) (P : pred nat) : + (0 <= eps)%R -> \sum_(i epspos; have := epsilon_trick P (fun=> lexx 0) epspos. +(* TODO: breaks coq 8.15 and below *) +(* (under eq_eseriesr do rewrite add0e) => /le_trans; apply. *) +rewrite (@eq_eseriesr _ (fun n => 0 + _) (fun n => (eps/(2^n.+1)%:R)%:E)). + by move/le_trans; apply; rewrite eseries0 ?add0e; [exact: lexx | move=> ? ?]. +by move=> ? ?; rewrite add0e. +Qed. + Section measurable_cover. Context d (T : semiRingOfSetsType d). Implicit Types (X : set T) (F : (set T)^nat). @@ -3130,15 +3877,14 @@ Lemma measurable_uncurry (T1 T2 : Type) d (T : semiRingOfSetsType d) measurable (G x.1 x.2) <-> measurable (uncurry G x). Proof. by case: x. Qed. -Section measure_extension. -Context (R : realType) d (T : semiRingOfSetsType d). +Section outer_measure_construction. +Context d (T : semiRingOfSetsType d) (R : realType). Variable mu : set T -> \bar R. -Hypothesis measure0 : mu set0 = 0. -Hypothesis measure_ge0 : forall X, mu X >= 0. +Hypothesis (measure0 : mu set0 = 0) (measure_ge0 : forall X, mu X >= 0). Hint Resolve measure_ge0 measure0 : core. Definition mu_ext (X : set T) : \bar R := - ereal_inf [set \sum_(i -> A <= B}. @@ -3157,37 +3903,35 @@ Unshelve. all: by end_near. Qed. Lemma mu_ext0 : mu^* set0 = 0. Proof. apply/eqP; rewrite eq_le; apply/andP; split; last exact/mu_ext_ge0. -rewrite /mu_ext; apply: ereal_inf_lb; exists (fun _ => set0); first by split. -by apply: (@lim_near_cst _ _ _ _ _ 0) => //; near=> n => /=; rewrite big1. +rewrite /mu_ext; apply: ereal_inf_lb; exists (fun=> set0); first by split. +by apply: lim_near_cst => //; near=> n => /=; rewrite big1. Unshelve. all: by end_near. Qed. Lemma mu_ext_sigma_subadditive : sigma_subadditive mu^*. Proof. move=> A; have [[i ioo]|] := pselect (exists i, mu^* (A i) = +oo). - rewrite (eseries_pinfty _ _ ioo)// ?leey// => n _. - by rewrite gt_eqF// (lt_le_trans _ (mu_ext_ge0 _)). + rewrite (eseries_pinfty _ _ ioo) ?leey// => n _. + by rewrite -ltNye (lt_le_trans _ (mu_ext_ge0 _)). rewrite -forallNE => Aoo. -suff add2e : forall e : {posnum R}, +suff add2e (e : {posnum R}) : mu^* (\bigcup_n A n) <= \sum_(i e. -move=> e; rewrite (le_trans _ (epsilon_trick _ _ _))//; last first. - by move=> n; apply: mu_ext_ge0. + by apply/lee_addgt0Pr => _/posnumP[]. +rewrite (le_trans _ (epsilon_trick _ _ _))//; last first. + by move=> n; exact: mu_ext_ge0. pose P n (B : (set T)^nat) := measurable_cover (A n) B /\ \sum_(k n; rewrite /P /mu_ext. set S := (X in ereal_inf X); move infS : (ereal_inf S) => iS. case: iS infS => [r Sr|Soo|Soo]. - - have en1 : (0 < e%:num / (2 ^ n.+1)%:R)%R. - by rewrite divr_gt0 // ltr0n expn_gt0. + - have en1 : (0 < e%:num / (2 ^ n.+1)%:R)%R by []. have /(lb_ereal_inf_adherent en1) : ereal_inf S \is a fin_num by rewrite Sr. move=> [x [B [mB AnB muBx] xS]]. - exists B; split => //; rewrite muBx -Sr; apply/ltW. - by rewrite (lt_le_trans xS) // lee_add2l //= lee_fin ler_pmul. + by exists B; split => //; rewrite muBx -Sr; exact/ltW. - by have := Aoo n; rewrite /mu^* Soo. - suff : lbound S 0 by move/lb_ereal_inf; rewrite Soo. by move=> /= _ [B [mB AnB] <-]; exact: nneseries_ge0. -have muG_ge0 x : 0 <= (mu \o uncurry G) x by exact/measure_ge0. +have muG_ge0 x : 0 <= (mu \o uncurry G) x by exact: measure_ge0. apply: (@le_trans _ _ (\esum_(i in setT) (mu \o uncurry G) i)). rewrite /mu_ext; apply: ereal_inf_lb => /=. have /card_esym/ppcard_eqP[f] := card_nat2. @@ -3198,8 +3942,7 @@ apply: (@le_trans _ _ (\esum_(i in setT) (mu \o uncurry G) i)). move=> t [i _ [j _ Bijt]]; exists (f^-1%FUN (i, j)) => //=. by rewrite invK ?inE. rewrite -(esum_pred_image (mu \o uncurry G) _ xpredT) ?[fun=> _]set_true//. - congr esum. - by rewrite -[RHS](image_eq f)predeqE=> -[a b]/=; split=> -[n _ <-]; exists n. + by rewrite image_eq. rewrite (_ : esum _ _ = \sum_(i set (nat * nat) := fun i => [set (i, j) | j in setT]. rewrite (_ : setT = \bigcup_k J k); last first. @@ -3208,11 +3951,10 @@ rewrite (_ : esum _ _ = \sum_(i i j _ _ ij. rewrite predeqE => -[n m] /=; split => //= -[] [_] _ [<-{n} _]. by move=> [m' _] [] /esym/eqP; rewrite (negbTE ij). - - by move=> /= [n m]; apply/measure_ge0; exact: (cover_measurable (PG n).1). - rewrite (_ : setT = id @` xpredT); last first. - by rewrite image_id funeqE => x; rewrite trueE. - rewrite esum_pred_image //; last by move=> n _; exact: esum_ge0. - apply: eq_eseries => /= j _. + - by move=> /= [n m]; apply: measure_ge0; exact: (cover_measurable (PG n).1). + rewrite -(image_id [set: nat]) -fun_true esum_pred_image//; last first. + by move=> n _; exact: esum_ge0. + apply: eq_eseriesr => /= j _. rewrite -(esum_pred_image (mu \o uncurry G) (pair j) predT)//=; last first. by move=> ? ? _ _; exact: (@can_inj _ _ _ snd). by congr esum; rewrite predeqE => -[a b]; split; move=> [i _ <-]; exists i. @@ -3223,13 +3965,13 @@ apply: lee_lim. - by near=> n; apply: lee_sum => i _; exact: (PG i).2. Unshelve. all: by end_near. Qed. -End measure_extension. +End outer_measure_construction. Declare Scope measure_scope. Delimit Scope measure_scope with mu. Notation "mu ^*" := (mu_ext mu) : measure_scope. Local Open Scope measure_scope. -Section measure_extension. +Section outer_measure_of_content. Context d (R : realType) (T : semiRingOfSetsType d). Variable mu : {content set T -> \bar R}. @@ -3239,7 +3981,7 @@ HB.instance Definition _ := isOuterMeasure.Build (le_mu_ext mu) (mu_ext_sigma_subadditive (measure_ge0 mu)). -End measure_extension. +End outer_measure_of_content. Section g_salgebra_measure_unique_trace. Context d (R : realType) (T : measurableType d). @@ -3260,23 +4002,23 @@ have setDE : setD_closed E. move=> A B BA [mA m1m2A AD] [mB m1m2B BD]; split; first exact: measurableD. - rewrite measureD//; last first. by rewrite (le_lt_trans _ m1oo)//; apply: le_measure => // /[!inE]. - rewrite setIidr// m1m2A m1m2B measureD// ?setIidr//. - by rewrite (le_lt_trans _ m1oo)// -m1m2A; apply: le_measure => // /[!inE]. + rewrite setIidr//= m1m2A m1m2B measureD// ?setIidr//. + by rewrite (le_lt_trans _ m1oo)//= -m1m2A; apply: le_measure => // /[!inE]. - by rewrite setDE; apply: subIset; left. have ndE : ndseq_closed E. move=> A ndA EA; split; have mA n : measurable (A n) by have [] := EA n. - exact: bigcupT_measurable. - - transitivity (lim (m1 \o A)). + - transitivity (limn (m1 \o A)). apply/esym/cvg_lim=>//. exact/(nondecreasing_cvg_mu mA _ ndA)/bigcupT_measurable. - transitivity (lim (m2 \o A)). - by congr (lim _); rewrite funeqE => n; have [] := EA n. + transitivity (limn (m2 \o A)). + by apply/congr_lim/funext => n; have [] := EA n. apply/cvg_lim => //. exact/(nondecreasing_cvg_mu mA _ ndA)/bigcupT_measurable. - by apply: bigcup_sub => n; have [] := EA n. have sDHE : <> `<=` E. by apply: monotone_class_subset => //; split => //; [move=> A []|exact/HE]. -by move=> X /sDHE[mX ?] _. +by move=> X /sDHE[]. Qed. End g_salgebra_measure_unique_trace. @@ -3316,13 +4058,13 @@ have nd_g' : nondecreasing_seq g'. exact: leq_trans lemn. move=> A gA. have -> : A = \bigcup_n (g' n `&` A) by rewrite -setI_bigcupl g'_cover setTI. -transitivity (lim (fun n => m1 (g' n `&` A))). +transitivity (lim (m1 (g' n `&` A) @[n --> \oo])). apply/esym/cvg_lim => //; apply: nondecreasing_cvg_mu. - by move=> n; apply: measurableI; exact/sGm. - by apply: bigcupT_measurable => k; apply: measurableI; exact/sGm. - by move=> ? ? ?; apply/subsetPset; apply: setSI; exact/subsetPset/nd_g'. -transitivity (lim (fun n => m2 (g' n `&` A))). - by congr (lim _); rewrite funeqE => x; apply: sG'm1m2 => //; exact/sGm. +transitivity (lim (m2 (g' n `&` A) @[n --> \oo])). + by apply/congr_lim/funext => x; apply: sG'm1m2 => //; exact/sGm. apply/cvg_lim => //; apply: nondecreasing_cvg_mu. - by move=> k; apply: measurableI => //; exact/sGm. - by apply: bigcupT_measurable => k; apply: measurableI; exact/sGm. @@ -3383,11 +4125,10 @@ End measure_unique. Arguments measure_unique {d R T} G g. Lemma measurable_mu_extE d (R : realType) (T : semiRingOfSetsType d) - (mu : {content set T -> \bar R}) X : - sigma_sub_additive mu -> + (mu : {measure set T -> \bar R}) X : measurable X -> mu^* X = mu X. Proof. -move=> muS mX; apply/eqP; rewrite eq_le; apply/andP; split. +move=> mX; apply/eqP; rewrite eq_le; apply/andP; split. apply: ereal_inf_lb; exists (fun n => if n is 0%N then X else set0). by split=> [[]// _|t Xt]; exists 0%N. apply/cvg_lim => //; rewrite -cvg_shiftS. @@ -3396,12 +4137,11 @@ move=> muS mX; apply/eqP; rewrite eq_le; apply/andP; split. apply/lb_ereal_inf => x [A [mA XA] <-{x}]. have XUA : X = \bigcup_n (X `&` A n). rewrite predeqE => t; split => [Xt|[i _ []//]]. - by have [i _ Ait] := XA _ Xt; exists i; split. + by have [i _ Ait] := XA _ Xt; exists i. apply: (@le_trans _ _ (\sum_(i // i; apply: measurableI. + by rewrite measure_sigma_sub_additive//= -?XUA => // i; apply: measurableI. apply: lee_lim; [exact: is_cvg_nneseries|exact: is_cvg_nneseries|]. -apply: nearW => n; apply: lee_sum => i _; apply: le_measure => // /[!inE]//=. -exact: measurableI. +by apply: nearW => n; apply: lee_sum => i _; exact: measureIr. Qed. Section Rmu_ext. @@ -3414,7 +4154,7 @@ Proof. apply/funeqP => /= X; rewrite /mu_ext/=; apply/eqP; rewrite eq_le. rewrite ?lb_ereal_inf// => _ [F [Fm XS] <-]; rewrite ereal_inf_lb//; last first. exists F; first by split=> // i; apply: sub_gen_smallest. - by rewrite (eq_eseries (fun _ _ => RmuE _ (Fm _))). + by rewrite (eq_eseriesr (fun _ _ => RmuE _ (Fm _))). pose K := [set: nat] `*`` fun i => decomp (F i). have /ppcard_eqP[f] : (K #= [set: nat])%card. apply: cardMR_eq_nat => // i; split; last by apply/set0P; rewrite decompN0. @@ -3436,18 +4176,13 @@ Qed. End Rmu_ext. Lemma measurable_Rmu_extE d (R : realType) (T : semiRingOfSetsType d) - (mu : {content set T -> \bar R}) X : - sigma_sub_additive mu -> + (mu : {measure set T -> \bar R}) X : d.-ring.-measurable X -> mu^* X = SetRing.measure mu X. -Proof. -move=> mu_sub Xm/=; rewrite -Rmu_ext/= measurable_mu_extE//. -exact: ring_sigma_sub_additive. -Qed. +Proof. by move=> Xm/=; rewrite -Rmu_ext/= measurable_mu_extE. Qed. -Section Hahn_extension. -Context d (R : realType) (T : semiRingOfSetsType d). -Variable mu : {content set T -> \bar R}. -Hypothesis mu_sub : sigma_sub_additive mu. +Section measure_extension. +Context d (T : semiRingOfSetsType d) (R : realType). +Variable mu : {measure set T -> \bar R}. Let Rmu := SetRing.measure mu. Notation rT := (SetRing.type T). @@ -3455,18 +4190,17 @@ Lemma sub_caratheodory : (d.-measurable).-sigma.-measurable `<=` mu^*.-cara.-measurable. Proof. suff: <> `<=` mu^*.-cara.-measurable. - apply: subset_trans; apply: sub_smallest2r => //. - by apply: sub_smallest. + by apply: subset_trans; apply: sub_smallest2r => //; exact: sub_smallest. apply: smallest_sub. split => //; [by move=> X mX; rewrite setTD; exact: measurableC | by move=> u_ mu_; exact: bigcupT_measurable]. move=> A mA; apply le_caratheodory_measurable => // X. apply lb_ereal_inf => _ [B [mB XB] <-]. -rewrite -(eq_eseries (fun _ _ => SetRing.RmuE _ (mB _)))=> //. +rewrite -(eq_eseriesr (fun _ _ => SetRing.RmuE _ (mB _))) => //. have RmB i : measurable (B i : set rT) by exact: sub_gen_smallest. set BA := eseries (fun n => Rmu (B n `&` A)). set BNA := eseries (fun n => Rmu (B n `&` ~` A)). -apply: (@le_trans _ _ (lim BA + lim BNA)); [apply: lee_add|]. +apply: (@le_trans _ _ (limn BA + limn BNA)); [apply: lee_add|]. - rewrite (_ : BA = eseries (fun n => mu_ext mu (B n `&` A))); last first. rewrite funeqE => n; apply: eq_bigr => k _. by rewrite /= measurable_Rmu_extE //; exact: measurableI. @@ -3475,33 +4209,28 @@ apply: (@le_trans _ _ (lim BA + lim BNA)); [apply: lee_add|]. exact: outer_measure_sigma_subadditive. - rewrite (_ : BNA = eseries (fun n => mu_ext mu (B n `\` A))); last first. rewrite funeqE => n; apply: eq_bigr => k _. - rewrite /= measurable_Rmu_extE //; exact: measurableD. + by rewrite /= measurable_Rmu_extE //; exact: measurableD. apply: (@le_trans _ _ (mu_ext mu (\bigcup_k (B k `\` A)))). by apply: le_mu_ext; rewrite -setI_bigcupl; exact: setISS. exact: outer_measure_sigma_subadditive. -have ? : cvg BNA. - apply/is_cvg_nneseries => n _. - by rewrite -setDE; apply: measure_ge0 => //; exact: measurableD. -have ? : cvg BA. - by apply/is_cvg_nneseries => n _; apply: measure_ge0 =>//; apply: measurableI. -have ? : cvg (eseries (Rmu \o B)) by exact/is_cvg_nneseries. -have [def|] := boolP (adde_def (lim BA) (lim BNA)); last first. +have ? : cvg (BNA @ \oo) by exact: is_cvg_nneseries. +have ? : cvg (BA @ \oo) by exact: is_cvg_nneseries. +have ? : cvg (eseries (Rmu \o B) @ \oo) by exact: is_cvg_nneseries. +have [def|] := boolP (lim (BA @ \oo) +? lim (BNA @ \oo)); last first. rewrite /adde_def negb_and !negbK=> /orP[/andP[BAoo BNAoo]|/andP[BAoo BNAoo]]. - - suff -> : lim (eseries (Rmu \o B)) = +oo by rewrite leey. + - suff -> : limn (eseries (Rmu \o B)) = +oo by rewrite leey. apply/eqP; rewrite -leye_eq -(eqP BAoo); apply/lee_lim => //. near=> n; apply: lee_sum => m _; apply: le_measure; rewrite /mkset; by [rewrite inE; exact: measurableI | rewrite inE | apply: subIset; left]. - - suff -> : lim (eseries (Rmu \o B)) = +oo by rewrite leey. + - suff -> : limn (eseries (Rmu \o B)) = +oo by rewrite leey. apply/eqP; rewrite -leye_eq -(eqP BNAoo); apply/lee_lim => //. by near=> n; apply: lee_sum => m _; rewrite -setDE; apply: le_measure; rewrite /mkset ?inE//; apply: measurableD. rewrite -limeD // (_ : (fun _ => _) = eseries (fun k => Rmu (B k `&` A) + Rmu (B k `&` ~` A))); last first. - by rewrite funeqE => n; rewrite -big_split /=; apply: eq_bigr. + by rewrite funeqE => n; rewrite -big_split /=; exact: eq_bigr. apply/lee_lim => //. - apply/is_cvg_nneseries => // n _; apply/adde_ge0. - by apply: measure_ge0 => //; exact: measurableI. - by rewrite -setDE; apply: measure_ge0; exact: measurableD. + by apply/is_cvg_nneseries => // n _; exact: adde_ge0. near=> n; apply: lee_sum => i _; rewrite -measure_semi_additive2. - apply: le_measure; rewrite /mkset ?inE//; [|by rewrite -setIUr setUCr setIT]. by apply: measurableU; [exact:measurableI|rewrite -setDE; exact:measurableD]. @@ -3513,54 +4242,55 @@ Unshelve. all: by end_near. Qed. Let I := [the measurableType _ of salgebraType (@measurable _ T)]. -Definition Hahn_ext : set I -> \bar R := mu^*. +Definition measure_extension : set I -> \bar R := mu^*. -Local Lemma Hahn_ext0 : Hahn_ext set0 = 0. +Local Lemma measure_extension0 : measure_extension set0 = 0. Proof. exact: mu_ext0. Qed. -Local Lemma Hahn_ext_ge0 (A : set I) : 0 <= Hahn_ext A. +Local Lemma measure_extension_ge0 (A : set I) : 0 <= measure_extension A. Proof. exact: mu_ext_ge0. Qed. -Local Lemma Hahn_ext_sigma_additive : semi_sigma_additive Hahn_ext. +Local Lemma measure_extension_semi_sigma_additive : + semi_sigma_additive measure_extension. Proof. -move=> F mF tF mUF; rewrite /Hahn_ext. -apply: caratheodory_measure_sigma_additive => //; last first. - exact: sub_caratheodory. +move=> F mF tF mUF; rewrite /measure_extension. +apply: caratheodory_measure_sigma_additive => //; last exact: sub_caratheodory. by move=> i; exact: (sub_caratheodory (mF i)). Qed. -HB.instance Definition _ := isMeasure.Build _ _ _ Hahn_ext - Hahn_ext0 Hahn_ext_ge0 Hahn_ext_sigma_additive. +HB.instance Definition _ := isMeasure.Build _ _ _ measure_extension + measure_extension0 measure_extension_ge0 + measure_extension_semi_sigma_additive. -Lemma Hahn_ext_sigma_finite : @sigma_finite _ _ T setT mu -> - @sigma_finite _ _ _ setT Hahn_ext. +Lemma measure_extension_sigma_finite : @sigma_finite _ T _ setT mu -> + @sigma_finite _ _ _ setT measure_extension. Proof. move=> -[S setTS mS]; exists S => //; move=> i; split. by have := (mS i).1; exact: sub_sigma_algebra. -by rewrite /Hahn_ext /= measurable_mu_extE //; +by rewrite /measure_extension /= measurable_mu_extE //; [exact: (mS i).2 | exact: (mS i).1]. Qed. -Lemma Hahn_ext_unique : sigma_finite [set: T] mu -> +Lemma measure_extension_unique : sigma_finite [set: T] mu -> (forall mu' : {measure set I -> \bar R}, (forall X, d.-measurable X -> mu X = mu' X) -> - (forall X, (d.-measurable).-sigma.-measurable X -> Hahn_ext X = mu' X)). + (forall X, (d.-measurable).-sigma.-measurable X -> + measure_extension X = mu' X)). Proof. move=> [F TF /all_and2[Fm muF]] mu' mu'mu X mX. apply: (@measure_unique _ _ [the measurableType _ of I] d.-measurable F) => //. - by move=> A B Am Bm; apply: measurableI. -- by move=> A Am; rewrite /= /Hahn_ext measurable_mu_extE// mu'mu. -- by move=> k; rewrite /= /Hahn_ext measurable_mu_extE. +- by move=> A Am; rewrite /= /measure_extension measurable_mu_extE// mu'mu. +- by move=> k; rewrite /= /measure_extension measurable_mu_extE. Qed. -End Hahn_extension. +End measure_extension. Lemma caratheodory_measurable_mu_ext d (R : realType) (T : measurableType d) (mu : {measure set T -> \bar R}) A : d.-measurable A -> mu^*.-cara.-measurable A. Proof. -by move=> Am; apply: sub_caratheodory => //; - [exact: measure_sigma_sub_additive|exact: sub_sigma_algebra]. +by move=> Am; apply: sub_caratheodory => //; apply: sub_sigma_algebra. Qed. Definition preimage_classes d1 d2 @@ -3609,9 +4339,10 @@ Lemma prod_salgebra_bigcup (F : _^nat) : (forall i, preimage_classes f1 f2 (F i) preimage_classes f1 f2 (\bigcup_i (F i)). Proof. exact: sigma_algebra_bigcup. Qed. +HB.instance Definition _ := Pointed.on (T1 * T2)%type. HB.instance Definition prod_salgebra_mixin := @isMeasurable.Build (measure_prod_display (d1, d2)) - (T1 * T2)%type (Pointed.class _) (preimage_classes f1 f2) + (T1 * T2)%type (preimage_classes f1 f2) (prod_salgebra_set0) (prod_salgebra_setC) (prod_salgebra_bigcup). End product_salgebra_instance. @@ -3706,47 +4437,55 @@ apply: (@iff_trans _ (preimage_classes (fst \o h) (snd \o h) `<=` measurable)). by rewrite subUset; split=> [|] A [C mC <-]; [exact: mf1|exact: mf2]. Qed. -Lemma measurable_fun_pair (f : T -> T1) (g : T -> T2) : +Lemma measurable_fun_prod (f : T -> T1) (g : T -> T2) : measurable_fun setT f -> measurable_fun setT g -> measurable_fun setT (fun x => (f x, g x)). -Proof. by move=> mf mg; apply/prod_measurable_funP. Qed. +Proof. by move=> mf mg; exact/prod_measurable_funP. Qed. End prod_measurable_fun. +#[deprecated(since="mathcomp-analysis 0.6.3", note="renamed `measurable_fun_prod`")] +Notation measurable_fun_pair := measurable_fun_prod (only parsing). Section prod_measurable_proj. Context d1 d2 (T1 : measurableType d1) (T2 : measurableType d2). -Lemma measurable_fun_fst : measurable_fun setT (@fst T1 T2). +Lemma measurable_fst : measurable_fun [set: T1 * T2] fst. Proof. by have /prod_measurable_funP[] := - @measurable_fun_id _ [the measurableType _ of (T1 * T2)%type] setT. + @measurable_id _ [the measurableType _ of (T1 * T2)%type] setT. Qed. +#[local] Hint Resolve measurable_fst : core. -Lemma measurable_fun_snd : measurable_fun setT (@snd T1 T2). +Lemma measurable_snd : measurable_fun [set: T1 * T2] snd. Proof. by have /prod_measurable_funP[] := - @measurable_fun_id _ [the measurableType _ of (T1 * T2)%type] setT. + @measurable_id _ [the measurableType _ of (T1 * T2)%type] setT. Qed. +#[local] Hint Resolve measurable_snd : core. -Lemma measurable_fun_swap : measurable_fun [set: T1 * T2] (@swap T1 T2). -Proof. -by apply/prod_measurable_funP => /=; split; - [exact: measurable_fun_snd|exact: measurable_fun_fst]. -Qed. +Lemma measurable_swap : measurable_fun [set: _] (@swap T1 T2). +Proof. exact: measurable_fun_prod. Qed. End prod_measurable_proj. +Arguments measurable_fst {d1 d2 T1 T2}. +Arguments measurable_snd {d1 d2 T1 T2}. +#[deprecated(since="mathcomp-analysis 0.6.3", note="renamed `measurable_fst`")] +Notation measurable_fun_fst := measurable_fst (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.3", note="renamed `measurable_snd`")] +Notation measurable_fun_snd := measurable_snd (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.3", note="renamed `measurable_swap`")] +Notation measurable_fun_swap := measurable_swap (only parsing). +#[global] Hint Extern 0 (measurable_fun _ fst) => + solve [apply: measurable_fst] : core. +#[global] Hint Extern 0 (measurable_fun _ snd) => + solve [apply: measurable_snd] : core. Lemma measurable_fun_if_pair d d' (X : measurableType d) (Y : measurableType d') (x y : X -> Y) : measurable_fun setT x -> measurable_fun setT y -> measurable_fun setT (fun tb => if tb.2 then x tb.1 else y tb.1). Proof. -move=> mx my. -have {}mx : measurable_fun [set: X * bool] (x \o fst). - by apply: measurable_funT_comp => //; exact: measurable_fun_fst. -have {}my : measurable_fun [set: X * bool] (y \o fst). - by apply: measurable_funT_comp => //; exact: measurable_fun_fst. -by apply: measurable_fun_ifT => //=; exact: measurable_fun_snd. +by move=> mx my; apply: measurable_fun_ifT => //=; exact: measurableT_comp. Qed. Section partial_measurable_fun. @@ -3754,43 +4493,65 @@ Context d d1 d2 (T : measurableType d) (T1 : measurableType d1) (T2 : measurableType d2). Variable f : T1 * T2 -> T. -Lemma measurable_fun_prod1 x : - measurable_fun setT f -> measurable_fun setT (fun y => f (x, y)). +Lemma measurable_pair1 (x : T1) : measurable_fun [set: T2] (pair x). Proof. -move=> mf; pose pairx := fun y : T2 => (x, y). -have m1pairx : measurable_fun setT (fst \o pairx) by exact/measurable_fun_cst. -have m2pairx : measurable_fun setT (snd \o pairx) by exact/measurable_fun_id. -have ? : measurable_fun setT pairx by exact/(proj2 (prod_measurable_funP _)). -exact: (measurable_fun_comp _ _ mf). +have m1pairx : measurable_fun [set: T2] (fst \o pair x) by exact/measurable_cst. +have m2pairx : measurable_fun [set: T2] (snd \o pair x) by exact/measurable_id. +exact/(prod_measurable_funP _). Qed. -Lemma measurable_fun_prod2 y : - measurable_fun setT f -> measurable_fun setT (fun x => f (x, y)). +Lemma measurable_pair2 (y : T2) : measurable_fun [set: T1] (pair^~ y). Proof. -move=> mf; pose pairy := fun x : T1 => (x, y). -have m1pairy : measurable_fun setT (fst \o pairy) by exact/measurable_fun_id. -have m2pairy : measurable_fun setT (snd \o pairy) by exact/measurable_fun_cst. -have : measurable_fun setT pairy by exact/(proj2 (prod_measurable_funP _)). -exact: (measurable_fun_comp _ _ mf). +have m1pairy : measurable_fun [set: T1] (fst \o pair^~y) by exact/measurable_id. +have m2pairy : measurable_fun [set: T1] (snd \o pair^~y) by exact/measurable_cst. +exact/(prod_measurable_funP _). Qed. End partial_measurable_fun. +#[global] Hint Extern 0 (measurable_fun _ (pair _)) => + solve [apply: measurable_pair1] : core. +#[global] Hint Extern 0 (measurable_fun _ (pair^~ _)) => + solve [apply: measurable_pair2] : core. -HB.mixin Record isProbability d (T : measurableType d) - (R : realType) (P : set T -> \bar R) of isMeasure d R T P := - { probability_setT : P setT = 1%E }. +Section absolute_continuity. +Context d (T : measurableType d) (R : realType). +Implicit Types m : set T -> \bar R. -#[short(type=probability)] -HB.structure Definition Probability d (T : measurableType d) (R : realType) := - {P of isProbability d T R P & isMeasure d R T P }. +Definition measure_dominates m1 m2 := + forall A, measurable A -> m2 A = 0 -> m1 A = 0. -Section probability_lemmas. -Context d (T : measurableType d) (R : realType) (P : probability T R). +Local Notation "m1 `<< m2" := (measure_dominates m1 m2). + +Lemma measure_dominates_trans m1 m2 m3 : m1 `<< m2 -> m2 `<< m3 -> m1 `<< m3. +Proof. by move=> m12 m23 A mA /m23-/(_ mA) /m12; exact. Qed. + +End absolute_continuity. +Notation "m1 `<< m2" := (measure_dominates m1 m2). + +Section absolute_continuity_lemmas. +Context d (T : measurableType d) (R : realType). +Implicit Types m : {measure set T -> \bar R}. + +Lemma measure_dominates_ae_eq m1 m2 f g E : measurable E -> + m2 `<< m1 -> ae_eq m1 E f g -> ae_eq m2 E f g. +Proof. by move=> mE m21 [A [mA A0 ?]]; exists A; split => //; exact: m21. Qed. + +End absolute_continuity_lemmas. -Lemma probability_le1 (A : set T) : measurable A -> (P A <= 1)%E. +Section essential_supremum. +Context d {T : measurableType d} {R : realType}. +Variable mu : {measure set T -> \bar R}. +Implicit Types f : T -> R. + +Definition ess_sup f := + ereal_inf (EFin @` [set r | mu (f @^-1` `]r, +oo[) = 0]). + +Lemma ess_sup_ge0 f : 0 < mu [set: T] -> (forall t, 0 <= f t)%R -> + 0 <= ess_sup f. Proof. -move=> mA; rewrite -(@probability_setT _ _ _ P). -by apply: le_measure => //; rewrite ?in_setE. +move=> muT f0; apply: lb_ereal_inf => _ /= [r /eqP rf <-]; rewrite leNgt. +apply/negP => r0; apply/negP : rf; rewrite gt_eqF// (_ : _ @^-1` _ = setT)//. +by apply/seteqP; split => // x _ /=; rewrite in_itv/= (lt_le_trans _ (f0 x)). Qed. -End probability_lemmas. +End essential_supremum. diff --git a/theories/misc/uniform_bigO.v b/theories/misc/uniform_bigO.v index eee8016e1..52d8e4fea 100644 --- a/theories/misc/uniform_bigO.v +++ b/theories/misc/uniform_bigO.v @@ -2,8 +2,8 @@ Require Import Reals. From Coq Require Import ssreflect ssrfun ssrbool. From mathcomp Require Import ssrnat eqtype choice fintype bigop order ssralg ssrnum. -Require Import boolp reals Rstruct Rbar. -Require Import classical_sets posnum topology normedtype landau. +From mathcomp Require Import boolp reals Rstruct ereal. +From mathcomp Require Import classical_sets signed topology normedtype landau. Set Implicit Arguments. Unset Strict Implicit. @@ -38,7 +38,7 @@ Definition OuP (f : A -> R * R -> R) (g : R * R -> R) := (* first we replace sig with ex and the l^2 norm with the l^oo norm *) -Let normedR2 := [normedModType _ of (R^o * R^o)]. +Let normedR2 := [the normedModType _ of (R^o * R^o)%type]. Definition OuPex (f : A -> R * R -> R^o) (g : R * R -> R^o) := exists2 alp, 0 < alp & exists2 C, 0 < C & @@ -51,22 +51,23 @@ Proof. rewrite RsqrtE; last by rewrite addr_ge0 //; apply/RleP/Rle_0_sqr. rewrite !Rsqr_pow2 !RpowE; apply/andP; split. by rewrite le_maxl; apply/andP; split; - rewrite -[`|_|]sqrtr_sqr ler_wsqrtr // (ler_addl, ler_addr) sqr_ge0. + rewrite -[`|_|]sqrtr_sqr ler_wsqrtr // (lerDl, lerDr) sqr_ge0. wlog lex12 : x / (`|x.1| <= `|x.2|). move=> ler_norm; case: (lerP `|x.1| `|x.2|) => [/ler_norm|] //. rewrite lt_leAnge => /andP [lex21 _]. + rewrite RplusE. by rewrite addrC [`|_|]maxC (ler_norm (x.2, x.1)). rewrite [`|_|]max_r // -[X in X * _]ger0_norm // -normrM. -rewrite -sqrtr_sqr ler_wsqrtr // exprMn sqr_sqrtr // mulr_natl mulr2n ler_add2r. +rewrite -sqrtr_sqr ler_wsqrtr // exprMn sqr_sqrtr // mulr_natl mulr2n lerD2r. rewrite -[_ ^+ 2]ger0_norm ?sqr_ge0 // -[X in _ <=X]ger0_norm ?sqr_ge0 //. -by rewrite !normrX ler_expn2r // nnegrE normr_ge0. +by rewrite !normrX lerXn2r // nnegrE normr_ge0. Qed. Lemma OuP_to_ex f g : OuP f g -> OuPex f g. Proof. move=> [_ [_ [/posnumP[a] [/posnumP[C] fOg]]]]. exists (a%:num / Num.sqrt 2) => //; exists C%:num => // x dx ltdxa Pdx. -apply: fOg; move: ltdxa; rewrite ltr_pdivl_mulr //; apply: le_lt_trans. +apply: fOg; move: ltdxa; rewrite ltr_pdivlMr //; apply: le_lt_trans. by rewrite mulrC; have /andP[] := ler_norm2 dx. Qed. @@ -82,27 +83,25 @@ Qed. (* then we replace the epsilon/delta definition with bigO *) Definition OuO (f : A -> R * R -> R^o) (g : R * R -> R^o) := - (fun x => f x.1 x.2) =O_ (filter_prod [set setT] - (within P [filter of 0 : R^o * R^o])) (fun x => g x.2). + (fun x => f x.1 x.2) =O_ (filter_prod [set setT]%classic + (within P (nbhs (0%R:R^o,0%R:R^o))(*[filter of 0 : R^o * R^o]*))) (fun x => g x.2). Lemma OuP_to_O f g : OuP f g -> OuO f g. Proof. move=> /OuP_to_ex [_/posnumP[a] [_/posnumP[C] fOg]]. apply/eqOP; near=> k; near=> x; apply: le_trans (fOg _ _ _ _) _; last 2 first. - by near: x; exists (setT, P); [split=> //=; apply: withinT|move=> ? []]. -- rewrite ler_pmul => //; near: k; exists C%:num; split. - exact: posnum_real. - by move=> ?; rewrite lt_leAnge => /andP[]. +- by rewrite ler_pM. - near: x; exists (setT, ball (0 : R^o * R^o) a%:num). - by split=> //=; rewrite /within; near=> x =>_; near: x; apply: nbhsx_ballx. + by split=> //=; rewrite /within /=; near=> x =>_; near: x; apply: nbhsx_ballx. move=> x [_ [/=]]; rewrite -ball_normE /= distrC subr0 distrC subr0. by move=> ??; rewrite lt_maxl; apply/andP. -Grab Existential Variables. all: end_near. Qed. +Unshelve. all: by end_near. Qed. Lemma OuO_to_P f g : OuO f g -> OuP f g. Proof. move=> fOg; apply/Ouex_to_P; move: fOg => /eqOP [k [kreal hk]]. -have /hk [Q [->]] : k < maxr 1 (k + 1) by rewrite lt_maxr ltr_addl orbC ltr01. +have /hk [Q [->]] : k < maxr 1 (k + 1) by rewrite lt_maxr ltrDl orbC ltr01. move=> [R [[_/posnumP[e1] Re1] [_/posnumP[e2] Re2]] sRQ] fOg. exists (minr e1%:num e2%:num) => //. exists (maxr 1 (k + 1)); first by rewrite lt_maxr ltr01. diff --git a/theories/normedtype.v b/theories/normedtype.v index d2e2159cb..01ea11f42 100644 --- a/theories/normedtype.v +++ b/theories/normedtype.v @@ -1,16 +1,28 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) +From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum finmap matrix. From mathcomp Require Import rat interval zmodp vector fieldext falgebra. -From mathcomp.classical Require Import boolp classical_sets functions. -From mathcomp.classical Require Import cardinality set_interval mathcomp_extra. +From mathcomp Require Import mathcomp_extra boolp classical_sets functions. +From mathcomp Require Import cardinality set_interval Rstruct. Require Import ereal reals signed topology prodnormedzmodule. -(******************************************************************************) -(* This file extends the topological hierarchy with norm-related notions. *) +(**md**************************************************************************) +(* # Norm-related Notions *) (* *) +(* This file extends the topological hierarchy with norm-related notions. *) (* Note that balls in topology.v are not necessarily open, here they are. *) +(* We used these definitions to prove the intermediate value theorem and *) +(* the Heine-Borel theorem, which states that the compact sets of *) +(* $\mathbb{R}^n$ are the closed and bounded sets, Urysohn's lemma, Vitali's *) +(* covering lemmas (finite case), etc. *) (* *) -(* * Normed Topological Abelian groups: *) +(* * Limit superior and inferior: *) +(* limf_esup f F, limf_einf f F == limit sup/inferior of f at "filter" F *) +(* f has type X -> \bar R. *) +(* F has type set (set X). *) +(* *) +(* ## Normed topological abelian groups *) +(* ``` *) (* pseudoMetricNormedZmodType R == interface type for a normed topological *) (* Abelian group equipped with a norm *) (* PseudoMetricNormedZmodule.Mixin nb == builds the mixin for a normed *) @@ -18,8 +30,15 @@ Require Import ereal reals signed topology prodnormedzmodule. (* compatibility between the norm and *) (* balls; the carrier type must have a *) (* normed Zmodule over a numDomainType. *) +(* ``` *) +(* *) +(* lower_semicontinuous f == the extented real-valued function f is *) +(* lower-semicontinuous. The type of f is *) +(* X -> \bar R with X : topologicalType and *) +(* R : realType *) (* *) -(* * Normed modules : *) +(* ## Normed modules *) +(* ``` *) (* normedModType K == interface type for a normed module *) (* structure over the numDomainType K. *) (* NormedModMixin normZ == builds the mixin for a normed module *) @@ -36,6 +55,14 @@ Require Import ereal reals signed topology prodnormedzmodule. (* structure on T. *) (* `|x| == the norm of x (notation from ssrnum). *) (* ball_norm == balls defined by the norm. *) +(* edist == the extended distance function for a *) +(* pseudometric X, from X*X -> \bar R *) +(* edist_inf A == the infimum of distances to the set A *) +(* Urysohn A B == a continuous function T -> [0,1] which *) +(* separates A and B when *) +(* `uniform_separator A B` *) +(* uniform_separator A B == There is a suitable uniform space and *) +(* entourage separating A and B *) (* nbhs_norm == neighborhoods defined by the norm. *) (* closed_ball == closure of a ball. *) (* f @`[ a , b ], f @`] a , b [ == notations for images of intervals, *) @@ -48,8 +75,10 @@ Require Import ereal reals signed topology prodnormedzmodule. (* maxr (f a) (f b)]%classic *) (* f @`] a , b [ := `]minr (f a) (f b), *) (* maxr (f a) (f b)[%classic *) +(* ``` *) (* *) -(* * Domination notations: *) +(* ## Domination notations *) +(* ``` *) (* dominated_by h k f F == `|f| <= k * `|h|, near F *) (* bounded_near f F == f is bounded near F *) (* [bounded f x | x in A] == f is bounded on A, ie F := globally A *) @@ -75,21 +104,33 @@ Require Import ereal reals signed topology prodnormedzmodule. (* Rhull A == the real interval hull of a set A *) (* shift x y == y + x *) (* center c := shift (- c) *) +(* ``` *) (* *) -(* * Complete normed modules : *) +(* ## Complete normed modules *) +(* ``` *) (* completeNormedModType K == interface type for a complete normed *) (* module structure over a realFieldType *) (* K. *) (* [completeNormedModType K of T] == clone of a canonical complete normed *) (* module structure over K on T. *) +(* ``` *) (* *) -(* * Filters : *) +(* ## Filters *) +(* ``` *) (* at_left x, at_right x == filters on real numbers for predicates *) (* s.t. nbhs holds on the left/right of x *) +(* ``` *) (* *) -(* --> We used these definitions to prove the intermediate value theorem and *) -(* the Heine-Borel theorem, which states that the compact sets of R^n are *) -(* the closed and bounded sets. *) +(* ``` *) +(* cpoint A == the center of the set A if it is an open ball *) +(* radius A == the radius of the set A if it is an open ball *) +(* Radius A has type {nonneg R} with R a numDomainType. *) +(* is_ball A == boolean predicate that holds when A is an open ball *) +(* k *` A == open ball with center cpoint A and radius k * radius A *) +(* if A is an open ball and set0 o.w. *) +(* vitali_collection_partition B V r n == subset of indices of V such the *) +(* the ball B i has a radius between r/2^n+1 and r/2^n *) +(* ``` *) (* *) (******************************************************************************) @@ -101,6 +142,16 @@ Reserved Notation "x ^'+" (at level 3, format "x ^'+"). Reserved Notation "x ^'-" (at level 3, format "x ^'-"). Reserved Notation "+oo_ R" (at level 3, format "+oo_ R"). Reserved Notation "-oo_ R" (at level 3, format "-oo_ R"). +Reserved Notation "[ 'bounded' E | x 'in' A ]" + (at level 0, x name, format "[ 'bounded' E | x 'in' A ]"). +Reserved Notation "k .-lipschitz_on f" + (at level 2, format "k .-lipschitz_on f"). +Reserved Notation "k .-lipschitz_ A f" + (at level 2, A at level 0, format "k .-lipschitz_ A f"). +Reserved Notation "k .-lipschitz f" (at level 2, format "k .-lipschitz f"). +Reserved Notation "[ 'lipschitz' E | x 'in' A ]" + (at level 0, x name, format "[ 'lipschitz' E | x 'in' A ]"). +Reserved Notation "k *` A" (at level 40, left associativity, format "k *` A"). Set Implicit Arguments. Unset Strict Implicit. @@ -112,39 +163,34 @@ Import numFieldTopology.Exports. Local Open Scope classical_set_scope. Local Open Scope ring_scope. -Definition pointed_of_zmodule (R : zmodType) : pointedType := PointedType R 0. +Section limf_esup_einf. +Variables (T : choiceType) (X : filteredType T) (R : realFieldType). +Implicit Types (f : X -> \bar R) (F : set (set X)). +Local Open Scope ereal_scope. -Definition filtered_of_normedZmod (K : numDomainType) (R : normedZmodType K) - : filteredType R := Filtered.Pack (Filtered.Class - (@Pointed.class (pointed_of_zmodule R)) - (nbhs_ball_ (ball_ (fun x => `|x|)))). +Definition limf_esup f F := ereal_inf [set ereal_sup (f @` V) | V in F]. -Section pseudoMetric_of_normedDomain. -Variables (K : numDomainType) (R : normedZmodType K). -Lemma ball_norm_center (x : R) (e : K) : 0 < e -> ball_ normr x e x. -Proof. by move=> ? /=; rewrite subrr normr0. Qed. -Lemma ball_norm_symmetric (x y : R) (e : K) : - ball_ normr x e y -> ball_ normr y e x. -Proof. by rewrite /= distrC. Qed. -Lemma ball_norm_triangle (x y z : R) (e1 e2 : K) : - ball_ normr x e1 y -> ball_ normr y e2 z -> ball_ normr x (e1 + e2) z. -Proof. -move=> /= ? ?; rewrite -(subr0 x) -(subrr y) opprD opprK (addrA x _ y) -addrA. -by rewrite (le_lt_trans (ler_norm_add _ _)) // ltr_add. -Qed. -Definition pseudoMetric_of_normedDomain - : PseudoMetric.mixin_of K (@entourage_ K R R (ball_ (fun x => `|x|))) - := PseudoMetricMixin ball_norm_center ball_norm_symmetric ball_norm_triangle erefl. +Definition limf_einf f F := - limf_esup (\- f) F. + +Lemma limf_esupE f F : + limf_esup f F = ereal_inf [set ereal_sup (f @` V) | V in F]. +Proof. by []. Qed. -Lemma nbhs_ball_normE : - @nbhs_ball_ K R R (ball_ normr) = nbhs_ (entourage_ (ball_ normr)). +Lemma limf_einfE f F : + limf_einf f F = ereal_sup [set ereal_inf (f @` V) | V in F]. Proof. -rewrite /nbhs_ entourage_E predeq2E => x A; split. - move=> [e egt0 sbeA]. - by exists [set xy | ball_ normr xy.1 e xy.2] => //; exists e. -by move=> [E [e egt0 sbeE] sEA]; exists e => // ??; apply/sEA/sbeE. +rewrite /limf_einf limf_esupE /ereal_inf oppeK -[in RHS]image_comp /=. +congr (ereal_sup [set _ | _ in [set ereal_sup _ | _ in _]]). +by under eq_fun do rewrite -image_comp. Qed. -End pseudoMetric_of_normedDomain. + +Lemma limf_esupN f F : limf_esup (\- f) F = - limf_einf f F. +Proof. by rewrite /limf_einf oppeK. Qed. + +Lemma limf_einfN f F : limf_einf (\- f) F = - limf_esup f F. +Proof. by rewrite /limf_einf; under eq_fun do rewrite oppeK. Qed. + +End limf_esup_einf. Lemma nbhsN (R : numFieldType) (x : R) : nbhs (- x) = -%R @ x. Proof. @@ -182,125 +228,29 @@ move=> [y [[z Az oppzey] [t Bt opptey]]]; exists (- y). by split; [rewrite -oppzey opprK|rewrite -opptey opprK]. Qed. -Module PseudoMetricNormedZmodule. -Section ClassDef. -Variable R : numDomainType. -Record mixin_of (T : normedZmodType R) (ent : set (set (T * T))) - (m : PseudoMetric.mixin_of R ent) := Mixin { - _ : PseudoMetric.ball m = ball_ (fun x => `| x |) }. - -Record class_of (T : Type) := Class { - base : Num.NormedZmodule.class_of R T; - pointed_mixin : Pointed.point_of T ; - nbhs_mixin : Filtered.nbhs_of T T ; - topological_mixin : @Topological.mixin_of T nbhs_mixin ; - uniform_mixin : @Uniform.mixin_of T nbhs_mixin ; - pseudoMetric_mixin : - @PseudoMetric.mixin_of R T (Uniform.entourage uniform_mixin) ; - mixin : @mixin_of (Num.NormedZmodule.Pack _ base) _ pseudoMetric_mixin +Lemma dnbhsN {R : numFieldType} (r : R) : + (- r)%R^' = (fun A => -%R @` A) @` r^'. +Proof. +apply/seteqP; split=> [A [e/= e0 reA]|_/= [A [e/= e0 reA <-]]]. + exists (-%R @` A). + exists e => // x/= rxe xr; exists (- x)%R; rewrite ?opprK//. + by apply: reA; rewrite ?eqr_opp//= opprK addrC distrC. + rewrite image_comp (_ : _ \o _ = idfun) ?image_id// funeqE => x/=. + by rewrite opprK. +exists e => //= x/=; rewrite -opprD normrN => axe xa. +exists (- x)%R; rewrite ?opprK//; apply: reA; rewrite ?eqr_oppLR//=. +by rewrite opprK. +Qed. + +HB.mixin Record NormedZmod_PseudoMetric_eq (R : numDomainType) T + of Num.NormedZmodule R T & PseudoMetric R T := { + pseudo_metric_ball_norm : ball = ball_ (fun x : T => `| x |) }. -Local Coercion base : class_of >-> Num.NormedZmodule.class_of. -Definition base2 T c := @PseudoMetric.Class _ _ - (@Uniform.Class _ - (@Topological.Class _ - (Filtered.Class - (Pointed.Class (@base T c) (pointed_mixin c)) - (nbhs_mixin c)) - (topological_mixin c)) - (uniform_mixin c)) - (pseudoMetric_mixin c). -Local Coercion base2 : class_of >-> PseudoMetric.class_of. -(* TODO: base3? *) - -Structure type (phR : phant R) := - Pack { sort; _ : class_of sort }. -Local Coercion sort : type >-> Sortclass. - -Variables (phR : phant R) (T : Type) (cT : type phR). - -Definition class := let: Pack _ c := cT return class_of cT in c. -Definition clone c of phant_id class c := @Pack phR T c. -Let xT := let: Pack T _ := cT in T. -Notation xclass := (class : class_of xT). -Definition pack (b0 : Num.NormedZmodule.class_of R T) lm0 um0 - (m0 : @mixin_of (@Num.NormedZmodule.Pack R (Phant R) T b0) lm0 um0) := - fun bT (b : Num.NormedZmodule.class_of R T) - & phant_id (@Num.NormedZmodule.class R (Phant R) bT) b => - fun uT (u : PseudoMetric.class_of R T) & phant_id (@PseudoMetric.class R uT) u => - fun (m : @mixin_of (Num.NormedZmodule.Pack _ b) _ u) & phant_id m m0 => - @Pack phR T (@Class T b u u u u u m). - -Definition eqType := @Equality.Pack cT xclass. -Definition choiceType := @Choice.Pack cT xclass. -Definition zmodType := @GRing.Zmodule.Pack cT xclass. -Definition normedZmodType := @Num.NormedZmodule.Pack R phR cT xclass. -Definition pointedType := @Pointed.Pack cT xclass. -Definition filteredType := @Filtered.Pack cT cT xclass. -Definition topologicalType := @Topological.Pack cT xclass. -Definition uniformType := @Uniform.Pack cT xclass. -Definition pseudoMetricType := @PseudoMetric.Pack R cT xclass. -Definition pointed_zmodType := @GRing.Zmodule.Pack pointedType xclass. -Definition filtered_zmodType := @GRing.Zmodule.Pack filteredType xclass. -Definition topological_zmodType := @GRing.Zmodule.Pack topologicalType xclass. -Definition uniform_zmodType := @GRing.Zmodule.Pack uniformType xclass. -Definition pseudoMetric_zmodType := @GRing.Zmodule.Pack pseudoMetricType xclass. -Definition pointed_normedZmodType := @Num.NormedZmodule.Pack R phR pointedType xclass. -Definition filtered_normedZmodType := @Num.NormedZmodule.Pack R phR filteredType xclass. -Definition topological_normedZmodType := @Num.NormedZmodule.Pack R phR topologicalType xclass. -Definition uniform_normedZmodType := @Num.NormedZmodule.Pack R phR uniformType xclass. -Definition pseudoMetric_normedZmodType := @Num.NormedZmodule.Pack R phR pseudoMetricType xclass. - -End ClassDef. - -(*Definition numDomain_normedDomainType (R : numDomainType) : type (Phant R) := - Pack (Phant R) (@Class R _ _ (NumDomain.normed_mixin (NumDomain.class R))).*) - -Module Exports. -Coercion base : class_of >-> Num.NormedZmodule.class_of. -Coercion base2 : class_of >-> PseudoMetric.class_of. -Coercion sort : type >-> Sortclass. -Coercion eqType : type >-> Equality.type. -Canonical eqType. -Coercion choiceType : type >-> Choice.type. -Canonical choiceType. -Coercion zmodType : type >-> GRing.Zmodule.type. -Canonical zmodType. -Coercion normedZmodType : type >-> Num.NormedZmodule.type. -Canonical normedZmodType. -Coercion pointedType : type >-> Pointed.type. -Canonical pointedType. -Coercion filteredType : type >-> Filtered.type. -Canonical filteredType. -Coercion topologicalType : type >-> Topological.type. -Canonical topologicalType. -Coercion uniformType : type >-> Uniform.type. -Canonical uniformType. -Coercion pseudoMetricType : type >-> PseudoMetric.type. -Canonical pseudoMetricType. -Canonical pointed_zmodType. -Canonical filtered_zmodType. -Canonical topological_zmodType. -Canonical uniform_zmodType. -Canonical pseudoMetric_zmodType. -Canonical pointed_normedZmodType. -Canonical filtered_normedZmodType. -Canonical topological_normedZmodType. -Canonical uniform_normedZmodType. -Canonical pseudoMetric_normedZmodType. -Notation pseudoMetricNormedZmodType R := (type (Phant R)). -Notation PseudoMetricNormedZmodType R T m := - (@pack _ (Phant R) T _ _ _ m _ _ idfun _ _ idfun _ idfun). -Notation "[ 'pseudoMetricNormedZmodType' R 'of' T 'for' cT ]" := - (@clone _ (Phant R) T cT _ idfun) - (at level 0, format "[ 'pseudoMetricNormedZmodType' R 'of' T 'for' cT ]") : - form_scope. -Notation "[ 'pseudoMetricNormedZmodType' R 'of' T ]" := - (@clone _ (Phant R) T _ _ idfun) - (at level 0, format "[ 'pseudoMetricNormedZmodType' R 'of' T ]") : form_scope. -End Exports. - -End PseudoMetricNormedZmodule. -Export PseudoMetricNormedZmodule.Exports. + +#[short(type="pseudoMetricNormedZmodType")] +HB.structure Definition PseudoMetricNormedZmod (R : numDomainType) := + {T of Num.NormedZmodule R T & PseudoMetric R T + & NormedZmod_PseudoMetric_eq R T}. Section pseudoMetricnormedzmodule_lemmas. Context {K : numDomainType} {V : pseudoMetricNormedZmodType K}. @@ -308,10 +258,43 @@ Context {K : numDomainType} {V : pseudoMetricNormedZmodType K}. Local Notation ball_norm := (ball_ (@normr K V)). Lemma ball_normE : ball_norm = ball. -Proof. by case: V => ? [? ? ? ? ? ? []]. Qed. +Proof. by rewrite pseudo_metric_ball_norm. Qed. End pseudoMetricnormedzmodule_lemmas. +Lemma bigcup_ballT {R : realType} : \bigcup_n ball (0%R : R) n%:R = setT. +Proof. +apply/seteqP; split => // x _; have [x0|x0] := ltP 0%R x. + exists `|ceil x|.+1 => //. + rewrite /ball /= sub0r normrN gtr0_norm// (le_lt_trans (ceil_ge _))//. + by rewrite -natr1 natr_absz -abszE gtz0_abs// ?ceil_gt0// ltr_pwDr. +exists `|ceil (- x)|.+1 => //. +rewrite /ball /= sub0r normrN ler0_norm// (le_lt_trans (ceil_ge _))//. +rewrite -natr1 natr_absz -abszE gez0_abs ?ceil_ge0// 1?lerNr ?oppr0//. +by rewrite ltr_pwDr. +Qed. + +Section lower_semicontinuous. +Context {X : topologicalType} {R : realType}. +Implicit Types f : X -> \bar R. +Local Open Scope ereal_scope. + +Definition lower_semicontinuous f := forall x a, a%:E < f x -> + exists2 V, nbhs x V & forall y, V y -> a%:E < f y. + +Lemma lower_semicontinuousP f : + lower_semicontinuous f <-> forall a, open [set x | f x > a%:E]. +Proof. +split=> [sci a|openf x a afx]. + rewrite openE /= => x /= /sci[A + Aaf]; rewrite nbhsE /= => -[B xB BA]. + apply: nbhs_singleton; apply: nbhs_interior. + by rewrite nbhsE /=; exists B => // y /BA /=; exact: Aaf. +exists [set x | a%:E < f x] => //. +by rewrite nbhsE/=; exists [set x | a%:E < f x]. +Qed. + +End lower_semicontinuous. + (** neighborhoods *) Section Nbhs'. @@ -364,25 +347,24 @@ apply: Build_ProperFilter => A /nbhs_ballP[_/posnumP[e] Ae]. exists (x + e%:num / 2); apply: Ae; last first. by rewrite eq_sym addrC -subr_eq subrr eq_sym. rewrite /ball /= opprD addrA subrr distrC subr0 ger0_norm //. -by rewrite {2}(splitr e%:num) ltr_spaddl. +by rewrite {2}(splitr e%:num) ltr_pwDl. Qed. -Global Instance Proper_dnbhs_realType (R : realType) (x : R) : - ProperFilter x^'. -Proof. exact: Proper_dnbhs_numFieldType. Qed. +#[global] Hint Extern 0 (ProperFilter _^') => + (apply: Proper_dnbhs_numFieldType) : typeclass_instances. -(** * Some Topology on extended real numbers *) +(** Some Topology on extended real numbers *) -Definition pinfty_nbhs (R : numFieldType) : set (set R) := +Definition pinfty_nbhs (R : numFieldType) : set_system R := fun P => exists M, M \is Num.real /\ forall x, M < x -> P x. Arguments pinfty_nbhs R : clear implicits. -Definition ninfty_nbhs (R : numFieldType) : set (set R) := +Definition ninfty_nbhs (R : numFieldType) : set_system R := fun P => exists M, M \is Num.real /\ forall x, x < M -> P x. Arguments ninfty_nbhs R : clear implicits. -Notation "+oo_ R" := (pinfty_nbhs [numFieldType of R]) +Notation "+oo_ R" := (pinfty_nbhs R) (only parsing) : ring_scope. -Notation "-oo_ R" := (ninfty_nbhs [numFieldType of R]) +Notation "-oo_ R" := (ninfty_nbhs R) (only parsing) : ring_scope. Notation "+oo" := (pinfty_nbhs _) : ring_scope. @@ -390,13 +372,12 @@ Notation "-oo" := (ninfty_nbhs _) : ring_scope. Section infty_nbhs_instances. Context {R : numFieldType}. -Let R_topologicalType := [topologicalType of R]. Implicit Types r : R. Global Instance proper_pinfty_nbhs : ProperFilter (pinfty_nbhs R). Proof. apply Build_ProperFilter. - by move=> P [M [Mreal MP]]; exists (M + 1); apply MP; rewrite ltr_addl. + by move=> P [M [Mreal MP]]; exists (M + 1); apply MP; rewrite ltrDl. split=> /= [|P Q [MP [MPr gtMP]] [MQ [MQr gtMQ]] |P Q sPQ [M [Mr gtM]]]. - by exists 0. - exists (maxr MP MQ); split=> [|x]; first exact: max_real. @@ -408,7 +389,7 @@ Global Instance proper_ninfty_nbhs : ProperFilter (ninfty_nbhs R). Proof. apply Build_ProperFilter. move=> P [M [Mr ltMP]]; exists (M - 1). - by apply: ltMP; rewrite gtr_addl oppr_lt0. + by apply: ltMP; rewrite gtrDl oppr_lt0. split=> /= [|P Q [MP [MPr ltMP]] [MQ [MQr ltMQ]] |P Q sPQ [M [Mr ltM]]]. - by exists 0. - exists (Num.min MP MQ); split=> [|x]; first exact: min_real. @@ -456,7 +437,7 @@ Lemma near_pinfty_div2 (A : set R) : (\forall k \near +oo, A k) -> (\forall k \near +oo, A (k / 2)). Proof. move=> [M [Mreal AM]]; exists (M * 2); split; first by rewrite realM. -by move=> x; rewrite -ltr_pdivl_mulr //; exact: AM. +by move=> x; rewrite -ltr_pdivlMr //; exact: AM. Qed. End infty_nbhs_instances. @@ -490,7 +471,7 @@ End infty_nbhs_instances. Section cvg_infty_numField. Context {R : numFieldType}. -Let cvgryPnum {F : set (set R)} {FF : Filter F} : [<-> +Let cvgryPnum {F : set_system R} {FF : Filter F} : [<-> (* 0 *) F --> +oo; (* 1 *) forall A, A \is Num.real -> \forall x \near F, A <= x; (* 2 *) forall A, A \is Num.real -> \forall x \near F, A < x; @@ -506,7 +487,7 @@ case=> [A [AR AF]] P [x [xR Px]]; near +oo_R => B. by near do [apply: Px; apply: (@lt_le_trans _ _ B) => //]; apply: AF. Unshelve. all: by end_near. Qed. -Let cvgrNyPnum {F : set (set R)} {FF : Filter F} : [<-> +Let cvgrNyPnum {F : set_system R} {FF : Filter F} : [<-> (* 0 *) F --> -oo; (* 1 *) forall A, A \is Num.real -> \forall x \near F, A >= x; (* 2 *) forall A, A \is Num.real -> \forall x \near F, A > x; @@ -522,7 +503,7 @@ case=> [A [AR AF]] P [x [xR Px]]; near -oo_R => B. by near do [apply: Px; apply: (@le_lt_trans _ _ B) => //]; apply: AF. Unshelve. all: end_near. Qed. -Context {T} {F : set (set T)} {FF : Filter F}. +Context {T} {F : set_system T} {FF : Filter F}. Implicit Types f : T -> R. Lemma cvgryPger f : @@ -576,7 +557,7 @@ Proof. by rewrite cvgrNyPltr. Qed. Lemma cvgNry f : (- f @ F --> +oo) <-> (f @ F --> -oo). Proof. rewrite cvgrNyPler cvgryPger; split=> Foo A Areal; -by near do rewrite -ler_opp2 ?opprK; apply: Foo; rewrite rpredN. +by near do rewrite -lerN2 ?opprK; apply: Foo; rewrite rpredN. Unshelve. all: end_near. Qed. Lemma cvgNrNy f : (- f @ F --> -oo) <-> (f @ F --> +oo). @@ -586,7 +567,7 @@ End cvg_infty_numField. Section cvg_infty_realField. Context {R : realFieldType}. -Context {T} {F : set (set T)} {FF : Filter F} (f : T -> R). +Context {T} {F : set_system T} {FF : Filter F} (f : T -> R). Lemma cvgryPge : f @ F --> +oo <-> forall A, \forall x \near F, A <= f x. Proof. @@ -622,7 +603,7 @@ Proof. by rewrite cvgrNyPlt. Qed. End cvg_infty_realField. -Lemma cvgrnyP {R : realType} {T} {F : set (set T)} {FF : Filter F} (f : T -> nat) : +Lemma cvgrnyP {R : realType} {T} {F : set_system T} {FF : Filter F} (f : T -> nat) : (((f n)%:R : R) @[n --> F] --> +oo) <-> (f @ F --> \oo). Proof. split=> [/cvgryPge|/cvgnyPge] Foo. @@ -637,7 +618,7 @@ Local Open Scope ereal_scope. Context {R : numFieldType}. -Let cvgeyPnum {F : set (set \bar R)} {FF : Filter F} : [<-> +Let cvgeyPnum {F : set_system \bar R} {FF : Filter F} : [<-> (* 0 *) F --> +oo; (* 1 *) forall A, A \is Num.real -> \forall x \near F, A%:E <= x; (* 2 *) forall A, A \is Num.real -> \forall x \near F, A%:E < x; @@ -653,7 +634,7 @@ case=> [A [AR AF]] P [x [xR Px]]; near +oo_R => B. by near do [apply: Px; rewrite (@lt_le_trans _ _ B%:E) ?lte_fin//]; apply: AF. Unshelve. all: end_near. Qed. -Let cvgeNyPnum {F : set (set \bar R)} {FF : Filter F} : [<-> +Let cvgeNyPnum {F : set_system \bar R} {FF : Filter F} : [<-> (* 0 *) F --> -oo; (* 1 *) forall A, A \is Num.real -> \forall x \near F, A%:E >= x; (* 2 *) forall A, A \is Num.real -> \forall x \near F, A%:E > x; @@ -669,7 +650,7 @@ case=> [A [AR AF]] P [x [xR Px]]; near -oo_R => B. by near do [apply: Px; rewrite (@le_lt_trans _ _ B%:E) ?lte_fin//]; apply: AF. Unshelve. all: end_near. Qed. -Context {T} {F : set (set T)} {FF : Filter F}. +Context {T} {F : set_system T} {FF : Filter F}. Implicit Types (f : T -> \bar R) (u : T -> R). Lemma cvgeyPger f : @@ -750,7 +731,7 @@ End ecvg_infty_numField. Section ecvg_infty_realField. Local Open Scope ereal_scope. Context {R : realFieldType}. -Context {T} {F : set (set T)} {FF : Filter F} (f : T -> \bar R). +Context {T} {F : set_system T} {FF : Filter F} (f : T -> \bar R). Lemma cvgeyPge : f @ F --> +oo <-> forall A, \forall x \near F, A%:E <= f x. Proof. @@ -786,798 +767,125 @@ Proof. by rewrite cvgeNyPlt. Qed. End ecvg_infty_realField. -Lemma cvgenyP {R : realType} {T} {F : set (set T)} {FF : Filter F} (f : T -> nat) : +Lemma cvgenyP {R : realType} {T} {F : set_system T} {FF : Filter F} (f : T -> nat) : (((f n)%:R : R)%:E @[n --> F] --> +oo%E) <-> (f @ F --> \oo). Proof. by rewrite cvgeryP cvgrnyP. Qed. -(** ** Modules with a norm *) +(** Modules with a norm *) -Module NormedModule. - -Record mixin_of (K : numDomainType) - (V : pseudoMetricNormedZmodType K) (scale : K -> V -> V) := Mixin { - _ : forall (l : K) (x : V), `| scale l x | = `| l | * `| x |; +HB.mixin Record PseudoMetricNormedZmod_Lmodule_isNormedModule K V + of PseudoMetricNormedZmod K V & GRing.Lmodule K V := { + normrZ : forall (l : K) (x : V), `| l *: x | = `| l | * `| x |; }. -Section ClassDef. - -Variable K : numDomainType. - -Record class_of (T : Type) := Class { - base : PseudoMetricNormedZmodule.class_of K T ; - lmodmixin : GRing.Lmodule.mixin_of K (GRing.Zmodule.Pack base) ; - mixin : @mixin_of K (PseudoMetricNormedZmodule.Pack (Phant K) base) - (GRing.Lmodule.scale lmodmixin) -}. -Local Coercion base : class_of >-> PseudoMetricNormedZmodule.class_of. -Local Coercion base2 T (c : class_of T) : GRing.Lmodule.class_of K T := - @GRing.Lmodule.Class K T (base c) (lmodmixin c). -Local Coercion mixin : class_of >-> mixin_of. - -Structure type (phK : phant K) := - Pack { sort; _ : class_of sort }. -Local Coercion sort : type >-> Sortclass. - -Variables (phK : phant K) (T : Type) (cT : type phK). - -Definition class := let: Pack _ c := cT return class_of cT in c. -Definition clone c of phant_id class c := @Pack phK T c. -Let xT := let: Pack T _ := cT in T. -Notation xclass := (class : class_of xT). - -Definition pack b0 l0 - (m0 : @mixin_of K (@PseudoMetricNormedZmodule.Pack K (Phant K) T b0) - (GRing.Lmodule.scale l0)) := - fun bT b & phant_id (@PseudoMetricNormedZmodule.class K (Phant K) bT) b => - fun l & phant_id l0 l => - fun m & phant_id m0 m => Pack phK (@Class T b l m). - -Definition eqType := @Equality.Pack cT xclass. -Definition choiceType := @Choice.Pack cT xclass. -Definition zmodType := @GRing.Zmodule.Pack cT xclass. -Definition normedZmodType := @Num.NormedZmodule.Pack K phK cT xclass. -Definition lmodType := @GRing.Lmodule.Pack K phK cT xclass. -Definition pointedType := @Pointed.Pack cT xclass. -Definition filteredType := @Filtered.Pack cT cT xclass. -Definition topologicalType := @Topological.Pack cT xclass. -Definition uniformType := @Uniform.Pack cT xclass. -Definition pseudoMetricType := @PseudoMetric.Pack K cT xclass. -Definition pseudoMetricNormedZmodType := @PseudoMetricNormedZmodule.Pack K phK cT xclass. -Definition pointed_lmodType := @GRing.Lmodule.Pack K phK pointedType xclass. -Definition filtered_lmodType := @GRing.Lmodule.Pack K phK filteredType xclass. -Definition topological_lmodType := @GRing.Lmodule.Pack K phK topologicalType xclass. -Definition uniform_lmodType := @GRing.Lmodule.Pack K phK uniformType xclass. -Definition pseudoMetric_lmodType := @GRing.Lmodule.Pack K phK pseudoMetricType xclass. -Definition normedZmod_lmodType := @GRing.Lmodule.Pack K phK normedZmodType xclass. -Definition pseudoMetricNormedZmod_lmodType := @GRing.Lmodule.Pack K phK pseudoMetricNormedZmodType xclass. -End ClassDef. - -Module Exports. - -Coercion base : class_of >-> PseudoMetricNormedZmodule.class_of. -Coercion base2 : class_of >-> GRing.Lmodule.class_of. -Coercion mixin : class_of >-> mixin_of. -Coercion sort : type >-> Sortclass. -Coercion eqType : type >-> Equality.type. -Canonical eqType. -Coercion choiceType : type >-> Choice.type. -Canonical choiceType. -Coercion zmodType : type >-> GRing.Zmodule.type. -Canonical zmodType. -Coercion normedZmodType : type >-> Num.NormedZmodule.type. -Canonical normedZmodType. -Coercion lmodType : type >-> GRing.Lmodule.type. -Canonical lmodType. -Coercion pointedType : type >-> Pointed.type. -Canonical pointedType. -Coercion filteredType : type >-> Filtered.type. -Canonical filteredType. -Coercion topologicalType : type >-> Topological.type. -Canonical topologicalType. -Coercion uniformType : type >-> Uniform.type. -Canonical uniformType. -Coercion pseudoMetricType : type >-> PseudoMetric.type. -Canonical pseudoMetricType. -Coercion pseudoMetricNormedZmodType : type >-> PseudoMetricNormedZmodule.type. -Canonical pseudoMetricNormedZmodType. -Canonical pointed_lmodType. -Canonical filtered_lmodType. -Canonical topological_lmodType. -Canonical uniform_lmodType. -Canonical pseudoMetric_lmodType. -Canonical normedZmod_lmodType. -Canonical pseudoMetricNormedZmod_lmodType. -Notation normedModType K := (type (Phant K)). -Notation NormedModType K T m := (@pack _ (Phant K) T _ _ m _ _ idfun _ idfun _ idfun). -Notation NormedModMixin := Mixin. -Notation "[ 'normedModType' K 'of' T 'for' cT ]" := (@clone _ (Phant K) T cT _ idfun) - (at level 0, format "[ 'normedModType' K 'of' T 'for' cT ]") : form_scope. -Notation "[ 'normedModType' K 'of' T ]" := (@clone _ (Phant K) T _ _ id) - (at level 0, format "[ 'normedModType' K 'of' T ]") : form_scope. -End Exports. - -End NormedModule. - -Export NormedModule.Exports. - -Module regular_topology. +#[short(type="normedModType")] +HB.structure Definition NormedModule (K : numDomainType) := + {T of PseudoMetricNormedZmod K T & GRing.Lmodule K T + & PseudoMetricNormedZmod_Lmodule_isNormedModule K T}. Section regular_topology. -Local Canonical pseudoMetricNormedZmodType (R : numFieldType) := - @PseudoMetricNormedZmodType - R R^o - (PseudoMetricNormedZmodule.Mixin (erefl : @ball _ R = ball_ Num.norm)). -Local Canonical normedModType (R : numFieldType) := - NormedModType R R^o (@NormedModMixin _ _ ( *:%R : R -> R^o -> _) (@normrM _)). -End regular_topology. -Module Exports. -Canonical pseudoMetricNormedZmodType. -Canonical normedModType. -End Exports. +Variable R : numFieldType. + +HB.instance Definition _ := Num.NormedZmodule.on R^o. +HB.instance Definition _ := NormedZmod_PseudoMetric_eq.Build R R^o erefl. +HB.instance Definition _ := + PseudoMetricNormedZmod_Lmodule_isNormedModule.Build R R^o (@normrM _). End regular_topology. -Export regular_topology.Exports. Module numFieldNormedType. Section realType. Variable (R : realType). -Local Canonical real_lmodType := [lmodType R of R for [lmodType R of R^o]]. -Local Canonical real_lalgType := [lalgType R of R for [lalgType R of R^o]]. -Local Canonical real_algType := [algType R of R for [algType R of R^o]]. -Local Canonical real_comAlgType := [comAlgType R of R]. -Local Canonical real_unitAlgType := [unitAlgType R of R]. -Local Canonical real_comUnitAlgType := [comUnitAlgType R of R]. -Local Canonical real_vectType := [vectType R of R for [vectType R of R^o]]. -Local Canonical real_FalgType := [FalgType R of R]. -Local Canonical real_fieldExtType := - [fieldExtType R of R for [fieldExtType R of R^o]]. -Local Canonical real_pseudoMetricNormedZmodType := - [pseudoMetricNormedZmodType R of R for [pseudoMetricNormedZmodType R of R^o]]. -Local Canonical real_normedModType := - [normedModType R of R for [normedModType R of R^o]]. +#[export, non_forgetful_inheritance] +HB.instance Definition _ := GRing.ComAlgebra.copy R R^o. +#[export, non_forgetful_inheritance] +HB.instance Definition _ := Vector.copy R R^o. +#[export, non_forgetful_inheritance] +HB.instance Definition _ := NormedModule.copy R R^o. End realType. Section rcfType. Variable (R : rcfType). -Local Canonical rcf_lmodType := [lmodType R of R for [lmodType R of R^o]]. -Local Canonical rcf_lalgType := [lalgType R of R for [lalgType R of R^o]]. -Local Canonical rcf_algType := [algType R of R for [algType R of R^o]]. -Local Canonical rcf_comAlgType := [comAlgType R of R]. -Local Canonical rcf_unitAlgType := [unitAlgType R of R]. -Local Canonical rcf_comUnitAlgType := [comUnitAlgType R of R]. -Local Canonical rcf_vectType := [vectType R of R for [vectType R of R^o]]. -Local Canonical rcf_FalgType := [FalgType R of R]. -Local Canonical rcf_fieldExtType := - [fieldExtType R of R for [fieldExtType R of R^o]]. -Local Canonical rcf_pseudoMetricNormedZmodType := - [pseudoMetricNormedZmodType R of R for [pseudoMetricNormedZmodType R of R^o]]. -Local Canonical rcf_normedModType := - [normedModType R of R for [normedModType R of R^o]]. +#[export, non_forgetful_inheritance] +HB.instance Definition _ := GRing.ComAlgebra.copy R R^o. +#[export, non_forgetful_inheritance] +HB.instance Definition _ := Vector.copy R R^o. +#[export, non_forgetful_inheritance] +HB.instance Definition _ := NormedModule.copy R R^o. End rcfType. Section archiFieldType. Variable (R : archiFieldType). -Local Canonical archiField_lmodType := - [lmodType R of R for [lmodType R of R^o]]. -Local Canonical archiField_lalgType := - [lalgType R of R for [lalgType R of R^o]]. -Local Canonical archiField_algType := [algType R of R for [algType R of R^o]]. -Local Canonical archiField_comAlgType := [comAlgType R of R]. -Local Canonical archiField_unitAlgType := [unitAlgType R of R]. -Local Canonical archiField_comUnitAlgType := [comUnitAlgType R of R]. -Local Canonical archiField_vectType := - [vectType R of R for [vectType R of R^o]]. -Local Canonical archiField_FalgType := [FalgType R of R]. -Local Canonical archiField_fieldExtType := - [fieldExtType R of R for [fieldExtType R of R^o]]. -Local Canonical archiField_pseudoMetricNormedZmodType := - [pseudoMetricNormedZmodType R of R for [pseudoMetricNormedZmodType R of R^o]]. -Local Canonical archiField_normedModType := - [normedModType R of R for [normedModType R of R^o]]. +#[export, non_forgetful_inheritance] +HB.instance Definition _ := GRing.ComAlgebra.copy R R^o. +#[export, non_forgetful_inheritance] +HB.instance Definition _ := Vector.copy R R^o. +#[export, non_forgetful_inheritance] +HB.instance Definition _ := NormedModule.copy R R^o. End archiFieldType. Section realFieldType. Variable (R : realFieldType). -Local Canonical realField_lmodType := [lmodType R of R for [lmodType R of R^o]]. -Local Canonical realField_lalgType := [lalgType R of R for [lalgType R of R^o]]. -Local Canonical realField_algType := [algType R of R for [algType R of R^o]]. -Local Canonical realField_comAlgType := [comAlgType R of R]. -Local Canonical realField_unitAlgType := [unitAlgType R of R]. -Local Canonical realField_comUnitAlgType := [comUnitAlgType R of R]. -Local Canonical realField_vectType := [vectType R of R for [vectType R of R^o]]. -Local Canonical realField_FalgType := [FalgType R of R]. -Local Canonical realField_fieldExtType := - [fieldExtType R of R for [fieldExtType R of R^o]]. -Local Canonical realField_pseudoMetricNormedZmodType := - [pseudoMetricNormedZmodType R of R for [pseudoMetricNormedZmodType R of R^o]]. -Local Canonical realField_normedModType := - [normedModType R of R for [normedModType R of R^o]]. -Definition lmod_latticeType := [latticeType of realField_lmodType]. -Definition lmod_distrLatticeType := [distrLatticeType of realField_lmodType]. -Definition lmod_orderType := [orderType of realField_lmodType]. -Definition lmod_realDomainType := [realDomainType of realField_lmodType]. -Definition lalg_latticeType := [latticeType of realField_lalgType]. -Definition lalg_distrLatticeType := [distrLatticeType of realField_lalgType]. -Definition lalg_orderType := [orderType of realField_lalgType]. -Definition lalg_realDomainType := [realDomainType of realField_lalgType]. -Definition alg_latticeType := [latticeType of realField_algType]. -Definition alg_distrLatticeType := [distrLatticeType of realField_algType]. -Definition alg_orderType := [orderType of realField_algType]. -Definition alg_realDomainType := [realDomainType of realField_algType]. -Definition comAlg_latticeType := [latticeType of realField_comAlgType]. -Definition comAlg_distrLatticeType := - [distrLatticeType of realField_comAlgType]. -Definition comAlg_orderType := [orderType of realField_comAlgType]. -Definition comAlg_realDomainType := [realDomainType of realField_comAlgType]. -Definition unitAlg_latticeType := [latticeType of realField_unitAlgType]. -Definition unitAlg_distrLatticeType := - [distrLatticeType of realField_unitAlgType]. -Definition unitAlg_orderType := [orderType of realField_unitAlgType]. -Definition unitAlg_realDomainType := [realDomainType of realField_unitAlgType]. -Definition comUnitAlg_latticeType := [latticeType of realField_comUnitAlgType]. -Definition comUnitAlg_distrLatticeType := - [distrLatticeType of realField_comUnitAlgType]. -Definition comUnitAlg_orderType := [orderType of realField_comUnitAlgType]. -Definition comUnitAlg_realDomainType := - [realDomainType of realField_comUnitAlgType]. -Definition vect_latticeType := [latticeType of realField_vectType]. -Definition vect_distrLatticeType := [distrLatticeType of realField_vectType]. -Definition vect_orderType := [orderType of realField_vectType]. -Definition vect_realDomainType := [realDomainType of realField_vectType]. -Definition Falg_latticeType := [latticeType of realField_FalgType]. -Definition Falg_distrLatticeType := [distrLatticeType of realField_FalgType]. -Definition Falg_orderType := [orderType of realField_FalgType]. -Definition Falg_realDomainType := [realDomainType of realField_FalgType]. -Definition fieldExt_latticeType := [latticeType of realField_fieldExtType]. -Definition fieldExt_distrLatticeType := - [distrLatticeType of realField_fieldExtType]. -Definition fieldExt_orderType := [orderType of realField_fieldExtType]. -Definition fieldExt_realDomainType := - [realDomainType of realField_fieldExtType]. -Definition pseudoMetricNormedZmod_latticeType := - [latticeType of realField_pseudoMetricNormedZmodType]. -Definition pseudoMetricNormedZmod_distrLatticeType := - [distrLatticeType of realField_pseudoMetricNormedZmodType]. -Definition pseudoMetricNormedZmod_orderType := - [orderType of realField_pseudoMetricNormedZmodType]. -Definition pseudoMetricNormedZmod_realDomainType := - [realDomainType of realField_pseudoMetricNormedZmodType]. -Definition normedMod_latticeType := [latticeType of realField_normedModType]. -Definition normedMod_distrLatticeType := - [distrLatticeType of realField_normedModType]. -Definition normedMod_orderType := [orderType of realField_normedModType]. -Definition normedMod_realDomainType := - [realDomainType of realField_normedModType]. +#[export, non_forgetful_inheritance] +HB.instance Definition _ := GRing.ComAlgebra.copy R R^o. +#[export, non_forgetful_inheritance] +HB.instance Definition _ := Vector.copy R R^o. +#[export, non_forgetful_inheritance] +HB.instance Definition _ := NormedModule.copy R R^o. +#[export, non_forgetful_inheritance] +HB.instance Definition _ := Num.RealField.on R. End realFieldType. Section numClosedFieldType. Variable (R : numClosedFieldType). -Local Canonical numClosedField_lmodType := - [lmodType R of R for [lmodType R of R^o]]. -Local Canonical numClosedField_lalgType := - [lalgType R of R for [lalgType R of R^o]]. -Local Canonical numClosedField_algType := - [algType R of R for [algType R of R^o]]. -Local Canonical numClosedField_comAlgType := [comAlgType R of R]. -Local Canonical numClosedField_unitAlgType := [unitAlgType R of R]. -Local Canonical numClosedField_comUnitAlgType := [comUnitAlgType R of R]. -Local Canonical numClosedField_vectType := - [vectType R of R for [vectType R of R^o]]. -Local Canonical numClosedField_FalgType := [FalgType R of R]. -Local Canonical numClosedField_fieldExtType := - [fieldExtType R of R for [fieldExtType R of R^o]]. -Local Canonical numClosedField_pseudoMetricNormedZmodType := - [pseudoMetricNormedZmodType R of R for [pseudoMetricNormedZmodType R of R^o]]. -Local Canonical numClosedField_normedModType := - [normedModType R of R for [normedModType R of R^o]]. -Definition lmod_decFieldType := [decFieldType of numClosedField_lmodType]. -Definition lmod_closedFieldType := [closedFieldType of numClosedField_lmodType]. -Definition lalg_decFieldType := [decFieldType of numClosedField_lalgType]. -Definition lalg_closedFieldType := [closedFieldType of numClosedField_lalgType]. -Definition alg_decFieldType := [decFieldType of numClosedField_algType]. -Definition alg_closedFieldType := [closedFieldType of numClosedField_algType]. -Definition comAlg_decFieldType := [decFieldType of numClosedField_comAlgType]. -Definition comAlg_closedFieldType := - [closedFieldType of numClosedField_comAlgType]. -Definition unitAlg_decFieldType := [decFieldType of numClosedField_unitAlgType]. -Definition unitAlg_closedFieldType := - [closedFieldType of numClosedField_unitAlgType]. -Definition comUnitAlg_decFieldType := - [decFieldType of numClosedField_comUnitAlgType]. -Definition comUnitAlg_closedFieldType := - [closedFieldType of numClosedField_comUnitAlgType]. -Definition vect_decFieldType := [decFieldType of numClosedField_vectType]. -Definition vect_closedFieldType := [closedFieldType of numClosedField_vectType]. -Definition Falg_decFieldType := [decFieldType of numClosedField_FalgType]. -Definition Falg_closedFieldType := [closedFieldType of numClosedField_FalgType]. -Definition fieldExt_decFieldType := - [decFieldType of numClosedField_fieldExtType]. -Definition fieldExt_closedFieldType := - [closedFieldType of numClosedField_fieldExtType]. -Definition pseudoMetricNormedZmod_decFieldType := - [decFieldType of numClosedField_pseudoMetricNormedZmodType]. -Definition pseudoMetricNormedZmod_closedFieldType := - [closedFieldType of numClosedField_pseudoMetricNormedZmodType]. -Definition normedMod_decFieldType := - [decFieldType of numClosedField_normedModType]. -Definition normedMod_closedFieldType := - [closedFieldType of numClosedField_normedModType]. +#[export, non_forgetful_inheritance] +HB.instance Definition _ := GRing.ComAlgebra.copy R R^o. +#[export, non_forgetful_inheritance] +HB.instance Definition _ := Vector.copy R R^o. +#[export, non_forgetful_inheritance] +HB.instance Definition _ := NormedModule.copy R R^o. +#[export, non_forgetful_inheritance] +HB.instance Definition _ := Num.ClosedField.on R. End numClosedFieldType. Section numFieldType. Variable (R : numFieldType). -Local Canonical numField_lmodType := [lmodType R of R for [lmodType R of R^o]]. -Local Canonical numField_lalgType := [lalgType R of R for [lalgType R of R^o]]. -Local Canonical numField_algType := [algType R of R for [algType R of R^o]]. -Local Canonical numField_comAlgType := [comAlgType R of R]. -Local Canonical numField_unitAlgType := [unitAlgType R of R]. -Local Canonical numField_comUnitAlgType := [comUnitAlgType R of R]. -Local Canonical numField_vectType := [vectType R of R for [vectType R of R^o]]. -Local Canonical numField_FalgType := [FalgType R of R]. -Local Canonical numField_fieldExtType := - [fieldExtType R of R for [fieldExtType R of R^o]]. -Local Canonical numField_pseudoMetricNormedZmodType := - [pseudoMetricNormedZmodType R of R for [pseudoMetricNormedZmodType R of R^o]]. -Local Canonical numField_normedModType := - [normedModType R of R for [normedModType R of R^o]]. -Definition lmod_porderType := [porderType of numField_lmodType]. -Definition lmod_numDomainType := [numDomainType of numField_lmodType]. -Definition lalg_pointedType := [pointedType of numField_lalgType]. -Definition lalg_filteredType := [filteredType R of numField_lalgType]. -Definition lalg_topologicalType := [topologicalType of numField_lalgType]. -Definition lalg_uniformType := [uniformType of numField_lalgType]. -Definition lalg_pseudoMetricType := [pseudoMetricType R of numField_lalgType]. -Definition lalg_normedZmodType := [normedZmodType R of numField_lalgType]. -Definition lalg_pseudoMetricNormedZmodType := - [pseudoMetricNormedZmodType R of numField_lalgType]. -Definition lalg_normedModType := [normedModType R of numField_lalgType]. -Definition lalg_porderType := [porderType of numField_lalgType]. -Definition lalg_numDomainType := [numDomainType of numField_lalgType]. -Definition alg_pointedType := [pointedType of numField_algType]. -Definition alg_filteredType := [filteredType R of numField_algType]. -Definition alg_topologicalType := [topologicalType of numField_algType]. -Definition alg_uniformType := [uniformType of numField_algType]. -Definition alg_pseudoMetricType := [pseudoMetricType R of numField_algType]. -Definition alg_normedZmodType := [normedZmodType R of numField_algType]. -Definition alg_pseudoMetricNormedZmodType := - [pseudoMetricNormedZmodType R of numField_algType]. -Definition alg_normedModType := [normedModType R of numField_algType]. -Definition alg_porderType := [porderType of numField_algType]. -Definition alg_numDomainType := [numDomainType of numField_algType]. -Definition comAlg_pointedType := [pointedType of numField_comAlgType]. -Definition comAlg_filteredType := [filteredType R of numField_comAlgType]. -Definition comAlg_topologicalType := [topologicalType of numField_comAlgType]. -Definition comAlg_uniformType := [uniformType of numField_comAlgType]. -Definition comAlg_pseudoMetricType := - [pseudoMetricType R of numField_comAlgType]. -Definition comAlg_normedZmodType := [normedZmodType R of numField_comAlgType]. -Definition comAlg_pseudoMetricNormedZmodType := - [pseudoMetricNormedZmodType R of numField_comAlgType]. -Definition comAlg_normedModType := [normedModType R of numField_comAlgType]. -Definition comAlg_porderType := [porderType of numField_comAlgType]. -Definition comAlg_numDomainType := [numDomainType of numField_comAlgType]. -Definition unitAlg_pointedType := [pointedType of numField_unitAlgType]. -Definition unitAlg_filteredType := [filteredType R of numField_unitAlgType]. -Definition unitAlg_topologicalType := [topologicalType of numField_unitAlgType]. -Definition unitAlg_uniformType := [uniformType of numField_unitAlgType]. -Definition unitAlg_pseudoMetricType := - [pseudoMetricType R of numField_unitAlgType]. -Definition unitAlg_normedZmodType := [normedZmodType R of numField_unitAlgType]. -Definition unitAlg_pseudoMetricNormedZmodType := - [pseudoMetricNormedZmodType R of numField_unitAlgType]. -Definition unitAlg_normedModType := [normedModType R of numField_unitAlgType]. -Definition unitAlg_porderType := [porderType of numField_unitAlgType]. -Definition unitAlg_numDomainType := [numDomainType of numField_unitAlgType]. -Definition comUnitAlg_pointedType := [pointedType of numField_comUnitAlgType]. -Definition comUnitAlg_filteredType := - [filteredType R of numField_comUnitAlgType]. -Definition comUnitAlg_topologicalType := - [topologicalType of numField_comUnitAlgType]. -Definition comUnitAlg_uniformType := [uniformType of numField_comUnitAlgType]. -Definition comUnitAlg_pseudoMetricType := - [pseudoMetricType R of numField_comUnitAlgType]. -Definition comUnitAlg_normedZmodType := - [normedZmodType R of numField_comUnitAlgType]. -Definition comUnitAlg_pseudoMetricNormedZmodType := - [pseudoMetricNormedZmodType R of numField_comUnitAlgType]. -Definition comUnitAlg_normedModType := - [normedModType R of numField_comUnitAlgType]. -Definition comUnitAlg_porderType := [porderType of numField_comUnitAlgType]. -Definition comUnitAlg_numDomainType := - [numDomainType of numField_comUnitAlgType]. -Definition vect_pointedType := [pointedType of numField_vectType]. -Definition vect_filteredType := [filteredType R of numField_vectType]. -Definition vect_topologicalType := [topologicalType of numField_vectType]. -Definition vect_uniformType := [uniformType of numField_vectType]. -Definition vect_pseudoMetricType := [pseudoMetricType R of numField_vectType]. -Definition vect_normedZmodType := [normedZmodType R of numField_vectType]. -Definition vect_pseudoMetricNormedZmodType := - [pseudoMetricNormedZmodType R of numField_vectType]. -Definition vect_normedModType := [normedModType R of numField_vectType]. -Definition vect_porderType := [porderType of numField_vectType]. -Definition vect_numDomainType := [numDomainType of numField_vectType]. -Definition Falg_pointedType := [pointedType of numField_FalgType]. -Definition Falg_filteredType := [filteredType R of numField_FalgType]. -Definition Falg_topologicalType := [topologicalType of numField_FalgType]. -Definition Falg_uniformType := [uniformType of numField_FalgType]. -Definition Falg_pseudoMetricType := [pseudoMetricType R of numField_FalgType]. -Definition Falg_normedZmodType := [normedZmodType R of numField_FalgType]. -Definition Falg_pseudoMetricNormedZmodType := - [pseudoMetricNormedZmodType R of numField_FalgType]. -Definition Falg_normedModType := [normedModType R of numField_FalgType]. -Definition Falg_porderType := [porderType of numField_FalgType]. -Definition Falg_numDomainType := [numDomainType of numField_FalgType]. -Definition fieldExt_pointedType := [pointedType of numField_fieldExtType]. -Definition fieldExt_filteredType := [filteredType R of numField_fieldExtType]. -Definition fieldExt_topologicalType := - [topologicalType of numField_fieldExtType]. -Definition fieldExt_uniformType := [uniformType of numField_fieldExtType]. -Definition fieldExt_pseudoMetricType := - [pseudoMetricType R of numField_fieldExtType]. -Definition fieldExt_normedZmodType := - [normedZmodType R of numField_fieldExtType]. -Definition fieldExt_pseudoMetricNormedZmodType := - [pseudoMetricNormedZmodType R of numField_fieldExtType]. -Definition fieldExt_normedModType := [normedModType R of numField_fieldExtType]. -Definition fieldExt_porderType := [porderType of numField_fieldExtType]. -Definition fieldExt_numDomainType := [numDomainType of numField_fieldExtType]. -Definition pseudoMetricNormedZmod_ringType := - [ringType of numField_pseudoMetricNormedZmodType]. -Definition pseudoMetricNormedZmod_comRingType := - [comRingType of numField_pseudoMetricNormedZmodType]. -Definition pseudoMetricNormedZmod_unitRingType := - [unitRingType of numField_pseudoMetricNormedZmodType]. -Definition pseudoMetricNormedZmod_comUnitRingType := - [comUnitRingType of numField_pseudoMetricNormedZmodType]. -Definition pseudoMetricNormedZmod_idomainType := - [idomainType of numField_pseudoMetricNormedZmodType]. -Definition pseudoMetricNormedZmod_fieldType := - [fieldType of numField_pseudoMetricNormedZmodType]. -Definition pseudoMetricNormedZmod_porderType := - [porderType of numField_pseudoMetricNormedZmodType]. -Definition pseudoMetricNormedZmod_numDomainType := - [numDomainType of numField_pseudoMetricNormedZmodType]. -Definition normedMod_ringType := [ringType of numField_normedModType]. -Definition normedMod_comRingType := [comRingType of numField_normedModType]. -Definition normedMod_unitRingType := [unitRingType of numField_normedModType]. -Definition normedMod_comUnitRingType := - [comUnitRingType of numField_normedModType]. -Definition normedMod_idomainType := [idomainType of numField_normedModType]. -Definition normedMod_fieldType := [fieldType of numField_normedModType]. -Definition normedMod_porderType := [porderType of numField_normedModType]. -Definition normedMod_numDomainType := [numDomainType of numField_normedModType]. +#[export, non_forgetful_inheritance] +HB.instance Definition _ := GRing.ComAlgebra.copy R R^o. +#[export, non_forgetful_inheritance] +HB.instance Definition _ := Vector.copy R R^o. +#[export, non_forgetful_inheritance] +HB.instance Definition _ := NormedModule.copy R R^o. +#[export, non_forgetful_inheritance] +HB.instance Definition _ := Num.NumField.on R. End numFieldType. -Module Exports. -Export topology.numFieldTopology.Exports. -(* realType *) -Canonical real_lmodType. -Canonical real_lalgType. -Canonical real_algType. -Canonical real_comAlgType. -Canonical real_unitAlgType. -Canonical real_comUnitAlgType. -Canonical real_vectType. -Canonical real_FalgType. -Canonical real_fieldExtType. -Canonical real_pseudoMetricNormedZmodType. -Canonical real_normedModType. -Coercion real_lmodType : realType >-> lmodType. -Coercion real_lalgType : realType >-> lalgType. -Coercion real_algType : realType >-> algType. -Coercion real_comAlgType : realType >-> comAlgType. -Coercion real_unitAlgType : realType >-> unitAlgType. -Coercion real_comUnitAlgType : realType >-> comUnitAlgType. -Coercion real_vectType : realType >-> vectType. -Coercion real_FalgType : realType >-> FalgType. -Coercion real_fieldExtType : realType >-> fieldExtType. -Coercion real_pseudoMetricNormedZmodType : - realType >-> pseudoMetricNormedZmodType. -Coercion real_normedModType : realType >-> normedModType. -(* rcfType *) -Canonical rcf_lmodType. -Canonical rcf_lalgType. -Canonical rcf_algType. -Canonical rcf_comAlgType. -Canonical rcf_unitAlgType. -Canonical rcf_comUnitAlgType. -Canonical rcf_vectType. -Canonical rcf_FalgType. -Canonical rcf_fieldExtType. -Canonical rcf_pseudoMetricNormedZmodType. -Canonical rcf_normedModType. -Coercion rcf_lmodType : rcfType >-> lmodType. -Coercion rcf_lalgType : rcfType >-> lalgType. -Coercion rcf_algType : rcfType >-> algType. -Coercion rcf_comAlgType : rcfType >-> comAlgType. -Coercion rcf_unitAlgType : rcfType >-> unitAlgType. -Coercion rcf_comUnitAlgType : rcfType >-> comUnitAlgType. -Coercion rcf_vectType : rcfType >-> vectType. -Coercion rcf_FalgType : rcfType >-> FalgType. -Coercion rcf_fieldExtType : rcfType >-> fieldExtType. -Coercion rcf_pseudoMetricNormedZmodType : - rcfType >-> pseudoMetricNormedZmodType. -Coercion rcf_normedModType : rcfType >-> normedModType. -(* archiFieldType *) -Canonical archiField_lmodType. -Canonical archiField_lalgType. -Canonical archiField_algType. -Canonical archiField_comAlgType. -Canonical archiField_unitAlgType. -Canonical archiField_comUnitAlgType. -Canonical archiField_vectType. -Canonical archiField_FalgType. -Canonical archiField_fieldExtType. -Canonical archiField_pseudoMetricNormedZmodType. -Canonical archiField_normedModType. -Coercion archiField_lmodType : archiFieldType >-> lmodType. -Coercion archiField_lalgType : archiFieldType >-> lalgType. -Coercion archiField_algType : archiFieldType >-> algType. -Coercion archiField_comAlgType : archiFieldType >-> comAlgType. -Coercion archiField_unitAlgType : archiFieldType >-> unitAlgType. -Coercion archiField_comUnitAlgType : archiFieldType >-> comUnitAlgType. -Coercion archiField_vectType : archiFieldType >-> vectType. -Coercion archiField_FalgType : archiFieldType >-> FalgType. -Coercion archiField_fieldExtType : archiFieldType >-> fieldExtType. -Coercion archiField_pseudoMetricNormedZmodType : - archiFieldType >-> pseudoMetricNormedZmodType. -Coercion archiField_normedModType : archiFieldType >-> normedModType. -(* realFieldType *) -Canonical realField_lmodType. -Canonical realField_lalgType. -Canonical realField_algType. -Canonical realField_comAlgType. -Canonical realField_unitAlgType. -Canonical realField_comUnitAlgType. -Canonical realField_vectType. -Canonical realField_FalgType. -Canonical realField_fieldExtType. -Canonical realField_pseudoMetricNormedZmodType. -Canonical realField_normedModType. -Canonical lmod_latticeType. -Canonical lmod_distrLatticeType. -Canonical lmod_orderType. -Canonical lmod_realDomainType. -Canonical lalg_latticeType. -Canonical lalg_distrLatticeType. -Canonical lalg_orderType. -Canonical lalg_realDomainType. -Canonical alg_latticeType. -Canonical alg_distrLatticeType. -Canonical alg_orderType. -Canonical alg_realDomainType. -Canonical comAlg_latticeType. -Canonical comAlg_distrLatticeType. -Canonical comAlg_orderType. -Canonical comAlg_realDomainType. -Canonical unitAlg_latticeType. -Canonical unitAlg_distrLatticeType. -Canonical unitAlg_orderType. -Canonical unitAlg_realDomainType. -Canonical comUnitAlg_latticeType. -Canonical comUnitAlg_distrLatticeType. -Canonical comUnitAlg_orderType. -Canonical comUnitAlg_realDomainType. -Canonical vect_latticeType. -Canonical vect_distrLatticeType. -Canonical vect_orderType. -Canonical vect_realDomainType. -Canonical Falg_latticeType. -Canonical Falg_distrLatticeType. -Canonical Falg_orderType. -Canonical Falg_realDomainType. -Canonical fieldExt_latticeType. -Canonical fieldExt_distrLatticeType. -Canonical fieldExt_orderType. -Canonical fieldExt_realDomainType. -Canonical pseudoMetricNormedZmod_latticeType. -Canonical pseudoMetricNormedZmod_distrLatticeType. -Canonical pseudoMetricNormedZmod_orderType. -Canonical pseudoMetricNormedZmod_realDomainType. -Canonical normedMod_latticeType. -Canonical normedMod_distrLatticeType. -Canonical normedMod_orderType. -Canonical normedMod_realDomainType. -Coercion realField_lmodType : realFieldType >-> lmodType. -Coercion realField_lalgType : realFieldType >-> lalgType. -Coercion realField_algType : realFieldType >-> algType. -Coercion realField_comAlgType : realFieldType >-> comAlgType. -Coercion realField_unitAlgType : realFieldType >-> unitAlgType. -Coercion realField_comUnitAlgType : realFieldType >-> comUnitAlgType. -Coercion realField_vectType : realFieldType >-> vectType. -Coercion realField_FalgType : realFieldType >-> FalgType. -Coercion realField_fieldExtType : realFieldType >-> fieldExtType. -Coercion realField_pseudoMetricNormedZmodType : - Num.RealField.type >-> PseudoMetricNormedZmodule.type. -Coercion realField_normedModType : Num.RealField.type >-> NormedModule.type. -(* numClosedFieldType *) -Canonical numClosedField_lmodType. -Canonical numClosedField_lalgType. -Canonical numClosedField_algType. -Canonical numClosedField_comAlgType. -Canonical numClosedField_unitAlgType. -Canonical numClosedField_comUnitAlgType. -Canonical numClosedField_vectType. -Canonical numClosedField_FalgType. -Canonical numClosedField_fieldExtType. -Canonical numClosedField_pseudoMetricNormedZmodType. -Canonical numClosedField_normedModType. -Canonical lmod_decFieldType. -Canonical lmod_closedFieldType. -Canonical lalg_decFieldType. -Canonical lalg_closedFieldType. -Canonical alg_decFieldType. -Canonical alg_closedFieldType. -Canonical comAlg_decFieldType. -Canonical comAlg_closedFieldType. -Canonical unitAlg_decFieldType. -Canonical unitAlg_closedFieldType. -Canonical comUnitAlg_decFieldType. -Canonical comUnitAlg_closedFieldType. -Canonical vect_decFieldType. -Canonical vect_closedFieldType. -Canonical Falg_decFieldType. -Canonical Falg_closedFieldType. -Canonical fieldExt_decFieldType. -Canonical fieldExt_closedFieldType. -Canonical pseudoMetricNormedZmod_decFieldType. -Canonical pseudoMetricNormedZmod_closedFieldType. -Canonical normedMod_decFieldType. -Canonical normedMod_closedFieldType. -Coercion numClosedField_lmodType : numClosedFieldType >-> lmodType. -Coercion numClosedField_lalgType : numClosedFieldType >-> lalgType. -Coercion numClosedField_algType : numClosedFieldType >-> algType. -Coercion numClosedField_comAlgType : numClosedFieldType >-> comAlgType. -Coercion numClosedField_unitAlgType : numClosedFieldType >-> unitAlgType. -Coercion numClosedField_comUnitAlgType : numClosedFieldType >-> comUnitAlgType. -Coercion numClosedField_vectType : numClosedFieldType >-> vectType. -Coercion numClosedField_FalgType : numClosedFieldType >-> FalgType. -Coercion numClosedField_fieldExtType : numClosedFieldType >-> fieldExtType. -Coercion numClosedField_pseudoMetricNormedZmodType : - numClosedFieldType >-> pseudoMetricNormedZmodType. -Coercion numClosedField_normedModType : numClosedFieldType >-> normedModType. -(* numFieldType *) -Canonical numField_lmodType. -Canonical numField_lalgType. -Canonical numField_algType. -Canonical numField_comAlgType. -Canonical numField_unitAlgType. -Canonical numField_comUnitAlgType. -Canonical numField_vectType. -Canonical numField_FalgType. -Canonical numField_fieldExtType. -Canonical numField_pseudoMetricNormedZmodType. -Canonical numField_normedModType. -Canonical lmod_porderType. -Canonical lmod_numDomainType. -Canonical lalg_pointedType. -Canonical lalg_filteredType. -Canonical lalg_topologicalType. -Canonical lalg_uniformType. -Canonical lalg_pseudoMetricType. -Canonical lalg_normedZmodType. -Canonical lalg_pseudoMetricNormedZmodType. -Canonical lalg_normedModType. -Canonical lalg_porderType. -Canonical lalg_numDomainType. -Canonical alg_pointedType. -Canonical alg_filteredType. -Canonical alg_topologicalType. -Canonical alg_uniformType. -Canonical alg_pseudoMetricType. -Canonical alg_normedZmodType. -Canonical alg_pseudoMetricNormedZmodType. -Canonical alg_normedModType. -Canonical alg_porderType. -Canonical alg_numDomainType. -Canonical comAlg_pointedType. -Canonical comAlg_filteredType. -Canonical comAlg_topologicalType. -Canonical comAlg_uniformType. -Canonical comAlg_pseudoMetricType. -Canonical comAlg_normedZmodType. -Canonical comAlg_pseudoMetricNormedZmodType. -Canonical comAlg_normedModType. -Canonical comAlg_porderType. -Canonical comAlg_numDomainType. -Canonical unitAlg_pointedType. -Canonical unitAlg_filteredType. -Canonical unitAlg_topologicalType. -Canonical unitAlg_uniformType. -Canonical unitAlg_pseudoMetricType. -Canonical unitAlg_normedZmodType. -Canonical unitAlg_pseudoMetricNormedZmodType. -Canonical unitAlg_normedModType. -Canonical unitAlg_porderType. -Canonical unitAlg_numDomainType. -Canonical comUnitAlg_pointedType. -Canonical comUnitAlg_filteredType. -Canonical comUnitAlg_topologicalType. -Canonical comUnitAlg_uniformType. -Canonical comUnitAlg_pseudoMetricType. -Canonical comUnitAlg_normedZmodType. -Canonical comUnitAlg_pseudoMetricNormedZmodType. -Canonical comUnitAlg_normedModType. -Canonical comUnitAlg_porderType. -Canonical comUnitAlg_numDomainType. -Canonical vect_pointedType. -Canonical vect_filteredType. -Canonical vect_topologicalType. -Canonical vect_uniformType. -Canonical vect_pseudoMetricType. -Canonical vect_normedZmodType. -Canonical vect_pseudoMetricNormedZmodType. -Canonical vect_normedModType. -Canonical vect_porderType. -Canonical vect_numDomainType. -Canonical Falg_pointedType. -Canonical Falg_filteredType. -Canonical Falg_topologicalType. -Canonical Falg_uniformType. -Canonical Falg_pseudoMetricType. -Canonical Falg_normedZmodType. -Canonical Falg_pseudoMetricNormedZmodType. -Canonical Falg_normedModType. -Canonical Falg_porderType. -Canonical Falg_numDomainType. -Canonical fieldExt_pointedType. -Canonical fieldExt_filteredType. -Canonical fieldExt_topologicalType. -Canonical fieldExt_uniformType. -Canonical fieldExt_pseudoMetricType. -Canonical fieldExt_normedZmodType. -Canonical fieldExt_pseudoMetricNormedZmodType. -Canonical fieldExt_normedModType. -Canonical fieldExt_porderType. -Canonical fieldExt_numDomainType. -Canonical pseudoMetricNormedZmod_ringType. -Canonical pseudoMetricNormedZmod_comRingType. -Canonical pseudoMetricNormedZmod_unitRingType. -Canonical pseudoMetricNormedZmod_comUnitRingType. -Canonical pseudoMetricNormedZmod_idomainType. -Canonical pseudoMetricNormedZmod_fieldType. -Canonical pseudoMetricNormedZmod_porderType. -Canonical pseudoMetricNormedZmod_numDomainType. -Canonical normedMod_ringType. -Canonical normedMod_comRingType. -Canonical normedMod_unitRingType. -Canonical normedMod_comUnitRingType. -Canonical normedMod_idomainType. -Canonical normedMod_fieldType. -Canonical normedMod_porderType. -Canonical normedMod_numDomainType. -Coercion numField_lmodType : numFieldType >-> lmodType. -Coercion numField_lalgType : numFieldType >-> lalgType. -Coercion numField_algType : numFieldType >-> algType. -Coercion numField_comAlgType : numFieldType >-> comAlgType. -Coercion numField_unitAlgType : numFieldType >-> unitAlgType. -Coercion numField_comUnitAlgType : numFieldType >-> comUnitAlgType. -Coercion numField_vectType : numFieldType >-> vectType. -Coercion numField_FalgType : numFieldType >-> FalgType. -Coercion numField_fieldExtType : numFieldType >-> fieldExtType. -Coercion numField_pseudoMetricNormedZmodType : - numFieldType >-> pseudoMetricNormedZmodType. -Coercion numField_normedModType : numFieldType >-> normedModType. -End Exports. +Module Exports. Export numFieldTopology.Exports. HB.reexport. End Exports. End numFieldNormedType. Import numFieldNormedType.Exports. +Lemma limf_esup_dnbhsN {R : realType} (f : R -> \bar R) (a : R) : + limf_esup f a^' = limf_esup (fun x => f (- x)%R) (- a)%R^'. +Proof. +rewrite /limf_esup dnbhsN image_comp/=. +congr (ereal_inf [set _ | _ in _]); apply/funext => A /=. +rewrite image_comp/= -compA (_ : _ \o _ = idfun)// funeqE => x/=. +by rewrite opprK. +Qed. + Section NormedModule_numDomainType. Variables (R : numDomainType) (V : normedModType R). -Lemma normrZ l (x : V) : `| l *: x | = `| l | * `| x |. -Proof. by case: V x => V0 [a b [c]] //= v; rewrite c. Qed. - Lemma normrZV (x : V) : `|x| \in GRing.unit -> `| `| x |^-1 *: x | = 1. Proof. by move=> nxu; rewrite normrZ normrV// normr_id mulVr. Qed. End NormedModule_numDomainType. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed `normrZ`")] -Notation normmZ := normrZ. +Notation normmZ := normrZ (only parsing). Section NormedModule_numFieldType. Variables (R : numFieldType) (V : normedModType R). @@ -1647,42 +955,42 @@ Proof. by move=> e1e2 y /lt_le_trans; apply. Qed. Let nbhs_simpl := (nbhs_simpl,@nbhs_nbhs_norm,@filter_from_norm_nbhs). -Lemma fcvgrPdist_lt {F : set (set V)} {FF : Filter F} (y : V) : +Lemma fcvgrPdist_lt {F : set_system V} {FF : Filter F} (y : V) : F --> y <-> forall eps, 0 < eps -> \forall y' \near F, `|y - y'| < eps. Proof. by rewrite -filter_fromP /= !nbhs_simpl. Qed. -Lemma cvgrPdist_lt {T} {F : set (set T)} {FF : Filter F} (f : T -> V) (y : V) : +Lemma cvgrPdist_lt {T} {F : set_system T} {FF : Filter F} (f : T -> V) (y : V) : f @ F --> y <-> forall eps, 0 < eps -> \forall t \near F, `|y - f t| < eps. Proof. exact: fcvgrPdist_lt. Qed. -Lemma cvgrPdistC_lt {T} {F : set (set T)} {FF : Filter F} (f : T -> V) (y : V) : +Lemma cvgrPdistC_lt {T} {F : set_system T} {FF : Filter F} (f : T -> V) (y : V) : f @ F --> y <-> forall eps, 0 < eps -> \forall t \near F, `|f t - y| < eps. Proof. by rewrite cvgrPdist_lt; under eq_forall do under eq_near do rewrite distrC. Qed. -Lemma cvgr_dist_lt {T} {F : set (set T)} {FF : Filter F} (f : T -> V) (y : V) : +Lemma cvgr_dist_lt {T} {F : set_system T} {FF : Filter F} (f : T -> V) (y : V) : f @ F --> y -> forall eps, eps > 0 -> \forall t \near F, `|y - f t| < eps. Proof. by move=> /cvgrPdist_lt. Qed. -Lemma __deprecated__cvg_dist {F : set (set V)} {FF : Filter F} (y : V) : +Lemma __deprecated__cvg_dist {F : set_system V} {FF : Filter F} (y : V) : F --> y -> forall eps, eps > 0 -> \forall y' \near F, `|y - y'| < eps. Proof. exact: cvgr_dist_lt. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvgr_dist_lt` or a variation instead")] -Notation cvg_dist := __deprecated__cvg_dist. +Notation cvg_dist := __deprecated__cvg_dist (only parsing). -Lemma cvgr_distC_lt {T} {F : set (set T)} {FF : Filter F} (f : T -> V) (y : V) : +Lemma cvgr_distC_lt {T} {F : set_system T} {FF : Filter F} (f : T -> V) (y : V) : f @ F --> y -> forall eps, eps > 0 -> \forall t \near F, `|f t - y| < eps. Proof. by move=> /cvgrPdistC_lt. Qed. -Lemma cvgr_dist_le {T} {F : set (set T)} {FF : Filter F} (f : T -> V) (y : V) : +Lemma cvgr_dist_le {T} {F : set_system T} {FF : Filter F} (f : T -> V) (y : V) : f @ F --> y -> forall eps, eps > 0 -> \forall t \near F, `|y - f t| <= eps. Proof. by move=> ? ? ?; near do rewrite ltW//; apply: cvgr_dist_lt. Unshelve. all: by end_near. Qed. -Lemma cvgr_distC_le {T} {F : set (set T)} {FF : Filter F} (f : T -> V) (y : V) : +Lemma cvgr_distC_le {T} {F : set_system T} {FF : Filter F} (f : T -> V) (y : V) : f @ F --> y -> forall eps, eps > 0 -> \forall t \near F, `|f t - y| <= eps. Proof. by move=> ? ? ?; near do rewrite ltW//; apply: cvgr_distC_lt. @@ -1696,17 +1004,17 @@ rewrite nbhs_normP; split=> -[/= e e0 Pe]; by exists e => // y /=; have /= := Pe y; rewrite distrC subr0. Qed. -Lemma cvgr0Pnorm_lt {T} {F : set (set T)} {FF : Filter F} (f : T -> V) : +Lemma cvgr0Pnorm_lt {T} {F : set_system T} {FF : Filter F} (f : T -> V) : f @ F --> 0 <-> forall eps, 0 < eps -> \forall t \near F, `|f t| < eps. Proof. by rewrite cvgrPdistC_lt; under eq_forall do under eq_near do rewrite subr0. Qed. -Lemma cvgr0_norm_lt {T} {F : set (set T)} {FF : Filter F} (f : T -> V) : +Lemma cvgr0_norm_lt {T} {F : set_system T} {FF : Filter F} (f : T -> V) : f @ F --> 0 -> forall eps, eps > 0 -> \forall t \near F, `|f t| < eps. Proof. by move=> /cvgr0Pnorm_lt. Qed. -Lemma cvgr0_norm_le {T} {F : set (set T)} {FF : Filter F} (f : T -> V) : +Lemma cvgr0_norm_le {T} {F : set_system T} {FF : Filter F} (f : T -> V) : f @ F --> 0 -> forall eps, eps > 0 -> \forall t \near F, `|f t| <= eps. Proof. by move=> ? ? ?; near do rewrite ltW//; apply: cvgr0_norm_lt. @@ -1725,7 +1033,7 @@ Lemma dnbhs0_le e : 0 < e -> \forall x \near (0 : V)^', `|x| <= e. Proof. by move=> e_gt0; apply: cvg_within; apply: nbhs0_le. Qed. Lemma nbhs_norm_ball x (eps : {posnum R}) : nbhs_norm x (ball x eps%:num). -Proof. rewrite nbhs_nbhs_norm; by apply: nbhsx_ballx. Qed. +Proof. by rewrite nbhs_nbhs_norm; exact: nbhsx_ballx. Qed. Lemma nbhsDl (P : set V) (x y : V) : (\forall z \near (x + y), P z) <-> (\near x, P (x + y)). @@ -1766,14 +1074,82 @@ Arguments cvgr0_norm_le {_ _ _ F FF}. #[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvgrPdist_lt` or a variation instead")] -Notation cvg_distP := fcvgrPdist_lt. +Notation cvg_distP := fcvgrPdist_lt (only parsing). + +(* NB: the following section used to be in Rstruct.v *) +Require Rstruct. + +Section analysis_struct. + +Import Rdefinitions. +Import Rstruct. + +(* TODO: express using ball?*) +Lemma continuity_pt_nbhs (f : R -> R) x : + Ranalysis1.continuity_pt f x <-> + forall eps : {posnum R}, nbhs x (fun u => `|f u - f x| < eps%:num). +Proof. +split=> [fcont e|fcont _/RltP/posnumP[e]]; last first. + have [_/posnumP[d] xd_fxe] := fcont e. + exists d%:num; split; first by apply/RltP; have := [gt0 of d%:num]. + by move=> y [_ /RltP yxd]; apply/RltP/xd_fxe; rewrite /= distrC. +have /RltP egt0 := [gt0 of e%:num]. +have [_ [/RltP/posnumP[d] dx_fxe]] := fcont e%:num egt0. +exists d%:num => //= y xyd; case: (eqVneq x y) => [->|xney]. + by rewrite subrr normr0. +apply/RltP/dx_fxe; split; first by split=> //; apply/eqP. +by have /RltP := xyd; rewrite distrC. +Qed. + +Lemma continuity_pt_cvg (f : R -> R) (x : R) : + Ranalysis1.continuity_pt f x <-> {for x, continuous f}. +Proof. +eapply iff_trans; first exact: continuity_pt_nbhs. +apply iff_sym. +have FF : Filter (f @ x). + by typeclasses eauto. + (*by apply fmap_filter; apply: @filter_filter' (locally_filter _).*) +case: (@fcvg_ballP _ _ (f @ x) FF (f x)) => {FF}H1 H2. +(* TODO: in need for lemmas and/or refactoring of already existing lemmas (ball vs. Rabs) *) +split => [{H2} - /H1 {}H1 eps|{H1} H]. +- have {H1} [//|_/posnumP[x0] Hx0] := H1 eps%:num. + exists x0%:num => //= Hx0' /Hx0 /=. + by rewrite /= distrC; apply. +- apply H2 => _ /posnumP[eps]; move: (H eps) => {H} [_ /posnumP[x0] Hx0]. + exists x0%:num => //= y /Hx0 /= {}Hx0. + by rewrite /ball /= distrC. +Qed. + +Lemma continuity_ptE (f : R -> R) (x : R) : + Ranalysis1.continuity_pt f x <-> {for x, continuous f}. +Proof. exact: continuity_pt_cvg. Qed. + +Local Open Scope classical_set_scope. + +Lemma continuity_pt_cvg' f x : + Ranalysis1.continuity_pt f x <-> f @ x^' --> f x. +Proof. by rewrite continuity_ptE continuous_withinNx. Qed. + +Lemma continuity_pt_dnbhs f x : + Ranalysis1.continuity_pt f x <-> + forall eps, 0 < eps -> x^' (fun u => `|f x - f u| < eps). +Proof. +rewrite continuity_pt_cvg' (@cvgrPdist_lt _ [the normedModType _ of R^o]). +exact. +Qed. + +Lemma nbhs_pt_comp (P : R -> Prop) (f : R -> R) (x : R) : + nbhs (f x) P -> Ranalysis1.continuity_pt f x -> \near x, P (f x). +Proof. by move=> Lf /continuity_pt_cvg; apply. Qed. + +End analysis_struct. Section open_closed_sets. (* TODO: duplicate theory within the subspace topology of Num.real in a numDomainType *) Variable R : realFieldType. -(** Some open sets of [R] *) +(** Some open sets of R *) Lemma open_lt (y : R) : open [set x : R| x < y]. Proof. move=> x /=; rewrite -subr_gt0 => yDx_gt0. exists (y - x) => // z. @@ -1808,10 +1184,9 @@ move: a b => [[]a|[]] [[]b|[]]// _ _. - by rewrite (_ : mkset _ = setT); [exact: openT | rewrite predeqE]. Qed. -(** Some closed sets of [R] *) +(** Some closed sets of R *) (* TODO: we can probably extend these results to numFieldType by adding a precondition that y \is Num.real *) - Lemma closed_le (y : R) : closed [set x : R | x <= y]. Proof. rewrite (_ : mkset _ = ~` [set x | x > y]); first exact: open_closedC. @@ -1852,8 +1227,8 @@ End open_closed_sets. #[global] Hint Extern 0 (closed _) => now apply: closed_le : core. #[global] Hint Extern 0 (closed _) => now apply: closed_eq : core. -Section at_left_right_pmNormedZmod. -Variable (R : numFieldType) (V : pseudoMetricNormedZmodType R). +Section at_left_right. +Variable R : numFieldType. Definition at_left (x : R) := within (fun u => u < x) (nbhs x). Definition at_right (x : R) := within (fun u => x < u) (nbhs x). @@ -1863,33 +1238,33 @@ Local Notation "x ^'+" := (at_right x) : classical_set_scope. Global Instance at_right_proper_filter (x : R) : ProperFilter x^'+. Proof. apply: Build_ProperFilter' => -[_/posnumP[d] /(_ (x + d%:num / 2))]. -apply; last (by rewrite ltr_addl); rewrite /=. +apply; last (by rewrite ltrDl); rewrite /=. rewrite opprD !addrA subrr add0r normrN normf_div !ger0_norm //. -by rewrite ltr_pdivr_mulr // ltr_pmulr // (_ : 1 = 1%:R) // ltr_nat. +by rewrite ltr_pdivrMr // ltr_pMr // (_ : 1 = 1%:R) // ltr_nat. Qed. Global Instance at_left_proper_filter (x : R) : ProperFilter x^'-. Proof. apply: Build_ProperFilter' => -[_ /posnumP[d] /(_ (x - d%:num / 2))]. -apply; last (by rewrite ltr_subl_addl ltr_addr); rewrite /=. +apply; last (by rewrite ltrBlDl ltrDr); rewrite /=. rewrite opprD !addrA subrr add0r opprK normf_div !ger0_norm //. -by rewrite ltr_pdivr_mulr // ltr_pmulr // (_ : 1 = 1%:R) // ltr_nat. +by rewrite ltr_pdivrMr // ltr_pMr // (_ : 1 = 1%:R) // ltr_nat. Qed. Lemma nbhs_right0P x (P : set R) : (\forall y \near x^'+, P y) <-> \forall e \near 0^'+, P (x + e). Proof. rewrite !near_withinE !near_simpl nbhs0P -propeqE. -by apply: (@eq_near _ (nbhs (0 : R))) => y; rewrite ltr_addl. +by apply: (@eq_near _ (nbhs (0 : R))) => y; rewrite ltrDl. Qed. Lemma nbhs_left0P x (P : set R) : (\forall y \near x^'-, P y) <-> \forall e \near 0^'+, P (x - e). Proof. rewrite !near_withinE !near_simpl nbhs0P; split=> Px. - rewrite -oppr0 nearN; near=> e; rewrite ltr_opp2 opprK => e_lt0. - by apply: (near Px) => //; rewrite gtr_addl. -by rewrite -oppr0 nearN; near=> e; rewrite gtr_addl oppr_lt0; apply: (near Px). + rewrite -oppr0 nearN; near=> e; rewrite ltrN2 opprK => e_lt0. + by apply: (near Px) => //; rewrite gtrDl. +by rewrite -oppr0 nearN; near=> e; rewrite gtrDl oppr_lt0; apply: (near Px). Unshelve. all: by end_near. Qed. Lemma nbhs_right_gt x : \forall y \near x^'+, x < y. @@ -1913,7 +1288,7 @@ Proof. by rewrite near_withinE; apply: nearW => ?; apply/ltW. Qed. Lemma nbhs_right_lt x z : x < z -> \forall y \near x^'+, y < z. Proof. move=> xz; exists (z - x) => //=; first by rewrite subr_gt0. -by move=> y /= + xy; rewrite distrC ?ger0_norm ?subr_ge0 1?ltW// ltr_add2r. +by move=> y /= + xy; rewrite distrC ?ger0_norm ?subr_ge0 1?ltW// ltrD2r. Qed. Lemma nbhs_right_le x z : x < z -> \forall y \near x^'+, y <= z. @@ -1922,7 +1297,7 @@ Unshelve. all: by end_near. Qed. Lemma nbhs_left_gt x z : z < x -> \forall y \near x^'-, z < y. Proof. -move=> xz; rewrite nbhs_left0P; near do rewrite -ltr_opp2 opprB ltr_subl_addl. +move=> xz; rewrite nbhs_left0P; near do rewrite -ltrN2 opprB ltrBlDl. by apply: nbhs_right_lt; rewrite subr_gt0. Unshelve. all: by end_near. Qed. @@ -1930,19 +1305,141 @@ Lemma nbhs_left_ge x z : z < x -> \forall y \near x^'-, z <= y. Proof. by move=> xz; near do apply/ltW; apply: nbhs_left_gt. Unshelve. all: by end_near. Qed. +Lemma not_near_at_rightP T (f : R -> T) (p : R) (P : pred T) : + ~ (\forall x \near p^'+, P (f x)) -> + forall e : {posnum R}, exists2 x, p < x < p + e%:num & ~ P (f x). +Proof. +move=> pPf e; apply: contrapT => /forallPNP pePf; apply: pPf; near=> t. +apply: contrapT; apply: pePf; apply/andP; split. +- by near: t; exact: nbhs_right_gt. +- by near: t; apply: nbhs_right_lt; rewrite ltr_addl. +Unshelve. all: by end_near. Qed. + +Lemma withinN (A : set R) a : + within A (nbhs (- a)) = - x @[x --> within (-%R @` A) (nbhs a)]. +Proof. +rewrite eqEsubset /=; split; move=> E /= [e e0 aeE]; exists e => //. + move=> r are ra; apply: aeE; last by rewrite memNE opprK. + by rewrite /= opprK addrC distrC. +move=> r aer ar; rewrite -(opprK r); apply: aeE; last by rewrite -memNE. +by rewrite /= opprK -normrN opprD. +Qed. + +Let fun_predC (T : choiceType) (f : T -> T) (p : pred T) : involutive f -> + [set f x | x in p] = [set x | x in p \o f]. +Proof. +by move=> fi; apply/seteqP; split => _/= [y hy <-]; + exists (f y) => //; rewrite fi. +Qed. + +Lemma at_rightN a : (- a)^'+ = -%R @ a^'-. +Proof. +rewrite /at_right withinN [X in within X _](_ : _ = [set u | u < a])//. +rewrite (@fun_predC _ -%R)/=; last exact: opprK. +by rewrite image_id; under eq_fun do rewrite ltr_oppl opprK. +Qed. + +Lemma at_leftN a : (- a)^'- = -%R @ a^'+. +Proof. +rewrite /at_left withinN [X in within X _](_ : _ = [set u | a < u])//. +rewrite (@fun_predC _ -%R)/=; last exact: opprK. +by rewrite image_id; under eq_fun do rewrite ltr_oppl opprK. +Qed. + +End at_left_right. +#[global] Typeclasses Opaque at_left at_right. +Notation "x ^'-" := (at_left x) : classical_set_scope. +Notation "x ^'+" := (at_right x) : classical_set_scope. + +#[global] Hint Extern 0 (Filter (nbhs _^'+)) => + (apply: at_right_proper_filter) : typeclass_instances. + +#[global] Hint Extern 0 (Filter (nbhs _^'-)) => + (apply: at_left_proper_filter) : typeclass_instances. + +Lemma cvg_at_leftNP {T : topologicalType} {R : numFieldType} + (f : R -> T) a (l : T) : + f @ a^'- --> l <-> f \o -%R @ (- a)^'+ --> l. +Proof. +by rewrite at_rightN -?fmap_comp; under [_ \o _]eq_fun => ? do rewrite /= opprK. +Qed. + +Lemma cvg_at_rightNP {T : topologicalType} {R : numFieldType} + (f : R -> T) a (l : T) : + f @ a^'+ --> l <-> f \o -%R @ (- a)^'- --> l. +Proof. +by rewrite at_leftN -?fmap_comp; under [_ \o _]eq_fun => ? do rewrite /= opprK. +Qed. + +Section open_itv_subset. +Context {R : realType}. +Variables (A : set R) (x : R). + +Lemma open_itvoo_subset : + open A -> A x -> \forall r \near 0^'+, `]x - r, x + r[ `<=` A. +Proof. +move=> /[apply] -[] _/posnumP[r] /subset_ball_prop_in_itv xrA. +exists r%:num => //= k; rewrite /= distrC subr0 set_itvoo => /ltr_normlW kr k0. +by apply/(subset_trans _ xrA)/subset_itvW; + [rewrite lerB//; exact: ltW | rewrite lerD//; exact: ltW]. +Qed. + +Lemma open_itvcc_subset : + open A -> A x -> \forall r \near 0^'+, `[x - r, x + r] `<=` A. +Proof. +move=> /[apply] -[] _/posnumP[r]. +have -> : r%:num = 2 * (r%:num / 2) by rewrite mulrCA divff// mulr1. +move/subset_ball_prop_in_itvcc => /= xrA; exists (r%:num / 2) => //= k. +rewrite /= distrC subr0 set_itvcc => /ltr_normlW kr k0. +move=> z /andP [xkz zxk]; apply: xrA => //; rewrite in_itv/=; apply/andP; split. + by rewrite (le_trans _ xkz)// lerB// ltW. +by rewrite (le_trans zxk)// lerD// ltW. +Qed. + +End open_itv_subset. + +Section at_left_right_topologicalType. +Variables (R : numFieldType) (V : topologicalType) (f : R -> V) (x : R). + +Lemma cvg_at_right_filter : f z @[z --> x] --> f x -> f z @[z --> x^'+] --> f x. +Proof. exact: (@cvg_within_filter _ _ _ (nbhs x)). Qed. + +Lemma cvg_at_left_filter : f z @[z --> x] --> f x -> f z @[z --> x^'-] --> f x. +Proof. exact: (@cvg_within_filter _ _ _ (nbhs x)). Qed. + +Lemma cvg_at_right_within : f x @[x --> x^'+] --> f x -> + f x @[x --> within (fun u => x <= u) (nbhs x)] --> f x. +Proof. +move=> fxr U Ux; rewrite ?near_simpl ?near_withinE; near=> z; rewrite le_eqVlt. +by move/predU1P => [<-|]; [exact: nbhs_singleton | near: z; exact: fxr]. +Unshelve. all: by end_near. Qed. + +Lemma cvg_at_left_within : f x @[x --> x^'-] --> f x -> + f x @[x --> within (fun u => u <= x) (nbhs x)] --> f x. +Proof. +move=> fxr U Ux; rewrite ?near_simpl ?near_withinE; near=> z; rewrite le_eqVlt. +by move/predU1P => [->|]; [exact: nbhs_singleton | near: z; exact: fxr]. +Unshelve. all: by end_near. Qed. + +End at_left_right_topologicalType. + +Section at_left_right_pmNormedZmod. +Variables (R : numFieldType) (V : pseudoMetricNormedZmodType R). + Lemma nbhsr0P (P : set V) x : - (\forall y \near x, P y) <-> (\forall e \near 0^'+, forall y, `|x - y| <= e -> P y). + (\forall y \near x, P y) <-> + (\forall e \near 0^'+, forall y, `|x - y| <= e -> P y). Proof. rewrite nbhs0P/= near_withinE/= !near_simpl. split=> /nbhs_norm0P[/= _/posnumP[e] /(_ _) Px]; apply/nbhs_norm0P. exists e%:num => //= r /= re yr y xyr; rewrite -[y](addrNK x) addrC. by apply: Px; rewrite /= distrC (le_lt_trans _ re)// gtr0_norm. exists (e%:num / 2) => //= r /= re; apply: (Px (e%:num / 2)) => //=. - by rewrite gtr0_norm// ltr_pdivr_mulr// ltr_pmulr// ?(ltr_nat _ 1 2). + by rewrite gtr0_norm// ltr_pdivrMr// ltr_pMr// ?(ltr_nat _ 1 2). by rewrite opprD addNKr normrN ltW. Qed. -Let cvgrP {F : set (set V)} {FF : Filter F} (y : V) : [<-> +Let cvgrP {F : set_system V} {FF : Filter F} (y : V) : [<-> F --> y; forall eps, 0 < eps -> \forall t \near F, `|y - t| <= eps; \forall eps \near 0^'+, \forall t \near F, `|y - t| <= eps; @@ -1950,98 +1447,98 @@ Let cvgrP {F : set (set V)} {FF : Filter F} (y : V) : [<-> Proof. tfae; first by move=> *; apply: cvgr_dist_le. - by move=> Fy; near do apply: Fy; apply: nbhs_right_gt. -- move=> Fy; near=> e; near 0^'+ => d; near=> x. +- move=> Fy; near=> e; near (0:R)^'+ => d; near=> x. rewrite (@le_lt_trans _ _ d)//; first by near: x; near: d. by near: d; apply: nbhs_right_lt; near: e; apply: nbhs_right_gt. -- move=> Fy; apply/cvgrPdist_lt => e e_gt0; near 0^'+ => d. +- move=> Fy; apply/cvgrPdist_lt => e e_gt0; near (0:R)^'+ => d. near=> x; rewrite (@lt_le_trans _ _ d)//; first by near: x; near: d. by near: d; apply: nbhs_right_le. Unshelve. all: by end_near. Qed. -Lemma cvgrPdist_le {T} {F : set (set T)} {FF : Filter F} (f : T -> V) (y : V) : +Lemma cvgrPdist_le {T} {F : set_system T} {FF : Filter F} (f : T -> V) (y : V) : f @ F --> y <-> forall eps, 0 < eps -> \forall t \near F, `|y - f t| <= eps. Proof. exact: (cvgrP _ 0 1)%N. Qed. -Lemma cvgrPdist_ltp {T} {F : set (set T)} {FF : Filter F} (f : T -> V) (y : V) : +Lemma cvgrPdist_ltp {T} {F : set_system T} {FF : Filter F} (f : T -> V) (y : V) : f @ F --> y <-> \forall eps \near 0^'+, \forall t \near F, `|y - f t| < eps. Proof. exact: (cvgrP _ 0 3)%N. Qed. -Lemma cvgrPdist_lep {T} {F : set (set T)} {FF : Filter F} (f : T -> V) (y : V) : +Lemma cvgrPdist_lep {T} {F : set_system T} {FF : Filter F} (f : T -> V) (y : V) : f @ F --> y <-> \forall eps \near 0^'+, \forall t \near F, `|y - f t| <= eps. Proof. exact: (cvgrP _ 0 2)%N. Qed. -Lemma cvgrPdistC_le {T} {F : set (set T)} {FF : Filter F} (f : T -> V) (y : V) : +Lemma cvgrPdistC_le {T} {F : set_system T} {FF : Filter F} (f : T -> V) (y : V) : f @ F --> y <-> forall eps, 0 < eps -> \forall t \near F, `|f t - y| <= eps. Proof. rewrite cvgrPdist_le. by under [X in X <-> _]eq_forall do under eq_near do rewrite distrC. Qed. -Lemma cvgrPdistC_ltp {T} {F : set (set T)} {FF : Filter F} (f : T -> V) (y : V) : +Lemma cvgrPdistC_ltp {T} {F : set_system T} {FF : Filter F} (f : T -> V) (y : V) : f @ F --> y <-> \forall eps \near 0^'+, \forall t \near F, `|f t - y| < eps. Proof. by rewrite cvgrPdist_ltp; under eq_near do under eq_near do rewrite distrC. Qed. -Lemma cvgrPdistC_lep {T} {F : set (set T)} {FF : Filter F} (f : T -> V) (y : V) : +Lemma cvgrPdistC_lep {T} {F : set_system T} {FF : Filter F} (f : T -> V) (y : V) : f @ F --> y <-> \forall eps \near 0^'+, \forall t \near F, `|f t - y| <= eps. Proof. by rewrite cvgrPdist_lep; under eq_near do under eq_near do rewrite distrC. Qed. -Lemma cvgr0Pnorm_le {T} {F : set (set T)} {FF : Filter F} (f : T -> V) : +Lemma cvgr0Pnorm_le {T} {F : set_system T} {FF : Filter F} (f : T -> V) : f @ F --> 0 <-> forall eps, 0 < eps -> \forall t \near F, `|f t| <= eps. Proof. rewrite cvgrPdistC_le. by under [X in X <-> _]eq_forall do under eq_near do rewrite subr0. Qed. -Lemma cvgr0Pnorm_ltp {T} {F : set (set T)} {FF : Filter F} (f : T -> V) : +Lemma cvgr0Pnorm_ltp {T} {F : set_system T} {FF : Filter F} (f : T -> V) : f @ F --> 0 <-> \forall eps \near 0^'+, \forall t \near F, `|f t| < eps. Proof. by rewrite cvgrPdistC_ltp; under eq_near do under eq_near do rewrite subr0. Qed. -Lemma cvgr0Pnorm_lep {T} {F : set (set T)} {FF : Filter F} (f : T -> V) : +Lemma cvgr0Pnorm_lep {T} {F : set_system T} {FF : Filter F} (f : T -> V) : f @ F --> 0 <-> \forall eps \near 0^'+, \forall t \near F, `|f t| <= eps. Proof. by rewrite cvgrPdistC_lep; under eq_near do under eq_near do rewrite subr0. Qed. -Lemma cvgr_norm_lt {T} {F : set (set T)} {FF : Filter F} (f : T -> V) (y : V) : +Lemma cvgr_norm_lt {T} {F : set_system T} {FF : Filter F} (f : T -> V) (y : V) : f @ F --> y -> forall u, `|y| < u -> \forall t \near F, `|f t| < u. Proof. -move=> Fy z zy; near 0^'+ => k; near=> x; have : `|f x - y| < k. +move=> Fy z zy; near (0:R)^'+ => k; near=> x; have : `|f x - y| < k. by near: x; apply: cvgr_distC_lt => //; near: k; apply: nbhs_right_gt. move=> /(le_lt_trans (ler_dist_dist _ _)) /real_ltr_normlW. -rewrite realB// ltr_subl_addl => /(_ _)/lt_le_trans; apply => //. -by rewrite -ler_subr_addl; near: k; apply: nbhs_right_le; rewrite subr_gt0. +rewrite realB// ltrBlDl => /(_ _)/lt_le_trans; apply => //. +by rewrite -lerBrDl; near: k; apply: nbhs_right_le; rewrite subr_gt0. Unshelve. all: by end_near. Qed. -Lemma cvgr_norm_le {T} {F : set (set T)} {FF : Filter F} (f : T -> V) (y : V) : +Lemma cvgr_norm_le {T} {F : set_system T} {FF : Filter F} (f : T -> V) (y : V) : f @ F --> y -> forall u, `|y| < u -> \forall t \near F, `|f t| <= u. Proof. by move=> fy u yu; near do apply/ltW; apply: cvgr_norm_lt yu. Unshelve. all: by end_near. Qed. -Lemma cvgr_norm_gt {T} {F : set (set T)} {FF : Filter F} (f : T -> V) (y : V) : +Lemma cvgr_norm_gt {T} {F : set_system T} {FF : Filter F} (f : T -> V) (y : V) : f @ F --> y -> forall u, `|y| > u -> \forall t \near F, `|f t| > u. Proof. -move=> Fy z zy; near 0^'+ => k; near=> x; have: `|f x - y| < k. +move=> Fy z zy; near (0:R)^'+ => k; near=> x; have: `|f x - y| < k. by near: x; apply: cvgr_distC_lt => //; near: k; apply: nbhs_right_gt. move=> /(le_lt_trans (ler_dist_dist _ _)); rewrite distrC => /real_ltr_normlW. -rewrite realB// ltr_subl_addl -ltr_subl_addr => /(_ isT); apply: le_lt_trans. -rewrite ler_subr_addl -ler_subr_addr; near: k; apply: nbhs_right_le. +rewrite realB// ltrBlDl -ltrBlDr => /(_ isT); apply: le_lt_trans. +rewrite lerBrDl -lerBrDr; near: k; apply: nbhs_right_le. by rewrite subr_gt0. Unshelve. all: by end_near. Qed. -Lemma cvgr_norm_ge {T} {F : set (set T)} {FF : Filter F} (f : T -> V) (y : V) : +Lemma cvgr_norm_ge {T} {F : set_system T} {FF : Filter F} (f : T -> V) (y : V) : f @ F --> y -> forall u, `|y| > u -> \forall t \near F, `|f t| >= u. Proof. by move=> fy u yu; near do apply/ltW; apply: cvgr_norm_gt yu. Unshelve. all: by end_near. Qed. -Lemma cvgr_neq0 {T} {F : set (set T)} {FF : Filter F} (f : T -> V) (y : V) : +Lemma cvgr_neq0 {T} {F : set_system T} {FF : Filter F} (f : T -> V) (y : V) : f @ F --> y -> y != 0 -> \forall t \near F, f t != 0. Proof. move=> Fy z; near do rewrite -normr_gt0. @@ -2089,23 +1586,25 @@ Arguments cvgr_neq0 {R V T F FF f}. #[global] Hint Extern 0 (is_true (?x <= _)) => match goal with H : x \is_near _ |- _ => near: x; exact: nbhs_left_le end : core. -#[global] Typeclasses Opaque at_left at_right. -Notation "x ^'-" := (at_left x) : classical_set_scope. -Notation "x ^'+" := (at_right x) : classical_set_scope. + +#[global] Hint Extern 0 (ProperFilter _^'-) => + (apply: at_left_proper_filter) : typeclass_instances. +#[global] Hint Extern 0 (ProperFilter _^'+) => + (apply: at_right_proper_filter) : typeclass_instances. Section at_left_rightR. Variable (R : numFieldType). -Lemma real_cvgr_lt {T} {F : set (set T)} {FF : Filter F} (f : T -> R) (y : R) : +Lemma real_cvgr_lt {T} {F : set_system T} {FF : Filter F} (f : T -> R) (y : R) : y \is Num.real -> f @ F --> y -> forall z, z > y -> \forall t \near F, f t \is Num.real -> f t < z. Proof. move=> yr Fy z zy; near=> x => fxr. -rewrite -(ltr_add2r (- y)) real_ltr_normlW// ?rpredB//. +rewrite -(ltrD2r (- y)) real_ltr_normlW// ?rpredB//. by near: x; apply: cvgr_distC_lt => //; rewrite subr_gt0. Unshelve. all: by end_near. Qed. -Lemma real_cvgr_le {T} {F : set (set T)} {FF : Filter F} (f : T -> R) (y : R) : +Lemma real_cvgr_le {T} {F : set_system T} {FF : Filter F} (f : T -> R) (y : R) : y \is Num.real -> f @ F --> y -> forall z, z > y -> \forall t \near F, f t \is Num.real -> f t <= z. Proof. @@ -2113,16 +1612,16 @@ move=> /real_cvgr_lt/[apply] + ? z0 => /(_ _ z0). by apply: filterS => ? /[apply]/ltW. Qed. -Lemma real_cvgr_gt {T} {F : set (set T)} {FF : Filter F} (f : T -> R) (y : R) : +Lemma real_cvgr_gt {T} {F : set_system T} {FF : Filter F} (f : T -> R) (y : R) : y \is Num.real -> f @ F --> y -> forall z, y > z -> \forall t \near F, f t \is Num.real -> f t > z. Proof. move=> yr Fy z zy; near=> x => fxr. -rewrite -ltr_opp2 -(ltr_add2l y) real_ltr_normlW// ?rpredB//. +rewrite -ltrN2 -(ltrD2l y) real_ltr_normlW// ?rpredB//. by near: x; apply: cvgr_dist_lt => //; rewrite subr_gt0. Unshelve. all: by end_near. Qed. -Lemma real_cvgr_ge {T} {F : set (set T)} {FF : Filter F} (f : T -> R) (y : R) : +Lemma real_cvgr_ge {T} {F : set_system T} {FF : Filter F} (f : T -> R) (y : R) : y \is Num.real -> f @ F --> y -> forall z, z < y -> \forall t \near F, f t \is Num.real -> f t >= z. Proof. @@ -2146,27 +1645,27 @@ rewrite nbhsr0P -propeqE; apply: eq_near => y /=. by rewrite -propeqE; apply: eq_forall => z; rewrite ler_distlC. Qed. -Lemma cvgr_lt {T} {F : set (set T)} {FF : Filter F} (f : T -> R) (y : R) : +Lemma cvgr_lt {T} {F : set_system T} {FF : Filter F} (f : T -> R) (y : R) : f @ F --> y -> forall z, z > y -> \forall t \near F, f t < z. Proof. -move=> Fy z zy; near=> x; rewrite -(ltr_add2r (- y)) ltr_normlW//. +move=> Fy z zy; near=> x; rewrite -(ltrD2r (- y)) ltr_normlW//. by near: x; apply: cvgr_distC_lt => //; rewrite subr_gt0. Unshelve. all: by end_near. Qed. -Lemma cvgr_le {T} {F : set (set T)} {FF : Filter F} (f : T -> R) (y : R) : +Lemma cvgr_le {T} {F : set_system T} {FF : Filter F} (f : T -> R) (y : R) : f @ F --> y -> forall z, z > y -> \forall t \near F, f t <= z. Proof. by move=> /cvgr_lt + ? z0 => /(_ _ z0); apply: filterS => ?; apply/ltW. Qed. -Lemma cvgr_gt {T} {F : set (set T)} {FF : Filter F} (f : T -> R) (y : R) : +Lemma cvgr_gt {T} {F : set_system T} {FF : Filter F} (f : T -> R) (y : R) : f @ F --> y -> forall z, y > z -> \forall t \near F, f t > z. Proof. -move=> Fy z zy; near=> x; rewrite -ltr_opp2 -(ltr_add2l y) ltr_normlW//. +move=> Fy z zy; near=> x; rewrite -ltrN2 -(ltrD2l y) ltr_normlW//. by near: x; apply: cvgr_dist_lt => //; rewrite subr_gt0. Unshelve. all: by end_near. Qed. -Lemma cvgr_ge {T} {F : set (set T)} {FF : Filter F} (f : T -> R) (y : R) : +Lemma cvgr_ge {T} {F : set_system T} {FF : Filter F} (f : T -> R) (y : R) : f @ F --> y -> forall z, z < y -> \forall t \near F, f t >= z. Proof. by move=> /cvgr_gt + ? z0 => /(_ _ z0); apply: filterS => ?; apply/ltW. @@ -2186,20 +1685,20 @@ Definition fun1 {T : Type} {K : numFieldType} : T -> K := fun=> 1. Arguments fun1 {T K} x /. Definition dominated_by {T : Type} {K : numDomainType} {V W : pseudoMetricNormedZmodType K} - (h : T -> V) (k : K) (f : T -> W) (F : set (set T)) := + (h : T -> V) (k : K) (f : T -> W) (F : set_system T) := F [set x | `|f x| <= k * `|h x|]. Definition strictly_dominated_by {T : Type} {K : numDomainType} {V W : pseudoMetricNormedZmodType K} - (h : T -> V) (k : K) (f : T -> W) (F : set (set T)) := + (h : T -> V) (k : K) (f : T -> W) (F : set_system T) := F [set x | `|f x| < k * `|h x|]. Lemma sub_dominatedl (T : Type) (K : numDomainType) (V W : pseudoMetricNormedZmodType K) - (h : T -> V) (k : K) (F G : set (set T)) : F `=>` G -> + (h : T -> V) (k : K) (F G : set_system T) : F `=>` G -> (@dominated_by T K V W h k)^~ G `<=` (dominated_by h k)^~ F. Proof. by move=> FG f; exact: FG. Qed. Lemma sub_dominatedr (T : Type) (K : numDomainType) (V : pseudoMetricNormedZmodType K) - (h : T -> V) (k : K) (f g : T -> V) (F : set (set T)) (FF : Filter F) : + (h : T -> V) (k : K) (f g : T -> V) (F : set_system T) (FF : Filter F) : (\forall x \near F, `|f x| <= `|g x|) -> dominated_by h k g F -> dominated_by h k f F. Proof. by move=> le_fg; apply: filterS2 le_fg => x; apply: le_trans. Qed. @@ -2220,7 +1719,7 @@ by congr F; rewrite funeqE => x/=; rewrite normr1 mulr1. Qed. Lemma ex_dom_bound {T : Type} {K : numFieldType} {V W : pseudoMetricNormedZmodType K} - (h : T -> V) (f : T -> W) (F : set (set T)) {PF : ProperFilter F}: + (h : T -> V) (f : T -> W) (F : set_system T) {PF : ProperFilter F}: (\forall M \near +oo, dominated_by h M f F) <-> exists M, dominated_by h M f F. Proof. @@ -2234,12 +1733,12 @@ have [] := pselect (exists x, (h x != 0) && (`|f x| <= M * `|h x|)); last first. case => x0 /andP[hx0_neq0] /(le_trans (normr_ge0 _)) /ger0_real. rewrite realrM // ?normr_eq0// => M_real. exists M; split => // k Mk; apply: filterS FM => x /le_trans/= ->//. -by rewrite ler_wpmul2r// ltW. +by rewrite ler_wpM2r// ltW. Qed. Lemma ex_strict_dom_bound {T : Type} {K : numFieldType} {V W : pseudoMetricNormedZmodType K} - (h : T -> V) (f : T -> W) (F : set (set T)) {PF : ProperFilter F} : + (h : T -> V) (f : T -> W) (F : set_system T) {PF : ProperFilter F} : (\forall x \near F, h x != 0) -> (\forall M \near +oo, dominated_by h M f F) <-> exists M, strictly_dominated_by h M f F. @@ -2247,12 +1746,12 @@ Proof. move=> hN0; rewrite ex_dom_bound /dominated_by /strictly_dominated_by. split => -[] M FM; last by exists M; apply: filterS FM => x /ltW. exists (M + 1); apply: filterS2 hN0 FM => x hN0 /le_lt_trans/= ->//. -by rewrite ltr_pmul2r ?normr_gt0// ltr_addl. +by rewrite ltr_pM2r ?normr_gt0// ltrDl. Qed. Definition bounded_near {T : Type} {K : numFieldType} {V : pseudoMetricNormedZmodType K} - (f : T -> V) (F : set (set T)) := + (f : T -> V) (F : set_system T) := \forall M \near +oo, F [set x | `|f x| <= M]. Lemma boundedE {T : Type} {K : numFieldType} {V : pseudoMetricNormedZmodType K} : @@ -2260,12 +1759,12 @@ Lemma boundedE {T : Type} {K : numFieldType} {V : pseudoMetricNormedZmodType K} Proof. by rewrite dominated_by1. Qed. Lemma sub_boundedr (T : Type) (K : numFieldType) (V : pseudoMetricNormedZmodType K) - (F G : set (set T)) : F `=>` G -> + (F G : set_system T) : F `=>` G -> (@bounded_near T K V)^~ G `<=` bounded_near^~ F. Proof. by move=> FG f; rewrite /bounded_near; apply: filterS=> M; apply: FG. Qed. Lemma sub_boundedl (T : Type) (K : numFieldType) (V : pseudoMetricNormedZmodType K) - (f g : T -> V) (F : set (set T)) (FF : Filter F) : + (f g : T -> V) (F : set_system T) (FF : Filter F) : (\forall x \near F, `|f x| <= `|g x|) -> bounded_near g F -> bounded_near f F. Proof. move=> le_fg; rewrite /bounded_near; apply: filterS => M. @@ -2273,12 +1772,12 @@ by apply: filterS2 le_fg => x; apply: le_trans. Qed. Lemma ex_bound {T : Type} {K : numFieldType} {V : pseudoMetricNormedZmodType K} - (f : T -> V) (F : set (set T)) {PF : ProperFilter F}: + (f : T -> V) (F : set_system T) {PF : ProperFilter F}: bounded_near f F <-> exists M, F [set x | `|f x| <= M]. Proof. by rewrite boundedE ex_dom_bound dominated_by1. Qed. Lemma ex_strict_bound {T : Type} {K : numFieldType} {V : pseudoMetricNormedZmodType K} - (f : T -> V) (F : set (set T)) {PF : ProperFilter F}: + (f : T -> V) (F : set_system T) {PF : ProperFilter F}: bounded_near f F <-> exists M, F [set x | `|f x| < M]. Proof. rewrite boundedE ex_strict_dom_bound ?strictly_dominated_by1//. @@ -2286,15 +1785,15 @@ by near=> x; rewrite oner_eq0. Unshelve. all: by end_near. Qed. Lemma ex_strict_bound_gt0 {T : Type} {K : numFieldType} {V : pseudoMetricNormedZmodType K} - (f : T -> V) (F : set (set T)) {PF : Filter F}: + (f : T -> V) (F : set_system T) {PF : Filter F}: bounded_near f F -> exists2 M, M > 0 & F [set x | `|f x| < M]. Proof. move=> /pinfty_ex_gt0[M M_gt0 FM]; exists (M + 1); rewrite ?addr_gt0//. -by apply: filterS FM => x /le_lt_trans/= ->//; rewrite ltr_addl. +by apply: filterS FM => x /le_lt_trans/= ->//; rewrite ltrDl. Qed. -Notation "[ 'bounded' E | x 'in' A ]" := (bounded_near (fun x => E) (globally A)) - (at level 0, x name, format "[ 'bounded' E | x 'in' A ]"). +Notation "[ 'bounded' E | x 'in' A ]" := + (bounded_near (fun x => E) (globally A)). Notation bounded_set := [set A | [bounded x | x in A]]. Notation bounded_fun := [set f | [bounded f x | x in setT]]. @@ -2302,7 +1801,7 @@ Lemma bounded_fun_has_ubound (T : Type) (R : realFieldType) (a : T -> R) : bounded_fun a -> has_ubound (range a). Proof. move=> [M [Mreal]]/(_ (`|M| + 1)). -rewrite (le_lt_trans (ler_norm _)) ?ltr_addl// => /(_ erefl) aM. +rewrite (le_lt_trans (ler_norm _)) ?ltrDl// => /(_ erefl) aM. by exists (`|M| + 1) => _ [n _ <-]; rewrite (le_trans (ler_norm _))// aM. Qed. @@ -2325,8 +1824,8 @@ Lemma bounded_funD (T : Type) (R : realFieldType) (a b : T -> R) : Proof. move=> [M [Mreal Ma]] [N [Nreal Nb]]. rewrite /bounded_fun/bounded_near; near=> x => y /= _. -rewrite (le_trans (ler_norm_add _ _))// [x]splitr. -by rewrite ler_add// (Ma, Nb)// ltr_pdivl_mulr//; +rewrite (le_trans (ler_normD _ _))// [x]splitr. +by rewrite lerD// (Ma, Nb)// ltr_pdivlMr//; near: x; apply: nbhs_pinfty_gt; rewrite ?rpredM ?rpred_nat. Unshelve. all: by end_near. Qed. @@ -2335,53 +1834,59 @@ Lemma bounded_locally (T : topologicalType) [bounded f x | x in A] -> [locally [bounded f x | x in A]]. Proof. by move=> /sub_boundedr AB x Ax; apply: AB; apply: within_nbhsW. Qed. -Notation "k .-lipschitz_on f" := (dominated_by (self_sub id) k (self_sub f)) - (at level 2, format "k .-lipschitz_on f") : type_scope. +Notation "k .-lipschitz_on f" := + (dominated_by (self_sub id) k (self_sub f)) : type_scope. Definition sub_klipschitz (K : numFieldType) (V W : normedModType K) (k : K) - (f : V -> W) (F G : set (set (V * V))) : + (f : V -> W) (F G : set_system (V * V)) : F `=>` G -> k.-lipschitz_on f G -> k.-lipschitz_on f F. Proof. exact. Qed. Definition lipschitz_on (K : numFieldType) (V W : normedModType K) - (f : V -> W) (F : set (set (V * V))) := + (f : V -> W) (F : set_system (V * V)) := \forall M \near +oo, M.-lipschitz_on f F. Definition sub_lipschitz (K : numFieldType) (V W : normedModType K) - (f : V -> W) (F G : set (set (V * V))) : + (f : V -> W) (F G : set_system (V * V)) : F `=>` G -> lipschitz_on f G -> lipschitz_on f F. Proof. by move=> FG; rewrite /lipschitz_on; apply: filterS => M; apply: FG. Qed. Lemma klipschitzW (K : numFieldType) (V W : normedModType K) (k : K) - (f : V -> W) (F : set (set (V * V))) {PF : ProperFilter F} : + (f : V -> W) (F : set_system (V * V)) {PF : ProperFilter F} : k.-lipschitz_on f F -> lipschitz_on f F. Proof. by move=> f_lip; apply/ex_dom_bound; exists k. Qed. Notation "k .-lipschitz_ A f" := - (k.-lipschitz_on f (globally (A `*` A))) - (at level 2, A at level 0, format "k .-lipschitz_ A f"). -Notation "k .-lipschitz f" := (k.-lipschitz_setT f) - (at level 2, format "k .-lipschitz f") : type_scope. + (k.-lipschitz_on f (globally (A `*` A))) : type_scope. +Notation "k .-lipschitz f" := (k.-lipschitz_setT f) : type_scope. Notation "[ 'lipschitz' E | x 'in' A ]" := - (lipschitz_on (fun x => E) (globally (A `*` A))) - (at level 0, x name, format "[ 'lipschitz' E | x 'in' A ]"). + (lipschitz_on (fun x => E) (globally (A `*` A))) : type_scope. Notation lipschitz f := [lipschitz f x | x in setT]. -Lemma klipschitz_locally (R : numFieldType) (V W : normedModType R) - (k : R) (f : V -> W) (A : set V) : - k.-lipschitz_A f -> [locally k.-lipschitz_A f]. +Lemma lipschitz_set0 (K : numFieldType) (V W : normedModType K) + (f : V -> W) : [lipschitz f x | x in set0]. +Proof. by apply: nearW; rewrite setM0 => ?; apply: globally0. Qed. + +Lemma lipschitz_set1 (K : numFieldType) (V W : normedModType K) + (f : V -> W) (a : V) : [lipschitz f x | x in [set a]]. Proof. -by move=> bndf x Ax; apply: sub_klipschitz bndf; apply: within_nbhsW. +apply: (@klipschitzW _ _ _ `|f a|). + exact: (@globally_properfilter _ _ (a, a)). +by move=> [x y] /= [] -> ->; rewrite !subrr !normr0 mulr0. Qed. +Lemma klipschitz_locally (R : numFieldType) (V W : normedModType R) (k : R) + (f : V -> W) (A : set V) : + k.-lipschitz_A f -> [locally k.-lipschitz_A f]. +Proof. by move=> + x Ax; apply: sub_klipschitz; apply: within_nbhsW. Qed. + Lemma lipschitz_locally (R : numFieldType) (V W : normedModType R) (A : set V) (f : V -> W) : [lipschitz f x | x in A] -> [locally [lipschitz f x | x in A]]. -Proof. -by move=> bndf x Ax; apply: sub_lipschitz bndf; apply: within_nbhsW. -Qed. +Proof. by move=> + x Ax; apply: sub_lipschitz; apply: within_nbhsW. Qed. -Lemma lipschitz_id (R : numFieldType) (V : normedModType R) : 1.-lipschitz (@id V). +Lemma lipschitz_id (R : numFieldType) (V : normedModType R) : + 1.-lipschitz (@id V). Proof. by move=> [/= x y] _; rewrite mul1r. Qed. Arguments lipschitz_id {R V}. @@ -2402,7 +1907,7 @@ Proof. case => q [q1 ctrfq] Ux Uy fixx fixy; apply/subr0_eq/normr0_eq0/eqP. have [->|xyneq] := eqVneq x y; first by rewrite subrr normr0. have xypos : 0 < `|x - y| by rewrite normr_gt0 subr_eq0. -suff : `|x - y| <= q%:num * `|x - y| by rewrite ler_pmull // leNgt q1. +suff : `|x - y| <= q%:num * `|x - y| by rewrite ler_pMl // leNgt q1. by rewrite [in leLHS]fixx [in leLHS]fixy; exact: (ctrfq (_, _)). Qed. @@ -2421,8 +1926,8 @@ set r := PosNum ab2; exists (r, r) => /=. apply/negPn/negP => /set0P[c] []; rewrite -ball_normE /ball_ => acr bcr. have r22 : r%:num * 2 = r%:num + r%:num. by rewrite (_ : 2 = 1 + 1) // mulrDr mulr1. -move: (ltr_add acr bcr); rewrite -r22 (distrC b c). -move/(le_lt_trans (ler_dist_add c a b)). +move: (ltrD acr bcr); rewrite -r22 (distrC b c). +move/(le_lt_trans (ler_distD c a b)). by rewrite -mulrA mulVr ?mulr1 ?ltxx // unitfE. Qed. Hint Extern 0 (hausdorff_space _) => solve[apply: norm_hausdorff] : core. @@ -2438,7 +1943,7 @@ Lemma norm_cvg_unique {F} {FF : ProperFilter F} : is_subset1 [set x : V | F --> Proof. exact: cvg_unique. Qed. Lemma norm_cvg_eq (x y : V) : x --> y -> x = y. Proof. exact: (@cvg_eq V). Qed. -Lemma norm_lim_id (x : V) : lim x = x. Proof. exact: lim_id. Qed. +Lemma norm_lim_id (x : V) : lim (nbhs x) = x. Proof. exact: lim_id. Qed. Lemma norm_cvg_lim {F} {FF : ProperFilter F} (l : V) : F --> l -> lim F = l. Proof. exact: (@cvg_lim V). Qed. @@ -2474,7 +1979,7 @@ Proof. by have := @ball_splitl _ _ z x y e; rewrite -ball_normE. Qed. Lemma normm_leW (x : V) (e : R) : e > 0 -> `|x| <= e / 2 -> `|x| < e. Proof. -by move=> /posnumP[{}e] /le_lt_trans ->//; rewrite [ltRHS]splitr ltr_spaddl. +by move=> /posnumP[{}e] /le_lt_trans ->//; rewrite [ltRHS]splitr ltr_pwDl. Qed. Lemma normm_lt_split (x y : V) (e : R) : @@ -2483,7 +1988,7 @@ Proof. by move=> xlt ylt; rewrite -[y]opprK (@distm_lt_split 0) ?subr0 ?opprK ?add0r. Qed. -Lemma __deprecated__cvg_distW {F : set (set V)} {FF : Filter F} (y : V) : +Lemma __deprecated__cvg_distW {F : set_system V} {FF : Filter F} (y : V) : (forall eps, 0 < eps -> \forall y' \near F, `|y - y'| <= eps) -> F --> y. Proof. by move=> /cvgrPdist_le. Qed. @@ -2491,16 +1996,16 @@ Proof. by move=> /cvgrPdist_le. Qed. End PseudoNormedZMod_numFieldType. #[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvgrPdist_le` or a variation instead")] -Notation cvg_distW := __deprecated__cvg_distW. +Notation cvg_distW := __deprecated__cvg_distW (only parsing). #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `norm_cvgi_lim`")] -Notation norm_cvgi_map_lim := norm_cvgi_lim. +Notation norm_cvgi_map_lim := norm_cvgi_lim (only parsing). Section NormedModule_numFieldType. Variables (R : numFieldType) (V : normedModType R). Section cvgr_norm_infty. -Variables (I : Type) (F : set (set I)) (FF : Filter F) (f : I -> V) (y : V). +Variables (I : Type) (F : set_system I) (FF : Filter F) (f : I -> V) (y : V). Lemma cvgr_norm_lty : f @ F --> y -> \forall M \near +oo, \forall y' \near F, `|f y'| < M. @@ -2527,11 +2032,11 @@ Unshelve. all: by end_near. Qed. End cvgr_norm_infty. -Lemma __deprecated__cvg_bounded_real {F : set (set V)} {FF : Filter F} (y : V) : +Lemma __deprecated__cvg_bounded_real {F : set_system V} {FF : Filter F} (y : V) : F --> y -> \forall M \near +oo, \forall y' \near F, `|y'| < M. Proof. exact: cvgr_norm_lty. Qed. -Lemma cvg_bounded {I} {F : set (set I)} {FF : Filter F} (f : I -> V) (y : V) : +Lemma cvg_bounded {I} {F : set_system I} {FF : Filter F} (f : I -> V) (y : V) : f @ F --> y -> bounded_near f F. Proof. exact: cvgr_norm_ley. Qed. @@ -2545,25 +2050,79 @@ Arguments cvg_bounded {R V I F FF}. Hint Extern 0 (hausdorff_space _) => solve[apply: norm_hausdorff] : core. #[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvgr_norm_lty` or a variation instead")] -Notation cvg_bounded_real := __deprecated__cvg_bounded_real. +Notation cvg_bounded_real := __deprecated__cvg_bounded_real (only parsing). Module Export NbhsNorm. Definition nbhs_simpl := (nbhs_simpl,@nbhs_nbhs_norm,@filter_from_norm_nbhs). End NbhsNorm. -(* TODO: generalize to R : numFieldType *) -Section hausdorff. +Lemma cvg_at_rightE (R : numFieldType) (V : normedModType R) (f : R -> V) x : + cvg (f @ x^') -> lim (f @ x^') = lim (f @ x^'+). +Proof. +move=> cvfx; apply/Logic.eq_sym. +apply: (@cvg_lim _ _ _ (at_right _)) => // A /cvfx /nbhs_ballP [_ /posnumP[e] xe_A]. +by exists e%:num => //= y xe_y; rewrite lt_def => /andP [xney _]; apply: xe_A. +Qed. +Arguments cvg_at_rightE {R V} f x. + +Lemma cvg_at_leftE (R : numFieldType) (V : normedModType R) (f : R -> V) x : + cvg (f @ x^') -> lim (f @ x^') = lim (f @ x^'-). +Proof. +move=> cvfx; apply/Logic.eq_sym. +apply: (@cvg_lim _ _ _ (at_left _)) => // A /cvfx /nbhs_ballP [_ /posnumP[e] xe_A]. +exists e%:num => //= y xe_y; rewrite lt_def => /andP [xney _]. +by apply: xe_A => //; rewrite eq_sym. +Qed. +Arguments cvg_at_leftE {R V} f x. -Lemma Rhausdorff (R : realFieldType) : hausdorff_space R. +Lemma continuous_within_itvP {R : realType } a b (f : R -> R) : + a < b -> + {within `[a,b], continuous f} <-> + {in `]a,b[, continuous f} /\ f @ a^'+ --> f a /\ f @b^'- --> f b. Proof. -move=> x y clxy; apply/eqP; rewrite eq_le. -apply/in_segment_addgt0Pr => _ /posnumP[e]. -rewrite in_itv /= -ler_distl; set he := (e%:num / 2)%:pos. -have [z [zx_he yz_he]] := clxy _ _ (nbhsx_ballx x he) (nbhsx_ballx y he). -have := ball_triangle yz_he (ball_sym zx_he). -by rewrite -mulr2n -mulr_natr divfK // => /ltW. +move=> ab; split=> [abf|]. + split. + suff : {in `]a, b[%classic, continuous f}. + by move=> P c W; apply: P; rewrite inE. + rewrite -continuous_open_subspace; last exact: interval_open. + by move: abf; exact/continuous_subspaceW/subset_itvW. + have [aab bab] : a \in `[a, b] /\ b \in `[a, b]. + by rewrite !in_itv/= !lexx (ltW ab). + split; apply/cvgrPdist_lt => eps eps_gt0 /=. + + move/continuous_withinNx/cvgrPdist_lt/(_ _ eps_gt0) : (abf a). + rewrite /dnbhs/= near_withinE !near_simpl// /prop_near1 /nbhs/=. + rewrite -nbhs_subspace_in// /within/= near_simpl. + apply: filter_app; exists (b - a); rewrite /= ?subr_gt0// => c cba + ac. + apply=> //; rewrite ?gt_eqF// !in_itv/= (ltW ac)/=; move: cba => /=. + by rewrite ltr0_norm ?subr_lt0// opprB ltr_add2r => /ltW. + + move/continuous_withinNx/cvgrPdist_lt/(_ _ eps_gt0) : (abf b). + rewrite /dnbhs/= near_withinE !near_simpl /prop_near1 /nbhs/=. + rewrite -nbhs_subspace_in// /within/= near_simpl. + apply: filter_app; exists (b - a); rewrite /= ?subr_gt0// => c cba + ac. + apply=> //; rewrite ?lt_eqF// !in_itv/= (ltW ac)/= andbT; move: cba => /=. + by rewrite gtr0_norm ?subr_gt0// ltr_add2l ltr_oppr opprK => /ltW. +case=> ctsoo [ctsL ctsR]; apply/subspace_continuousP => x /andP[]. +rewrite !bnd_simp/= !le_eqVlt => /predU1P[<-{x}|ax] /predU1P[|]. +- by move/eqP; rewrite lt_eqF. +- move=> _; apply/cvgrPdist_lt => eps eps_gt0 /=. + move/cvgrPdist_lt/(_ _ eps_gt0): ctsL; rewrite /at_right !near_withinE. + apply: filter_app; exists (b - a); rewrite /= ?subr_gt0// => c cba + ac. + have : a <= c by move: ac => /andP[]. + by rewrite le_eqVlt => /predU1P[->|/[swap] /[apply]//]; rewrite subrr normr0. +- move=> ->; apply/cvgrPdist_lt => eps eps_gt0 /=. + move/cvgrPdist_lt/(_ _ eps_gt0): ctsR; rewrite /at_left !near_withinE. + apply: filter_app; exists (b - a); rewrite /= ?subr_gt0 // => c cba + ac. + have : c <= b by move: ac => /andP[]. + by rewrite le_eqVlt => /predU1P[->|/[swap] /[apply]//]; rewrite subrr normr0. +- move=> xb; have aboox : x \in `]a, b[ by rewrite !in_itv/= ax. + rewrite within_interior; first exact: ctsoo. + suff : `]a, b[ `<=` interior `[a, b] by exact. + by rewrite -open_subsetE; [exact: subset_itvW| exact: interval_open]. Qed. +(* TODO: generalize to R : numFieldType *) +Section hausdorff. + Lemma pseudoMetricNormedZModType_hausdorff (R : realFieldType) (V : pseudoMetricNormedZmodType R) : hausdorff_space V. @@ -2593,10 +2152,9 @@ Lemma __deprecated__continuous_cvg_dist {R : numFieldType} Proof. by move=> cf /cvg_eq->// e; rewrite subrr normr0. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="simply use the fact that `(x --> l) -> (x = l)`")] -Notation continuous_cvg_dist := __deprecated__continuous_cvg_dist. - -(** ** Matrices *) +Notation continuous_cvg_dist := __deprecated__continuous_cvg_dist (only parsing). +(** Matrices: *) Section mx_norm. Variables (K : numDomainType) (m n : nat). Implicit Types x y : 'M[K]_(m, n). @@ -2610,8 +2168,8 @@ Lemma ler_mx_norm_add x y : mx_norm (x + y) <= mx_norm x + mx_norm y. Proof. rewrite !mx_normE [_ <= _%:num]num_le; apply/bigmax_leP. split=> [|ij _]; first exact: addr_ge0. -rewrite mxE; apply: le_trans (ler_norm_add _ _) _. -by rewrite ler_add// -[leLHS]nngE num_le; exact: le_bigmax. +rewrite mxE; apply: le_trans (ler_normD _ _) _. +by rewrite lerD// -[leLHS]nngE num_le; exact: le_bigmax. Qed. Lemma mx_norm_eq0 x : mx_norm x = 0 -> x = 0. @@ -2669,12 +2227,10 @@ elim/big_ind2 : _ => //= a a' b b' ->{a'} ->{b'}. by have [ab|ab] := leP a b; [rewrite max_r | rewrite max_l // ltW]. Qed. -Definition matrix_normedZmodMixin (K : numDomainType) (m n : nat) := - @Num.NormedMixin _ _ _ (@mx_norm K m.+1 n.+1) (@ler_mx_norm_add _ _ _) - (@mx_norm_eq0 _ _ _) (@mx_norm_natmul _ _ _) (@mx_normN _ _ _). - -Canonical matrix_normedZmodType (K : numDomainType) (m n : nat) := - NormedZmodType K 'M[K]_(m.+1, n.+1) (matrix_normedZmodMixin K m n). +HB.instance Definition _ (K : numDomainType) (m n : nat) := + Num.Zmodule_isNormed.Build K 'M[K]_(m, n) + (@ler_mx_norm_add _ _ _) (@mx_norm_eq0 _ _ _) + (@mx_norm_natmul _ _ _) (@mx_normN _ _ _). Section matrix_NormedModule. Variables (K : numFieldType) (m n : nat). @@ -2683,7 +2239,7 @@ Local Lemma ball_gt0 (x y : 'M[K]_(m.+1, n.+1)) e : ball x e y -> 0 < e. Proof. by move/(_ ord0 ord0); apply: le_lt_trans. Qed. Lemma mx_norm_ball : - @ball _ [pseudoMetricType K of 'M[K]_(m.+1, n.+1)] = ball_ (fun x => `| x |). + @ball _ [the pseudoMetricType K of 'M[K]_(m.+1, n.+1)] = ball_ (fun x => `| x |). Proof. rewrite /normr /ball_ predeq3E => x e y /=; rewrite mx_normE; split => xey. - have e_gt0 : 0 < e := ball_gt0 xey. @@ -2696,10 +2252,8 @@ rewrite /normr /ball_ predeq3E => x e y /=; rewrite mx_normE; split => xey. by move: (xey (i, j)); rewrite !mxE; exact. Qed. -Definition matrix_PseudoMetricNormedZmodMixin := - PseudoMetricNormedZmodule.Mixin mx_norm_ball. -Canonical matrix_pseudoMetricNormedZmodType := - PseudoMetricNormedZmodType K 'M[K]_(m.+1, n.+1) matrix_PseudoMetricNormedZmodMixin. +HB.instance Definition _ := + NormedZmod_PseudoMetric_eq.Build K 'M[K]_(m.+1, n.+1) mx_norm_ball. Lemma mx_normZ (l : K) (x : 'M[K]_(m.+1, n.+1)) : `| l *: x | = `| l | * `| x |. Proof. @@ -2707,17 +2261,16 @@ rewrite {1 3}/normr /= !mx_normE (eq_bigr (fun i => (`|l| * `|x i.1 i.2|)%:nng)); last first. by move=> i _; rewrite mxE //=; apply/eqP; rewrite -num_eq /= normrM. elim/big_ind2 : _ => // [|a b c d bE dE]; first by rewrite mulr0. -by rewrite !num_max bE dE maxr_pmulr. +by rewrite !num_max bE dE maxr_pMr. Qed. -Definition matrix_NormedModMixin := NormedModMixin mx_normZ. -Canonical matrix_normedModType := - NormedModType K 'M[K]_(m.+1, n.+1) matrix_NormedModMixin. +HB.instance Definition _ := + PseudoMetricNormedZmod_Lmodule_isNormedModule.Build K 'M[K]_(m.+1, n.+1) + mx_normZ. End matrix_NormedModule. -(** ** Pairs *) - +(** Pairs: *) Section prod_PseudoMetricNormedZmodule. Context {K : numDomainType} {U V : pseudoMetricNormedZmodType K}. @@ -2728,13 +2281,12 @@ rewrite /ball /= /prod_ball -!ball_normE /ball_ /=. by rewrite comparable_lt_maxl// ?real_comparable//; split=> /andP. Qed. -Lemma prod_norm_ball : @ball _ [pseudoMetricType K of U * V] = ball_ (fun x => `|x|). +Lemma prod_norm_ball : + @ball _ [the pseudoMetricType K of (U * V)%type] = ball_ (fun x => `|x|). Proof. by rewrite /= - ball_prod_normE. Qed. -Definition prod_pseudoMetricNormedZmodMixin := - PseudoMetricNormedZmodule.Mixin prod_norm_ball. -Canonical prod_pseudoMetricNormedZmodType := - PseudoMetricNormedZmodType K (U * V) prod_pseudoMetricNormedZmodMixin. +HB.instance Definition _ := NormedZmod_PseudoMetric_eq.Build K (U * V)%type + prod_norm_ball. End prod_PseudoMetricNormedZmodule. @@ -2742,11 +2294,11 @@ Section prod_NormedModule. Context {K : numDomainType} {U V : normedModType K}. Lemma prod_norm_scale (l : K) (x : U * V) : `| l *: x | = `|l| * `| x |. -Proof. by rewrite prod_normE /= !normrZ maxr_pmulr. Qed. +Proof. by rewrite prod_normE /= !normrZ maxr_pMr. Qed. -Definition prod_NormedModMixin := NormedModMixin prod_norm_scale. -Canonical prod_normedModType := - NormedModType K (U * V) prod_NormedModMixin. +HB.instance Definition _ := + PseudoMetricNormedZmod_Lmodule_isNormedModule.Build K (U * V)%type + prod_norm_scale. End prod_NormedModule. @@ -2755,10 +2307,10 @@ Variables (K : numDomainType). Example matrix_triangke m n (M N : 'M[K]_(m.+1, n.+1)) : `|M + N| <= `|M| + `|N|. -Proof. apply ler_norm_add. Qed. +Proof. apply ler_normD. Qed. Example pair_triangle (x y : K * K) : `|x + y| <= `|x| + `|y|. -Proof. apply ler_norm_add. Qed. +Proof. apply ler_normD. Qed. End example_of_sharing. @@ -2766,14 +2318,14 @@ Section prod_NormedModule_lemmas. Context {T : Type} {K : numDomainType} {U V : normedModType K}. -Lemma fcvgr2dist_ltP {F : set (set U)} {G : set (set V)} +Lemma fcvgr2dist_ltP {F : set_system U} {G : set_system V} {FF : Filter F} {FG : Filter G} (y : U) (z : V) : (F, G) --> (y, z) <-> forall eps, 0 < eps -> \forall y' \near F & z' \near G, `| (y, z) - (y', z') | < eps. Proof. exact: fcvgrPdist_lt. Qed. -Lemma cvgr2dist_ltP {I J} {F : set (set I)} {G : set (set J)} +Lemma cvgr2dist_ltP {I J} {F : set_system I} {G : set_system J} {FF : Filter F} {FG : Filter G} (f : I -> U) (g : J -> V) (y : U) (z : V) : (f @ F, g @ G) --> (y, z) <-> forall eps, 0 < eps -> @@ -2783,14 +2335,14 @@ rewrite fcvgr2dist_ltP; split=> + e e0 => /(_ e e0); by rewrite !near_simpl// => ?; rewrite !near_simpl. Qed. -Lemma cvgr2dist_lt {I J} {F : set (set I)} {G : set (set J)} +Lemma cvgr2dist_lt {I J} {F : set_system I} {G : set_system J} {FF : Filter F} {FG : Filter G} (f : I -> U) (g : J -> V) (y : U) (z : V) : (f @ F, g @ G) --> (y, z) -> forall eps, 0 < eps -> \forall i \near F & j \near G, `| (y, z) - (f i, g j) | < eps. Proof. by rewrite cvgr2dist_ltP. Qed. -Lemma __deprecated__cvg_dist2 {F : set (set U)} {G : set (set V)} +Lemma __deprecated__cvg_dist2 {F : set_system U} {G : set_system V} {FF : Filter F} {FG : Filter G} (y : U) (z : V): (F, G) --> (y, z) -> forall eps, 0 < eps -> @@ -2798,7 +2350,7 @@ Lemma __deprecated__cvg_dist2 {F : set (set U)} {G : set (set V)} Proof. exact: cvgr2dist_lt. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvgr2dist_lt` or a variant instead")] -Notation cvg_dist2 := __deprecated__cvg_dist2. +Notation cvg_dist2 := __deprecated__cvg_dist2 (only parsing). End prod_NormedModule_lemmas. Arguments cvgr2dist_ltP {_ _ _ _ _ F G FF FG}. @@ -2806,10 +2358,10 @@ Arguments cvgr2dist_lt {_ _ _ _ _ F G FF FG}. #[deprecated(since="mathcomp-analysis 0.6.0", note="use `fcvgr2dist_ltP` or a variant instead")] -Notation cvg_dist2P := fcvgr2dist_ltP. +Notation cvg_dist2P := fcvgr2dist_ltP (only parsing). -(** Normed vector spaces have some continuous functions *) -(** that are in fact continuous on pseudoMetricNormedZmodType *) +(** Normed vector spaces have some continuous functions that are in fact +continuous on pseudoMetricNormedZmodType *) Section NVS_continuity_pseudoMetricNormedZmodType. Context {K : numFieldType} {V : pseudoMetricNormedZmodType K}. @@ -2829,7 +2381,7 @@ Lemma natmul_continuous n : continuous (fun x : V => x *+ n). Proof. case: n => [|n] x; first exact: cvg_cst. apply/cvgrPdist_lt=> _/posnumP[e]; near=> a. -by rewrite -mulrnBl normrMn -mulr_natr -ltr_pdivl_mulr. +by rewrite -mulrnBl normrMn -mulr_natr -ltr_pdivlMr. Unshelve. all: by end_near. Qed. Lemma norm_continuous : continuous (normr : V -> K). @@ -2848,9 +2400,9 @@ Proof. move=> [/= k x]; apply/cvgrPdist_lt => _/posnumP[e]; near +oo_K => M. near=> l z => /=; have M0 : 0 < M by []. rewrite (@distm_lt_split _ _ (k *: z)) // -?(scalerBr, scalerBl) normrZ. - rewrite (@le_lt_trans _ _ (M * `|x - z|)) ?ler_wpmul2r -?ltr_pdivl_mull//. + rewrite (@le_lt_trans _ _ (M * `|x - z|)) ?ler_wpM2r -?ltr_pdivlMl//. by near: z; apply: cvgr_dist_lt; rewrite // mulr_gt0 ?invr_gt0. -rewrite (@le_lt_trans _ _ (`|k - l| * M)) ?ler_wpmul2l -?ltr_pdivl_mulr//. +rewrite (@le_lt_trans _ _ (`|k - l| * M)) ?ler_wpM2l -?ltr_pdivlMr//. by near: z; near: M; apply: cvg_bounded (@cvg_refl _ _). by near: l; apply: cvgr_dist_lt; rewrite // divr_gt0. Unshelve. all: by end_near. Qed. @@ -2880,19 +2432,19 @@ Proof. exact: scale_continuous. Qed. Lemma mulrl_continuous (x : K) : continuous ( *%R x). Proof. exact: scaler_continuous. Qed. -Lemma mulrr_continuous (y : K) : continuous ( *%R^~ y). +Lemma mulrr_continuous (y : K) : continuous ( *%R^~ y : K -> K). Proof. exact: scalel_continuous. Qed. -Lemma inv_continuous (x : K) : x != 0 -> {for x, continuous GRing.inv}. +Lemma inv_continuous (x : K) : x != 0 -> {for x, continuous (@GRing.inv K)}. Proof. move=> x_neq0; have nx_gt0 : `|x| > 0 by rewrite normr_gt0. apply/(@cvgrPdist_ltp _ _ _ (nbhs x)); near (0 : K)^'+ => d. near=> e. near=> y; have y_neq0 : y != 0 by near: y; apply: (cvgr_neq0 x). rewrite /= -div1r -[y^-1]div1r -mulNr addf_div// mul1r mulN1r normrM normfV. -rewrite ltr_pdivr_mulr ?normr_gt0 ?mulf_neq0// (@lt_le_trans _ _ (e * d))//. +rewrite ltr_pdivrMr ?normr_gt0 ?mulf_neq0// (@lt_le_trans _ _ (e * d))//. by near: y; apply: cvgr_distC_lt => //; rewrite mulr_gt0. -rewrite ler_pmul2l => //=; rewrite normrM -ler_pdivr_mull//. -near: y; apply: (cvgr_norm_ge x) => //; rewrite ltr_pdivr_mull//. +rewrite ler_pM2l => //=; rewrite normrM -ler_pdivrMl//. +near: y; apply: (cvgr_norm_ge x) => //; rewrite ltr_pdivrMl//. by near: d; apply: nbhs_right_lt; rewrite mulr_gt0. Unshelve. all: by end_near. Qed. @@ -2901,7 +2453,7 @@ End NVS_continuity_mul. Section cvg_composition_pseudometric. Context {K : numFieldType} {V : pseudoMetricNormedZmodType K} {T : Type}. -Context (F : set (set T)) {FF : Filter F}. +Context (F : set_system T) {FF : Filter F}. Implicit Types (f g : T -> V) (s : T -> K) (k : K) (x : T) (a b : V). Lemma cvgN f a : f @ F --> a -> - f @ F --> - a. @@ -2923,7 +2475,7 @@ Lemma is_cvgMn f n : cvg (f @ F) -> cvg (((@GRing.natmul _)^~n \o f) @ F). Proof. by move=> /cvgMn /cvgP. Qed. Lemma cvgD f g a b : f @ F --> a -> g @ F --> b -> (f + g) @ F --> a + b. -Proof. by move=> ? ?; apply: continuous2_cvg => //; exact: add_continuous. Qed. +Proof. by move=> ? ?; apply: continuous2_cvg => //; apply add_continuous. Qed. Lemma is_cvgD f g : cvg (f @ F) -> cvg (g @ F) -> cvg (f + g @ F). Proof. by have := cvgP _ (cvgD _ _); apply. Qed. @@ -2970,22 +2522,22 @@ Proof. by rewrite norm_cvg0P. Qed. End cvg_composition_pseudometric. Lemma __deprecated__cvg_dist0 {U} {K : numFieldType} {V : normedModType K} - {F : set (set U)} {FF : Filter F} (f : U -> V) : + {F : set_system U} {FF : Filter F} (f : U -> V) : (fun x => `|f x|) @ F --> (0 : K) -> f @ F --> (0 : V). Proof. exact: norm_cvg0. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `norm_cvg0` and generalized to `pseudoMetricNormedZmodType`")] -Notation cvg_dist0 := __deprecated__cvg_dist0. +Notation cvg_dist0 := __deprecated__cvg_dist0 (only parsing). Section cvg_composition_normed. Context {K : numFieldType} {V : normedModType K} {T : Type}. -Context (F : set (set T)) {FF : Filter F}. +Context (F : set_system T) {FF : Filter F}. Implicit Types (f g : T -> V) (s : T -> K) (k : K) (x : T) (a b : V). Lemma cvgZ s f k a : s @ F --> k -> f @ F --> a -> s x *: f x @[x --> F] --> k *: a. -Proof. move=> ? ?; apply: continuous2_cvg => //; exact: scale_continuous. Qed. +Proof. by move=> ? ?; apply: continuous2_cvg => //; apply scale_continuous. Qed. Lemma is_cvgZ s f : cvg (s @ F) -> cvg (f @ F) -> cvg ((fun x => s x *: f x) @ F). @@ -3013,7 +2565,7 @@ End cvg_composition_normed. Section cvg_composition_field. Context {K : numFieldType} {T : Type}. -Context (F : set (set T)) {FF : Filter F}. +Context (F : set_system T) {FF : Filter F}. Implicit Types (f g : T -> K) (a b : K). Lemma cvgV f a : a != 0 -> f @ F --> a -> f\^-1 @ F --> a^-1. @@ -3065,7 +2617,7 @@ End cvg_composition_field. Section limit_composition_pseudometric. Context {K : numFieldType} {V : pseudoMetricNormedZmodType K} {T : Type}. -Context (F : set (set T)) {FF : ProperFilter F}. +Context (F : set_system T) {FF : ProperFilter F}. Implicit Types (f g : T -> V) (s : T -> K) (k : K) (x : T) (a : V). Lemma limN f : cvg (f @ F) -> lim (- f @ F) = - lim (f @ F). @@ -3087,7 +2639,7 @@ End limit_composition_pseudometric. Section limit_composition_normed. Context {K : numFieldType} {V : normedModType K} {T : Type}. -Context (F : set (set T)) {FF : ProperFilter F}. +Context (F : set_system T) {FF : ProperFilter F}. Implicit Types (f g : T -> V) (s : T -> K) (k : K) (x : T) (a : V). Lemma limZ s f : cvg (s @ F) -> cvg (f @ F) -> @@ -3106,7 +2658,7 @@ End limit_composition_normed. Section limit_composition_field. Context {K : numFieldType} {T : Type}. -Context (F : set (set T)) {FF : ProperFilter F}. +Context (F : set_system T) {FF : ProperFilter F}. Implicit Types (f g : T -> K). Lemma limM f g : cvg (f @ F) -> cvg (g @ F) -> @@ -3118,7 +2670,7 @@ End limit_composition_field. Section cvg_composition_field_proper. Context {K : numFieldType} {T : Type}. -Context (F : set (set T)) {FF : ProperFilter F}. +Context (F : set_system T) {FF : ProperFilter F}. Implicit Types (f g : T -> K) (a b : K). Lemma limV f : lim (f @ F) != 0 -> lim (f\^-1 @ F) = (lim (f @ F))^-1. @@ -3135,7 +2687,7 @@ Qed. End cvg_composition_field_proper. Section ProperFilterRealType. -Context {T : Type} {F : set (set T)} {FF : ProperFilter F} {R : realFieldType}. +Context {T : Type} {F : set_system T} {FF : ProperFilter F} {R : realFieldType}. Implicit Types (f g h : T -> R) (a b : R). Lemma cvgr_to_ge f a b : f @ F --> a -> (\near F, b <= f F) -> b <= a. @@ -3161,10 +2713,10 @@ Proof. by move=> ?; apply: cvgr_le. Qed. End ProperFilterRealType. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `cvgr_ge` and generalized to a `Filter`")] -Notation cvg_gt_ge := __deprecated__cvg_gt_ge. +Notation cvg_gt_ge := __deprecated__cvg_gt_ge (only parsing). #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `cvgr_le` and generalized to a `Filter`")] -Notation cvg_lt_le_:= __deprecated__cvg_lt_le. +Notation cvg_lt_le_:= __deprecated__cvg_lt_le (only parsing). Section local_continuity. @@ -3234,7 +2786,7 @@ Section cvg_fin. Context {R : numFieldType}. Section filter. -Context {F : set (set \bar R)} {FF : Filter F}. +Context {F : set_system \bar R} {FF : Filter F}. Lemma fine_fcvg a : F --> a%:E -> fine @ F --> a. Proof. @@ -3250,7 +2802,7 @@ Proof. by apply; apply/nbhs_EFin; near=> x. Unshelve. all: by end_near. Qed. End filter. Section limit. -Context {I : Type} {F : set (set I)} {FF : Filter F} (f : I -> \bar R). +Context {I : Type} {F : set_system I} {FF : Filter F} (f : I -> \bar R). Lemma fine_cvg a : f @ F --> a%:E -> fine \o f @ F --> a. Proof. exact: fine_fcvg. Qed. @@ -3284,16 +2836,8 @@ End limit. End cvg_fin. -Lemma eq_cvg (T T' : Type) (F : set (set T)) (f g : T -> T') (x : set (set T')) : - f =1 g -> (f @ F --> x) = (g @ F --> x). -Proof. by move=> /funext->. Qed. - -Lemma eq_is_cvg (T T' : Type) (fT : filteredType T') (F : set (set T)) (f g : T -> T') : - f =1 g -> [cvg (f @ F) in fT] = [cvg (g @ F) in fT]. -Proof. by move=> /funext->. Qed. - Section ecvg_realFieldType. -Context {I} {F : set (set I)} {FF : Filter F} {R : realFieldType}. +Context {I} {F : set_system I} {FF : Filter F} {R : realFieldType}. Implicit Types f g u v : I -> \bar R. Local Open Scope ereal_scope. @@ -3305,13 +2849,13 @@ have yE u v x : u @ F --> +oo -> v @ F --> x%:E -> u \+ v @ F --> +oo. near=> A; near=> n; have /(_ _)/wrap[//|Fgn] := near Fg n. rewrite -lee_subl_addr// (@le_trans _ _ (A - (x - 1))%:E)//; last by near: n. rewrite ?EFinB lee_sub// lee_subl_addr// -[v n]fineK// -EFinD lee_fin. - by rewrite ler_distl_addr// ltW//; near: n; apply: cvgr_dist_lt. + by rewrite ler_distlDr// ltW//; near: n; apply: cvgr_dist_lt. have NyE u v x : u @ F --> -oo -> v @ F --> x%:E -> u \+ v @ F --> -oo. move=> /cvgeNyPle/= foo /fine_cvgP -[Fg gb]; apply/cvgeNyPleNy. near=> A; near=> n; have /(_ _)/wrap[//|Fgn] := near Fg n. rewrite -lee_subr_addr// (@le_trans _ _ (A - (x + 1))%:E)//; first by near: n. rewrite ?EFinB ?EFinD lee_sub// -[v n]fineK// -EFinD lee_fin. - by rewrite ler_distlC_addr// ltW//; near: n; apply: cvgr_dist_lt. + by rewrite ler_distlCDr// ltW//; near: n; apply: cvgr_dist_lt. have yyE u v : u @ F --> +oo -> v @ F --> +oo -> u \+ v @ F --> +oo. move=> /cvgeyPge foo /cvgeyPge goo; apply/cvgeyPge => A; near=> y. by rewrite -[leLHS]adde0 lee_add//; near: y; [apply: foo|apply: goo]. @@ -3356,7 +2900,7 @@ Qed. Lemma abse_continuous : continuous (@abse R). Proof. case=> [r|A /= [r [rreal rA]]|A /= [r [rreal rA]]]/=. -- exact/(cvg_comp (@norm_continuous _ [normedModType R of R^o] r)). +- exact/(cvg_comp (@norm_continuous _ [the normedModType R of R^o] r)). - by exists r; split => // y ry; apply: rA; rewrite (lt_le_trans ry)// lee_abs. - exists (- r)%R; rewrite realN; split => // y; rewrite EFinN -lte_oppr => yr. by apply: rA; rewrite (lt_le_trans yr)// -abseN lee_abs. @@ -3379,7 +2923,7 @@ Qed. Lemma mule_continuous (r : R) : continuous (mule r%:E). Proof. -wlog r0 : r / (r > 0)%R => [hwlog|]. +rewrite /continuous_at; wlog r0 : r / (r > 0)%R => [hwlog|]. have [r0|r0|->] := ltrgtP r 0; do ?exact: hwlog; last first. by move=> x; rewrite mul0e; apply: cvg_near_cst; near=> y; rewrite mul0e. have -> : *%E r%:E = \- ( *%E (- r)%:E ). @@ -3444,7 +2988,7 @@ Let cvgeM_lt0_pinfty f g b : Proof. move=> b0 /cvgeyPge foo /fine_cvgP -[gfin gb]; apply/cvgeNyPleNy. near (0%R : R)^'+ => e; near=> A; near=> n. -rewrite -lee_opp -muleN (@le_trans _ _ (f n * e%:E))//. +rewrite -leeN2 -muleN (@le_trans _ _ (f n * e%:E))//. by rewrite -lee_pdivr_mulr ?mulr_gt0 ?oppr_gt0//; near: n; apply: foo. rewrite lee_pmul ?lee_fin//. by rewrite (@le_trans _ _ 1) ?lee_fin//; near: n; apply: foo. @@ -3521,27 +3065,733 @@ Unshelve. all: end_near. Qed. End ecvg_realFieldType. +Section max_cts. +Context {R : realType} {T : topologicalType}. + +Lemma continuous_min (f g : T -> R^o) x : + {for x, continuous f} -> {for x, continuous g} -> + {for x, continuous (f \min g)}. +Proof. +move=> ctsf ctsg. +under [_ \min _]eq_fun => ? do rewrite minr_absE. +apply: cvgM; [|exact: cvg_cst]; apply:cvgD; first exact: cvgD. +by apply: cvgN; apply: cvg_norm; apply: cvgB. +Qed. + +Lemma continuous_max (f g : T -> R^o) x : + {for x, continuous f} -> {for x, continuous g} -> + {for x, continuous (f \max g)}. +Proof. +move=> ctsf ctsg. +under [_ \max _]eq_fun => ? do rewrite maxr_absE. +apply: cvgM; [|exact: cvg_cst]; apply:cvgD; first exact: cvgD. +by apply: cvg_norm; apply: cvgB. +Qed. + +End max_cts. + #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to cvgeN, and generalized to filter in Type")] -Notation ereal_cvgN := cvgeN. +Notation ereal_cvgN := cvgeN (only parsing). #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to is_cvgeN, and generalized to filter in Type")] -Notation ereal_is_cvgN := is_cvgeN. +Notation ereal_is_cvgN := is_cvgeN (only parsing). #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to cvgeMl, and generalized to filter in Type")] -Notation ereal_cvgrM := cvgeMl. +Notation ereal_cvgrM := cvgeMl (only parsing). #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to is_cvgeMl, and generalized to filter in Type")] -Notation ereal_is_cvgrM := is_cvgeMl. +Notation ereal_is_cvgrM := is_cvgeMl (only parsing). #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to cvgeMr, and generalized to filter in Type")] -Notation ereal_cvgMr := cvgeMr. +Notation ereal_cvgMr := cvgeMr (only parsing). #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to is_cvgeMr, and generalized to filter in Type")] -Notation ereal_is_cvgMr := is_cvgeMr. +Notation ereal_is_cvgMr := is_cvgeMr (only parsing). #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to cvgeM, and generalized to a realFieldType")] -Notation ereal_cvgM := cvgeM. +Notation ereal_cvgM := cvgeM (only parsing). + +Section pseudoMetricDist. +Context {R : realType} {X : pseudoMetricType R}. +Implicit Types r : R. + +Definition edist (xy : X * X) : \bar R := + ereal_inf (EFin @` [set r | 0 < r /\ ball xy.1 r xy.2]). + +Lemma edist_ge0 (xy : X * X) : (0 <= edist xy)%E. +Proof. +by apply: lb_ereal_inf => z [+ []] => _/posnumP[r] _ <-; rewrite lee_fin. +Qed. +Hint Resolve edist_ge0 : core. + +Lemma edist_neqNy (xy : X * X) : (edist xy != -oo)%E. +Proof. by rewrite -lteNye (@lt_le_trans _ _ 0%E). Qed. +Hint Resolve edist_neqNy : core. + +Lemma edist_lt_ball r (xy : X * X) : (edist xy < r%:E)%E -> ball xy.1 r xy.2. +Proof. +case/ereal_inf_lt => ? [+ []] => _/posnumP[eps] bxye <-; rewrite lte_fin. +by move/ltW/le_ball; exact. +Qed. + +Lemma edist_fin r (xy : X * X) : + 0 < r -> ball xy.1 r xy.2 -> (edist xy <= r%:E)%E. +Proof. +move: r => _/posnumP[r] => ?; rewrite -(ereal_inf1 r%:num%:E) le_ereal_inf //. +by move=> ? -> /=; exists r%:num; split. +Qed. + +Lemma edist_pinftyP (xy : X * X) : + (edist xy = +oo)%E <-> (forall r, 0 < r -> ~ ball xy.1 r xy.2). +Proof. +split. + move/ereal_inf_pinfty => xrb r rpos rb; move: (ltry r); rewrite ltey => /eqP. + by apply; apply: xrb; exists r. +rewrite /edist=> nrb; suff -> : [set r | 0 < r /\ ball xy.1 r xy.2] = set0. + by rewrite image_set0 ereal_inf0. +by rewrite -subset0 => r [?] rb; apply: nrb; last exact: rb. +Qed. + +Lemma edist_finP (xy : X * X) : + (edist xy \is a fin_num)%E <-> exists2 r, 0 < r & ball xy.1 r xy.2. +Proof. +rewrite ge0_fin_numE ?edist_ge0// ltey. +rewrite -(rwP (negPP eqP)); apply/iff_not2; rewrite notE. +apply: (iff_trans (edist_pinftyP _)); apply: (iff_trans _ (forall2NP _ _)). +by under eq_forall => ? do rewrite implyE. +Qed. + +Lemma edist_fin_open : open [set xy : X * X | edist xy \is a fin_num]. +Proof. +move=> z /= /edist_finP [] _/posnumP[r] bzr. +exists (ball z.1 r%:num, ball z.2 r%:num); first by split; exact: nbhsx_ballx. +case=> a b [bza bzb]; apply/edist_finP; exists (r%:num + r%:num + r%:num) => //. +exact/(ball_triangle _ bzb)/(ball_triangle _ bzr)/ball_sym. +Qed. + +Lemma edist_fin_closed : closed [set xy : X * X | edist xy \is a fin_num]. +Proof. +move=> z /= /(_ (ball z 1)) []; first exact: nbhsx_ballx. +move=> w [/edist_finP [] _/posnumP[r] babr [bz1w1 bz2w2]]; apply/edist_finP. +exists (1 + (r%:num + 1)) => //. +exact/(ball_triangle bz1w1)/(ball_triangle babr)/ball_sym. +Qed. + +Lemma edist_pinfty_open : open [set xy : X * X | edist xy = +oo]%E. +Proof. +rewrite -closedC; have := edist_fin_closed; congr (_ _). +by rewrite eqEsubset; split => z; rewrite /= ?ge0_fin_numE// ltey => /eqP. +Qed. + +Lemma edist_sym (x y : X) : edist (x, y) = edist (y, x). +Proof. by rewrite /edist /=; under eq_fun do rewrite ball_symE. Qed. + +Lemma edist_triangle (x y z : X) : + (edist (x, z) <= edist (x, y) + edist (y, z))%E. +Proof. +have [->|] := eqVneq (edist (x, y)) +oo%E; first by rewrite addye ?leey. +have [->|] := eqVneq (edist (y, z)) +oo%E; first by rewrite addey ?leey. +rewrite -?ltey -?ge0_fin_numE//. +move=> /edist_finP [_/posnumP[r2] /= yz] /edist_finP [_/posnumP[r1] /= xy]. +have [|] := eqVneq (edist (x, z)) +oo%E. + move/edist_pinftyP /(_ (r1%:num + r2%:num) _) => -[//|]. + exact: (ball_triangle xy). +rewrite -ltey -ge0_fin_numE// => /[dup] xzfin. +move/edist_finP => [_/posnumP[del] /= xz]. +rewrite /edist /= ?ereal_inf_EFin; first last. +- by exists (r1%:num + r2%:num); split => //; apply: (ball_triangle xy). +- by exists 0 => ? /= [/ltW]. +- by exists r1%:num; split. +- by exists 0 => ? /= [/ltW]. +- by exists r2%:num; split. +- by exists 0 => ? /= [/ltW]. +rewrite -EFinD lee_fin -inf_sumE //; first last. +- by split; [exists r2%:num; split| exists 0 => ? /= [/ltW]]. +- by split; [exists r1%:num; split| exists 0 => ? /= [/ltW]]. +apply: lb_le_inf. + by exists (r1%:num + r2%:num); exists r1%:num => //; exists r2%:num. +move=> ? [+ []] => _/posnumP[p] xpy [+ []] => _/posnumP[q] yqz <-. +apply: inf_lb; first by exists 0 => ? /= [/ltW]. +by split => //; apply: (ball_triangle xpy). +Qed. + +Lemma edist_continuous : continuous edist. +Proof. +move=> [x y]; have [pE U /= Upinf|] := eqVneq (edist (x, y)) +oo%E. + rewrite nbhs_simpl /=; apply (@filterS _ _ _ [set xy | edist xy = +oo]%E). + by move=> z /= ->; apply: nbhs_singleton; move: pE Upinf => ->. + by apply: open_nbhs_nbhs; split => //; exact: edist_pinfty_open. +rewrite -ltey -ge0_fin_numE// => efin. +rewrite /continuous_at -[edist (x, y)]fineK//; apply: cvg_EFin. + by have := edist_fin_open efin; apply: filter_app; near=> w. +apply/cvgrPdist_le => _/posnumP[eps]. +suff: \forall t \near (nbhs x, nbhs y), + `|fine (edist (x, y)) - fine (edist t)| <= eps%:num by []. +rewrite -near2_pair; near=> a b => /=. +have abxy : (edist (a, b) <= edist (x, a) + edist (x, y) + edist (y, b))%E. + rewrite (edist_sym x a) -addeA. + by rewrite (le_trans (@edist_triangle _ x _)) ?lee_add ?edist_triangle. +have xyab : (edist (x, y) <= edist (x, a) + edist (a, b) + edist (y, b))%E. + rewrite (edist_sym y b) -addeA. + by rewrite (le_trans (@edist_triangle _ a _))// ?lee_add// ?edist_triangle. +have xafin : edist (x, a) \is a fin_num. + by apply/edist_finP; exists 1 =>//; near: a; exact: nbhsx_ballx. +have ybfin : edist (y, b) \is a fin_num. + by apply/edist_finP; exists 1 =>//; near: b; exact: nbhsx_ballx. +have abfin : edist (a, b) \is a fin_num. + by rewrite ge0_fin_numE// (le_lt_trans abxy) ?lte_add_pinfty// -ge0_fin_numE. +have xyabfin: (edist (x, y) - edist (a, b))%E \is a fin_num + by rewrite fin_numB abfin efin. +rewrite -fineB// -fine_abse// -lee_fin fineK ?abse_fin_num//. +rewrite (@le_trans _ _ (edist (x, a) + edist (y, b))%E)//; last first. + by rewrite [eps%:num]splitr/= EFinD lee_add//; apply: edist_fin => //=; + [near: a | near: b]; exact: nbhsx_ballx. +have [ab_le_xy|/ltW xy_le_ab] := leP (edist (a, b)) (edist (x, y)). + by rewrite gee0_abs ?subre_ge0// lee_subl_addr// addeAC. +rewrite lee0_abs ?sube_le0// oppeB ?fin_num_adde_defr//. +by rewrite addeC lee_subl_addr// addeAC. +Unshelve. all: end_near. Qed. + +Lemma edist_closeP x y : close x y <-> edist (x, y) = 0%E. +Proof. +rewrite ball_close; split=> [bxy|edist0 eps]; first last. + by apply: (@edist_lt_ball _ (x, y)); rewrite edist0. +case: ltgtP (edist_ge0 (x, y)) => // dpos _. +have xxfin : edist (x, y) \is a fin_num. + by rewrite ge0_fin_numE// (@le_lt_trans _ _ 1%:E) ?ltey// edist_fin. +have dpose : fine (edist (x, y)) > 0 by rewrite -lte_fin fineK. +pose eps := PosNum dpose. +have : (edist (x, y) <= (eps%:num / 2)%:E)%E. + apply: ereal_inf_lb; exists (eps%:num / 2) => //; split => //. + exact: (bxy (eps%:num / 2)%:pos). +apply: contra_leP => _. +by rewrite /= EFinM fineK// lte_pdivr_mulr// lte_pmulr// lte1n. +Qed. + +Lemma edist_refl x : edist (x, x) = 0%E. Proof. exact/edist_closeP. Qed. + +Lemma edist_closel x y z : close x y -> edist (x, z) = edist (y, z). +Proof. +move=> /edist_closeP xy0; apply: le_anti; apply/andP; split. + by rewrite -[edist (y, z)]add0e -xy0 edist_triangle. +by rewrite -[edist (x, z)]add0e -xy0 [edist (x, y)]edist_sym edist_triangle. +Qed. + +End pseudoMetricDist. +#[global] +Hint Extern 0 (is_true (0%R <= edist _)%E) => solve [apply: edist_ge0] : core. +#[global] +Hint Extern 0 (is_true (edist _ != -oo%E)) => solve [apply: edist_neqNy] : core. + +Section edist_inf. +Context {R : realType} {T : pseudoMetricType R} (A : set T). + +Definition edist_inf z := ereal_inf [set edist (z, a) | a in A]. + +Lemma edist_inf_ge0 w : (0 <= edist_inf w)%E. +Proof. by apply: lb_ereal_inf => ? /= [? ? <-]. Qed. +Hint Resolve edist_inf_ge0 : core. + +Lemma edist_inf_neqNy w : (edist_inf w != -oo)%E. +Proof. by rewrite -lteNye (@lt_le_trans _ _ 0%E). Qed. +Hint Resolve edist_inf_neqNy : core. + +Lemma edist_inf_triangle x y : (edist_inf x <= edist (x, y) + edist_inf y)%E. +Proof. +have [A0|/set0P[a0 Aa0]] := eqVneq A set0. + by rewrite /edist_inf A0 ?image_set0 ?ereal_inf0 addey. +have [fyn|] := boolP (edist_inf y \is a fin_num); first last. + by rewrite ge0_fin_numE// ?ltey negbK => /eqP->; rewrite addey ?leey. +have [xyfin|] := boolP (edist (x, y) \is a fin_num); first last. + by rewrite ge0_fin_numE// ?ltey // negbK => /eqP->; rewrite addye ?leey. +apply/lee_addgt0Pr => _/posnumP[eps]. +have [//|? [a Aa <-] yaeps] := @lb_ereal_inf_adherent R _ eps%:num _ fyn. +apply: le_trans; first by apply: (@ereal_inf_lb _ _ (edist (x, a))); exists a. +apply: le_trans; first exact: (@edist_triangle _ _ _ y). +by rewrite -addeA lee_add2lE // ltW. +Qed. + +Lemma edist_inf_continuous : continuous edist_inf. +Proof. +move=> z; have [A0|/= /set0P[a0 Aa0]] := eqVneq A set0. + rewrite /edist_inf A0. + under eq_fun do rewrite image_set0 ereal_inf0. + exact: cvg_cst. +have [] := eqVneq (edist_inf z) +oo%E. + move=> /[dup] fzp /ereal_inf_pinfty => zAp U /= Ufz. + have : nbhs z (ball z 1) by exact: nbhsx_ballx. + apply: filter_app; near_simpl; near=> w => bz1w. + suff /= -> : (edist_inf w) = +oo%E by apply: nbhs_singleton; rewrite -fzp. + apply/ereal_inf_pinfty => r [a Aa] war; apply/zAp; exists a => //. + have /gee0P[|[r' r'pos war']] := edist_ge0 (w, a). + by rewrite war => ->; apply: zAp; exists a. + have := @edist_triangle _ _ z w a; rewrite war'; apply: contra_leP => _. + rewrite (@le_lt_trans _ _ (1 + r'%:E)%E) ?lee_add2r ?edist_fin//. + by rewrite -EFinD [edist (z, a)]zAp ?ltey //; exists a. +rewrite -ltey -ge0_fin_numE ?edist_inf_ge0 // => fz_fin. +rewrite /continuous_at -[edist_inf z]fineK //; apply/fine_cvgP. +have fwfin : \forall w \near z, edist_inf w \is a fin_num. + (have : nbhs z (ball z 1) by exact: nbhsx_ballx); apply: filter_app. + near=> t => bz1; rewrite ge0_fin_numE ?edist_inf_ge0 //. + rewrite (le_lt_trans (edist_inf_triangle _ z))//. + rewrite -ge0_fin_numE ?adde_ge0 ?edist_inf_ge0 //. + rewrite fin_numD fz_fin andbT; apply/edist_finP; exists 1 => //. + exact/ball_sym. +split => //; apply/cvgrPdist_le => _/posnumP[eps]. +have : nbhs z (ball z eps%:num) by exact: nbhsx_ballx. +apply: filter_app; near_simpl; move: fwfin; apply: filter_app. +near=> t => tfin /= /[dup] ?. +have ztfin : edist (z, t) \is a fin_num by apply/edist_finP; exists eps%:num. +move=> /(@edist_fin _ _ _ (z, t)) - /(_ trivial). +rewrite -[edist (z, t)]fineK ?lee_fin //; apply: le_trans. +rewrite ler_norml; apply/andP; split. + rewrite lerBrDr addrC lerBlDr addrC -fineD //. + rewrite -lee_fin ?fineK // ?fin_numD ?ztfin ?fz_fin // edist_sym. + exact: edist_inf_triangle. +rewrite lerBlDr -fineD // -lee_fin ?fineK // ?fin_numD ?tfin ?ztfin //. +exact: edist_inf_triangle. +Unshelve. all: by end_near. Qed. + +Lemma edist_inf0 a : A a -> edist_inf a = 0%E. +Proof. +move=> Aa; apply: le_anti; apply/andP; split; last exact: edist_inf_ge0. +by apply: ereal_inf_lb; exists a => //; exact: edist_refl. +Qed. + +End edist_inf. +#[global] +Hint Extern 0 (is_true (0 <= edist_inf _ _)%E) => + solve [apply: edist_inf_ge0] : core. +#[global] +Hint Extern 0 (is_true (edist_inf _ _ != -oo%E)) => + solve [apply: edist_inf_neqNy] : core. + +Section urysohn_separator. +Context {T : uniformType} {R : realType}. +Context (A B : set T) (E : set (T * T)). +Hypothesis entE : entourage E. +Hypothesis AB0 : A `*` B `&` E = set0. + +Local Notation T' := [the pseudoMetricType R of gauge.type entE]. + +Local Lemma urysohn_separation : exists (f : T -> R), + [/\ continuous f, range f `<=` `[0, 1], + f @` A `<=` [set 0] & f @` B `<=` [set 1] ]. +Proof. +have [eps exy] : exists (eps : {posnum R}), + forall (x y : T'), A x -> B y -> ~ ball x eps%:num y. + have : @entourage T' E by exists O => /=. + rewrite -entourage_ballE; case=> _/posnumP[eps] epsdiv; exists eps. + move=> x y Ax By bxy; have divxy := epsdiv (x, y) bxy. + by have : set0 (x, y) by rewrite -AB0; split. +have [->|/set0P[a A0]] := eqVneq A set0. + exists (fun=> 1); split; first by move => ?; exact: cvg_cst. + - by move=> ? [? _ <-]; rewrite /= in_itv /=; apply/andP; split => //. + - by rewrite image_set0. + - by move=> ? [? ? <-]. +have dfin x : @edist_inf R T' A x \is a fin_num. + rewrite ge0_fin_numE ?edist_inf_ge0 //; apply: le_lt_trans. + by apply: ereal_inf_lb; exists a. + rewrite -ge0_fin_numE ?edist_ge0 //; apply/edist_finP => /=; exists 2 => //. + exact: countable_uniform.countable_uniform_bounded. +pose f' := (fun z => fine (@edist_inf R T' A z)) \min (fun=> eps%:num). +pose f z := (f' z)/eps%:num; exists f; split. +- move=> x; rewrite /f; apply: (@cvgM R T (nbhs x)); last exact: cvg_cst. + suff : {for x, continuous (f' : T' -> R)}. + move=> Q U; rewrite nbhs_simpl /= => f'U. + have [J /(gauge.gauge_ent entE) entJ/filterS] := Q _ f'U; apply. + by rewrite nbhs_simpl /= -nbhs_entourageE /=; exists J. + apply: continuous_min; last by apply: cvg_cst; exact: nbhs_filter. + apply: fine_cvg; first exact: nbhs_filter. + rewrite fineK //; first exact: edist_inf_continuous. +- move=> _ [x _ <-]; rewrite set_itvE /=; apply/andP; split. + by rewrite /f divr_ge0 // /f' /= le_minr fine_ge0//= edist_inf_ge0. + by rewrite /f ler_pdivrMr // mul1r /f' /= /minr; case: ltP => // /ltW. +- by move=> ? [z Az] <-; rewrite /f/f' /= edist_inf0 // /minr fine0 ifT ?mul0r. +- move=> ? [b Bb] <-; rewrite /f /f'/= /minr/=. + case: ltP => //; rewrite ?divrr // ?unitf_gt0 // -lte_fin fineK//. + move => /ereal_inf_lt [_ [z Az <-]] ebz; have [] := exy _ _ Az Bb. + exact/ball_sym/(@edist_lt_ball R T' _ (b, z)). +Qed. + +End urysohn_separator. + +Section topological_urysohn_separator. +Context {T : topologicalType} {R : realType}. + +Definition uniform_separator (A B : set T) := + exists (uT : @Uniform.axioms_ T^o) (E : set (T * T)), + let UT := Uniform.Pack uT in [/\ + @entourage UT E, A `*` B `&` E = set0 & + (forall x, @nbhs UT UT x `<=` @nbhs T T x)]. + +Local Lemma Urysohn' (A B : set T) : exists (f : T -> R), + [/\ continuous f, + range f `<=` `[0, 1] + & uniform_separator A B -> + f @` A `<=` [set 0] /\ f @` B `<=` [set 1]]. +Proof. +have [[? [E [entE ABE0 coarseT]]]|nP] := pselect (uniform_separator A B). + have [f] := @urysohn_separation _ R _ _ _ entE ABE0. + by case=> ctsf ? ? ?; exists f; split => // ? ? /= ?; apply/coarseT/ctsf. +exists (fun=>1); split => //; first by move=> ?; exact: cvg_cst. +by move=> ? [? _ <-]; rewrite /= in_itv /=; apply/andP; split => //. +Qed. + +Definition Urysohn (A B : set T) : T -> R := projT1 (cid (Urysohn' A B)). + +Section urysohn_facts. + +Lemma Urysohn_continuous (A B : set T) : continuous (Urysohn A B). +Proof. by have [] := projT2 (cid (@Urysohn' A B)). Qed. + +Lemma Urysohn_range (A B : set T) : range (Urysohn A B) `<=` `[0, 1]. +Proof. by have [] := projT2 (cid (@Urysohn' A B)). Qed. + +Lemma Urysohn_sub0 (A B : set T) : + uniform_separator A B -> Urysohn A B @` A `<=` [set 0]. +Proof. by move=> eE; have [_ _ /(_ eE)[]] := projT2 (cid (@Urysohn' A B)). Qed. + +Lemma Urysohn_sub1 (A B : set T) : + uniform_separator A B -> Urysohn A B @` B `<=` [set 1]. +Proof. by move=> eE; have [_ _ /(_ eE)[]] := projT2 (cid (@Urysohn' A B)). Qed. + +Lemma Urysohn_eq0 (A B : set T) : + uniform_separator A B -> A !=set0 -> Urysohn A B @` A = [set 0]. +Proof. +move=> eE Aa; have [_ _ /(_ eE)[As0 _]] := projT2 (cid (@Urysohn' A B)). +rewrite eqEsubset; split => // ? ->; case: Aa => a ?; exists a => //. +by apply: As0; exists a. +Qed. + +Lemma Urysohn_eq1 (A B : set T) : + uniform_separator A B -> (B !=set0) -> (Urysohn A B) @` B = [set 1]. +Proof. +move=> eE Bb; have [_ _ /(_ eE)[_ Bs0]] := projT2 (cid (@Urysohn' A B)). +rewrite eqEsubset; split => // ? ->; case: Bb => b ?; exists b => //. +by apply: Bs0; exists b. +Qed. + +End urysohn_facts. +End topological_urysohn_separator. + +Lemma uniform_separatorW {T : uniformType} (A B : set T) : + (exists2 E, entourage E & A `*` B `&` E = set0) -> + uniform_separator A B. +Proof. by case=> E entE AB0; exists (Uniform.class T), E; split => // ?. Qed. + +Section Urysohn. +Context {T : topologicalType} . +Hypothesis normalT : normal_space T. +Section normal_uniform_separators. +Context (A : set T). + +Local Notation "A ^-1" := [set xy | A (xy.2, xy.1)] : classical_set_scope. + +Local Notation "'to_set' A x" := [set y | A (x, y)] + (at level 0, A at level 0) : classical_set_scope. + +(* Urysohn's lemma guarantees a continuous function : T -> R + where "f @` A = [set 0]" and "f @` B = [set 1]". + The idea is to leverage countable_uniformity to build that function + rather than construct it directly. + + The bulk of the work is building a uniformity to measure "distance from A". + Each pair of "nested" U,V induces an approxmiantion "apxU". + A-------)] U + A----------------) V (points near A) + (------------ ~`closure U (points far from A) + These make the sub-basis for a filter. That filter is a uniformity + because normality lets us split + + A------)] U + A-----------)] V' + (--------------- ~`closure U + A----------------) V + (--------- ~` closure V' + and (U,V') + (V', V) splits the entourage of (U,V). This uniform space is not + neccesarily a pseudometric. So we find an entourage which divides A and B, + then the gauge pseudometric gives us what we want. +*) + +Let apxU (UV : set T * set T) : set (T * T) := + (UV.2 `*` UV.2) `|` (~` closure UV.1 `*` ~` closure UV.1). + +Let nested (UV : set T * set T) := + [/\ open UV.1, open UV.2, A `<=` UV.1 & closure UV.1 `<=`UV.2]. + +Let ury_base := [set apxU UV | UV in nested]. + +Local Lemma ury_base_refl E : + ury_base E -> [set fg | fg.1 = fg.2] `<=` E. +Proof. +case; case=> L R [_ _ _ /= LR] <- [? x /= ->]. +case: (pselect (R x)); first by left. +by move/subsetC: LR => /[apply] => ?; right. +Qed. + +Local Lemma ury_base_inv E : ury_base E -> ury_base (E^-1)%classic. +Proof. +case; case=> L R ? <-; exists (L, R) => //. +by rewrite eqEsubset; split => //; (case=> x y [] [? ?]; [left| right]). +Qed. + +Local Lemma ury_base_split E : ury_base E -> + exists E1 E2, [/\ ury_base E1, ury_base E2 & + (E1 `&` E2) \; (E1 `&` E2) `<=` E]. +Proof. +case; case => L R [/= oL oR AL cLR <-]. +have [R' []] : exists R', [/\ open R', closure L `<=` R' & closure R' `<=` R]. + have := @normalT (closure L) (@closed_closure T L). + case/(_ R); first by move=> x /cLR ?; apply: open_nbhs_nbhs. + move=> V /set_nbhsP [U] [? ? ? cVR]; exists U; split => //. + by apply: (subset_trans _ cVR); exact: closure_subset. +move=> oR' cLR' cR'R; exists (apxU (L, R')), (apxU (R', R)). +split; first by exists (L, R'). + exists (R', R) => //; split => //; apply: (subset_trans AL). + by apply: (subset_trans _ cLR'); exact: subset_closure. +case=> x z /= [y [+ +] []]. +(do 4 (case; case=> /= ? ?)); try (by left); try (by right); + match goal with nG : (~ closure ?S ?y), G : ?S ?y |- _ => + by move/subset_closure: G + end. +Qed. + +Let ury_unif := smallest Filter ury_base. + +Instance ury_unif_filter : Filter ury_unif. +Proof. exact: smallest_filter_filter. Qed. + +Local Lemma ury_unif_refl E : ury_unif E -> [set fg | fg.1 = fg.2] `<=` E. +Proof. +move/(_ (globally [set fg | fg.1 = fg.2])); apply; split. + exact: globally_filter. +exact: ury_base_refl. +Qed. + +Local Lemma set_prod_invK (K : set (T * T)) : (K^-1^-1)%classic = K. +Proof. by rewrite eqEsubset; split; case. Qed. + +Local Lemma ury_unif_inv E : ury_unif E -> ury_unif (E^-1)%classic. +Proof. +move=> ufE F [/filter_inv FF urF]; have [] := ufE [set (V^-1)%classic | V in F]. + split => // K /ury_base_inv/urF /= ?; exists (K^-1)%classic => //. + by rewrite set_prod_invK. +by move=> R FR <-; rewrite set_prod_invK. +Qed. + +Local Lemma ury_unif_split_iter E n : + filterI_iter ury_base n E -> exists2 K : set (T * T), + filterI_iter ury_base n.+1 K & K\;K `<=` E. +Proof. +elim: n E; first move=> E []. +- move=> ->; exists setT => //; exists setT; first by left. + by exists setT; rewrite ?setIT; first by left. +- move=> /[dup] /ury_base_split [E1 [E2] [? ? ? ?]]; exists (E1 `&` E2) => //. + by (exists E1; first by right); exists E2; first by right. +move=> n IH E /= [E1 /IH [F1 F1n1 F1E1]] [E2 /IH [F2 F2n1 F2E2]] E12E. +exists (F1 `&` F2); first by exists F1 => //; exists F2. +move=> /= [x z ] [y /= [K1xy K2xy] [K1yz K2yz]]; rewrite -E12E; split. + by apply: F1E1; exists y. +by apply: F2E2; exists y. +Qed. + +Local Lemma ury_unif_split E : ury_unif E -> + exists2 K, ury_unif K & K \; K `<=` E. +Proof. +rewrite /ury_unif filterI_iterE; case=> G [n _] /ury_unif_split_iter []. +move=> K SnK KG GE; exists K; first by exists K => //; exists n.+1. +exact: (subset_trans _ GE). +Qed. + +Local Lemma ury_unif_covA E : ury_unif E -> A `*` A `<=` E. +Proof. +rewrite /ury_unif filterI_iterE; case=> G [n _] sG /(subset_trans _); apply. +elim: n G sG. + move=> g [-> //| [[P Q]]] [/= _ _ AP cPQ <-] [x y] [/= /AP ? ?]. + by left; split => //=; apply/cPQ/subset_closure => //; exact: AP. +by move=> n IH G [R] /IH AAR [M] /IH AAM <- z; split; [exact: AAR | exact: AAM]. +Qed. + +Definition urysohnType : Type := T. + +HB.instance Definition _ := Pointed.on urysohnType. + +HB.instance Definition _ := + isUniform.Build urysohnType ury_unif_filter ury_unif_refl ury_unif_inv + ury_unif_split. + +Lemma normal_uniform_separator (B : set T) : + closed A -> closed B -> A `&` B = set0 -> uniform_separator A B. +Proof. +move=> clA clB AB0; have /(_ (~`B))[x Ax|] := normalT clA. + apply: open_nbhs_nbhs; split => //. + - exact/closed_openC. + - by move: x Ax; apply/ disjoints_subset. +move=> V /set_nbhsP [U [oU AU UV]] cVcb. +exists (Uniform.class urysohnType), (apxU (U, ~` B)); split => //. +- move=> ?; apply:sub_gen_smallest; exists (U, ~`B) => //; split => //=. + exact/closed_openC. + by move: UV => /closure_subset/subset_trans; apply. +- rewrite eqEsubset; split; case=> // a b [/=[Aa Bb] [[//]|]]. + by have /subset_closure ? := AU _ Aa; case. +move=> x ? [E gE] /(@filterS T); apply; move: gE. +rewrite /= /ury_unif filterI_iterE; case => K /= [i _] /= uiK KE. +suff : @nbhs T T x to_set K (x) by apply: filterS => y /KE. +elim: i K uiK {E KE}; last by move=> ? H ? [N] /H ? [M] /H ? <-; apply: filterI. +move=> K [->|]; first exact: filterT. +move=> [[/= P Q] [/= oP oQ AP cPQ <-]]; rewrite /apxU /=. +set M := [set y | _ \/ _]. +have [Qx|nQx] := pselect (Q x); first last. + suff -> : M = ~` closure P. + apply: open_nbhs_nbhs; split; first exact/closed_openC/closed_closure. + by move/cPQ. + rewrite eqEsubset /M; split => z; first by do 2!case. + by move=> ?; right; split => // /cPQ. +have [nPx|cPx] := pselect (closure P x). + suff -> : M = Q by apply: open_nbhs_nbhs; split. + rewrite eqEsubset /M; split => z; first by do 2!case. + by move=> ?; left; split. +suff -> : M = setT by exact: filterT. +rewrite eqEsubset; split => // z _. +by have [Qz|/(subsetC cPQ)] := pselect (Q z); constructor. +Qed. + +End normal_uniform_separators. +End Urysohn. +Lemma uniform_separatorP {T : topologicalType} {R : realType} (A B : set T) : + uniform_separator A B <-> + exists (f : T -> R), [/\ continuous f, range f `<=` `[0, 1], + f @` A `<=` [set 0] & f @` B `<=` [set 1]]. +Proof. +split; first do [move=> ?; exists (Urysohn A B); split]. +- exact: Urysohn_continuous. +- exact: Urysohn_range. +- exact: Urysohn_sub0. +- exact: Urysohn_sub1. +case=> f [ctsf f01 fA0 fB1]. +pose T' := weak_topology f. +exists (Uniform.class T'), ([set xy | ball (f xy.1) 1 (f xy.2)]); split. +- exists [set xy | ball xy.1 1 xy.2]; last by case. + by rewrite -entourage_ballE; exists 1 => //=. +- rewrite -subset0 => -[a b [[/= Aa Bb]]]. + by rewrite (imsub1 fA0)// (imsub1 fB1)// /ball/= sub0r normrN normr1 ltxx. +- move=> x U [V [[W oW <- /=]]] ? /filterS; apply; apply: ctsf. + exact: open_nbhs_nbhs. +Qed. + +Section normalP. +Context {T : topologicalType}. + +Let normal_spaceP : [<-> + (* 0 *) normal_space T; + (* 1 *) forall (A B : set T), closed A -> closed B -> A `&` B = set0 -> + uniform_separator A B; + (* 2 *) forall (A B : set T), closed A -> closed B -> A `&` B = set0 -> + exists U V, [/\ open U, open V, A `<=` U, B `<=` V & U `&` V = set0] ]. +Proof. +pose R := Rdefinitions.R. +tfae; first by move=> ?; exact: normal_uniform_separator. +- move=> + A B clA clB AB0 => /(_ _ _ clA clB AB0) /(@uniform_separatorP _ R). + case=> f [cf f01 /imsub1P/subset_trans fa0 /imsub1P/subset_trans fb1]. + exists (f@^-1` `]-1, 1/2[), (f @^-1` `]1/2, 2[); split. + + by apply: open_comp; [|exact: interval_open]. + + by apply: open_comp; [|exact: interval_open]. + + by apply: fa0 => x/= ->; rewrite (@in_itv _ R)/=; apply/andP; split. + + apply: fb1 => x/= ->; rewrite (@in_itv _ R)/= ltr_pdivrMr// mul1r. + by rewrite ltr1n. + + rewrite -preimage_setI ?set_itvoo -subset0 => t [] /andP [_ +] /andP [+ _]. + by move=> /lt_trans /[apply]; rewrite ltxx. +move=> + A clA B /set_nbhsP [C [oC AC CB]]. +have AC0 : A `&` ~` C = set0 by apply/disjoints_subset; rewrite setCK. +case/(_ _ _ clA (open_closedC oC) AC0) => U [V] [oU oV AU nCV UV0]. +exists (~` closure V). + apply/set_nbhsP; exists U; split => //. + apply/subsetCr; have := open_closedC oU; rewrite closure_id => ->. + by apply/closure_subset/disjoints_subset; rewrite setIC. +apply/(subset_trans _ CB)/subsetCP; apply: (subset_trans nCV). +apply/subsetCr; have := open_closedC oV; rewrite closure_id => ->. +exact/closure_subset/subsetC/subset_closure. +Qed. + +Lemma normal_openP : normal_space T <-> + forall (A B : set T), closed A -> closed B -> A `&` B = set0 -> + exists U V, [/\ open U, open V, A `<=` U, B `<=` V & U `&` V = set0]. +Proof. exact: (normal_spaceP 0%N 2%N). Qed. + +Lemma normal_separatorP : normal_space T <-> + forall (A B : set T), closed A -> closed B -> A `&` B = set0 -> + uniform_separator A B. +Proof. exact: (normal_spaceP 0%N 1%N). Qed. + +End normalP. + +Section pseudometric_normal. + +Lemma uniform_regular {X : uniformType} : @regular_space X. +Proof. +move=> x A; rewrite /= -nbhs_entourageE => -[E entE]. +move/(subset_trans (ent_closure entE)) => ExA. +by exists [set y | split_ent E (x, y)]; first by exists (split_ent E). +Qed. + +Lemma regular_openP {T : topologicalType} (x : T) : + {for x, @regular_space T} <-> forall A, closed A -> ~ A x -> + exists U V : set T, [/\ open U, open V, U x, A `<=` V & U `&` V = set0]. +Proof. +split. + move=> + A clA nAx => /(_ (~` A)) []. + by apply: open_nbhs_nbhs; split => //; exact: closed_openC. + move=> U Ux /subsetC; rewrite setCK => AclU; exists (interior U). + exists (~` closure U) ; split => //; first exact: open_interior. + exact/closed_openC/closed_closure. + apply/disjoints_subset; rewrite setCK. + exact: (subset_trans (@interior_subset _ _) (@subset_closure _ _)). +move=> + A Ax => /(_ (~` interior A)) []; [|exact|]. + exact/open_closedC/open_interior. +move=> U [V] [oU oV Ux /subsetC cAV /disjoints_subset UV]; exists U. + exact/open_nbhs_nbhs. +apply: (subset_trans (closure_subset UV)). +move/open_closedC/closure_id : oV => <-. +by apply: (subset_trans cAV); rewrite setCK; exact: interior_subset. +Qed. + +Lemma pseudometric_normal {R : realType} {X : pseudoMetricType R} : + normal_space X. +Proof. +apply/normal_openP => A B clA clB AB0. +have eps' (D : set X) : closed D -> forall x, exists eps : {posnum R}, ~ D x -> + ball x eps%:num `&` D = set0. + move=> clD x; have [nDx|?] := pselect (~ D x); last by exists 1%:pos. + have /regular_openP/(_ _ clD) [//|] := @uniform_regular X x. + move=> U [V] [+ oV] Ux /subsetC BV /disjoints_subset UV0. + rewrite openE /interior => /(_ _ Ux); rewrite -nbhs_ballE => -[]. + move => _/posnumP[eps] beU; exists eps => _; apply/disjoints_subset. + exact: (subset_trans beU (subset_trans UV0 _)). +pose epsA x := projT1 (cid (eps' _ clB x)). +pose epsB x := projT1 (cid (eps' _ clA x)). +exists (\bigcup_(x in A) interior (ball x ((epsA x)%:num / 2)%:pos%:num)). +exists (\bigcup_(x in B) interior (ball x ((epsB x)%:num / 2)%:pos%:num)). +split. +- by apply: bigcup_open => ? ?; exact: open_interior. +- by apply: bigcup_open => ? ?; exact: open_interior. +- by move=> x ?; exists x => //; exact: nbhsx_ballx. +- by move=> y ?; exists y => //; exact: nbhsx_ballx. +- apply/eqP/negPn/negP/set0P => -[z [[x Ax /interior_subset Axe]]]. + case=> y By /interior_subset Bye; have nAy : ~ A y. + by move: AB0; rewrite setIC => /disjoints_subset; exact. + have nBx : ~ B x by move/disjoints_subset: AB0; exact. + have [|/ltW] := leP ((epsA x)%:num / 2) ((epsB y)%:num / 2). + move/ball_sym: Axe => /[swap] /le_ball /[apply] /(ball_triangle Bye). + rewrite -splitr => byx; have := projT2 (cid (eps' _ clA y)) nAy. + by rewrite -subset0; apply; split; [exact: byx|]. + move/ball_sym: Bye =>/[swap] /le_ball /[apply] /(ball_triangle Axe). + rewrite -splitr => byx; have := projT2 (cid (eps' _ clB x)) nBx. + by rewrite -subset0; apply; split; [exact: byx|]. +Qed. + +End pseudometric_normal. Section open_closed_sets_ereal. Variable R : realFieldType (* TODO: generalize to numFieldType? *). @@ -3587,31 +3837,32 @@ Qed. Lemma open_ereal_lt_ereal x : open [set y | y < x]. Proof. -have openr r : open [set x | x < r%:E]. - case => [? | // | ?]; [rewrite /= lte_fin => xy | by exists r]. +have openr r : open [set x : \bar R | x < r%:E]. + (* BUG: why doesn't case work? *) + move=> [? | // | ?]; [rewrite /= lte_fin => xy | by exists r]. by move: (@open_ereal_lt r%:E); rewrite openE; apply; rewrite /= lte_fin. -case: x => [ // | | [] // ]. +move: x => [ // | | ]; last by move=> []. (* same BUG *) suff -> : [set y | y < +oo] = \bigcup_r [set y : \bar R | y < r%:E]. exact: bigcup_open. rewrite predeqE => -[r | | ]/=. - rewrite ltry; split => // _. - by exists (r + 1)%R => //=; rewrite lte_fin ltr_addl. + by exists (r + 1)%R => //=; rewrite lte_fin ltrDl. - by rewrite ltxx; split => // -[] x /=; rewrite ltNge leey. -- by split => // _; exists 0%R => //=. +- by split => // _; exists 0%R => //=; rewrite ltNye. Qed. Lemma open_ereal_gt_ereal x : open [set y | x < y]. Proof. have openr r : open [set x | r%:E < x]. - case => [? | ? | //]; [rewrite /= lte_fin => xy | by exists r]. + move=> [? | ? | //]; [rewrite /= lte_fin => xy | by exists r]. by move: (@open_ereal_gt r%:E); rewrite openE; apply; rewrite /= lte_fin. -case: x => [ // | [] // | ]. +case: x => [ // | | ]; first by move=> []. suff -> : [set y | -oo < y] = \bigcup_r [set y : \bar R | r%:E < y]. exact: bigcup_open. rewrite predeqE => -[r | | ]/=. - rewrite ltNyr; split => // _. - by exists (r - 1)%R => //=; rewrite lte_fin ltr_subl_addr ltr_addl. -- by split => // _; exists 0%R => //=. + by exists (r - 1)%R => //=; rewrite lte_fin ltrBlDr ltrDl. +- by split => // _; exists 0%R => //=; rewrite ltey. - by rewrite ltxx; split => // -[] x _ /=; rewrite ltNge leNye. Qed. @@ -3642,7 +3893,7 @@ rewrite eqEsubset; split. move=> v; rewrite /mkset le_eqVlt => /predU1P[<-{v}|]; last first. by move=> ?; exact: subset_closure. move=> B [e /= e0 zB]; near (0 : R)^'+ => d. -exists (z + d); split; rewrite /= ?ltr_addl//; apply: zB => /=. +exists (z + d); split; rewrite /= ?ltrDl//; apply: zB => /=. by rewrite opprD addNKr normrN gtr0_norm//. Unshelve. all: by end_near. Qed. @@ -3653,7 +3904,7 @@ rewrite eqEsubset; split. move=> v; rewrite /mkset le_eqVlt => /predU1P[<-{z}|]; last first. by move=> ?; exact: subset_closure. move=> B [e /= e0 vB]; near (0 : R)^'+ => d. -exists (v - d); split; rewrite /= ?gtr_addl ?oppr_lt0//; apply: vB => /=. +exists (v - d); split; rewrite /= ?gtrDl ?oppr_lt0//; apply: vB => /=. by rewrite opprB addrC addrNK gtr0_norm//; near: d. Unshelve. all: by end_near. Qed. @@ -3661,131 +3912,13 @@ End closure_left_right_open. (** ** Complete Normed Modules *) -Module CompleteNormedModule. - -Section ClassDef. +#[short(type="completeNormedModType")] +HB.structure Definition CompleteNormedModule (K : numFieldType) := + {T of NormedModule K T & Complete T}. -Variable K : numFieldType. +(** The topology on real numbers *) -Record class_of (T : Type) := Class { - base : NormedModule.class_of K T ; - mixin : Complete.axiom (PseudoMetric.Pack base) -}. -Local Coercion base : class_of >-> NormedModule.class_of. -Definition base2 T (cT : class_of T) : CompletePseudoMetric.class_of K T := - @CompletePseudoMetric.Class _ _ (@base T cT) (@mixin T cT). -Local Coercion base2 : class_of >-> CompletePseudoMetric.class_of. - -Structure type (phK : phant K) := Pack { sort; _ : class_of sort }. -Local Coercion sort : type >-> Sortclass. - -Variables (phK : phant K) (cT : type phK) (T : Type). - -Definition class := let: Pack _ c := cT return class_of cT in c. - -Definition pack := - fun bT (b : NormedModule.class_of K T) & phant_id (@NormedModule.class K phK bT) b => - fun mT m & phant_id (@Complete.class mT) (@Complete.Class T b m) => - Pack phK (@Class T b m). -Let xT := let: Pack T _ := cT in T. -Notation xclass := (class : class_of xT). - -Definition eqType := @Equality.Pack cT xclass. -Definition choiceType := @Choice.Pack cT xclass. -Definition zmodType := @GRing.Zmodule.Pack cT xclass. -Definition normedZmodType := @Num.NormedZmodule.Pack K phK cT xclass. -Definition lmodType := @GRing.Lmodule.Pack K phK cT xclass. -Definition pointedType := @Pointed.Pack cT xclass. -Definition filteredType := @Filtered.Pack cT cT xclass. -Definition topologicalType := @Topological.Pack cT xclass. -Definition uniformType := @Uniform.Pack cT xclass. -Definition pseudoMetricType := @PseudoMetric.Pack K cT xclass. -Definition pseudoMetricNormedZmodType := - @PseudoMetricNormedZmodule.Pack K phK cT xclass. -Definition normedModType := @NormedModule.Pack K phK cT xclass. -Definition completeType := @Complete.Pack cT xclass. -Definition completePseudoMetricType := @CompletePseudoMetric.Pack K cT xclass. -Definition complete_zmodType := @GRing.Zmodule.Pack completeType xclass. -Definition complete_lmodType := @GRing.Lmodule.Pack K phK completeType xclass. -Definition complete_normedZmodType := @Num.NormedZmodule.Pack K phK completeType xclass. -Definition complete_pseudoMetricNormedZmodType := - @PseudoMetricNormedZmodule.Pack K phK completeType xclass. -Definition complete_normedModType := @NormedModule.Pack K phK completeType xclass. -Definition completePseudoMetric_lmodType : GRing.Lmodule.type phK := - @GRing.Lmodule.Pack K phK (CompletePseudoMetric.sort completePseudoMetricType) - xclass. -Definition completePseudoMetric_zmodType : GRing.Zmodule.type := - @GRing.Zmodule.Pack (CompletePseudoMetric.sort completePseudoMetricType) - xclass. -Definition completePseudoMetric_normedModType : NormedModule.type phK := - @NormedModule.Pack K phK (CompletePseudoMetric.sort completePseudoMetricType) - xclass. -Definition completePseudoMetric_normedZmodType : Num.NormedZmodule.type phK := - @Num.NormedZmodule.Pack K phK - (CompletePseudoMetric.sort completePseudoMetricType) xclass. -Definition completePseudoMetric_pseudoMetricNormedZmodType : - PseudoMetricNormedZmodule.type phK := - @PseudoMetricNormedZmodule.Pack K phK - (CompletePseudoMetric.sort completePseudoMetricType) xclass. -End ClassDef. - -Module Exports. - -Coercion base : class_of >-> NormedModule.class_of. -Coercion base2 : class_of >-> CompletePseudoMetric.class_of. -Coercion sort : type >-> Sortclass. -Coercion eqType : type >-> Equality.type. -Canonical eqType. -Coercion choiceType : type >-> Choice.type. -Canonical choiceType. -Coercion zmodType : type >-> GRing.Zmodule.type. -Canonical zmodType. -Coercion pseudoMetricNormedZmodType : type >-> PseudoMetricNormedZmodule.type. -Canonical pseudoMetricNormedZmodType. -Coercion normedZmodType : type >-> Num.NormedZmodule.type. -Canonical normedZmodType. -Coercion lmodType : type >-> GRing.Lmodule.type. -Canonical lmodType. -Coercion pointedType : type >-> Pointed.type. -Canonical pointedType. -Coercion filteredType : type >-> Filtered.type. -Canonical filteredType. -Coercion topologicalType : type >-> Topological.type. -Canonical topologicalType. -Coercion uniformType : type >-> Uniform.type. -Canonical uniformType. -Coercion pseudoMetricType : type >-> PseudoMetric.type. -Canonical pseudoMetricType. -Coercion normedModType : type >-> NormedModule.type. -Canonical normedModType. -Coercion completeType : type >-> Complete.type. -Canonical completeType. -Coercion completePseudoMetricType : type >-> CompletePseudoMetric.type. -Canonical completePseudoMetricType. -Canonical complete_zmodType. -Canonical complete_lmodType. -Canonical complete_normedZmodType. -Canonical complete_pseudoMetricNormedZmodType. -Canonical complete_normedModType. -Canonical completePseudoMetric_lmodType. -Canonical completePseudoMetric_zmodType. -Canonical completePseudoMetric_normedModType. -Canonical completePseudoMetric_normedZmodType. -Canonical completePseudoMetric_pseudoMetricNormedZmodType. -Notation completeNormedModType K := (type (Phant K)). -Notation "[ 'completeNormedModType' K 'of' T ]" := (@pack _ (Phant K) T _ _ idfun _ _ idfun) - (at level 0, format "[ 'completeNormedModType' K 'of' T ]") : form_scope. -End Exports. - -End CompleteNormedModule. - -Export CompleteNormedModule.Exports. - -(** * Extended Types *) - -(** * The topology on real numbers *) - -Lemma R_complete (R : realType) (F : set (set R)) : ProperFilter F -> cauchy F -> cvg F. +Lemma R_complete (R : realType) (F : set_system R) : ProperFilter F -> cauchy F -> cvg F. Proof. move=> FF /cauchy_ballP F_cauchy; apply/cvg_ex. pose D := \bigcap_(A in F) (down A). @@ -3794,9 +3927,9 @@ have D_has_sup : has_sup D; first split. - exists (x0 - 1) => A FA. near F => x. apply/downP; exists x; first by near: x. - by rewrite ler_distl_subl // ltW //; near: x. + by rewrite ler_distlBl // ltW //; near: x. - exists (x0 + 1); apply/ubP => x /(_ _ x01) /downP [y]. - rewrite -[ball _ _ _]/(_ (_ < _)) ltr_distl ltr_subl_addr => /andP[/ltW]. + rewrite -[ball _ _ _]/(_ (_ < _)) ltr_distl ltrBlDr => /andP[/ltW]. by move=> /(le_trans _) yx01 _ /yx01. exists (sup D). apply/cvgrPdist_le => /= _ /posnumP[eps]; near=> x. @@ -3805,25 +3938,21 @@ rewrite ler_distl; move/ubP: (sup_upper_bound D_has_sup) => -> //=. have Fxeps : F (ball_ [eta normr] x eps%:num). by near: x; apply: nearP_dep; apply: F_cauchy. apply/ubP => y /(_ _ Fxeps) /downP[z]. - rewrite /ball_/= ltr_distl ltr_subl_addr. + rewrite /ball_/= ltr_distl ltrBlDr. by move=> /andP [/ltW /(le_trans _) le_xeps _ /le_xeps]. rewrite /D /= => A FA; near F => y. apply/downP; exists y. by near: y. -rewrite ler_subl_addl -ler_subl_addr ltW //. +rewrite lerBlDl -lerBlDr ltW //. suff: `|x - y| < eps%:num by rewrite ltr_norml => /andP[_]. by near: y; near: x; apply: nearP_dep; apply: F_cauchy. Unshelve. all: by end_near. Qed. -Canonical R_regular_completeType (R : realType) := - CompleteType R^o (@R_complete R). (*todo : delete*) -Canonical R_regular_CompleteNormedModule (R : realType) := - [completeNormedModType R of R^o]. (*todo : delete*) +HB.instance Definition _ (R : realType) := Uniform_isComplete.Build R^o + (@R_complete R). (* todo : delete *) -Canonical R_completeType (R : realType) := - [completeType of R for [completeType of R^o]]. -Canonical R_CompleteNormedModule (R : realType) := - [completeNormedModType R of R]. +HB.instance Definition _ (R : realType) := Complete.copy R + [the completeType of R^o]. (* new *) Section cvg_seq_bounded. @@ -3831,7 +3960,7 @@ Context {K : numFieldType}. Local Notation "'+oo'" := (@pinfty_nbhs K). Lemma cvg_seq_bounded {V : normedModType K} (a : nat -> V) : - cvg a -> bounded_fun a. + cvgn a -> bounded_fun a. Proof. move=> /cvg_bounded/ex_bound => -[/= Moo] => -[N _ /(_ _) aM]. have Moo_real : Moo \is Num.real by rewrite ger0_real ?(le_trans _ (aM N _))/=. @@ -3850,11 +3979,11 @@ move=> A0 ?; have [|AsupA] := pselect (A (sup A)); first exact: subset_closure. rewrite closure_limit_point; right => U /nbhs_ballP[_ /posnumP[e]] supAeU. suff [x [Ax /andP[sAex xsA]]] : exists x, A x /\ sup A - e%:num < x < sup A. exists x; split => //; first by rewrite lt_eqF. - apply supAeU; rewrite /ball /= ltr_distl (addrC x e%:num) -ltr_subl_addl sAex. - by rewrite andbT (le_lt_trans _ xsA) // ler_subl_addl ler_addr. + apply supAeU; rewrite /ball /= ltr_distl (addrC x e%:num) -ltrBlDl sAex. + by rewrite andbT (le_lt_trans _ xsA) // lerBlDl lerDr. apply: contrapT => /forallNP Ax. suff /(sup_le_ub A0) : ubound A (sup A - e%:num). - by rewrite leNgt => /negP; apply; rewrite ltr_subl_addl ltr_addr. + by rewrite leNgt => /negP; apply; rewrite ltrBlDl ltrDr. move=> y Ay; have /not_andP[//|/negP] := Ax y. rewrite negb_and leNgt => /orP[//|]; apply: contra => sAey. rewrite lt_neqAle sup_upper_bound // andbT. @@ -3864,8 +3993,8 @@ Qed. Lemma near_infty_natSinv_lt (R : archiFieldType) (e : {posnum R}) : \forall n \near \oo, n.+1%:R^-1 < e%:num. Proof. -near=> n; rewrite -(@ltr_pmul2r _ n.+1%:R) // mulVr ?unitfE //. -rewrite -(@ltr_pmul2l _ e%:num^-1) // mulr1 mulrA mulVr ?unitfE // mul1r. +near=> n; rewrite -(@ltr_pM2r _ n.+1%:R) // mulVr ?unitfE //. +rewrite -(@ltr_pM2l _ e%:num^-1) // mulr1 mulrA mulVr ?unitfE // mul1r. rewrite (lt_trans (archi_boundP _)) // ltr_nat. by near: n; exists (Num.bound e%:num^-1). Unshelve. all: by end_near. Qed. @@ -3874,9 +4003,9 @@ Lemma near_infty_natSinv_expn_lt (R : archiFieldType) (e : {posnum R}) : \forall n \near \oo, 1 / 2 ^+ n < e%:num. Proof. near=> n. -rewrite -(@ltr_pmul2r _ (2 ^+ n)) // -?natrX ?ltr0n ?expn_gt0//. +rewrite -(@ltr_pM2r _ (2 ^+ n)) // -?natrX ?ltr0n ?expn_gt0//. rewrite mul1r mulVr ?unitfE ?gt_eqF// ?ltr0n ?expn_gt0//. -rewrite -(@ltr_pmul2l _ e%:num^-1) // mulr1 mulrA mulVr ?unitfE // mul1r. +rewrite -(@ltr_pM2l _ e%:num^-1) // mulr1 mulrA mulVr ?unitfE // mul1r. rewrite (lt_trans (archi_boundP _)) // natrX upper_nthrootP //. near: n; eexists; last by move=> m; exact. by []. @@ -3884,7 +4013,7 @@ Unshelve. all: by end_near. Qed. Lemma limit_pointP (T : archiFieldType) (A : set T) (x : T) : limit_point A x <-> exists a_ : nat -> T, - [/\ a_ @` setT `<=` A, forall n, a_ n != x & a_ --> x]. + [/\ a_ @` setT `<=` A, forall n, a_ n != x & a_ @ \oo --> x]. Proof. split=> [Ax|[a_ [aTA a_x] ax]]; last first. move=> U /ax[m _ a_U]; near \oo => n; exists (a_ n); split => //. @@ -3940,30 +4069,30 @@ Qed. Lemma nbhs_open_ereal_lt r (f : R -> R) : r < f r -> nbhs r%:E [set y | y < (f r)%:E]%E. Proof. -move=> xfx; rewrite nbhsE /=; eexists; split; last by move=> y; exact. +move=> xfx; rewrite nbhsE /=; eexists; last by move=> y; exact. by split; [apply open_ereal_lt_ereal | rewrite /= lte_fin]. Qed. Lemma nbhs_open_ereal_gt r (f : R -> R) : f r < r -> nbhs r%:E [set y | (f r)%:E < y]%E. Proof. -move=> xfx; rewrite nbhsE /=; eexists; split; last by move=> y; exact. +move=> xfx; rewrite nbhsE /=; eexists; last by move=> y; exact. by split; [apply open_ereal_gt_ereal | rewrite /= lte_fin]. Qed. Lemma nbhs_open_ereal_pinfty r : (nbhs +oo [set y | r%:E < y])%E. Proof. -rewrite nbhsE /=; eexists; split; last by move=> y; exact. +rewrite nbhsE /=; eexists; last by move=> y; exact. by split; [apply open_ereal_gt_ereal | rewrite /= ltry]. Qed. Lemma nbhs_open_ereal_ninfty r : (nbhs -oo [set y | y < r%:E])%E. Proof. -rewrite nbhsE /=; eexists; split; last by move=> y; exact. +rewrite nbhsE /=; eexists; last by move=> y; exact. by split; [apply open_ereal_lt_ereal | rewrite /= ltNyr]. Qed. -Lemma ereal_hausdorff : hausdorff_space (ereal_topologicalType R). +Lemma ereal_hausdorff : hausdorff_space (\bar R). Proof. move=> -[r| |] // [r' | |] //=. - move=> rr'; congr (_%:E); apply Rhausdorff => /= A B rA r'B. @@ -3971,21 +4100,21 @@ move=> -[r| |] // [r' | |] //=. rr' _ _ (nbhs_image_EFin rA) (nbhs_image_EFin r'B). by rewrite -r0z => -[r1r0]; exists r0; split => //; rewrite -r1r0. - have /(@nbhs_open_ereal_lt _ (fun x => x + 1)) loc_r : r < r + 1. - by rewrite ltr_addl. + by rewrite ltrDl. move/(_ _ _ loc_r (nbhs_open_ereal_pinfty (r + 1))) => -[z [zr rz]]. by move: (lt_trans rz zr); rewrite lte_fin ltxx. - have /(@nbhs_open_ereal_gt _ (fun x => x - 1)) loc_r : r - 1 < r. - by rewrite ltr_subl_addr ltr_addl. + by rewrite ltrBlDr ltrDl. move/(_ _ _ loc_r (nbhs_open_ereal_ninfty (r - 1))) => -[z [rz zr]]. by move: (lt_trans zr rz); rewrite ltxx. - have /(@nbhs_open_ereal_lt _ (fun x => x + 1)) loc_r' : r' < r' + 1. - by rewrite ltr_addl. + by rewrite ltrDl. move/(_ _ _ (nbhs_open_ereal_pinfty (r' + 1)) loc_r') => -[z [r'z zr']]. by move: (lt_trans zr' r'z); rewrite ltxx. - move/(_ _ _ (nbhs_open_ereal_pinfty 0) (nbhs_open_ereal_ninfty 0)). by move=> -[z [zx xz]]; move: (lt_trans xz zx); rewrite ltxx. - have /(@nbhs_open_ereal_gt _ (fun x => x - 1)) yB : r' - 1 < r'. - by rewrite ltr_subl_addr ltr_addl. + by rewrite ltrBlDr ltrDl. move/(_ _ _ (nbhs_open_ereal_ninfty (r' - 1)) yB) => -[z [zr' r'z]]. by move: (lt_trans r'z zr'); rewrite ltxx. - move/(_ _ _ (nbhs_open_ereal_ninfty 0) (nbhs_open_ereal_pinfty 0)). @@ -3999,17 +4128,17 @@ Hint Extern 0 (hausdorff_space _) => solve[apply: ereal_hausdorff] : core. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `nbhs_image_EFin`")] -Notation nbhs_image_ERFin := nbhs_image_EFin. +Notation nbhs_image_ERFin := nbhs_image_EFin (only parsing). -Lemma EFin_lim (R : realFieldType) (f : nat -> R) : cvg f -> - lim (EFin \o f) = (lim f)%:E. +Lemma EFin_lim (R : realFieldType) (f : nat -> R) : cvgn f -> + limn (EFin \o f) = (limn f)%:E. Proof. move=> cf; apply: cvg_lim => //; move/cvg_ex : cf => [l fl]. by apply: (cvg_comp fl); rewrite (cvg_lim _ fl). Qed. Section ProperFilterERealType. -Context {T : Type} {a : set (set T)} {Fa : ProperFilter a} {R : realFieldType}. +Context {T : Type} {a : set_system T} {Fa : ProperFilter a} {R : realFieldType}. Local Open Scope ereal_scope. Implicit Types f g h : T -> \bar R. @@ -4032,7 +4161,7 @@ Proof. exact: cvge_to_le. Qed. End ProperFilterERealType. Section ecvg_realFieldType_proper. -Context {I} {F : set (set I)} {FF : ProperFilter F} {R : realFieldType}. +Context {I} {F : set_system I} {FF : ProperFilter F} {R : realFieldType}. Implicit Types (f g : I -> \bar R) (u v : I -> R) (x : \bar R) (r : R). Local Open Scope ereal_scope. @@ -4096,25 +4225,25 @@ Proof. by move=> ? ?; apply/cvg_lim => //; apply: cvg_nnesum. Qed. End ecvg_realFieldType_proper. #[deprecated(since="mathcomp-analysis 0.6.0", note="generalized to `limeMl`")] -Notation ereal_limrM := limeMl. +Notation ereal_limrM := limeMl (only parsing). #[deprecated(since="mathcomp-analysis 0.6.0", note="generalized to `limeMr`")] -Notation ereal_limMr := limeMr. +Notation ereal_limMr := limeMr (only parsing). #[deprecated(since="mathcomp-analysis 0.6.0", note="generalized to `limeN`")] -Notation ereal_limN := limeN. +Notation ereal_limN := limeN (only parsing). Section cvg_0_pinfty. -Context {R : realFieldType} {I : Type} {a : set (set I)} {FF : Filter a}. +Context {R : realFieldType} {I : Type} {a : set_system I} {FF : Filter a}. Implicit Types f : I -> R. Lemma gtr0_cvgV0 f : (\near a, 0 < f a) -> f\^-1 @ a --> 0 <-> f @ a --> +oo. Proof. move=> f_gt0; split; last first. move=> /cvgryPgt cvg_f_oo; apply/cvgr0Pnorm_lt => _/posnumP[e]. - near=> i; rewrite gtr0_norm ?invr_gt0//; last by near: i. - by rewrite -ltf_pinv ?qualifE ?invr_gt0 ?invrK//=; near: i. + near=> i; rewrite gtr0_norm ?invr_gt0//=; last by near: i. + by rewrite -ltf_pV2 ?qualifE/= ?invr_gt0 ?invrK//=; near: i. move=> /cvgr0Pnorm_lt uB; apply/cvgryPgty. near=> M; near=> i; suff: `|(f i)^-1| < M^-1. - by rewrite gtr0_norm ?ltf_pinv ?qualifE ?invr_gt0//; near: i. + by rewrite gtr0_norm ?ltf_pV2 ?qualifE ?invr_gt0//=; near: i. by near: i; apply: uB; rewrite ?invr_gt0. Unshelve. all: by end_near. Qed. @@ -4138,17 +4267,17 @@ Unshelve. all: by end_near. Qed. End cvg_0_pinfty. Section FilterRealType. -Context {T : Type} {a : set (set T)} {Fa : Filter a} {R : realFieldType}. +Context {T : Type} {a : set_system T} {Fa : Filter a} {R : realFieldType}. Implicit Types f g h : T -> R. -Lemma squeeze_cvgr f g h : (\near a, f a <= g a <= h a) -> +Lemma squeeze_cvgr f h g : (\near a, f a <= g a <= h a) -> forall (l : R), f @ a --> l -> h @ a --> l -> g @ a --> l. Proof. move=> fgh l lfa lga; apply/cvgrPdist_lt => e e_gt0. near=> x; have /(_ _)/andP[//|fg gh] := near fgh x. rewrite distrC ltr_distl (lt_le_trans _ fg) ?(le_lt_trans gh)//=. - by near: x; apply: (cvgr_lt l); rewrite // ltr_addl. -by near: x; apply: (cvgr_gt l); rewrite // gtr_addl oppr_lt0. + by near: x; apply: (cvgr_lt l); rewrite // ltrDl. +by near: x; apply: (cvgr_gt l); rewrite // gtrDl oppr_lt0. Unshelve. all: end_near. Qed. Lemma ger_cvgy f g : (\near a, f a <= g a) -> @@ -4168,11 +4297,11 @@ Unshelve. all: end_near. Qed. End FilterRealType. Section TopoProperFilterRealType. -Context {T : topologicalType} {a : set (set T)} {Fa : ProperFilter a}. +Context {T : topologicalType} {a : set_system T} {Fa : ProperFilter a}. Context {R : realFieldType}. Implicit Types f g h : T -> R. -Lemma ler_cvg_to f g l l' : f @ a --> l -> g @ a --> l' -> +Lemma ler_cvg_to f g (l l' : R) : f @ a --> l -> g @ a --> l' -> (\near a, f a <= g a) -> l <= l'. Proof. move=> fl gl; under eq_near do rewrite -subr_ge0; rewrite -subr_ge0. @@ -4186,7 +4315,7 @@ Proof. exact: ler_cvg_to. Qed. End TopoProperFilterRealType. Section FilterERealType. -Context {T : Type} {a : set (set T)} {Fa : Filter a} {R : realFieldType}. +Context {T : Type} {a : set_system T} {Fa : Filter a} {R : realFieldType}. Local Open Scope ereal_scope. Implicit Types f g h : T -> \bar R. @@ -4228,7 +4357,7 @@ Unshelve. all: end_near. Qed. End FilterERealType. Section TopoProperFilterERealType. -Context {T : topologicalType} {a : set (set T)} {Fa : ProperFilter a}. +Context {T : topologicalType} {a : set_system T} {Fa : ProperFilter a}. Context {R : realFieldType}. Local Open Scope ereal_scope. Implicit Types f g h : T -> \bar R. @@ -4290,17 +4419,17 @@ move=> oU; have [->|U0] := eqVneq U set0. apply/seteqP; split=> [x Ux|x [p _ Ipx]]; last exact: bigcup_ointsub_sub Ipx. suff [q Iqx] : exists q, bigcup_ointsub U q x. by exists q => //=; rewrite in_setE; case: Iqx => A [[_ _ +] ? _]; exact. -have : nbhs x U by rewrite nbhsE /=; exists U; split => //. +have : nbhs x U by rewrite nbhsE /=; exists U. rewrite -nbhs_ballE /nbhs_ball /nbhs_ball_ => -[_/posnumP[r] xrU]. have /rat_in_itvoo[q qxxr] : (x - r%:num < x + r%:num)%R. - by rewrite ltr_subl_addr -addrA ltr_addl. + by rewrite ltrBlDr -addrA ltrDl. exists q, `](x - r%:num)%R, (x + r%:num)%R[%classic; last first. - by rewrite /= in_itv/= ltr_subl_addl ltr_addr// ltr_addl//; apply/andP. + by rewrite /= in_itv/= ltrBlDl ltrDr// ltrDl//; apply/andP. split=> //; split; [exact: interval_open|exact: interval_is_interval|]. move=> y /=; rewrite in_itv/= => /andP[xy yxr]; apply xrU => /=. rewrite /ball /= /ball_ /= in xrU *; have [yx|yx] := leP x y. - by rewrite ler0_norm ?subr_le0// opprB ltr_subl_addl. -by rewrite gtr0_norm ?subr_gt0// ltr_subl_addr -ltr_subl_addl. + by rewrite ler0_norm ?subr_le0// opprB ltrBlDl. +by rewrite gtr0_norm ?subr_gt0// ltrBlDr -ltrBlDl. Qed. End open_union_rat. @@ -4315,9 +4444,9 @@ suff : ~ X^° (sup X) by rewrite supXr. case/nbhs_ballP => _/posnumP[e] supXeX. have [f XsupXf] : exists f : {posnum R}, X (sup X + f%:num). exists (e%:num / 2)%:pos; apply supXeX; rewrite /ball /= opprD addrA subrr. - by rewrite sub0r normrN gtr0_norm // ltr_pdivr_mulr // ltr_pmulr // ltr1n. + by rewrite sub0r normrN gtr0_norm // ltr_pdivrMr // ltr_pMr // ltr1n. have : sup X + f%:num <= sup X by apply sup_ub. -by apply/negP; rewrite -ltNge; rewrite ltr_addl. +by apply/negP; rewrite -ltNge; rewrite ltrDl. Qed. Lemma left_bounded_interior (R : realType) (X : set R) : @@ -4330,9 +4459,9 @@ suff : ~ X^° (inf X) by rewrite -rinfX. case/nbhs_ballP => _/posnumP[e] supXeX. have [f XsupXf] : exists f : {posnum R}, X (inf X - f%:num). exists (e%:num / 2)%:pos; apply supXeX; rewrite /ball /= opprB addrCA subrr. - by rewrite addr0 gtr0_norm // ltr_pdivr_mulr // ltr_pmulr // ltr1n. + by rewrite addr0 gtr0_norm // ltr_pdivrMr // ltr_pMr // ltr1n. have : inf X <= inf X - f%:num by apply inf_lb. -by apply/negP; rewrite -ltNge; rewrite ltr_subl_addr ltr_addl. +by apply/negP; rewrite -ltNge; rewrite ltrBlDr ltrDl. Qed. Section interval_realType. @@ -4420,27 +4549,27 @@ case: (asboolP (has_lbound _)) => ?; case: (asboolP (has_ubound _)) => ? //=. rewrite !(lteifF, lteifT). + move=> /andP[]; rewrite le_eqVlt => /orP[/eqP <- //|infXx]. rewrite le_eqVlt => /orP[/eqP -> //|xsupX]. - apply: (@interior_subset R). + apply: (@interior_subset [the topologicalType of R : Type]). by rewrite interval_bounded_interior // /mkset infXx. + move=> /andP[]; rewrite le_eqVlt => /orP[/eqP <- //|infXx supXx]. - apply: (@interior_subset R). + apply: (@interior_subset [the topologicalType of R : Type]). by rewrite interval_bounded_interior // /mkset infXx. + move=> /andP[infXx]; rewrite le_eqVlt => /orP[/eqP -> //|xsupX]. - apply: (@interior_subset R). + apply: (@interior_subset [the topologicalType of R : Type]). by rewrite interval_bounded_interior // /mkset infXx. - + move=> ?; apply: (@interior_subset R). + + move=> ?; apply: (@interior_subset [the topologicalType of R : Type]). by rewrite interval_bounded_interior // /mkset infXx. - case: asboolP => XinfX; rewrite !(lteifF, lteifT, andbT). + rewrite le_eqVlt => /orP[/eqP<-//|infXx]. - apply: (@interior_subset R). + apply: (@interior_subset [the topologicalType of R : Type]). by rewrite interval_right_unbounded_interior. - + move=> infXx; apply: (@interior_subset R). + + move=> infXx; apply: (@interior_subset [the topologicalType of R : Type]). by rewrite interval_right_unbounded_interior. - case: asboolP => XsupX /=. + rewrite le_eqVlt => /orP[/eqP->//|xsupX]. - apply: (@interior_subset R). + apply: (@interior_subset [the topologicalType of R : Type]). by rewrite interval_left_unbounded_interior. - + move=> xsupX; apply: (@interior_subset R). + + move=> xsupX; apply: (@interior_subset [the topologicalType of R : Type]). by rewrite interval_left_unbounded_interior. - by move=> _; rewrite (interval_unbounded_setT iX). Qed. @@ -4499,18 +4628,18 @@ split => [cE x y Ex Ey z /andP[xz zy]|]. have z1y : z1 <= y. rewrite leNgt; apply/negP => yz1. suff : (~` closure (A true)) y by apply; exact: subset_closure. - apply zcA1; rewrite /ball /= ltr_distl (lt_le_trans zy) // ?ler_addl //. - rewrite andbT ltr_subl_addl addrC (lt_trans yz1) // ltr_add2l. - by rewrite ltr_pdivr_mulr // ltr_pmulr // ltr1n. - rewrite z1y andbT ler_addl; split => //. + apply zcA1; rewrite /ball /= ltr_distl (lt_le_trans zy) // ?lerDl //. + rewrite andbT ltrBlDl addrC (lt_trans yz1) // ltrD2l. + by rewrite ltr_pdivrMr // ltr_pMr // ltr1n. + rewrite z1y andbT lerDl; split => //. have ncA1z1 : (~` closure (A true)) z1. apply zcA1; rewrite /ball /= /z1 opprD addrA subrr add0r normrN. - by rewrite ger0_norm // ltr_pdivr_mulr // ltr_pmulr // ltr1n. + by rewrite ger0_norm // ltr_pdivrMr // ltr_pMr // ltr1n. have nA0z1 : ~ (A false) z1. - move=> A0z1; have : z < z1 by rewrite /z1 ltr_addl. + move=> A0z1; have : z < z1 by rewrite /z1 ltrDl. apply/negP; rewrite -leNgt. apply: sup_ub; first by exists y => u [_] /andP[]. - by split => //; rewrite /mkset /z1 (le_trans xz) /= ?ler_addl // (ltW z1y). + by split => //; rewrite /mkset /z1 (le_trans xz) /= ?lerDl // (ltW z1y). by rewrite EU => -[//|]; apply: contra_not ncA1z1; exact: subset_closure. Qed. End interval_realType. @@ -4518,7 +4647,7 @@ End interval_realType. Section segment. Variable R : realType. -(** properties of segments in [R] *) +(** properties of segments in R *) Lemma segment_connected (a b : R) : connected `[a, b]. Proof. exact/connected_intervalP/interval_is_interval. Qed. @@ -4549,15 +4678,16 @@ apply: segment_connected. by apply/saxUf; rewrite /= in_itv/= (itvP ayz) lezx. exists i => //; apply/xe_fi; rewrite /ball_/= distrC ger0_norm. have lezy : z <= y by rewrite (itvP ayz). - rewrite ltr_subl_addl; apply: le_lt_trans lezy _; rewrite -ltr_subl_addr. - by have := xe_y; rewrite /ball_ => /ltr_distlC_subl. + rewrite ltrBlDl; apply: le_lt_trans lezy _; rewrite -ltrBlDr. + by have := xe_y; rewrite /ball_ => /ltr_distlCBl. by rewrite subr_ge0; apply/ltW. exists A; last by rewrite predeqE => x; split=> [[] | []]. move=> x clAx; have abx : x \in `[a, b]. by apply: interval_closed; have /closureI [] := clAx. split=> //; have /sabUf [i Di fx] := abx. have /fop := Di; rewrite openE => /(_ _ fx) [_ /posnumP[e] xe_fi]. -have /clAx [y [[aby [E sD [sayUf _]]] xe_y]] := nbhsx_ballx x e. +have /clAx [y [[aby [E sD [sayUf _]]] xe_y]] := + nbhsx_ballx x e%:num ltac:(by []). exists (i |` E)%fset; first by move=> j /fset1UP[->|/sD] //; rewrite inE. split=> [z axz|]; last first. exists i; first by rewrite /= !inE eq_refl. @@ -4567,8 +4697,8 @@ have [lezy|ltyz] := lerP z y. by exists j => //=; rewrite inE orbC Dj. exists i; first by rewrite /= !inE eq_refl. apply/xe_fi; rewrite /ball_/= ger0_norm; last by rewrite subr_ge0 (itvP axz). -rewrite ltr_subl_addl -ltr_subl_addr; apply: lt_trans ltyz. -by apply: ltr_distlC_subl; rewrite distrC. +rewrite ltrBlDl -ltrBlDr; apply: lt_trans ltyz. +by apply: ltr_distlCBl; rewrite distrC. Qed. End segment. @@ -4578,7 +4708,7 @@ Lemma __deprecated__ler0_addgt0P (R : numFieldType) (x : R) : Proof. exact: ler_gtP. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="use `ler_gtP` instead which generalizes it to any upper bound.")] -Notation ler0_addgt0P := __deprecated__ler0_addgt0P. +Notation ler0_addgt0P := __deprecated__ler0_addgt0P (only parsing). Lemma IVT (R : realType) (f : R -> R) (a b v : R) : a <= b -> {within `[a, b], continuous f} -> @@ -4587,10 +4717,10 @@ Lemma IVT (R : realType) (f : R -> R) (a b v : R) : Proof. move=> leab fcont; gen have ivt : f v fcont / f a <= v <= f b -> exists2 c, c \in `[a, b] & f c = v; last first. - case: (leP (f a) (f b)) => [] _ fabv; first exact: ivt. + case: (leP (f a) (f b)) => [] _ fabv /=; first exact: ivt. have [| |c cab /oppr_inj] := ivt (- f) (- v); last by exists c. - - by move=> x; apply: continuousN; apply: fcont. - - by rewrite ler_oppr opprK ler_oppr opprK andbC. + - by move=> x /=; apply/continuousN/fcont. + - by rewrite lerNr opprK lerNr opprK andbC. move=> favfb; suff: is_interval (f @` `[a,b]). apply; last exact: favfb. - by exists a => //=; rewrite in_itv/= lexx. @@ -4599,7 +4729,7 @@ apply/connected_intervalP/connected_continuous_connected => //. exact: segment_connected. Qed. -(** Local properties in [R] *) +(* Local properties in R *) (* Topology on [R]² *) @@ -4758,8 +4888,8 @@ have covA : A `<=` \bigcup_(n : int) [set p | `|p| < n%:~R]. have /Aco [] := covA. move=> n _; rewrite openE => p; rewrite /= -subr_gt0 => ltpn. apply/nbhs_ballP; exists (n%:~R - `|p|) => // q. - rewrite -ball_normE /= ltr_subr_addr distrC; apply: le_lt_trans. - by rewrite -{1}(subrK p q) ler_norm_add. + rewrite -ball_normE /= ltrBrDr distrC; apply: le_lt_trans. + by rewrite -{1}(subrK p q) ler_normD. move=> D _ DcovA. exists (\big[maxr/0]_(i : D) (fsval i)%:~R). rewrite bigmax_real//; last by move=> ? _; rewrite realz. @@ -4774,7 +4904,7 @@ Lemma rV_compact (T : topologicalType) n (A : 'I_n.+1 -> set T) : compact [ set v : 'rV[T]_n.+1 | forall i, A i (v ord0 i)]. Proof. move=> Aico. -have : @compact (product_topologicalType _) [set f | forall i, A i (f i)]. +have : @compact (prod_topology _) [set f | forall i, A i (f i)]. by apply: tychonoff. move=> Aco F FF FA. set G := [set [set f : 'I_n.+1 -> T | B (\row_j f j)] | B in F]. @@ -4783,7 +4913,7 @@ have row_simpl (v : 'rV[T]_n.+1) : \row_j (v ord0 j) = v. have row_simpl' (f : 'I_n.+1 -> T) : (\row_j f j) ord0 = f. by rewrite funeqE=> ?; rewrite mxE. have [f [Af clGf]] : [set f | forall i, A i (f i)] `&` - @cluster (product_topologicalType _) G !=set0. + @cluster (prod_topology _) G !=set0. suff GF : ProperFilter G. apply: Aco; exists [set v : 'rV[T]_n.+1 | forall i, A i (v ord0 i)] => //. by rewrite predeqE => f; split => Af i; [have := Af i|]; rewrite row_simpl'. @@ -4798,13 +4928,13 @@ have [f [Af clGf]] : [set f | forall i, A i (f i)] `&` by rewrite predeqE => ? /=; rewrite row_simpl'. exists (\row_j f j); split; first by move=> i; rewrite mxE; apply: Af. move=> C D FC f_D; have {}f_D : - nbhs (f : product_topologicalType _) [set g | D (\row_j g j)]. + nbhs (f : prod_topology _) [set g | D (\row_j g j)]. have [E f_E sED] := f_D; rewrite nbhsE. set Pj := fun j Bj => open_nbhs (f j) Bj /\ Bj `<=` E ord0 j. have exPj : forall j, exists Bj, open_nbhs (f j) Bj /\ Bj `<=` E ord0 j. move=> j; have := f_E ord0 j; rewrite nbhsE => - [Bj]. by rewrite row_simpl'; exists Bj. - exists [set g | forall j, (get (Pj j)) (g j)]; split; last first. + exists [set g | forall j, (get (Pj j)) (g j)]; last first. move=> g Pg; apply: sED => i j; rewrite ord1 row_simpl'. by have /getPex [_ /(_ _ (Pg j))] := exPj j. split; last by move=> j; have /getPex [[]] := exPj j. @@ -4836,14 +4966,13 @@ have Mnco : compact by move=> _; apply: segment_compact. apply: subclosed_compact Acl Mnco _ => v /normAltM normvleM i. suff : `|v ord0 i : R| <= M + 1 by rewrite ler_norml. -apply: le_trans (normvleM _ _); last by rewrite ltr_addl. +apply: le_trans (normvleM _ _); last by rewrite ltrDl. have /mapP[j Hj ->] : `|v ord0 i| \in [seq `|v x.1 x.2| | x : 'I_1 * 'I_n.+1]. by apply/mapP; exists (ord0, i) => //=; rewrite mem_enum. by rewrite [leRHS]/normr /= mx_normrE; apply/bigmax_geP; right => /=; exists j. Qed. - -(** * Some limits on real functions *) +(** Some limits on real functions *) Section Shift. @@ -4873,8 +5002,14 @@ Lemma near_shift {K : numDomainType} {R : normedModType K} (y x : R) (P : set R) : (\near x, P x) = (\forall z \near y, (P \o shift (x - y)) z). Proof. -rewrite propeqE nbhs0P [X in _ <-> X]nbhs0P/= -propeqE. -by apply: eq_near => e; rewrite ![_ + e]addrC addrACA subrr addr0. +(* rewrite propeqE nbhs0P [X in _ <-> X]nbhs0P/= -propeqE. *) +(* by apply: eq_near => e; rewrite ![_ + e]addrC addrACA subrr addr0. *) +rewrite propeqE; split=> /= /nbhs_normP [_/posnumP[e] ye]; +apply/nbhs_normP; exists e%:num => //= t et. + apply: ye; rewrite /= !opprD addrA addrACA subrr add0r. + by rewrite opprK addrC. +have /= := ye (t - (x - y)); rewrite addrNK; apply. +by rewrite /= opprB addrCA addrA subrK. Qed. Lemma cvg_comp_shift {T : Type} {K : numDomainType} {R : normedModType K} @@ -4890,7 +5025,9 @@ Variables (K : numFieldType) (U V : normedModType K). Lemma continuous_shift (f : U -> V) u : {for u, continuous f} = {for 0, continuous (f \o shift u)}. -Proof. by rewrite [in RHS]forE /= add0r cvg_comp_shift add0r. Qed. +Proof. +by rewrite [in RHS]forE /continuous_at/= add0r cvg_comp_shift add0r. +Qed. Lemma continuous_withinNshiftx (f : U -> V) u : f \o shift u @ 0^' --> f u <-> {for u, continuous f}. @@ -4902,13 +5039,32 @@ Qed. End continuous. +Section ball_realFieldType. +Variables (R : realFieldType). + +Lemma ball0 (a r : R) : ball a r = set0 <-> r <= 0. +Proof. +split. + move=> /seteqP[+ _] => H; rewrite leNgt; apply/negP => r0. + by have /(_ (ballxx _ r0)) := H a. +move=> r0; apply/seteqP; split => // y; rewrite /ball/=. +by move/lt_le_trans => /(_ _ r0); rewrite normr_lt0. +Qed. + +Lemma ball_itv (x r : R) : (ball x r = `]x - r, x + r[%classic)%R. +Proof. +by apply/seteqP; split => y; rewrite /ball/= in_itv/= ltr_distlC. +Qed. + +End ball_realFieldType. + Section Closed_Ball. Lemma ball_open (R : numDomainType) (V : normedModType R) (x : V) (r : R) : 0 < r -> open (ball x r). Proof. rewrite openE -ball_normE /interior => r0 y /= Bxy; near=> z. -rewrite /= (le_lt_trans (ler_dist_add y _ _)) // addrC -ltr_subr_addr. +rewrite /= (le_lt_trans (ler_distD y _ _)) // addrC -ltrBrDr. by near: z; apply: cvgr_dist_lt; rewrite // subr_gt0. Unshelve. all: by end_near. Qed. @@ -4927,7 +5083,14 @@ Qed. Definition closed_ball (R : numDomainType) (V : pseudoMetricType R) (x : V) (e : R) := closure (ball x e). -Lemma closed_ballxx (R: numDomainType) (V : pseudoMetricType R) (x : V) +Lemma closed_ball0 (R : realFieldType) (a r : R) : + r <= 0 -> closed_ball a r = set0. +Proof. +move=> /ball0 r0; apply/seteqP; split => // y. +by rewrite /closed_ball r0 closure0. +Qed. + +Lemma closed_ballxx (R : numDomainType) (V : pseudoMetricType R) (x : V) (e : R) : 0 < e -> closed_ball x e x. Proof. by move=> ?; exact/subset_closure/ballxx. Qed. @@ -4949,16 +5112,23 @@ exists (y + (s / 2) *: (`|x - y|^-1 *: (x - y))); split; [apply: Be|apply: B0y]. rewrite /= opprD addrA -[X in `|X - _|](scale1r (x - y)) scalerA -scalerBl. rewrite -[X in X - _](@divrr _ `|x - y|) ?unitfE ?normr_eq0 ?subr_eq0//. rewrite -mulrBl -scalerA normrZ normfZV ?subr_eq0// mulr1. - rewrite gtr0_norm; first by rewrite ltr_subl_addl xye ltr_addr mulr_gt0. - by rewrite subr_gt0 xye ltr_pdivr_mulr // mulr_natr mulr2n ltr_spaddl. + rewrite gtr0_norm; first by rewrite ltrBlDl xye ltrDr mulr_gt0. + by rewrite subr_gt0 xye ltr_pdivrMr // mulr_natr mulr2n ltr_pwDl. rewrite -ball_normE /ball_ /= opprD addrA addrN add0r normrN normrZ. rewrite normfZV ?subr_eq0// mulr1 normrM (gtr0_norm s0) gtr0_norm //. -by rewrite ltr_pdivr_mulr // ltr_pmulr // ltr1n. +by rewrite ltr_pdivrMr // ltr_pMr // ltr1n. Qed. -Lemma closed_ball_closed (R : realFieldType) (V : normedModType R) (x : V) - (r : R) : 0 < r -> closed (closed_ball x r). -Proof. by move => r0; rewrite closed_ballE //; exact: closed_closed_ball_. Qed. +Lemma closed_ball_closed (R : realFieldType) (V : pseudoMetricType R) (x : V) + (r : R) : closed (closed_ball x r). +Proof. exact: closed_closure. Qed. + +Lemma closed_ball_itv (R : realFieldType) (x r : R) : 0 < r -> + (closed_ball x r = `[x - r, x + r]%classic)%R. +Proof. +by move=> r0; apply/seteqP; split => y; + rewrite closed_ballE// /closed_ball_ /= in_itv/= ler_distlC. +Qed. Lemma closed_ballR_compact (R : realType) (x e : R) : 0 < e -> compact (closed_ball x e). @@ -4982,12 +5152,35 @@ split=> [/nbhs_ballP[_/posnumP[r] xrB]|[e xeB]]; last first. exact: (subset_trans (@subset_closure _ _) xeB). exists (r%:num / 2)%:sgn. apply: (subset_trans (closed_ball_subset _ _) xrB) => //=. -by rewrite lter_pdivr_mulr // ltr_pmulr // ltr1n. +by rewrite lter_pdivrMr // ltr_pMr // ltr1n. Qed. -Lemma subset_closed_ball (R : realFieldType) (V : normedModType R) (x : V) - (r : R) : 0 < r -> ball x r `<=` closed_ball x r. -Proof. move=> r0; rewrite /closed_ball; apply: subset_closure. Qed. +Lemma subset_closed_ball (R : realFieldType) (V : pseudoMetricType R) (x : V) + (r : R) : ball x r `<=` closed_ball x r. +Proof. exact: subset_closure. Qed. + +Lemma open_subball {R : realFieldType} {M : normedModType R} (A : set M) + (x : M) : open A -> A x -> \forall e \near 0^'+, ball x e `<=` A. +Proof. +move=> aA Ax. +have /(@nbhs_closedballP R M _ x)[r xrA]: nbhs x A by rewrite nbhsE/=; exists A. +near=> e. +apply/(subset_trans _ xrA)/(subset_trans _ (@subset_closed_ball _ _ _ _)) => //. +by apply: le_ball; near: e; apply: nbhs_right_le. +Unshelve. all: by end_near. Qed. + +Lemma closed_disjoint_closed_ball {R : realFieldType} {M : normedModType R} + (K : set M) z : closed K -> ~ K z -> + \forall d \near 0^'+, closed_ball z d `&` K = set0. +Proof. +rewrite -openC => /open_subball /[apply]; move=> [e /= e0]. +move=> /(_ (e / 2)) /= ; rewrite sub0r normrN gtr0_norm ?divr_gt0//. +rewrite ltr_pdivrMr// ltr_pMr// ltr1n => /(_ erefl isT). +move/subsets_disjoint; rewrite setCK => ze2K0. +exists (e / 2); first by rewrite /= divr_gt0. +move=> x /= + x0; rewrite sub0r normrN gtr0_norm// => xe. +by move: ze2K0; apply: subsetI_eq0 => //=; exact: closed_ball_subset. +Qed. Lemma locally_compactR (R : realType) : locally_compact [set: R]. Proof. @@ -4996,6 +5189,14 @@ move=> x _; rewrite withinET; exists (closed_ball x 1). by split; [apply: closed_ballR_compact | apply: closed_ball_closed]. Qed. +Lemma subset_closure_half (R : realFieldType) (V : pseudoMetricType R) (x : V) + (r : R) : 0 < r -> closed_ball x (r / 2) `<=` ball x r. +Proof. +move:r => _/posnumP[r] z /(_ (ball z ((r%:num/2)%:pos)%:num)) []. + exact: nbhsx_ballx. +by move=> y [+/ball_sym]; rewrite [t in ball x t z]splitr; apply: ball_triangle. +Qed. + (*TBA topology.v once ball_normE is there*) Lemma interior_closed_ballE (R : realType) (V : normedModType R) (x : V) @@ -5008,11 +5209,11 @@ have [-> _|nxt] := eqVneq t x; first exact: ballxx. near ((0 : R^o)^') => e; rewrite -ball_normE /closed_ball_ => tsxr. pose z := t + `|e| *: (t - x); have /tsxr /= : `|t - z| < s. rewrite distrC addrAC subrr add0r normrZ normr_id. - rewrite -ltr_pdivl_mulr ?(normr_gt0,subr_eq0) //. + rewrite -ltr_pdivlMr ?(normr_gt0,subr_eq0) //. by near: e; apply/dnbhs0_lt; rewrite divr_gt0 // normr_gt0 subr_eq0. rewrite /z opprD addrA -scalerN -{1}(scale1r (x - t)) opprB -scalerDl normrZ. -apply lt_le_trans; rewrite ltr_pmull; last by rewrite normr_gt0 subr_eq0 eq_sym. -by rewrite ger0_norm // ltr_addl normr_gt0; near: e; exists 1 => /=. +apply lt_le_trans; rewrite ltr_pMl; last by rewrite normr_gt0 subr_eq0 eq_sym. +by rewrite ger0_norm // ltrDl normr_gt0; near: e; exists 1 => /=. Unshelve. all: by end_near. Qed. Lemma open_nbhs_closed_ball (R : realType) (V : normedModType R) (x : V) @@ -5143,23 +5344,24 @@ Lemma linear_boundedP (f : {linear V -> W}) : bounded_near f (nbhs 0) <-> Proof. split=> [|/pinfty_ex_gt0 [r r0 Bf]]; last first. apply/ex_bound; exists r; apply/nbhs_norm0P; exists 1 => //= x /=. - by rewrite -(gtr_pmulr _ r0) => /ltW; exact/le_trans/Bf. + by rewrite -(gtr_pMr _ r0) => /ltW; exact/le_trans/Bf. rewrite /bounded_near => /pinfty_ex_gt0 [M M0 /nbhs_norm0P [_/posnumP[e] efM]]. near (0 : R)^'+ => d; near=> r => x. have[->|x0] := eqVneq x 0; first by rewrite raddf0 !normr0 mulr0. have nd0 : d / `|x| > 0 by rewrite divr_gt0 ?normr_gt0. have: `|f (d / `|x| *: x)| <= M. by apply: efM => /=; rewrite normrZ gtr0_norm// divfK ?normr_eq0//. -rewrite linearZ/= normrZ gtr0_norm// -ler_pdivl_mull//; move/le_trans; apply. -rewrite invfM invrK mulrAC ler_wpmul2r//; near: r; apply: nbhs_pinfty_ge. +rewrite linearZ/= normrZ gtr0_norm// -ler_pdivlMl//; move/le_trans; apply. +rewrite invfM invrK mulrAC ler_wpM2r//; near: r; apply: nbhs_pinfty_ge. by rewrite rpredM// ?rpredV ?gtr0_real. Unshelve. all: by end_near. Qed. Lemma continuous_linear_bounded (x : V) (f : {linear V -> W}) : {for 0, continuous f} -> bounded_near f (nbhs x). Proof. -rewrite /prop_for linear0 /bounded_near => f0; near=> M; apply/nbhs0P. -near do rewrite /= linearD (le_trans (ler_norm_add _ _))// -ler_subr_addl. +rewrite /prop_for/continuous_at linear0 /bounded_near => f0. +near=> M; apply/nbhs0P. +near do rewrite /= linearD (le_trans (ler_normD _ _))// -lerBrDl. by apply: cvgr0_norm_le; rewrite // subr_gt0. Unshelve. all: by end_near. Qed. @@ -5172,7 +5374,7 @@ Lemma bounded_linear_continuous (f : {linear V -> W}) : Proof. move=> /linear_boundedP [y [yreal fr]] x; near +oo_R => r. apply/(@cvgrPdist_lt _ _ _ (nbhs x)) => e e_gt0; near=> z; rewrite -linearB. -rewrite (le_lt_trans (fr r _ _))// -?ltr_pdivl_mull//. +rewrite (le_lt_trans (fr r _ _))// -?ltr_pdivlMl//. by near: z; apply: cvgr_dist_lt => //; rewrite mulrC divr_gt0. Unshelve. all: by end_near. Qed. @@ -5200,13 +5402,538 @@ split => [/(_ 1) [M Bf]|/linear_boundedP fr y]. by rewrite sub0r normrN => x1; exact/Bf/ltW. near +oo_R => r; exists (r * y) => x xe. rewrite (@le_trans _ _ (r * `|x|)) //; first by move: {xe} x; near: r. -by rewrite ler_pmul //. +by rewrite ler_pM //. Unshelve. all: by end_near. Qed. End LinearContinuousBounded. #[deprecated(since="mathcomp-analysis 0.6.0", note="generalized to `continuous_linear_bounded`")] -Notation linear_continuous0 := __deprecated__linear_continuous0. +Notation linear_continuous0 := __deprecated__linear_continuous0 (only parsing). #[deprecated(since="mathcomp-analysis 0.6.0", note="generalized to `bounded_linear_continuous`")] -Notation linear_bounded0 := __deprecated__linear_bounded0. +Notation linear_bounded0 := __deprecated__linear_bounded0 (only parsing). + +Section center_radius. +Context {R : numDomainType} {M : pseudoMetricType R}. +Implicit Types A : set M. + +(* NB: the identifier "center" is already taken! *) +Definition cpoint A := get [set c | exists r, A = ball c r]. + +Definition radius A : {nonneg R} := + xget 0%:nng [set r | A = ball (cpoint A) r%:num]. + +Definition is_ball A := A == ball (cpoint A) (radius A)%:num. + +Definition scale_ball (k : R) A := + if is_ball A then ball (cpoint A) (k * (radius A)%:num) else set0. + +Local Notation "k *` B" := (scale_ball k B). + +Lemma sub_scale_ball A k l : k <= l -> k *` A `<=` l *` A. +Proof. +move=> kl; rewrite /scale_ball; case: ifPn=> [Aball|_]; last exact: subset_refl. +by apply: le_ball; rewrite ler_wpM2r. +Qed. + +Lemma scale_ball1 A : is_ball A -> 1 *` A = A. +Proof. by move=> Aball; rewrite /scale_ball Aball mul1r; move/eqP in Aball. Qed. + +Lemma sub1_scale_ball A l : is_ball A -> A `<=` l.+1%:R *` A. +Proof. by move/scale_ball1 => {1}<-; apply: sub_scale_ball; rewrite ler1n. Qed. + +End center_radius. +Notation "k *` B" := (scale_ball k B) : classical_set_scope. + +Lemma scale_ball0 {R : realFieldType} (A : set R) r : (r <= 0)%R -> + r *` A = set0. +Proof. +move=> r0; apply/seteqP; split => // x. +rewrite /scale_ball; case: ifPn => // ballA. +by rewrite ((ball0 _ _).2 _)// mulr_le0_ge0. +Qed. + +Section center_radius_realFieldType. +Context {R : realFieldType}. +Implicit Types x y r s : R. + +Let ball_inj_radius_gt0 x y r s : 0 < r -> ball x r = ball y s -> 0 < s. +Proof. +move=> r0 xrys; rewrite ltNge; apply/negP => /ball0 s0; move: xrys. +by rewrite s0 => /seteqP[+ _] => /(_ x); apply; exact: ballxx. +Qed. + +Let ball_inj_center x y r s : 0 < r -> ball x r = ball y s -> x = y. +Proof. +move=> r0 xrys; have s0 := ball_inj_radius_gt0 r0 xrys. +apply/eqP/negPn/negP => xy. +wlog : x y r s xrys r0 s0 xy / x < y. + move: xy; rewrite neq_lt => /orP[xy|yx]. + by move/(_ _ _ _ _ xrys); apply => //; rewrite lt_eqF. + by move/esym : xrys => /[swap] /[apply]; apply => //; rewrite lt_eqF. +move=> {}xy; have [rs|sr] := ltP r s. +- suff : ~ ball x r (y + r). + by apply; rewrite xrys /ball/= ltr_distlC !ltrD2l -ltr_norml gtr0_norm. + by rewrite /ball/= ltr_distlC ltrD2r (ltNge y) (ltW xy) andbF. +- suff : ~ ball y s (x - r + minr ((y - x) / 2) r). + apply; rewrite -xrys /ball/= ltr_distlC ltrDl lt_minr r0 andbT. + rewrite divr_gt0 ?subr_gt0//= addrAC ltrBlDl addrCA ler_ltD//. + by rewrite lt_minl ltrDl r0 orbT. + have [yx2r|ryx2] := ltP ((y - x) / 2) r. + rewrite /ball/= ltr_distlC => /andP[+ _]; rewrite -(@ltr_pM2l _ 2)//. + rewrite !mulrDr mulrCA divff// mulr1 ltNge => /negP; apply. + rewrite addrAC !addrA (addrC _ y) mulr_natl mulr2n addrA addrK. + rewrite (mulr_natl y) mulr2n -!addrA lerD2l (lerD (ltW _))//. + by rewrite ler_wpM2l// lerNl opprK. + rewrite subrK /ball/= ltr_distlC => /andP[]. + rewrite ltrBlDl addrC -ltrBlDl -(@ltr_pM2r _ (2^-1))//. + move=> /le_lt_trans => /(_ _ ryx2) /le_lt_trans => /(_ _ sr). + by rewrite ltr_pMr// invf_gt1// ltNge ler1n. +Qed. + +Let ball_inj_radius x y r s : 0 < r -> ball x r = ball y s -> r = s. +Proof. +move=> r0 xrys; have s0 := ball_inj_radius_gt0 r0 xrys. +move: (xrys); rewrite (ball_inj_center r0 xrys) => {}xrys. +apply/eqP/negPn/negP; rewrite neq_lt => /orP[rs|sr]. +- suff : ball y s (y + r) by rewrite -xrys /ball/= ltr_distlC ltxx andbF. + rewrite /ball/= ltr_distlC !ltrD2l rs andbT (lt_trans _ r0)//. + by rewrite ltrNl oppr0 (lt_trans r0). +- suff : ball y r (y + s) by rewrite xrys /ball/= ltr_distlC ltxx andbF. + rewrite /ball/= ltr_distlC !ltrD2l sr andbT (lt_trans _ s0)//. + by rewrite ltrNl oppr0 (lt_trans s0). +Qed. + +Lemma ball_inj x y r s : 0 < r -> ball x r = ball y s -> x = y /\ r = s. +Proof. +by move=> r0 xrys; split; [exact: (ball_inj_center r0 xrys)| + exact: (ball_inj_radius r0 xrys)]. +Qed. + +Lemma radius0 : radius (@set0 R) = 0%:nng :> {nonneg R}. +Proof. +rewrite /radius/=; case: xgetP => [r _ /= /esym/ball0 r0|]/=. + by apply/val_inj/eqP; rewrite /= eq_le r0/=. +by move=> /(_ 0%:nng) /nesym /ball0. +Qed. + +Lemma is_ball0 : is_ball (@set0 R). +Proof. +rewrite /is_ball; apply/eqP/seteqP; split => // x; rewrite radius0/=. +by rewrite (ball0 _ _).2. +Qed. + +Lemma cpoint_ball x r : 0 < r -> cpoint (ball x r) = x. +Proof. +move=> r0; rewrite /cpoint; case: xgetP => [y _ [s] /(ball_inj r0)[]//|]. +by move=> /(_ x)/forallNP/(_ r). +Qed. + +Lemma radius_ball_num x r : 0 <= r -> (radius (ball x r))%:num = r. +Proof. +rewrite le_eqVlt => /orP[/eqP <-|r0]; first by rewrite (ball0 _ _).2// radius0. +rewrite /radius; case: xgetP => [y _ /(ball_inj r0)[]//|]. +by move=> /(_ (NngNum (ltW r0)))/=; rewrite cpoint_ball. +Qed. + +Lemma radius_ball x r (r0 : 0 <= r) : radius (ball x r) = NngNum r0. +Proof. by apply/val_inj => //=; rewrite radius_ball_num. Qed. + +Lemma is_ballP (A : set R) x : is_ball A -> + A x -> `|cpoint A - x| < (radius A)%:num. +Proof. by rewrite /is_ball => /eqP {1}-> /lt_le_trans; exact. Qed. + +Lemma is_ball_ball x r : is_ball (ball x r). +Proof. +have [r0|/ball0 ->] := ltP 0 r; last exact: is_ball0. +by apply/eqP; rewrite cpoint_ball// (radius_ball _ (ltW r0)). +Qed. + +Lemma scale_ball_set0 (k : R) : k *` set0 = set0 :> set R. +Proof. by rewrite /scale_ball is_ball0// radius0/= mulr0 ball0. Qed. + +Lemma ballE (A : set R) : is_ball A -> A = ball (cpoint A) (radius A)%:num. +Proof. +move=> ballA; apply/seteqP; split => [x /is_ballP|x Ax]; first exact. +by move: ballA => /eqP ->. +Qed. + +Lemma is_ball_closureP (A : set R) x : is_ball A -> + closure A x -> `|cpoint A - x| <= (radius A)%:num. +Proof. +move=> ballP cAx. +have : closed_ball (cpoint A) (radius A)%:num x by rewrite /closed_ball -ballE. +by have [r0|r0] := ltP 0 (radius A)%:num; [rewrite closed_ballE| + rewrite closed_ball0]. +Qed. + +Lemma is_ball_closure (A : set R) : is_ball A -> + closure A = closed_ball (cpoint A) (radius A)%:num. +Proof. by move=> ballA; rewrite /closed_ball -ballE. Qed. + +Lemma closure_ball (c r : R) : closure (ball c r) = closed_ball c r. +Proof. +have [r0|r0] := leP r 0. + by rewrite closed_ball0// ((ball0 _ _).2 r0) closure0. +by rewrite (is_ball_closure (is_ball_ball _ _)) cpoint_ball// radius_ball ?ltW. +Qed. + +Lemma scale_ballE k x r : 0 <= k -> k *` ball x r = ball x (k * r). +Proof. +move=> k0; have [r0|r0] := ltP 0 r. + apply/seteqP; split => y. + rewrite /scale_ball is_ball_ball//= cpoint_ball//. + by rewrite (radius_ball_num _ (ltW _)). + by rewrite /scale_ball is_ball_ball cpoint_ball// radius_ball_num// ltW. +rewrite ((ball0 _ _).2 r0) scale_ball_set0; apply/esym/ball0. +by rewrite mulr_ge0_le0. +Qed. + +Lemma cpoint_scale_ball A (k : R) : 0 < k -> is_ball A -> 0 < (radius A)%:num -> + cpoint (k *` A) = cpoint A :> R. +Proof. +move=> k0 ballA r0. +rewrite [in LHS](ballE ballA) (scale_ballE _ _ (ltW k0))// cpoint_ball//. +by rewrite mulr_gt0. +Qed. + +Lemma radius_scale_ball (A : set R) (k : R) : 0 <= k -> is_ball A -> + (radius (k *` A))%:num = k * (radius A)%:num. +Proof. +move=> k0 ballA. +by rewrite [in LHS](ballE ballA) (scale_ballE _ _ k0)// radius_ball// mulr_ge0. +Qed. + +Lemma is_scale_ball (A : set R) (k : R) : is_ball A -> is_ball (k *` A). +Proof. +move=> Aball. +have [k0|k0] := leP 0 k. + by rewrite (ballE Aball) (scale_ballE _ _ k0); exact: is_ball_ball. +rewrite (_ : _ *` _ = set0); first exact: is_ball0. +apply/seteqP; split => // x. +by rewrite /scale_ball Aball (ball0 _ _).2// nmulr_rle0. +Qed. + +End center_radius_realFieldType. + +Section vitali_lemma_finite. +Context {R : realType} {I : eqType}. +Variable (B : I -> set R). +Hypothesis is_ballB : forall i, is_ball (B i). +Hypothesis B_set0 : forall i, B i !=set0. + +Lemma vitali_lemma_finite (s : seq I) : + { D : seq I | [/\ uniq D, + {subset D <= s}, trivIset [set` D] B & + forall i, i \in s -> exists j, [/\ j \in D, + B i `&` B j !=set0, + radius (B j) >= radius (B i) & + B i `<=` 3%:R *` B j] ] }. +Proof. +pose LE x y := radius (B x) <= radius (B y). +have LE_trans : transitive LE by move=> x y z; exact: le_trans. +wlog : s / sorted LE s. + have : sorted LE (sort LE s) by apply: sort_sorted => x y; exact: le_total. + move=> /[swap] /[apply] -[D [uD Ds trivIset_DB H]]; exists D; split => //. + - by move=> x /Ds; rewrite mem_sort. + - by move=> i; rewrite -(mem_sort LE) => /H. +elim: s => [_|i [/= _ _|j t]]; first by exists nil. + exists [:: i]; split => //; first by rewrite set_cons1; exact: trivIset1. + move=> _ /[1!inE] /eqP ->; exists i; split => //; first by rewrite mem_head. + - by rewrite setIid; exact: B_set0. + - exact: sub1_scale_ball. +rewrite /= => + /andP[ij jt] => /(_ jt)[u [uu ujt trivIset_uB H]]. +have [K|] := pselect (forall j, j \in u -> B j `&` B i = set0). + have [iu|iu] := boolP (i \in u). + exists u; split => //. + - by move=> x /ujt xjt; rewrite inE xjt orbT. + - move=> k /[1!inE] /predU1P[->{k}|]. + exists i; split; [by []| |exact: lexx|]. + by rewrite setIid; exact: B_set0. + exact: sub1_scale_ball. + by move/H => [l [lu lk0 kl k3l]]; exists l; split => //; rewrite inE lu orbT. + exists (i :: u); split => //. + - by rewrite /= iu. + - move=> x /[1!inE] /predU1P[->|]; first by rewrite mem_head. + by move/ujt => xjt; rewrite in_cons xjt orbT. + - move=> k l /= /[1!inE] /predU1P[->{k}|ku]. + by move=> /predU1P[->{j}//|js] /set0P; rewrite setIC K// eqxx. + by move=> /predU1P[->{l} /set0P|lu]; [rewrite K// eqxx|exact: trivIset_uB]. + - move=> k /[1!inE] /predU1P[->{k}|]. + exists i; split; [by rewrite mem_head| |exact: lexx|]. + by rewrite setIid; exact: B_set0. + exact: sub1_scale_ball. + by move/H => [l [lu lk0 kl k3l]]; exists l; split => //; rewrite inE lu orbT. +move/existsNP/cid => [k /not_implyP[ku /eqP/set0P ki0]]. +exists u; split => //. + by move=> l /ujt /[!inE] /predU1P[->|->]; rewrite ?eqxx ?orbT. +move=> _ /[1!inE] /predU1P[->|/H//]; exists k; split; [exact: ku| | |]. +- by rewrite setIC. +- apply: (le_trans ij); move/ujt : ku => /[1!inE] /predU1P[<-|kt]. + exact: lexx. + by have /allP := order_path_min LE_trans jt; apply; exact: kt. +- case: ki0 => x [Bkx Bix] y => iy. + rewrite (ballE (is_ballB k)) scale_ballE// /ball/=. + rewrite -(subrK x y) -(addrC x) opprD addrA opprB. + rewrite (le_lt_trans (ler_normD _ _))// -nat1r mulrDl mul1r mulr_natl. + rewrite (ltrD (is_ballP (is_ballB k) _))// -(subrK (cpoint (B i)) y). + rewrite -(addrC (cpoint (B i))) opprD addrA opprB. + rewrite (le_lt_trans (ler_normD _ _))//. + apply (@lt_le_trans _ _ ((radius (B j))%:num *+ 2)); last first. + apply: ler_wMn2r; move/ujt : ku; rewrite inE => /predU1P[<-|kt]. + exact: lexx. + by have /allP := order_path_min LE_trans jt; apply; exact: kt. + rewrite mulr2n ltrD//. + by rewrite distrC (lt_le_trans (is_ballP (is_ballB i) _)). + by rewrite (lt_le_trans (is_ballP (is_ballB i) _)). +Qed. + +Lemma vitali_lemma_finite_cover (s : seq I) : + { D : seq I | [/\ uniq D, {subset D <= s}, + trivIset [set` D] B & + cover [set` s] B `<=` cover [set` D] (scale_ball 3%:R \o B)] }. +Proof. +have [D [uD DV tD maxD]] := vitali_lemma_finite s. +exists D; split => // x [i Vi] cBix/=. +by have [j [Dj BiBj ij]] := maxD i Vi; move/(_ _ cBix) => ?; exists j. +Qed. + +End vitali_lemma_finite. + +Section vitali_collection_partition. +Context {R : realType} {I : eqType}. +Variables (B : I -> set R) (V : set I) (r : R). +Hypothesis is_ballB : forall i, is_ball (B i). +Hypothesis B_set0 : forall i, 0 < (radius (B i))%:num. + +Definition vitali_collection_partition n := + [set i | V i /\ r / (2 ^ n.+1)%:R < (radius (B i))%:num <= r / (2 ^ n)%:R]. + +Hypothesis VBr : forall i, V i -> (radius (B i))%:num <= r. + +Lemma vitali_collection_partition_ub_gt0 i : V i -> 0 < r. +Proof. by move=> Vi; rewrite (lt_le_trans _ (VBr Vi)). Qed. + +Notation r_gt0 := vitali_collection_partition_ub_gt0. + +Lemma ex_vitali_collection_partition i : + V i -> exists n, vitali_collection_partition n i. +Proof. +move=> Vi; pose f := floor (r / (radius (B i))%:num). +have f_ge0 : 0 <= f by rewrite floor_ge0// divr_ge0// ltW// (r_gt0 Vi). +have [m /andP[mf fm]] := leq_ltn_expn `|f|.-1. +exists m; split => //; apply/andP; split => [{mf}|{fm}]. + rewrite -(@ler_nat R) in fm. + rewrite ltr_pdivrMr// mulrC -ltr_pdivrMr// (lt_le_trans _ fm)//. + rewrite (lt_le_trans (lt_succ_floor _))//= -/f -natr1 lerD2r//. + have [<-|f0] := eqVneq 0 f; first by rewrite /= ler0n. + rewrite prednK//; last by rewrite absz_gt0 eq_sym. + by rewrite natr_absz// ger0_norm. +move: m => [|m] in mf *; first by rewrite expn0 divr1 VBr. +rewrite -(@ler_nat R) in mf. +rewrite ler_pdivlMr// mulrC -ler_pdivlMr//. +have [f0|f0] := eqVneq 0 f. + by move: mf; rewrite -f0 absz0 leNgt expnS ltr_nat leq_pmulr// expn_gt0. +rewrite (le_trans mf)// prednK//; last by rewrite absz_gt0 eq_sym. +by rewrite natr_absz// ger0_norm// floor_le. +Qed. + +Lemma cover_vitali_collection_partition : + V = \bigcup_n vitali_collection_partition n. +Proof. +apply/seteqP; split => [|i [n _] []//]. +by move=> i Vi; have [n Hn] := ex_vitali_collection_partition Vi; exists n. +Qed. + +Lemma disjoint_vitali_collection_partition n m : n != m -> + vitali_collection_partition n `&` + vitali_collection_partition m = set0. +Proof. +move=> nm; wlog : n m nm / (n < m)%N. + move=> wlg; move: nm; rewrite neq_lt => /orP[nm|mn]. + by rewrite wlg// lt_eqF. + by rewrite setIC wlg// lt_eqF. +move=> {}nm; apply/seteqP; split => // i [] [Vi] /andP[rnB _] [_ /andP[_]]. +move/(lt_le_trans rnB); rewrite ltr_pM2l//; last by rewrite (r_gt0 Vi). +rewrite ltf_pV2 ?posrE ?ltr0n ?expn_gt0// ltr_nat. +by move/ltn_pexp2l => /(_ isT); rewrite ltnNge => /negP; apply. +Qed. + +End vitali_collection_partition. + +Lemma separated_closed_ball_countable + {R : realType} (I : Type) (B : I -> set R) (D : set I) : + (forall i, (radius (B i))%:num > 0) -> + trivIset D (fun i => closed_ball (cpoint (B i)) (radius (B i))%:num) -> countable D. +Proof. +move=> B0 tD. +have : trivIset D (fun i => ball (cpoint (B i)) (radius (B i))%:num). + move=> i j Di Dj BiBj; apply: tD => //. + by apply: subsetI_neq0 BiBj => //; exact: subset_closed_ball. +apply: separated_open_countable => //; first by move=> i; exact: ball_open. +by move=> i; eexists; exact: ballxx. +Qed. + +Section vitali_lemma_infinite. +Context {R : realType} {I : eqType}. +Variables (B : I -> set R) (V : set I) (r : R). +Hypothesis is_ballB : forall i, is_ball (B i). +Hypothesis Bset0 : forall i, (radius (B i))%:num > 0. +Hypothesis VBr : forall i, V i -> (radius (B i))%:num <= r. + +Let B_ := vitali_collection_partition B V r. + +Let H_ n (U : set I) := [set i | B_ n i /\ + forall j, U j -> i != j -> closure (B i) `&` closure (B j) = set0]. + +Let elt_prop (x : set I * nat * set I) := + x.1.1 `<=` V /\ + maximal_disjoint_subcollection (closure \o B) x.1.1 (H_ x.1.2 x.2). + +Let elt_type := {x | elt_prop x}. + +Let Rel (x y : elt_type) := + (sval y).2 = (sval x).2 `|` (sval x).1.1 /\ (sval x).1.2.+1 = (sval y).1.2. + +Lemma vitali_lemma_infinite : { D : set I | [/\ countable D, + D `<=` V, trivIset D (closure \o B) & + forall i, V i -> exists j, [/\ D j, + closure (B i) `&` closure (B j) !=set0, + (radius (B j))%:num >= (radius (B i))%:num / 2 & + closure (B i) `<=` closure (5%:R *` B j)] ] }. +Proof. +have [D0 [D0B0 tD0 maxD0]] := + ex_maximal_disjoint_subcollection (closure \o B) (B_ O). +have H0 : elt_prop (D0, 0%N, set0). + split; first by move=> i /D0B0[]. + split => //=. + - move=> x /= D0x; split; first exact: D0B0. + by move=> s D0s xs; move/trivIsetP : tD0; exact. + - by move=> F D0F FH0; apply: maxD0 => // i Fi; exact: (FH0 _ Fi).1. +have [v [Hv0 HvRel]] : {v : nat -> elt_type | + v 0%N = exist _ _ H0 /\ forall n, Rel (v n) (v n.+1)}. + apply: dependent_choice_Type => -[[[Dn n] Un] Hn]. + pose Hn1 := H_ n.+1 (Un `|` Dn). + have [Dn1 maxDn1] := + ex_maximal_disjoint_subcollection (closure\o B) Hn1. + suff: elt_prop (Dn1, n.+1, Un `|` Dn) by move=> H; exists (exist _ _ H). + by split => //=; case: maxDn1 => + _ _ => /subset_trans; apply => i [[]]. +pose D i := (sval (v i)).1.1. +pose U i := (sval (v i)).2. +have UE n : U n = \bigcup_(i < n) D i. + elim: n => [|n ih]; first by rewrite bigcup_mkord big_ord0 /U /sval /D Hv0. + by rewrite /U /sval/= (HvRel n).1 bigcup_mkord big_ord_recr -bigcup_mkord -ih. +pose v_ i := (sval (v i)).1.2. +have v_E n : v_ n = n. + elim: n => /= [|n]; first by rewrite /v_ /sval/= Hv0. + by move: (HvRel n).2; rewrite -!/(v_ _) => <- ->. +have maxD m : maximal_disjoint_subcollection (closure\o B) (D m) + (H_ m (\bigcup_(i < m) D i)). + by rewrite -(UE m) -[m in H_ m _]v_E /v_ /U /D; move: (v m) => [x []]. +have DH m : D m `<=` H_ m (\bigcup_(i < m) D i) by have [] := maxD m. +exists (\bigcup_k D k); split. +- apply: bigcup_countable => // n _. + apply: (@separated_closed_ball_countable R _ B) => //. + have [_ + _] := maxD n; move=> DB i j Dni Dnj. + by rewrite -!is_ball_closure//; exact: DB. +- by move=> i [n _ Dni]; have [+ _ _] := maxD n; move/(_ _ Dni) => [[]]. +- apply: trivIset_bigcup => m; first by have [] := maxD m. + move=> n i j mn Dmi Dnj. + wlog : i j n m mn Dmi Dnj / (m < n)%N. + move=> wlg ij. + move: mn; rewrite neq_lt => /orP[mn|nm]. + by rewrite (wlg i j n m)// ?lt_eqF. + by rewrite (wlg j i m n)// ?lt_eqF// setIC. + move=> {}mn. + have [_ {}H] := DH _ _ Dnj. + move=> /set0P/eqP; apply: contra_notP => /eqP. + by rewrite eq_sym setIC; apply: H => //; exists m. +move=> i Vi. +have [n Bni] := ex_vitali_collection_partition Bset0 VBr Vi. +have [[j Dj BiBj]|] := + pselect (exists2 j, (\bigcup_(i < n.+1) D i) j & + closure (B i) `&` closure (B j) !=set0); last first. + move/forall2NP => H. + have {}H j : (\bigcup_(i < n.+1) D i) j -> + closure (B i) `&` closure (B j) = set0. + by have [//|/set0P/negP/negPn/eqP] := H j. + have H_i : (H_ n (\bigcup_(i < n) D i)) i. + split => // s Hs si; apply: H => //. + by move: Hs => [m /= nm Dms]; exists m => //=; rewrite (ltn_trans nm). + have Dn_Bi j : D n j -> closure (B i) `&` closure (B j) = set0. + by move=> Dnj; apply: H; exists n => //=. + have [Dni|Dni] := pselect (D n i). + have := Dn_Bi _ Dni. + rewrite setIid => /closure_eq0 Bi0. + by have := Bset0 i; rewrite Bi0 radius0/= ltxx. + have not_tB : ~ trivIset (D n `|` [set i]) (closure \o B). + have [_ _] := maxD n. + apply. + split; first exact: subsetUl. + by move=> x; apply/Dni; apply: x; right. + by rewrite subUset; split; [exact: DH|]; rewrite sub1set inE. + have [p [q [pq Dnpi Dnqi pq0]]] : exists p q, [/\ p != q, + D n p \/ p = i, D n q \/ q = i & + closure (B p) `&` closure (B q) !=set0]. + move/trivIsetP : not_tB => /existsNP[p not_tB]; exists p. + move/existsNP : not_tB => [q not_tB]; exists q. + move/not_implyP : not_tB => [Dnip] /not_implyP[Dni1] /not_implyP[pq pq0]. + by split => //; exact/set0P/eqP. + case: Dnpi => [Dnp|pi]. + - case: Dnqi => [Dnq|qi]. + + case: (maxD n) => _ + _. + move/trivIsetP => /(_ _ _ Dnp Dnq pq). + by move/set0P : pq0 => /eqP. + + have := Dn_Bi _ Dnp. + by rewrite setIC -qi; move/set0P : pq0 => /eqP. + - case: Dnqi => [Dnq|qi]. + + have := Dn_Bi _ Dnq. + by rewrite -pi; move/set0P : pq0 => /eqP. + + by move: pq; rewrite pi qi eqxx. +have Birn : (radius (B i))%:num <= r / (2 ^ n)%:R. + by move: Bni; by rewrite /B_ /= => -[_] /andP[]. +have Bjrn : (radius (B j))%:num > r / (2 ^ n.+1)%:R. + have : \bigcup_(i < n.+1) D i `<=` \bigcup_(i < n.+1) (B_ i). + move=> k [m/= mn] Dmk. + have [+ _ _] := maxD m. + by move/(_ _ Dmk) => -[Bmk] _; exists m. + move/(_ _ Dj) => [m/= mn1] [_] /andP[+ _]. + apply: le_lt_trans. + rewrite ler_pM2l ?(vitali_collection_partition_ub_gt0 Bset0 VBr Vi)//. + by rewrite lef_pV2// ?posrE ?ltr0n ?expn_gt0// ler_nat leq_pexp2l. +exists j; split => //. +- by case: Dj => m /= mn Dm; exists m. +- rewrite (le_trans _ (ltW Bjrn))// ler_pdivrMr// expnSr natrM. + by rewrite invrM ?unitfE// mulrAC -mulrA (mulrA 2) divff// div1r. +- move=> x Bix. + rewrite is_ball_closure//; last first. + by rewrite (ballE (is_ballB j)) scale_ballE; [exact: is_ball_ball|]. + rewrite closed_ballE; last first. + rewrite (ballE (is_ballB j)) scale_ballE; last by []. + by rewrite radius_ball_num ?mulr_ge0// mulr_gt0. + rewrite /closed_ball_ /= cpoint_scale_ball; [|by []..]. + rewrite radius_scale_ball//. + apply: (@le_trans _ _ (2 * (radius (B i))%:num + (radius (B j))%:num)). + case: BiBj => y [Biy Bjy]. + rewrite (le_trans (ler_distD y _ _))// [in leRHS]addrC lerD//. + exact: is_ball_closureP. + rewrite (le_trans (ler_distD (cpoint (B i)) _ _))//. + rewrite (_ : 2 = 1 + 1); last by []. + rewrite mulrDl !mul1r// lerD; [by []| |exact: is_ball_closureP]. + by rewrite distrC; exact: is_ball_closureP. + rewrite -lerBrDr// -(@natr1 _ 4). + rewrite (mulrDl 4%:R) mul1r addrK (natrM _ 2 2) -mulrA ler_pM2l//. + rewrite (le_trans Birn)// [in leRHS]mulrC -ler_pdivrMr//. + by rewrite -mulrA -invfM -natrM -expnSr ltW. +Qed. + +Lemma vitali_lemma_infinite_cover : { D : set I | [/\ countable D, + D `<=` V, trivIset D (closure\o B) & + cover V (closure\o B) `<=` cover D (closure \o scale_ball 5%:R \o B)] }. +Proof. +have [D [cD DV tD maxD]] := vitali_lemma_infinite. +exists D; split => // x [i Vi] cBix/=. +by have [j [Dj BiBj ij]] := maxD i Vi; move/(_ _ cBix) => ?; exists j. +Qed. + +End vitali_lemma_infinite. diff --git a/theories/nsatz_realtype.v b/theories/nsatz_realtype.v index 85d83307c..218346e2b 100644 --- a/theories/nsatz_realtype.v +++ b/theories/nsatz_realtype.v @@ -1,16 +1,17 @@ Require Import Nsatz. From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum. -From mathcomp.classical Require Import boolp. +From mathcomp Require Import boolp. Require Import reals ereal. -(******************************************************************************) -(* nsatz for realType *) +(**md**************************************************************************) +(* # nsatz for realType *) (* *) (* This file registers the ring corresponding to the MathComp-Analysis type *) (* realType to the tactic nsatz of Coq. This enables some automation used for *) (* example in the file trigo.v. *) (* *) -(* ref: https://coq.inria.fr/refman/addendum/nsatz.html *) +(* Reference: *) +(* - https://coq.inria.fr/refman/addendum/nsatz.html *) (* *) (******************************************************************************) @@ -38,6 +39,7 @@ Instance Nsatz_realType_Ring_ops: Nsatz_realType_mul Nsatz_realType_sub Nsatz_realType_opp (@eq T)). +Proof. Defined. #[global] diff --git a/theories/numfun.v b/theories/numfun.v index f53c1744d..7774ff3f0 100644 --- a/theories/numfun.v +++ b/theories/numfun.v @@ -1,14 +1,16 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From HB Require Import structures. -From mathcomp Require Import all_ssreflect. -From mathcomp Require Import ssralg ssrnum ssrint interval finmap. -From mathcomp.classical Require Import boolp classical_sets fsbigop. -From mathcomp.classical Require Import functions cardinality mathcomp_extra. +From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval finmap. +From mathcomp Require Import mathcomp_extra boolp classical_sets fsbigop. +From mathcomp Require Import functions cardinality set_interval. Require Import signed reals ereal topology normedtype sequences. -(******************************************************************************) +(**md**************************************************************************) +(* # Numerical functions *) +(* *) (* This file provides definitions and lemmas about numerical functions. *) (* *) +(* ``` *) (* {nnfun T >-> R} == type of non-negative functions *) (* f ^\+ == the function formed by the non-negative outputs *) (* of f (from a type to the type of extended real *) @@ -18,6 +20,7 @@ Require Import signed reals ereal topology normedtype sequences. (* of f and 0 o.w. *) (* rendered as f ⁻ with company-coq (U+207B) *) (* \1_ A == indicator function 1_A *) +(* ``` *) (* *) (******************************************************************************) @@ -187,14 +190,14 @@ Lemma lt0_funeposM r f : (r < 0)%R -> (fun x => r%:E * f x)^\+ = (fun x => - r%:E * (f^\- x)). Proof. move=> r0; rewrite -[in LHS](opprK r); under eq_fun do rewrite EFinN mulNe. -by rewrite funeposN gt0_funenegM -1?ltr_oppr ?oppr0. +by rewrite funeposN gt0_funenegM -1?ltrNr ?oppr0. Qed. Lemma lt0_funenegM r f : (r < 0)%R -> (fun x => r%:E * f x)^\- = (fun x => - r%:E * (f^\+ x)). Proof. move=> r0; rewrite -[in LHS](opprK r); under eq_fun do rewrite EFinN mulNe. -by rewrite funenegN gt0_funeposM -1?ltr_oppr ?oppr0. +by rewrite funenegN gt0_funeposM -1?ltrNr ?oppr0. Qed. Lemma fune_abse f : abse \o f = f^\+ \+ f^\-. @@ -202,9 +205,9 @@ Proof. rewrite funeqE => x /=; have [fx0|/ltW fx0] := leP (f x) 0. - rewrite lee0_abs// /funepos /funeneg. move/max_idPr : (fx0) => ->; rewrite add0e. - by move: fx0; rewrite -{1}oppr0 EFinN lee_oppr => /max_idPl ->. + by move: fx0; rewrite -{1}oppe0 lee_oppr => /max_idPl ->. - rewrite gee0_abs// /funepos /funeneg; move/max_idPl : (fx0) => ->. - by move: fx0; rewrite -{1}oppr0 EFinN lee_oppl => /max_idPr ->; rewrite adde0. + by move: fx0; rewrite -{1}oppe0 lee_oppl => /max_idPr ->; rewrite adde0. Qed. Lemma funeposneg f : f = (fun x => f^\+ x - f^\- x). @@ -217,7 +220,7 @@ Qed. Lemma add_def_funeposneg f x : (f^\+ x +? - f^\- x). Proof. by rewrite /funeneg /funepos; case: (f x) => [r| |]; - [rewrite !maxEFin|rewrite /maxe /= ltNyr|rewrite /maxe /= ltNyr]. + [rewrite -fine_max/=|rewrite /maxe /= ltNyr|rewrite /maxe /= ltNyr]. Qed. Lemma funeD_Dpos f g : f \+ g = (f \+ g)^\+ \- (f \+ g)^\-. @@ -239,15 +242,15 @@ have [|fx0] := leP 0 (f x); last rewrite add0e. by rewrite -{1}oppe0 lee_oppl => /max_idPr ->; rewrite adde0 oppeK addeC. move gg' : (g x) => g'; move: g' gg' => [g' gg' g'0|//|goo _]. + move/ltW : (g'0); rewrite -{1}oppe0 -lee_oppr => /max_idPl => ->. - by rewrite oppeD// 2!oppeK. + by rewrite fin_num_oppeD// 2!oppeK. + by rewrite /maxe /=; case: (f x) fx0. Qed. End funposneg_lemmas. #[global] -Hint Extern 0 (is_true (0 <= _ ^\+ _)%E) => solve [apply: funepos_ge0] : core. +Hint Extern 0 (is_true (0%R <= _ ^\+ _)%E) => solve [apply: funepos_ge0] : core. #[global] -Hint Extern 0 (is_true (0 <= _ ^\- _)%E) => solve [apply: funeneg_ge0] : core. +Hint Extern 0 (is_true (0%R <= _ ^\- _)%E) => solve [apply: funeneg_ge0] : core. Definition indic {T} {R : ringType} (A : set T) (x : T) : R := (x \in A)%:R. Reserved Notation "'\1_' A" (at level 8, A at level 2, format "'\1_' A") . @@ -265,7 +268,18 @@ Proof. by apply/funext=> x; rewrite indicE in_setT. Qed. Lemma indic0 : \1_(@set0 T) = cst (0 : R). Proof. by apply/funext=> x; rewrite indicE in_set0. Qed. -Lemma preimage_indic D (B : set R) : +Lemma image_indic D A : + \1_D @` A = (if A `\` D != set0 then [set 0] else set0) `|` + (if A `&` D != set0 then [set 1 : R] else set0). +Proof. +rewrite /indic; apply/predeqP => x; split => [[t At /= <-]|]. + by rewrite /indic; case: (boolP (t \in D)); rewrite ?(inE, notin_set) => Dt; + [right|left]; rewrite ifT//=; apply/set0P; exists t. +by move=> []; case: ifPn; rewrite ?negbK// => /set0P[t [At Dt]] ->; + exists t => //; case: (boolP (t \in D)); rewrite ?(inE, notin_set). +Qed. + +Lemma preimage_indic (D : set T) (B : set R) : \1_D @^-1` B = if 1 \in B then (if 0 \in B then setT else D) else (if 0 \in B then ~` D else set0). Proof. @@ -284,17 +298,6 @@ rewrite /preimage/= /indic; apply/seteqP; split => x; by rewrite inE in B0. Qed. -Lemma image_indic D A : - \1_D @` A = (if A `\` D != set0 then [set 0] else set0) `|` - (if A `&` D != set0 then [set 1 : R] else set0). -Proof. -rewrite /indic; apply/predeqP => x; split => [[t At /= <-]|]. - by rewrite /indic; case: (boolP (t \in D)); rewrite ?(inE, notin_set) => Dt; - [right|left]; rewrite ifT//=; apply/set0P; exists t. -by move=> []; case: ifPn; rewrite ?negbK// => /set0P[t [At Dt]] ->; - exists t => //; case: (boolP (t \in D)); rewrite ?(inE, notin_set). -Qed. - Lemma image_indic_sub D A : \1_D @` A `<=` ([set 0; 1] : set R). Proof. by rewrite image_indic; do ![case: ifP=> //= _] => // t []//= ->; [left|right]. @@ -309,6 +312,13 @@ Qed. End indic_lemmas. +Lemma patch_indic T {R : numFieldType} (f : T -> R) (D : set T) : + f \_ D = (f \* \1_D)%R. +Proof. +apply/funext => x /=; rewrite /patch /= indicE. +by case: ifPn => _; rewrite ?(mulr1, mulr0). +Qed. + Lemma xsection_indic (R : ringType) T1 T2 (A : set (T1 * T2)) x : xsection A x = (fun y => (\1_A (x, y) : R)) @^-1` [set 1]. Proof. @@ -326,11 +336,11 @@ by rewrite /ysection/=; case: (_ \in _) => //= /esym/eqP /[!oner_eq0]. Qed. Lemma indic_restrict {T : pointedType} {R : numFieldType} (A : set T) : - \1_A = 1 \_ A :> (T -> R). + \1_A = (1 : T -> R) \_ A. Proof. by apply/funext => x; rewrite indicE /patch; case: ifP. Qed. Lemma restrict_indic T (R : numFieldType) (E A : set T) : - (\1_E \_ A) = \1_(E `&` A) :> (T -> R). + ((\1_E : T -> R) \_ A) = \1_(E `&` A). Proof. apply/funext => x; rewrite /restrict 2!indicE. case: ifPn => [|] xA; first by rewrite in_setI xA andbT. @@ -345,10 +355,10 @@ Proof. split=> [|f g]; rewrite !inE/=; first exact: finite_image_cst. by move=> fA gA; apply: (finite_image11 (fun x y => x * y)). Qed. -Canonical fimfun_mul := MulrPred fimfun_mulr_closed. -Canonical fimfun_ring := SubringPred fimfun_mulr_closed. -Definition fimfun_ringMixin := [ringMixin of {fimfun aT >-> rT} by <:]. -Canonical fimfun_ringType := RingType {fimfun aT >-> rT} fimfun_ringMixin. + +HB.instance Definition _ := + @GRing.isMulClosed.Build _ (@fimfun aT rT) fimfun_mulr_closed. +HB.instance Definition _ := [SubZmodule_isSubRing of {fimfun aT >-> rT} by <:]. Implicit Types (f g : {fimfun aT >-> rT}). @@ -378,9 +388,7 @@ Arguments indic_fimfun {aT rT} _. Section comring. Context (aT : pointedType) (rT : comRingType). -Definition fimfun_comRingMixin := [comRingMixin of {fimfun aT >-> rT} by <:]. -Canonical fimfun_comRingType := - ComRingType {fimfun aT >-> rT} fimfun_comRingMixin. +HB.instance Definition _ := [SubRing_isSubComRing of {fimfun aT >-> rT} by <:]. Implicit Types (f g : {fimfun aT >-> rT}). HB.instance Definition _ f g := FImFun.copy (f \* g) (f * g). @@ -398,3 +406,168 @@ HB.builders Context T R f of @FiniteDecomp T R f. Qed. HB.instance Definition _ := finite_subproof. HB.end. + +Section Tietze. +Context {X : topologicalType} {R : realType}. + +Local Notation "3" := 3%:R : ring_scope. + +Hypothesis normalX : normal_space X. + +Lemma urysohn_ext_itv A B x y : + closed A -> closed B -> A `&` B = set0 -> x < y -> + exists f : X -> R, [/\ continuous f, + f @` A `<=` [set x], f @` B `<=` [set y] & range f `<=` `[x, y]]. +Proof. +move=> cA cB A0 xy; move/normal_separatorP : normalX => urysohn_ext. +have /(@uniform_separatorP _ R)[f [cf f01 f0 f1]] := urysohn_ext _ _ cA cB A0. +pose g : X -> R := line_path x y \o f; exists g; split; rewrite /g /=. + move=> t; apply: continuous_comp; first exact: cf. + apply: (@continuousD R R^o). + apply: continuousM; last exact: cvg_cst. + by apply: (@continuousB R R^o) => //; exact: cvg_cst. + by apply: continuousM; [exact: cvg_id|exact: cvg_cst]. +- by rewrite -image_comp => z /= [? /f0 -> <-]; rewrite line_path0. +- by rewrite -image_comp => z /= [? /f1 -> <-]; rewrite line_path1. +- rewrite -image_comp; apply: (subset_trans (image_subset _ f01)). + by rewrite range_line_path. +Qed. + +Context (A : set X). +Hypothesis clA : closed A. + +Local Notation "3" := 3%:R. + +Local Lemma tietze_step' (f : X -> R) (M : R) : + 0 < M -> {within A, continuous f} -> + (forall x, A x -> `|f x| <= M) -> + exists g : X -> R, [/\ continuous g, + (forall x, A x -> `|f x - g x| <= 2/3 * M) & + (forall x, `|g x| <= 1/3 * M)]. +Proof. +move: M => _/posnumP[M] ctsf fA1. +have [] := @urysohn_ext_itv (A `&` f @^-1` `]-oo, -(1/3) * M%:num]) + (A `&` f @^-1` `[1/3 * M%:num,+oo[) (-(1/3) * M%:num) (1/3 * M%:num). +- by rewrite closed_setSI//; exact: closed_comp. +- by rewrite closed_setSI//; apply: closed_comp => //; exact: interval_closed. +- rewrite setIACA -preimage_setI eqEsubset; split => z // [_ []]. + rewrite !set_itvE/= => /[swap] /le_trans /[apply]. + by rewrite leNgt mulNr gtrN// mulr_gt0// divr_gt0. +- by rewrite mulNr gtrN// mulr_gt0//. +move=> g [ctsg gL3 gR3 grng]; exists g; split => //; first last. + by move=> x; rewrite ler_norml -mulNr; apply: grng; exists x. +move=> x Ax; have := fA1 _ Ax; rewrite 2!ler_norml => /andP[Mfx fxM]. +have [xL|xL] := leP (f x) (-(1/3) * M%:num). + have: [set g x | x in A `&` f@^-1` `]-oo, -(1/3) * M%:num]] (g x) by exists x. + move/gL3=> ->; rewrite !mulNr opprK; apply/andP; split. + by rewrite -lerBlDr -opprD -2!mulrDl natr1 divrr ?unitfE// mul1r. + rewrite -lerBrDr -2!mulrBl -(@natrB _ 2 1)// (le_trans xL)//. + by rewrite ler_pM2r// ltW// gtrN// divr_gt0. +have [xR|xR] := lerP (1/3 * M%:num) (f x). + have : [set g x | x in A `&` f@^-1` `[1/3 * M%:num, +oo[] (g x). + by exists x => //; split => //; rewrite /= in_itv //= xR. + move/gR3 => ->; apply/andP; split. + rewrite lerBrDl -2!mulrBl (le_trans _ xR)// ler_pM2r//. + by rewrite ler_wpM2r ?invr_ge0 ?ler0n// lerBlDl natr1 ler1n. + by rewrite lerBlDl -2!mulrDl nat1r divrr ?mul1r// unitfE. +have /andP[ng3 pg3] : -(1/3) * M%:num <= g x <= 1/3 * M%:num. + by apply: grng; exists x. +rewrite ?(intrD _ 1 1) !mulrDl; apply/andP; split. + by rewrite opprD lerB// -mulNr ltW. +by rewrite (lerD (ltW _))// lerNl -mulNr. +Qed. + +Let tietze_step (f : X -> R) M : + {g : X -> R^o | {within A, continuous f} -> 0 < M -> + (forall x, A x -> `|f x| <= M) -> [/\ continuous g, + forall x, A x -> `|f x - g x| <= 2/3 * M :>R + & forall x, `|g x| <= 1/3 * M ]}. +Proof. +apply: cid. +have [|?] := pselect ({within A, continuous f}); last by exists point. +have [|?] := ltP 0 M; last by exists point. +have [|?] := pselect (forall x, A x -> `|f x| <= M); last by exists point. +by move=> bd pm cf; have [g ?] := tietze_step' pm cf bd; exists g. +Qed. + +Let onem_twothirds : 1 - 2/3%:R = 1/3%:R :> R. +Proof. by apply/eqP; rewrite subr_eq/= -mulrDl nat1r divrr// unitfE. Qed. + +Lemma continuous_bounded_extension (f : X -> R^o) M : + 0 < M -> {within A, continuous f} -> (forall x, A x -> `|f x| <= M) -> + exists g, [/\ {in A, f =1 g}, continuous g & forall x, `|g x| <= M]. +Proof. +move: M => _/posnumP[M] Af fbd; pose M2d3 n := geometric M%:num (2/3) n. +have MN0 n : 0 < M2d3 n by rewrite /M2d3 /geometric /mk_sequence. +pose f_ := fix F n := + if n is n.+1 then F n - projT1 (tietze_step (F n) (M2d3 n)) else f. +pose g_ n := projT1 (tietze_step (f_ n) (M2d3 n)). +have fgE n : f_ n - f_ n.+1 = g_ n by rewrite /= opprB addrC subrK. +have twothirds1 : `|2/3| < 1 :> R. + by rewrite gtr0_norm //= ltr_pdivrMr// mul1r ltr_nat. +have f_geo n : {within A, continuous f_ n} /\ + (forall x, A x -> `|f_ n x| <= geometric M%:num (2/3) n). + elim: n => [|n [ctsN bdN]]; first by split=> //= x ?; rewrite expr0 mulr1 fbd. + have [cg bdNS bd2] := projT2 (tietze_step (f_ n) _) ctsN (MN0 n) bdN. + split=> [x|]; first by apply: cvgB; [exact:ctsN|exact/continuous_subspaceT/cg]. + by move=> x Ax; rewrite (le_trans (bdNS _ Ax))// /M2d3/= mulrCA -exprS. +have g_cts n : continuous (g_ n). + by have [? ?] := f_geo n; case: (projT2 (tietze_step (f_ n) _) _ (MN0 n)). +have g_bd n : forall x, `|g_ n x| <= geometric ((1/3) * M%:num) (2/3) n. + have [ctsN bdfN] := f_geo n; rewrite /geometric /= -[_ * M%:num * _]mulrA. + by have [_ _] := projT2 (tietze_step (f_ n) _) ctsN (MN0 n) bdfN. +pose h_ : nat -> [the completeType of {uniform X -> R^o}] := + @series {uniform X -> _} g_. +have cvgh' : cvg (h_ @ \oo). + apply/cauchy_cvgP/cauchy_ballP => eps epos; near_simpl. + suff : \forall x & x' \near \oo, (x' <= x)%N -> ball (h_ x) eps (h_ x'). + move=>/[dup]; rewrite {1}near_swap; apply: filter_app2; near=> n m. + by have /orP[mn /(_ mn)/ball_sym + _| ? _] := leq_total n m; apply. + near=> n m; move=> /= MN; rewrite /ball /= /h_ => t; rewrite /ball /=. + rewrite -[X in `|X|]/((series g_ n - series g_ m) t) sub_series MN fct_sumE. + rewrite (le_lt_trans (ler_norm_sum _ _ _))//. + rewrite (le_lt_trans (ler_sum _ (fun i _ => g_bd i t)))// -mulr_sumr. + rewrite -(subnKC MN) geometric_partial_tail. + pose L := (1/3) * M%:num * ((2/3) ^+ m / (1 - (2/3))). + apply: (@le_lt_trans _ _ L); first by rewrite ler_pM2l // geometric_le_lim. + rewrite /L onem_twothirds. + rewrite [_ ^+ _ * _ ^-1]mulrC mulrA -[x in x < _]ger0_norm; last by []. + near: m; near_simpl; move: eps epos. + by apply: (cvgr0_norm_lt (fun _ => _ : R^o)); exact: cvg_geometric. +have cvgh : {uniform, h_ @ \oo --> lim (h_ @ \oo)}. + by move=> ?; rewrite /= uniform_nbhsT; exact: cvgh'. +exists (lim (h_ @ \oo)); split. +- move=> t /set_mem At; have /pointwise_cvgP/(_ t)/(cvg_lim (@Rhausdorff _)) := + !! pointwise_uniform_cvg _ cvgh. + rewrite -fmap_comp /comp /h_ => <-; apply/esym/(@cvg_lim _ (@Rhausdorff R)). + apply: (@cvg_zero R [the pseudoMetricNormedZmodType R of R^o]). + apply: norm_cvg0; under eq_fun => n. + rewrite distrC /series /cst /= -mulN1r fct_sumE mulr_sumr. + under [fun _ : nat => _]eq_fun => ? do rewrite mulN1r -fgE opprB. + rewrite telescope_sumr //= addrCA subrr addr0. + over. + apply/norm_cvg0P/cvgr0Pnorm_lt => eps epos. + have /(_ _ epos) := @cvgr0_norm_lt R _ _ _ eventually_filter (_ : nat -> R^o) + (cvg_geometric M%:num twothirds1). + apply: filter_app; near_simpl; apply: nearW => n /le_lt_trans; apply. + by rewrite (le_trans ((f_geo n).2 _ _)) // ler_norm. +- apply: (@uniform_limit_continuous X _ (h_ @ \oo) (lim (h_ @ \oo))) =>//. + near_simpl; apply: nearW; elim. + by rewrite /h_ /series /= big_geq// => ?; exact: cvg_cst. + move=> n; rewrite /h_ /series /= big_nat_recr /= // => IH t. + by apply: continuousD; [exact: IH|exact: g_cts]. +- move=> t. + have /pointwise_cvgP/(_ t)/(cvg_lim (@Rhausdorff _)) := + !! pointwise_uniform_cvg _ cvgh. + rewrite -fmap_comp /comp /h_ => <-. + under [fun _ : nat => _]eq_fun => ? do rewrite /series /= fct_sumE. + have cvg_gt : cvgn [normed series (g_^~ t)]. + apply: (series_le_cvg _ _ (g_bd ^~ t) (is_cvg_geometric_series _)) => //. + by move=> n; rewrite mulr_ge0. + rewrite (le_trans (lim_series_norm _))//; apply: le_trans. + exact/(lim_series_le cvg_gt _ (g_bd ^~ t))/is_cvg_geometric_series. + rewrite (cvg_lim _ (cvg_geometric_series _))//; last exact: Rhausdorff. + by rewrite onem_twothirds mulrAC divrr ?mul1r// unitfE. +Unshelve. all: by end_near. Qed. + +End Tietze. diff --git a/theories/probability.v b/theories/probability.v new file mode 100644 index 000000000..6c4b8e571 --- /dev/null +++ b/theories/probability.v @@ -0,0 +1,827 @@ +(* mathcomp analysis (c) 2022 Inria and AIST. License: CeCILL-C. *) +From mathcomp Require Import all_ssreflect. +From mathcomp Require Import ssralg poly ssrnum ssrint interval finmap. +From mathcomp Require Import mathcomp_extra boolp classical_sets functions. +From mathcomp Require Import cardinality. +From HB Require Import structures. +Require Import exp numfun lebesgue_measure lebesgue_integral. +Require Import reals ereal signed topology normedtype sequences esum measure. +Require Import exp numfun lebesgue_measure lebesgue_integral. + +(**md**************************************************************************) +(* # Probability *) +(* *) +(* This file provides basic notions of probability theory. See measure.v for *) +(* the type probability T R (a measure that sums to 1). *) +(* *) +(* ``` *) +(* {RV P >-> R} == real random variable: a measurable function from *) +(* the measurableType of the probability P to R *) +(* distribution X == measure image of P by X : {RV P -> R}, declared *) +(* as an instance of probability measure *) +(* 'E_P[X] == expectation of the real measurable function X *) +(* covariance X Y == covariance between real random variable X and Y *) +(* 'V_P[X] == variance of the real random variable X *) +(* mmt_gen_fun X == moment generating function of the random variable *) +(* X *) +(* {dmfun T >-> R} == type of discrete real-valued measurable functions *) +(* {dRV P >-> R} == real-valued discrete random variable *) +(* dRV_dom X == domain of the discrete random variable X *) +(* dRV_enum X == bijection between the domain and the range of X *) +(* pmf X r := fine (P (X @^-1` [set r])) *) +(* enum_prob X k == probability of the kth value in the range of X *) +(* ``` *) +(* *) +(******************************************************************************) + +Reserved Notation "'{' 'RV' P >-> R '}'" + (at level 0, format "'{' 'RV' P '>->' R '}'"). +Reserved Notation "''E_' P [ X ]" (format "''E_' P [ X ]", at level 5). +Reserved Notation "''V_' P [ X ]" (format "''V_' P [ X ]", at level 5). +Reserved Notation "{ 'dmfun' aT >-> T }" + (at level 0, format "{ 'dmfun' aT >-> T }"). +Reserved Notation "'{' 'dRV' P >-> R '}'" + (at level 0, format "'{' 'dRV' P '>->' R '}'"). + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Import numFieldTopology.Exports. + +Local Open Scope classical_set_scope. +Local Open Scope ring_scope. + +Definition random_variable (d : _) (T : measurableType d) (R : realType) + (P : probability T R) := {mfun T >-> R}. + +Notation "{ 'RV' P >-> R }" := (@random_variable _ _ R P) : form_scope. + +Lemma notin_range_measure d (T : measurableType d) (R : realType) + (P : {measure set T -> \bar R}) (X : T -> R) r : + r \notin range X -> P (X @^-1` [set r]) = 0%E. +Proof. by rewrite notin_set => hr; rewrite preimage10. Qed. + +Lemma probability_range d (T : measurableType d) (R : realType) + (P : probability T R) (X : {RV P >-> R}) : P (X @^-1` range X) = 1%E. +Proof. by rewrite preimage_range probability_setT. Qed. + +Definition distribution (d : _) (T : measurableType d) (R : realType) + (P : probability T R) (X : {mfun T >-> R}) := + pushforward P (@measurable_funP _ _ _ X). + +Section distribution_is_probability. +Context d (T : measurableType d) (R : realType) (P : probability T R) + (X : {mfun T >-> R}). + +Let distribution0 : distribution P X set0 = 0%E. +Proof. exact: measure0. Qed. + +Let distribution_ge0 A : (0 <= distribution P X A)%E. +Proof. exact: measure_ge0. Qed. + +Let distribution_sigma_additive : semi_sigma_additive (distribution P X). +Proof. exact: measure_semi_sigma_additive. Qed. + +HB.instance Definition _ := isMeasure.Build _ _ R (distribution P X) + distribution0 distribution_ge0 distribution_sigma_additive. + +Let distribution_is_probability : distribution P X [set: _] = 1%:E. +Proof. +by rewrite /distribution /= /pushforward /= preimage_setT probability_setT. +Qed. + +HB.instance Definition _ := Measure_isProbability.Build _ _ R + (distribution P X) distribution_is_probability. + +End distribution_is_probability. + +Section transfer_probability. +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType) (P : probability T R). + +Lemma probability_distribution (X : {RV P >-> R}) r : + P [set x | X x = r] = distribution P X [set r]. +Proof. by []. Qed. + +Lemma integral_distribution (X : {RV P >-> R}) (f : R -> \bar R) : + measurable_fun [set: R] f -> (forall y, 0 <= f y) -> + \int[distribution P X]_y f y = \int[P]_x (f \o X) x. +Proof. by move=> mf f0; rewrite integral_pushforward. Qed. + +End transfer_probability. + +HB.lock Definition expectation {d} {T : measurableType d} {R : realType} + (P : probability T R) (X : T -> R) := (\int[P]_w (X w)%:E)%E. +Canonical expectation_unlockable := Unlockable expectation.unlock. +Arguments expectation {d T R} P _%R. +Notation "''E_' P [ X ]" := (@expectation _ _ _ P X) : ereal_scope. + +Section expectation_lemmas. +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType) (P : probability T R). + +Lemma expectation_fin_num (X : {RV P >-> R}) : P.-integrable setT (EFin \o X) -> + 'E_P[X] \is a fin_num. +Proof. by move=> ?; rewrite unlock integral_fune_fin_num. Qed. + +Lemma expectation_cst r : 'E_P[cst r] = r%:E. +Proof. by rewrite unlock/= integral_cst//= probability_setT mule1. Qed. + +Lemma expectation_indic (A : set T) (mA : measurable A) : 'E_P[\1_A] = P A. +Proof. by rewrite unlock integral_indic// setIT. Qed. + +Lemma integrable_expectation (X : {RV P >-> R}) + (iX : P.-integrable [set: T] (EFin \o X)) : `| 'E_P[X] | < +oo. +Proof. +move: iX => /integrableP[? Xoo]; rewrite (le_lt_trans _ Xoo)// unlock. +exact: le_trans (le_abse_integral _ _ _). +Qed. + +Lemma expectationM (X : {RV P >-> R}) (iX : P.-integrable [set: T] (EFin \o X)) + (k : R) : 'E_P[k \o* X] = k%:E * 'E_P [X]. +Proof. +rewrite unlock; under eq_integral do rewrite EFinM. +by rewrite -integralZl//; under eq_integral do rewrite muleC. +Qed. + +Lemma expectation_ge0 (X : {RV P >-> R}) : + (forall x, 0 <= X x)%R -> 0 <= 'E_P[X]. +Proof. +by move=> ?; rewrite unlock integral_ge0// => x _; rewrite lee_fin. +Qed. + +Lemma expectation_le (X Y : T -> R) : + measurable_fun [set: T] X -> measurable_fun [set: T] Y -> + (forall x, 0 <= X x)%R -> (forall x, 0 <= Y x)%R -> + {ae P, (forall x, X x <= Y x)%R} -> 'E_P[X] <= 'E_P[Y]. +Proof. +move=> mX mY X0 Y0 XY; rewrite unlock ae_ge0_le_integral => //. +- by move=> t _; apply: X0. +- exact/EFin_measurable_fun. +- by move=> t _; apply: Y0. +- exact/EFin_measurable_fun. +- move: XY => [N [mN PN XYN]]; exists N; split => // t /= h. + by apply: XYN => /=; apply: contra_not h; rewrite lee_fin. +Qed. + +Lemma expectationD (X Y : {RV P >-> R}) : + P.-integrable [set: T] (EFin \o X) -> P.-integrable [set: T] (EFin \o Y) -> + 'E_P[X \+ Y] = 'E_P[X] + 'E_P[Y]. +Proof. by move=> ? ?; rewrite unlock integralD_EFin. Qed. + +Lemma expectationB (X Y : {RV P >-> R}) : + P.-integrable [set: T] (EFin \o X) -> P.-integrable [set: T] (EFin \o Y) -> + 'E_P[X \- Y] = 'E_P[X] - 'E_P[Y]. +Proof. by move=> ? ?; rewrite unlock integralB_EFin. Qed. + +Lemma expectation_sum (X : seq {RV P >-> R}) : + (forall Xi, Xi \in X -> P.-integrable [set: T] (EFin \o Xi)) -> + 'E_P[\sum_(Xi <- X) Xi] = \sum_(Xi <- X) 'E_P[Xi]. +Proof. +elim: X => [|X0 X IHX] intX; first by rewrite !big_nil expectation_cst. +have intX0 : P.-integrable [set: T] (EFin \o X0). + by apply: intX; rewrite in_cons eqxx. +have {}intX Xi : Xi \in X -> P.-integrable [set: T] (EFin \o Xi). + by move=> XiX; apply: intX; rewrite in_cons XiX orbT. +rewrite !big_cons expectationD ?IHX// (_ : _ \o _ = fun x => + \sum_(f <- map (fun x : {RV P >-> R} => EFin \o x) X) f x). + by apply: integrable_sum => // _ /mapP[h hX ->]; exact: intX. +by apply/funext => t/=; rewrite big_map sumEFin mfun_sum. +Qed. + +End expectation_lemmas. + +HB.lock Definition covariance {d} {T : measurableType d} {R : realType} + (P : probability T R) (X Y : T -> R) := + 'E_P[(X \- cst (fine 'E_P[X])) * (Y \- cst (fine 'E_P[Y]))]%E. +Canonical covariance_unlockable := Unlockable covariance.unlock. +Arguments covariance {d T R} P _%R _%R. + +Section covariance_lemmas. +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType) (P : probability T R). + +Lemma covarianceE (X Y : {RV P >-> R}) : + P.-integrable setT (EFin \o X) -> + P.-integrable setT (EFin \o Y) -> + P.-integrable setT (EFin \o (X * Y)%R) -> + covariance P X Y = 'E_P[X * Y] - 'E_P[X] * 'E_P[Y]. +Proof. +move=> X1 Y1 XY1. +have ? : 'E_P[X] \is a fin_num by rewrite fin_num_abs// integrable_expectation. +have ? : 'E_P[Y] \is a fin_num by rewrite fin_num_abs// integrable_expectation. +rewrite unlock [X in 'E_P[X]](_ : _ = (X \* Y \- fine 'E_P[X] \o* Y + \- fine 'E_P[Y] \o* X \+ fine ('E_P[X] * 'E_P[Y]) \o* cst 1)%R); last first. + apply/funeqP => x /=; rewrite mulrDr !mulrDl/= mul1r fineM// mulrNN addrA. + by rewrite mulrN mulNr [Z in (X x * Y x - Z)%R]mulrC. +have ? : P.-integrable [set: T] (EFin \o (X \* Y \- fine 'E_P[X] \o* Y)%R). + by rewrite compreBr ?integrableB// compre_scale ?integrableZl. +rewrite expectationD/=; last 2 first. + - by rewrite compreBr// integrableB// compre_scale ?integrableZl. + - by rewrite compre_scale// integrableZl// finite_measure_integrable_cst. +rewrite 2?expectationB//= ?compre_scale// ?integrableZl//. +rewrite 3?expectationM//= ?finite_measure_integrable_cst//. +by rewrite expectation_cst mule1 fineM// EFinM !fineK// muleC subeK ?fin_numM. +Qed. + +Lemma covarianceC (X Y : T -> R) : covariance P X Y = covariance P Y X. +Proof. +by rewrite unlock; congr expectation; apply/funeqP => x /=; rewrite mulrC. +Qed. + +Lemma covariance_fin_num (X Y : {RV P >-> R}) : + P.-integrable setT (EFin \o X) -> + P.-integrable setT (EFin \o Y) -> + P.-integrable setT (EFin \o (X * Y)%R) -> + covariance P X Y \is a fin_num. +Proof. +by move=> X1 Y1 XY1; rewrite covarianceE// fin_numB fin_numM expectation_fin_num. +Qed. + +Lemma covariance_cst_l c (X : {RV P >-> R}) : covariance P (cst c) X = 0. +Proof. +rewrite unlock expectation_cst/=. +rewrite [X in 'E_P[X]](_ : _ = cst 0%R) ?expectation_cst//. +by apply/funeqP => x; rewrite /GRing.mul/= subrr mul0r. +Qed. + +Lemma covariance_cst_r (X : {RV P >-> R}) c : covariance P X (cst c) = 0. +Proof. by rewrite covarianceC covariance_cst_l. Qed. + +Lemma covarianceZl a (X Y : {RV P >-> R}) : + P.-integrable setT (EFin \o X) -> + P.-integrable setT (EFin \o Y) -> + P.-integrable setT (EFin \o (X * Y)%R) -> + covariance P (a \o* X)%R Y = a%:E * covariance P X Y. +Proof. +move=> X1 Y1 XY1. +have aXY : (a \o* X * Y = a \o* (X * Y))%R. + by apply/funeqP => x; rewrite mulrAC. +rewrite [LHS]covarianceE => [||//|] /=; last 2 first. +- by rewrite compre_scale ?integrableZl. +- by rewrite aXY compre_scale ?integrableZl. +rewrite covarianceE// aXY !expectationM//. +by rewrite -muleA -muleBr// fin_num_adde_defr// expectation_fin_num. +Qed. + +Lemma covarianceZr a (X Y : {RV P >-> R}) : + P.-integrable setT (EFin \o X) -> + P.-integrable setT (EFin \o Y) -> + P.-integrable setT (EFin \o (X * Y)%R) -> + covariance P X (a \o* Y)%R = a%:E * covariance P X Y. +Proof. +move=> X1 Y1 XY1. +by rewrite [in RHS]covarianceC covarianceC covarianceZl; last rewrite mulrC. +Qed. + +Lemma covarianceNl (X Y : {RV P >-> R}) : + P.-integrable setT (EFin \o X) -> + P.-integrable setT (EFin \o Y) -> + P.-integrable setT (EFin \o (X * Y)%R) -> + covariance P (\- X)%R Y = - covariance P X Y. +Proof. +move=> X1 Y1 XY1. +have -> : (\- X = -1 \o* X)%R by apply/funeqP => x /=; rewrite mulrN mulr1. +by rewrite covarianceZl// EFinN mulNe mul1e. +Qed. + +Lemma covarianceNr (X Y : {RV P >-> R}) : + P.-integrable setT (EFin \o X) -> + P.-integrable setT (EFin \o Y) -> + P.-integrable setT (EFin \o (X * Y)%R) -> + covariance P X (\- Y)%R = - covariance P X Y. +Proof. by move=> X1 Y1 XY1; rewrite !(covarianceC X) covarianceNl 1?mulrC. Qed. + +Lemma covarianceNN (X Y : {RV P >-> R}) : + P.-integrable setT (EFin \o X) -> + P.-integrable setT (EFin \o Y) -> + P.-integrable setT (EFin \o (X * Y)%R) -> + covariance P (\- X)%R (\- Y)%R = covariance P X Y. +Proof. +move=> X1 Y1 XY1. +have NY : P.-integrable setT (EFin \o (\- Y)%R) by rewrite compreN ?integrableN. +by rewrite covarianceNl ?covarianceNr ?oppeK//= mulrN compreN ?integrableN. +Qed. + +Lemma covarianceDl (X Y Z : {RV P >-> R}) : + P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> + P.-integrable setT (EFin \o Y) -> P.-integrable setT (EFin \o (Y ^+ 2)%R) -> + P.-integrable setT (EFin \o Z) -> P.-integrable setT (EFin \o (Z ^+ 2)%R) -> + P.-integrable setT (EFin \o (X * Z)%R) -> + P.-integrable setT (EFin \o (Y * Z)%R) -> + covariance P (X \+ Y)%R Z = covariance P X Z + covariance P Y Z. +Proof. +move=> X1 X2 Y1 Y2 Z1 Z2 XZ1 YZ1. +rewrite [LHS]covarianceE//= ?mulrDl ?compreDr// ?integrableD//. +rewrite 2?expectationD//=. +rewrite muleDl ?fin_num_adde_defr ?expectation_fin_num//. +rewrite oppeD ?fin_num_adde_defr ?fin_numM ?expectation_fin_num//. +by rewrite addeACA 2?covarianceE. +Qed. + +Lemma covarianceDr (X Y Z : {RV P >-> R}) : + P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> + P.-integrable setT (EFin \o Y) -> P.-integrable setT (EFin \o (Y ^+ 2)%R) -> + P.-integrable setT (EFin \o Z) -> P.-integrable setT (EFin \o (Z ^+ 2)%R) -> + P.-integrable setT (EFin \o (X * Y)%R) -> + P.-integrable setT (EFin \o (X * Z)%R) -> + covariance P X (Y \+ Z)%R = covariance P X Y + covariance P X Z. +Proof. +move=> X1 X2 Y1 Y2 Z1 Z2 XY1 XZ1. +by rewrite covarianceC covarianceDl ?(covarianceC X) 1?mulrC. +Qed. + +Lemma covarianceBl (X Y Z : {RV P >-> R}) : + P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> + P.-integrable setT (EFin \o Y) -> P.-integrable setT (EFin \o (Y ^+ 2)%R) -> + P.-integrable setT (EFin \o Z) -> P.-integrable setT (EFin \o (Z ^+ 2)%R) -> + P.-integrable setT (EFin \o (X * Z)%R) -> + P.-integrable setT (EFin \o (Y * Z)%R) -> + covariance P (X \- Y)%R Z = covariance P X Z - covariance P Y Z. +Proof. +move=> X1 X2 Y1 Y2 Z1 Z2 XZ1 YZ1. +rewrite -[(X \- Y)%R]/(X \+ (\- Y))%R covarianceDl ?covarianceNl//=. +- by rewrite compreN// integrableN. +- by rewrite mulrNN. +- by rewrite mulNr compreN// integrableN. +Qed. + +Lemma covarianceBr (X Y Z : {RV P >-> R}) : + P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> + P.-integrable setT (EFin \o Y) -> P.-integrable setT (EFin \o (Y ^+ 2)%R) -> + P.-integrable setT (EFin \o Z) -> P.-integrable setT (EFin \o (Z ^+ 2)%R) -> + P.-integrable setT (EFin \o (X * Y)%R) -> + P.-integrable setT (EFin \o (X * Z)%R) -> + covariance P X (Y \- Z)%R = covariance P X Y - covariance P X Z. +Proof. +move=> X1 X2 Y1 Y2 Z1 Z2 XY1 XZ1. +by rewrite !(covarianceC X) covarianceBl 1?(mulrC _ X). +Qed. + +End covariance_lemmas. + +Section variance. +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType) (P : probability T R). + +Definition variance (X : T -> R) := covariance P X X. +Local Notation "''V_' P [ X ]" := (variance X). + +Lemma varianceE (X : {RV P >-> R}) : + P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> + 'V_P[X] = 'E_P[X ^+ 2] - ('E_P[X]) ^+ 2. +Proof. by move=> X1 X2; rewrite /variance covarianceE. Qed. + +Lemma variance_fin_num (X : {RV P >-> R}) : + P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o X ^+ 2)%R -> + 'V_P[X] \is a fin_num. +Proof. by move=> /[dup]; apply: covariance_fin_num. Qed. + +Lemma variance_ge0 (X : {RV P >-> R}) : (0 <= 'V_P[X])%E. +Proof. +by rewrite /variance unlock; apply: expectation_ge0 => x; apply: sqr_ge0. +Qed. + +Lemma variance_cst r : 'V_P[cst r] = 0%E. +Proof. +rewrite /variance unlock expectation_cst/=. +rewrite [X in 'E_P[X]](_ : _ = cst 0%R) ?expectation_cst//. +by apply/funext => x; rewrite /GRing.exp/GRing.mul/= subrr mulr0. +Qed. + +Lemma varianceZ a (X : {RV P >-> R}) : + P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> + 'V_P[(a \o* X)%R] = (a ^+ 2)%:E * 'V_P[X]. +Proof. +move=> X1 X2; rewrite /variance covarianceZl//=. +- by rewrite covarianceZr// muleA. +- by rewrite compre_scale// integrableZl. +- rewrite [X in EFin \o X](_ : _ = (a \o* X ^+ 2)%R); last first. + by apply/funeqP => x; rewrite mulrA. + by rewrite compre_scale// integrableZl. +Qed. + +Lemma varianceN (X : {RV P >-> R}) : + P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> + 'V_P[(\- X)%R] = 'V_P[X]. +Proof. by move=> X1 X2; rewrite /variance covarianceNN. Qed. + +Lemma varianceD (X Y : {RV P >-> R}) : + P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> + P.-integrable setT (EFin \o Y) -> P.-integrable setT (EFin \o (Y ^+ 2)%R) -> + P.-integrable setT (EFin \o (X * Y)%R) -> + 'V_P[X \+ Y]%R = 'V_P[X] + 'V_P[Y] + 2%:E * covariance P X Y. +Proof. +move=> X1 X2 Y1 Y2 XY1. +rewrite -['V_P[_]]/(covariance P (X \+ Y)%R (X \+ Y)%R). +have XY : P.-integrable [set: T] (EFin \o (X \+ Y)%R). + by rewrite compreDr// integrableD. +rewrite covarianceDl//=; last 3 first. +- rewrite -expr2 sqrrD compreDr ?integrableD// compreDr// integrableD//. + rewrite -mulr_natr -[(_ * 2)%R]/(2 \o* (X * Y))%R compre_scale//. + exact: integrableZl. +- by rewrite mulrDr compreDr ?integrableD. +- by rewrite mulrDr mulrC compreDr ?integrableD. +rewrite covarianceDr// covarianceDr; [|by []..|by rewrite mulrC |exact: Y2]. +rewrite (covarianceC P Y X) [LHS]addeA [LHS](ACl (1*4*(2*3)))/=. +by rewrite -[2%R]/(1 + 1)%R EFinD muleDl ?mul1e// covariance_fin_num. +Qed. + +Lemma varianceB (X Y : {RV P >-> R}) : + P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> + P.-integrable setT (EFin \o Y) -> P.-integrable setT (EFin \o (Y ^+ 2)%R) -> + P.-integrable setT (EFin \o (X * Y)%R) -> + 'V_P[(X \- Y)%R] = 'V_P[X] + 'V_P[Y] - 2%:E * covariance P X Y. +Proof. +move=> X1 X2 Y1 Y2 XY1. +rewrite -[(X \- Y)%R]/(X \+ (\- Y))%R. +rewrite varianceD/= ?varianceN ?covarianceNr ?muleN//. +- by rewrite compreN ?integrableN. +- by rewrite mulrNN. +- by rewrite mulrN compreN ?integrableN. +Qed. + +Lemma varianceD_cst_l c (X : {RV P >-> R}) : + P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> + 'V_P[(cst c \+ X)%R] = 'V_P[X]. +Proof. +move=> X1 X2. +rewrite varianceD//=; last 3 first. +- exact: finite_measure_integrable_cst. +- by rewrite compre_scale// integrableZl// finite_measure_integrable_cst. +- by rewrite mulrC compre_scale ?integrableZl. +by rewrite variance_cst add0e covariance_cst_l mule0 adde0. +Qed. + +Lemma varianceD_cst_r (X : {RV P >-> R}) c : + P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> + 'V_P[(X \+ cst c)%R] = 'V_P[X]. +Proof. +move=> X1 X2. +have -> : (X \+ cst c = cst c \+ X)%R by apply/funeqP => x /=; rewrite addrC. +exact: varianceD_cst_l. +Qed. + +Lemma varianceB_cst_l c (X : {RV P >-> R}) : + P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> + 'V_P[(cst c \- X)%R] = 'V_P[X]. +Proof. +move=> X1 X2. +rewrite -[(cst c \- X)%R]/(cst c \+ (\- X))%R varianceD_cst_l/=; last 2 first. +- by rewrite compreN ?integrableN. +- by rewrite mulrNN; apply: X2. +by rewrite varianceN. +Qed. + +Lemma varianceB_cst_r (X : {RV P >-> R}) c : + P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> + 'V_P[(X \- cst c)%R] = 'V_P[X]. +Proof. +by move=> X1 X2; rewrite -[(X \- cst c)%R]/(X \+ (cst (- c)))%R varianceD_cst_r. +Qed. + +Lemma covariance_le (X Y : {RV P >-> R}) : + P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> + P.-integrable setT (EFin \o Y) -> P.-integrable setT (EFin \o (Y ^+ 2)%R) -> + P.-integrable setT (EFin \o (X * Y)%R) -> + covariance P X Y <= sqrte 'V_P[X] * sqrte 'V_P[Y]. +Proof. +move=> X1 X2 Y1 Y2 XY1. +rewrite -sqrteM ?variance_ge0//. +rewrite lee_sqrE ?sqrte_ge0// sqr_sqrte ?mule_ge0 ?variance_ge0//. +rewrite -(fineK (variance_fin_num X1 X2)) -(fineK (variance_fin_num Y1 Y2)). +rewrite -(fineK (covariance_fin_num X1 Y1 XY1)). +rewrite -EFin_expe -EFinM lee_fin -(@ler_pM2l _ 4) ?ltr0n// [leRHS]mulrA. +rewrite [in leLHS](_ : 4 = 2 * 2)%R -natrM// [in leLHS]natrM mulrACA -expr2. +rewrite -subr_le0; apply: deg_le2_ge0 => r; rewrite -lee_fin !EFinD. +rewrite EFinM fineK ?variance_fin_num// muleC -varianceZ//. +rewrite 2!EFinM ?fineK ?variance_fin_num// ?covariance_fin_num//. +rewrite -muleA [_ * r%:E]muleC -covarianceZl//. +rewrite addeAC -varianceD ?variance_ge0//=. +- by rewrite compre_scale ?integrableZl. +- rewrite [X in EFin \o X](_ : _ = r ^+2 \o* X ^+ 2)%R 1?mulrACA//. + by rewrite compre_scale ?integrableZl. +- by rewrite -mulrAC compre_scale// integrableZl. +Qed. + +End variance. +Notation "'V_ P [ X ]" := (variance P X). + +Section markov_chebyshev_cantelli. +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType) (P : probability T R). + +Lemma markov (X : {RV P >-> R}) (f : R -> R) (eps : R) : + (0 < eps)%R -> + measurable_fun [set: R] f -> (forall r, 0 <= f r)%R -> + {in Num.nneg &, {homo f : x y / x <= y}}%R -> + (f eps)%:E * P [set x | eps%:E <= `| (X x)%:E | ] <= + 'E_P[f \o (fun x => `| x |%R) \o X]. +Proof. +move=> e0 mf f0 f_nd; rewrite -(setTI [set _ | _]). +apply: (le_trans (@le_integral_comp_abse _ _ _ P _ measurableT (EFin \o X) + eps (er_map f) _ _ _ _ e0)) => //=. +- exact: measurable_er_map. +- by case => //= r _; exact: f0. +- move=> [x| |] [y| |]; rewrite !inE/= !in_itv/= ?andbT ?lee_fin ?leey//. + by move=> ? ? ?; rewrite f_nd. +- exact/EFin_measurable_fun. +- by rewrite unlock. +Qed. + +Definition mmt_gen_fun (X : {RV P >-> R}) (t : R) := 'E_P[expR \o t \o* X]. + +Lemma chernoff (X : {RV P >-> R}) (r a : R) : (0 < r)%R -> + P [set x | X x >= a]%R <= mmt_gen_fun X r * (expR (- (r * a)))%:E. +Proof. +move=> t0. +rewrite /mmt_gen_fun; have -> : expR \o r \o* X = + (normr \o normr) \o [the {mfun T >-> R} of expR \o r \o* X]. + by apply: funext => t /=; rewrite normr_id ger0_norm ?expR_ge0. +rewrite expRN lee_pdivl_mulr ?expR_gt0//. +rewrite (le_trans _ (markov _ (expR_gt0 (r * a)) _ _ _))//; last first. + exact: (monoW_in (@ger0_le_norm _)). +rewrite ger0_norm ?expR_ge0// muleC lee_pmul2l// ?lte_fin ?expR_gt0//. +rewrite [X in _ <= P X](_ : _ = [set x | a <= X x]%R)//; apply: eq_set => t/=. +by rewrite ger0_norm ?expR_ge0// lee_fin ler_expR mulrC ler_pM2r. +Qed. + +Lemma chebyshev (X : {RV P >-> R}) (eps : R) : (0 < eps)%R -> + P [set x | (eps <= `| X x - fine ('E_P[X])|)%R ] <= (eps ^- 2)%:E * 'V_P[X]. +Proof. +move => heps; have [->|hv] := eqVneq 'V_P[X] +oo. + by rewrite mulr_infty gtr0_sg ?mul1e// ?leey// invr_gt0// exprn_gt0. +have h (Y : {RV P >-> R}) : + P [set x | (eps <= `|Y x|)%R] <= (eps ^- 2)%:E * 'E_P[Y ^+ 2]. + rewrite -lee_pdivr_mull; last by rewrite invr_gt0// exprn_gt0. + rewrite exprnN expfV exprz_inv opprK -exprnP. + apply: (@le_trans _ _ ('E_P[(@GRing.exp R ^~ 2%N \o normr) \o Y])). + apply: (@markov Y (@GRing.exp R ^~ 2%N)) => //. + - by move=> r; apply: sqr_ge0. + - move=> x y; rewrite !nnegrE => x0 y0. + by rewrite ler_sqr. + apply: expectation_le => //. + - by apply: measurableT_comp => //; exact: measurableT_comp. + - by move=> x /=; apply: sqr_ge0. + - by move=> x /=; apply: sqr_ge0. + - by apply/aeW => t /=; rewrite real_normK// num_real. +have := h [the {mfun T >-> R} of (X \- cst (fine ('E_P[X])))%R]. +by move=> /le_trans; apply; rewrite /variance [in leRHS]unlock. +Qed. + +Lemma cantelli (X : {RV P >-> R}) (lambda : R) : + P.-integrable setT (EFin \o X) -> P.-integrable setT (EFin \o (X ^+ 2)%R) -> + (0 < lambda)%R -> + P [set x | lambda%:E <= (X x)%:E - 'E_P[X]] + <= (fine 'V_P[X] / (fine 'V_P[X] + lambda^2))%:E. +Proof. +move=> X1 X2 lambda_gt0. +have finEK : (fine 'E_P[X])%:E = 'E_P[X]. + by rewrite fineK ?unlock ?integral_fune_fin_num. +have finVK : (fine 'V_P[X])%:E = 'V_P[X] by rewrite fineK ?variance_fin_num. +pose Y := (X \- cst (fine 'E_P[X]))%R. +have Y1 : P.-integrable [set: T] (EFin \o Y). + rewrite compreBr => [|//]; apply: integrableB X1 _ => [//|]. + exact: finite_measure_integrable_cst. +have Y2 : P.-integrable [set: T] (EFin \o (Y ^+ 2)%R). + rewrite sqrrD/= compreDr => [|//]. + apply: integrableD => [//||]; last first. + rewrite -[(_ ^+ 2)%R]/(cst ((- fine 'E_P[X]) ^+ 2)%R). + exact: finite_measure_integrable_cst. + rewrite compreDr => [|//]; apply: integrableD X2 _ => [//|]. + rewrite [X in EFin \o X](_ : _ = (- fine 'E_P[X] * 2) \o* X)%R; last first. + by apply/funeqP => x /=; rewrite -mulr_natl mulrC mulrA. + by rewrite compre_scale => [|//]; apply: integrableZl X1. +have EY : 'E_P[Y] = 0. + rewrite expectationB/= ?finite_measure_integrable_cst//. + rewrite expectation_cst finEK subee//. + by rewrite unlock; apply: integral_fune_fin_num X1. +have VY : 'V_P[Y] = 'V_P[X] by rewrite varianceB_cst_r. +have le (u : R) : (0 <= u)%R -> + P [set x | lambda%:E <= (X x)%:E - 'E_P[X]] + <= ((fine 'V_P[X] + u^2) / (lambda + u)^2)%:E. + move=> uge0; rewrite EFinM. + have YU1 : P.-integrable [set: T] (EFin \o (Y \+ cst u)%R). + rewrite compreDr => [|//]; apply: integrableD Y1 _ => [//|]. + exact: finite_measure_integrable_cst. + have YU2 : P.-integrable [set: T] (EFin \o ((Y \+ cst u) ^+ 2)%R). + rewrite sqrrD/= compreDr => [|//]. + apply: integrableD => [//||]; last first. + rewrite -[(_ ^+ 2)%R]/(cst (u ^+ 2))%R. + exact: finite_measure_integrable_cst. + rewrite compreDr => [|//]; apply: integrableD Y2 _ => [//|]. + rewrite [X in EFin \o X](_ : _ = (2 * u) \o* Y)%R; last first. + by apply/funeqP => x /=; rewrite -mulr_natl mulrCA. + by rewrite compre_scale => [|//]; apply: integrableZl Y1. + have -> : (fine 'V_P[X] + u^2)%:E = 'E_P[(Y \+ cst u)^+2]%R. + rewrite -VY -[RHS](@subeK _ _ (('E_P[(Y \+ cst u)%R])^+2)); last first. + by rewrite fin_numX ?unlock ?integral_fune_fin_num. + rewrite -varianceE/= -/Y -?expe2//. + rewrite expectationD/= ?EY ?add0e ?expectation_cst -?EFinM; last 2 first. + - rewrite compreBr => [|//]; apply: integrableB X1 _ => [//|]. + exact: finite_measure_integrable_cst. + - exact: finite_measure_integrable_cst. + by rewrite (varianceD_cst_r _ Y1 Y2) EFinD fineK ?(variance_fin_num Y1 Y2). + have le : [set x | lambda%:E <= (X x)%:E - 'E_P[X]] + `<=` [set x | ((lambda + u)^2)%:E <= ((Y x + u)^+2)%:E]. + move=> x /= le; rewrite lee_fin; apply: lerXn2r. + - exact: addr_ge0 (ltW lambda_gt0) _. + - apply/(addr_ge0 _ uge0)/(le_trans (ltW lambda_gt0) _). + by rewrite -lee_fin EFinB finEK. + - by rewrite lerD2r -lee_fin EFinB finEK. + apply: (le_trans (le_measure _ _ _ le)). + - rewrite -[[set _ | _]]setTI inE; apply: emeasurable_fun_c_infty => [//|]. + by apply: emeasurable_funB => //; exact: measurable_int X1. + - rewrite -[[set _ | _]]setTI inE; apply: emeasurable_fun_c_infty => [//|]. + rewrite EFin_measurable_fun [X in measurable_fun _ X](_ : _ = + (fun x => x ^+ 2) \o (fun x => Y x + u))%R//. + apply/measurableT_comp => //; apply/measurable_funD => //. + by rewrite -EFin_measurable_fun; apply: measurable_int Y1. + set eps := ((lambda + u) ^ 2)%R. + have peps : (0 < eps)%R by rewrite exprz_gt0 ?ltr_wpDr. + rewrite (lee_pdivl_mulr _ _ peps) muleC. + under eq_set => x. + rewrite -[leRHS]gee0_abs ?lee_fin ?sqr_ge0 -?lee_fin => [|//]. + rewrite -[(_ ^+ 2)%R]/(((Y \+ cst u) ^+ 2) x)%R; over. + rewrite -[X in X%:E * _]gtr0_norm => [|//]. + apply: (le_trans (markov _ peps _ _ _)) => //=. + by move=> x y /[!nnegrE] /ger0_norm-> /ger0_norm->. + rewrite -/Y le_eqVlt; apply/orP; left; apply/eqP; congr expectation. + by apply/funeqP => x /=; rewrite -expr2 normr_id ger0_norm ?sqr_ge0. +pose u0 := (fine 'V_P[X] / lambda)%R. +have u0ge0 : (0 <= u0)%R. + by apply: divr_ge0 (ltW lambda_gt0); rewrite -lee_fin finVK variance_ge0. +apply: le_trans (le _ u0ge0) _; rewrite lee_fin le_eqVlt; apply/orP; left. +rewrite eqr_div; [|apply: lt0r_neq0..]; last 2 first. +- by rewrite exprz_gt0 -1?[ltLHS]addr0 ?ltr_leD. +- by rewrite ltr_wpDl ?fine_ge0 ?variance_ge0 ?exprz_gt0. +apply/eqP; have -> : fine 'V_P[X] = (u0 * lambda)%R. + by rewrite /u0 -mulrA mulVr ?mulr1 ?unitfE ?gt_eqF. +by rewrite -mulrDl -mulrDr (addrC u0) [in RHS](mulrAC u0) -exprnP expr2 !mulrA. +Qed. + +End markov_chebyshev_cantelli. + +HB.mixin Record MeasurableFun_isDiscrete d (T : measurableType d) (R : realType) + (X : T -> R) of @MeasurableFun d T R X := { + countable_range : countable (range X) +}. + +HB.structure Definition discreteMeasurableFun d (T : measurableType d) + (R : realType) := { + X of isMeasurableFun d T R X & MeasurableFun_isDiscrete d T R X +}. + +Notation "{ 'dmfun' aT >-> T }" := + (@discreteMeasurableFun.type _ aT T) : form_scope. + +Definition discrete_random_variable (d : _) (T : measurableType d) + (R : realType) (P : probability T R) := {dmfun T >-> R}. + +Notation "{ 'dRV' P >-> R }" := + (@discrete_random_variable _ _ R P) : form_scope. + +Section dRV_definitions. +Context d (T : measurableType d) (R : realType) (P : probability T R). + +Definition dRV_dom_enum (X : {dRV P >-> R}) : + { B : set nat & {splitbij B >-> range X}}. +Proof. +have /countable_bijP/cid[B] := @countable_range _ _ _ X. +move/card_esym/ppcard_eqP/unsquash => f. +exists B; exact: f. +Qed. + +Definition dRV_dom (X : {dRV P >-> R}) : set nat := projT1 (dRV_dom_enum X). + +Definition dRV_enum (X : {dRV P >-> R}) : {splitbij (dRV_dom X) >-> range X} := + projT2 (dRV_dom_enum X). + +Definition enum_prob (X : {dRV P >-> R}) := + (fun k => P (X @^-1` [set dRV_enum X k])) \_ (dRV_dom X). + +End dRV_definitions. + +Section distribution_dRV. +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType) (P : probability T R). +Variable X : {dRV P >-> R}. + +Lemma distribution_dRV_enum (n : nat) : n \in dRV_dom X -> + distribution P X [set dRV_enum X n] = enum_prob X n. +Proof. +by move=> nX; rewrite /distribution/= /enum_prob/= patchE nX. +Qed. + +Lemma distribution_dRV A : measurable A -> + distribution P X A = \sum_(k mA; rewrite /distribution /pushforward. +have mAX i : dRV_dom X i -> measurable (X @^-1` (A `&` [set dRV_enum X i])). + move=> _; rewrite preimage_setI; apply: measurableI => //. + exact/measurable_sfunP. +have tAX : trivIset (dRV_dom X) (fun k => X @^-1` (A `&` [set dRV_enum X k])). + under eq_fun do rewrite preimage_setI; rewrite -/(trivIset _ _). + apply: trivIset_setIl; apply/trivIsetP => i j iX jX /eqP ij. + rewrite -preimage_setI (_ : _ `&` _ = set0)//. + by apply/seteqP; split => //= x [] -> {x} /inj; rewrite inE inE => /(_ iX jX). +have := measure_bigcup P _ (fun k => X @^-1` (A `&` [set dRV_enum X k])) mAX tAX. +rewrite -preimage_bigcup => {mAX tAX}PXU. +rewrite -{1}(setIT A) -(setUv (\bigcup_(i in dRV_dom X) [set dRV_enum X i])). +rewrite setIUr preimage_setU measureU; last 3 first. + - rewrite preimage_setI; apply: measurableI => //. + exact: measurable_sfunP. + by apply: measurable_sfunP; exact: bigcup_measurable. + - apply: measurable_sfunP; apply: measurableI => //. + by apply: measurableC; exact: bigcup_measurable. + - rewrite 2!preimage_setI setIACA -!setIA -preimage_setI. + by rewrite setICr preimage_set0 2!setI0. +rewrite [X in _ + X = _](_ : _ = 0) ?adde0; last first. + rewrite (_ : _ @^-1` _ = set0) ?measure0//; apply/disjoints_subset => x AXx. + rewrite setCK /bigcup /=; exists ((dRV_enum X)^-1 (X x))%function. + exact: funS. + by rewrite invK// inE. +rewrite setI_bigcupr; etransitivity; first exact: PXU. +rewrite eseries_mkcond; apply: eq_eseriesr => k _. +rewrite /enum_prob patchE; case: ifPn => nX; rewrite ?mul0e//. +rewrite diracE; have [kA|] := boolP (_ \in A). + by rewrite mule1 setIidr// => _ /= ->; exact: set_mem. +rewrite notin_set => kA. +rewrite mule0 (disjoints_subset _ _).2 ?preimage_set0 ?measure0//. +by apply: subsetCr; rewrite sub1set inE. +Qed. + +Lemma sum_enum_prob : \sum_(n /esym; apply: eq_trans. +by rewrite [RHS]eseries_mkcond; apply: eq_eseriesr => k _; rewrite diracT mule1. +Qed. + +End distribution_dRV. + +Section discrete_distribution. +Local Open Scope ereal_scope. +Context d (T : measurableType d) (R : realType) (P : probability T R). + +Lemma dRV_expectation (X : {dRV P >-> R}) : + P.-integrable [set: T] (EFin \o X) -> + 'E_P[X] = \sum_(n ix; rewrite unlock. +rewrite -[in LHS](_ : \bigcup_k (if k \in dRV_dom X then + X @^-1` [set dRV_enum X k] else set0) = setT); last first. + apply/seteqP; split => // t _. + exists ((dRV_enum X)^-1%function (X t)) => //. + case: ifPn=> [_|]. + by rewrite invK// inE. + by rewrite notin_set/=; apply; apply: funS. +have tA : trivIset (dRV_dom X) (fun k => [set dRV_enum X k]). + by move=> i j iX jX [r [/= ->{r}]] /inj; rewrite !inE; exact. +have {tA}/trivIset_mkcond tXA : + trivIset (dRV_dom X) (fun k => X @^-1` [set dRV_enum X k]). + apply/trivIsetP => /= i j iX jX ij. + move/trivIsetP : tA => /(_ i j iX jX) Aij. + by rewrite -preimage_setI Aij ?preimage_set0. +rewrite integral_bigcup //; last 2 first. + - by move=> k; case: ifPn. + - apply: (integrableS measurableT) => //. + by rewrite -bigcup_mkcond; exact: bigcup_measurable. +transitivity (\sum_(i i _; case: ifPn => iX. + by apply: eq_integral => t; rewrite in_setE/= => ->. + by rewrite !integral_set0. +transitivity (\sum_(i i _; rewrite -integralZl//; last 2 first. + - by case: ifPn. + - apply/integrableP; split => //. + rewrite (eq_integral (cst 1%E)); last by move=> x _; rewrite abse1. + rewrite integral_cst//; last by case: ifPn. + rewrite mul1e (@le_lt_trans _ _ 1%E) ?ltey//. + by case: ifPn => // _; exact: probability_le1. + by apply: eq_integral => y _; rewrite mule1. +apply: eq_eseriesr => k _; case: ifPn => kX. + rewrite /= integral_cst//= mul1e probability_distribution muleC. + by rewrite distribution_dRV_enum. +by rewrite integral_set0 mule0 /enum_prob patchE (negbTE kX) mul0e. +Qed. + +Definition pmf (X : {RV P >-> R}) (r : R) : R := fine (P (X @^-1` [set r])). + +Lemma expectation_pmf (X : {dRV P >-> R}) : + P.-integrable [set: T] (EFin \o X) -> 'E_P[X] = + \sum_(n iX; rewrite dRV_expectation// [in RHS]eseries_mkcond. +apply: eq_eseriesr => k _. +rewrite /enum_prob patchE; case: ifPn => kX; last by rewrite mul0e. +by rewrite /pmf fineK// fin_num_measure. +Qed. + +End discrete_distribution. diff --git a/theories/prodnormedzmodule.v b/theories/prodnormedzmodule.v index 4649f942e..199cdf769 100644 --- a/theories/prodnormedzmodule.v +++ b/theories/prodnormedzmodule.v @@ -1,7 +1,8 @@ +From HB Require Import structures. From mathcomp Require Import all_ssreflect fingroup ssralg poly ssrnum. Require Import signed. -(******************************************************************************) +(**md**************************************************************************) (* This file equips the product of two normedZmodTypes with a canonical *) (* normedZmodType structure. It is a short file that has been added here for *) (* convenience during the rebase of MathComp-Analysis on top of MathComp 1.1. *) @@ -23,7 +24,7 @@ Definition norm (x : U * V) : R := Num.max `|x.1| `|x.2|. Lemma normD x y : norm (x + y) <= norm x + norm y. Proof. -rewrite /norm num_le_maxl !(le_trans (ler_norm_add _ _)) ?ler_add//; +rewrite /norm num_le_maxl !(le_trans (ler_normD _ _)) ?lerD//; by rewrite comparable_le_maxr ?lexx ?orbT// real_comparable. Qed. @@ -34,24 +35,23 @@ by case/and3P => /eqP -> /eqP ->. Qed. Lemma normMn x n : norm (x *+ n) = (norm x) *+ n. -Proof. by rewrite /norm pairMnE -mulr_natl maxr_pmulr ?mulr_natl ?normrMn. Qed. +Proof. by rewrite /norm pairMnE -mulr_natl maxr_pMr ?mulr_natl ?normrMn. Qed. Lemma normrN x : norm (- x) = norm x. Proof. by rewrite /norm/= !normrN. Qed. -Definition normedZmodMixin : - @Num.normed_mixin_of R [zmodType of U * V] (Num.NumDomain.class R) := - @Num.NormedMixin _ _ _ norm normD norm_eq0 normMn normrN. - -Canonical normedZmodType := NormedZmodType R (U * V) normedZmodMixin. +#[export] +HB.instance Definition _ := Num.Zmodule_isNormed.Build R (U * V)%type + normD norm_eq0 normMn normrN. -Lemma prod_normE (x : normedZmodType) : `|x| = Num.max `|x.1| `|x.2|. +Lemma prod_normE (x : [the normedZmodType R of (U * V)%type]) : + `|x| = Num.max `|x.1| `|x.2|. Proof. by []. Qed. End ProdNormedZmodule. Module Exports. -Canonical normedZmodType. +HB.reexport. Definition prod_normE := @prod_normE. End Exports. diff --git a/theories/real_interval.v b/theories/real_interval.v index 8ca4e888b..cc90e5e51 100644 --- a/theories/real_interval.v +++ b/theories/real_interval.v @@ -1,15 +1,13 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint interval. From mathcomp Require Import finmap fingroup perm rat. -From mathcomp.classical Require Import boolp classical_sets functions. -From mathcomp.classical Require Import mathcomp_extra. -From mathcomp.classical Require Export set_interval. +From mathcomp Require Import mathcomp_extra boolp classical_sets functions. +From mathcomp Require Export set_interval. From HB Require Import structures. Require Import reals ereal signed topology normedtype sequences. -(******************************************************************************) -(* This files contains lemmas about sets and intervals on reals. *) -(* *) +(**md**************************************************************************) +(* # Sets and intervals on $\overline{\mathbb{R}}$ *) (******************************************************************************) Set Implicit Arguments. @@ -31,7 +29,7 @@ move: b i => [] [[]y|[]]; rewrite ?bnd_simp => xy; split=> //; do 1?[ by exists ((x + y) / 2); rewrite !set_itvE/= addrC !(midf_le,midf_lt) //; exact: ltW | by exists (x - 1); rewrite !set_itvE/= - !(ltr_subl_addr, ler_subl_addr, ltr_addl,ler_addl)]. + !(ltrBlDr, lerBlDr, ltrDl,lerDl)]. Qed. Lemma has_inf_half x b (i : itv_bound R) : (BSide b x < i)%O -> @@ -41,7 +39,7 @@ move: b i => [] [[]y|[]]; rewrite ?bnd_simp => xy; do 1?[ by split=> //; exists ((x + y) / 2); rewrite !set_itvE/= !(midf_le,midf_lt) //; exact: ltW - | by split => //; exists (x + 1); rewrite !set_itvE/= !(ltr_addl,ler_addl)]. + | by split => //; exists (x + 1); rewrite !set_itvE/= !(ltrDl,lerDl)]. Qed. End interval_has. @@ -61,7 +59,7 @@ case: b; last first. by rewrite -setUitv1// sup_setU ?sup1// => ? ? ? ->; exact/ltW. set s := sup _; apply/eqP; rewrite eq_le; apply/andP; split. - apply sup_le_ub; last by move=> ? /ltW. - by exists (x - 1); rewrite !set_itvE/= ltr_subl_addr ltr_addl. + by exists (x - 1); rewrite !set_itvE/= ltrBlDr ltrDl. - rewrite leNgt; apply/negP => sx; pose p := (s + x) / 2. suff /andP[?]: (p < x) && (s < p) by apply/negP; rewrite -leNgt sup_ub. by rewrite !midf_lt. @@ -102,7 +100,7 @@ Let inf_itv_bnd_o x y b : (BSide b x < BLeft y)%O -> Proof. case: b => xy. by rewrite -setU1itv// inf_setU ?inf1// => _ ? -> /andP[/ltW]. -by rewrite /inf opp_itv_bnd_bnd sup_itv_o_bnd ?opprK // ltr_oppl opprK. +by rewrite /inf opp_itv_bnd_bnd sup_itv_o_bnd ?opprK // ltrNl opprK. Qed. Let inf_itv_bounded x y a b : (BSide a x < BSide b y)%O -> @@ -162,12 +160,12 @@ Lemma itv_c_inftyEbigcap x : `[x, +oo[%classic = \bigcap_k `]x - k.+1%:R^-1, +oo[%classic. Proof. rewrite predeqE => y; split=> /= [|xy]. - rewrite in_itv /= andbT => xy z _ /=; rewrite in_itv /= andbT ltr_subl_addr. - by rewrite (le_lt_trans xy) // ltr_addl invr_gt0 ltr0n. + rewrite in_itv /= andbT => xy z _ /=; rewrite in_itv /= andbT ltrBlDr. + by rewrite (le_lt_trans xy) // ltrDl invr_gt0 ltr0n. rewrite in_itv /= andbT leNgt; apply/negP => yx. have {}[k ykx] := ltr_add_invr yx. have {xy}/= := xy k Logic.I. -by rewrite in_itv /= andbT; apply/negP; rewrite -leNgt ler_subr_addr ltW. +by rewrite in_itv /= andbT; apply/negP; rewrite -leNgt lerBrDr ltW. Qed. Lemma itv_bnd_inftyEbigcup b x : [set` Interval (BSide b x) +oo%O] = @@ -175,10 +173,10 @@ Lemma itv_bnd_inftyEbigcup b x : [set` Interval (BSide b x) +oo%O] = Proof. rewrite predeqE => y; split=> /=; last first. by move=> [n _]/=; rewrite in_itv => /andP[xy yn]; rewrite in_itv /= xy. -rewrite in_itv /= andbT => xy; exists (`|floor y|%N.+1) => //=. -rewrite in_itv /= xy /= -natr1. -have [y0|y0] := ltP 0 y; last by rewrite (le_lt_trans y0)// ltr_spaddr. -by rewrite natr_absz ger0_norm ?lt_succ_floor// floor_ge0 ltW. +rewrite in_itv /= andbT => xy; exists `|floor y|%N.+1 => //=. +rewrite in_itv /= xy /=. +have [y0|y0] := ltP 0 y; last by rewrite (le_lt_trans y0)// ltr_pwDr. +by rewrite -natr1 natr_absz ger0_norm ?floor_ge0 1?ltW// lt_succ_floor. Qed. Lemma itv_o_inftyEbigcup x : @@ -189,7 +187,7 @@ rewrite predeqE => y; split => [|[n _]]/=. have {}[k xky] := ltr_add_invr xy. by exists k => //=; rewrite in_itv /= (ltW xky). rewrite in_itv /= andbT => xny. -by rewrite in_itv /= andbT (lt_le_trans _ xny) // ltr_addl invr_gt0. +by rewrite in_itv /= andbT (lt_le_trans _ xny) // ltrDl invr_gt0. Qed. Lemma set_itv_setT (i : interval R) : [set` i] = setT -> i = `]-oo, +oo[. @@ -275,7 +273,7 @@ Coercion ereal_of_itv_bound T (b : itv_bound T) : \bar T := match b with BSide _ y => y%:E | +oo%O => +oo%E | -oo%O => -oo%E end. Arguments ereal_of_itv_bound T !b. -Section erealDomainType. +Section itv_realDomainType. Context (R : realDomainType). Lemma le_bnd_ereal (a b : itv_bound R) : (a <= b)%O -> (a <= b)%E. @@ -325,10 +323,109 @@ rewrite set_itvE predeqE => x; split => /=. - by move: x => [x h|//|/(_ erefl)]; rewrite ?ltNyr. Qed. -End erealDomainType. +End itv_realDomainType. + +Section set_ereal. +Context (R : realType) T (f g : T -> \bar R). +Local Open Scope ereal_scope. + +Let E j := [set x | f x - g x >= j.+1%:R^-1%:E]. + +Lemma set_lte_bigcup : [set x | f x > g x] = \bigcup_j E j. +Proof. +apply/seteqP; split => [x/=|x [n _]]; last first. + by rewrite /E/= -sube_gt0; apply: lt_le_trans. +move gxE : (g x) => gx; case: gx gxE => [gx| |gxoo fxoo]; last 2 first. + - by case: (f x). + - by exists 0%N => //; rewrite /E/= gxoo addey// ?leey// -ltNye. +move fxE : (f x) => fx; case: fx fxE => [fx fxE gxE|fxoo gxE _|//]; last first. + by exists 0%N => //; rewrite /E/= fxoo gxE// addye// leey. +rewrite lte_fin -subr_gt0 => fgx; exists `|floor (fx - gx)^-1%R|%N => //. +rewrite /E/= -natr1 natr_absz ger0_norm ?floor_ge0 ?invr_ge0; last exact/ltW. +rewrite fxE gxE lee_fin -[leRHS]invrK lef_pV2//. +- by apply/ltW; rewrite lt_succ_floor. +- by rewrite posrE// ltr_pwDr// ler0z floor_ge0 invr_ge0 ltW. +- by rewrite posrE invr_gt0. +Qed. + +End set_ereal. Lemma disj_itv_Rhull {R : realType} (A B : set R) : A `&` B = set0 -> is_interval A -> is_interval B -> disjoint_itv (Rhull A) (Rhull B). Proof. by move=> AB0 iA iB; rewrite /disjoint_itv RhullK ?inE// RhullK ?inE. Qed. + +Lemma set1_bigcap_oc (R : realType) (r : R) : + [set r] = \bigcap_i `]r - i.+1%:R^-1, r]%classic. +Proof. +apply/seteqP; split=> [x ->|]. + by move=> i _/=; rewrite in_itv/= lexx ltrBlDr ltrDl invr_gt0 ltr0n. +move=> x rx; apply/esym/eqP; rewrite eq_le (itvP (rx 0%N _))// andbT. +apply/ler_addgt0Pl => e e_gt0; rewrite -lerBlDl ltW//. +have := rx `|floor e^-1%R|%N I; rewrite /= in_itv => /andP[/le_lt_trans->]//. +rewrite lerD2l lerN2 -lef_pV2 ?invrK//; last by rewrite posrE. +by rewrite -natr1 natr_absz ger0_norm ?floor_ge0 ?invr_ge0 1?ltW// lt_succ_floor. +Qed. + +Lemma itv_bnd_open_bigcup (R : realType) b (r s : R) : + [set` Interval (BSide b r) (BLeft s)] = + \bigcup_n [set` Interval (BSide b r) (BRight (s - n.+1%:R^-1))]. +Proof. +apply/seteqP; split => [x/=|]; last first. + move=> x [n _ /=] /[!in_itv] /andP[-> /le_lt_trans]; apply. + by rewrite ltrBlDr ltrDl invr_gt0 ltr0n. +rewrite in_itv/= => /andP[sx xs]; exists `|ceil ((s - x)^-1)|%N => //=. +rewrite in_itv/= sx/= lerBrDl addrC -lerBrDl. +rewrite -[in X in _ <= X](invrK (s - x)) ler_pV2. +- rewrite -natr1 natr_absz ger0_norm; last first. + by rewrite ceil_ge0// invr_ge0 subr_ge0 ltW. + by rewrite (@le_trans _ _ (ceil (s - x)^-1)%:~R)// ?lerDl// ceil_ge. +- by rewrite inE unitfE ltr0n andbT pnatr_eq0. +- by rewrite inE invr_gt0 subr_gt0 xs andbT unitfE invr_eq0 subr_eq0 gt_eqF. +Qed. + +Lemma itv_open_bnd_bigcup (R : realType) b (r s : R) : + [set` Interval (BRight s) (BSide b r)] = + \bigcup_n [set` Interval (BLeft (s + n.+1%:R^-1)) (BSide b r)]. +Proof. +have /(congr1 (fun x => -%R @` x)) := itv_bnd_open_bigcup (~~ b) (- r) (- s). +rewrite opp_itv_bnd_bnd/= !opprK negbK => ->; rewrite image_bigcup. +apply eq_bigcupr => k _; apply/seteqP; split=> [_/= [y ysr] <-|x/= xsr]. + by rewrite oppr_itv/= opprD. +by exists (- x); rewrite ?oppr_itv//= opprK// negbK opprB opprK addrC. +Qed. + +Lemma itv_bnd_infty_bigcup (R : realType) b (x : R) : + [set` Interval (BSide b x) +oo%O] = + \bigcup_i [set` Interval (BSide b x) (BRight (x + i%:R))]. +Proof. +apply/seteqP; split=> y; rewrite /= !in_itv/= andbT; last first. + by move=> [k _ /=]; move: b => [|] /=; rewrite in_itv/= => /andP[//] /ltW. +move=> xy; exists `|ceil (y - x)|%N => //=; rewrite in_itv/= xy/= -lerBlDl. +rewrite !natr_absz/= ger0_norm ?ceil_ge0 ?subr_ge0 ?ceil_ge//. +by case: b xy => //= /ltW. +Qed. + +Lemma itv_infty_bnd_bigcup (R : realType) b (x : R) : + [set` Interval -oo%O (BSide b x)] = + \bigcup_i [set` Interval (BLeft (x - i%:R)) (BSide b x)]. +Proof. +have /(congr1 (fun x => -%R @` x)) := itv_bnd_infty_bigcup (~~ b) (- x). +rewrite opp_itv_bnd_infty negbK opprK => ->; rewrite image_bigcup. +apply eq_bigcupr => k _; apply/seteqP; split=> [_ /= -[r rbxk <-]|y/= yxkb]. + by rewrite oppr_itv/= opprB addrC. +by exists (- y); [rewrite oppr_itv/= negbK opprD opprK|rewrite opprK]. +Qed. + +Lemma bigcup_itvT {R : realType} b : + \bigcup_i [set` Interval (BSide b (- i%:R)) (BRight i%:R)] = [set: R]. +Proof. +rewrite -subTset => x _ /=; exists `|(floor `|x| + 1)%R|%N => //=. +rewrite in_itv/= !natr_absz intr_norm intrD. +have : `|x| < `|(floor `|x|)%:~R + 1|. + by rewrite [ltRHS]ger0_norm ?lt_succ_floor// addr_ge0// ler0z floor_ge0. +case: b => /=. +- by move/ltW; rewrite ler_norml => /andP[-> ->]. +- by rewrite ltr_norml => /andP[-> /ltW->]. +Qed. diff --git a/theories/realfun.v b/theories/realfun.v index 387d4c684..e4502e512 100644 --- a/theories/realfun.v +++ b/theories/realfun.v @@ -1,15 +1,45 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum finmap. From mathcomp Require Import matrix interval zmodp vector fieldext falgebra. -From mathcomp.classical Require Import boolp classical_sets. -From mathcomp.classical Require Import functions cardinality mathcomp_extra. -Require Import ereal reals signed topology prodnormedzmodule. -Require Import normedtype derive real_interval. +From mathcomp Require Import mathcomp_extra boolp classical_sets functions. +From mathcomp Require Import cardinality. +Require Import ereal reals signed topology prodnormedzmodule normedtype derive. +Require Import sequences real_interval. From HB Require Import structures. -(******************************************************************************) +(**md**************************************************************************) +(* # Real-valued functions over reals *) +(* *) (* This file provides properties of standard real-valued functions over real *) (* numbers (e.g., the continuity of the inverse of a continuous function). *) +(* *) +(* ``` *) +(* nondecreasing_fun f == the function f is non-decreasing *) +(* nonincreasing_fun f == the function f is non-increasing *) +(* increasing_fun f == the function f is (strictly) increasing *) +(* decreasing_fun f == the function f is (strictly) decreasing *) +(* *) +(* derivable_oo_continuous_bnd f x y == f is derivable on `]x, y[ and *) +(* continuous up to the boundary *) +(* *) +(* itv_partition a b s == s is a partition of the interval `[a, b] *) +(* itv_partitionL s c == the left side of splitting a partition at c *) +(* itv_partitionR s c == the right side of splitting a partition at c *) +(* variation a b f s == the sum of f at all points in the partition s *) +(* variations a b f == the set of all variations of f between a and b *) +(* bounded_variation a b f == all variations of f are bounded *) +(* total_variation a b f == the sup over all variations of f from a to b *) +(* neg_tv a f x == the decreasing component of f *) +(* pos_tv a f x == the increasing component of f *) +(* *) +(* ``` *) +(* *) +(* * Limit superior and inferior for functions: *) +(* ``` *) +(* lime_sup f a/lime_inf f a == limit sup/inferior of the extended real- *) +(* valued function f at point a *) +(* ``` *) +(* *) (******************************************************************************) Set Implicit Arguments. @@ -24,14 +54,943 @@ Local Open Scope ring_scope. Import numFieldNormedType.Exports. +Notation "'nondecreasing_fun' f" := ({homo f : n m / (n <= m)%O >-> (n <= m)%O}) + (at level 10). +Notation "'nonincreasing_fun' f" := ({homo f : n m / (n <= m)%O >-> (n >= m)%O}) + (at level 10). +Notation "'increasing_fun' f" := ({mono f : n m / (n <= m)%O >-> (n <= m)%O}) + (at level 10). +Notation "'decreasing_fun' f" := ({mono f : n m / (n <= m)%O >-> (n >= m)%O}) + (at level 10). + +Lemma nondecreasing_funN {R : realType} a b (f : R -> R) : + {in `[a, b] &, nondecreasing_fun f} <-> + {in `[a, b] &, nonincreasing_fun (\- f)}. +Proof. +split=> [h m n mab nab mn|h m n mab nab mn]; first by rewrite lerNr opprK h. +by rewrite -(opprK (f n)) -lerNr h. +Qed. + +Lemma nonincreasing_funN {R : realType} a b (f : R -> R) : + {in `[a, b] &, nonincreasing_fun f} <-> + {in `[a, b] &, nondecreasing_fun (\- f)}. +Proof. +apply: iff_sym; apply: (iff_trans (nondecreasing_funN a b (\- f))). +rewrite [in X in _ <-> X](_ : f = \- (\- f))//. +by apply/funext => x /=; rewrite opprK. +Qed. + +Section fun_cvg. + +Section fun_cvg_realFieldType. +Context {R : realFieldType}. + +(* NB: see cvg_addnl in topology.v *) +Lemma cvg_addrl (M : R) : M + r @[r --> +oo] --> +oo. +Proof. +move=> P [r [rreal rP]]; exists (r - M); split. + by rewrite realB// num_real. +by move=> m; rewrite ltrBlDl => /rP. +Qed. + +(* NB: see cvg_addnr in topology.v *) +Lemma cvg_addrr (M : R) : (r + M) @[r --> +oo] --> +oo. +Proof. by under [X in X @ _]funext => n do rewrite addrC; exact: cvg_addrl. Qed. + +(* NB: see cvg_centern in sequences.v *) +Lemma cvg_centerr (M : R) (T : topologicalType) (f : R -> T) (l : T) : + (f (n - M) @[n --> +oo] --> l) = (f r @[r --> +oo] --> l). +Proof. +rewrite propeqE; split; last by apply: cvg_comp; exact: cvg_addrr. +gen have cD : f l / f r @[r --> +oo] --> l -> f (n + M) @[n --> +oo] --> l. + by apply: cvg_comp; exact: cvg_addrr. +move=> /cD /=. +by under [X in X @ _ --> l]funext => n do rewrite addrK. +Qed. + +(* NB: see cvg_shiftn in sequence.v *) +Lemma cvg_shiftr (M : R) (T : topologicalType) (f : R -> T) (l : T) : + (f (n + M) @[n --> +oo]--> l) = (f r @[r --> +oo] --> l). +Proof. +rewrite propeqE; split; last by apply: cvg_comp; exact: cvg_addrr. +rewrite -[X in X -> _](cvg_centerr M); apply: cvg_trans => /=. +apply: near_eq_cvg; near do rewrite subrK; exists M. +by rewrite num_real. +Unshelve. all: by end_near. Qed. + +Lemma left_right_continuousP {T : topologicalType} (f : R -> T) x : + f @ x^'- --> f x /\ f @ x^'+ --> f x <-> f @ x --> f x. +Proof. +split; last by move=> cts; split; exact: cvg_within_filter. +move=> [+ +] U /= Uz => /(_ U Uz) + /(_ U Uz); near_simpl. +rewrite !near_withinE => lf rf; apply: filter_app lf; apply: filter_app rf. +near=> t => xlt xgt; have := @real_leVge R x t; rewrite !num_real. +move=> /(_ isT isT) /orP; rewrite !le_eqVlt => -[|] /predU1P[|//]. +- by move=> <-; exact: nbhs_singleton. +- by move=> ->; exact: nbhs_singleton. +Unshelve. all: by end_near. Qed. + +Lemma cvg_at_right_left_dnbhs (f : R -> R) (p : R) (l : R) : + f x @[x --> p^'+] --> l -> f x @[x --> p^'-] --> l -> + f x @[x --> p^'] --> l. +Proof. +move=> /cvgrPdist_le fppl /cvgrPdist_le fpnl; apply/cvgrPdist_le => e e0. +have {fppl}[a /= a0 fppl] := fppl _ e0; have {fpnl}[b /= b0 fpnl] := fpnl _ e0. +near=> t. +have : t != p by near: t; exact: nbhs_dnbhs_neq. +rewrite neq_lt => /orP[tp|pt]. +- apply: fpnl => //=; near: t. + exists (b / 2) => //=; first by rewrite divr_gt0. + move=> z/= + _ => /lt_le_trans; apply. + by rewrite ler_pdivrMr// ler_pMr// ler1n. +- apply: fppl =>//=; near: t. + exists (a / 2) => //=; first by rewrite divr_gt0. + move=> z/= + _ => /lt_le_trans; apply. + by rewrite ler_pdivrMr// ler_pMr// ler1n. +Unshelve. all: by end_near. Qed. +End fun_cvg_realFieldType. + +Section cvgr_fun_cvg_seq. +Context {R : realType}. + +Lemma cvg_at_rightP (f : R -> R) (p l : R) : + f x @[x --> p^'+] --> l <-> + (forall u : R^nat, (forall n, u n > p) /\ (u n @[n --> \oo] --> p) -> + f (u n) @[n --> \oo] --> l). +Proof. +split=> [/cvgrPdist_le fpl u [up /cvgrPdist_lt ucvg]|pfl]. + apply/cvgrPdist_le => e e0. + have [r /= r0 {}fpl] := fpl _ e0; have [s /= s0 {}ucvg] := ucvg _ r0. + near=> t; apply: fpl => //=; apply: ucvg => /=. + by near: t; exists s. +apply: contrapT => fpl; move: pfl; apply/existsNP. +suff: exists2 x : R ^nat, + (forall k, x k > p) /\ x n @[n --> \oo] --> p & ~ f (x n) @[n --> \oo] --> l. + by move=> [x_] h; exists x_; exact/not_implyP. +have [e He] : exists e : {posnum R}, forall d : {posnum R}, + exists xn : R, [/\ xn > p, `|xn - p| < d%:num & `|f xn - l| >= e%:num]. + apply: contrapT; apply: contra_not fpl => /forallNP h. + apply/cvgrPdist_le => e e0; have /existsNP[d] := h (PosNum e0). + move/forallNP => {}h; near=> t. + have /not_and3P[abs|abs|/negP] := h t. + - by exfalso; apply: abs; near: t; exact: nbhs_right_gt. + - exfalso; apply: abs. + by near: t; by exists d%:num => //= z/=; rewrite distrC. + - by rewrite -ltNge distrC => /ltW. +have invn n : 0 < n.+1%:R^-1 :> R by rewrite invr_gt0. +exists (fun n => sval (cid (He (PosNum (invn n))))). + split => [k|]; first by rewrite /sval/=; case: cid => x []. + apply/cvgrPdist_lt => r r0; near=> t. + rewrite /sval/=; case: cid => x [px xpt _]. + rewrite distrC (lt_le_trans xpt)// -(@invrK _ r) lef_pV2 ?posrE ?invr_gt0//. + near: t; exists `|ceil (r^-1)|%N => // s /=. + rewrite -ltnS -(@ltr_nat R) => /ltW; apply: le_trans. + by rewrite natr_absz gtr0_norm ?ceil_gt0 ?invr_gt0// ceil_ge. +move=> /cvgrPdist_lt/(_ e%:num (ltac:(by [])))[] n _ /(_ _ (leqnn _)). +rewrite /sval/=; case: cid => // x [px xpn]. +by rewrite leNgt distrC => /negP. +Unshelve. all: by end_near. Qed. + +Lemma cvg_at_leftP (f : R -> R) (p l : R) : + f x @[x --> p^'-] --> l <-> + (forall u : R^nat, (forall n, u n < p) /\ u n @[n --> \oo] --> p -> + f (u n) @[n --> \oo] --> l). +Proof. +apply: (iff_trans (cvg_at_leftNP f p l)). +apply: (iff_trans (cvg_at_rightP _ _ _)). +split=> [pfl u [pu up]|pfl u [pu up]]. + rewrite -(opprK u); apply: pfl. + by split; [move=> k; rewrite ltrNr opprK//|exact/cvgNP]. +apply: pfl. +by split; [move=> k; rewrite ltrNl//|apply/cvgNP => /=; rewrite opprK]. +Qed. + +End cvgr_fun_cvg_seq. + +Section cvge_fun_cvg_seq. +Context {R : realType}. + +Lemma cvge_at_rightP (f : R -> \bar R) (p l : R) : + f x @[x --> p^'+] --> l%:E <-> + (forall u : R^nat, (forall n, u n > p) /\ u n @[n --> \oo] --> p -> + f (u n) @[n --> \oo] --> l%:E). +Proof. +split=> [/fine_cvgP [ffin_num fpl] u [pu up]|h]. + apply/fine_cvgP; split; last by move/cvg_at_rightP : fpl; exact. + have [e /= e0 {}ffin_num] := ffin_num. + move/cvgrPdist_lt : up => /(_ _ e0)[s /= s0 {}up]; near=> t. + by apply: ffin_num => //=; apply: up => /=; near: t; exists s. +suff H : \forall F \near p^'+, f F \is a fin_num. + by apply/fine_cvgP; split => //; apply/cvg_at_rightP => u /h /fine_cvgP[]. +apply: contrapT => /not_near_at_rightP abs. +have invn n : 0 < n.+1%:R^-1 :> R by rewrite invr_gt0. +pose y_ n := sval (cid2 (abs (PosNum (invn n)))). +have py_ k : p < y_ k by rewrite /y_ /sval/=; case: cid2 => //= x /andP[]. +have y_p : y_ n @[n --> \oo] --> p. + apply/cvgrPdist_lt => e e0; near=> t. + rewrite ltr0_norm// ?subr_lt0// opprB. + rewrite /y_ /sval/=; case: cid2 => //= x /andP[_ + _]. + rewrite ltrBlDr => /lt_le_trans; apply. + rewrite addrC lerD2r -(invrK e) lef_pV2// ?posrE ?invr_gt0//. + near: t. + exists `|ceil e^-1|%N => // k /= ek. + rewrite (le_trans (ceil_ge _))// (@le_trans _ _ `|ceil e^-1|%:~R)//. + by rewrite ger0_norm// ?ceil_ge0// ?invr_ge0// ltW. + by move: ek;rewrite -(leq_add2r 1) !addn1 -(ltr_nat R) => /ltW. +have /fine_cvgP[[m _ mfy_] /= _] := h _ (conj py_ y_p). +near \oo => n. +have mn : (m <= n)%N by near: n; exists m. +have {mn} := mfy_ _ mn. +rewrite /y_ /sval; case: cid2 => /= x _. +Unshelve. all: by end_near. Qed. + +Lemma cvge_at_leftP (f : R -> \bar R) (p l : R) : + f x @[x --> p^'-] --> l%:E <-> + (forall u : R^nat, (forall n, u n < p) /\ u n @[n --> \oo] --> p -> + f (u n) @[n --> \oo] --> l%:E). +Proof. +apply: (iff_trans (cvg_at_leftNP f p l%:E)). +apply: (iff_trans (cvge_at_rightP _ _ l)); split=> h u [up pu]. +- rewrite (_ : u = \- (\- u))%R; last by apply/funext => ?/=; rewrite opprK. + by apply: h; split; [by move=> n; rewrite ltrNl opprK|exact: cvgN]. +- by apply: h; split => [n|]; [rewrite ltrNl|move/cvgN : pu; rewrite opprK]. +Qed. + +End cvge_fun_cvg_seq. + +Section fun_cvg_realType. +Context {R : realType}. +Implicit Types f : R -> R. + +(* NB: see nondecreasing_cvgn in sequences.v *) +Lemma nondecreasing_cvgr f : nondecreasing_fun f -> has_ubound (range f) -> + f r @[r --> +oo] --> sup (range f). +Proof. +move=> ndf ubf; set M := sup (range f). +have supf : has_sup (range f) by split => //; exists (f 0), 0. +apply/cvgrPdist_le => _/posnumP[e]. +have [p Mefp] : exists p, M - e%:num <= f p. + have [_ -[p _] <- /ltW efp] := sup_adherent (gt0 e) supf. + by exists p; rewrite efp. +near=> n; have pn : p <= n by near: n; apply: nbhs_pinfty_ge; rewrite num_real. +rewrite ler_distlC (le_trans Mefp (ndf _ _ _))//= (@le_trans _ _ M) ?lerDl//. +by have /ubP := sup_upper_bound supf; apply; exists n. +Unshelve. all: by end_near. Qed. + +(***md This covers the cases where the interval is + $]a, +\infty[$, $]a, b[$, or $]a, b]$. *) +Lemma nonincreasing_at_right_cvgr f a (b : itv_bound R) : (BRight a < b)%O -> + {in Interval (BRight a) b &, nonincreasing_fun f} -> + has_ubound (f @` [set` Interval (BRight a) b]) -> + f x @[x --> a ^'+] --> sup (f @` [set` Interval (BRight a) b]). +Proof. +move=> ab lef ubf; set M := sup _. +have supf : has_sup [set f x | x in [set` Interval (BRight a) b]]. + split => //; case: b ab {lef ubf M} => [[|] t ta|[]] /=. + - exists (f ((a + t) / 2)), ((a + t) / 2) => //=. + by rewrite in_itv/= !midf_lt. + - exists (f ((a + t) / 2)), ((a + t) / 2) => //=. + by rewrite in_itv/= midf_lt// midf_le// ltW. + - by exists (f (a + 1)), (a + 1). + - by exists (f (a + 1)), (a + 1) => //=; rewrite in_itv/= ltrDl andbT. +apply/cvgrPdist_le => _/posnumP[e]. +have {supf} [p [ap pb]] : + exists p, [/\ a < p, (BLeft p < b)%O & M - e%:num <= f p]. + have [_ -[p apb] <- /ltW efp] := sup_adherent (gt0 e) supf. + move: apb; rewrite /= in_itv/= -[X in _ && X]/(BLeft p < b)%O => /andP[ap pb]. + by exists p; split. +rewrite lerBlDr {}/M. +move: b ab pb lef ubf => [[|] b|[//|]] ab pb lef ubf; set M := sup _ => Mefp. +- near=> r; rewrite ler_distl; apply/andP; split. + + suff: f r <= M by apply: le_trans; rewrite lerBlDr lerDl. + apply: sup_ub => //=; exists r => //; rewrite in_itv/=. + by apply/andP; split; near: r; [exact: nbhs_right_gt|exact: nbhs_right_lt]. + + rewrite (le_trans Mefp)// lerD2r lef//=; last 2 first. + by rewrite in_itv/= ap. + by near: r; exact: nbhs_right_le. + apply/andP; split; near: r; [exact: nbhs_right_gt|exact: nbhs_right_lt]. +- near=> r; rewrite ler_distl; apply/andP; split. + + suff: f r <= M by apply: le_trans; rewrite lerBlDr lerDl. + apply: sup_ub => //=; exists r => //; rewrite in_itv/=. + by apply/andP; split; near: r; [exact: nbhs_right_gt|exact: nbhs_right_le]. + + rewrite (le_trans Mefp)// lerD2r lef//=; last 2 first. + by rewrite in_itv/= ap. + by near: r; exact: nbhs_right_le. + by apply/andP; split; near: r; [exact: nbhs_right_gt|exact: nbhs_right_le]. +- near=> r; rewrite ler_distl; apply/andP; split. + suff: f r <= M by apply: le_trans; rewrite lerBlDr lerDl. + apply: sup_ub => //=; exists r => //; rewrite in_itv/= andbT. + by near: r; apply: nbhs_right_gt. + rewrite (le_trans Mefp)// lerD2r lef//. + - by rewrite in_itv/= andbT; near: r; exact: nbhs_right_gt. + - by rewrite in_itv/= ap. + - by near: r; exact: nbhs_right_le. +Unshelve. all: by end_near. Qed. + +Lemma nonincreasing_at_right_is_cvgr f a : + (\forall x \near a^'+, {in `]a, x[ &, nonincreasing_fun f}) -> + (\forall x \near a^'+, has_ubound (f @` `]a, x[)) -> + cvg (f x @[x --> a ^'+]). +Proof. +move=> nif ubf; apply/cvg_ex; near a^'+ => b. +by eexists; apply: (@nonincreasing_at_right_cvgr _ _ (BLeft b)); + [rewrite bnd_simp|near: b..]. +Unshelve. all: by end_near. Qed. + +Lemma nondecreasing_at_right_cvgr f a (b : itv_bound R) : (BRight a < b)%O -> + {in Interval (BRight a) b &, nondecreasing_fun f} -> + has_lbound (f @` [set` Interval (BRight a) b]) -> + f x @[x --> a ^'+] --> inf (f @` [set` Interval (BRight a) b]). +Proof. +move=> ab nif hlb; set M := inf _. +have ndNf : {in Interval (BRight a) b &, nonincreasing_fun (\- f)}. + by move=> r s rab sab /nif; rewrite lerN2; exact. +have hub : has_ubound [set (\- f) x | x in [set` Interval (BRight a) b]]. + apply/has_ub_lbN; rewrite image_comp/=. + rewrite [X in has_lbound X](_ : _ = f @` [set` Interval (BRight a) b])//. + by apply: eq_imagel => y _ /=; rewrite opprK. +have /cvgN := nonincreasing_at_right_cvgr ab ndNf hub. +rewrite opprK [X in _ --> X -> _](_ : _ = + inf (f @` [set` Interval (BRight a) b]))//. +by rewrite /inf; congr (- sup _); rewrite image_comp/=; exact: eq_imagel. +Qed. + +Lemma nondecreasing_at_right_is_cvgr f a : + (\forall x \near a^'+, {in `]a, x[ &, nondecreasing_fun f}) -> + (\forall x \near a^'+, has_lbound (f @` `]a, x[)) -> + cvg (f x @[x --> a ^'+]). +Proof. +move=> ndf lbf; apply/cvg_ex; near a^'+ => b. +by eexists; apply: (@nondecreasing_at_right_cvgr _ _ (BLeft b)); + [rewrite bnd_simp|near: b..]. +Unshelve. all: by end_near. Qed. + +End fun_cvg_realType. +Arguments nondecreasing_at_right_cvgr {R f a} b. +Arguments nondecreasing_at_right_cvgr {R f a} b. + +Section fun_cvg_ereal. +Context {R : realType}. +Local Open Scope ereal_scope. + +(* NB: see ereal_nondecreasing_cvgn in sequences.v *) +Lemma nondecreasing_cvge (f : R -> \bar R) : + nondecreasing_fun f -> f r @[r --> +oo%R] --> ereal_sup (range f). +Proof. +move=> ndf; set S := range f; set l := ereal_sup S. +have [Spoo|Spoo] := pselect (S +oo). + have [N Nf] : exists N, forall n, (n >= N)%R -> f n = +oo. + case: Spoo => N _ uNoo; exists N => n Nn. + by have := ndf _ _ Nn; rewrite uNoo leye_eq => /eqP. + have -> : l = +oo by rewrite /l /ereal_sup; exact: supremum_pinfty. + rewrite -(cvg_shiftr `|N|); apply: cvg_near_cst. + exists N; split; first by rewrite num_real. + by move=> x /ltW Nx; rewrite Nf// ler_wpDr. +have [lpoo|lpoo] := eqVneq l +oo. + rewrite lpoo; apply/cvgeyPge => M. + have /ereal_sup_gt[_ [n _] <- Mun] : M%:E < l by rewrite lpoo// ltry. + exists n; split; first by rewrite num_real. + by move=> m /= nm; rewrite (le_trans (ltW Mun))// ndf// ltW. +have [fnoo|fnoo] := pselect (f = cst -oo). + rewrite /l (_ : S = [set -oo]). + by rewrite ereal_sup1 fnoo; exact: cvg_cst. + apply/seteqP; split => [_ [n _] <- /[!fnoo]//|_ ->]. + by rewrite /S fnoo; exists 0%R. +have [/ereal_sup_ninfty lnoo|lnoo] := eqVneq l -oo. + by exfalso; apply/fnoo/funext => n; rewrite (lnoo (f n))//; exists n. +have l_fin_num : l \is a fin_num by rewrite fin_numE lpoo lnoo. +set A := [set n | f n = -oo]; set B := [set n | f n != -oo]. +have f_fin_num n : B n -> f n \is a fin_num. + move=> Bn; rewrite fin_numE Bn/=. + by apply: contra_notN Spoo => /eqP unpoo; exists n. +have [x Bx] : B !=set0. + apply/set0P/negP => /eqP B0; apply/fnoo/funext => n. + apply/eqP/negPn/negP => unnoo. + by move/seteqP : B0 => [+ _] => /(_ n); apply. +have xB r : (x <= r)%R -> B r. + move=> /ndf xr; apply/negP => /eqP urnoo. + by move: xr; rewrite urnoo leeNy_eq; exact/negP. +rewrite -(@fineK _ l)//; apply/fine_cvgP; split. + exists x; split; first by rewrite num_real. + by move=> r A1r; rewrite f_fin_num //; exact/xB/ltW. +set g := fun n => if (n < x)%R then fine (f x) else fine (f n). +have <- : sup (range g) = fine l. + apply: EFin_inj; rewrite -ereal_sup_EFin//; last 2 first. + - exists (fine l) => /= _ [m _ <-]; rewrite /g /=. + have [mx|xm] := ltP m x. + by rewrite fine_le// ?f_fin_num//; apply: ereal_sup_ub; exists x. + rewrite fine_le// ?f_fin_num//; first exact/xB. + by apply: ereal_sup_ub; exists m. + - by exists (g 0%R), 0%R. + rewrite fineK//; apply/eqP; rewrite eq_le; apply/andP; split. + apply: le_ereal_sup => _ /= [_ [m _] <-] <-. + rewrite /g; have [_|xm] := ltP m x. + by rewrite fineK// ?f_fin_num//; exists x. + by rewrite fineK// ?f_fin_num//; [exists m|exact/xB]. + apply: ub_ereal_sup => /= _ [m _] <-. + have [mx|xm] := ltP m x. + rewrite (le_trans (ndf _ _ (ltW mx)))//. + apply: ereal_sup_ub => /=; exists (fine (f x)); last first. + by rewrite fineK// f_fin_num. + by exists m => //; rewrite /g mx. + apply: ereal_sup_ub => /=; exists (fine (f m)) => //. + by exists m => //; rewrite /g ltNge xm. + by rewrite fineK ?f_fin_num//; exact: xB. +suff: g x @[x --> +oo%R] --> sup (range g). + apply: cvg_trans; apply: near_eq_cvg; near=> n. + rewrite /g ifF//; apply/negbTE; rewrite -leNgt. + by near: n; apply: nbhs_pinfty_ge; rewrite num_real. +apply: nondecreasing_cvgr. +- move=> m n mn; rewrite /g /=; have [_|xm] := ltP m x. + + have [nx|nx] := ltP n x; first by rewrite fine_le// f_fin_num. + by rewrite fine_le// ?f_fin_num//; [exact: xB|exact: ndf]. + + rewrite ltNge (le_trans xm mn)//= fine_le ?f_fin_num//. + * exact: xB. + * by apply: xB; rewrite (le_trans xm). + * exact/ndf. +- exists (fine l) => /= _ [m _ <-]; rewrite /g /=. + rewrite -lee_fin (fineK l_fin_num); apply: ereal_sup_ub. + have [_|xm] := ltP m x; first by rewrite fineK// ?f_fin_num//; eexists. + by rewrite fineK// ?f_fin_num//; [exists m|exact/xB]. +Unshelve. all: by end_near. Qed. + +(* NB: see ereal_nondecreasing_is_cvgn in sequences.v *) +Lemma nondecreasing_is_cvge (f : R -> \bar R) : + nondecreasing_fun f -> (cvg (f r @[r --> +oo]))%R. +Proof. by move=> u_nd u_ub; apply: cvgP; exact: nondecreasing_cvge. Qed. + +Lemma nondecreasing_at_right_cvge (f : R -> \bar R) a (b : itv_bound R) : + (BRight a < b)%O -> + {in Interval (BRight a) b &, nondecreasing_fun f} -> + f x @[x --> a ^'+] --> ereal_inf (f @` [set` Interval (BRight a) b]). +Proof. +move=> ab ndf; set S := (X in ereal_inf X); set l := ereal_inf S. +have [Snoo|Snoo] := pselect (S -oo). + case: (Snoo) => N/=. + rewrite in_itv/= -[X in _ && X]/(BLeft N < b)%O => /andP[aN Nb] fNpoo. + have Nf n : (a < n <= N)%R -> f n = -oo. + move=> /andP[an nN]; apply/eqP. + rewrite eq_le leNye andbT -fNpoo ndf//. + by rewrite in_itv/= -[X in _ && X]/(BLeft n < b)%O an (le_lt_trans _ Nb). + by rewrite in_itv/= -[X in _ && X]/(BLeft N < b)%O (lt_le_trans an nN). + have -> : l = -oo. + by rewrite /l /ereal_inf /ereal_sup supremum_pinfty//=; exists -oo. + apply: cvg_near_cst; exists (N - a)%R => /=; first by rewrite subr_gt0. + move=> y /= + ay; rewrite ltr0_norm ?subr_lt0// opprB => ayNa. + by rewrite Nf// ay/= -(subrK a y) -lerBrDr ltW. +have [lnoo|lnoo] := eqVneq l -oo. + rewrite lnoo; apply/cvgeNyPle => M. + have /ereal_inf_lt[x [y]]/= : M%:E > l by rewrite lnoo ltNyr. + rewrite in_itv/= -[X in _ && X]/(BLeft y < b)%O/= => /andP[ay yb] <- fyM. + exists (y - a)%R => /=; first by rewrite subr_gt0. + move=> z /= + az. + rewrite ltr0_norm ?subr_lt0// opprB ltrBlDr subrK => zy. + rewrite (le_trans _ (ltW fyM))// ndf ?ltW//. + by rewrite in_itv/= -[X in _ && X]/(BLeft z < b)%O/= az/= (lt_trans _ yb). + by rewrite in_itv/= -[X in _ && X]/(BLeft y < b)%O/= (lt_trans az zy). +have [fpoo|fpoo] := pselect {in Interval (BRight a) b, forall x, f x = +oo}. + rewrite {}/l in lnoo *; rewrite {}/S in Snoo lnoo *. + rewrite [X in ereal_inf X](_ : _ = [set +oo]). + rewrite ereal_inf1; apply/cvgeyPgey; near=> M. + move: b ab {ndf lnoo Snoo} fpoo => [[|] b|[//|]] ab fpoo. + - near=> x; rewrite fpoo ?leey// in_itv/=. + by apply/andP; split; near: x; [exact: nbhs_right_gt|exact: nbhs_right_lt]. + - near=> x; rewrite fpoo ?leey// in_itv/=. + by apply/andP; split; near: x; [exact: nbhs_right_gt|exact: nbhs_right_le]. + - near=> x; rewrite fpoo ?leey// in_itv/= andbT. + by near: x; exact: nbhs_right_gt. + apply/seteqP; split => [_ [n _] <- /[!fpoo]//|_ ->]. + move: b ab ndf lnoo Snoo fpoo => [[|] s|[//|]] ab ndf lnoo Snoo fpoo /=. + - by exists ((a + s) / 2)%R; rewrite ?fpoo// in_itv/= !midf_lt. + - by exists ((a + s) / 2)%R; rewrite ?fpoo// in_itv/= !(midf_lt, midf_le)// ltW. + - by exists (a + 1)%R; rewrite ?fpoo// in_itv/= andbT ltrDl. +have [/ereal_inf_pinfty lpoo|lpoo] := eqVneq l +oo. + by exfalso; apply/fpoo => r rab; rewrite (lpoo (f r))//; exists r. +have l_fin_num : l \is a fin_num by rewrite fin_numE lpoo lnoo. +set A := [set r | [/\ (a < r)%R, (BLeft r < b)%O & f r != +oo]]. +have f_fin_num r : r \in A -> f r \is a fin_num. + rewrite inE /A/= => -[ar rb] frnoo; rewrite fin_numE frnoo andbT. + apply: contra_notN Snoo => /eqP frpoo. + by exists r => //=; rewrite in_itv/= -[X in _ && X]/(BLeft r < b)%O ar rb. +have [x [ax xb fxpoo]] : A !=set0. + apply/set0P/negP => /eqP A0; apply/fpoo => x. + rewrite in_itv/= -[X in _ && X]/(BLeft x < b)%O => /andP[ax xb]. + apply/eqP/negPn/negP => unnoo. + by move/seteqP : A0 => [+ _] => /(_ x); apply; rewrite /A/= ax. +have axA r : (a < r <= x)%R -> r \in A. + move=> /andP[ar rx]; move: (rx) => /ndf rafx; rewrite /A /= inE; split => //. + by rewrite (le_lt_trans _ xb). + apply/negP => /eqP urnoo. + move: rafx; rewrite urnoo. + rewrite in_itv/= -[X in _ && X]/(BLeft r < b)%O ar/=. + rewrite in_itv/= -[X in _ && X]/(BLeft x < b)%O ax/=. + by rewrite leye_eq (negbTE fxpoo) -falseE; apply; rewrite (le_lt_trans _ xb). +rewrite -(@fineK _ l)//; apply/fine_cvgP; split. + exists (x - a)%R => /=; first by rewrite subr_gt0. + move=> z /= + az. + rewrite ltr0_norm ?subr_lt0// opprB ltrBlDr subrK// => zx. + by rewrite f_fin_num// axA// az/= ltW. +set g := fun n => if (a < n < x)%R then fine (f n) else fine (f x). +have <- : inf [set g x | x in [set` Interval (BRight a) b]] = fine l. + apply: EFin_inj; rewrite -ereal_inf_EFin//; last 2 first. + - exists (fine l) => /= _ [m _ <-]; rewrite /g /=. + case: ifPn => [/andP[am mx]|]. + rewrite fine_le// ?f_fin_num//; first by rewrite axA// am (ltW mx). + apply: ereal_inf_lb; exists m => //=. + rewrite in_itv/= -[X in _ && X]/(BLeft m < b)%O am/=. + by rewrite (le_lt_trans _ xb) ?ltW. + rewrite negb_and -!leNgt => /orP[ma|xm]. + rewrite fine_le// ?f_fin_num ?inE//. + apply: ereal_inf_lb; exists x => //=. + by rewrite in_itv/= -[X in _ && X]/(BLeft x < b)%O ax xb. + rewrite fine_le// ?f_fin_num ?inE//. + apply: ereal_inf_lb; exists x => //=. + by rewrite in_itv/= -[X in _ && X]/(BLeft x < b)%O ax xb. + - rewrite {}/l in lnoo lpoo l_fin_num *. + rewrite {}/S in Snoo lnoo lpoo l_fin_num *. + rewrite {}/A in f_fin_num axA *. + move: b ab {xb ndf lnoo lpoo l_fin_num f_fin_num Snoo fpoo axA} => + [[|] s|[//|]] ab /=. + + exists (g ((a + s) / 2))%R, ((a + s) / 2)%R => //=. + by rewrite /= in_itv/= !midf_lt. + + exists (g ((a + s) / 2))%R, ((a + s) / 2)%R => //=. + by rewrite /= in_itv/= !(midf_lt, midf_le)// ltW. + + exists (g (a + 1)%R), (a + 1)%R => //=. + by rewrite in_itv/= andbT ltrDl. + rewrite fineK//; apply/eqP; rewrite eq_le; apply/andP; split; last first. + apply: le_ereal_inf => _ /= [_ [m _] <-] <-. + rewrite /g; case: ifPn => [/andP[am mx]|]. + rewrite fineK// ?f_fin_num//; last by rewrite axA// am ltW. + exists m => //=. + by rewrite in_itv/= -[X in _ && X]/(BLeft m < b)%O am/= (lt_trans _ xb). + rewrite negb_and -!leNgt => /orP[ma|xm]. + rewrite fineK//; last by rewrite f_fin_num ?inE. + exists x => //=. + by rewrite in_itv/= -[X in _ && X]/(BLeft x < b)%O ax xb. + exists x => /=. + by rewrite in_itv/= -[X in _ && X]/(BLeft x < b)%O ax xb. + by rewrite fineK// f_fin_num ?inE. + apply: lb_ereal_inf => /= y [m] /=. + rewrite in_itv/= -[X in _ && X]/(BLeft m < b)%O => /andP[am mb] <-{y}. + have [mx|xm] := ltP m x. + apply: ereal_inf_lb => /=; exists (fine (f m)); last first. + by rewrite fineK// f_fin_num// axA// am (ltW mx). + by exists m; [rewrite in_itv/= am|rewrite /g am mx]. + rewrite (@le_trans _ _ (f x))//; last first. + by apply: ndf => //; rewrite in_itv//= ?ax ?am. + apply: ereal_inf_lb => /=; exists (fine (f x)); last first. + by rewrite fineK// f_fin_num ?inE. + by exists x; [rewrite in_itv/= ax|rewrite /g ltxx andbF]. +suff: g x @[x --> a^'+] --> inf [set g x | x in [set` Interval (BRight a) b]]. + apply: cvg_trans; apply: near_eq_cvg; near=> n. + rewrite /g /=; case: ifPn => [//|]. + rewrite negb_and -!leNgt => /orP[na|xn]. + exfalso. + move: na; rewrite leNgt => /negP; apply. + by near: n; exact: nbhs_right_gt. + suff nx : (n < x)%R by rewrite ltNge xn in nx. + near: n; exists ((x - a) / 2)%R; first by rewrite /= divr_gt0// subr_gt0. + move=> y /= /[swap] ay. + rewrite ltr0_norm// ?subr_lt0// opprB ltrBlDr => /lt_le_trans; apply. + by rewrite -lerBrDr ler_pdivrMr// ler_pMr// ?ler1n// subr_gt0. +apply: nondecreasing_at_right_cvgr => //. +- move=> m n; rewrite !in_itv/= -[X in _ && X]/(BLeft m < b)%O. + rewrite -[X in _ -> _ && X -> _]/(BLeft n < b)%O. + move=> /andP[am mb] /andP[an nb] mn. + rewrite /g /=; case: ifPn => [/andP[_ mx]|]. + rewrite (lt_le_trans am mn) /=; have [nx|nn0] := ltP n x. + rewrite fine_le ?f_fin_num ?ndf//; first by rewrite axA// am (ltW mx). + by rewrite axA// (ltW nx) andbT (lt_le_trans am). + by rewrite in_itv/= am. + by rewrite in_itv/= an. + rewrite fine_le ?f_fin_num//. + + by rewrite axA// am (ltW (lt_le_trans mx _)). + + by rewrite inE. + + rewrite ndf//; last exact/ltW. + by rewrite !in_itv/= am. + by rewrite !in_itv/= ax. + rewrite negb_and -!leNgt => /orP[|xm]; first by rewrite leNgt am. + by rewrite (lt_le_trans am mn)/= ltNge (le_trans xm mn). +- exists (fine l) => /= _ [m _ <-]; rewrite /g /=. + rewrite -lee_fin (fineK l_fin_num); apply: ereal_inf_lb. + case: ifPn => [/andP[am mn0]|]. + rewrite fineK//; last by rewrite f_fin_num// axA// am (ltW mn0). + exists m => //=. + by rewrite in_itv/= -[X in _ && X]/(BLeft m < b)%O am (lt_trans _ xb). + rewrite negb_and -!leNgt => /orP[ma|xm]. + rewrite fineK//; first by exists x => //=; rewrite in_itv/= ax. + by rewrite f_fin_num ?inE. + by rewrite fineK// ?f_fin_num ?inE//; exists x => //=; rewrite in_itv/= ax. +Unshelve. all: by end_near. Qed. + +Lemma nondecreasing_at_right_is_cvge (f : R -> \bar R) (a : R) : + (\forall x \near a^'+, {in `]a, x[ &, nondecreasing_fun f}) -> + cvg (f x @[x --> a ^'+]). +Proof. +move=> ndf; apply/cvg_ex; near a^'+ => b. +by eexists; apply: (@nondecreasing_at_right_cvge _ _ (BLeft b)); + [rewrite bnd_simp|near: b..]. +Unshelve. all: by end_near. Qed. + +Lemma nonincreasing_at_right_cvge (f : R -> \bar R) a (b : itv_bound R) : + (BRight a < b)%O -> {in Interval (BRight a) b &, nonincreasing_fun f} -> + f x @[x --> a ^'+] --> ereal_sup (f @` [set` Interval (BRight a) b]). +Proof. +move=> ab nif; have ndNf : {in Interval (BRight a) b &, + {homo (\- f) : n m / (n <= m)%R >-> n <= m}}. + by move=> r s rab sab /nif; rewrite leeN2; exact. +have /cvgeN := nondecreasing_at_right_cvge ab ndNf. +under eq_fun do rewrite oppeK. +set lhs := (X in _ --> X -> _); set rhs := (X in _ -> _ --> X). +suff : lhs = rhs by move=> ->. +rewrite {}/rhs {}/lhs; rewrite /ereal_inf oppeK; congr ereal_sup. +by rewrite image_comp/=; apply: eq_imagel => x _ /=; rewrite oppeK. +Qed. + +Lemma nonincreasing_at_right_is_cvge (f : R -> \bar R) a : + (\forall x \near a^'+, {in `]a, x[ &, nonincreasing_fun f}) -> + cvg (f x @[x --> a ^'+]). +Proof. +move=> nif; apply/cvg_ex; near a^'+ => b. +by eexists; apply: (@nonincreasing_at_right_cvge _ _ (BLeft b)); + [rewrite bnd_simp|near: b..]. +Unshelve. all: by end_near. Qed. + +End fun_cvg_ereal. + +End fun_cvg. +Arguments nondecreasing_at_right_cvge {R f a} b. +Arguments nondecreasing_at_right_is_cvge {R f a}. +Arguments nonincreasing_at_right_cvge {R f a} b. +Arguments nonincreasing_at_right_is_cvge {R f a}. + +Section lime_sup_inf. +Variable R : realType. +Local Open Scope ereal_scope. +Implicit Types (f g : R -> \bar R) (a r s l : R). + +Definition lime_sup f a : \bar R := limf_esup f a^'. + +Definition lime_inf f a : \bar R := - lime_sup (\- f) a. + +Let sup_ball f a r := ereal_sup [set f x | x in ball a r `\ a]. + +Let sup_ball_le f a r s : (r <= s)%R -> sup_ball f a r <= sup_ball f a s. +Proof. +move=> rs; apply: ub_ereal_sup => /= _ /= [t [rt ta] <-]. +by apply: ereal_sup_ub => /=; exists t => //; split => //; exact: le_ball rt. +Qed. + +Let sup_ball_is_cvg f a : cvg (sup_ball f a e @[e --> 0^'+]). +Proof. +apply: nondecreasing_at_right_is_cvge; near=> e. +by move=> x y; rewrite !in_itv/= => /andP[x0 xe] /andP[y0 ye] /sup_ball_le. +Unshelve. all: by end_near. Qed. + +Let inf_ball f a r := - sup_ball (\- f) a r. + +Let inf_ballE f a r : inf_ball f a r = ereal_inf [set f x | x in ball a r `\ a]. +Proof. +by rewrite /inf_ball /ereal_inf; congr (- _); rewrite /sup_ball -image_comp. +Qed. + +Let inf_ball_le f a r s : (s <= r)%R -> inf_ball f a r <= inf_ball f a s. +Proof. by move=> sr; rewrite /inf_ball lee_oppl oppeK sup_ball_le. Qed. + +Let inf_ball_is_cvg f a : cvg (inf_ball f a e @[e --> 0^'+]). +Proof. +apply: nonincreasing_at_right_is_cvge; near=> e. +by move=> x y; rewrite !in_itv/= => /andP[x0 xe] /andP[y0 ye] /inf_ball_le. +Unshelve. all: by end_near. Qed. + +Let le_sup_ball f g a : + (forall r, (0 < r)%R -> forall y : R, y != a -> ball a r y -> f y <= g y) -> + \forall r \near 0^'+, sup_ball f a r <= sup_ball g a r. +Proof. +move=> fg; near=> r; apply: ub_ereal_sup => /= _ [s [pas /= /eqP ps]] <-. +apply: (@le_trans _ _ (g s)); first exact: (fg r). +by apply: ereal_sup_ub => /=; exists s => //; split => //; exact/eqP. +Unshelve. all: by end_near. Qed. + +Lemma lime_sup_lim f a : lime_sup f a = lim (sup_ball f a e @[e --> 0^'+]). +Proof. +apply/eqP; rewrite eq_le; apply/andP; split. + apply: lime_ge => //; near=> e; apply: ereal_inf_lb => /=. + by exists (ball a e `\ a) => //=; exact: dnbhs_ball. +apply: lb_ereal_inf => /= _ [A [r /= r0 arA] <-]. +apply: lime_le => //; near=> e. +apply: le_ereal_sup => _ [s [ase /eqP sa] <- /=]. +exists s => //; apply: arA => //=; apply: (lt_le_trans ase). +by near: e; exact: nbhs_right_le. +Unshelve. all: by end_near. Qed. + +Lemma lime_inf_lim f a : lime_inf f a = lim (inf_ball f a e @[e --> 0^'+]). +Proof. +rewrite /lime_inf lime_sup_lim -limeN; last exact: sup_ball_is_cvg. +by rewrite /sup_ball; under eq_fun do rewrite -image_comp. +Qed. + +Lemma lime_supE f a : + lime_sup f a = ereal_inf [set sup_ball f a e | e in `]0, +oo[ ]%R. +Proof. +rewrite lime_sup_lim; apply/cvg_lim => //. +apply: nondecreasing_at_right_cvge => //. +by move=> x y; rewrite !in_itv/= !andbT => x0 y0; exact: sup_ball_le. +Qed. + +Lemma lime_infE f a : + lime_inf f a = ereal_sup [set inf_ball f a e | e in `]0, +oo[ ]%R. +Proof. by rewrite /lime_inf lime_supE /ereal_inf oppeK image_comp. Qed. + +Lemma lime_infN f a : lime_inf (\- f) a = - lime_sup f a. +Proof. by rewrite /lime_sup -limf_einfN. Qed. + +Lemma lime_supN f a : lime_sup (\- f) a = - lime_inf f a. +Proof. by rewrite /lime_inf oppeK. Qed. + +Lemma lime_sup_ge0 f a : (forall x, 0 <= f x) -> 0 <= lime_sup f a. +Proof. +move=> f0; rewrite lime_supE; apply: lb_ereal_inf => /= x [e /=]. +rewrite in_itv/= andbT => e0 <-{x}; rewrite -(ereal_sup1 0) ereal_sup_le //=. +exists (f (a + e / 2)%R); last by rewrite ereal_sup1 f0. +exists (a + e / 2)%R => //=; split. + rewrite /ball/= opprD addrA subrr sub0r normrN gtr0_norm ?divr_gt0//. + by rewrite ltr_pdivrMr// ltr_pMr// ltr1n. +by apply/eqP; rewrite gt_eqF// ltr_pwDr// divr_gt0. +Qed. + +Lemma lime_inf_ge0 f a : (forall x, 0 <= f x) -> 0 <= lime_inf f a. +Proof. +move=> f0; rewrite lime_inf_lim; apply: lime_ge; first exact: inf_ball_is_cvg. +near=> b; rewrite inf_ballE. +by apply: lb_ereal_inf => /= _ [r [abr/= ra]] <-; exact: f0. +Unshelve. all: by end_near. Qed. + +Lemma lime_supD f g a : lime_sup f a +? lime_sup g a -> + lime_sup (f \+ g)%E a <= lime_sup f a + lime_sup g a. +Proof. +move=> fg; rewrite !lime_sup_lim -limeD//; last first. + by rewrite -!lime_sup_lim. +apply: lee_lim => //. +- apply: nondecreasing_at_right_is_cvge; near=> e => x y; rewrite !in_itv/=. + by move=> /andP[? ?] /andP[? ?] xy; apply: lee_add => //; exact: sup_ball_le. +- near=> a0; apply: ub_ereal_sup => _ /= [a1 [a1ae a1a]] <-. + by apply: lee_add; apply: ereal_sup_ub => /=; exists a1. +Unshelve. all: by end_near. Qed. + +Lemma lime_sup_le f g a : + (forall r, (0 < r)%R -> forall y, y != a -> ball a r y -> f y <= g y) -> + lime_sup f a <= lime_sup g a. +Proof. +by move=> fg; rewrite !lime_sup_lim; apply: lee_lim => //; exact: le_sup_ball. +Qed. + +Lemma lime_inf_sup f a : lime_inf f a <= lime_sup f a. +Proof. +rewrite lime_inf_lim lime_sup_lim; apply: lee_lim => //. +near=> r. +rewrite ereal_sup_le//. +have ? : exists2 x, ball a r x /\ x <> a & f x = f (a + r / 2)%R. + exists (a + r / 2)%R => //; split. + rewrite /ball/= opprD addrA subrr sub0r normrN gtr0_norm ?divr_gt0//. + by rewrite ltr_pdivrMr// ltr_pMr// ltr1n. + by apply/eqP; rewrite gt_eqF// ltr_pwDr// divr_gt0. +by exists (f (a + r / 2)%R) => //=; rewrite inf_ballE ereal_inf_lb. +Unshelve. all: by end_near. Qed. + +Local Lemma lim_lime_sup' f a (l : R) : + f r @[r --> a] --> l%:E -> lime_sup f a <= l%:E. +Proof. +move=> fpA; apply/lee_addgt0Pr => e e0; rewrite lime_sup_lim. +apply: lime_le => //. +move/fine_cvg : (fpA) => /cvgrPdist_le fpA1. +move/fcvg_is_fine : (fpA); rewrite near_map => -[d d0] fpA2. +have := fpA1 _ e0 => -[q /= q0] H. +near=> x. +apply: ub_ereal_sup => //= _ [y [pry /= yp <-]]. +have ? : f y \is a fin_num. + apply: fpA2. + rewrite /ball_ /= (lt_le_trans pry)//. + by near: x; exact: nbhs_right_le. +rewrite -lee_subel_addl// -(@fineK _ (f y)) // -EFinB lee_fin. +rewrite (le_trans (ler_norm _))// distrC H// /ball_/= ltr_distlC. +move: pry; rewrite /ball/= ltr_distlC => /andP[pay ypa]. +have xq : (x <= q)%R by near: x; exact: nbhs_right_le. +apply/andP; split. + by rewrite (le_lt_trans _ pay)// lerB. +by rewrite (lt_le_trans ypa)// lerD2l. +Unshelve. all: by end_near. +Qed. + +Local Lemma lim_lime_inf' f a (l : R) : + f r @[r --> a] --> l%:E -> l%:E <= lime_inf f a. +Proof. +move=> fpA; apply/lee_subgt0Pr => e e0; rewrite lime_inf_lim. +apply: lime_ge => //. +move/fine_cvg : (fpA) => /cvgrPdist_le fpA1. +move/fcvg_is_fine : (fpA); rewrite near_map => -[d d0] fpA2. +have := fpA1 _ e0 => -[q /= q0] H. +near=> x. +rewrite inf_ballE. +apply: lb_ereal_inf => //= _ [y [pry /= yp <-]]. +have ? : f y \is a fin_num. + apply: fpA2. + rewrite /ball_ /= (lt_le_trans pry)//. + by near: x; exact: nbhs_right_le. +rewrite -(@fineK _ (f y)) // -EFinB lee_fin lerBlDr -lerBlDl. +rewrite (le_trans (ler_norm _))// H// /ball_/= ltr_distlC. +move: pry; rewrite /ball/= ltr_distlC => /andP[pay ypa]. +have xq : (x <= q)%R by near: x; exact: nbhs_right_le. +apply/andP; split. + by rewrite (le_lt_trans _ pay)// lerB. +by rewrite (lt_le_trans ypa)// lerD2l. +Unshelve. all: by end_near. +Qed. + +Lemma lim_lime_inf f a (l : R) : + f r @[r --> a] --> l%:E -> lime_inf f a = l%:E. +Proof. +move=> h; apply/eqP; rewrite eq_le. +by rewrite lim_lime_inf'// andbT (le_trans (lime_inf_sup _ _))// lim_lime_sup'. +Qed. + +Lemma lim_lime_sup f a (l : R) : + f r @[r --> a] --> l%:E -> lime_sup f a = l%:E. +Proof. +move=> h; apply/eqP; rewrite eq_le. +by rewrite lim_lime_sup'//= (le_trans _ (lime_inf_sup _ _))// lim_lime_inf'. +Qed. + +Local Lemma lime_supP f a l : + lime_sup f a = l%:E -> forall e : {posnum R}, exists d : {posnum R}, + forall x, (ball a d%:num `\ a) x -> f x < l%:E + e%:num%:E. +Proof. +rewrite lime_supE => fal. +have H (e : {posnum R}) : + exists d : {posnum R}, l%:E <= sup_ball f a d%:num < l%:E + e%:num%:E. + apply: contrapT => /forallNP H. + have : ereal_inf [set sup_ball f a r | r in `]0%R, +oo[] \is a fin_num. + by rewrite fal. + move=> /lb_ereal_inf_adherent-/(_ e%:num ltac:(by []))[y] /=. + case=> r; rewrite in_itv/= andbT => r0 <-{y}. + rewrite ltNge => /negP; apply. + have /negP := H (PosNum r0). + rewrite negb_and => /orP[|]. + rewrite -ltNge => farl. + have : ereal_inf [set sup_ball f a r | r in `]0%R, +oo[] < l%:E. + rewrite (le_lt_trans _ farl)//; apply: ereal_inf_lb => /=; exists r => //. + by rewrite in_itv/= r0. + by rewrite fal ltxx. + by rewrite -leNgt; apply: le_trans; rewrite lee_add2r// fal. +move=> e; have [d /andP[lfp fpe]] := H e. +exists d => r /= [] prd rp. +by rewrite (le_lt_trans _ fpe)//; apply: ereal_sup_ub => /=; exists r. +Qed. + +Local Lemma lime_infP f a l : + lime_inf f a = l%:E -> forall e : {posnum R}, exists d : {posnum R}, + forall x, (ball a d%:num `\ a) x -> l%:E - e%:num%:E < f x. +Proof. +move=> /(congr1 oppe); rewrite -lime_supN => /lime_supP => H e. +have [d {}H] := H e. +by exists d => r /H; rewrite lte_oppl oppeD// EFinN oppeK. +Qed. + +Lemma lime_sup_inf_at_right f a l : + lime_sup f a = l%:E -> lime_inf f a = l%:E -> f x @[x --> a^'+] --> l%:E. +Proof. +move=> supfpl inffpl; apply/cvge_at_rightP => u [pu up]. +have fu : \forall n \near \oo, f (u n) \is a fin_num. + have [dsup Hdsup] := lime_supP supfpl (PosNum ltr01). + have [dinf Hdinf] := lime_infP inffpl (PosNum ltr01). + near=> n; rewrite fin_numE; apply/andP; split. + apply/eqP => fxnoo. + suff : (ball a dinf%:num `\ a) (u n) by move=> /Hdinf; rewrite fxnoo. + split; last by apply/eqP; rewrite gt_eqF. + by near: n; move/cvgrPdist_lt : up; exact. + apply/eqP => fxnoo. + suff : (ball a dsup%:num `\ a) (u n) by move=> /Hdsup; rewrite fxnoo. + split; last by apply/eqP; rewrite gt_eqF. + by near: n; move/cvgrPdist_lt : up; exact. +apply/fine_cvgP; split => /=; first exact: fu. +apply/cvgrPdist_le => _/posnumP[e]. +have [d1 Hd1] : exists d1 : {posnum R}, + l%:E - e%:num%:E <= ereal_inf [set f x | x in ball a d1%:num `\ a]. + have : l%:E - e%:num%:E < lime_inf f a. + by rewrite inffpl lte_subl_addr// lte_addl. + rewrite lime_infE => /ereal_sup_gt[x /= [r]]; rewrite in_itv/= andbT. + move=> r0 <-{x} H; exists (PosNum r0); rewrite ltW//. + by rewrite -inf_ballE. +have [d2 Hd2] : exists d2 : {posnum R}, + ereal_sup [set f x | x in ball a d2%:num `\ a] <= l%:E + e%:num%:E. + have : lime_sup f a < l%:E + e%:num%:E by rewrite supfpl lte_addl. + rewrite lime_supE => /ereal_inf_lt[x /= [r]]; rewrite in_itv/= andbT. + by move=> r0 <-{x} H; exists (PosNum r0); rewrite ltW. +pose d := minr d1%:num d2%:num. +have d0 : (0 < d)%R by rewrite lt_minr; apply/andP; split => //=. +move/cvgrPdist_lt : up => /(_ _ d0)[m _] {}ucvg. +near=> n. +rewrite /= ler_distlC; apply/andP; split. + rewrite -lee_fin EFinB (le_trans Hd1)//. + rewrite (@le_trans _ _ (ereal_inf [set f x | x in ball a d `\ a]))//. + apply: le_ereal_inf => _/= [r [adr ra] <-]; exists r => //; split => //. + by rewrite /ball/= (lt_le_trans adr)// /d le_minl lexx. + apply: ereal_inf_lb => /=; exists (u n). + split; last by apply/eqP; rewrite eq_sym lt_eqF. + by apply: ucvg => //=; near: n; by exists m. + by rewrite fineK//; by near: n. +rewrite -lee_fin EFinD (le_trans _ Hd2)//. +rewrite (@le_trans _ _ (ereal_sup [set f x | x in ball a d `\ a]))//; last first. + apply: le_ereal_sup => z/= [r [adr rp] <-{z}]; exists r => //; split => //. + by rewrite /ball/= (lt_le_trans adr)// /d le_minl lexx orbT. +apply: ereal_sup_ub => /=; exists (u n). + split; last by apply/eqP; rewrite eq_sym lt_eqF. + by apply: ucvg => //=; near: n; exists m. +by rewrite fineK//; near: n. +Unshelve. all: by end_near. Qed. + +Lemma lime_sup_inf_at_left f a l : + lime_sup f a = l%:E -> lime_inf f a = l%:E -> f x @[x --> a^'-] --> l%:E. +Proof. +move=> supfal inffal; apply/cvg_at_leftNP/lime_sup_inf_at_right. +- by rewrite /lime_sup -limf_esup_dnbhsN. +- by rewrite /lime_inf /lime_sup -(limf_esup_dnbhsN (-%E \o f)) limf_esupN oppeK. +Qed. + +End lime_sup_inf. + +Section derivable_oo_continuous_bnd. +Context {R : numFieldType} {V : normedModType R}. + +Definition derivable_oo_continuous_bnd (f : R -> V) (x y : R) := + [/\ {in `]x, y[, forall x, derivable f x 1}, + f @ x^'+ --> f x & f @ y^'- --> f y]. + +Lemma derivable_oo_continuous_bnd_within (f : R -> V) (x y : R) : + derivable_oo_continuous_bnd f x y -> {within `[x, y], continuous f}. +Proof. +move=> [fxy fxr fyl]; apply/subspace_continuousP => z /=. +rewrite in_itv/= => /andP[]; rewrite le_eqVlt => /predU1P[<-{z} xy|]. + have := cvg_at_right_within fxr; apply: cvg_trans; apply: cvg_app. + by apply: within_subset => z/=; rewrite in_itv/= => /andP[]. +move=> /[swap]. +rewrite le_eqVlt => /predU1P[->{z} xy|zy xz]. + have := cvg_at_left_within fyl; apply: cvg_trans; apply: cvg_app. + by apply: within_subset => z/=; rewrite in_itv/= => /andP[]. +apply: cvg_within_filter. +apply/differentiable_continuous; rewrite -derivable1_diffP. +by apply: fxy; rewrite in_itv/= xz zy. +Qed. + +End derivable_oo_continuous_bnd. + Section real_inverse_functions. Variable R : realType. Implicit Types (a b : R) (f g : R -> R). -(* This lemma should be used with caution. Generally `{within I, continuous f}` +(** This lemma should be used with caution. Generally `{within I, continuous f}` is what one would intend. So having `{in I, continuous f}` as a condition - may indicate potential issues at the endpoints of the interval. -*) + may indicate potential issues at the endpoints of the interval. *) Lemma continuous_subspace_itv (I : interval R) (f : R -> R) : {in I, continuous f} -> {within [set` I], continuous f}. Proof. @@ -95,9 +1054,9 @@ have aux a c b : a \in I -> b \in I -> a < c -> c < b -> have ofC : {within [set` I], continuous (-f)}. move=> ?; apply: continuous_comp; [exact: fC | exact: continuousN]. have ofI : {in I &, injective (-f)} by move=>> ? ? /oppr_inj/fI ->. - rewrite -[X in X < _ -> _](opprK (f b)) ltr_oppl => ofaLofb. + rewrite -[X in X < _ -> _](opprK (f b)) ltrNl => ofaLofb. have := main _ c ofC ofI a b aI bI ofaLofb aLc cLb. - by (do 2 rewrite ltr_oppl opprK); rewrite and_comm. + by (do 2 rewrite ltrNl opprK); rewrite and_comm. split=> [faLfc|fcLfb]. suff L : f a < f b by have [] := main f c fC fI a b aI bI L aLc cLb. by case: ltgtP decr fanfb => // fbfa []//; case: ltgtP faLfc. @@ -129,9 +1088,9 @@ Lemma itv_continuous_inj_ge f (I : interval R) : {in I &, {mono f : x y /~ x <= y}}. Proof. move=> [a [b [aI bI ab fbfa]]] fC fI x y xI yI. -suff : (- f) y <= (- f) x = (y <= x) by rewrite ler_oppl opprK. +suff : (- f) y <= (- f) x = (y <= x) by rewrite lerNl opprK. apply: itv_continuous_inj_le xI => // [|x1 x1I | x1 x2 x1I x2I]. -- by exists a, b; split => //; rewrite ler_oppl opprK. +- by exists a, b; split => //; rewrite lerNl opprK. - by apply/continuousN/fC. by move/oppr_inj; apply/fI. Qed. @@ -173,8 +1132,8 @@ move=> /(_ b a); rewrite !bound_itvE fafb. by move=> /(_ (ltW aLb) (ltW aLb)); rewrite lt_geF. Qed. -(* The condition "f a <= f b" is unnecessary because the last *) -(* interval condition is vacuously true otherwise. *) +(** The condition "f a <= f b" is unnecessary because the last + interval condition is vacuously true otherwise. *) Lemma segment_can_le a b f g : a <= b -> {within `[a, b], continuous f} -> {in `[a, b], cancel f g} -> @@ -196,20 +1155,20 @@ Qed. Section negation_itv. Local Definition itvN_oppr a b := @GRing.opp R. Local Lemma itv_oppr_is_fun a b : - IsFun _ _ `[- b, - a]%classic `[a, b]%classic (itvN_oppr a b). + isFun _ _ `[- b, - a]%classic `[a, b]%classic (itvN_oppr a b). Proof. by split=> x /=; rewrite oppr_itvcc. Qed. HB.instance Definition _ a b := itv_oppr_is_fun a b. End negation_itv. -(* The condition "f b <= f a" is unnecessary---see seg...increasing above *) +(** The condition "f b <= f a" is unnecessary---see seg...increasing above *) Lemma segment_can_ge a b f g : a <= b -> {within `[a, b], continuous f} -> {in `[a, b], cancel f g} -> {in `[f b, f a] &, {mono g : x y /~ x <= y}}. Proof. -move=> aLb fC fK x y xfbfa yfbfa; rewrite -ler_opp2. +move=> aLb fC fK x y xfbfa yfbfa; rewrite -lerN2. apply: (@segment_can_le (- b) (- a) (f \o -%R) (- g)); - rewrite /= ?ler_opp2 ?opprK //. + rewrite /= ?lerN2 ?opprK //. pose fun_neg : subspace `[-b,-a] -> subspace `[a,b] := itvN_oppr a b. move=> z; apply: (@continuous_comp _ _ _ [fun of fun_neg]); last exact: fC. exact/subspaceT_continuous/continuous_subspaceT/opp_continuous. @@ -293,6 +1252,7 @@ have : f a >= f b by rewrite (itvP xfafb). by case: ltrgtP xfafb => // ->. Qed. + Lemma segment_inc_surj_continuous a b f : {in `[a, b] &, {mono f : x y / x <= y}} -> set_surj `[a, b] `[f a, f b] f -> {within `[a, b], continuous f}. @@ -319,41 +1279,41 @@ have fxab : f x \in `[f a, f b] by rewrite in_itv/= !fle. have := xabcc; rewrite in_itv //= => /andP [ax xb]. apply/cvgrPdist_lt => _ /posnumP[e]; rewrite !near_simpl; near=> y. rewrite (@le_lt_trans _ _ (e%:num / 2%:R))//; last first. - by rewrite ltr_pdivr_mulr// ltr_pmulr// ltr1n. + by rewrite ltr_pdivrMr// ltr_pMr// ltr1n. rewrite ler_distlC; near: y. pose u := minr (f x + e%:num / 2) (f b). pose l := maxr (f x - e%:num / 2) (f a). have ufab : u \in `[f a, f b]. rewrite !in_itv /= le_minl ?le_minr lexx ?fle // le_ab orbT ?andbT. - by rewrite ler_paddr // fle. + by rewrite ler_wpDr // fle. have lfab : l \in `[f a, f b]. rewrite !in_itv/= le_maxl ?le_maxr lexx ?fle// le_ab orbT ?andbT. - by rewrite ler_subl_addr ler_paddr// fle // lexx. + by rewrite lerBlDr ler_wpDr// fle // lexx. have guab : g u \in `[a, b]. rewrite !in_itv; apply/andP; split; have := ufab; rewrite in_itv => /andP. - by case; rewrite /= -gle // ?fK // bound_itvE fle. - by case => _; rewrite /= -gle // ?fK // bound_itvE fle. + by case; rewrite /= -[f _ <= _]gle // ?fK // bound_itvE fle. + by case => _; rewrite /= -[_ <= f _]gle // ?fK // bound_itvE fle. have glab : g l \in `[a, b]. rewrite !in_itv; apply/andP; split; have := lfab; rewrite in_itv /= => /andP. - by case; rewrite -gle // ?fK // bound_itvE fle. - by case => _; rewrite -gle // ?fK // bound_itvE fle. + by case; rewrite -[f _ <= _]gle // ?fK // bound_itvE fle. + by case => _; rewrite -[_ <= f _]gle // ?fK // bound_itvE fle. have faltu : f a < u. rewrite /u comparable_lt_minr ?real_comparable ?num_real// flt// aLb andbT. - by rewrite (@le_lt_trans _ _ (f x)) ?fle// ltr_addl. + by rewrite (@le_lt_trans _ _ (f x)) ?fle// ltrDl. have lltfb : l < f b. rewrite /u comparable_lt_maxl ?real_comparable ?num_real// flt// aLb andbT. - by rewrite (@lt_le_trans _ _ (f x)) ?fle// ltr_subl_addr ltr_addl. + by rewrite (@lt_le_trans _ _ (f x)) ?fle// ltrBlDr ltrDl. case: pselect => // _; rewrite near_withinE; near_simpl. have Fnbhs : Filter (nbhs x) by apply: nbhs_filter. have := ax; rewrite le_eqVlt => /orP[/eqP|] {}ax. near=> y => /[dup] yab; rewrite /= in_itv => /andP[ay yb]; apply/andP; split. - by rewrite (@le_trans _ _ (f a)) ?fle// ler_subl_addr ax ler_paddr. + by rewrite (@le_trans _ _ (f a)) ?fle// lerBlDr ax ler_wpDr. apply: ltW; suff : f y < u by rewrite lt_minr => /andP[->]. rewrite -?[f y < _]glt// ?fK//; last by rewrite in_itv /= !fle. by near: y; near_simpl; apply: open_lt; rewrite /= -flt ?gK// -ax. have := xb; rewrite le_eqVlt => /orP[/eqP {}xb {ax}|{}xb]. near=> y => /[dup] yab; rewrite /= in_itv /= => /andP[ay yb]. - apply/andP; split; last by rewrite (@le_trans _ _ (f b)) ?fle// xb ler_paddr. + apply/andP; split; last by rewrite (@le_trans _ _ (f b)) ?fle// xb ler_wpDr. apply: ltW; suff : l < f y by rewrite lt_maxl => /andP[->]. rewrite -?[_ < f y]glt// ?fK//; last by rewrite in_itv /= !fle. by near: y; near_simpl; apply: open_gt; rewrite /= -flt// gK// xb. @@ -364,7 +1324,7 @@ have ? : y \in `[a, b] by apply: subset_itv_oo_cc; near: y; apply: near_in_itv. have fyab : f y \in `[f a, f b] by rewrite in_itv/= !fle// ?ltW. rewrite -[l <= _]gle -?[_ <= u]gle// ?fK //. apply: subset_itv_oo_cc; near: y; apply: near_in_itv; rewrite in_itv /=. -rewrite -[x]fK // !glt//= lt_minr lt_maxl ?andbT ltr_subl_addr ltr_spaddr //. +rewrite -[x]fK // !glt//= lt_minr lt_maxl ?andbT ltrBlDr ltr_pwDr //. by apply/and3P; split; rewrite // flt. Unshelve. all: by end_near. Qed. @@ -377,7 +1337,7 @@ move=> fge f_surj; suff: {within `[a, b], continuous (- f)}. move=> contNf x xab; rewrite -[f]opprK. exact/continuous_comp/opp_continuous/contNf. apply: segment_inc_surj_continuous. - by move=> x y xab yab; rewrite ler_opp2 fge. + by move=> x y xab yab; rewrite lerN2 fge. by move=> y /=; rewrite -oppr_itvcc => /f_surj[x ? /(canLR opprK)<-]; exists x. Qed. @@ -432,7 +1392,7 @@ Lemma near_can_continuousAcan_sym f g (x : R) : {near f x, continuous g} /\ {near f x, cancel g f}. Proof. move=> fK fct; near (0 : R)^'+ => e; have e_gt0 : 0 < e by []. -have xBeLxDe : x - e <= x + e by rewrite ler_add2l gt0_cp. +have xBeLxDe : x - e <= x + e by rewrite lerD2l gt0_cp. have fcte : {in `[x - e, x + e], continuous f}. by near: e; apply/at_right_in_segment. have fwcte : {within `[x - e, x + e], continuous f}. @@ -474,7 +1434,7 @@ Variable R : realType. Lemma exprn_continuous n : continuous (@GRing.exp R ^~ n). Proof. move=> x; elim: n=> [|n /(continuousM cvg_id) ih]; first exact: cst_continuous. -by rewrite exprS; under eq_fun do rewrite exprS; exact: ih. +by rewrite /continuous_at exprS; under eq_fun do rewrite exprS; exact: ih. Qed. Lemma sqr_continuous : continuous (@exprz R ^~ 2). @@ -494,7 +1454,7 @@ move=> x; case: (ltrgtP x 0) => [xlt0 | xgt0 | ->]. apply: (@segment_can_le_continuous _ _ _ (@GRing.exp _^~ _)) => //. by apply: continuous_subspaceT; exact: exprn_continuous. by move=> y y0b; rewrite sqrtr_sqr ger0_norm// (itvP y0b). -- rewrite sqrtr0; apply/cvgr0Pnorm_lt => _ /posnumP[e]; near=> y. +- rewrite /continuous_at sqrtr0; apply/cvgr0Pnorm_lt => _ /posnumP[e]; near=> y. have [ylt0|yge0] := ltrP y 0; first by rewrite ltr0_sqrtr ?normr0. rewrite ger0_norm ?sqrtr_ge0//; have: `|y| < e%:num ^+ 2 by []. by rewrite -ltr_sqrt// ger0_norm// sqrtr_sqr ger0_norm. @@ -506,7 +1466,6 @@ Section is_derive_inverse. Variable R : realType. (* Attempt to prove the diff of inverse *) - Lemma is_derive1_caratheodory (f : R -> R) (x a : R) : is_derive x 1 f a <-> exists g, [/\ forall z, f z - f x = g z * (z - x), @@ -539,7 +1498,7 @@ by near: y; rewrite near_withinE /= near_simpl; near=> x1. Unshelve. all: by end_near. Qed. Lemma is_derive_0_is_cst (f : R -> R) x y : - (forall x, is_derive x 1 f 0) -> f x = f y. + (forall x, is_derive x (1 : R) f 0) -> f x = f y. Proof. move=> Hd. wlog xLy : x y / x <= y by move=> H; case: (leP x y) => [/H |/ltW /H]. @@ -602,3 +1561,866 @@ End is_derive_inverse. #[global] Hint Extern 0 (is_derive _ _ (fun _ => (_ _)^-1) _) => (eapply is_deriveV; first by []) : typeclass_instances. + +Section interval_partition. +Context {R : realType}. +Implicit Type (a b : R) (s : seq R). + +(** a :: s is a partition of the interval [a, b] *) +Definition itv_partition a b s := [/\ path <%R a s & last a s == b]. + +Lemma itv_partition_nil a b : itv_partition a b [::] -> a = b. +Proof. by move=> [_ /eqP <-]. Qed. + +Lemma itv_partition_cons a b x s : + itv_partition a b (x :: s) -> itv_partition x b s. +Proof. by rewrite /itv_partition/= => -[/andP[]]. Qed. + +Lemma itv_partition1 a b : a < b -> itv_partition a b [:: b]. +Proof. by rewrite /itv_partition /= => ->. Qed. + +Lemma itv_partition_size_neq0 a b s : + (size s > 0)%N -> itv_partition a b s -> a < b. +Proof. +elim: s a => // x [_ a _|h t ih a _]; rewrite /itv_partition /=. + by rewrite andbT => -[ax /eqP <-]. +move=> [] /andP[ax /andP[xy] ht /eqP tb]. +by rewrite (lt_trans ax)// ih// /itv_partition /= xy/= tb. +Qed. + +Lemma itv_partitionxx a s : itv_partition a a s -> s = [::]. +Proof. +case: s => //= h t [/= /andP[ah /lt_path_min/allP ht] /eqP hta]. +suff : h < a by move/lt_trans => /(_ _ ah); rewrite ltxx. +apply/ht; rewrite -hta. +by have := mem_last h t; rewrite inE hta lt_eqF. +Qed. + +Lemma itv_partition_le a b s : itv_partition a b s -> a <= b. +Proof. +case: s => [/itv_partition_nil ->//|h t /itv_partition_size_neq0 - /(_ _)/ltW]. +exact. +Qed. + +Lemma itv_partition_cat a b c s t : + itv_partition a b s -> itv_partition b c t -> itv_partition a c (s ++ t). +Proof. +rewrite /itv_partition => -[sa /eqP asb] [bt btc]. +by rewrite cat_path// sa /= last_cat asb. +Qed. + +Lemma itv_partition_nth_size def a b s : itv_partition a b s -> + nth def (a :: s) (size s) = b. +Proof. +by elim: s a => [a/= /itv_partition_nil//|y t ih a /= /itv_partition_cons/ih]. +Qed. + +Lemma itv_partition_nth_ge a b s m : (m < (size s).+1)%N -> + itv_partition a b s -> a <= nth b (a :: s) m. +Proof. +elim: m s a b => [s a b _//|n ih [//|h t] a b]. +rewrite ltnS => nh [/= /andP[ah ht] lb]. +by rewrite (le_trans (ltW ah))// ih. +Qed. + +Lemma itv_partition_nth_le a b s m : (m < (size s).+1)%N -> + itv_partition a b s -> nth b (a :: s) m <= b. +Proof. +elim: m s a => [s a _|n ih]; first exact: itv_partition_le. +by move=> [//|a h t /= nt] H; rewrite ih//; exact: itv_partition_cons H. +Qed. + +Lemma nondecreasing_fun_itv_partition a b f s : + {in `[a, b] &, nondecreasing_fun f} -> itv_partition a b s -> + let F : nat -> R := f \o nth b (a :: s) in + forall k, (k < size s)%N -> F k <= F k.+1. +Proof. +move=> ndf abs F k ks. +have [_] := nondecreasing_seqP F; apply => m n mn; rewrite /F/=. +have [ms|ms] := ltnP m (size s).+1; last first. + rewrite nth_default//. + have [|ns] := ltnP n (size s).+1; last by rewrite nth_default. + by move=> /(leq_ltn_trans mn); rewrite ltnS leqNgt ms. +have [ns|ns] := ltnP n (size s).+1; last first. + rewrite [in leRHS]nth_default//=; apply/ndf/itv_partition_nth_le => //. + by rewrite in_itv/= itv_partition_nth_le// andbT itv_partition_nth_ge. + by rewrite in_itv/= lexx andbT; exact: (itv_partition_le abs). +move: abs; rewrite /itv_partition => -[] sa sab. +move: mn; rewrite leq_eqVlt => /predU1P[->//|mn]. +apply/ndf/ltW/sorted_ltn_nth => //=; last exact: lt_trans. + by rewrite in_itv/= itv_partition_nth_le// andbT itv_partition_nth_ge. +by rewrite in_itv/= itv_partition_nth_le// andbT itv_partition_nth_ge. +Qed. + +Lemma nonincreasing_fun_itv_partition a b f s : + {in `[a, b] &, nonincreasing_fun f} -> itv_partition a b s -> + let F : nat -> R := f \o nth b (a :: s) in + forall k, (k < size s)%N -> F k.+1 <= F k. +Proof. +move/nonincreasing_funN => ndNf abs F k ks; rewrite -(opprK (F k)) ler_oppr. +exact: (nondecreasing_fun_itv_partition ndNf abs). +Qed. + +(** given a partition of [a, b] and c, returns a partition of [a, c] *) +Definition itv_partitionL s c := rcons [seq x <- s | x < c] c. + +Lemma itv_partitionLP a b c s : a < c -> c < b -> itv_partition a b s -> + itv_partition a c (itv_partitionL s c). +Proof. +move=> ac bc [] al /eqP htb; split. + rewrite /itv_partitionL rcons_path/=; apply/andP; split. + by apply: path_filter => //; exact: lt_trans. + exact: (last_filterP [pred x | x < c]). +by rewrite /itv_partitionL last_rcons. +Qed. + +(** given a partition of [a, b] and c, returns a partition of [c, b] *) +Definition itv_partitionR s c := [seq x <- s | c < x]. + +Lemma itv_partitionRP a b c s : a < c -> c < b -> itv_partition a b s -> + itv_partition c b (itv_partitionR s c). +Proof. +move=> ac cb [] sa /eqP alb; rewrite /itv_partition; split. + move: sa; rewrite lt_path_sortedE => /andP[allas ss]. + rewrite lt_path_sortedE filter_all/=. + by apply: sorted_filter => //; exact: lt_trans. +exact/eqP/(path_lt_last_filter ac). +Qed. + +Lemma in_itv_partition c s : sorted <%R s -> c \in s -> + s = itv_partitionL s c ++ itv_partitionR s c. +Proof. +elim: s c => // h t ih c /= ht. +rewrite inE => /predU1P[->{c}/=|ct]. + rewrite ltxx /itv_partitionL /= ltxx /itv_partitionR/= path_lt_filter0//=. + by rewrite path_lt_filterT. +rewrite /itv_partitionL/=; case: ifPn => [hc|]. + by rewrite ltNge (ltW hc)/= /= [in LHS](ih _ _ ct)//; exact: path_sorted ht. +rewrite -leNgt le_eqVlt => /predU1P[ch|ch]. + by rewrite ch ltxx path_lt_filter0//= /itv_partitionR path_lt_filterT. +move: ht; rewrite lt_path_sortedE => /andP[/allP/(_ _ ct)]. +by move=> /lt_trans-/(_ _ ch); rewrite ltxx. +Qed. + +Lemma notin_itv_partition c s : sorted <%R s -> c \notin s -> + s = [seq x <- s | x < c] ++ itv_partitionR s c. +Proof. +elim: s c => // h t ih c /= ht. +rewrite inE negb_or => /andP[]; rewrite neq_lt => /orP[ch|ch] ct. + rewrite ch ltNge (ltW ch)/= path_lt_filter0/= /itv_partitionR; last first. + exact: path_lt_head ht. + by rewrite path_lt_filterT//; exact: path_lt_head ht. +by rewrite ch/= ltNge (ltW ch)/= -ih//; exact: path_sorted ht. +Qed. + +Lemma itv_partition_rev a b s : itv_partition a b s -> + itv_partition (- b) (- a) (rev (belast (- a) (map -%R s))). +Proof. +move=> [sa /eqP alb]; split. + rewrite (_ : - b = last (- a) (map -%R s)); last by rewrite last_map alb. + rewrite rev_path// path_map. + by apply: sub_path sa => x y xy/=; rewrite ltr_oppr opprK. +case: s sa alb => [_ <-//|h t] /= /andP[ah ht] <-{b}. +by rewrite rev_cons last_rcons. +Qed. + +End interval_partition. + +Section variation. +Context {R : realType}. +Implicit Types (a b : R) (f g : R -> R). + +Definition variation a b f s := let F := f \o nth b (a :: s) in + \sum_(0 <= n < size s) `|F n.+1 - F n|%R. + +Lemma variation_zip a b f s : itv_partition a b s -> + variation a b f s = \sum_(x <- zip s (a :: s)) `|f x.1 - f x.2|. +Proof. +elim: s a b => // [a b|h t ih a b]. + by rewrite /itv_partition /= => -[_ /eqP <-]; rewrite /variation/= !big_nil. +rewrite /itv_partition /variation => -[]/= /andP[ah ht] /eqP htb. +rewrite big_nat_recl//= big_cons/=; congr +%R. +have /ih : itv_partition h b t by split => //; exact/eqP. +by rewrite /variation => ->; rewrite !big_seq; apply/eq_bigr => r rt. +Qed. + +(* NB: not used yet but should allow for "term-by-term" comparisons *) +Lemma variation_prev a b f s : itv_partition a b s -> + variation a b f s = \sum_(x <- s) `|f x - f (prev (locked (a :: s)) x)|. +Proof. +move=> [] sa /eqP asb; rewrite /variation [in LHS]/= (big_nth b) !big_nat. +apply: eq_bigr => i /andP[_ si]; congr (`| _ - f _ |). +rewrite -lock. +rewrite prev_nth inE gt_eqF; last first. + rewrite -[a]/(nth b (a :: s) 0) -[ltRHS]/(nth b (a :: s) i.+1). + exact: lt_sorted_ltn_nth. +rewrite orFb mem_nth// index_uniq//. + by apply: set_nth_default => /=; rewrite ltnS ltnW. +by apply: (sorted_uniq lt_trans) => //; apply: path_sorted sa. +Qed. + +Lemma variation_next a b f s : itv_partition a b s -> + variation a b f s = + \sum_(x <- belast a s) `|f (next (locked (a :: s)) x) - f x|. +Proof. +move=> [] sa /eqP asb; rewrite /variation [in LHS]/= (big_nth b) !big_nat. +rewrite size_belast; apply: eq_bigr => i /andP[_ si]. +congr (`| f _ - f _ |); last first. + by rewrite lastI -cats1 nth_cat size_belast// si. +rewrite -lock next_nth. +rewrite {1}lastI mem_rcons inE mem_nth ?size_belast// orbT. +rewrite lastI -cats1 index_cat mem_nth ?size_belast//. +rewrite index_uniq ?size_belast//. + exact: set_nth_default. +have /lt_sorted_uniq : sorted <%R (a :: s) by []. +by rewrite lastI rcons_uniq => /andP[]. +Qed. + +Lemma variation_nil a b f : variation a b f [::] = 0. +Proof. by rewrite /variation/= big_nil. Qed. + +Lemma variation_ge0 a b f s : 0 <= variation a b f s. +Proof. exact/sumr_ge0. Qed. + +Lemma variationN a b f s : variation a b (\- f) s = variation a b f s. +Proof. +by rewrite /variation; apply: eq_bigr => k _ /=; rewrite -opprD normrN. +Qed. + +Lemma variation_le a b f g s : + variation a b (f \+ g)%R s <= variation a b f s + variation a b g s. +Proof. +rewrite [in leRHS]/variation -big_split/=. +apply: ler_sum => k _; apply: le_trans; last exact: ler_norm_add. +by rewrite /= addrACA addrA opprD addrA. +Qed. + +Lemma nondecreasing_variation a b f s : {in `[a, b] &, nondecreasing_fun f} -> + itv_partition a b s -> variation a b f s = f b - f a. +Proof. +move=> ndf abs; rewrite /variation; set F : nat -> R := f \o nth _ (a :: s). +transitivity (\sum_(0 <= n < size s) (F n.+1 - F n)). + rewrite !big_nat; apply: eq_bigr => k; rewrite leq0n/= => ks. + by rewrite ger0_norm// subr_ge0; exact: nondecreasing_fun_itv_partition. +by rewrite telescope_sumr// /F/= (itv_partition_nth_size _ abs). +Qed. + +Lemma nonincreasing_variation a b f s : {in `[a, b] &, nonincreasing_fun f} -> + itv_partition a b s -> variation a b f s = f a - f b. +Proof. +move=> /nonincreasing_funN ndNf abs; have := nondecreasing_variation ndNf abs. +by rewrite opprK addrC => <-; rewrite variationN. +Qed. + +Lemma variationD a b c f s t : a <= c -> c <= b -> + itv_partition a c s -> itv_partition c b t -> + variation a c f s + variation c b f t = variation a b f (s ++ t). +Proof. +rewrite le_eqVlt => /predU1P[<-{c} cb|ac]. + by move=> /itv_partitionxx ->; rewrite variation_nil add0r. +rewrite le_eqVlt => /predU1P[<-{b}|cb]. + by move=> ? /itv_partitionxx ->; rewrite variation_nil addr0 cats0. +move=> acs cbt; rewrite /variation /= [in RHS]/index_iota subn0 size_cat. +rewrite iotaD add0n big_cat/= -[in X in _ = X + _](subn0 (size s)); congr +%R. + rewrite -/(index_iota 0 (size s)) 2!big_nat. + apply: eq_bigr => k /[!leq0n] /= ks. + rewrite nth_cat ks -cat_cons nth_cat /= ltnS (ltnW ks). + by rewrite !(set_nth_default b c)//= ltnS ltnW. +rewrite -[in RHS](addnK (size s) (size t)). +rewrite -/(index_iota (size s) (size t + size s)). +rewrite -{1}[in RHS](add0n (size s)) big_addn addnK 2!big_nat; apply: eq_bigr. +move=> k /[!leq0n]/= kt. +rewrite nth_cat {1}(addnC k) -ltn_subRL subnn ltn0 addnK. +case: k kt => [t0 /=|k kt]. + rewrite add0n -cat_cons nth_cat/= ltnS leqnn -last_nth. + by case: acs => _ /eqP ->. +rewrite addSnnS (addnC k) -cat_cons nth_cat/= -ltn_subRL subnn ltn0. +by rewrite -(addnC k) addnK. +Qed. + +(* NB: this is the only lemma that uses variation_zip *) +Lemma variation_itv_partitionLR a b c f s : a < c -> c < b -> + itv_partition a b s -> + variation a b f s <= variation a b f (itv_partitionL s c ++ itv_partitionR s c). +Proof. +move=> ac bc abs; have [cl|cl] := boolP (c \in s). + by rewrite -in_itv_partition//; case: abs => /path_sorted. +rewrite /itv_partitionL [in leLHS](notin_itv_partition _ cl)//; last first. + by apply: path_sorted; case: abs => + _; exact. +rewrite -notin_itv_partition//; last first. + by apply: path_sorted; case: abs => /= + _; exact. +rewrite !variation_zip//; last first. + by apply: itv_partition_cat; + [exact: (itv_partitionLP _ bc)|exact: (itv_partitionRP ac)]. +rewrite [in leLHS](notin_itv_partition _ cl); last first. + by apply: path_sorted; case: abs => + _; exact. +set L := [seq x <- s | x < c]. +rewrite -cats1 -catA. +move: L => L. +set B := itv_partitionR s c. +move: B => B. +elim/last_ind : L => [|L0 L1 _]. + rewrite !cat0s /=; case: B => [|B0 B1]. + by rewrite big_nil big_cons/= big_nil addr0. + rewrite !big_cons/= addrA lerD// [leRHS]addrC. + by rewrite (le_trans _ (ler_normD _ _))// addrA subrK. +rewrite -cats1. +rewrite (_ : a :: _ ++ B = (a :: L0) ++ [:: L1] ++ B)//; last first. + by rewrite -!catA -cat_cons. +rewrite zip_cat; last by rewrite cats1 size_rcons. +rewrite (_ : a :: _ ++ _ ++ B = (a :: L0) ++ [:: L1] ++ [:: c] ++ B); last first. + by rewrite -!catA -cat_cons. +rewrite zip_cat; last by rewrite cats1 size_rcons. +rewrite !big_cat lerD//. +case: B => [|B0 B1]. + by rewrite /= big_nil big_cons big_nil addr0. +rewrite -cat1s zip_cat// catA. +rewrite (_ : [:: L1] ++ _ ++ B1 = ([:: L1] ++ [:: c]) ++ [:: B0] ++ B1); last first. + by rewrite catA. +rewrite zip_cat// !big_cat lerD//= !big_cons !big_nil !addr0/= [leRHS]addrC. + by rewrite (le_trans _ (ler_normD _ _))// addrA subrK. +Qed. + +Lemma le_variation a b f s x : variation a b f s <= variation a b f (x :: s). +Proof. +case: s => [|h t]. + by rewrite variation_nil /variation/= big_nat_recl//= big_nil addr0. +rewrite /variation/= !big_nat_recl//= addrA lerD2r. +by rewrite (le_trans _ (ler_normD _ _))// (addrC (f x - _)) addrA subrK. +Qed. + +Lemma variation_opp_rev a b f s : itv_partition a b s -> + variation a b f s = + variation (- b) (- a) (f \o -%R) (rev (belast (- a) (map -%R s))). +Proof. +move=> abl; rewrite belast_map /variation /= [LHS]big_nat_rev/= add0n. +rewrite size_rev size_map size_belast 2!big_nat. +apply: eq_bigr => k; rewrite leq0n /= => ks. +rewrite nth_rev ?size_map ?size_belast// [in RHS]distrC. +rewrite (nth_map a); last first. + by rewrite size_belast ltn_subLR// addSn ltnS leq_addl. +rewrite opprK -rev_rcons nth_rev ?size_rcons ?size_map ?size_belast 1?ltnW//. +rewrite subSn// -map_rcons (nth_map b) ?size_rcons ?size_belast; last first. + by rewrite ltnS ltn_subLR// addSn ltnS leq_addl. +rewrite opprK nth_rcons size_belast -subSn// subSS. +rewrite (ltn_subLR _ (ltnW ks)) if_same. +case: k => [|k] in ks *. + rewrite add0n ltnn subn1 (_ : nth b s _ = b); last first. + case: abl ks => _. + elim/last_ind : s => // h t _; rewrite last_rcons => /eqP -> _. + by rewrite nth_rcons size_rcons ltnn eqxx. + rewrite (_ : nth b (a :: s) _ = nth a (belast a s) (size s).-1)//. + case: abl ks => _. + elim/last_ind : s => // h t _; rewrite last_rcons => /eqP -> _. + rewrite belast_rcons size_rcons/= -rcons_cons nth_rcons/= ltnS leqnn. + exact: set_nth_default. +rewrite addSn ltnS leq_addl//; congr (`| f _ - f _ |). + elim/last_ind : s ks {abl} => // h t _; rewrite size_rcons ltnS => kh. + rewrite belast_rcons nth_rcons subSS ltn_subLR//. + by rewrite addSn ltnS leq_addl// subSn. +elim/last_ind : s ks {abl} => // h t _; rewrite size_rcons ltnS => kh. +rewrite belast_rcons subSS -rcons_cons nth_rcons /= ltn_subLR//. +rewrite addnS ltnS leq_addl; apply: set_nth_default => //. +by rewrite /= ltnS leq_subLR leq_addl. +Qed. + +Lemma variation_rev_opp a b f s : itv_partition (- b) (- a) s -> + variation a b f (rev (belast b (map -%R s))) = + variation (- b) (- a) (f \o -%R) s. +Proof. +move=> abs; rewrite [in RHS]variation_opp_rev ?opprK//. +suff: (f \o -%R) \o -%R = f by move=> ->. +by apply/funext=> ? /=; rewrite opprK. +Qed. + +Lemma variation_subseq a b f (s t : list R) : + itv_partition a b s -> itv_partition a b t -> + subseq s t -> + variation a b f s <= variation a b f t. +Proof. +elim: t s a => [? ? ? /= _ /eqP ->//|a s IH [|x t] w]. + by rewrite variation_nil // variation_ge0. +move=> /[dup] /itv_partition_cons itvxb /[dup] /itv_partition_le wb itvxt. +move=> /[dup] /itv_partition_cons itvas itvws /=. +have ab : a <= b by exact: (itv_partition_le itvas). +have wa : w < a by case: itvws => /= /andP[]. +have waW : w <= a := ltW wa. +case: ifPn => [|] nXA. + move/eqP : nXA itvxt itvxb => -> itvat itvt /= ta. + rewrite -[_ :: t]cat1s -[_ :: s]cat1s. + rewrite -?(@variationD _ _ a)//; [|exact: itv_partition1..]. + by rewrite lerD// IH. +move=> xts; rewrite -[_ :: s]cat1s -(@variationD _ _ a) => //; last first. + exact: itv_partition1. +have [y [s' s'E]] : exists y s', s = y :: s'. + by case: {itvas itvws IH} s xts => // y s' ?; exists y, s'. +apply: (@le_trans _ _ (variation w b f s)). + rewrite IH//. + case: itvws => /= /andP[_]; rewrite s'E /= => /andP[ay ys' lyb]. + by split => //; rewrite (path_lt_head wa)//= ys' andbT. +by rewrite variationD //; [exact: le_variation | exact: itv_partition1]. +Qed. + +End variation. + +Section bounded_variation. +Context {R : realType}. +Implicit Type (a b : R) (f : R -> R). + +Definition variations a b f := [set variation a b f l | l in itv_partition a b]. + +Lemma variations_variation a b f s : itv_partition a b s -> + variations a b f (variation a b f s). +Proof. by move=> abs; exists s. Qed. + +Lemma variations_neq0 a b f : a < b -> variations a b f !=set0. +Proof. +move=> ab; exists (variation a b f [:: b]); exists [:: b] => //. +exact: itv_partition1. +Qed. + +Lemma variationsN a b f : variations a b (\- f) = variations a b f. +Proof. +apply/seteqP; split => [_ [s abs] <-|r [s abs]]. + by rewrite variationN; exact: variations_variation. +by rewrite -variationN => <-; exact: variations_variation. +Qed. + +Lemma variationsxx a f : variations a a f = [set 0]. +Proof. +apply/seteqP; split => [x [_ /itv_partitionxx ->]|x ->]. + by rewrite /variation big_nil => <-. +by exists [::] => //=; rewrite /variation /= big_nil. +Qed. + +Definition bounded_variation a b f := has_ubound (variations a b f). + +Notation BV := bounded_variation. + +Lemma bounded_variationxx a f : BV a a f. +Proof. by exists 0 => r; rewrite variationsxx => ->. Qed. + +Lemma bounded_variationD a b f g : a < b -> + BV a b f -> BV a b g -> BV a b (f \+ g). +Proof. +move=> ab [r abfr] [s abgs]; exists (r + s) => _ [l abl] <-. +apply: le_trans; first exact: variation_le. +rewrite lerD//. +- by apply: abfr; exact: variations_variation. +- by apply: abgs; exact: variations_variation. +Qed. + +Lemma bounded_variationN a b f : BV a b f -> BV a b (\- f). +Proof. by rewrite /bounded_variation variationsN. Qed. + +Lemma bounded_variationl a c b f : a <= c -> c <= b -> BV a b f -> BV a c f. +Proof. +rewrite le_eqVlt => /predU1P[<-{c} ? ?|ac]; first exact: bounded_variationxx. +rewrite le_eqVlt => /predU1P[<-{b}//|cb]. +move=> [x Hx]; exists x => _ [s acs] <-. +rewrite (@le_trans _ _ (variation a b f (rcons s b)))//; last first. + apply/Hx/variations_variation; case: acs => sa /eqP asc. + by rewrite /itv_partition rcons_path last_rcons sa/= asc. +rewrite {2}/variation size_rcons -[leLHS]addr0 big_nat_recr//= lerD//. +rewrite /variation !big_nat ler_sum// => k; rewrite leq0n /= => ks. +rewrite nth_rcons// ks -cats1 -cat_cons nth_cat /= ltnS (ltnW ks). +by rewrite ![in leRHS](set_nth_default c)//= ltnS ltnW. +Qed. + +Lemma bounded_variationr a c b f : a <= c -> c <= b -> BV a b f -> BV c b f. +Proof. +rewrite le_eqVlt => /predU1P[<-{c}//|ac]. +rewrite le_eqVlt => /predU1P[<-{b} ?|cb]; first exact: bounded_variationxx. +move=> [x Hx]; exists x => _ [s cbs] <-. +rewrite (@le_trans _ _ (variation a b f (c :: s)))//; last first. + apply/Hx/variations_variation; case: cbs => cs csb. + by rewrite /itv_partition/= ac/= cs. +by rewrite {2}/variation/= -[leLHS]add0r big_nat_recl//= lerD. +Qed. + +Lemma variations_opp a b f : + variations (- b) (- a) (f \o -%R) = variations a b f. +Proof. +rewrite eqEsubset; split=> [_ [s bas <-]| _ [s abs <-]]. + eexists; last exact: variation_rev_opp. + by move/itv_partition_rev : bas; rewrite !opprK. +eexists; last by exact/esym/variation_opp_rev. +exact: itv_partition_rev abs. +Qed. + +Lemma nondecreasing_bounded_variation a b f : + {in `[a, b] &, {homo f : x y / x <= y}} -> BV a b f. +Proof. +move=> incf; exists (f b - f a) => ? [l pabl <-]; rewrite le_eqVlt. +by rewrite nondecreasing_variation// eqxx. +Qed. + +End bounded_variation. + +Section total_variation. +Context {R : realType}. +Implicit Types (a b : R) (f : R -> R). + +Definition total_variation a b f := + ereal_sup [set x%:E | x in variations a b f]. + +Notation BV := bounded_variation. +Notation TV := total_variation. + +Lemma total_variationxx a f : TV a a f = 0%E. +Proof. by rewrite /total_variation variationsxx image_set1 ereal_sup1. Qed. + +Lemma total_variation_ge a b f : a <= b -> (`|f b - f a|%:E <= TV a b f)%E. +Proof. +rewrite le_eqVlt => /predU1P[<-{b}|ab]. + by rewrite total_variationxx subrr normr0. +apply: ereal_sup_ub => /=; exists (variation a b f [:: b]). + exact/variations_variation/itv_partition1. +by rewrite /variation/= big_nat_recr//= big_nil add0r. +Qed. + +Lemma total_variation_ge0 a b f : a <= b -> (0 <= TV a b f)%E. +Proof. by move=> ab; rewrite (le_trans _ (total_variation_ge _ ab)). Qed. + +Lemma bounded_variationP a b f : a <= b -> BV a b f <-> TV a b f \is a fin_num. +Proof. +rewrite le_eqVlt => /predU1P[<-{b}|ab]. + by rewrite total_variationxx; split => // ?; exact: bounded_variationxx. +rewrite ge0_fin_numE; last exact/total_variation_ge0/ltW. +split=> [abf|]. + by rewrite /total_variation ereal_sup_EFin ?ltry//; exact: variations_neq0. +rewrite /total_variation /bounded_variation ltey => /eqP; apply: contra_notP. +by move/hasNub_ereal_sup; apply; exact: variations_neq0. +Qed. + +Lemma nondecreasing_total_variation a b f : a <= b -> + {in `[a, b] &, nondecreasing_fun f} -> TV a b f = (f b - f a)%:E. +Proof. +rewrite le_eqVlt => /predU1P[<-{b} ?|ab ndf]. + by rewrite total_variationxx subrr. +rewrite /total_variation [X in ereal_sup X](_ : _ = [set (f b - f a)%:E]). + by rewrite ereal_sup1. +apply/seteqP; split => [x/= [s [t abt <-{s} <-{x}]]|x/= ->{x}]. + by rewrite nondecreasing_variation. +exists (variation a b f [:: b]) => //. + exact/variations_variation/itv_partition1. +by rewrite nondecreasing_variation//; exact: itv_partition1. +Qed. + +Lemma total_variationN a b f : TV a b (\- f) = TV a b f. +Proof. by rewrite /TV; rewrite variationsN. Qed. + +Lemma total_variation_le a b f g : a <= b -> + (TV a b (f \+ g)%R <= TV a b f + TV a b g)%E. +Proof. +rewrite le_eqVlt => /predU1P[<-{b}|ab]. + by rewrite !total_variationxx adde0. +have [abf|abf] := pselect (BV a b f); last first. + rewrite {2}/total_variation hasNub_ereal_sup//; last first. + exact: variations_neq0. + rewrite addye ?leey// -ltNye (@lt_le_trans _ _ 0%E)//. + exact/total_variation_ge0/ltW. +have [abg|abg] := pselect (BV a b g); last first. + rewrite {3}/total_variation hasNub_ereal_sup//; last first. + exact: variations_neq0. + rewrite addey ?leey// -ltNye (@lt_le_trans _ _ 0%E)//. + exact/total_variation_ge0/ltW. +move: abf abg => [r abfr] [s abgs]. +have BVabfg : BV a b (f \+ g). + by apply: bounded_variationD => //; [exists r|exists s]. +apply: ub_ereal_sup => y /= [r' [s' abs <-{r'} <-{y}]]. +apply: (@le_trans _ _ (variation a b f s' + variation a b g s')%:E). + exact: variation_le. +by rewrite EFinD lee_add// ereal_sup_le//; + (eexists; last exact: lexx); (eexists; last reflexivity); + exact: variations_variation. +Qed. + +Let total_variationD1 a b c f : a <= c -> c <= b -> + (TV a b f >= TV a c f + TV c b f)%E. +Proof. +rewrite le_eqVlt=> /predU1P[<-{c}|ac]; first by rewrite total_variationxx add0e. +rewrite le_eqVlt=> /predU1P[<-{b}|cb]; first by rewrite total_variationxx adde0. +have [abf|abf] := pselect (BV a b f); last first. + rewrite {3}/total_variation hasNub_ereal_sup ?leey//. + by apply: variations_neq0 => //; rewrite (lt_trans ac). +have H s t : itv_partition a c s -> itv_partition c b t -> + (TV a b f >= (variation a c f s)%:E + (variation c b f t)%:E)%E. + move=> acs cbt; rewrite -EFinD; apply: ereal_sup_le. + exists (variation a b f (s ++ t))%:E. + eexists; last reflexivity. + by exists (s ++ t) => //; exact: itv_partition_cat acs cbt. + by rewrite variationD// ltW. +rewrite [leRHS]ereal_sup_EFin//; last first. + by apply: variations_neq0; rewrite (lt_trans ac). +have acf : BV a c f := bounded_variationl (ltW ac) (ltW cb) abf. +have cbf : BV c b f := bounded_variationr (ltW ac) (ltW cb) abf. +rewrite {1 2}/total_variation ereal_sup_EFin//; last exact: variations_neq0. +rewrite ereal_sup_EFin//; last exact: variations_neq0. +rewrite -EFinD -sup_sumE; last 2 first. + by split => //; exact: variations_neq0. + by split => //; exact: variations_neq0. +apply: le_sup. +- move=> r/= [s [l' acl' <-{s}]] [t [l cbl] <-{t} <-{r}]. + exists (variation a b f (l' ++ l)); split; last by rewrite variationD// ltW. + exact/variations_variation/(itv_partition_cat acl' cbl). +- have [r acfr] := variations_neq0 f ac. + have [s cbfs] := variations_neq0 f cb. + by exists (r + s); exists r => //; exists s. +- by split => //; apply: variations_neq0; rewrite (lt_trans ac). +Qed. + +Let total_variationD2 a b c f : a <= c -> c <= b -> + (TV a b f <= TV a c f + TV c b f)%E. +Proof. +rewrite le_eqVlt => /predU1P[<-{c}|ac]; first by rewrite total_variationxx add0e. +rewrite le_eqVlt => /predU1P[<-{b}|cb]; first by rewrite total_variationxx adde0. +case : (pselect (bounded_variation a c f)); first last. + move=> nbdac; have /eqP -> : TV a c f == +oo%E. + have: (-oo < TV a c f)%E by apply: (lt_le_trans _ (total_variation_ge0 f (ltW ac))). + by rewrite ltNye_eq => /orP [] => // /bounded_variationP => /(_ (ltW ac)). + by rewrite addye ?leey // -ltNye (@lt_le_trans _ _ 0)%E // ?total_variation_ge0 // ltW. +case : (pselect (bounded_variation c b f)); first last. + move=> nbdac; have /eqP -> : TV c b f == +oo%E. + have: (-oo < TV c b f)%E. + exact: (lt_le_trans _ (total_variation_ge0 f (ltW cb))). + by rewrite ltNye_eq => /orP [] => // /bounded_variationP => /(_ (ltW cb)). + rewrite addey ?leey // -ltNye (@lt_le_trans _ _ 0%E)//. + exact/total_variation_ge0/ltW. +move=> bdAB bdAC. +rewrite /total_variation [x in (x + _)%E]ereal_sup_EFin //; last first. + exact: variations_neq0. +rewrite [x in (_ + x)%E]ereal_sup_EFin //; last exact: variations_neq0. +rewrite -EFinD -sup_sumE /has_sup; [|(by split => //; exact: variations_neq0)..]. +apply: ub_ereal_sup => ? [? [l pacl <- <-]]; rewrite lee_fin. +apply: (le_trans (variation_itv_partitionLR _ ac _ _)) => //. +apply: sup_ub => /=. + case: bdAB => M ubdM; case: bdAC => N ubdN; exists (N + M). + move=> q [?] [i pabi <-] [? [j pbcj <-]] <-. + by apply: lerD; [apply: ubdN;exists i|apply:ubdM;exists j]. +exists (variation a c f (itv_partitionL l c)). + by apply: variations_variation; exact: itv_partitionLP pacl. +exists (variation c b f (itv_partitionR l c)). + by apply: variations_variation; exact: itv_partitionRP pacl. +by rewrite variationD// ?ltW//; + [exact: itv_partitionLP pacl|exact: itv_partitionRP pacl]. +Qed. + +Lemma total_variationD a b c f : a <= c -> c <= b -> + (TV a b f = TV a c f + TV c b f)%E. +Proof. +by move=> ac cb; apply/eqP; rewrite eq_le; apply/andP; split; + [exact: total_variationD2|exact: total_variationD1]. +Qed. + +End total_variation. + +Section variation_continuity. +Context {R : realType}. +Implicit Type f : R -> R. + +Notation BV := bounded_variation. +Notation TV := total_variation. + +Definition neg_tv a f (x : R) : \bar R := ((TV a x f - (f x)%:E) * 2^-1%:E)%E. + +Definition pos_tv a f (x : R) : \bar R := neg_tv a (\- f) x. + +Lemma neg_tv_nondecreasing a b f : + {in `[a, b] &, nondecreasing_fun (neg_tv a f)}. +Proof. +move=> x y xab yab xy; have ax : a <= x. + by move: xab; rewrite in_itv //= => /andP []. +rewrite /neg_tv lee_pmul2r // lee_subr_addl // addeCA -EFinB. +rewrite [TV a y _](total_variationD _ ax xy) //. +apply: lee_add => //; apply: le_trans; last exact: total_variation_ge. +by rewrite lee_fin ler_norm. +Qed. + +Lemma bounded_variation_pos_neg_tvE a b f : BV a b f -> + {in `[a, b], f =1 (fine \o pos_tv a f) \- (fine \o neg_tv a f)}. +Proof. +move=> bdabf x; rewrite in_itv /= => /andP [ax xb]. +have ffin: TV a x f \is a fin_num. + apply/bounded_variationP => //. + exact: (bounded_variationl _ xb). +have Nffin : TV a x (\- f) \is a fin_num. + apply/bounded_variationP => //; apply/bounded_variationN. + exact: (bounded_variationl ax xb). +rewrite /pos_tv /neg_tv /= total_variationN -fineB -?muleBl // ?fineM //. +- rewrite addeAC oppeD //= ?fin_num_adde_defl //. + by rewrite addeA subee // add0e -EFinD //= opprK mulrDl -Num.Theory.splitr. +- by rewrite fin_numB ?fin_numD ?ffin; apply/andP; split. +- by apply: fin_num_adde_defl; rewrite fin_numN fin_numD; apply/andP; split. +- by rewrite fin_numM // fin_numD; apply/andP; split. +- by rewrite fin_numM // fin_numD; apply/andP; split. +Qed. + +Lemma fine_neg_tv_nondecreasing a b f : BV a b f -> + {in `[a, b] &, nondecreasing_fun (fine \o neg_tv a f)}. +Proof. +move=> bdv p q pab qab pq /=. +move: (pab) (qab); rewrite ?in_itv /= => /andP[ap pb] /andP[aq qb]. +apply: fine_le; rewrite /neg_tv ?fin_numM // ?fin_numB /=. +- apply/andP; split => //; apply/bounded_variationP => //. + exact: (bounded_variationl _ pb). +- apply/andP; split => //; apply/bounded_variationP => //. + exact: (bounded_variationl _ qb). +exact: (neg_tv_nondecreasing _ pab). +Qed. + +Lemma neg_tv_bounded_variation a b f : BV a b f -> BV a b (fine \o neg_tv a f). +Proof. +move=> ?; apply: nondecreasing_bounded_variation. +exact: fine_neg_tv_nondecreasing. +Qed. + +Lemma total_variation_right_continuous a b x f : a <= x -> x < b -> + f @ x^'+ --> f x -> + BV a b f -> + fine \o TV a ^~ f @ x^'+ --> fine (TV a x f). +Proof. +move=> ax xb ctsf bvf; have ? : a <= b by apply:ltW; apply: (le_lt_trans ax). +apply/cvgrPdist_lt=> _/posnumP[eps]. +have ? : Filter (nbhs x^'+) by exact: at_right_proper_filter. +have xbl := ltW xb. +have xbfin : TV x b f \is a fin_num. + by apply/bounded_variationP => //; exact: (bounded_variationr _ _ bvf). +have [//|?] := @ub_ereal_sup_adherent R _ (eps%:num / 2) _ xbfin. +case=> ? [l + <- <-]; rewrite -/(total_variation x b f). +move: l => [|i j]. + by move=> /itv_partition_nil /eqP; rewrite lt_eqF. +move=> [/= /andP[xi ij /eqP ijb]] tv_eps. +apply: filter_app (nbhs_right_ge _). +apply: filter_app (nbhs_right_lt xi). +have e20 : 0 < eps%:num / 2 by []. +move/cvgrPdist_lt/(_ (eps%:num/2) e20) : ctsf; apply: filter_app. +near=> t => fxt ti xt; have ta : a <= t by exact: (le_trans ax). +have tb : t <= b by rewrite (le_trans (ltW ti))// -ijb path_lt_le_last. +rewrite -fineB; last 2 first. + by apply/bounded_variationP => //; exact: bounded_variationl bvf. + by apply/bounded_variationP => //; exact: bounded_variationl bvf. +rewrite (total_variationD _ ax xt). +have tbfin : TV t b f \is a fin_num. + by apply/bounded_variationP => //; exact: (@bounded_variationr _ a). +have xtfin : TV x t f \is a fin_num. + apply/bounded_variationP => //; apply: (@bounded_variationl _ _ _ b) => //. + exact: (@bounded_variationr _ a). +rewrite oppeD ?fin_num_adde_defl// addeA subee //; first last. + by apply/bounded_variationP => //; exact: (@bounded_variationl _ _ _ b). +rewrite sub0e fineN normrN ger0_norm; last first. + by rewrite fine_ge0// total_variation_ge0. +move: (tv_eps); rewrite (total_variationD f _ tb) //. +move: xt; rewrite le_eqVlt => /predU1P[->|xt]. + by rewrite total_variationxx/=. +have : variation x b f (i :: j) <= variation x t f (t :: nil) + + variation t b f (i :: j). + rewrite variationD//; last 2 first. + exact: itv_partition1. + by rewrite /itv_partition/= ti ij ijb. + exact: le_variation. +rewrite -lee_fin => /lt_le_trans /[apply]. +rewrite {1}variation_prev; last exact: itv_partition1. +rewrite /= -addeA -lte_subr_addr; last by rewrite fin_numD; apply/andP. +rewrite EFinD -lte_fin ?fineK // oppeD //= ?fin_num_adde_defl // opprK addeA. +move/lt_trans; apply. +rewrite [x in (_ < x%:E)%E]Num.Theory.splitr EFinD addeC lte_add2lE //. +rewrite -addeA. +apply: (@le_lt_trans _ _ (variation x t f (t :: nil))%:E). + rewrite [in leRHS]variation_prev; last exact: itv_partition1. + rewrite gee_addl // sube_le0; apply: ereal_sup_ub => /=. + exists (variation t b f (i :: j)) => //; apply: variations_variation. + by rewrite /itv_partition/= ijb ij ti. +by rewrite /variation/= big_nat_recr//= big_nil add0r distrC lte_fin. +Unshelve. all: by end_near. Qed. + +Lemma neg_tv_right_continuous a x b f : a <= x -> x < b -> + BV a b f -> + f @ x^'+ --> f x -> + fine \o neg_tv a f @ x^'+ --> fine (neg_tv a f x). +Proof. +move=> ax ? bvf fcts; have xb : x <= b by exact: ltW. +have xbfin : TV a x f \is a fin_num. + by apply/bounded_variationP => //; exact: bounded_variationl bvf. +apply: fine_cvg; rewrite /neg_tv fineM // ?fin_numB ?xbfin //= EFinM. +under eq_fun => i do rewrite EFinN. +apply: (@cvg_trans _ (((TV a n f - (f n)%:E) * 2^-1%:E)%E @[n --> x^'+])). + exact: cvg_id. +apply: cvgeMr; first by []. +rewrite fineD; [|by []..]. +rewrite EFinB; apply: cvgeB; [by []| |]. + apply/ fine_cvgP; split; first exists (b - x). + - by rewrite /= subr_gt0. + - move=> t /= xtbx xt; have ? : a <= t. + by apply: ltW; apply: (le_lt_trans ax). + apply/bounded_variationP => //. + apply: bounded_variationl bvf => //. + move: xtbx; rewrite distrC ger0_norm ?subr_ge0; last by exact: ltW. + by rewrite ltrBrDr -addrA [-_ + _]addrC subrr addr0 => /ltW. + by apply: total_variation_right_continuous => //; last exact: bvf. +apply: cvg_comp; first exact: fcts. +apply/ fine_cvgP; split; first by near=> t => //. +by have -> : fine \o EFin = id by move=> ?; rewrite funeqE => ? /=. +Unshelve. all: by end_near. Qed. + +Lemma total_variation_opp a b f : TV a b f = TV (- b) (- a) (f \o -%R). +Proof. by rewrite /total_variation variations_opp. Qed. + +Lemma total_variation_left_continuous a b x f : a < x -> x <= b -> + f @ x^'- --> f x -> + BV a b f -> + fine \o TV a ^~ f @ x^'- --> fine (TV a x f). +Proof. +move=> ax xb fNcts bvf. +apply/cvg_at_leftNP; rewrite total_variation_opp. +have bvNf : BV (-b) (-a) (f \o -%R). + by case: bvf => M; rewrite -variations_opp => ?; exists M. +have bx : - b <= - x by rewrite lerNl opprK. +have xa : - x < - a by rewrite ltrNl opprK. +have ? : - x <= - a by exact: ltW. +have ? : Filter (nbhs (-x)^'+) by exact: at_right_proper_filter. +have -> : fine (TV (-x) (-a) (f \o -%R)) = + fine (TV (-b) (-a) (f \o -%R)) - fine (TV (-b) (-x) (f \o -%R)). + apply/eqP; rewrite -subr_eq opprK addrC. + rewrite -fineD; last 2 first. + by apply/bounded_variationP => //; exact: bounded_variationl bvNf. + by apply/bounded_variationP => //; exact: bounded_variationr bvNf. + by rewrite -total_variationD. +have /near_eq_cvg/cvg_trans : {near (- x)^'+, + (fun t => fine (TV (- b) (- a) (f \o -%R)) - fine (TV (- b) t (f \o -%R))) =1 + (fine \o (TV a)^~ f) \o -%R}. + apply: filter_app (nbhs_right_lt xa). + apply: filter_app (nbhs_right_ge _). + near=> t => xt ta; have ? : -b <= t by exact: (le_trans bx). + have ? : t <= -a by exact: ltW. + apply/eqP; rewrite eq_sym -subr_eq opprK addrC. + rewrite /= [TV a _ f]total_variation_opp opprK -fineD; last first. + by apply/bounded_variationP => //; apply: bounded_variationr bvNf. + by apply/bounded_variationP => //; apply: bounded_variationl bvNf. + by rewrite -total_variationD. +apply. +apply: cvgB; first exact: cvg_cst. +apply: (total_variation_right_continuous _ _ _ bvNf). +- by rewrite ler_oppl opprK //. +- by rewrite ltr_oppl opprK //. +by apply/cvg_at_leftNP; rewrite /= opprK. +Unshelve. all: by end_near. Qed. + +Lemma total_variation_continuous a b (f : R -> R) : a < b -> + {within `[a,b], continuous f} -> + BV a b f -> + {within `[a,b], continuous (fine \o TV a ^~ f)}. +Proof. +move=> ab /(@continuous_within_itvP _ _ _ _ ab) [int [l r]] bdf. +apply/continuous_within_itvP; (repeat split) => //. +- move=> x /[dup] xab; rewrite in_itv /= => /andP [ax xb]. + apply/left_right_continuousP; split. + apply: (total_variation_left_continuous _ (ltW xb)) => //. + by have /left_right_continuousP [] := int x xab. + apply: (total_variation_right_continuous _ xb) => //; first exact: ltW. + by have /left_right_continuousP [] := int x xab. +- exact: (total_variation_right_continuous _ ab). +- exact: (total_variation_left_continuous ab). +Qed. + +End variation_continuity. diff --git a/theories/reals.v b/theories/reals.v index 8e303f499..79e403811 100644 --- a/theories/reals.v +++ b/theories/reals.v @@ -5,24 +5,27 @@ (* Copyright (c) - 2016--2018 - Polytechnique *) (* -------------------------------------------------------------------- *) -(******************************************************************************) -(* An axiomatization of real numbers *) +(**md**************************************************************************) +(* # An axiomatization of real numbers $\mathbb{R}$ *) (* *) (* This file provides a classical axiomatization of real numbers as a *) (* discrete real archimedean field with in particular a theory of floor and *) (* ceil. *) (* *) +(* ``` *) (* realType == type of real numbers *) (* sup A == where A : set R with R : realType, the supremum of A when *) (* it exists, 0 otherwise *) (* inf A := - sup (- A) *) +(* ``` *) (* *) (* The mixin corresponding to realType extends an archiFieldType with two *) (* properties: *) -(* - when sup A exists, it is an upper bound of A (lemma sup_upper_bound) *) -(* - when sup A exists, there exists an element x in A such that *) -(* sup A - eps < x for any 0 < eps (lemma sup_adherent) *) +(* - when sup A exists, it is an upper bound of A (lemma sup_upper_bound) *) +(* - when sup A exists, there exists an element x in A such that *) +(* sup A - eps < x for any 0 < eps (lemma sup_adherent) *) (* *) +(* ``` *) (* Rint == the set of real numbers that can be written as z%:~R, *) (* i.e., as an integer *) (* Rtoint r == r when r is an integer, 0 otherwise *) @@ -32,12 +35,13 @@ (* range1 x := [set y |x <= y < x + 1] *) (* Rceil x == the ceil of x as a real number, i.e., - Rfloor (- x) *) (* ceil x := - floor (- x) *) +(* ``` *) (* *) (******************************************************************************) +From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra. -From mathcomp.classical Require Import boolp classical_sets set_interval. -From mathcomp.classical Require Import mathcomp_extra. +From mathcomp Require Import mathcomp_extra boolp classical_sets set_interval. Require Import Setoid. @@ -74,10 +78,10 @@ Lemma has_ubound0 : has_ubound (@set0 R). Proof. by exists 0. Qed. Lemma ubound0 : ubound (@set0 R) = setT. Proof. by rewrite predeqE => r; split => // _. Qed. -Lemma lboundT : lbound (@setT R) = set0. +Lemma lboundT : lbound [set: R] = set0. Proof. rewrite predeqE => r; split => // /(_ (r - 1) Logic.I). -rewrite ler_subr_addl addrC -ler_subr_addl subrr. +rewrite lerBrDl addrC -lerBrDl subrr. by rewrite real_leNgt ?realE ?ler01// ?lexx// ltr01. Qed. @@ -113,166 +117,44 @@ Qed. End has_bound_lemmas. (* -------------------------------------------------------------------- *) -Module Real. -Section Mixin. - -Variable (R : archiFieldType). -Record mixin_of : Type := Mixin { - _ : - forall E : set (Num.ArchimedeanField.sort R), +HB.mixin Record ArchimedeanField_isReal R of Num.ArchimedeanField R := { + sup_upper_bound_subdef : + forall E : set [the archiFieldType of R], has_sup E -> ubound E (supremum 0 E) ; - _ : - forall (E : set (Num.ArchimedeanField.sort R)) (eps : R), 0 < eps -> + sup_adherent_subdef : + forall (E : set [the archiFieldType of R]) (eps : R), 0 < eps -> has_sup E -> exists2 e : R, E e & (supremum 0 E - eps) < e ; }. -End Mixin. +#[short(type=realType)] +HB.structure Definition Real := {R of ArchimedeanField_isReal R + & Num.ArchimedeanField R & Num.RealClosedField R}. -Definition EtaMixin R sup_upper_bound sup_adherent := - let _ := @Mixin R sup_upper_bound sup_adherent in - @Mixin (Num.ArchimedeanField.Pack (Num.ArchimedeanField.class R)) - sup_upper_bound sup_adherent. -Section ClassDef. - -Record class_of (R : Type) : Type := Class { - base : Num.ArchimedeanField.class_of R; - mixin_rcf : Num.real_closed_axiom (Num.NumDomain.Pack base); - (* TODO: ajouter une structure de pseudoMetricNormedDomain *) - mixin : mixin_of (Num.ArchimedeanField.Pack base) -}. - -Local Coercion base : class_of >-> Num.ArchimedeanField.class_of. -Local Coercion base_rcf R (c : class_of R) : Num.RealClosedField.class_of R := - @Num.RealClosedField.Class _ c (@mixin_rcf _ c). - -Structure type := Pack {sort; _ : class_of sort; _ : Type}. -Local Coercion sort : type >-> Sortclass. -Variables (T : Type) (cT : type). -Definition class := let: Pack _ c _ as cT' := cT return class_of cT' in c. -Definition clone c of phant_id class c := @Pack T c T. -Let xT := let: Pack T _ _ := cT in T. -Notation xclass := (class : class_of xT). - -Definition rcf_axiom {R} (cR : Num.RealClosedField.class_of R) : - Num.real_closed_axiom (Num.NumDomain.Pack cR) := - match cR with Num.RealClosedField.Class _ ax => ax end. -Coercion rcf_axiom : Num.RealClosedField.class_of >-> Num.real_closed_axiom. - -Definition pack b0 (m0 : mixin_of (@Num.ArchimedeanField.Pack T b0)) := - fun bT b & phant_id (Num.ArchimedeanField.class bT) b => - fun (bTr : rcfType) (br : Num.RealClosedField.class_of bTr) & - phant_id (Num.RealClosedField.class bTr) br => - fun cra & phant_id (@rcf_axiom bTr br) cra => - fun m & phant_id m0 m => Pack (@Class T b cra m) T. - -Definition eqType := @Equality.Pack cT xclass. -Definition choiceType := @Choice.Pack cT xclass. -Definition porderType := @Order.POrder.Pack ring_display cT xclass. -Definition latticeType := @Order.Lattice.Pack ring_display cT xclass. -Definition distrLatticeType := @Order.DistrLattice.Pack ring_display cT xclass. -Definition orderType := @Order.Total.Pack ring_display cT xclass. -Definition zmodType := @GRing.Zmodule.Pack cT xclass. -Definition ringType := @GRing.Ring.Pack cT xclass. -Definition comRingType := @GRing.ComRing.Pack cT xclass. -Definition unitRingType := @GRing.UnitRing.Pack cT xclass. -Definition comUnitRingType := @GRing.ComUnitRing.Pack cT xclass. -Definition idomainType := @GRing.IntegralDomain.Pack cT xclass. -Definition numDomainType := @Num.NumDomain.Pack cT xclass. -Definition normedZmodType := NormedZmodType numDomainType cT xclass. -Definition fieldType := @GRing.Field.Pack cT xclass. -Definition realDomainType := @Num.RealDomain.Pack cT xclass. -Definition numFieldType := @Num.NumField.Pack cT xclass. -Definition realFieldType := @Num.RealField.Pack cT xclass. -Definition archimedeanFieldType := @Num.ArchimedeanField.Pack cT xclass. -Definition rcfType := @Num.RealClosedField.Pack cT xclass. -Definition join_rcfType := @Num.RealClosedField.Pack archimedeanFieldType xclass. - -End ClassDef. - -Module Exports. -Coercion base : class_of >-> Num.ArchimedeanField.class_of. -Coercion base_rcf : class_of >-> Num.RealClosedField.class_of. -Coercion mixin : class_of >-> mixin_of. -Coercion sort : type >-> Sortclass. -Bind Scope ring_scope with sort. -Coercion eqType : type >-> Equality.type. -Canonical eqType. -Coercion choiceType : type >-> Choice.type. -Canonical choiceType. -Coercion porderType : type >-> Order.POrder.type. -Canonical porderType. -Coercion latticeType : type >-> Order.Lattice.type. -Canonical latticeType. -Coercion distrLatticeType : type >-> Order.DistrLattice.type. -Canonical distrLatticeType. -Coercion orderType : type >-> Order.Total.type. -Canonical orderType. -Coercion zmodType : type >-> GRing.Zmodule.type. -Canonical zmodType. -Coercion ringType : type >-> GRing.Ring.type. -Canonical ringType. -Coercion comRingType : type >-> GRing.ComRing.type. -Canonical comRingType. -Coercion unitRingType : type >-> GRing.UnitRing.type. -Canonical unitRingType. -Coercion comUnitRingType : type >-> GRing.ComUnitRing.type. -Canonical comUnitRingType. -Coercion idomainType : type >-> GRing.IntegralDomain.type. -Canonical idomainType. -Coercion numDomainType : type >-> Num.NumDomain.type. -Canonical numDomainType. -Coercion normedZmodType : type >-> Num.NormedZmodule.type. -Canonical normedZmodType. -Coercion realDomainType : type >-> Num.RealDomain.type. -Canonical realDomainType. -Coercion fieldType : type >-> GRing.Field.type. -Canonical fieldType. -Coercion numFieldType : type >-> Num.NumField.type. -Canonical numFieldType. -Coercion realFieldType : type >-> Num.RealField.type. -Canonical realFieldType. -Coercion archimedeanFieldType : type >-> Num.ArchimedeanField.type. -Canonical archimedeanFieldType. -Coercion rcfType : type >-> Num.RealClosedField.type. -Canonical rcfType. -Canonical join_rcfType. - -Notation realType := type. -Notation RealType T m := (@pack T _ m _ _ id _ _ id _ id _ id). -Notation RealMixin := EtaMixin. -Notation "[ 'realType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) - (at level 0, format "[ 'realType' 'of' T 'for' cT ]") : form_scope. -Notation "[ 'realType' 'of' T ]" := (@clone T _ _ id) - (at level 0, format "[ 'realType' 'of' T ]") : form_scope. - -End Exports. -End Real. - -Export Real.Exports. +Bind Scope ring_scope with Real.sort. (* -------------------------------------------------------------------- *) Definition sup {R : realType} := @supremum _ R 0. (*Local Notation "-` E" := [pred x | - x \in E] - (at level 35, right associativity) : fun_scope.*) + (at level 35, right associativity) : function_scope.*) Definition inf {R : realType} (E : set R) := - sup (-%R @` E). (* -------------------------------------------------------------------- *) Lemma sup_upper_bound {R : realType} (E : set R): has_sup E -> ubound E (sup E). -Proof. by move=> supE; case: R E supE=> ? [? ? []]. Qed. +Proof. exact: sup_upper_bound_subdef. Qed. Lemma sup_adherent {R : realType} (E : set R) (eps : R) : 0 < eps -> has_sup E -> exists2 e : R, E e & (sup E - eps) < e. -Proof. by case: R E eps=> ? [? ? []]. Qed. +Proof. exact: sup_adherent_subdef. Qed. (* -------------------------------------------------------------------- *) Section IsInt. Context {R : realFieldType}. -Definition Rint := [qualify a x : R | `[< exists z, x == z%:~R >]]. -Fact Rint_key : pred_key Rint. Proof. by []. Qed. -Canonical Rint_keyed := KeyedQualifier Rint_key. +Definition Rint_pred := fun x : R => `[< exists z, x == z%:~R >]. +Arguments Rint_pred _ /. +Definition Rint := [qualify a x | Rint_pred x]. Lemma Rint_def x : (x \is a Rint) = (`[< exists z, x == z%:~R >]). Proof. by []. Qed. @@ -299,28 +181,25 @@ split=> // _ _ /RintP[x ->] /RintP[y ->]; apply/RintP. by exists (x - y); rewrite rmorphB. by exists (x * y); rewrite rmorphM. Qed. -Canonical Rint_opprPred := OpprPred Rint_subring_closed. -Canonical Rint_addrPred := AddrPred Rint_subring_closed. -Canonical Rint_mulrPred := MulrPred Rint_subring_closed. -Canonical Rint_zmodPred := ZmodPred Rint_subring_closed. -Canonical Rint_semiringPred := SemiringPred Rint_subring_closed. -Canonical Rint_smulrPred := SmulrPred Rint_subring_closed. -Canonical Rint_subringPred := SubringPred Rint_subring_closed. +HB.instance Definition _ := GRing.isSubringClosed.Build R Rint_pred + Rint_subring_closed. Lemma Rint_ler_addr1 (x y : R) : x \is a Rint -> y \is a Rint -> (x + 1 <= y) = (x < y). Proof. move=> /RintP[xi ->] /RintP[yi ->]; rewrite -{2}[1]mulr1z. -by rewrite -intrD !(ltr_int, ler_int) lez_addr1. +by rewrite -intrD !(ltr_int, ler_int) lezD1. Qed. Lemma Rint_ltr_addr1 (x y : R) : x \is a Rint -> y \is a Rint -> (x < y + 1) = (x <= y). +Proof. move=> /RintP[xi ->] /RintP[yi ->]; rewrite -{3}[1]mulr1z. -by rewrite -intrD !(ltr_int, ler_int) ltz_addr1. +by rewrite -intrD !(ltr_int, ler_int) ltzD1. Qed. End IsInt. +Arguments Rint_pred _ _ /. (* -------------------------------------------------------------------- *) Section ToInt. @@ -418,11 +297,11 @@ have Dz: 2%:R * z = x + y. by rewrite mulrCA divff ?mulr1 // pnatr_eq0. have ubE : has_sup E by split => //; exists x. have [/downP [t Et lezt] | leyz] := sup_total z ubE. - rewrite -(ler_add2l x) -Dz -mulr2n -[leRHS]mulr_natl. - rewrite ler_pmul2l ?ltr0Sn //; apply/(le_trans lezt). + rewrite -(lerD2l x) -Dz -mulr2n -[leRHS]mulr_natl. + rewrite ler_pM2l ?ltr0Sn //; apply/(le_trans lezt). by move/ubP : leEx; exact. -rewrite -(ler_add2r y) -Dz -mulr2n -[leLHS]mulr_natl. -by rewrite ler_pmul2l ?ltr0Sn. +rewrite -(lerD2r y) -Dz -mulr2n -[leLHS]mulr_natl. +by rewrite ler_pM2l ?ltr0Sn. Qed. Lemma sup_setU (A B : set R) : has_sup B -> @@ -445,6 +324,47 @@ Qed. End RealLemmas. +Section sup_sum. +Context {R : realType}. + +Lemma sup_sumE (A B : set R) : + has_sup A -> has_sup B -> sup [set x + y | x in A & y in B] = sup A + sup B. +Proof. +move=> /[dup] supA [[a Aa] ubA] /[dup] supB [[b Bb] ubB]. +have ABsup : has_sup [set x + y | x in A & y in B]. + split; first by exists (a + b), a => //; exists b. + case: ubA ubB => p up [q uq]; exists (p + q) => ? [r Ar [s Bs] <-]. + by apply: lerD; [exact: up | exact: uq]. +apply: le_anti; apply/andP; split. + apply: sup_le_ub; first by case: ABsup. + by move=> ? [p Ap [q Bq] <-]; apply: lerD; exact: sup_ub. +rewrite real_leNgt ?num_real// -subr_gt0; apply/negP. +set eps := (_ + _ - _) => epos. +have e2pos : 0 < eps / 2%:R by rewrite divr_gt0// ltr0n. +have [r Ar supBr] := sup_adherent e2pos supA. +have [s Bs supAs] := sup_adherent e2pos supB. +have := ltrD supBr supAs. +rewrite -addrA [-_+_]addrC -addrA -opprD -splitr addrA /= opprD opprK addrA. +rewrite subrr add0r; apply/negP; rewrite -real_leNgt ?num_real//. +by apply: sup_upper_bound => //; exists r => //; exists s. +Qed. + +Lemma inf_sumE (A B : set R) : + has_inf A -> has_inf B -> inf [set x + y | x in A & y in B] = inf A + inf B. +Proof. +move/has_inf_supN => ? /has_inf_supN ?; rewrite /inf. +rewrite [X in - sup X = _](_ : _ = + [set x + y | x in [set - x | x in A ] & y in [set - x | x in B]]). + rewrite eqEsubset; split => /= t [] /= x []a Aa. + case => b Bb <- <-; exists (- a); first by exists a. + by exists (- b); [exists b|rewrite opprD]. + move=> <- [y] [b Bb] <- <-; exists (a + b); last by rewrite opprD. + by exists a => //; exists b. +by rewrite sup_sumE // -opprD. +Qed. + +End sup_sum. + (* -------------------------------------------------------------------- *) Section InfTheory. @@ -456,7 +376,7 @@ Implicit Types x : R. Lemma inf_lower_bound E : has_inf E -> lbound E (inf E). Proof. move=> /has_inf_supN /sup_upper_bound /ubP inflb; apply/lbP => x. -by rewrite memNE => /inflb; rewrite ler_oppl. +by rewrite memNE => /inflb; rewrite lerNl. Qed. Lemma inf_adherent E (eps : R) : 0 < eps -> @@ -464,7 +384,7 @@ Lemma inf_adherent E (eps : R) : 0 < eps -> Proof. move=> + /has_inf_supN supNE => /sup_adherent /(_ supNE)[e NEx egtsup]. exists (- e); first by case: NEx => x Ex <-{}; rewrite opprK. -by rewrite ltr_oppl -mulN1r mulrDr !mulN1r opprK. +by rewrite ltrNl -mulN1r mulrDr !mulN1r opprK. Qed. Lemma inf_out E : ~ has_inf E -> inf E = 0. @@ -491,7 +411,7 @@ Qed. Lemma lb_le_inf E x : nonempty E -> (lbound E) x -> x <= inf E. Proof. -by move=> /(nonemptyN E) En0 /lb_ubN /(sup_le_ub En0); rewrite ler_oppr. +by move=> /(nonemptyN E) En0 /lb_ubN /(sup_le_ub En0); rewrite lerNr. Qed. Lemma has_infPn E : nonempty E -> @@ -506,14 +426,14 @@ Lemma inf_setU (A B : set R) : has_inf A -> Proof. move=> hiA AB; congr (- _). rewrite image_setU setUC sup_setU //; first exact/has_inf_supN. -by move=> _ _ [] b Bb <-{} [] a Aa <-{}; rewrite ler_oppl opprK; apply AB. +by move=> _ _ [] b Bb <-{} [] a Aa <-{}; rewrite lerNl opprK; apply AB. Qed. Lemma inf_lt (S : set R) (x : R) : S !=set0 -> (inf S < x -> exists2 y, S y & y < x)%R. Proof. -move=> /nonemptyN S0; rewrite /inf ltr_oppl => /sup_gt => /(_ S0)[r [r' Sr']]. -by move=> <-; rewrite ltr_oppr opprK => r'x; exists r'. +move=> /nonemptyN S0; rewrite /inf ltrNl => /sup_gt => /(_ S0)[r [r' Sr']]. +by move=> <-; rewrite ltrNr opprK => r'x; exists r'. Qed. End InfTheory. @@ -527,7 +447,7 @@ Implicit Types x y : R. Lemma has_sup_floor_set x : has_sup (floor_set x). Proof. split; [exists (- (Num.bound (-x))%:~R) | exists (Num.bound x)%:~R]. - rewrite /floor_set/mkset rpredN rpred_int /= ler_oppl. + rewrite /floor_set/mkset rpredN rpred_int /= lerNl. case: (ger0P (-x)) => [/archi_boundP/ltW//|]. by move/ltW/le_trans; apply; rewrite ler0z. apply/ubP=> y /andP[_] /le_trans; apply. @@ -540,12 +460,12 @@ Proof. have /(sup_adherent ltr01) [y Fy] := has_sup_floor_set x. have /sup_upper_bound /ubP /(_ _ Fy) := has_sup_floor_set x. rewrite le_eqVlt=> /orP[/eqP<-//| lt_yFx]. -rewrite ltr_subl_addr -ltr_subl_addl => lt1_FxBy. +rewrite ltrBlDr -ltrBlDl => lt1_FxBy. pose e := sup (floor_set x) - y; have := has_sup_floor_set x. move/sup_adherent=> -/(_ e) []; first by rewrite subr_gt0. move=> z Fz; rewrite /e opprB addrCA subrr addr0 => lt_yz. have /sup_upper_bound /ubP /(_ _ Fz) := has_sup_floor_set x. -rewrite -(ler_add2r (-y)) => /le_lt_trans /(_ lt1_FxBy). +rewrite -(lerD2r (-y)) => /le_lt_trans /(_ lt1_FxBy). case/andP: Fy Fz lt_yz=> /RintP[yi -> _]. case/andP=> /RintP[zi -> _]; rewrite -rmorphB /= ltrz1 ltr_int. rewrite lt_neqAle => /andP[ne_yz le_yz]. @@ -567,7 +487,7 @@ have [|] := pselect ((floor_set x) (Rfloor x + 1)); last first. rewrite /floor_set => /negP. by rewrite negb_and -ltNge rpredD // ?(Rint1, isint_Rfloor). move/ubP : (sup_upper_bound (has_sup_floor_set x)) => h/h. -by rewrite ger_addl ler10. +by rewrite gerDl ler10. Qed. Lemma Rfloor_le x : Rfloor x <= x. @@ -585,12 +505,12 @@ Proof. move=> /andP[m1x x_m1] /andP[m2x x_m2]. wlog suffices: m1 m2 m1x {x_m1 m2x} x_m2 / (m1 <= m2). by move=> ih; apply/eqP; rewrite eq_le !ih. -rewrite -(ler_add2r 1) lez_addr1 -(@ltr_int R) intrD. +rewrite -(lerD2r 1) lezD1 -(@ltr_int R) intrD. exact/(le_lt_trans m1x). Qed. Lemma range1rr x : (range1 x) x. -Proof. by rewrite /range1/mkset lexx /= ltr_addl ltr01. Qed. +Proof. by rewrite /range1/mkset lexx /= ltrDl ltr01. Qed. Lemma range1zP (m : int) x : Rfloor x = m%:~R <-> (range1 m%:~R) x. Proof. @@ -672,7 +592,7 @@ Proof. by rewrite Rfloor_ge_int RfloorE ler_int. Qed. Lemma ltr_add_invr (y x : R) : y < x -> exists k, y + k.+1%:R^-1 < x. Proof. move=> yx; exists `|floor (x - y)^-1|%N. -rewrite -ltr_subr_addl -{2}(invrK (x - y)%R) ltf_pinv ?qualifE ?ltr0n//. +rewrite -ltrBrDl -{2}(invrK (x - y)%R) ltf_pV2 ?qualifE/= ?ltr0n//. by rewrite invr_gt0 subr_gt0. rewrite -natr1 natr_absz ger0_norm. by rewrite floor_ge0 invr_ge0 subr_ge0 ltW. @@ -693,10 +613,10 @@ Lemma Rceil0 : Rceil 0 = 0 :> R. Proof. by rewrite /Rceil oppr0 Rfloor0 oppr0. Qed. Lemma Rceil_ge x : x <= Rceil x. -Proof. by rewrite /Rceil ler_oppr Rfloor_le. Qed. +Proof. by rewrite /Rceil lerNr Rfloor_le. Qed. Lemma le_Rceil : {homo (@Rceil R) : x y / x <= y}. -Proof. by move=> x y ?; rewrite ler_oppl opprK le_Rfloor // ler_oppl opprK. Qed. +Proof. by move=> x y ?; rewrite lerNl opprK le_Rfloor // lerNl opprK. Qed. Lemma Rceil_ge0 x : 0 <= x -> 0 <= Rceil x. Proof. by move=> ?; rewrite -Rceil0 le_Rceil. Qed. @@ -711,72 +631,82 @@ Lemma ceil_ge0 x : 0 <= x -> 0 <= ceil x. Proof. by move/(ge_trans (ceil_ge x)); rewrite -(ler_int R). Qed. Lemma ceil_gt0 x : 0 < x -> 0 < ceil x. -Proof. by move=> ?; rewrite /ceil oppr_gt0 floor_lt0 // ltr_oppl oppr0. Qed. +Proof. by move=> ?; rewrite /ceil oppr_gt0 floor_lt0 // ltrNl oppr0. Qed. Lemma ceil_le0 x : x <= 0 -> ceil x <= 0. -Proof. by move=> x0; rewrite -ler_oppl oppr0 floor_ge0 -ler_oppr oppr0. Qed. +Proof. by move=> x0; rewrite -lerNl oppr0 floor_ge0 -lerNr oppr0. Qed. Lemma le_ceil : {homo @ceil R : x y / x <= y}. -Proof. by move=> x y xy; rewrite ler_oppl opprK le_floor // ler_oppl opprK. Qed. +Proof. by move=> x y xy; rewrite lerNl opprK le_floor // lerNl opprK. Qed. Lemma ceil_ge_int x (z : int) : (x <= z%:~R) = (ceil x <= z). -Proof. by rewrite /ceil ler_oppl -floor_ge_int// -ler_oppr mulrNz opprK. Qed. +Proof. by rewrite /ceil lerNl -floor_ge_int// -lerNr mulrNz opprK. Qed. Lemma ceil_lt_int x (z : int) : (z%:~R < x) = (z < ceil x). Proof. by rewrite ltNge ceil_ge_int -ltNge. Qed. +Lemma ceilN x : ceil (- x) = - floor x. Proof. by rewrite /ceil opprK. Qed. + +Lemma floorN x : floor (- x) = - ceil x. Proof. by rewrite /ceil opprK. Qed. + End CeilTheory. (* -------------------------------------------------------------------- *) Section Sup. Context {R : realType}. +Implicit Types A B : set R. -Lemma le_down (S : set R) : S `<=` down S. -Proof. by move=> x xS; apply/downP; exists x. Qed. +Lemma le_down A : A `<=` down A. +Proof. by move=> x xA; apply/downP; exists x. Qed. -Lemma downK (S : set R) : down (down S) = down S. +Lemma downK A : down (down A) = down A. Proof. -rewrite predeqE => x; split. -- case/downP => y /downP[z Sz yz xy]. - by apply/downP; exists z => //; rewrite (le_trans xy). -- by move=> Sx; apply/downP; exists x. +rewrite predeqE => x; split; last by move=> Ax; apply/downP; exists x. +case/downP => y /downP[z Az yz xy]. +by apply/downP; exists z => //; rewrite (le_trans xy). Qed. -Lemma has_sup_down (S : set R) : has_sup (down S) <-> has_sup S. +Lemma has_sup_down A : has_sup (down A) <-> has_sup A. Proof. -split=> -[nzS nzubS]. - case: nzS=> x /downP[y yS le_xy]; split; first by exists y. - case: nzubS=> u /ubP ubS; exists u; apply/ubP=> z zS. - by apply/ubS; apply/downP; exists z. -case: nzS=> x xS; split; first by exists x; apply/le_down. -case: nzubS=> u /ubP ubS; exists u; apply/ubP=> y /downP []. -by move=> z zS /le_trans; apply; apply/ubS. +split=> -[nzA nzubA]. + case: nzA => x /downP[y yS le_xy]; split; first by exists y. + case: nzubA=> u /ubP ubA; exists u; apply/ubP=> z zS. + by apply/ubA; apply/downP; exists z. +case: nzA => x xA; split; first by exists x; apply/le_down. +case: nzubA => u /ubP ubA; exists u; apply/ubP=> y /downP []. +by move=> z zA /le_trans; apply; apply/ubA. Qed. -Lemma le_sup (S1 S2 : set R) : - S1 `<=` down S2 -> nonempty S1 -> has_sup S2 - -> sup S1 <= sup S2. +Lemma le_sup A B : A `<=` down B -> nonempty A -> has_sup B -> + sup A <= sup B. Proof. -move=> le_S12 nz_S1 hs_S2; have hs_S1: has_sup S1. - split=> //; case: hs_S2=> _ [x ubx]. - exists x; apply/ubP=> y /le_S12 /downP[z zS2 le_yz]. +move=> le_AB nz_A hs_B; have hs_A: has_sup A. + split=> //; case: hs_B => _ [x ubx]. + exists x; apply/ubP=> y /le_AB /downP[z zB le_yz]. by apply/(le_trans le_yz); move/ubP: ubx; apply. rewrite leNgt -subr_gt0; apply/negP => lt_sup. -case: (sup_adherent lt_sup hs_S1 )=> x /le_S12 xdS2. -rewrite subKr => lt_S2x; case/downP: xdS2=> z zS2. -move/(lt_le_trans lt_S2x); rewrite ltNge. -by move/ubP: (sup_upper_bound hs_S2) => ->. +case: (sup_adherent lt_sup hs_A )=> x /le_AB xdB. +rewrite subKr => lt_Bx; case/downP: xdB => z zB. +move/(lt_le_trans lt_Bx); rewrite ltNge. +by move/ubP : (sup_upper_bound hs_B) => ->. +Qed. + +Lemma le_inf A B : -%R @` B `<=` down (-%R @` A) -> nonempty B -> has_inf A -> + inf A <= inf B. +Proof. +move=> SBA AB Ai; rewrite lerNl opprK le_sup// ?has_inf_supN//. +exact/nonemptyN. Qed. -Lemma sup_down (S : set R) : sup (down S) = sup S. +Lemma sup_down A : sup (down A) = sup A. Proof. -have [supS|supNS] := pselect (has_sup S); last first. +have [supA|supNA] := pselect (has_sup A); last first. by rewrite !sup_out // => /has_sup_down. -have supDS : has_sup (down S) by apply/has_sup_down. +have supDA : has_sup (down A) by apply/has_sup_down. apply/eqP; rewrite eq_le !le_sup //. - by case: supS => -[x xS] _; exists x; apply/le_down. - rewrite downK; exact: le_down. - by case: supS. +- by case: supA => -[x xA] _; exists x; apply/le_down. +- by rewrite downK; exact: le_down. +- by case: supA. Qed. Lemma lt_sup_imfset {T : Type} (F : T -> R) l : @@ -795,8 +725,8 @@ Lemma lt_inf_imfset {T : Type} (F : T -> R) l : exists2 x, F x < l & inf [set y | exists x, y = F x] <= F x. Proof. set P := [set y | _]; move=> hs; rewrite -subr_gt0. -move=> /inf_adherent/(_ hs)[_ [x ->]]; rewrite addrA [_ + l]addrC addrK. -by move=> ltFxl; exists x=> //; move/lbP : (inf_lower_bound hs) => -> //; exists x. +move=> /inf_adherent/(_ hs)[_ [x ->]]; rewrite addrCA subrr addr0 => ltFxl. +by exists x=> //; move/lbP : (inf_lower_bound hs) => -> //; exists x. Qed. End Sup. @@ -812,7 +742,7 @@ have i0i1n : i0 - (i + 1) = n by rewrite opprD addrA i0in1 -addn1 PoszD addrK. have [?|/not_forallP] := pselect (lbound B (i + 1)); first exact: (ih (i + 1)). move=> /contrapT[x /not_implyP[Bx i1x]]; exists x; split => // k Bk. rewrite (le_trans _ (lbBi _ Bk)) //. -by move/negP : i1x; rewrite -ltNge ltz_addr1. +by move/negP : i1x; rewrite -ltNge ltzD1. Qed. Section rat_in_itvoo. @@ -824,7 +754,7 @@ Let archi_bound_divP (R : archiFieldType) (x y : R) : 0 < x -> y < x *+ bound_div x y. Proof. move=> x0; have [y0|y0] := leP 0 y; last by rewrite /bound_div y0 mulr0n. -rewrite /bound_div (ltNge y 0) y0/= -mulr_natl -ltr_pdivr_mulr//. +rewrite /bound_div (ltNge y 0) y0/= -mulr_natl -ltr_pdivrMr//. by rewrite archi_boundP// (divr_ge0 _(ltW _)). Qed. @@ -847,31 +777,31 @@ have [m2 m2nx] : exists m2, m2.+1%:~R > - x *+ n. by rewrite mulrn_wge0 // oppr_ge0. have : exists m, -(m2.+1 : int) <= m <= m1.+1 /\ m%:~R - 1 <= x *+ n < m%:~R. have m2m1 : - (m2.+1 : int) < m1.+1. - by rewrite -(ltr_int R) (lt_trans _ m1nx)// rmorphN /= ltr_oppl // -mulNrn. + by rewrite -(ltr_int R) (lt_trans _ m1nx)// rmorphN /= ltrNl // -mulNrn. pose B := [set m : int | m%:~R > x *+ n]. have m1B : B m1.+1 by []. have m2B : lbound B (- m2.+1%:~R). - move=> i; rewrite /B /= -(opprK (x *+ n)) -ltr_oppl -mulNrn => nxi. - rewrite -(mulN1r m2.+1%:~R) mulN1r -ler_oppl. + move=> i; rewrite /B /= -(opprK (x *+ n)) -ltrNl -mulNrn => nxi. + rewrite -(mulN1r m2.+1%:~R) mulN1r -lerNl. by have := lt_trans nxi m2nx; rewrite intz -mulrNz ltr_int => /ltW. have [m [Bm infB]] := int_lbound_has_minimum (ex_intro _ _ m1B) m2B. have mN1B : ~ B (m - 1). - by move=> /infB; apply/negP; rewrite -ltNge ltr_subl_addr ltz_addr1. + by move=> /infB; apply/negP; rewrite -ltNge ltrBlDr ltzD1. exists m; split; [apply/andP; split|apply/andP; split] => //. - by move: m2B; rewrite /lbound /= => /(_ _ Bm); rewrite intz. - exact: infB. - by rewrite leNgt; apply/negP; rewrite /B /= intrD in mN1B. move=> [m [/andP[m2m mm1] /andP[mnx nxm]]]. have [/andP[a b] c] : x *+ n < m%:~R <= 1 + x *+ n /\ 1 + x *+ n < y *+ n. - split; [apply/andP; split|] => //; first by rewrite -ler_subl_addl. - by move: nyx; rewrite mulrnDl -ltr_subr_addr mulNrn. + split; [apply/andP; split|] => //; first by rewrite -lerBlDl. + by move: nyx; rewrite mulrnDl -ltrBrDr mulNrn. have n_gt0 : n != 0%N by apply: contraTN nyx => /eqP ->; rewrite mulr0n ltr10. exists (m%:Q / n%:Q); rewrite in_itv /=; apply/andP; split. - rewrite rmorphM (@rmorphV _ _ _ n%:~R); first by rewrite unitfE // intr_eq0. - rewrite ltr_pdivl_mulr /=; first by rewrite ltr0q ltr0z ltz_nat lt0n. + rewrite rmorphM/= (@rmorphV _ _ _ n%:~R); first by rewrite unitfE // intr_eq0. + rewrite ltr_pdivlMr /=; first by rewrite ltr0q ltr0z ltz_nat lt0n. by rewrite mulrC // !ratr_int mulr_natl. rewrite rmorphM /= (@rmorphV _ _ _ n%:~R); first by rewrite unitfE // intr_eq0. -rewrite ltr_pdivr_mulr /=; first by rewrite ltr0q ltr0z ltz_nat lt0n. +rewrite ltr_pdivrMr /=; first by rewrite ltr0q ltr0z ltz_nat lt0n. by rewrite 2!ratr_int mulr_natr (le_lt_trans _ c). Qed. diff --git a/theories/sequences.v b/theories/sequences.v index 97f98b773..0d3f80270 100644 --- a/theories/sequences.v +++ b/theories/sequences.v @@ -1,17 +1,24 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum matrix. From mathcomp Require Import interval rat. -From mathcomp.classical Require Import boolp classical_sets. -From mathcomp.classical Require Import functions set_interval mathcomp_extra. +From mathcomp Require Import mathcomp_extra boolp classical_sets functions. +From mathcomp Require Import set_interval. Require Import reals ereal signed topology normedtype landau. -(******************************************************************************) -(* Definitions and lemmas about sequences *) +(**md**************************************************************************) +(* # Definitions and lemmas about sequences *) (* *) (* The purpose of this file is to gather generic definitions and lemmas about *) (* sequences. *) +(* ``` *) +(* nondecreasing_seq u == the sequence u is non-decreasing *) +(* nonincreasing_seq u == the sequence u is non-increasing *) +(* increasing_seq u == the sequence u is (strictly) increasing *) +(* decreasing_seq u == the sequence u is (strictly) decreasing *) +(* ``` *) (* *) -(* * About sequences of real numbers: *) +(* ## About sequences of real numbers *) +(* ``` *) (* [sequence u_n]_n == the sequence of general element u_n *) (* R ^nat == notation for the type of sequences, i.e., *) (* functions of type nat -> R *) @@ -33,28 +40,30 @@ Require Import reals ereal signed topology normedtype landau. (* exponential *) (* expR x == the exponential function defined on a realType *) (* is_cvg_series_exp_coeff == convergence of \sum_n^+oo x^n / n! *) -(* *) (* \sum_ F i == lim (fun n => (\sum_) F i)) where *) (* can be (i = u_ n *) -(* nondecreasing_cvg u_ == if u_ is nondecreasing and bounded then u_ *) -(* is convergent and its limit is sup u_n *) -(* nonincreasing_cvg u_ == if u_ is nonincreasing u_ and bound by below *) -(* then u_ is convergent *) -(* adjacent == adjacent sequences lemma *) -(* cesaro == Cesaro's lemma *) +(* ``` *) +(* nonincreasing_cvgn_ge u_ == if u_ is nonincreasing and convergent then *) +(* forall n, lim u_ <= u_ n *) +(* nondecreasing_cvgn_le u_ == if u_ is nondecreasing and convergent then *) +(* forall n, lim u_ >= u_ n *) +(* nondecreasing_cvgn u_ == if u_ is nondecreasing and bounded then u_ *) +(* is convergent and its limit is sup u_n *) +(* nonincreasing_cvgn u_ == if u_ is nonincreasing u_ and bound by below *) +(* then u_ is convergent *) +(* adjacent == adjacent sequences lemma *) +(* cesaro == Cesaro's lemma *) +(* ``` *) (* *) -(* * About sequences of natural numbers: *) +(* ## About sequences of natural numbers *) (* nseries *) (* *) -(* * About sequences of extended real numbers: *) +(* ## About sequences of extended real numbers *) (* eseries, etelescope, etc. *) (* *) (* Section sequences_ereal contain properties of sequences of extended real *) @@ -64,14 +73,17 @@ Require Import reals ereal signed topology normedtype landau. (* positive) extended numbers use the string "nneseries" (resp. "npeseries")*) (* as part of their identifier *) (* *) -(* * Limit superior and inferior: *) -(* sdrop u n := {u_k | k >= n} *) -(* sups u := [sequence sup (sdrop u n)]_n *) -(* infs u := [sequence inf (sdrop u n)]_n *) -(* lim_{inf,sup} == limit inferior/superior for realType *) -(* esups u := [sequence ereal_sup (sdrop u n)]_n *) -(* einfs u := [sequence ereal_inf (sdrop u n)]_n *) -(* lim_e{inf,sup} == limit inferior/superior for \bar R *) +(* ## Limit superior and inferior for sequences: *) +(* ``` *) +(* sdrop u n := {u_k | k >= n} *) +(* sups u := [sequence sup (sdrop u n)]_n *) +(* infs u := [sequence inf (sdrop u n)]_n *) +(* limn_sup, limn_inf == limit sup/inferior for a sequence of reals *) +(* esups u := [sequence ereal_sup (sdrop u n)]_n *) +(* einfs u := [sequence ereal_inf (sdrop u n)]_n *) +(* limn_esup u, limn_einf == limit sup/inferior for a sequence of *) +(* of extended reals *) +(* ``` *) (* *) (******************************************************************************) @@ -137,19 +149,19 @@ Notation "'decreasing_seq' f" := ({mono f : n m / (n <= m)%nat >-> (n >= m)%O}) Lemma nondecreasing_opp (T : numDomainType) (u_ : T ^nat) : nondecreasing_seq (- u_) = nonincreasing_seq u_. -Proof. by rewrite propeqE; split => du x y /du; rewrite ler_opp2. Qed. +Proof. by rewrite propeqE; split => du x y /du; rewrite lerN2. Qed. Lemma nonincreasing_opp (T : numDomainType) (u_ : T ^nat) : nonincreasing_seq (- u_) = nondecreasing_seq u_. -Proof. by rewrite propeqE; split => du x y /du; rewrite ler_opp2. Qed. +Proof. by rewrite propeqE; split => du x y /du; rewrite lerN2. Qed. Lemma decreasing_opp (T : numDomainType) (u_ : T ^nat) : decreasing_seq (- u_) = increasing_seq u_. -Proof. by rewrite propeqE; split => du x y; rewrite -du ler_opp2. Qed. +Proof. by rewrite propeqE; split => du x y; rewrite -du lerN2. Qed. Lemma increasing_opp (T : numDomainType) (u_ : T ^nat) : increasing_seq (- u_) = decreasing_seq u_. -Proof. by rewrite propeqE; split => du x y; rewrite -du ler_opp2. Qed. +Proof. by rewrite propeqE; split => du x y; rewrite -du lerN2. Qed. Lemma nondecreasing_seqP (d : unit) (T : porderType d) (u_ : T ^nat) : (forall n, u_ n <= u_ n.+1)%O <-> nondecreasing_seq u_. @@ -191,14 +203,12 @@ Lemma nondecreasing_seqD T (d : unit) (R : numDomainType) (f g : (T -> R)^nat) : (forall x, nondecreasing_seq (f ^~ x)) -> (forall x, nondecreasing_seq (g ^~ x)) -> (forall x, nondecreasing_seq ((f \+ g) ^~ x)). -Proof. by move=> ndf ndg t m n mn; apply: ler_add; [exact/ndf|exact/ndg]. Qed. +Proof. by move=> ndf ndg t m n mn; apply: lerD; [exact/ndf|exact/ndg]. Qed. Local Notation eqolimn := (@eqolim _ _ _ eventually_filter). Local Notation eqolimPn := (@eqolimP _ _ _ eventually_filter). -(*********************) -(* Sequences of sets *) -(*********************) +(** Sequences of sets *) Section seqDU. Variables (T : Type). @@ -238,11 +248,21 @@ move: UFnt; rewrite -bigcup_mkord => -[/= k _ Fkt] {Fnt n}. have [n kn] := ubnP k; elim: n => // n ih in t k Fkt kn *. case: k => [|k] in Fkt kn *; first by exists O. have [?|] := pselect (forall m, (m <= k)%N -> ~ F m t); first by exists k.+1. -move=> /existsNP[i] /not_implyP[ik] /contrapT Fit; apply (ih t i) => //. +move=> /existsNP[i] /not_implyP[ik] /contrapT Fit; apply: (ih t i) => //. by rewrite (leq_ltn_trans ik). Qed. +Lemma seqDUIE (S : set T) (F : (set T)^nat) : + seqDU (fun n => S `&` F n) = (fun n => S `&` F n `\` \bigcup_(i < n) F i). +Proof. +apply/funext => n; rewrite -setIDA; apply/seteqP; split; last first. + move=> x [Sx [Fnx UFx]]; split=> //; apply: contra_not UFx => /=. + by rewrite bigcup_mkord -big_distrr/= => -[]. +by rewrite /seqDU -setIDA bigcup_mkord -big_distrr/= setDIr setIUr setDIK set0U. +Qed. + End seqDU. +Arguments trivIset_seqDU {T} F. #[global] Hint Resolve trivIset_seqDU : core. Section seqD. @@ -307,15 +327,13 @@ Lemma eq_bigcup_seqD_bigsetU F : Proof. rewrite -(@eq_bigcup_seqD (fun n => \big[setU/set0]_(i < n.+1) F i)). rewrite eqEsubset; split => [t [i _]|t [i _ Fit]]. - by rewrite -bigcup_set_cond => -[/= j _ Fjt]; exists j. + by rewrite -bigcup_seq_cond => -[/= j _ Fjt]; exists j. by exists i => //; rewrite big_ord_recr /=; right. Qed. End seqD. -(************************************) -(* Convergence of patched sequences *) -(************************************) +(** Convergence of patched sequences *) Section sequences_patched. (* TODO: generalizations to numDomainType *) @@ -334,22 +352,23 @@ by near do [move=> /=; case: ifP => //; rewrite ltn_geF//]. Unshelve. all: by end_near. Qed. Lemma is_cvg_restrict f u_ : - cvg ([sequence if (n <= N)%nat then f n else u_ n]_n @ \oo) = - cvg (u_ @ \oo). + cvgn [sequence if (n <= N)%nat then f n else u_ n]_n = cvgn u_. Proof. by rewrite propeqE; split; [rewrite cvg_restrict|rewrite -(cvg_restrict f)] => /cvgP. Qed. -Lemma cvg_centern u_ l : ([sequence u_ (n - N)%N]_n --> l) = (u_ --> l). +Lemma cvg_centern u_ l : + ([sequence u_ (n - N)%N]_n @ \oo --> l) = (u_ @ \oo --> l). Proof. rewrite propeqE; split; last by apply: cvg_comp; apply: cvg_subnr. -gen have cD : u_ l / u_ --> l -> (fun n => u_ (n + N)%N) --> l. +gen have cD : u_ l / u_ @ \oo --> l -> (fun n => u_ (n + N)%N) @ \oo --> l. by apply: cvg_comp; apply: cvg_addnr. -by move=> /cD /=; under [X in X --> l]funext => n do rewrite addnK. +by move=> /cD /=; under [X in X @ _ --> l]funext => n do rewrite addnK. Qed. -Lemma cvg_shiftn u_ l : ([sequence u_ (n + N)%N]_n --> l) = (u_ --> l). +Lemma cvg_shiftn u_ l : + ([sequence u_ (n + N)%N]_n @ \oo --> l) = (u_ @ \oo --> l). Proof. rewrite propeqE; split; last by apply: cvg_comp; apply: cvg_addnr. rewrite -[X in X -> _]cvg_centern; apply: cvg_trans => /=. @@ -360,7 +379,8 @@ End NatShift. Variables (V : topologicalType). -Lemma cvg_shiftS u_ (l : V) : ([sequence u_ n.+1]_n --> l) = (u_ --> l). +Lemma cvg_shiftS u_ (l : V) : + ([sequence u_ n.+1]_n @ \oo --> l) = (u_ @ \oo --> l). Proof. suff -> : [sequence u_ n.+1]_n = [sequence u_(n + 1)%N]_n by rewrite cvg_shiftn. by rewrite funeqE => n/=; rewrite addn1. @@ -378,167 +398,175 @@ Lemma __deprecated__squeeze T (f g h : T -> R) (a : filter_on T) : Proof. exact: squeeze_cvgr. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `squeeze_cvgr`")] -Notation squeeze := __deprecated__squeeze. +Notation squeeze := __deprecated__squeeze (only parsing). Lemma __deprecated__cvgPpinfty (u_ : R ^nat) : - u_ --> +oo <-> forall A, \forall n \near \oo, A <= u_ n. + u_ @ \oo --> +oo <-> forall A, \forall n \near \oo, A <= u_ n. Proof. exact: cvgryPge. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `cvgryPge`, and generalized to any filter")] -Notation cvgPpinfty := __deprecated__cvgPpinfty. +Notation cvgPpinfty := __deprecated__cvgPpinfty (only parsing). -Lemma __deprecated__cvgNpinfty u_ : (- u_ --> +oo) = (u_ --> -oo). +Lemma __deprecated__cvgNpinfty u_ : (- u_ @ \oo --> +oo) = (u_ @ \oo --> -oo). Proof. exact/propeqP/cvgNry. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvgNry` instead")] -Notation cvgNpinfty := __deprecated__cvgNpinfty. +Notation cvgNpinfty := __deprecated__cvgNpinfty (only parsing). -Lemma __deprecated__cvgNninfty u_ : (- u_ --> -oo) = (u_ --> +oo). +Lemma __deprecated__cvgNninfty u_ : (- u_ @ \oo --> -oo) = (u_ @ \oo --> +oo). Proof. exact/propeqP/cvgNrNy. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvgNrNy` instead")] -Notation cvgNninfty := __deprecated__cvgNninfty. +Notation cvgNninfty := __deprecated__cvgNninfty (only parsing). Lemma __deprecated__cvgPninfty (u_ : R ^nat) : - u_ --> -oo <-> forall A, \forall n \near \oo, A >= u_ n. + u_ @ \oo --> -oo <-> forall A, \forall n \near \oo, A >= u_ n. Proof. exact: cvgrNyPle. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `cvgrNyPle`, and generalized to any filter")] -Notation cvgPninfty := __deprecated__cvgPninfty. +Notation cvgPninfty := __deprecated__cvgPninfty (only parsing). Lemma __deprecated__ger_cvg_pinfty u_ v_ : (\forall n \near \oo, u_ n <= v_ n) -> - u_ --> +oo -> v_ --> +oo. + u_ @ \oo --> +oo -> v_ @ \oo --> +oo. Proof. exact: ger_cvgy. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `ger_cvgy`, and generalized to any filter")] -Notation ger_cvg_pinfty := __deprecated__ger_cvg_pinfty. +Notation ger_cvg_pinfty := __deprecated__ger_cvg_pinfty (only parsing). Lemma __deprecated__ler_cvg_ninfty v_ u_ : (\forall n \near \oo, u_ n <= v_ n) -> - v_ --> -oo -> u_ --> -oo. + v_ @ \oo --> -oo -> u_ @ \oo --> -oo. Proof. exact: ler_cvgNy. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `ler_cvgNy`, and generalized to any filter")] -Notation ler_cvg_ninfty := __deprecated__ler_cvg_ninfty. +Notation ler_cvg_ninfty := __deprecated__ler_cvg_ninfty (only parsing). -Lemma __deprecated__lim_ge x u : cvg u -> (\forall n \near \oo, x <= u n) -> x <= lim u. +Lemma __deprecated__lim_ge x u : cvg (u @ \oo) -> + (\forall n \near \oo, x <= u n) -> x <= lim (u @ \oo). Proof. exact: limr_ge. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `limr_ge`, and generalized to any proper filter")] -Notation lim_ge := __deprecated__lim_ge. +Notation lim_ge := __deprecated__lim_ge (only parsing). -Lemma __deprecated__lim_le x u : cvg u -> (\forall n \near \oo, x >= u n) -> x >= lim u. +Lemma __deprecated__lim_le x u : cvg (u @ \oo) -> + (\forall n \near \oo, x >= u n) -> x >= lim (u @ \oo). Proof. exact: limr_le. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `limr_le`, and generalized to any proper filter")] -Notation lim_le := __deprecated__lim_le. +Notation lim_le := __deprecated__lim_le (only parsing). -Lemma lt_lim u (M : R) : nondecreasing_seq u -> cvg u -> M < lim u -> - \forall n \near \oo, M <= u n. +Lemma lt_lim u (M : R) : nondecreasing_seq u -> + cvgn u -> M < limn u -> \forall n \near \oo, M <= u n. Proof. move=> ndu cu Ml; have [[n Mun]|/forallNP Mu] := pselect (exists n, M <= u n). near=> m; suff : u n <= u m by exact: le_trans. by near: m; exists n.+1 => // p q; apply/ndu/ltnW. have {}Mu : forall x, M > u x by move=> x; rewrite ltNge; apply/negP. -have : lim u <= M by apply: limr_le => //; near=> m; apply/ltW/Mu. +have : limn u <= M by apply: limr_le => //; near=> m; apply/ltW/Mu. by move/(lt_le_trans Ml); rewrite ltxx. Unshelve. all: by end_near. Qed. -Lemma nonincreasing_cvg_ge u_ : nonincreasing_seq u_ -> cvg u_ -> - forall n, lim u_ <= u_ n. +Lemma nonincreasing_cvgn_ge u_ : nonincreasing_seq u_ -> cvgn u_ -> + forall n, limn u_ <= u_ n. Proof. move=> du ul p; rewrite leNgt; apply/negP => up0. -move/cvgrPdist_lt : ul => /(_ `|u_ p - lim u_|%R). +move/cvgrPdist_lt : ul => /(_ `|u_ p - limn u_|%R). rewrite {1}ltr0_norm ?subr_lt0 // opprB subr_gt0 => /(_ up0) ul. near \oo => N. have /du uNp : (p <= N)%nat by near: N; rewrite nearE; exists p. -have : `|lim u_ - u_ N| >= `|u_ p - lim u_|%R. +have : `|limn u_ - u_ N| >= `|u_ p - limn u_|%R. rewrite ltr0_norm // ?subr_lt0 // opprB distrC. - rewrite (@le_trans _ _ (lim u_ - u_ N)) // ?ler_sub //. - rewrite (_ : `| _ | = `|u_ N - lim u_|%R) // ler0_norm // ?opprB //. + rewrite (@le_trans _ _ (limn u_ - u_ N)) // ?lerB //. + rewrite (_ : `| _ | = `|u_ N - limn u_|%R) // ler0_norm // ?opprB //. by rewrite subr_le0 (le_trans _ (ltW up0)). rewrite leNgt => /negP; apply; by near: N. Unshelve. all: by end_near. Qed. -Lemma nondecreasing_cvg_le u_ : nondecreasing_seq u_ -> cvg u_ -> - forall n, u_ n <= lim u_. +Lemma nondecreasing_cvgn_le u_ : nondecreasing_seq u_ -> cvgn u_ -> + forall n, u_ n <= limn u_. Proof. -move=> iu cu n; move: (@nonincreasing_cvg_ge (- u_)). +move=> iu cu n; move: (@nonincreasing_cvgn_ge (- u_)). rewrite -nondecreasing_opp opprK => /(_ iu); rewrite is_cvgNE => /(_ cu n). -by rewrite limN // ler_oppl opprK. +by rewrite limN // lerNl opprK. Qed. -Lemma cvg_has_ub u_ : cvg u_ -> has_ubound [set `|u_ n| | n in setT]. +Lemma cvg_has_ub u_ : cvgn u_ -> has_ubound [set `|u_ n| | n in setT]. Proof. move=> /cvg_seq_bounded/pinfty_ex_gt0[M M_gt0 /= uM]. by exists M; apply/ubP => x -[n _ <-{x}]; exact: uM. Qed. -Lemma cvg_has_sup u_ : cvg u_ -> has_sup (u_ @` setT). +Lemma cvg_has_sup u_ : cvgn u_ -> has_sup (u_ @` setT). Proof. move/cvg_has_ub; rewrite -/(_ @` _) -(image_comp u_ normr setT). by move=> /has_ub_image_norm uM; split => //; exists (u_ 0%N), 0%N. Qed. -Lemma cvg_has_inf u_ : cvg u_ -> has_inf (u_ @` setT). +Lemma cvg_has_inf u_ : cvgn u_ -> has_inf (u_ @` setT). Proof. by move/is_cvgN/cvg_has_sup; rewrite -has_inf_supN image_comp. Qed. Lemma __deprecated__cvgPpinfty_lt (u_ : R ^nat) : - u_ --> +oo%R <-> forall A, \forall n \near \oo, (A < u_ n)%R. + u_ @ \oo --> +oo%R <-> forall A, \forall n \near \oo, (A < u_ n)%R. Proof. exact: cvgryPgt. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `cvgryPgt`, and generalized to any proper filter")] -Notation cvgPpinfty_lt := __deprecated__cvgPpinfty_lt. +Notation cvgPpinfty_lt := __deprecated__cvgPpinfty_lt (only parsing). Lemma __deprecated__cvgPninfty_lt (u_ : R ^nat) : - u_ --> -oo%R <-> forall A, \forall n \near \oo, (A > u_ n)%R. + u_ @ \oo --> -oo%R <-> forall A, \forall n \near \oo, (A > u_ n)%R. Proof. exact: cvgrNyPlt. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `cvgrNyPlt`, and generalized to any proper filter")] -Notation cvgPninfty_lt := __deprecated__cvgPninfty_lt. +Notation cvgPninfty_lt := __deprecated__cvgPninfty_lt (only parsing). Lemma __deprecated__cvgPpinfty_near (u_ : R ^nat) : - u_ --> +oo%R <-> \forall A \near +oo, \forall n \near \oo, (A <= u_ n)%R. + u_ @ \oo --> +oo%R <-> \forall A \near +oo, \forall n \near \oo, (A <= u_ n)%R. Proof. exact: cvgryPgey. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `cvgryPgey`, and generalized to any proper filter")] -Notation cvgPpinfty_near := __deprecated__cvgPpinfty_near. +Notation cvgPpinfty_near := __deprecated__cvgPpinfty_near (only parsing). Lemma __deprecated__cvgPninfty_near (u_ : R ^nat) : - u_ --> -oo%R <-> \forall A \near -oo, \forall n \near \oo, (A >= u_ n)%R. + u_ @ \oo --> -oo%R <-> \forall A \near -oo, \forall n \near \oo, (A >= u_ n)%R. Proof. exact: cvgrNyPleNy. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `cvgrNyPleNy`, and generalized to any proper filter")] -Notation cvgPninfty_near := __deprecated__cvgPninfty_near. +Notation cvgPninfty_near := __deprecated__cvgPninfty_near (only parsing). Lemma __deprecated__cvgPpinfty_lt_near (u_ : R ^nat) : - u_ --> +oo%R <-> \forall A \near +oo, \forall n \near \oo, (A < u_ n)%R. + u_ @ \oo --> +oo%R <-> \forall A \near +oo, \forall n \near \oo, (A < u_ n)%R. Proof. exact: cvgryPgty. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `cvgryPgty`, and generalized to any proper filter")] -Notation cvgPpinfty_lt_near := __deprecated__cvgPpinfty_lt_near. +Notation cvgPpinfty_lt_near := __deprecated__cvgPpinfty_lt_near (only parsing). Lemma __deprecated__cvgPninfty_lt_near (u_ : R ^nat) : - u_ --> -oo%R <-> \forall A \near -oo, \forall n \near \oo, (A > u_ n)%R. + u_ @ \oo --> -oo%R <-> \forall A \near -oo, \forall n \near \oo, (A > u_ n)%R. Proof. exact: cvgrNyPltNy. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `cvgrNyPltNy`, and generalized to any proper filter")] -Notation cvgPninfty_lt_near := __deprecated__cvgPninfty_lt_near. +Notation cvgPninfty_lt_near := __deprecated__cvgPninfty_lt_near (only parsing). End sequences_R_lemmas_realFieldType. +#[deprecated(since="mathcomp-analysis 0.6.6", + note="renamed to `nonincreasing_cvgn_ge`")] +Notation nonincreasing_cvg_ge := nonincreasing_cvgn_ge (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", + note="renamed to `nondecreasing_cvgn_le`")] +Notation nondecreasing_cvg_le := nondecreasing_cvgn_le (only parsing). Lemma __deprecated__invr_cvg0 (R : realFieldType) (u : R^nat) : - (forall i, 0 < u i) -> ((u i)^-1 @[i --> \oo] --> 0) <-> (u --> +oo). + (forall i, 0 < u i) -> ((u i)^-1 @[i --> \oo] --> 0) <-> (u @ \oo --> +oo). Proof. by move=> ?; rewrite gtr0_cvgV0//; apply: nearW. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `gtr0_cvgV0` and generalized")] -Notation invr_cvg0 := __deprecated__invr_cvg0. +Notation invr_cvg0 := __deprecated__invr_cvg0 (only parsing). Lemma __deprecated__invr_cvg_pinfty (R : realFieldType) (u : R^nat) : - (forall i, 0 < u i) -> ((u i)^-1 @[i --> \oo] --> +oo) <-> (u --> 0). + (forall i, 0 < u i) -> ((u i)^-1 @[i --> \oo] --> +oo) <-> (u @ \oo--> 0). Proof. by move=> ?; rewrite cvgrVy//; apply: nearW. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `cvgrVy` and generalized")] -Notation invr_cvg_pinfty := __deprecated__invr_cvg_pinfty. +Notation invr_cvg_pinfty := __deprecated__invr_cvg_pinfty (only parsing). Section partial_sum. Variables (V : zmodType) (u_ : V ^nat). @@ -596,42 +624,43 @@ Section partial_sum_numFieldType. Variables V : numFieldType. Implicit Types f g : V ^nat. -Lemma is_cvg_seriesN f : cvg (series (- f)) = cvg (series f). +Lemma is_cvg_seriesN f : cvgn (series (- f)) = cvgn (series f). Proof. by rewrite seriesN is_cvgNE. Qed. -Lemma lim_seriesN f : cvg (series f) -> lim (series (- f)) = - lim (series f). +Lemma lim_seriesN f : cvg (series f @ \oo) -> + limn (series (- f)) = - limn (series f). Proof. by move=> cf; rewrite seriesN limN. Qed. -Lemma is_cvg_seriesZ f k : cvg (series f) -> cvg (series (k *: f)). +Lemma is_cvg_seriesZ f k : cvgn (series f) -> cvgn (series (k *: f)). Proof. by move=> cf; rewrite seriesZ; exact: is_cvgZr. Qed. -Lemma lim_seriesZ f k : cvg (series f) -> - lim (series (k *: f)) = k *: lim (series f). +Lemma lim_seriesZ f k : cvgn (series f) -> + limn (series (k *: f)) = k *: limn (series f). Proof. by move=> cf; rewrite seriesZ limZr. Qed. Lemma is_cvg_seriesD f g : - cvg (series f) -> cvg (series g) -> cvg (series (f + g)). + cvgn (series f) -> cvgn (series g) -> cvgn (series (f + g)). Proof. by move=> cf cg; rewrite seriesD; exact: is_cvgD. Qed. -Lemma lim_seriesD f g : cvg (series f) -> cvg (series g) -> - lim (series (f + g)) = lim (series f) + lim (series g). +Lemma lim_seriesD f g : cvgn (series f) -> cvgn (series g) -> + limn (series (f + g)) = limn (series f) + limn (series g). Proof. by move=> cf cg; rewrite seriesD limD. Qed. Lemma is_cvg_seriesB f g : - cvg (series f) -> cvg (series g) -> cvg (series (f - g)). + cvgn (series f) -> cvgn (series g) -> cvgn (series (f - g)). Proof. by move=> cf cg; apply: is_cvg_seriesD; rewrite ?is_cvg_seriesN. Qed. -Lemma lim_seriesB f g : cvg (series f) -> cvg (series g) -> - lim (series (f - g)) = lim (series f) - lim (series g). +Lemma lim_seriesB f g : cvg (series f @ \oo) -> cvg (series g @ \oo) -> + limn (series (f - g)) = limn (series f) - limn (series g). Proof. by move=> Cf Cg; rewrite lim_seriesD ?is_cvg_seriesN// lim_seriesN. Qed. End partial_sum_numFieldType. Lemma lim_series_le (V : realFieldType) (f g : V ^nat) : - cvg (series f) -> cvg (series g) -> (forall n, f n <= g n) -> - lim (series f) <= lim (series g). + cvgn (series f) -> cvgn (series g) -> (forall n, f n <= g n) -> + limn (series f) <= limn (series g). Proof. -by move=> cf cg fg; apply (ler_lim cf cg); near=> x; rewrite ler_sum. +by move=> cf cg fg; apply: (ler_lim cf cg); near=> x; rewrite ler_sum. Unshelve. all: by end_near. Qed. Lemma telescopeK (V : zmodType) (u_ : V ^nat) : @@ -650,7 +679,7 @@ Variables (N : nat) (K : numFieldType) (V : normedModType K). Implicit Types (f : nat -> V) (u : V ^nat) (l : V). Lemma is_cvg_series_restrict u_ : - cvg [sequence \sum_(N <= k < n) u_ k]_n = cvg (series u_). + cvgn [sequence \sum_(N <= k < n) u_ k]_n = cvgn (series u_). Proof. suff -> : (fun n => \sum_(N <= k < n) u_ k) = fun n => if (n <= N)%N then \sum_(N <= k < n) u_ k @@ -665,85 +694,108 @@ End series_patched. Section sequences_R_lemmas. Variable R : realType. -Lemma nondecreasing_cvg (u_ : R ^nat) : +Lemma nondecreasing_cvgn (u_ : R ^nat) : nondecreasing_seq u_ -> has_ubound (range u_) -> - u_ --> sup (range u_). + u_ @ \oo --> sup (range u_). Proof. move=> leu u_ub; set M := sup (range u_). have su_ : has_sup (range u_) by split => //; exists (u_ 0%N), 0%N. apply/cvgrPdist_le => _/posnumP[e]. -have [p /andP[Mu_p u_pM]] : exists p, M - e%:num <= u_ p <= M. +have [p Mu_p] : exists p, M - e%:num <= u_ p. have [_ -[p _] <- /ltW Mu_p] := sup_adherent (gt0 e) su_. - by exists p; rewrite Mu_p; have /ubP := sup_upper_bound su_; apply; exists p. + by exists p; rewrite Mu_p. near=> n; have pn : (p <= n)%N by near: n; exact: nbhs_infty_ge. -rewrite ler_distlC (le_trans Mu_p (leu _ _ _))//= (@le_trans _ _ M) ?ler_addl//. +rewrite ler_distlC (le_trans Mu_p (leu _ _ _))//= (@le_trans _ _ M) ?lerDl//. by have /ubP := sup_upper_bound su_; apply; exists n. Unshelve. all: by end_near. Qed. -Lemma nondecreasing_is_cvg (u_ : R ^nat) : - nondecreasing_seq u_ -> has_ubound (range u_) -> cvg u_. -Proof. by move=> u_nd u_ub; apply: cvgP; apply: nondecreasing_cvg. Qed. +Lemma nondecreasing_is_cvgn (u_ : R ^nat) : + nondecreasing_seq u_ -> has_ubound (range u_) -> cvgn u_. +Proof. by move=> u_nd u_ub; apply: cvgP; exact: nondecreasing_cvgn. Qed. -Lemma nondecreasing_dvg_lt (u_ : R ^nat) : - nondecreasing_seq u_ -> ~ cvg u_ -> u_ --> +oo. +Lemma nondecreasing_dvgn_lt (u_ : R ^nat) : + nondecreasing_seq u_ -> ~ cvgn u_ -> u_ @ \oo --> +oo. Proof. move=> nu du; apply: contrapT => /cvgryPge/existsNP[l lu]; apply: du. -apply: nondecreasing_is_cvg => //; exists l => _ [n _ <-]. +apply: nondecreasing_is_cvgn => //; exists l => _ [n _ <-]. rewrite leNgt; apply/negP => lun; apply: lu; near=> m. by rewrite (le_trans (ltW lun)) //; apply: nu; near: m; exists n. Unshelve. all: by end_near. Qed. -Lemma near_nondecreasing_is_cvg (u_ : R ^nat) (M : R) : +Lemma near_nondecreasing_is_cvgn (u_ : R ^nat) (M : R) : {near \oo, nondecreasing_seq u_} -> (\forall n \near \oo, u_ n <= M) -> - cvg u_. + cvgn u_. Proof. -move=> [k _ u_nd] [k' _ u_M]; suff : cvg [sequence u_ (n + maxn k k')%N]_n. +move=> [k _ u_nd] [k' _ u_M]. +suff : cvgn [sequence u_ (n + maxn k k')%N]_n. by case/cvg_ex => /= l; rewrite cvg_shiftn => ul; apply/cvg_ex; exists l. -apply: nondecreasing_is_cvg; [move=> /= m n mn|exists M => _ [n _ <-]]. +apply: nondecreasing_is_cvgn; [move=> /= m n mn|exists M => _ [n _ <-]]. by rewrite u_nd ?leq_add2r//= (leq_trans (leq_maxl _ _) (leq_addl _ _)). by rewrite u_M //= (leq_trans (leq_maxr _ _) (leq_addl _ _)). Qed. -Lemma nonincreasing_cvg (u_ : R ^nat) : +Lemma nonincreasing_cvgn (u_ : R ^nat) : nonincreasing_seq u_ -> has_lbound (range u_) -> - u_ --> inf (u_ @` setT). + u_ @ \oo --> inf (u_ @` setT). Proof. -rewrite -nondecreasing_opp => u_nd u_lb; rewrite -[X in X --> _](opprK u_). -apply: cvgN; rewrite image_comp; apply: nondecreasing_cvg => //. +rewrite -nondecreasing_opp => u_nd u_lb; rewrite -[X in X @ _ --> _](opprK u_). +apply: cvgN; rewrite image_comp; apply: nondecreasing_cvgn => //. by move/has_lb_ubN : u_lb; rewrite image_comp. Qed. -Lemma nonincreasing_is_cvg (u_ : R ^nat) : - nonincreasing_seq u_ -> has_lbound (range u_) -> cvg u_. -Proof. by move=> u_decr u_bnd; apply: cvgP; apply: nonincreasing_cvg. Qed. +Lemma nonincreasing_is_cvgn (u_ : R ^nat) : + nonincreasing_seq u_ -> has_lbound (range u_) -> cvgn u_. +Proof. by move=> u_decr u_bnd; apply: cvgP; exact: nonincreasing_cvgn. Qed. -Lemma near_nonincreasing_is_cvg (u_ : R ^nat) (m : R) : +Lemma near_nonincreasing_is_cvgn (u_ : R ^nat) (m : R) : {near \oo, nonincreasing_seq u_} -> (\forall n \near \oo, m <= u_ n) -> - cvg u_. + cvgn u_. Proof. move=> u_ni u_m. -rewrite -(opprK u_); apply: is_cvgN; apply/(@near_nondecreasing_is_cvg _ (- m)). -- by apply: filterS u_ni => x u_x y xy; rewrite ler_oppl opprK u_x. -- by apply: filterS u_m => x u_x; rewrite ler_oppl opprK. +rewrite -(opprK u_); apply: is_cvgN; apply/(@near_nondecreasing_is_cvgn _ (- m)). +- by apply: filterS u_ni => x u_x y xy; rewrite lerNl opprK u_x. +- by apply: filterS u_m => x u_x; rewrite lerNl opprK. Qed. Lemma adjacent (u_ v_ : R ^nat) : nondecreasing_seq u_ -> nonincreasing_seq v_ -> - (v_ - u_) --> (0 : R) -> [/\ lim v_ = lim u_, cvg u_ & cvg v_]. + v_ - u_ @ \oo --> (0 : R) -> + [/\ limn v_ = limn u_, cvgn u_ & cvgn v_]. Proof. set w_ := v_ - u_ => iu dv w0; have vu n : v_ n >= u_ n. - suff : lim w_ <= w_ n by rewrite (cvg_lim _ w0)// subr_ge0. - apply: (nonincreasing_cvg_ge _ (cvgP _ w0)) => m p mp. - by rewrite ler_sub; rewrite ?iu ?dv. -have cu : cvg u_. - apply: nondecreasing_is_cvg => //; exists (v_ 0%N) => _ [n _ <-]. + suff : limn w_ <= w_ n by rewrite (cvg_lim _ w0)// subr_ge0. + apply: (nonincreasing_cvgn_ge _ (cvgP _ w0)) => m p mp. + by rewrite lerB; rewrite ?iu ?dv. +have cu : cvgn u_. + apply: nondecreasing_is_cvgn => //; exists (v_ 0%N) => _ [n _ <-]. by rewrite (le_trans (vu _)) // dv. -have cv : cvg v_. - apply: nonincreasing_is_cvg => //; exists (u_ 0%N) => _ [n _ <-]. +have cv : cvgn v_. + apply: nonincreasing_is_cvgn => //; exists (u_ 0%N) => _ [n _ <-]. by rewrite (le_trans _ (vu _)) // iu. by split=> //; apply/eqP; rewrite -subr_eq0 -limB //; exact/eqP/cvg_lim. Qed. End sequences_R_lemmas. +#[deprecated(since="mathcomp-analysis 0.6.6", + note="renamed to `nonincreasing_cvgn`")] +Notation nonincreasing_cvg := nonincreasing_cvgn (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", + note="renamed to `nondecreasing_cvgn`")] +Notation nondecreasing_cvg := nondecreasing_cvgn (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", + note="renamed to `nonincreasing_is_cvgn`")] +Notation nonincreasing_is_cvg := nonincreasing_is_cvgn (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", + note="renamed to `nondecreasing_is_cvgn`")] +Notation nondecreasing_is_cvg := nondecreasing_is_cvgn (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", + note="renamed to `nondecreasing_dvgn_lt`")] +Notation nondecreasing_dvg_lt := nondecreasing_dvgn_lt (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", + note="renamed to `near_nondecreasing_is_cvgn`")] +Notation near_nondecreasing_is_cvg := near_nondecreasing_is_cvgn (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", + note="renamed to `near_nonincreasing_is_cvgn`")] +Notation near_nonincreasing_is_cvg := near_nonincreasing_is_cvgn (only parsing). Definition harmonic {R : fieldType} : R ^nat := [sequence n.+1%:R^-1]_n. Arguments harmonic {R} n /. @@ -754,22 +806,25 @@ Proof. by rewrite /=. Qed. Lemma harmonic_ge0 {R : numFieldType} i : 0 <= harmonic i :> R. Proof. exact/ltW/harmonic_gt0. Qed. -Lemma cvg_harmonic {R : archiFieldType} : harmonic --> (0 : R). +Lemma cvg_harmonic {R : archiFieldType} : @harmonic R @ \oo --> 0. Proof. apply/cvgrPdist_le => _/posnumP[e]; near=> i. -rewrite distrC subr0 ger0_norm//= -lef_pinv ?qualifE// invrK. +rewrite distrC subr0 ger0_norm//= -lef_pV2 ?qualifE//= invrK. rewrite (le_trans (ltW (archi_boundP _)))// ler_nat -add1n -leq_subLR. by near: i; apply: nbhs_infty_ge. Unshelve. all: by end_near. Qed. -Lemma dvg_harmonic (R : numFieldType) : ~ cvg (series (@harmonic R)). +Lemma cvge_harmonic {R : archiFieldType} : (EFin \o @harmonic R) @ \oo --> 0%E. +Proof. by apply: cvg_EFin; [exact: nearW | exact: cvg_harmonic]. Qed. + +Lemma dvg_harmonic (R : numFieldType) : ~ cvgn (series (@harmonic R)). Proof. have ge_half n : (0 < n)%N -> 2^-1 <= \sum_(n <= i < n.*2) harmonic i. case: n => // n _. rewrite (@le_trans _ _ (\sum_(n.+1 <= i < n.+1.*2) n.+1.*2%:R^-1)) //=. rewrite sumr_const_nat -addnn addnK addnn -mul2n natrM invfM. by rewrite -[_ *+ n.+1]mulr_natr divfK. - by apply: ler_sum_nat => i /andP[? ?]; rewrite lef_pinv ?qualifE ?ler_nat. + by apply: ler_sum_nat => i /andP[? ?]; rewrite lef_pV2 ?qualifE/= ?ler_nat. move/cvg_cauchy/cauchy_ballP => /(_ _ [gt0 of 2^-1 : R]); rewrite !near_map2. rewrite -ball_normE => /nearP_dep hcvg; near \oo => n; near \oo => m. have: `|series harmonic n - series harmonic m| < 2^-1 :> R by near: m; near: n. @@ -778,7 +833,7 @@ rewrite sub_series_geq; last by near: m; apply: nbhs_infty_ge. rewrite -addrA sub_series_geq -addnn ?leq_addr// addnn. have sh_ge0 i j : 0 <= \sum_(i <= k < j) harmonic k :> R. by rewrite ?sumr_ge0//; move=> k _; apply: harmonic_ge0. -by rewrite ger0_norm// ler_paddl// ge_half//; near: n. +by rewrite ger0_norm// ler_wpDl// ge_half//; near: n. Unshelve. all: by end_near. Qed. Definition arithmetic_mean (R : numDomainType) (u_ : R ^nat) : R ^nat := @@ -795,27 +850,28 @@ Definition root_mean_square (R : realType) (u_ : R ^nat) : R ^nat := Section cesaro. Variable R : archiFieldType. -Theorem cesaro (u_ : R ^nat) (l : R) : u_ --> l -> arithmetic_mean u_ --> l. +Theorem cesaro (u_ : R ^nat) (l : R) : u_ @ \oo --> l -> + arithmetic_mean u_ @ \oo --> l. Proof. move=> u0_cvg; have ssplit v_ m n : (m <= n)%N -> `|n%:R^-1 * series v_ n| <= n%:R^-1 * `|series v_ m| + n%:R^-1 * `|\sum_(m <= i < n) v_ i|. - move=> /subnK<-; rewrite series_addn mulrDr (le_trans (ler_norm_add _ _))//. + move=> /subnK<-; rewrite series_addn mulrDr (le_trans (ler_normD _ _))//. by rewrite !normrM ger0_norm. apply/cvgrPdist_lt=> _/posnumP[e]; near \oo => m; near=> n. have {}/ssplit -/(_ _ [sequence l - u_ n]_n) : (m.+1 <= n.+1)%nat. by near: n; exists m. rewrite !seriesEnat /= big_split/=. rewrite sumrN mulrBr sumr_const_nat -(mulr_natl l) mulKf//. -move=> /le_lt_trans->//; rewrite [e%:num]splitr ltr_add//. +move=> /le_lt_trans->//; rewrite [e%:num]splitr ltrD//. have [->|neq0] := eqVneq (\sum_(0 <= k < m.+1) (l - u_ k)) 0. by rewrite normr0 mulr0. - rewrite -ltr_pdivl_mulr ?normr_gt0//. - rewrite -ltf_pinv ?qualifE// ?mulr_gt0 ?invr_gt0 ?normr_gt0// invrK. + rewrite -ltr_pdivlMr ?normr_gt0//. + rewrite -ltf_pV2 ?qualifE//= ?mulr_gt0 ?invr_gt0 ?normr_gt0// invrK. rewrite (lt_le_trans (archi_boundP _))// ler_nat leqW//. by near: n; apply: nbhs_infty_ge. -rewrite ltr_pdivr_mull ?ltr0n // (le_lt_trans (ler_norm_sum _ _ _)) //. +rewrite ltr_pdivrMl ?ltr0n // (le_lt_trans (ler_norm_sum _ _ _)) //. rewrite (le_lt_trans (@ler_sum_nat _ _ _ _ (fun i => e%:num / 2) _))//; last first. - by rewrite sumr_const_nat mulr_natl ltr_pmuln2l// ltn_subrL. + by rewrite sumr_const_nat mulr_natl ltr_pMn2l// ltn_subrL. move=> i /andP[mi _]; move: i mi; near: m. have : \forall x \near \oo, `|l - u_ x| < e%:num / 2. by move/cvgrPdist_lt : u0_cvg; apply. @@ -829,8 +885,8 @@ Section cesaro_converse. Variable R : archiFieldType. Let cesaro_converse_off_by_one (u_ : R ^nat) : - [sequence n.+1%:R^-1 * series u_ n.+1]_ n --> (0 : R) -> - [sequence n.+1%:R^-1 * series u_ n]_ n --> (0 : R). + [sequence n.+1%:R^-1 * series u_ n.+1]_n @ \oo --> (0 : R) -> + [sequence n.+1%:R^-1 * series u_ n]_n @ \oo --> (0 : R). Proof. move=> H; apply/cvgrPdist_lt => _/posnumP[e]. move/cvgrPdist_lt : H => /(_ _ (gt0 e)) -[m _ mu]. @@ -839,17 +895,18 @@ have /andP[n0] : ((0 < n) && (m <= n.-1))%N. near: n; exists m.+1 => // k mk; rewrite (leq_trans _ mk) //=. by rewrite -(leq_add2r 1%N) !addn1 prednK // (leq_trans _ mk). move/mu => {mu}; rewrite sub0r normrN /= prednK //; apply: le_lt_trans. -rewrite !normrM ler_wpmul2r // ger0_norm // ger0_norm //. -by rewrite lef_pinv // ?ler_nat // posrE // ltr0n. +rewrite !normrM ler_wpM2r // ger0_norm // ger0_norm //. +by rewrite lef_pV2 // ?ler_nat // posrE // ltr0n. Unshelve. all: by end_near. Qed. Lemma cesaro_converse (u_ : R ^nat) (l : R) : - telescope u_ =o_\oo harmonic -> arithmetic_mean u_ --> l -> u_ --> l. + telescope u_ =o_\oo @harmonic R -> + arithmetic_mean u_ @ \oo --> l -> u_ @ \oo --> l. Proof. pose a_ := telescope u_ => a_o u_l. suff abel : forall n, u_ n - arithmetic_mean u_ n = \sum_(1 <= k < n.+1) k%:R / n.+1%:R * a_ k.-1. - suff K : u_ - arithmetic_mean u_ --> (0 : R). + suff K : u_ - arithmetic_mean u_ @ \oo --> (0 : R). rewrite -(add0r l). rewrite (_ : u_ = u_ - arithmetic_mean u_ + arithmetic_mean u_); last first. by rewrite funeqE => n; rewrite subrK. @@ -861,15 +918,15 @@ suff abel : forall n, fun n => n.+1%:R^-1 * \sum_(0 <= k < n) k.+1%:R * a_ k); last first. rewrite funeqE => n; rewrite big_add1 /= /= big_distrr /=. by apply eq_bigr => i _; rewrite mulrCA mulrA. - have {}a_o : [sequence n.+1%:R * telescope u_ n]_n --> (0 : R). + have {}a_o : [sequence n.+1%:R * telescope u_ n]_n @ \oo --> (0 : R). apply: (@eqolim0 _ _ _ eventually_filterType). rewrite a_o. - set h := 'o_[filter of \oo] harmonic. + set h := 'o_\oo (@harmonic R). apply/eqoP => _/posnumP[e] /=. - near=> n; rewrite normr1 mulr1 normrM -ler_pdivl_mull// ?normr_gt0//. + near=> n; rewrite normr1 mulr1 normrM -ler_pdivlMl// ?normr_gt0//. rewrite mulrC -normrV ?unitfE //. near: n. - by case: (eqoP eventually_filterType harmonic h) => Hh _; apply Hh. + by case: (eqoP eventually_filterType (@harmonic R) h) => Hh _; apply Hh. move: (cesaro a_o); rewrite /arithmetic_mean /series /= -/a_. exact: (@cesaro_converse_off_by_one (fun k => k.+1%:R * a_ k)). case => [|n]. @@ -882,28 +939,28 @@ rewrite -(mulr_natl (u_ O)) mulrA mulVr ?unitfE ?pnatr_eq0 // mul1r opprD addrA. rewrite eq_sum_telescope (addrC (u_ O)) addrK. rewrite [X in _ - _ * X](_ : _ = \sum_(0 <= i < n.+1) \sum_(0 <= k < n.+1 | (k < i.+1)%N) a_ k); last first. - rewrite !big_mkord; apply eq_bigr => i _. - by rewrite seriesEord/= big_mkord -big_ord_widen//. + rewrite !big_mkord; apply: eq_bigr => i _. + by rewrite seriesEord/= big_mkord -big_ord_widen. rewrite (exchange_big_dep_nat xpredT) //=. rewrite [X in _ - _ * X](_ : _ = \sum_(0 <= i < n.+1) \sum_(i <= j < n.+1) a_ i ); last first. - apply congr_big_nat => //= i ni. + apply: congr_big_nat => //= i ni. rewrite big_const_nat iter_addr addr0 -big_filter. rewrite big_const_seq iter_addr addr0; congr (_ *+ _). rewrite /index_iota subn0 -[in LHS](subnKC (ltnW ni)) iotaD filter_cat. rewrite count_cat (_ : [seq _ <- _ | _] = [::]); last first. - rewrite -(filter_pred0 (iota 0 i)); apply eq_in_filter => j. + rewrite -(filter_pred0 (iota 0 i)); apply: eq_in_filter => j. by rewrite mem_iota leq0n andTb add0n => ji; rewrite ltnNge ji. rewrite 2!add0n (_ : [seq _ <- _ | _] = iota i (n.+1 - i)); last first. - rewrite -[RHS]filter_predT; apply eq_in_filter => j. + rewrite -[RHS]filter_predT; apply: eq_in_filter => j. rewrite mem_iota => /andP[ij]; rewrite subnKC; last exact/ltnW. by move=> jn; rewrite ltnS ij. by rewrite count_predT size_iota. rewrite [X in _ - _ * X](_ : _ = \sum_(0 <= i < n.+1) a_ i * (n.+1 - i)%:R); last first. - by apply eq_bigr => i _; rewrite big_const_nat iter_addr addr0 mulr_natr. + by apply: eq_bigr => i _; rewrite big_const_nat iter_addr addr0 mulr_natr. rewrite big_distrr /= big_mkord (big_morph _ (@opprD _) (@oppr0 _)). -rewrite seriesEord -big_split /= big_add1 /= big_mkord; apply eq_bigr => i _. +rewrite seriesEord -big_split /= big_add1 /= big_mkord; apply: eq_bigr => i _. rewrite mulrCA -[X in X - _]mulr1 -mulrBr [RHS]mulrC; congr (_ * _). rewrite -[X in X - _](@divrr _ (n.+2)%:R) ?unitfE ?pnatr_eq0 //. rewrite [in X in _ - X]mulrC -mulrBl; congr (_ / _). @@ -916,12 +973,13 @@ End cesaro_converse. Section series_convergence. Lemma cvg_series_cvg_0 (K : numFieldType) (V : normedModType K) (u_ : V ^nat) : - cvg (series u_) -> u_ --> (0 : V). + cvgn (series u_) -> u_ @ \oo --> (0 : V). Proof. move=> cvg_series. rewrite (_ : u_ = fun n => series u_ n.+1 - series u_ n); last first. by rewrite funeqE => i; rewrite seriesSB. -by rewrite -(subrr (lim (series u_))); apply: cvgB => //; rewrite ?cvg_shiftS. +rewrite -(subrr (limn (series u_))). +by apply: cvgB => //; rewrite ?cvg_shiftS. Qed. Lemma nondecreasing_series (R : numFieldType) (u_ : R ^nat) (P : pred nat) : @@ -930,14 +988,14 @@ Lemma nondecreasing_series (R : numFieldType) (u_ : R ^nat) (P : pred nat) : Proof. move=> u_ge0; apply/nondecreasing_seqP => n. rewrite [in leRHS]big_mkcond [in leRHS]big_nat_recr//=. -by rewrite -[in leRHS]big_mkcond/= ler_addl; case: ifPn => //; exact: u_ge0. +by rewrite -[in leRHS]big_mkcond/= lerDl; case: ifPn => //; exact: u_ge0. Qed. Lemma increasing_series (R : numFieldType) (u_ : R ^nat) : (forall n, 0 < u_ n) -> increasing_seq (series u_). Proof. move=> u_ge0; apply/increasing_seqP => n. -by rewrite !seriesEord/= big_ord_recr ltr_addl. +by rewrite !seriesEord/= big_ord_recr ltrDl. Qed. End series_convergence. @@ -955,25 +1013,25 @@ Lemma exprn_geometric (R : fieldType) : (@GRing.exp R) = geometric 1. Proof. by rewrite funeq2E => z n /=; rewrite mul1r. Qed. Lemma cvg_arithmetic (R : archiFieldType) a (z : R) : - z > 0 -> arithmetic a z --> +oo. + z > 0 -> arithmetic a z @ \oo --> +oo. Proof. move=> z_gt0; apply/cvgryPge => A; near=> n => /=. -rewrite -ler_subl_addl -mulr_natl -ler_pdivr_mulr//. +rewrite -lerBlDl -mulr_natl -ler_pdivrMr//. rewrite ler_normlW// ltW// (lt_le_trans (archi_boundP _))// ler_nat. by near: n; apply: nbhs_infty_ge. Unshelve. all: by end_near. Qed. Lemma cvg_expr (R : archiFieldType) (z : R) : - `|z| < 1 -> (GRing.exp z : R ^nat) --> (0 : R). + `|z| < 1 -> (GRing.exp z : R ^nat) @ \oo --> (0 : R). Proof. move=> Nz_lt1; apply/norm_cvg0P; pose t := (1 - `|z|). -apply: (@squeeze_cvgr _ _ _ _ (cst 0) _ (t^-1 *: @harmonic R)); last 2 first. +apply: (@squeeze_cvgr _ _ _ _ (cst 0) (t^-1 *: @harmonic R)); last 2 first. - exact: cvg_cst. - by rewrite -(scaler0 _ t^-1); exact: (cvgZr cvg_harmonic). -near=> n; rewrite normr_ge0 normrX/= ler_pdivl_mull ?subr_gt0//. -rewrite -(@ler_pmul2l _ n.+1%:R)// mulfV// [t * _]mulrC mulr_natl. +near=> n; rewrite normr_ge0 normrX/= ler_pdivlMl ?subr_gt0//. +rewrite -(@ler_pM2l _ n.+1%:R)// mulfV// [t * _]mulrC mulr_natl. have -> : 1 = (`|z| + t) ^+ n.+1 by rewrite addrC addrNK expr1n. -rewrite exprDn (bigD1 (inord 1)) ?inordK// subn1 expr1 bin1 ler_addl sumr_ge0//. +rewrite exprDn (bigD1 (inord 1)) ?inordK// subn1 expr1 bin1 lerDl sumr_ge0//. by move=> i; rewrite ?(mulrn_wge0, mulr_ge0, exprn_ge0, subr_ge0)// ltW. Unshelve. all: by end_near. Qed. @@ -987,7 +1045,7 @@ by under eq_bigr do rewrite -mulrA -exprSr; rewrite telescope_sumr// opprB. Qed. Lemma cvg_geometric_series (R : archiFieldType) (a z : R) : `|z| < 1 -> - series (geometric a z) --> (a * (1 - z)^-1). + series (geometric a z) @ \oo --> (a * (1 - z)^-1). Proof. move=> Nz_lt1; rewrite geometric_seriesE ?lt_eqF 1?ltr_normlW//. have -> : a / (1 - z) = (a * (1 - 0)) / (1 - z) by rewrite subr0 mulr1. @@ -995,10 +1053,10 @@ by apply: cvgMl; apply: cvgMr; apply: cvgB; [apply: cvg_cst|apply: cvg_expr]. Qed. Lemma cvg_geometric_series_half (R : archiFieldType) (r : R) n : - series (fun k => r / (2 ^ (k + n.+1))%:R : R^o) --> (r / 2 ^+ n : R^o). + series (fun k => r / (2 ^ (k + n.+1))%:R : R^o) @ \oo --> (r / 2 ^+ n : R^o). Proof. rewrite (_ : series _ = series (geometric (r / (2 ^ n.+1)%:R) 2^-1%R)); last first. - rewrite funeqE => m; rewrite /series /=; apply eq_bigr => k _. + rewrite funeqE => m; rewrite /series /=; apply: eq_bigr => k _. by rewrite expnD natrM (mulrC (2 ^ k)%:R) invfM exprVn (natrX _ 2 k) mulrA. apply: cvg_trans. apply: cvg_geometric_series. @@ -1008,12 +1066,18 @@ by rewrite -mulrA -invfM expnSr natrM -mulrA divff// mulr1 natrX. Qed. Arguments cvg_geometric_series_half {R} _ _. +Lemma geometric_partial_tail {R : fieldType} (n m : nat) (x : R) : + \sum_(m <= i < m + n) x ^+ i = series (geometric (x ^+ m) x) n. +Proof. +by rewrite (big_addn 0 _ m) addnC addnK; under eq_bigr do rewrite exprD mulrC. +Qed. + Lemma cvg_geometric (R : archiFieldType) (a z : R) : `|z| < 1 -> - geometric a z --> (0 : R). + geometric a z @ \oo --> (0 : R). Proof. by move=> /cvg_geometric_series/cvgP/cvg_series_cvg_0. Qed. Lemma is_cvg_geometric_series (R : archiFieldType) (a z : R) : `|z| < 1 -> - cvg (series (geometric a z)). + cvgn (series (geometric a z)). Proof. by move=> /cvg_geometric_series/cvgP; apply. Qed. Definition normed_series_of (K : numDomainType) (V : normedModType K) @@ -1045,16 +1109,16 @@ Unshelve. all: by end_near. Qed. Lemma series_le_cvg (R : realType) (u_ v_ : R ^nat) : (forall n, 0 <= u_ n) -> (forall n, 0 <= v_ n) -> (forall n, u_ n <= v_ n) -> - cvg (series v_) -> cvg (series u_). + cvgn (series v_) -> cvgn (series u_). Proof. move=> u_ge0 v_ge0 le_uv /cvg_seq_bounded/bounded_fun_has_ubound[M v_M]. -apply: nondecreasing_is_cvg; first exact: nondecreasing_series. +apply: nondecreasing_is_cvgn; first exact: nondecreasing_series. exists M => _ [n _ <-]. by apply: le_trans (v_M (series v_ n) _); [apply: ler_sum | exists n]. Qed. Lemma normed_cvg {R : realType} (V : completeNormedModType R) (u_ : V ^nat) : - cvg [normed series u_] -> cvg (series u_). + cvgn [normed series u_] -> cvgn (series u_). Proof. move=> /cauchy_cvgP/cauchy_seriesP u_ncvg. apply/cauchy_cvgP/cauchy_seriesP => e /u_ncvg. @@ -1063,7 +1127,8 @@ by apply: le_lt_trans; apply: ler_norm_sum. Qed. Lemma lim_series_norm {R : realType} (V : completeNormedModType R) (f : V ^nat) : - cvg [normed series f] -> `|lim (series f)| <= lim [normed series f]. + cvgn [normed series f] -> + `|limn (series f)| <= limn [normed series f]. Proof. move=> cnf; have cf := normed_cvg cnf. rewrite -lim_norm // (ler_lim (is_cvg_norm cf) cnf) //. @@ -1073,12 +1138,12 @@ Unshelve. all: by end_near. Qed. Section series_linear. Lemma cvg_series_bounded (R : realFieldType) (f : R ^nat) : - cvg (series f) -> bounded_fun f. + cvgn (series f) -> bounded_fun f. Proof. by move/cvg_series_cvg_0 => f0; apply/cvg_seq_bounded/cvg_ex; exists 0. Qed. -Lemma cvg_to_0_linear (R : realFieldType) (f : R -> R) K k : +Lemma cvg_to_0_linear (R : realFieldType) (f : R -> R) K (k : R) : 0 < k -> (forall r, 0 < `| r | < k -> `|f r| <= K * `| r |) -> f x @[x --> 0^'] --> 0. Proof. @@ -1089,25 +1154,25 @@ move=> k0 kfK; have [K0|K0] := lerP K 0. near: x; exists (k / 2); first by rewrite /mkset divr_gt0. move=> t /=; rewrite distrC subr0 => tk2 t0. by rewrite normr_gt0 t0 (lt_trans tk2) // -[in ltLHS](add0r k) midf_lt. -- apply/eqolim0/eqoP => _/posnumP[e]; near=> x. +- apply/(@eqolim0 _ _ R (0^'))/eqoP => _/posnumP[e]; near=> x. rewrite (le_trans (kfK _ _)) //=. + near: x; exists (k / 2); first by rewrite /mkset divr_gt0. move=> t /=; rewrite distrC subr0 => tk2 t0. by rewrite normr_gt0 t0 (lt_trans tk2) // -[in ltLHS](add0r k) midf_lt. - + rewrite normr1 mulr1 mulrC -ler_pdivl_mulr //. + + rewrite normr1 mulr1 mulrC -ler_pdivlMr //. near: x; exists (e%:num / K); first by rewrite /mkset divr_gt0. by move=> t /=; rewrite distrC subr0 => /ltW. Unshelve. all: by end_near. Qed. Lemma lim_cvg_to_0_linear (R : realType) (f : nat -> R) (g : R -> nat -> R) k : - 0 < k -> cvg (series f) -> + 0 < k -> cvgn (series f) -> (forall r, 0 < `|r| < k -> forall n, `|g r n| <= f n * `| r |) -> - lim (series (g x)) @[x --> 0^'] --> 0. + limn (series (g x)) @[x --> 0^'] --> 0. Proof. move=> k_gt0 Cf Hg. -apply: (@cvg_to_0_linear _ _ (lim (series f)) k) => // h hLk; rewrite mulrC. -have Ckf := @is_cvg_seriesZ _ _ `|h| Cf. -have Cng : cvg [normed series (g h)]. +apply: (@cvg_to_0_linear _ _ (limn (series f)) k) => // h hLk; rewrite mulrC. +have Ckf : cvgn (series (`|h| *: f)) := @is_cvg_seriesZ _ _ `|h| Cf. +have Cng : cvgn [normed series (g h)]. apply: series_le_cvg (Hg _ hLk) _ => [//|?|]. exact: le_trans (Hg _ hLk _). by under eq_fun do rewrite mulrC. @@ -1143,16 +1208,16 @@ Hypothesis x0 : 0 < x. Let S0 N n := (N ^ N)%:R * \sum_(N.+1 <= i < n) (x / N%:R) ^+ i. -Let is_cvg_S0 N : x < N%:R -> cvg (S0 N). +Let is_cvg_S0 N : x < N%:R -> cvgn (S0 N). Proof. move=> xN; apply: is_cvgZr; rewrite is_cvg_series_restrict exprn_geometric. apply/is_cvg_geometric_series; rewrite normrM normfV. -by rewrite ltr_pdivr_mulr ?mul1r !ger0_norm // 1?ltW // (lt_trans x0). +by rewrite ltr_pdivrMr ?mul1r !ger0_norm // 1?ltW // (lt_trans x0). Qed. Let S0_ge0 N n : 0 <= S0 N n. Proof. -rewrite mulr_ge0 // ?ler0n //; apply sumr_ge0 => i _. +rewrite mulr_ge0 // ?ler0n //; apply: sumr_ge0 => i _. by rewrite exprn_ge0 // divr_ge0 // ltW. Qed. @@ -1170,20 +1235,20 @@ Lemma incr_S1 N : nondecreasing_seq (S1 N). Proof. apply/nondecreasing_seqP => n; rewrite /S1. have [nN|Nn] := leqP n N; first by rewrite !big_geq // (leq_trans nN). -by rewrite big_nat_recr//= ler_addl exp_coeff_ge0 // ltW. +by rewrite big_nat_recr//= lerDl exp_coeff_ge0 // ltW. Qed. Let S1_sup N : x < N%:R -> ubound (range (S1 N)) (sup (range (S0 N))). Proof. move=> xN _ [n _ <-]; rewrite (le_trans _ (S0_sup n xN)) // /S0 big_distrr /=. -have N_gt0 := lt_trans x0 xN; apply ler_sum => i _. +have N_gt0 := lt_trans x0 xN; apply: ler_sum => i _. have [Ni|iN] := ltnP N i; last first. - rewrite expr_div_n mulrCA ler_pmul2l ?exprn_gt0// (@le_trans _ _ 1) //. + rewrite expr_div_n mulrCA ler_pM2l ?exprn_gt0// (@le_trans _ _ 1) //. by rewrite invf_le1// ?ler1n ?ltr0n // fact_gt0. rewrite natrX -expfB_cond ?(negPf (lt0r_neq0 N_gt0))//. by rewrite exprn_ege1 // ler1n; case: (N) xN x0; case: ltrgt0P. -rewrite /exp expr_div_n /= (fact_split Ni) mulrCA ler_pmul2l ?exprn_gt0// natrX. -rewrite -invf_div -expfB // lef_pinv ?qualifE ?exprn_gt0//; last first. +rewrite /exp expr_div_n /= (fact_split Ni) mulrCA ler_pM2l ?exprn_gt0// natrX. +rewrite -invf_div -expfB // lef_pV2 ?qualifE/= ?exprn_gt0//; last first. rewrite ltr0n muln_gt0 fact_gt0/= big_seq big_mkcond/= prodn_gt0// => j. by case: ifPn=>//; rewrite mem_index_iota => /andP[+ _]; exact: leq_ltn_trans. rewrite big_nat_rev/= -natrX ler_nat -prod_nat_const_nat big_add1 /= big_ltn //. @@ -1194,14 +1259,14 @@ move=> j; rewrite mem_index_iota => /andP[_ ji]. by rewrite -addnBA// ?leq_addr// ltnW// ltnW. Qed. -Lemma is_cvg_series_exp_coeff_pos : cvg (series (exp x)). +Lemma is_cvg_series_exp_coeff_pos : cvgn (series (exp x)). Proof. rewrite /series; near \oo => N; have xN : x < N%:R; last first. rewrite -(@is_cvg_series_restrict N.+1). - by apply: (nondecreasing_is_cvg (incr_S1 N)); eexists; apply: S1_sup. + by apply: (nondecreasing_is_cvgn (incr_S1 N)); eexists; apply: S1_sup. near: N; exists (absz (floor x)).+1 => // m; rewrite /mkset -(@ler_nat R). move/lt_le_trans => -> //; rewrite (lt_le_trans (lt_succ_floor x)) // -addn1. -by rewrite natrD ler_add2r -(@gez0_abs (floor x)) ?floor_ge0// ltW. +by rewrite natrD lerD2r -(@gez0_abs (floor x)) ?floor_ge0// ltW. Unshelve. all: by end_near. Qed. End exponential_series_cvg. @@ -1212,7 +1277,7 @@ rewrite funeqE => n /=; apply: eq_bigr => k _. by rewrite /exp normrM normfV normrX [`|_%:R|]@ger0_norm. Qed. -Lemma is_cvg_series_exp_coeff x : cvg (series (exp x)). +Lemma is_cvg_series_exp_coeff x : cvgn (series (exp x)). Proof. have [->|x0] := eqVneq x 0. apply/cvg_ex; exists 1; apply/cvgrPdist_lt => // => _/posnumP[e]. @@ -1223,39 +1288,37 @@ apply: normed_cvg; rewrite normed_series_exp_coeff. by apply: is_cvg_series_exp_coeff_pos; rewrite normr_gt0. Unshelve. all: by end_near. Qed. -Lemma cvg_exp_coeff x : exp x --> (0 : R). +Lemma cvg_exp_coeff x : exp x @ \oo --> (0 : R). Proof. exact: (cvg_series_cvg_0 (@is_cvg_series_exp_coeff x)). Qed. End exponential_series. (* TODO: generalize *) -Definition expR {R : realType} (x : R) : R := lim (series (exp_coeff x)). +Definition expR {R : realType} (x : R) : R := limn (series (exp_coeff x)). -(********************************) -(* Sequences of natural numbers *) -(********************************) +(** Sequences of natural numbers *) -Lemma __deprecated__nat_dvg_real (R : realType) (u_ : nat ^nat) : u_ --> \oo -> - ([sequence (u_ n)%:R : R^o]_n --> +oo)%R. +Lemma __deprecated__nat_dvg_real (R : realType) (u_ : nat ^nat) : + u_ @ \oo --> \oo -> ([sequence (u_ n)%:R : R^o]_n @ \oo --> +oo)%R. Proof. by move=> ?; apply/cvgrnyP. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `cvgrnyP` and generalized")] -Notation nat_dvg_real := __deprecated__nat_dvg_real. +Notation nat_dvg_real := __deprecated__nat_dvg_real (only parsing). Lemma __deprecated__nat_cvgPpinfty (u : nat^nat) : - u --> \oo <-> forall A, \forall n \near \oo, (A <= u n)%N. + u @ \oo --> \oo <-> forall A, \forall n \near \oo, (A <= u n)%N. Proof. exact: cvgnyPge. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `cvgnyPge` and generalized")] -Notation nat_cvgPpinfty:= __deprecated__nat_cvgPpinfty. +Notation nat_cvgPpinfty:= __deprecated__nat_cvgPpinfty (only parsing). Lemma nat_nondecreasing_is_cvg (u_ : nat^nat) : - nondecreasing_seq u_ -> has_ubound (range u_) -> cvg u_. + nondecreasing_seq u_ -> has_ubound (range u_) -> cvgn u_. Proof. move=> u_nd [l ul]. suff [N Nu] : exists N, forall n, (n >= N)%N -> u_ n = u_ N. apply/cvg_ex; exists (u_ N); rewrite -(cvg_shiftn N). - rewrite [X in X --> _](_ : _ = cst (u_ N))//; first exact: cvg_cst. + rewrite [X in X @ \oo --> _](_ : _ = cst (u_ N))//; first exact: cvg_cst. by apply/funext => n /=; rewrite Nu// leq_addl. apply/not_existsP => hu. have {hu}/choice[f Hf] : forall x, (exists n, x <= n /\ u_ n > u_ x)%N. @@ -1278,12 +1341,11 @@ rewrite -[in X in (_ <= X)%N](subnKC ab) iotaD big_cat/= add0n. by rewrite /index_iota subn0 leq_addr. Qed. -Lemma cvg_nseries_near (u : nat^nat) : cvg (nseries u) -> +Lemma cvg_nseries_near (u : nat^nat) : cvgn (nseries u) -> \forall n \near \oo, u n = 0%N. Proof. move=> /cvg_ex[l ul]; have /ul[a _ aul] : nbhs l [set l]. - exists [set l]; split; last by split. - by exists [set l] => //; rewrite bigcup_set1. + by exists [set l]; split=> //; exists [set l] => //; rewrite bigcup_set1. have /ul[b _ bul] : nbhs l [set l.-1; l]. by exists [set l]; split => //; exists [set l] => //; rewrite bigcup_set1. exists (maxn a b) => // n /= abn. @@ -1295,7 +1357,8 @@ have /bul[->|->] : (b <= n.+1)%N by rewrite leqW// (leq_trans _ abn)// leq_maxr. - by rewrite subnn. Qed. -Lemma dvg_nseries (u : nat^nat) : ~ cvg (nseries u) -> nseries u --> \oo. +Lemma dvg_nseries (u : nat^nat) : ~ cvgn (nseries u) -> + nseries u @ \oo --> \oo. Proof. move=> du; apply: contrapT => /cvgnyPgt/existsNP[l lu]; apply: du. apply: nat_nondecreasing_is_cvg => //; first exact: le_nseries. @@ -1303,18 +1366,16 @@ exists l => _ [n _ <-]; rewrite leNgt; apply/negP => lun; apply: lu. by near do rewrite (leq_trans lun) ?le_nseries//; apply: nbhs_infty_ge. Unshelve. all: by end_near. Qed. -(**************************************) -(* Sequences of extended real numbers *) -(**************************************) +(** Sequences of extended real numbers *) Notation "\big [ op / idx ]_ ( m <= i (\big[ op / idx ]_(m <= i < n | P) F))) : big_scope. + (limn (fun n => (\big[ op / idx ]_(m <= i < n | P) F))) : big_scope. Notation "\big [ op / idx ]_ ( m <= i (\big[ op / idx ]_(m <= i < n) F))) : big_scope. + (limn (fun n => (\big[ op / idx ]_(m <= i < n) F))) : big_scope. Notation "\big [ op / idx ]_ ( i (\big[ op / idx ]_(i < n | P) F))) : big_scope. + (limn (fun n => (\big[ op / idx ]_(i < n | P) F))) : big_scope. Notation "\big [ op / idx ]_ ( i (\big[ op / idx ]_(i < n) F))) : big_scope. + (limn (fun n => (\big[ op / idx ]_(i < n) F))) : big_scope. Notation "\sum_ ( m <= i eseries n \is a fin_num -> else - \sum_(n <= k < m) u_ k. Proof. move=> ? ?; have [mn|/ltnW mn] := leqP m n; rewrite -sub_eseries_geq//. -by rewrite oppeD ?fin_numN// oppeK addeC. +by rewrite fin_num_oppeD ?fin_numN// oppeK addeC. Qed. Lemma sub_double_eseries n : eseries n \is a fin_num -> @@ -1388,7 +1449,7 @@ Local Open Scope ereal_scope. Variable T : realDomainType. Implicit Types u : (\bar T)^nat. -Lemma ereal_nondecreasing_opp u_ : +Lemma ereal_nondecreasing_oppn u_ : nondecreasing_seq (-%E \o u_) = nonincreasing_seq u_. Proof. rewrite propeqE; split => ni_u m n mn; last by rewrite lee_oppr oppeK ni_u. @@ -1396,54 +1457,40 @@ by rewrite -(oppeK (u_ m)) -lee_oppr ni_u. Qed. End sequences_ereal_realDomainType. +#[deprecated(since="mathcomp-analysis 0.6.6", + note="renamed to `ereal_nondecreasing_oppn`")] +Notation ereal_nondecreasing_opp := ereal_nondecreasing_oppn (only parsing). Section sequences_ereal. Local Open Scope ereal_scope. Lemma __deprecated__ereal_cvg_abs0 (R : realFieldType) (f : (\bar R)^nat) : - abse \o f --> nbhs 0 -> f --> 0. + abse \o f @ \oo --> 0 -> f @ \oo --> 0. Proof. by move/cvg_abse0P. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", - note="renamed to `cvg_abse0P` and generalized")] -Notation ereal_cvg_abs0 := __deprecated__ereal_cvg_abs0. Lemma __deprecated__ereal_cvg_ge0 (R : realFieldType) (f : (\bar R)^nat) (a : \bar R) : - (forall n, 0 <= f n) -> f --> a -> 0 <= a. + (forall n, 0 <= f n) -> f @ \oo --> a -> 0 <= a. Proof. by move=> f_ge0; apply: cvge_ge; apply: nearW. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvge_ge` instead")] -Notation ereal_cvg_ge0 := __deprecated__ereal_cvg_ge0. -Lemma __deprecated__ereal_lim_ge (R : realFieldType) x (u_ : (\bar R)^nat) : cvg u_ -> - (\forall n \near \oo, x <= u_ n) -> x <= lim u_. +Lemma __deprecated__ereal_lim_ge (R : realFieldType) x (u_ : (\bar R)^nat) : + cvgn u_ -> (\forall n \near \oo, x <= u_ n) -> x <= limn u_. Proof. exact: lime_ge. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", - note="renamed to `lime_ge` and generalized")] -Notation ereal_lim_ge := __deprecated__ereal_lim_ge. -Lemma __deprecated__ereal_lim_le (R : realFieldType) x (u_ : (\bar R)^nat) : cvg u_ -> - (\forall n \near \oo, u_ n <= x) -> lim u_ <= x. +Lemma __deprecated__ereal_lim_le (R : realFieldType) x (u_ : (\bar R)^nat) : + cvgn u_ -> (\forall n \near \oo, u_ n <= x) -> limn u_ <= x. Proof. exact: lime_le. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", - note="renamed to `lime_le` and generalized")] -Notation ereal_lim_le := __deprecated__ereal_lim_le. Lemma __deprecated__dvg_ereal_cvg (R : realFieldType) (u_ : R ^nat) : - u_ --> +oo%R -> [sequence (u_ n)%:E]_n --> +oo. + u_ @ \oo --> +oo%R -> [sequence (u_ n)%:E]_n @ \oo --> +oo. Proof. by rewrite cvgeryP. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", - note="renamed to `cvgeryP` and generalized")] -Notation dvg_ereal_cvg := __deprecated__dvg_ereal_cvg. Lemma __deprecated__ereal_cvg_real (R : realFieldType) (f : (\bar R)^nat) a : {near \oo, forall x, f x \is a fin_num} /\ - (fine \o f --> a) <-> f --> a%:E. + (fine \o f @ \oo --> a) <-> f @ \oo --> a%:E. Proof. by rewrite fine_cvgP. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", - note="renamed to `fine_cvgP` and generalized")] -Notation ereal_cvg_real := __deprecated__ereal_cvg_real. -Lemma ereal_nondecreasing_cvg (R : realType) (u_ : (\bar R)^nat) : - nondecreasing_seq u_ -> u_ --> ereal_sup (u_ @` setT). +Lemma ereal_nondecreasing_cvgn (R : realType) (u_ : (\bar R)^nat) : + nondecreasing_seq u_ -> u_ @ \oo --> ereal_sup (u_ @` setT). Proof. move=> nd_u_; set S := u_ @` setT; set l := ereal_sup S. have [Spoo|Spoo] := pselect (S +oo). @@ -1451,111 +1498,72 @@ have [Spoo|Spoo] := pselect (S +oo). case: Spoo => N _ uNoo; exists N => n Nn. by move: (nd_u_ _ _ Nn); rewrite uNoo leye_eq => /eqP. have -> : l = +oo by rewrite /l /ereal_sup; exact: supremum_pinfty. - rewrite -(cvg_shiftn N); set f := (X in X --> _). + rewrite -(cvg_shiftn N); set f := (X in X @ \oo --> _). rewrite (_ : f = (fun=> +oo)); first exact: cvg_cst. by rewrite funeqE => n; rewrite /f /= Nu // leq_addl. -have [Snoo|Snoo] := pselect (u_ = fun=> -oo). - rewrite /l (_ : S = [set -oo]); last first. - rewrite predeqE => x; split => [-[n _ <-]|->]; first by rewrite Snoo. - by exists O => //; rewrite Snoo. - by rewrite ereal_sup1 Snoo; exact: cvg_cst. +have [/funext Snoo|Snoo] := pselect (forall n, u_ n = -oo). + rewrite /l (_ : S = [set -oo]). + by rewrite ereal_sup1 Snoo; exact: cvg_cst. + apply/seteqP; split => [_ [n _] <- /[!Snoo]//|_ ->]. + by rewrite /S Snoo; exists 0%N. have [/ereal_sup_ninfty loo|lnoo] := eqVneq l -oo. - suff : u_ = (fun=> -oo) by []. - by rewrite funeqE => m; apply (loo (u_ m)); exists m. -apply/cvg_ballP => _/posnumP[e]. + by exfalso; apply: Snoo => n; rewrite (loo (u_ n))//; exists n. +have {Snoo}[N Snoo] : exists N, forall n, (n >= N)%N -> u_ n != -oo. + move/existsNP : Snoo => [m /eqP]. + rewrite neq_lt => /orP[|umoo]; first by rewrite ltNge leNye. + by exists m => k mk; rewrite gt_eqF// (lt_le_trans umoo)// nd_u_. +have u_fin_num n : (n >= N)%N -> u_ n \is a fin_num. + move=> Nn; rewrite fin_numE Snoo//=; apply: contra_notN Spoo => /eqP unpoo. + by exists n. have [{lnoo}loo|lpoo] := eqVneq l +oo. - near=> n; rewrite /ball /= /ereal_ball. - have unoo : u_ n != -oo. - near: n; have [m /eqP umoo] : exists m, u_ m <> -oo. - apply/existsNP => uoo. - by apply/Snoo; rewrite funeqE => ?; rewrite uoo. - exists m => // k mk; apply: contra umoo => /eqP ukoo. - by move/nd_u_ : mk; rewrite ukoo leeNy_eq. - rewrite loo ger0_norm ?subr_ge0; last first. - by case/ler_normlP : (contract_le1 (u_ n)). - have [e2|e2] := lerP 2 e%:num. - rewrite /= ltr_subl_addr addrC -ltr_subl_addr. - case/ler_normlP : (contract_le1 (u_ n)); rewrite ler_oppl => un1 _. - rewrite (@le_lt_trans _ _ (-1)) //. - by rewrite ler_subl_addr addrC -ler_subl_addr opprK (le_trans e2). - by move: un1; rewrite le_eqVlt eq_sym contract_eqN1 (negbTE unoo). - rewrite ltr_subl_addr addrC -ltr_subl_addr -lt_expandLR ?inE//=. - near: n. - suff [n Hn] : exists n, expand (contract +oo - e%:num)%R < u_ n. - by exists n => // m nm; rewrite (lt_le_trans Hn) //; apply nd_u_. - apply/not_existsP => abs. - have : l <= expand (contract +oo - e%:num)%R. - apply: ub_ereal_sup => x [n _ <-{x}]. - rewrite leNgt; apply/negP/abs. - rewrite loo leye_eq expand_eqoo ler_sub_addr addrC -ler_sub_addr subrr. - by apply/negP; rewrite -ltNge. - have [e1|e1] := ltrP 1 e%:num. - by rewrite ler_subl_addr (le_trans (ltW e2)). - by rewrite ler_subl_addr ler_addl. + rewrite loo; apply/cvgeyPge => M. + have /ereal_sup_gt[_ [n _] <- Mun] : M%:E < l by rewrite loo// ltry. + by exists n => // m /= nm; rewrite (le_trans (ltW Mun))// nd_u_. have l_fin_num : l \is a fin_num by rewrite fin_numE lpoo lnoo. -have [le1|le1] := (ltrP (`|contract l - e%:num|) 1)%R; last first. - near=> n; rewrite /ball /= /ereal_ball /=. - have unoo : u_ n != -oo. - near: n. - have [m /eqP umoo] : exists m, u_ m <> -oo. - apply/existsNP => uoo. - by apply/Snoo; rewrite funeqE => ?; rewrite uoo. - exists m => // k mk; apply: contra umoo => /eqP ukoo. - by move/nd_u_ : mk; rewrite ukoo leeNy_eq. - rewrite ger0_norm ?subr_ge0 ?le_contract ?ereal_sup_ub//; last by exists n. - have [l0|l0] := ger0P (contract l). - have el : (e%:num > contract l)%R. - rewrite ltNge; apply/negP => er. - rewrite ger0_norm ?subr_ge0// -ler_subl_addr opprK in le1. - case/ler_normlP : (contract_le1 l) => _ /(le_trans le1); apply/negP. - by rewrite -ltNge ltr_addl. - rewrite ltr0_norm ?subr_lt0// opprB in le1. - rewrite ltr_subl_addr addrC -ltr_subl_addr -opprB ltr_oppl. - rewrite (lt_le_trans _ le1) // lt_neqAle eqr_oppLR contract_eqN1 unoo /=. - by case/ler_normlP : (contract_le1 (u_ n)). - rewrite ler0_norm in le1; last by rewrite subr_le0 (le_trans (ltW l0)). - rewrite opprB ler_subr_addr addrC -ler_subr_addr in le1. - rewrite ltr_subl_addr (le_lt_trans le1) // -ltr_subl_addl addrAC subrr add0r. - rewrite lt_neqAle eq_sym contract_eqN1 unoo /=. - by case/ler_normlP : (contract_le1 (u_ n)); rewrite ler_oppl. -pose e' := - (fine l - fine (expand (contract l - e%:num)))%R. -have e'0 : (0 < e')%R. - rewrite /e' subr_gt0 -lte_fin fine_expand //. - rewrite lt_expandLR ?inE ?ltW// ltr_subl_addr fineK //. - by rewrite ltr_addl. -have [y [m _ umx] Se'y] := ub_ereal_sup_adherent e'0 l_fin_num. -near=> n; rewrite /ball /= /ereal_ball /=. -rewrite ger0_norm ?subr_ge0 ?le_contract ?ereal_sup_ub//; last by exists n. -move: Se'y; rewrite -{}umx {y} /= => le'um. -have leum : (contract l - e%:num < contract (u_ m))%R. - rewrite -lt_expandLR ?inE ?ltW//. - move: le'um; rewrite /e' EFinN /= opprB EFinB. - rewrite (fineK l_fin_num) fine_expand //. - by rewrite addeCA subee // adde0. -rewrite ltr_subl_addr addrC -ltr_subl_addr (lt_le_trans leum) //. -by rewrite le_contract nd_u_//; near: n; exists m. +rewrite -(@fineK _ l)//; apply/fine_cvgP; split. + near=> n; rewrite fin_numE Snoo/=; last by near: n; exists N. + by apply: contra_notN Spoo => /eqP unpoo; exists n. +rewrite -(cvg_shiftn N); set v_ := [sequence _]_ _. +have <- : sup (range v_) = fine l. + apply: EFin_inj; rewrite -ereal_sup_EFin//; last 2 first. + - exists (fine l) => /= _ [m _ <-]; rewrite /v_ /= fine_le//. + by rewrite u_fin_num// leq_addl. + by apply: ereal_sup_ub; exists (m + N)%N. + - by exists (v_ 0%N), 0%N. + rewrite fineK//; apply/eqP; rewrite eq_le; apply/andP; split. + apply: le_ereal_sup => _ /= [_ [m _] <-] <-. + by exists (m + N)%N => //; rewrite /v_/= fineK// u_fin_num// leq_addl. + apply: ub_ereal_sup => /= _ [m _] <-. + rewrite (@le_trans _ _ (u_ (m + N)%N))//; first by rewrite nd_u_// leq_addr. + apply: ereal_sup_ub => /=; exists (fine (u_ (m + N)%N)); first by exists m. + by rewrite fineK// u_fin_num// leq_addl. +apply: nondecreasing_cvgn. +- move=> m n mn /=; rewrite /v_ /= fine_le ?u_fin_num ?leq_addl//. + by rewrite nd_u_// leq_add2r. +- exists (fine l) => /= _ [m _ <-]; rewrite /v_ /= fine_le//. + by rewrite u_fin_num// leq_addl. + by apply: ereal_sup_ub; exists (m + N)%N. Unshelve. all: by end_near. Qed. -Lemma ereal_nondecreasing_is_cvg (R : realType) (u_ : (\bar R) ^nat) : - nondecreasing_seq u_ -> cvg u_. -Proof. by move=> ?; apply/cvg_ex; eexists; exact: ereal_nondecreasing_cvg. Qed. +Lemma ereal_nondecreasing_is_cvgn (R : realType) (u_ : (\bar R) ^nat) : + nondecreasing_seq u_ -> cvgn u_. +Proof. by move=> ?; apply/cvg_ex; eexists; exact: ereal_nondecreasing_cvgn. Qed. -Lemma ereal_nonincreasing_cvg (R : realType) (u_ : (\bar R)^nat) : - nonincreasing_seq u_ -> u_ --> ereal_inf (u_ @` setT). +Lemma ereal_nonincreasing_cvgn (R : realType) (u_ : (\bar R)^nat) : + nonincreasing_seq u_ -> u_ @ \oo --> ereal_inf (u_ @` setT). Proof. -move=> ni_u; rewrite [X in X --> _](_ : _ = -%E \o -%E \o u_); last first. +move=> ni_u; rewrite [X in X @ \oo --> _](_ : _ = -%E \o -%E \o u_); last first. by rewrite funeqE => n; rewrite /= oppeK. apply: cvgeN. rewrite [X in _ --> X](_ : _ = ereal_sup (range (-%E \o u_))); last first. congr ereal_sup; rewrite predeqE => x; split=> [[_ [n _ <-]] <-|[n _] <-]; by [exists n | exists (u_ n) => //; exists n]. -by apply: ereal_nondecreasing_cvg; rewrite ereal_nondecreasing_opp. +by apply: ereal_nondecreasing_cvgn; rewrite ereal_nondecreasing_oppn. Qed. -Lemma ereal_nonincreasing_is_cvg (R : realType) (u_ : (\bar R) ^nat) : - nonincreasing_seq u_ -> cvg u_. -Proof. by move=> ?; apply/cvg_ex; eexists; apply: ereal_nonincreasing_cvg. Qed. +Lemma ereal_nonincreasing_is_cvgn (R : realType) (u_ : (\bar R) ^nat) : + nonincreasing_seq u_ -> cvgn u_. +Proof. by move=> ?; apply/cvg_ex; eexists; apply: ereal_nonincreasing_cvgn. Qed. (* NB: see also nondecreasing_series *) Lemma ereal_nondecreasing_series (R : realDomainType) (u_ : (\bar R)^nat) @@ -1563,9 +1571,31 @@ Lemma ereal_nondecreasing_series (R : realDomainType) (u_ : (\bar R)^nat) nondecreasing_seq (fun n => \sum_(0 <= i < n | P i) u_ i). Proof. by move=> u_ge0 n m nm; rewrite lee_sum_nneg_natr// => k _ /u_ge0. Qed. -Lemma eq_eseries (R : realFieldType) (f g : (\bar R)^nat) (P : pred nat) : - (forall i, P i -> f i = g i) -> \sum_(i efg; congr (lim _); apply/funext => n; exact: eq_bigr. Qed. +Lemma congr_lim (R : numFieldType) (f g : nat -> \bar R) : + f = g -> limn f = limn g. +Proof. by move=> ->. Qed. + +Lemma eseries_cond {R : numFieldType} (f : (\bar R)^nat) P N : + \sum_(N <= i n /=; apply: big_nat_widenl. Qed. + +Lemma eseries_mkcondl {R : numFieldType} (f : (\bar R)^nat) P Q : + \sum_(i n; rewrite big_mkcondl. Qed. + +Lemma eseries_mkcondr {R : numFieldType} (f : (\bar R)^nat) P Q : + \sum_(i n; rewrite big_mkcondr. Qed. + +Lemma eq_eseriesr (R : numFieldType) (f g : (\bar R)^nat) (P : pred nat) {N} : + (forall i, P i -> f i = g i) -> + \sum_(N <= i efg; apply/congr_lim/funext => n; exact: eq_bigr. Qed. + +Lemma eq_eseriesl (R : realFieldType) (P Q : pred nat) (f : (\bar R)^nat) : + P =1 Q -> \sum_(i efg; apply/congr_lim/funext => n; apply: eq_bigl. Qed. +Arguments eq_eseriesl {R P} Q. Section ereal_series. Variables (R : realFieldType) (f : (\bar R)^nat). @@ -1574,14 +1604,14 @@ Implicit Types P : pred nat. Lemma ereal_series_cond k P : \sum_(k <= i n. +apply/congr_lim/funext => n. rewrite big_nat_cond (big_nat_widenl k 0%N)//= 2!big_mkord. by apply: eq_big => //= i; rewrite andbAC ltn_ord andbT andbb. Qed. Lemma ereal_series k : \sum_(k <= i n. +rewrite ereal_series_cond; congr (limn _); apply/funext => n. by apply: eq_big => // i; rewrite andbT. Qed. @@ -1600,7 +1630,7 @@ Lemma nneseries_lim_ge (R : realType) (u_ : (\bar R)^nat) (P : pred nat) k : (forall n, P n -> 0 <= u_ n) -> \sum_(0 <= i < k | P i) u_ i <= \sum_(i -> //. +move/ereal_nondecreasing_series/ereal_nondecreasing_cvgn/cvg_lim => -> //. by apply: ereal_sup_ub; exists k. Qed. @@ -1621,52 +1651,54 @@ Variable (R : realType) (u_ : (\bar R)^nat). Implicit Type P : pred nat. Lemma is_cvg_ereal_nneg_natsum_cond m P : - (forall n, (m <= n)%N -> P n -> 0 <= u_ n) -> -cvg (fun n => \sum_(m <= i < n | P i) u_ i). + (forall n, (m <= n)%N -> P n -> 0 <= u_ n) -> + cvgn (fun n => \sum_(m <= i < n | P i) u_ i). Proof. -by move/lee_sum_nneg_natr/ereal_nondecreasing_cvg => cu; apply: cvgP; exact: cu. +by move/lee_sum_nneg_natr/ereal_nondecreasing_cvgn => cu; apply: cvgP; exact: cu. Qed. Lemma is_cvg_ereal_npos_natsum_cond m P : - (forall n, (m <= n)%N -> P n -> u_ n <= 0) -> - cvg (fun n => \sum_(m <= i < n | P i) u_ i). + (forall n, (m <= n)%N -> P n -> u_ n <= 0) -> + cvgn (fun n => \sum_(m <= i < n | P i) u_ i). Proof. -by move/lee_sum_npos_natr/ereal_nonincreasing_cvg => cu; apply: cvgP; exact: cu. +by move/lee_sum_npos_natr/ereal_nonincreasing_cvgn => cu; apply: cvgP; exact: cu. Qed. Lemma is_cvg_ereal_nneg_natsum m : (forall n, (m <= n)%N -> 0 <= u_ n) -> - cvg (fun n => \sum_(m <= i < n) u_ i). + cvgn (fun n => \sum_(m <= i < n) u_ i). Proof. by move=> u_ge0; apply: is_cvg_ereal_nneg_natsum_cond => n /u_ge0. Qed. Lemma is_cvg_ereal_npos_natsum m : (forall n, (m <= n)%N -> u_ n <= 0) -> - cvg (fun n => \sum_(m <= i < n) u_ i). + cvgn (fun n => \sum_(m <= i < n) u_ i). Proof. by move=> u_le0; apply: is_cvg_ereal_npos_natsum_cond => n /u_le0. Qed. -Lemma is_cvg_nneseries_cond P : (forall n, P n -> 0 <= u_ n) -> - cvg (fun n => \sum_(0 <= i < n | P i) u_ i). -Proof. by move=> u_ge0; apply: is_cvg_ereal_nneg_natsum_cond => n _ /u_ge0. Qed. +Lemma is_cvg_nneseries_cond P N : (forall n, P n -> 0 <= u_ n) -> + cvgn (fun n => \sum_(N <= i < n | P i) u_ i). +Proof. +by move=> u_ge0; apply: is_cvg_ereal_nneg_natsum_cond => n _; exact: u_ge0. +Qed. -Lemma is_cvg_npeseries_cond P : (forall n, P n -> u_ n <= 0) -> - cvg (fun n => \sum_(0 <= i < n | P i) u_ i). +Lemma is_cvg_npeseries_cond P N : (forall n, P n -> u_ n <= 0) -> + cvgn (fun n => \sum_(N <= i < n | P i) u_ i). Proof. by move=> u_le0; apply: is_cvg_ereal_npos_natsum_cond => n _ /u_le0. Qed. -Lemma is_cvg_nneseries P : (forall n, P n -> 0 <= u_ n) -> - cvg (fun n => \sum_(0 <= i < n | P i) u_ i). +Lemma is_cvg_nneseries P N : (forall n, P n -> 0 <= u_ n) -> + cvgn (fun n => \sum_(N <= i < n | P i) u_ i). Proof. by move=> ?; exact: is_cvg_nneseries_cond. Qed. -Lemma is_cvg_npeseries P : (forall n, P n -> u_ n <= 0) -> - cvg (fun n => \sum_(0 <= i < n | P i) u_ i). +Lemma is_cvg_npeseries P N : (forall n, P n -> u_ n <= 0) -> + cvgn (fun n => \sum_(N <= i < n | P i) u_ i). Proof. by move=> ?; exact: is_cvg_npeseries_cond. Qed. -Lemma nneseries_ge0 P : (forall n, P n -> 0 <= u_ n) -> - 0 <= \sum_(i 0 <= u_ n) -> + 0 <= \sum_(N <= i u0; apply: (lime_ge (is_cvg_nneseries u0)). by apply: nearW => k; rewrite sume_ge0. Qed. -Lemma npeseries_le0 P : (forall n : nat, P n -> u_ n <= 0) -> - \sum_(i u_ n <= 0) -> + \sum_(N <= i u0; apply: (lime_le (is_cvg_npeseries u0)). by apply: nearW => k; rewrite sume_le0. @@ -1674,14 +1706,16 @@ Qed. End cvg_eseries. Arguments is_cvg_nneseries {R}. +Arguments nneseries_ge0 {R u_ P} N. Lemma nnseries_is_cvg {R : realType} (u : nat -> R) : - (forall i, 0 <= u i)%R -> \sum_(k cvg (series u). + (forall i, 0 <= u i)%R -> \sum_(k + cvgn (series u). Proof. -move=> ? ?; apply: nondecreasing_is_cvg. +move=> ? ?; apply: nondecreasing_is_cvgn. move=> m n mn; rewrite /series/=. rewrite -(subnKC mn) {2}/index_iota subn0 iotaD big_cat/=. - by rewrite add0n -{2}(subn0 m) -/(index_iota _ _) ler_addl sumr_ge0. + by rewrite add0n -{2}(subn0 m) -/(index_iota _ _) lerDl sumr_ge0. exists (fine (\sum_(k _ [n _ <-]; rewrite -lee_fin fineK//; last first. rewrite fin_num_abs gee0_abs//; apply: nneseries_ge0 => // i _. @@ -1689,12 +1723,12 @@ rewrite /ubound/= => _ [n _ <-]; rewrite -lee_fin fineK//; last first. by rewrite -sumEFin; apply: nneseries_lim_ge => i _; rewrite lee_fin. Qed. -Lemma nneseriesrM (R : realType) (f : nat -> \bar R) (P : pred nat) x : +Lemma nneseriesZl (R : realType) (f : nat -> \bar R) (P : pred nat) x N : (forall i, P i -> 0 <= f i) -> - (\sum_(i f0; rewrite -limeMl//; last exact: is_cvg_nneseries. -by congr (lim _); apply/funext => /= n; rewrite ge0_sume_distrr. +by apply/congr_lim/funext => /= n; rewrite ge0_sume_distrr. Qed. Lemma adde_def_nneseries (R : realType) (f g : (\bar R)^nat) @@ -1703,35 +1737,26 @@ Lemma adde_def_nneseries (R : realType) (f g : (\bar R)^nat) (\sum_(i f0 g0; rewrite /adde_def !negb_and; apply/andP; split; apply/orP. -- by right; apply/eqP => Qg; have := nneseries_ge0 g0; rewrite Qg. -- by left; apply/eqP => Pf; have := nneseries_ge0 f0; rewrite Pf. +- by right; apply/eqP => Qg; have := nneseries_ge0 0 g0; rewrite Qg. +- by left; apply/eqP => Pf; have := nneseries_ge0 0 f0; rewrite Pf. Qed. Lemma __deprecated__ereal_cvgPpinfty (R : realFieldType) (u_ : (\bar R)^nat) : - u_ --> +oo <-> (forall A, (0 < A)%R -> \forall n \near \oo, A%:E <= u_ n). + u_ @ \oo --> +oo <-> (forall A, (0 < A)%R -> \forall n \near \oo, A%:E <= u_ n). Proof. -by split=> [/cvgeyPge//|u_ge]; apply/cvgeyPgey; near=> x; apply u_ge. +by split=> [/cvgeyPge//|u_ge]; apply/cvgeyPgey; near=> x; apply: u_ge. Unshelve. all: by end_near. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", - note="use `cvgeyPge` or a variant instead")] -Notation ereal_cvgPpinfty := __deprecated__ereal_cvgPpinfty. Lemma __deprecated__ereal_cvgPninfty (R : realFieldType) (u_ : (\bar R)^nat) : - u_ --> -oo <-> (forall A, (A < 0)%R -> \forall n \near \oo, u_ n <= A%:E). + u_ @ \oo --> -oo <-> (forall A, (A < 0)%R -> \forall n \near \oo, u_ n <= A%:E). Proof. -by split=> [/cvgeNyPle//|u_ge]; apply/cvgeNyPleNy; near=> x; apply u_ge. +by split=> [/cvgeNyPle//|u_ge]; apply/cvgeNyPleNy; near=> x; apply: u_ge. Unshelve. all: by end_near. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", - note="use `cvgeNyPle` or a variant instead")] -Notation ereal_cvgPninfty := __deprecated__ereal_cvgPninfty. Lemma __deprecated__ereal_squeeze (R : realType) (f g h : (\bar R)^nat) : (\forall x \near \oo, f x <= g x <= h x) -> forall (l : \bar R), - f --> l -> h --> l -> g --> l. + f @ \oo --> l -> h @ \oo --> l -> g @ \oo --> l. Proof. by move=> ? ?; apply: squeeze_cvge. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", - note="renamed to `squeeze_cvge` and generalized")] -Notation ereal_squeeze := __deprecated__ereal_squeeze. Lemma nneseries_pinfty (R : realType) (u_ : (\bar R)^nat) (P : pred nat) k : (forall n, P n -> 0 <= u_ n) -> P k -> @@ -1741,15 +1766,16 @@ move=> u_ge0 Pk ukoo; apply: (eseries_pinfty _ Pk ukoo) => // n Pn. by rewrite gt_eqF// (lt_le_trans _ (u_ge0 _ Pn)). Qed. -Lemma lee_nneseries (R : realType) (u v : (\bar R)^nat) (P : pred nat) : - (forall i, P i -> 0 <= u i) -> (forall n, P n -> u n <= v n) -> - \sum_(i 0 <= u i) -> + (forall n, P n -> u n <= v n) -> + \sum_(N <= i u0 Puv; apply: lee_lim. -- by apply: is_cvg_ereal_nneg_natsum_cond => n _ /u0. +- by apply: is_cvg_ereal_nneg_natsum_cond => n ? /u0; exact. - apply: is_cvg_ereal_nneg_natsum_cond => n _ Pn. by rewrite (le_trans _ (Puv _ Pn))// u0. -- by near=> n; exact: lee_sum. +- by near=> n; apply: lee_sum => k; exact: Puv. Unshelve. all: by end_near. Qed. Lemma lee_npeseries (R : realType) (u v : (\bar R)^nat) (P : pred nat) : @@ -1764,124 +1790,88 @@ move=> u0 Puv; apply: lee_lim. Unshelve. all: by end_near. Qed. Lemma __deprecated__ereal_cvgD_pinfty_fin (R : realFieldType) (f g : (\bar R)^nat) b : - f --> +oo -> g --> b%:E -> f \+ g --> +oo. + f @ \oo --> +oo -> g @ \oo --> b%:E -> f \+ g @ \oo --> +oo. Proof. exact: cvgeD. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvgeD` instead")] -Notation ereal_cvgD_pinfty_fin := __deprecated__ereal_cvgD_pinfty_fin. Lemma __deprecated__ereal_cvgD_ninfty_fin (R : realFieldType) (f g : (\bar R)^nat) b : - f --> -oo -> g --> b%:E -> f \+ g --> -oo. + f @ \oo --> -oo -> g @ \oo --> b%:E -> f \+ g @ \oo --> -oo. Proof. exact: cvgeD. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvgeD` instead")] -Notation ereal_cvgD_ninfty_fin := __deprecated__ereal_cvgD_ninfty_fin. Lemma __deprecated__ereal_cvgD_pinfty_pinfty (R : realFieldType) (f g : (\bar R)^nat) : - f --> +oo -> g --> +oo -> f \+ g --> +oo. + f @ \oo --> +oo -> g @ \oo --> +oo -> f \+ g @ \oo --> +oo. Proof. exact: cvgeD. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvgeD` instead")] -Notation ereal_cvgD_pinfty_pinfty := __deprecated__ereal_cvgD_pinfty_pinfty. Lemma __deprecated__ereal_cvgD_ninfty_ninfty (R : realFieldType) (f g : (\bar R)^nat) : - f --> -oo -> g --> -oo -> f \+ g --> -oo. + f @ \oo --> -oo -> g @ \oo --> -oo -> f \+ g @ \oo --> -oo. Proof. exact: cvgeD. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvgeD` instead")] -Notation ereal_cvgD_ninfty_ninfty := __deprecated__ereal_cvgD_ninfty_ninfty. +Notation ereal_cvgD_ninfty_ninfty := __deprecated__ereal_cvgD_ninfty_ninfty (only parsing). Lemma __deprecated__ereal_cvgD (R : realFieldType) (f g : (\bar R)^nat) a b : - a +? b -> f --> a -> g --> b -> f \+ g --> a + b. + a +? b -> f @ \oo --> a -> g @ \oo --> b -> f \+ g @ \oo --> a + b. Proof. exact: cvgeD. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", - note="renamed to `cvgeD` and generalized")] -Notation ereal_cvgD := __deprecated__ereal_cvgD. - -Section nneseries_split. Lemma __deprecated__ereal_cvgB (R : realFieldType) (f g : (\bar R)^nat) a b : - a +? - b -> f --> a -> g --> b -> f \- g --> a - b. + a +? - b -> f @ \oo --> a -> g @ \oo --> b -> f \- g @ \oo --> a - b. Proof. exact: cvgeB. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", - note="renamed to `cvgeB` and generalized")] -Notation ereal_cvgB := __deprecated__ereal_cvgB. Lemma __deprecated__ereal_is_cvgD (R : realFieldType) (u v : (\bar R)^nat) : - lim u +? lim v -> cvg u -> cvg v -> cvg (u \+ v). + limn u +? limn v -> cvgn u -> cvgn v -> cvgn (u \+ v). Proof. exact: is_cvgeD. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", - note="renamed to `is_cvgeD` and generalized")] -Notation ereal_is_cvgD := __deprecated__ereal_is_cvgD. Lemma __deprecated__ereal_cvg_sub0 (R : realFieldType) (f : (\bar R)^nat) (k : \bar R) : - k \is a fin_num -> (fun x => f x - k) --> 0 <-> f --> k. + k \is a fin_num -> (fun x => f x - k) @ \oo --> 0 <-> f @ \oo --> k. Proof. exact: cvge_sub0. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", - note="renamed to `cvge_sub0` and generalized")] -Notation ereal_cvg_sub0 := __deprecated__ereal_cvg_sub0. Lemma __deprecated__ereal_limD (R : realFieldType) (f g : (\bar R)^nat) : - cvg f -> cvg g -> lim f +? lim g -> - lim (f \+ g) = lim f + lim g. + cvgn f -> cvgn g -> limn f +? limn g -> + limn (f \+ g) = limn f + limn g. Proof. exact: limeD. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", - note="renamed to `limeD` and generalized")] -Notation ereal_limD := __deprecated__ereal_limD. Lemma __deprecated__ereal_cvgM_gt0_pinfty (R : realFieldType) (f g : (\bar R)^nat) b : - (0 < b)%R -> f --> +oo -> g --> b%:E -> f \* g --> +oo. + (0 < b)%R -> f @ \oo --> +oo -> g @ \oo --> b%:E -> f \* g @ \oo --> +oo. Proof. move=> b_lt0 fl gl; have /= := cvgeM _ fl gl; rewrite gt0_mulye//; apply. by rewrite mule_def_infty_neq0// gt_eqF. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvgeM` instead")] -Notation ereal_cvgM_gt0_pinfty := __deprecated__ereal_cvgM_gt0_pinfty. Lemma __deprecated__ereal_cvgM_lt0_pinfty (R : realFieldType) (f g : (\bar R)^nat) b : - (b < 0)%R -> f --> +oo -> g --> b%:E -> f \* g --> -oo. + (b < 0)%R -> f @ \oo --> +oo -> g @ \oo --> b%:E -> f \* g @ \oo --> -oo. Proof. move=> b_lt0 fl gl; have /= := cvgeM _ fl gl; rewrite lt0_mulye//; apply. by rewrite mule_def_infty_neq0// lt_eqF. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvgeM` instead")] -Notation ereal_cvgM_lt0_pinfty := __deprecated__ereal_cvgM_lt0_pinfty. Lemma __deprecated__ereal_cvgM_gt0_ninfty (R : realFieldType) (f g : (\bar R)^nat) b : - (0 < b)%R -> f --> -oo -> g --> b%:E -> f \* g --> -oo. + (0 < b)%R -> f @ \oo --> -oo -> g @ \oo --> b%:E -> f \* g @ \oo --> -oo. Proof. move=> b_lt0 fl gl; have /= := cvgeM _ fl gl; rewrite gt0_mulNye//; apply. by rewrite mule_def_infty_neq0// gt_eqF. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvgeM` instead")] -Notation ereal_cvgM_gt0_ninfty := __deprecated__ereal_cvgM_gt0_ninfty. Lemma __deprecated__ereal_cvgM_lt0_ninfty (R : realFieldType) (f g : (\bar R)^nat) b : - (b < 0)%R -> f --> -oo -> g --> b%:E -> f \* g --> +oo. + (b < 0)%R -> f @ \oo --> -oo -> g @ \oo --> b%:E -> f \* g @ \oo --> +oo. Proof. move=> b_lt0 fl gl; have /= := cvgeM _ fl gl; rewrite lt0_mulNye//; apply. by rewrite mule_def_infty_neq0// lt_eqF. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvgeM` instead")] -Notation ereal_cvgM_lt0_ninfty := __deprecated__ereal_cvgM_lt0_ninfty. Lemma __deprecated__ereal_cvgM (R : realType) (f g : (\bar R) ^nat) (a b : \bar R) : - a *? b -> f --> a -> g --> b -> f \* g --> a * b. + a *? b -> f @ \oo --> a -> g @ \oo --> b -> f \* g @ \oo --> a * b. Proof. exact: cvgeM. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", - note="renamed to `cvgeM` and generalized")] -Notation ereal_cvgM := __deprecated__ereal_cvgM. Lemma __deprecated__ereal_lim_sum (R : realFieldType) (I : Type) (r : seq I) (f : I -> (\bar R)^nat) (l : I -> \bar R) (P : pred I) : (forall k n, P k -> 0 <= f k n) -> - (forall k, P k -> f k --> l k) -> - (fun n => \sum_(k <- r | P k) f k n) --> \sum_(k <- r | P k) l k. + (forall k, P k -> f k @ \oo --> l k) -> + (fun n => \sum_(k <- r | P k) f k n) @ \oo --> \sum_(k <- r | P k) l k. Proof. by move=> f0 ?; apply: cvg_nnesum => // ? ?; apply: nearW => ?; apply: f0. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", - note="renamed to `cvg_nnesum` and generalized")] -Notation ereal_lim_sum := __deprecated__ereal_lim_sum. Let lim_shift_cst (R : realFieldType) (u : (\bar R) ^nat) (l : \bar R) : - cvg u -> (forall n, 0 <= u n) -> -oo < l -> lim (fun x => l + u x) = l + lim u. + cvgn u -> (forall n, 0 <= u n) -> -oo < l -> + limn (fun x => l + u x) = l + limn u. Proof. move=> cu u0 hl; apply/cvg_lim => //; apply: cvgeD (cu); last first. exact: cvg_cst. @@ -1889,10 +1879,12 @@ rewrite ltninfty_adde_def// inE (@lt_le_trans _ _ 0)//. by apply: lime_ge => //; exact: nearW. Qed. +Section nneseries_split. + Let near_eq_lim (R : realFieldType) (f g : nat -> \bar R) : - cvg g -> {near \oo, f =1 g} -> lim f = lim g. + cvgn g -> {near \oo, f =1 g} -> limn f = limn g. Proof. -move=> cg fg; suff: f --> lim g by exact/cvg_lim. +move=> cg fg; suff: f @ \oo --> limn g by exact/cvg_lim. by apply: cvg_trans cg; apply: near_eq_cvg; near do apply/esym. Unshelve. all: by end_near. Qed. @@ -1912,15 +1904,35 @@ Unshelve. all: by end_near. Qed. End nneseries_split. +Lemma nneseries_tail_cvg (R : realType) (f : (\bar R)^nat) : + \sum_(k (forall k, 0 <= f k) -> + \sum_(N <= k \oo] --> 0. +Proof. +move=> foo f0. +have : cvg (\sum_(0 <= k < n) f k @[n --> \oo]). + by apply: ereal_nondecreasing_is_cvgn; exact: lee_sum_nneg_natr. +move/cvg_ex => [[l fl||/cvg_lim fnoo]] /=; last 2 first. + - by move/cvg_lim => fpoo; rewrite fpoo// in foo. + - have : 0 <= \sum_(k _](_ : _ = fun N => l%:E - \sum_(0 <= k < N) f k). + apply/cvgeNP; rewrite oppe0. + under eq_fun => ? do rewrite oppeD// oppeK addeC. + exact/cvge_sub0. +apply/funext => N; apply/esym/eqP; rewrite sube_eq//. + by rewrite addeC big_mkord -(nneseries_split N)//; exact/eqP/esym/cvg_lim. +by rewrite ge0_adde_def//= ?inE; [exact: nneseries_ge0|exact: sume_ge0]. +Qed. + Lemma nneseriesD (R : realType) (f g : nat -> \bar R) (P : pred nat) : (forall i, P i -> 0 <= f i) -> (forall i, P i -> 0 <= g i) -> \sum_(i f_eq0 g_eq0. -transitivity (lim (fun n => \sum_(0 <= i < n | P i) f i + +transitivity (limn (fun n => \sum_(0 <= i < n | P i) f i + \sum_(0 <= i < n | P i) g i)). - by congr (lim _); apply/funext => n; rewrite big_split. + by apply/congr_lim/funext => n; rewrite big_split. rewrite limeD /adde_def //=; do ? exact: is_cvg_nneseries. by rewrite ![_ == -oo]gt_eqF ?andbF// (@lt_le_trans _ _ 0) ?[_ < _]real0// nneseries_ge0. @@ -1934,25 +1946,25 @@ Proof. move=> f0; elim: n => [|n IHn]. by rewrite big_geq// eseries0// => i; rewrite big_geq. rewrite big_nat_recr// -IHn/= -nneseriesD//; last by move=> i; rewrite sume_ge0. -by congr (lim _); apply/funext => m; apply: eq_bigr => i _; rewrite big_nat_recr. +by apply/congr_lim/funext => m; apply: eq_bigr => i _; rewrite big_nat_recr. Qed. -Lemma nneseries_sum I (r : seq I) (P : {pred I}) - [R : realType] [f : I -> nat -> \bar R] : - (forall i j, P i -> 0 <= f i j) -> - \sum_(j nat -> \bar R] : (forall i j, P i -> 0 <= f i j) -> + \sum_(j f_ge0; case Dr : r => [|i r']; rewrite -?{}[_ :: _]Dr. by rewrite big_nil eseries0// => i; rewrite big_nil. rewrite {r'}(big_nth i) big_mkcond. -rewrite (eq_eseries (fun _ _ => big_nth i _ _)). -rewrite (eq_eseries (fun _ _ => big_mkcond _ _))/=. +rewrite (eq_eseriesr (fun _ _ => big_nth i _ _)). +rewrite (eq_eseriesr (fun _ _ => big_mkcond _ _))/=. rewrite nneseries_sum_nat; last by move=> ? ?; case: ifP => // /f_ge0. by apply: eq_bigr => j _; case: ifP => //; rewrite eseries0. Qed. Lemma lte_lim (R : realFieldType) (u : (\bar R)^nat) (M : R) : - nondecreasing_seq u -> cvg u -> M%:E < lim u -> + nondecreasing_seq u -> cvgn u -> M%:E < limn u -> \forall n \near \oo, M%:E <= u n. Proof. move=> ndu cu Ml; have [[n Mun]|] := pselect (exists n, M%:E <= u n). @@ -1960,12 +1972,12 @@ move=> ndu cu Ml; have [[n Mun]|] := pselect (exists n, M%:E <= u n). by near: m; exists n.+1 => // p q; apply/ndu/ltnW. move/forallNP => Mu. have {}Mu : forall x, M%:E > u x by move=> x; rewrite ltNge; apply/negP. -have : lim u <= M%:E by apply lime_le => //; near=> m; apply/ltW/Mu. +have : limn u <= M%:E by apply lime_le => //; near=> m; apply/ltW/Mu. by move/(lt_le_trans Ml); rewrite ltxx. Unshelve. all: by end_near. Qed. Lemma lim_mkord (R : realFieldType) (P : {pred nat}) (f : (\bar R)^nat) : - lim (fun n => \sum_(k < n | P k) f k)%E = \sum_(k \sum_(k < n | P k) f k)%E = \sum_(k _) = (fun n => \sum_(0 <= k < n | P k) f k)%E) //. by rewrite funeqE => k; rewrite big_mkord. @@ -1973,17 +1985,200 @@ Qed. Lemma eseries_mkcond [R : realFieldType] [P : pred nat] (f : nat -> \bar R) : \sum_(i n /=; apply: big_mkcond. Qed. +Proof. by apply/congr_lim/eq_fun => n /=; apply: big_mkcond. Qed. End sequences_ereal. +#[deprecated(since="mathcomp-analysis 0.6.0", + note="use `cvgeyPge` or a variant instead")] +Notation ereal_cvgPpinfty := __deprecated__ereal_cvgPpinfty (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.0", + note="use `cvgeNyPle` or a variant instead")] +Notation ereal_cvgPninfty := __deprecated__ereal_cvgPninfty (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.0", + note="renamed to `squeeze_cvge` and generalized")] +Notation ereal_squeeze := __deprecated__ereal_squeeze (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvgeD` instead")] +Notation ereal_cvgD_pinfty_fin := __deprecated__ereal_cvgD_pinfty_fin (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvgeD` instead")] +Notation ereal_cvgD_ninfty_fin := __deprecated__ereal_cvgD_ninfty_fin (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvgeD` instead")] +Notation ereal_cvgD_pinfty_pinfty := __deprecated__ereal_cvgD_pinfty_pinfty (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.0", + note="renamed to `cvgeD` and generalized")] +Notation ereal_cvgD := __deprecated__ereal_cvgD (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.0", + note="renamed to `cvgeB` and generalized")] +Notation ereal_cvgB := __deprecated__ereal_cvgB (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.0", + note="renamed to `is_cvgeD` and generalized")] +Notation ereal_is_cvgD := __deprecated__ereal_is_cvgD (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.0", + note="renamed to `cvge_sub0` and generalized")] +Notation ereal_cvg_sub0 := __deprecated__ereal_cvg_sub0 (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.0", + note="renamed to `limeD` and generalized")] +Notation ereal_limD := __deprecated__ereal_limD (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvgeM` instead")] +Notation ereal_cvgM_gt0_pinfty := __deprecated__ereal_cvgM_gt0_pinfty (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvgeM` instead")] +Notation ereal_cvgM_lt0_pinfty := __deprecated__ereal_cvgM_lt0_pinfty (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvgeM` instead")] +Notation ereal_cvgM_gt0_ninfty := __deprecated__ereal_cvgM_gt0_ninfty (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvgeM` instead")] +Notation ereal_cvgM_lt0_ninfty := __deprecated__ereal_cvgM_lt0_ninfty (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.0", + note="renamed to `cvgeM` and generalized")] +Notation ereal_cvgM := __deprecated__ereal_cvgM (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.0", + note="renamed to `cvg_nnesum` and generalized")] +Notation ereal_lim_sum := __deprecated__ereal_lim_sum (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.0", + note="renamed to `cvg_abse0P` and generalized")] +Notation ereal_cvg_abs0 := __deprecated__ereal_cvg_abs0 (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.0", note="use `cvge_ge` instead")] +Notation ereal_cvg_ge0 := __deprecated__ereal_cvg_ge0 (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.0", + note="renamed to `lime_ge` and generalized")] +Notation ereal_lim_ge := __deprecated__ereal_lim_ge (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.0", + note="renamed to `lime_le` and generalized")] +Notation ereal_lim_le := __deprecated__ereal_lim_le (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.0", + note="renamed to `cvgeryP` and generalized")] +Notation dvg_ereal_cvg := __deprecated__dvg_ereal_cvg (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.0", + note="renamed to `fine_cvgP` and generalized")] +Notation ereal_cvg_real := __deprecated__ereal_cvg_real (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", + note="renamed to `ereal_nondecreasing_cvgn`")] +Notation ereal_nondecreasing_cvg := ereal_nondecreasing_cvgn (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", + note="renamed to `ereal_nondecreasing_is_cvgn`")] +Notation ereal_nondecreasing_is_cvg := ereal_nondecreasing_is_cvgn (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", + note="renamed to `ereal_nonincreasing_cvgn`")] +Notation ereal_nonincreasing_cvg := ereal_nonincreasing_cvgn (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", + note="renamed to `ereal_nonincreasing_is_cvgn`")] +Notation ereal_nonincreasing_is_cvg := ereal_nonincreasing_is_cvgn (only parsing). #[deprecated(since="analysis 0.6.0", note="Use eseries0 instead.")] -Notation nneseries0 := eseries0. -#[deprecated(since="analysis 0.6.0", note="Use eq_eseries instead.")] -Notation eq_nneseries := eq_eseries. +Notation nneseries0 := eseries0 (only parsing). +#[deprecated(since="analysis 0.6.0", note="Use eq_eseriesr instead.")] +Notation eq_nneseries := eq_eseriesr (only parsing). #[deprecated(since="analysis 0.6.0", note="Use eseries_pred0 instead.")] -Notation nneseries_pred0 := eseries_pred0. +Notation nneseries_pred0 := eseries_pred0 (only parsing). #[deprecated(since="analysis 0.6.0", note="Use eseries_mkcond instead.")] -Notation nneseries_mkcond := eseries_mkcond. +Notation nneseries_mkcond := eseries_mkcond (only parsing). + +Section minr_cvg_0. +Local Open Scope ring_scope. +Context {R : realFieldType}. +Implicit Types (u : R^nat) (r : R). + +Lemma minr_cvg_0_cvg_0 u r : 0 < r -> (forall k, 0 <= u k) -> + minr (u n) r @[n --> \oo] --> 0 -> u n @[n --> \oo] --> 0. +Proof. +move=> r0 u0 minr_cvg; apply/cvgrPdist_lt => _ /posnumP[e]. +have : 0 < minr e%:num r by rewrite lt_minr// r0 andbT. +move/cvgrPdist_lt : minr_cvg => /[apply] -[M _ hM]. +near=> n; rewrite sub0r normrN. +have /hM : (M <= n)%N by near: n; exists M. +rewrite sub0r normrN (ger0_norm (u0 n)) ger0_norm// => [/lt_min_lt//|]. +by rewrite le_minr u0 ltW. +Unshelve. all: by end_near. Qed. + +Lemma maxr_cvg_0_cvg_0 u r : r < 0 -> (forall k, u k <= 0) -> + maxr (u n) r @[n --> \oo] --> 0 -> u n @[n --> \oo] --> 0. +Proof. +rewrite -[in r < _]oppr0 ltrNr => r0 u0. +under eq_fun do rewrite -(opprK (u _)) -[in maxr _ _](opprK r) -oppr_min. +rewrite -[in _ --> _]oppr0 => /cvgNP/minr_cvg_0_cvg_0-/(_ r0). +have Nu0 k : 0 <= - u k by rewrite lerNr oppr0. +by move=> /(_ Nu0)/(cvgNP _ _).2; rewrite opprK oppr0. +Qed. + +End minr_cvg_0. + +Section mine_cvg_0. +Context {R : realFieldType}. +Local Open Scope ereal_scope. +Implicit Types (u : (\bar R)^nat) (r : R) (x : \bar R). + +Lemma mine_cvg_0_cvg_fin_num u x : 0 < x -> (forall k, 0 <= u k) -> + mine (u n) x @[n --> \oo] --> 0 -> + \forall n \near \oo, u n \is a fin_num. +Proof. +case: x => [r r0 u0 /fine_cvgP[_]|_ u0|//]; last first. + under eq_cvg do rewrite miney. + by case/fine_cvgP. +move=> /cvgrPdist_lt/(_ _ r0)[N _ hN]. +near=> n; have /hN : (N <= n)%N by near: n; exists N. +rewrite sub0r normrN /= ger0_norm ?fine_ge0//; last first. + by rewrite le_minr u0 ltW. +by have := u0 n; case: (u n) => //=; rewrite ltxx. +Unshelve. all: by end_near. Qed. + +Lemma mine_cvg_minr_cvg u r : (0 < r)%R -> (forall k, 0 <= u k) -> + mine (u n) r%:E @[n --> \oo] --> 0 -> + minr (fine (u n)) r @[n --> \oo] --> 0%R. +Proof. +move=> r0 u0 mine_cvg; apply: (cvg_trans _ (fine_cvg mine_cvg)). +move/fine_cvgP : mine_cvg => [_ /=] /cvgrPdist_lt. +move=> /(_ _ r0)[N _ hN]; apply: near_eq_cvg; near=> n. +have xnoo : u n < +oo. + rewrite ltNge leye_eq; apply/eqP => xnoo. + have /hN : (N <= n)%N by near: n; exists N. + by rewrite /= sub0r normrN xnoo //= gtr0_norm // ltxx. +by rewrite /= -(@fineK _ (u n)) ?ge0_fin_numE//= -fine_min. +Unshelve. all: by end_near. Qed. + +Lemma mine_cvg_0_cvg_0 u x : 0 < x -> (forall k, 0 <= u k) -> + mine (u n) x @[n --> \oo] --> 0 -> u n @[n --> \oo] --> 0. +Proof. +move=> x0 u0 h; apply/fine_cvgP; split. + exact: (mine_cvg_0_cvg_fin_num x0). +case: x x0 h => [r r0 h|_|//]; last first. + under eq_cvg do rewrite miney. + exact: fine_cvg. +apply: (@minr_cvg_0_cvg_0 _ (fine \o u) r) => //. + by move=> k /=; rewrite fine_ge0. +exact: mine_cvg_minr_cvg. +Qed. + +Lemma maxe_cvg_0_cvg_fin_num u x : x < 0 -> (forall k, u k <= 0) -> + maxe (u n) x @[n --> \oo] --> 0 -> + \forall n \near \oo, u n \is a fin_num. +Proof. +rewrite -[in x < _]oppe0 lte_oppr => x0 u0. +under eq_fun do rewrite -(oppeK (u _)) -[in maxe _ _](oppeK x) -oppe_min. +rewrite -[in _ --> _]oppe0 => /cvgeNP/mine_cvg_0_cvg_fin_num-/(_ x0). +have Nu0 k : 0 <= - u k by rewrite lee_oppr oppe0. +by move=> /(_ Nu0)[n _ nu]; exists n => // m/= nm; rewrite -fin_numN nu. +Qed. + +Lemma maxe_cvg_maxr_cvg u r : (r < 0)%R -> (forall k, u k <= 0) -> + maxe (u n) r%:E @[n --> \oo] --> 0 -> + maxr (fine (u n)) r @[n --> \oo] --> 0%R. +Proof. +rewrite -[in (r < _)%R]oppr0 ltrNr => r0 u0. +under eq_fun do rewrite -(oppeK (u _)) -[in maxe _ _](oppeK r%:E) -oppe_min. +rewrite -[in _ --> _]oppe0 => /cvgeNP/mine_cvg_minr_cvg-/(_ r0). +have Nu0 k : 0 <= - u k by rewrite lee_oppr oppe0. +move=> /(_ Nu0)/(cvgNP _ _).2; rewrite oppr0. +by under eq_cvg do rewrite /GRing.opp /= oppr_min fineN !opprK. +Qed. + +Lemma maxe_cvg_0_cvg_0 u x : x < 0 -> (forall k, u k <= 0) -> + maxe (u n) x @[n --> \oo] --> 0 -> u n @[n --> \oo] --> 0. +Proof. +rewrite -[in x < _]oppe0 lte_oppr => x0 u0. +under eq_fun do rewrite -(oppeK (u _)) -[in maxe _ _](oppeK x) -oppe_min. +rewrite -[in _ --> _]oppe0 => /cvgeNP/mine_cvg_0_cvg_0-/(_ x0). +have Nu0 k : 0 <= - u k by rewrite lee_oppr oppe0. +by move=> /(_ Nu0); rewrite -[in _ --> _]oppe0 => /cvgeNP. +Qed. + +End mine_cvg_0. Definition sdrop T (u : T^nat) n := [set u k | k in [set k | k >= n]]%N. @@ -2042,24 +2237,23 @@ move=> u_lb; rewrite -nonincreasing_opp -supsN; apply/nonincreasing_sups. by move: u_lb => /has_lb_ubN; rewrite /comp /= image_comp. Qed. -Lemma is_cvg_sups u : cvg u -> cvg (sups u). +Lemma is_cvg_sups u : cvgn u -> cvgn (sups u). Proof. move=> cf; have [M [Mreal Mu]] := cvg_seq_bounded cf. -apply: nonincreasing_is_cvg. +apply: nonincreasing_is_cvgn. exact/nonincreasing_sups/bounded_fun_has_ubound/cvg_seq_bounded. exists (- (M + 1)) => _ [n _ <-]; rewrite (@le_trans _ _ (u n)) //. - by apply/lerNnormlW/Mu => //; rewrite ltr_addl. + by apply/lerNnormlW/Mu => //; rewrite ltrDl. apply: sup_ub; last by exists n => /=. exact/has_ubound_sdrop/bounded_fun_has_ubound/cvg_seq_bounded. Qed. -Lemma is_cvg_infs u : cvg u -> cvg (infs u). +Lemma is_cvg_infs u : cvgn u -> cvgn (infs u). Proof. -move/is_cvgN/is_cvg_sups; rewrite supsN. -by move/(@is_cvgN _ [normedModType R of R^o]); rewrite opprK. +by move/is_cvgN/is_cvg_sups; rewrite supsN; move/is_cvgN; rewrite opprK. Qed. -Lemma infs_le_sups u n : cvg u -> infs u n <= sups u n. +Lemma infs_le_sups u n : cvgn u -> infs u n <= sups u n. Proof. move=> cu; rewrite /infs /sups /=; set A := sdrop _ _. have [a Aa] : A !=set0 by exists (u n); rewrite /A /=; exists n => //=. @@ -2069,26 +2263,24 @@ rewrite (@le_trans _ _ a) //; [apply/inf_lb|apply/sup_ub] => //. Qed. Lemma cvg_sups_inf u : has_ubound (range u) -> has_lbound (range u) -> - sups u --> inf (range (sups u)). + sups u @ \oo --> inf (range (sups u)). Proof. -move=> u_ub u_lb. -apply: nonincreasing_cvg; first exact: nonincreasing_sups. +move=> u_ub u_lb; apply: nonincreasing_cvgn; first exact: nonincreasing_sups. case: u_lb => M uM; exists M => _ [n _ <-]. -rewrite (@le_trans _ _ (u n)) //; first by apply uM; exists n. +rewrite (@le_trans _ _ (u n)) //; first by apply: uM; exists n. by apply: sup_ub; [exact/has_ubound_sdrop|exists n => /=]. Qed. Lemma cvg_infs_sup u : has_ubound (range u) -> has_lbound (range u) -> - infs u --> sup (range (infs u)). + infs u @ \oo --> sup (range (infs u)). Proof. -move=> u_ub u_lb; have : sups (- u) --> inf (range (sups (- u))). +move=> u_ub u_lb; have : sups (- u) @ \oo --> inf (range (sups (- u))). apply: cvg_sups_inf. - by move: u_lb => /has_lb_ubN; rewrite image_comp. - by move: u_ub => /has_ub_lbN; rewrite image_comp. rewrite /inf => /(@cvg_comp _ _ _ _ (fun x => - x)). rewrite supsN /comp /= -[in X in _ -> X --> _](opprK (infs u)); apply. -rewrite image_comp /comp /= -(opprK (sup (range (infs u)))). -apply: (@cvgN _ [normedModType R of R^o]). +rewrite image_comp /comp /= -(opprK (sup (range (infs u)))); apply: cvgN. by rewrite (_ : [set _ | _ in setT] = (range (infs u))) // opprK. Qed. @@ -2128,7 +2320,7 @@ Lemma bounded_fun_has_lbound_sups u : Proof. move=> /[dup] ba /bounded_fun_has_lbound/has_lbound_sdrop h. have [M hM] := h O; exists M => y [n _ <-]. -rewrite (@le_trans _ _ (u n)) //; first by apply hM; exists n. +rewrite (@le_trans _ _ (u n)) //; first by apply: hM; exists n. apply: sup_ub; last by exists n => /=. by move: ba => /bounded_fun_has_ubound/has_ubound_sdrop; exact. Qed. @@ -2138,55 +2330,54 @@ Lemma bounded_fun_has_ubound_infs u : Proof. move=> /[dup] ba /bounded_fun_has_ubound/has_ubound_sdrop h. have [M hM] := h O; exists M => y [n _ <-]. -rewrite (@le_trans _ _ (u n)) //; last by apply hM; exists n. +rewrite (@le_trans _ _ (u n)) //; last by apply: hM; exists n. apply: inf_lb; last by exists n => /=. by move: ba => /bounded_fun_has_lbound/has_lbound_sdrop; exact. Qed. End sups_infs. -Section lim_sup_lim_inf. +Section limn_sup_limn_inf. Variable R : realType. Implicit Types (r : R) (u v : R^o^nat). -Definition lim_sup u := lim (sups u). +Definition limn_sup u := limn (sups u). -Definition lim_inf u := lim (infs u). +Definition limn_inf u := limn (infs u). -Lemma lim_infN u : cvg u -> lim_inf (-%R \o u) = - lim_sup u. +Lemma limn_infN u : cvgn u -> limn_inf (-%R \o u) = - limn_sup u. Proof. -move=> cu_; rewrite /lim_inf infsN. -rewrite (@limN _ [normedModType R of R^o] _ _ _ (sups u)) //. -exact: is_cvg_sups. +by move=> cu_; rewrite /limn_inf infsN limN//; exact: is_cvg_sups. Qed. -Lemma lim_supE u : bounded_fun u -> lim_sup u = inf (range (sups u)). +Lemma limn_supE u : bounded_fun u -> limn_sup u = inf (range (sups u)). Proof. -move=> ba; apply/cvg_lim; first exact: Rhausdorff. +move=> ba; apply/cvg_lim => //. by apply/cvg_sups_inf; [exact/bounded_fun_has_ubound| exact/bounded_fun_has_lbound]. Qed. -Lemma lim_infE u : bounded_fun u -> lim_inf u = sup (range (infs u)). +Lemma limn_infE u : bounded_fun u -> limn_inf u = sup (range (infs u)). Proof. -move=> ba; apply/cvg_lim; first exact: Rhausdorff. -apply/cvg_infs_sup; [exact/bounded_fun_has_ubound| - exact/bounded_fun_has_lbound]. +move=> ba; apply/cvg_lim => //. +by apply/cvg_infs_sup; [exact/bounded_fun_has_ubound| + exact/bounded_fun_has_lbound]. Qed. -Lemma lim_inf_le_lim_sup u : cvg u -> lim_inf u <= lim_sup u. +Lemma limn_inf_sup u : cvgn u -> limn_inf u <= limn_sup u. Proof. move=> cf_; apply: ler_lim; [exact: is_cvg_infs|exact: is_cvg_sups|]. by apply: nearW => n; apply: infs_le_sups. Qed. -Lemma cvg_lim_inf_sup u l : u --> l -> (lim_inf u = l) * (lim_sup u = l). +Lemma cvg_limn_inf_sup u l : u @ \oo --> l -> (limn_inf u = l) * (limn_sup u = l). Proof. move=> ul. -have /cvg_seq_bounded [M [Mr Mu]] : cvg u by apply/cvg_ex; eexists; exact: ul. -suff: lim_sup u <= l <= lim_inf u. +have /cvg_seq_bounded [M [Mr Mu]] : cvg (u @ \oo) + by apply/cvg_ex; eexists; exact: ul. +suff: limn_sup u <= l <= limn_inf u. move=> /andP[sul liu]. - have /lim_inf_le_lim_sup iusu : cvg u by apply/cvg_ex; eexists; exact: ul. + have /limn_inf_sup iusu : cvg (u @ \oo) by apply/cvg_ex; eexists; exact: ul. split; first by apply/eqP; rewrite eq_le liu andbT (le_trans iusu). by apply/eqP; rewrite eq_le sul /= (le_trans _ iusu). apply/andP; split. @@ -2195,107 +2386,134 @@ apply/andP; split. move/cvgrPdist_lt : (ul) => /(_ _ e0) -[k _ klu]. near=> n; have kn : (k <= n)%N by near: n; exists k. apply: sup_le_ub; first by exists (u n) => /=; exists n => //=. - move=> _ /= [m nm] <-; apply/ltW/ltr_distl_addr; rewrite distrC. + move=> _ /= [m nm] <-; apply/ltW/ltr_distlDr; rewrite distrC. by apply: (klu m) => /=; rewrite (leq_trans kn). -- apply/ler_addgt0Pr => e e0; rewrite -ler_subl_addr. +- apply/ler_addgt0Pr => e e0; rewrite -lerBlDr. apply: limr_ge; first by apply: is_cvg_infs; apply/cvg_ex; exists l. move/cvgrPdist_lt : (ul) => /(_ _ e0) -[k _ klu]. - near=> n; have kn: (k <= n)%N by near: n; exists k. + near=> n; have kn : (k <= n)%N by near: n; exists k. apply: lb_le_inf; first by exists (u n) => /=; exists n => //=. - move=> _ /= [m nm] <-; apply/ltW/ltr_distl_subl. + move=> _ /= [m nm] <-; apply/ltW/ltr_distlBl. by apply: (klu m) => /=; rewrite (leq_trans kn). Unshelve. all: by end_near. Qed. -Lemma cvg_lim_infE u : cvg u -> lim_inf u = lim u. +Lemma cvg_limn_infE u : cvgn u -> limn_inf u = limn u. Proof. -move=> /cvg_ex[l ul]; have [-> _] := cvg_lim_inf_sup ul. +move=> /cvg_ex[l ul]; have [-> _] := cvg_limn_inf_sup ul. by move/cvg_lim : ul => ->. Qed. -Lemma cvg_lim_supE u : cvg u -> lim_sup u = lim u. +Lemma cvg_limn_supE u : cvgn u -> limn_sup u = limn u. Proof. -move=> /cvg_ex[l ul]; have [_ ->] := cvg_lim_inf_sup ul. +move=> /cvg_ex[l ul]; have [_ ->] := cvg_limn_inf_sup ul. by move/cvg_lim : ul => ->. Qed. -Lemma cvg_sups u l : u --> l -> (sups u) --> (l : R^o). +Lemma cvg_sups u l : u @ \oo --> l -> sups u @ \oo --> (l : R^o). Proof. -move=> ul; have [iul <-] := cvg_lim_inf_sup ul. +move=> ul; have [iul <-] := cvg_limn_inf_sup ul. apply/cvg_closeP; split => //; apply: is_cvg_sups. by apply/cvg_ex; eexists; apply: ul. Qed. -Lemma cvg_infs u l : u --> l -> (infs u) --> (l : R^o). +Lemma cvg_infs u l : u @ \oo --> l -> infs u @ \oo --> (l : R^o). Proof. -move=> ul; have [<- iul] := cvg_lim_inf_sup ul. +move=> ul; have [<- iul] := cvg_limn_inf_sup ul. apply/cvg_closeP; split => //; apply: is_cvg_infs. by apply/cvg_ex; eexists; apply: ul. Qed. -Lemma le_lim_supD u v : - bounded_fun u -> bounded_fun v -> lim_sup (u \+ v) <= lim_sup u + lim_sup v. +Lemma le_limn_supD u v : bounded_fun u -> bounded_fun v -> + limn_sup (u \+ v) <= limn_sup u + limn_sup v. Proof. move=> ba bb; have ab k : sups (u \+ v) k <= sups u k + sups v k. apply: sup_le_ub; first by exists ((u \+ v) k); exists k => /=. - by move=> M [n /= kn <-]; apply: ler_add; apply: sup_ub; [ + by move=> M [n /= kn <-]; apply: lerD; apply: sup_ub; [ exact/has_ubound_sdrop/bounded_fun_has_ubound; exact | exists n | exact/has_ubound_sdrop/bounded_fun_has_ubound; exact | exists n ]. -have cu : cvg (sups u). - apply: nonincreasing_is_cvg; last exact: bounded_fun_has_lbound_sups. +have cu : cvgn (sups u). + apply: nonincreasing_is_cvgn; last exact: bounded_fun_has_lbound_sups. exact/nonincreasing_sups/bounded_fun_has_ubound. -have cv : cvg (sups v). - apply: nonincreasing_is_cvg; last exact: bounded_fun_has_lbound_sups. +have cv : cvgn (sups v). + apply: nonincreasing_is_cvgn; last exact: bounded_fun_has_lbound_sups. exact/nonincreasing_sups/bounded_fun_has_ubound. -rewrite -(@limD _ [normedModType R of R^o] _ _ _ _ _ cu cv); apply: ler_lim. -- apply: nonincreasing_is_cvg; last first. +rewrite -(limD cu cv); apply: ler_lim. +- apply: nonincreasing_is_cvgn; last first. exact/bounded_fun_has_lbound_sups/bounded_funD. exact/nonincreasing_sups/bounded_fun_has_ubound/bounded_funD. -- exact: (@is_cvgD _ [normedModType R of R^o] _ _ _ _ _ cu cv). +- exact: is_cvgD cu cv. - exact: nearW. Qed. -Lemma le_lim_infD u v : - bounded_fun u -> bounded_fun v -> lim_inf u + lim_inf v <= lim_inf (u \+ v). +Lemma le_limn_infD u v : bounded_fun u -> bounded_fun v -> + limn_inf u + limn_inf v <= limn_inf (u \+ v). Proof. move=> ba bb; have ab k : infs u k + infs v k <= infs (u \+ v) k. apply: lb_le_inf; first by exists ((u \+ v) k); exists k => /=. - by move=> M [n /= kn <-]; apply: ler_add; apply: inf_lb; [ + by move=> M [n /= kn <-]; apply: lerD; apply: inf_lb; [ exact/has_lbound_sdrop/bounded_fun_has_lbound; exact | exists n | exact/has_lbound_sdrop/bounded_fun_has_lbound; exact | exists n ]. -have cu : cvg (infs u). - apply: nondecreasing_is_cvg; last exact: bounded_fun_has_ubound_infs. +have cu : cvgn (infs u). + apply: nondecreasing_is_cvgn; last exact: bounded_fun_has_ubound_infs. exact/nondecreasing_infs/bounded_fun_has_lbound. -have cv : cvg (infs v). - apply: nondecreasing_is_cvg; last exact: bounded_fun_has_ubound_infs. +have cv : cvgn (infs v). + apply: nondecreasing_is_cvgn; last exact: bounded_fun_has_ubound_infs. exact/nondecreasing_infs/bounded_fun_has_lbound. -rewrite -(@limD _ [normedModType R of R^o] _ _ _ _ _ cu cv); apply: ler_lim. -- exact: (@is_cvgD _ [normedModType R of R^o] _ _ _ _ _ cu cv). -- apply: nondecreasing_is_cvg; last first. +rewrite -(limD cu cv); apply: ler_lim. +- exact: is_cvgD cu cv. +- apply: nondecreasing_is_cvgn; last first. exact/bounded_fun_has_ubound_infs/bounded_funD. exact/nondecreasing_infs/bounded_fun_has_lbound/bounded_funD. - exact: nearW. Qed. -Lemma lim_supD u v : cvg u -> cvg v -> lim_sup (u \+ v) = lim_sup u + lim_sup v. +Lemma limn_supD u v : cvgn u -> cvgn v -> + limn_sup (u \+ v) = limn_sup u + limn_sup v. Proof. move=> cu cv; have [ba bb] := (cvg_seq_bounded cu, cvg_seq_bounded cv). -apply/eqP; rewrite eq_le le_lim_supD //=. -have := @le_lim_supD _ _ (bounded_funD ba bb) (bounded_funN bb). -rewrite -ler_subl_addr; apply: le_trans. -rewrite -[_ \+ _]/(u + v - v) addrK -lim_infN; last exact: is_cvgN. +apply/eqP; rewrite eq_le le_limn_supD //=. +have := @le_limn_supD _ _ (bounded_funD ba bb) (bounded_funN bb). +rewrite -lerBlDr; apply: le_trans. +rewrite -[_ \+ _]/(u + v - v) addrK -limn_infN; last exact: is_cvgN. rewrite /comp /=; under eq_fun do rewrite opprK. -by rewrite ler_add// cvg_lim_infE// cvg_lim_supE. -Qed. - -Lemma lim_infD u v : cvg u -> cvg v -> lim_inf (u \+ v) = lim_inf u + lim_inf v. -Proof. -move=> cu cv; rewrite (cvg_lim_infE cu) -(cvg_lim_supE cu). -rewrite (cvg_lim_infE cv) -(cvg_lim_supE cv) -lim_supD//. -rewrite cvg_lim_supE; last exact: (@is_cvgD _ _ _ _ _ _ _ cu cv). -by rewrite cvg_lim_infE //; exact: (@is_cvgD _ _ _ _ _ _ _ cu cv). -Qed. - -End lim_sup_lim_inf. +by rewrite lerD// cvg_limn_infE// cvg_limn_supE. +Qed. + +Lemma limn_infD u v : cvgn u -> cvgn v -> + limn_inf (u \+ v) = limn_inf u + limn_inf v. +Proof. +move=> cu cv; rewrite (cvg_limn_infE cu) -(cvg_limn_supE cu). +rewrite (cvg_limn_infE cv) -(cvg_limn_supE cv) -limn_supD//. +rewrite cvg_limn_supE; last exact: (@is_cvgD _ _ _ _ _ _ _ cu cv). +by rewrite cvg_limn_infE //; exact: (@is_cvgD _ _ _ _ _ _ _ cu cv). +Qed. + +End limn_sup_limn_inf. + +#[deprecated(since="mathcomp-analysis 0.6.6", note="renamed to `limn_sup`")] +Notation lim_sup := limn_sup (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", note="renamed to `limn_inf`")] +Notation lim_inf := limn_sup (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", note="renamed to `limn_infN`")] +Notation lim_infN := limn_infN (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", note="renamed to `limn_supE`")] +Notation lim_supE := limn_supE (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", note="renamed to `limn_infE`")] +Notation lim_infE := limn_infE (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", note="renamed to `limn_inf_sup`")] +Notation lim_inf_le_lim_sup := limn_inf_sup (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", note="renamed to `cvg_limn_infE`")] +Notation cvg_lim_infE := cvg_limn_infE (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", note="renamed to `cvg_limn_supE`")] +Notation cvg_lim_supE := cvg_limn_supE (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", note="renamed to `le_limn_supD`")] +Notation le_lim_supD := le_limn_supD (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", note="renamed to `le_limn_infD`")] +Notation le_lim_infD := le_limn_infD (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", note="renamed to `limn_supD`")] +Notation lim_supD := limn_supD (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", note="renamed to `limn_infD`")] +Notation lim_infD := limn_infD (only parsing). Section esups_einfs. Variable R : realType. @@ -2338,16 +2556,16 @@ rewrite /einfs /=; set A := sdrop _ _; have [a Aa] : A !=set0. by rewrite (@le_trans _ _ a) //; [exact/ereal_inf_lb|exact/ereal_sup_ub]. Unshelve. all: by end_near. Qed. -Lemma cvg_esups_inf u : esups u --> ereal_inf (range (esups u)). -Proof. by apply: ereal_nonincreasing_cvg => //; exact: nonincreasing_esups. Qed. +Lemma cvg_esups_inf u : esups u @ \oo --> ereal_inf (range (esups u)). +Proof. by apply: ereal_nonincreasing_cvgn => //; exact: nonincreasing_esups. Qed. -Lemma is_cvg_esups u : cvg (esups u). +Lemma is_cvg_esups u : cvgn (esups u). Proof. by apply/cvg_ex; eexists; exact/cvg_esups_inf. Qed. -Lemma cvg_einfs_sup u : einfs u --> ereal_sup (range (einfs u)). -Proof. by apply: ereal_nondecreasing_cvg => //; exact: nondecreasing_einfs. Qed. +Lemma cvg_einfs_sup u : einfs u @ \oo --> ereal_sup (range (einfs u)). +Proof. by apply: ereal_nondecreasing_cvgn => //; exact: nondecreasing_einfs. Qed. -Lemma is_cvg_einfs u : cvg (einfs u). +Lemma is_cvg_einfs u : cvgn (einfs u). Proof. by apply/cvg_ex; eexists; exact/cvg_einfs_sup. Qed. Lemma esups_preimage T (a : \bar R) (f : (T -> \bar R)^nat) n : @@ -2367,7 +2585,7 @@ Lemma einfs_preimage T (a : \bar R) (f : (T -> \bar R)^nat) n : Proof. rewrite predeqE => t; split => /= [|h]. rewrite in_itv andbT /= => h k nk /=. - by rewrite /= in_itv/= (le_trans h)//; apply ereal_inf_lb; exists k. + by rewrite /= in_itv/= (le_trans h)//; apply: ereal_inf_lb; exists k. rewrite /= in_itv /= andbT leNgt; apply/negP. move=> /ereal_inf_lt[_ /= [k nk <-]]; apply/negP. by have := h _ nk; rewrite /= in_itv /= andbT -leNgt. @@ -2375,30 +2593,48 @@ Qed. End esups_einfs. -Module LimSup. -Definition lim_esup (R : realType) (u : (\bar R)^nat) := lim (esups u). -Definition lim_einf (R : realType) (u : (\bar R)^nat) := lim (einfs u). -End LimSup. +Section limn_esup_einf. +Context {R : realType}. +Implicit Type (u : (\bar R)^nat). +Local Open Scope ereal_scope. + +Definition limn_esup u := limf_esup u \oo. + +Definition limn_einf u := - limn_esup (\- u). + +Lemma limn_esup_lim u : limn_esup u = limn (esups u). +Proof. +apply/eqP; rewrite eq_le; apply/andP; split. + apply: lime_ge; first exact: is_cvg_esups. + near=> m; apply: ereal_inf_lb => /=. + by exists [set k | (m <= k)%N] => //=; exists m. +apply: lb_ereal_inf => /= _ [A [r /= r0 rA] <-]. +apply: lime_le; first exact: is_cvg_esups. +near=> m; apply: le_ereal_sup => _ [n /= mn] <-. +exists n => //; apply: rA => //=; apply: leq_trans mn. +by near: m; exists r. +Unshelve. all: by end_near. Qed. -#[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `lim_esup`")] -Notation elim_sup := LimSup.lim_esup. -#[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `lim_einf`")] -Notation elim_inf := LimSup.lim_einf. +Lemma limn_einf_lim u : limn_einf u = limn (einfs u). +Proof. +rewrite /limn_einf limn_esup_lim esupsN -limeN//. + by under eq_fun do rewrite oppeK. +by apply: is_cvgeN; exact: is_cvg_einfs. +Qed. -Notation lim_esup := LimSup.lim_esup. -Notation lim_einf := LimSup.lim_einf. +End limn_esup_einf. Section lim_esup_inf. Local Open Scope ereal_scope. Variable R : realType. Implicit Types (u v : (\bar R)^nat) (l : \bar R). -Lemma lim_einf_shift u l : l \is a fin_num -> - lim_einf (fun x => l + u x) = l + lim_einf u. +Lemma limn_einf_shift u l : l \is a fin_num -> + limn_einf (fun x => l + u x) = l + limn_einf u. Proof. -move=> lfin; apply/cvg_lim => //; apply: cvg_trans; last first. - apply: (@cvgeD _ \oo _ _ (cst l) (einfs u) _ (lim (einfs u))). - - by rewrite adde_defC fin_num_adde_def. +move=> lfin; rewrite !limn_einf_lim; apply/cvg_lim => //; apply: cvg_trans; last first. + apply: (@cvgeD _ \oo _ _ (cst l) (einfs u) _ (limn (einfs u))). + - by rewrite fin_num_adde_defr. - exact: cvg_cst. - exact: is_cvg_einfs. suff : einfs (fun n => l + u n) = (fun n => l + einfs u n) by move=> ->. @@ -2411,78 +2647,77 @@ apply/eqP; rewrite eq_le; apply/andP; split. by rewrite lee_add2l//; apply: ereal_inf_lb; exists m => /=. Qed. -Lemma lim_esup_le_cvg u l : lim_esup u <= l -> (forall n, l <= u n) -> u --> l. +Lemma limn_esup_le_cvg u l : limn_esup u <= l -> (forall n, l <= u n) -> + u @ \oo --> l. Proof. move=> supul ul; have usupu n : l <= u n <= esups u n. by rewrite ul /=; apply/ereal_sup_ub; exists n => /=. -suff : esups u --> l. +suff : esups u @ \oo --> l. by apply: (@squeeze_cvge _ _ _ _ (cst l)) => //; [exact: nearW|exact: cvg_cst]. apply/cvg_closeP; split; first exact: is_cvg_esups. -rewrite closeE//; apply/eqP; rewrite eq_le supul. +rewrite closeE//; apply/eqP. +rewrite eq_le -[X in X <= _ <= _]limn_esup_lim supul/=. apply: (lime_ge (@is_cvg_esups _ _)); apply: nearW => m. have /le_trans : l <= einfs u m by apply: lb_ereal_inf => _ [p /= pm] <-. by apply; exact: einfs_le_esups. Qed. -Lemma lim_einfN u : lim_einf (-%E \o u) = - lim_esup u. -Proof. -by rewrite /lim_einf einfsN /lim_esup limeN //; exact/is_cvg_esups. -Qed. +Lemma limn_einfN u : limn_einf (-%E \o u) = - limn_esup u. +Proof. by rewrite /limn_esup -limf_einfN. Qed. -Lemma lim_esupN u : lim_esup (-%E \o u) = - lim_einf u. -Proof. -apply/eqP; rewrite -eqe_oppLR -lim_einfN /=. -by rewrite (_ : _ \o _ = u) // funeqE => n /=; rewrite oppeK. -Qed. +Lemma limn_esupN u : limn_esup (-%E \o u) = - limn_einf u. +Proof. by rewrite /limn_einf oppeK. Qed. -Lemma lim_einf_sup u : lim_einf u <= lim_esup u. +Lemma limn_einf_sup u : limn_einf u <= limn_esup u. Proof. +rewrite limn_esup_lim limn_einf_lim. apply: lee_lim; [exact/is_cvg_einfs|exact/is_cvg_esups|]. by apply: nearW; exact: einfs_le_esups. Qed. -Lemma cvgNy_lim_einf_sup u : u --> -oo -> - (lim_einf u = -oo) * (lim_esup u = -oo). +Lemma cvgNy_limn_einf_sup u : u @ \oo --> -oo -> + (limn_einf u = -oo) * (limn_esup u = -oo). Proof. -move=> uoo; suff: lim_esup u = -oo. - by move=> {}uoo; split => //; apply/eqP; rewrite -leeNy_eq -uoo lim_einf_sup. -apply: cvg_lim => //=. apply/cvgeNyPle => M. +move=> uoo; suff: limn_esup u = -oo. + by move=> {}uoo; split => //; apply/eqP; rewrite -leeNy_eq -uoo limn_einf_sup. +rewrite limn_esup_lim; apply: cvg_lim => //=; apply/cvgeNyPle => M. have /cvgeNyPle/(_ M)[m _ uM] := uoo. near=> n; apply: ub_ereal_sup => _ [k /= nk <-]. by apply: uM => /=; rewrite (leq_trans _ nk)//; near: n; exists m. Unshelve. all: by end_near. Qed. -Lemma cvgNy_einfs u : u --> -oo -> einfs u --> -oo. +Lemma cvgNy_einfs u : u @ \oo --> -oo -> einfs u @ \oo --> -oo. Proof. -move=> /cvgNy_lim_einf_sup[uoo _]. -by apply/cvg_closeP; split; [exact: is_cvg_einfs|rewrite closeE]. +move=> /cvgNy_limn_einf_sup[uoo _]. +apply/cvg_closeP; split; [exact: is_cvg_einfs|rewrite closeE//]. +by rewrite -limn_einf_lim. Qed. -Lemma cvgNy_esups u : u --> -oo -> esups u --> -oo. +Lemma cvgNy_esups u : u @ \oo --> -oo -> esups u @ \oo --> -oo. Proof. -move=> /cvgNy_lim_einf_sup[_ uoo]. -by apply/cvg_closeP; split; [exact: is_cvg_esups|rewrite closeE]. +move=> /cvgNy_limn_einf_sup[_ uoo]; apply/cvg_closeP. +by split; [exact: is_cvg_esups|rewrite closeE// -limn_esup_lim]. Qed. -Lemma cvgy_einfs u : u --> +oo -> einfs u --> +oo. +Lemma cvgy_einfs u : u @ \oo --> +oo -> einfs u @ \oo --> +oo. Proof. move=> /cvgeN/cvgNy_esups/cvgeN; rewrite esupsN. by under eq_cvg do rewrite /= oppeK. Qed. -Lemma cvgy_esups u : u --> +oo -> esups u --> +oo. +Lemma cvgy_esups u : u @ \oo --> +oo -> esups u @ \oo --> +oo. Proof. move=> /cvgeN/cvgNy_einfs/cvgeN; rewrite einfsN. by under eq_cvg do rewrite /= oppeK. Qed. -Lemma cvg_esups u l : u --> l -> esups u --> l. +Lemma cvg_esups u l : u @ \oo --> l -> esups u @ \oo --> l. Proof. case: l => [l /fine_cvgP[u_fin_num] ul| |]; last 2 first. - exact: cvgy_esups. - exact: cvgNy_esups. have [p _ pu] := u_fin_num; apply/cvg_ballP => _/posnumP[e]. -have : EFin \o sups (fine \o u) --> l%:E. +have : EFin \o sups (fine \o u) @ \oo --> l%:E. by apply: continuous_cvg => //; apply: cvg_sups. move=> /cvg_ballP /(_ e%:num (gt0 _))[q _ qsupsu]; near=> n. have -> : esups u n = (EFin \o sups (fine \o u)) n. @@ -2499,57 +2734,61 @@ have -> : esups u n = (EFin \o sups (fine \o u)) n. by apply: qsupsu => /=; near: n; exists q. Unshelve. all: by end_near. Qed. -Lemma cvg_einfs u l : u --> l -> einfs u --> l. +Lemma cvg_einfs u l : u @ \oo --> l -> einfs u @ \oo --> l. Proof. move=> /cvgeN/cvg_esups/cvgeN; rewrite oppeK esupsN. by under eq_cvg do rewrite /= oppeK. Qed. -Lemma cvg_lim_einf_sup u l : u --> l -> (lim_einf u = l) * (lim_esup u = l). +Lemma cvg_limn_einf_sup u l : u @ \oo --> l -> + (limn_einf u = l) * (limn_esup u = l). Proof. -by move=> ul; split; apply/cvg_lim => //; [apply/cvg_einfs|apply/cvg_esups]. +move=> ul; rewrite limn_esup_lim limn_einf_lim; split. +- by apply/cvg_lim => //; exact/cvg_einfs. +- by apply/cvg_lim => //; exact/cvg_esups. Qed. -Lemma is_cvg_lim_einfE u : cvg u -> lim_einf u = lim u. +Lemma is_cvg_limn_einfE u : cvgn u -> limn_einf u = limn u. Proof. -move=> /cvg_ex[l ul]; have [-> _] := cvg_lim_einf_sup ul. +move=> /cvg_ex[l ul]; have [-> _] := cvg_limn_einf_sup ul. by move/cvg_lim : ul => ->. Qed. -Lemma is_cvg_lim_esupE u : cvg u -> lim_esup u = lim u. +Lemma is_cvg_limn_esupE u : cvgn u -> limn_esup u = limn u. Proof. -move=> /cvg_ex[l ul]; have [_ ->] := cvg_lim_einf_sup ul. +move=> /cvg_ex[l ul]; have [_ ->] := cvg_limn_einf_sup ul. by move/cvg_lim : ul => ->. Qed. End lim_esup_inf. - -#[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `lim_einf_shift`")] -Notation elim_inf_shift := lim_einf_shift. -#[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `lim_esup_le_cvg`")] -Notation elim_sup_le_cvg := lim_esup_le_cvg. -#[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `lim_einfN`")] -Notation elim_infN := lim_einfN. -#[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `lim_esupN`")] -Notation elim_supN := lim_esupN. -#[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `lim_einf_sup`")] -Notation elim_inf_sup := lim_einf_sup. -#[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `cvgNy_lim_einf_sup`")] -Notation cvg_ninfty_elim_inf_sup := cvgNy_lim_einf_sup. -#[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `cvgNy_einfs`")] -Notation cvg_ninfty_einfs := cvgNy_einfs. -#[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `cvgNy_esups`")] -Notation cvg_ninfty_esups := cvgNy_esups. -#[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `cvgy_einfs`")] -Notation cvg_pinfty_einfs := cvgy_einfs. -#[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `cvgy_esups`")] -Notation cvg_pinfty_esups := cvgy_esups. -#[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `cvg_lim_einf_sup`")] -Notation cvg_elim_inf_sup := cvg_lim_einf_sup. -#[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `is_cvg_lim_einfE`")] -Notation is_cvg_elim_infE := is_cvg_lim_einfE. -#[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `is_cvg_lim_esupE`")] -Notation is_cvg_elim_supE := is_cvg_lim_esupE. +#[deprecated(since="mathcomp-analysis 0.6.6", note="renamed to `limn_einf_shift`")] +Notation lim_einf_shift := limn_einf_shift (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", note="renamed to `limn_esup_le_cvg`")] +Notation lim_esup_le_cvg := limn_esup_le_cvg (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", note="renamed to `limn_einfN`")] +Notation lim_einfN := limn_einfN (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", note="renamed to `limn_esupN`")] +Notation lim_esupN := limn_esupN (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", note="renamed to `limn_einf_sup`")] +Notation lim_einf_sup := limn_einf_sup (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", note="renamed to `cvgNy_limn_einf_sup`")] +Notation cvgNy_lim_einf_sup := cvgNy_limn_einf_sup (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", note="renamed to `cvg_limn_einf_sup`")] +Notation cvg_lim_einf_sup := cvg_limn_einf_sup (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", note="renamed to `is_cvg_limn_einfE`")] +Notation is_cvg_lim_einfE := is_cvg_limn_einfE (only parsing). +#[deprecated(since="mathcomp-analysis 0.6.6", note="renamed to `is_cvg_limn_esupE`")] +Notation is_cvg_lim_esupE := is_cvg_limn_esupE (only parsing). + +Lemma geometric_le_lim {R : realType} (n : nat) (a x : R) : + 0 <= a -> 0 < x -> `|x| < 1 -> series (geometric a x) n <= a * (1 - x)^-1. +Proof. +move=> a0 x0 x1. +have /(@cvg_unique _ (@Rhausdorff R)) := @cvg_geometric_series _ a _ x1. +move/(_ _ (@is_cvg_geometric_series _ a _ x1)) => ->. +apply: nondecreasing_cvgn_le; last exact: is_cvg_geometric_series. +by apply: nondecreasing_series => ? _ /=; rewrite pmulr_lge0 // exprn_gt0. +Qed. Section banach_contraction. @@ -2568,25 +2807,25 @@ Proof. by rewrite ?(invr_ge0, mulr_ge0, subr_ge0, ltW q1). Qed. Lemma contraction_dist n m : `|y n - y (n + m)| <= C * q%:num ^+ n. Proof. have f1 k : `|y k.+1 - y k| <= q%:num ^+ k * `|f base - base|. - elim: k => [|k /(ler_wpmul2l (ge0 q))]; first by rewrite expr0 mul1r. + elim: k => [|k /(ler_wpM2l (ge0 q))]; first by rewrite expr0 mul1r. rewrite mulrA -exprS; apply: le_trans. by rewrite (@ctrfq (y k.+1, y k)); split; exact: funS. have /le_trans -> // : `| y n - y (n + m)| <= series (geometric (`|f base - base| * q%:num ^+ n) q%:num) m. elim: m => [|m ih]. by rewrite geometric_seriesE ?lt_eqF//= addn0 subrr normr0 subrr mulr0 mul0r. - rewrite (le_trans (ler_dist_add (y (n + m)%N) _ _))//. - apply: (le_trans (ler_add ih _)); first by rewrite distrC addnS; exact: f1. + rewrite (le_trans (ler_distD (y (n + m)%N) _ _))//. + apply: (le_trans (lerD ih _)); first by rewrite distrC addnS; exact: f1. rewrite [_ * `|_|]mulrC exprD mulrA geometric_seriesE ?lt_eqF//=. rewrite -!/(`1-_) (onem_PosNum ctrf.1) (onemX_NngNum (ltW ctrf.1)). - rewrite -!mulrA -mulrDr ler_pmul// -mulrDr exprSr onemM -addrA. + rewrite -!mulrA -mulrDr ler_pM// -mulrDr exprSr onemM -addrA. rewrite -[in leRHS](mulrC _ `1-(_ ^+ m)) -onemMr onemK. by rewrite [in leRHS]mulrDl mulrAC mulrV ?mul1r// unitf_gt0// onem_gt0. rewrite geometric_seriesE ?lt_eqF//= -[leRHS]mulr1 (ACl (1*4*2*3))/= -/C. -by rewrite ler_wpmul2l// 1?mulr_ge0// ler_subl_addr ler_addl. +by rewrite ler_wpM2l// 1?mulr_ge0// lerBlDr lerDl. Qed. -Lemma contraction_cvg : cvg y. +Lemma contraction_cvg : cvgn y. Proof. apply/cauchy_cvgP; apply/cauchy_ballP => _/posnumP[e]; near_simpl. have lt_min n m : `|y n - y m| <= C * q%:num ^+ minn n m. @@ -2597,7 +2836,7 @@ case: ltrgt0P C_ge0 => // [Cpos|C0] _; last first. near=> n m => /=; rewrite -ball_normE. by apply: (le_lt_trans (lt_min _ _)); rewrite C0 mul0r. near=> n; rewrite -ball_normE /= (le_lt_trans (lt_min n.1 n.2)) //. -rewrite // -ltr_pdivl_mull //. +rewrite // -ltr_pdivlMl //. suff : ball 0 (C^-1 * e%:num) (q%:num ^+ minn n.1 n.2). by rewrite /ball /= sub0r normrN ger0_norm. near: n; rewrite nbhs_simpl. @@ -2612,10 +2851,10 @@ exists ([set n | N <= n], [set n | N <= n])%N; first by split; exists N. move=> [n m] [Nn Nm]; rewrite /ball /= sub0r normrN ger0_norm /g //. apply: le_lt_trans; last by apply: (Q N) => /=. rewrite sub0r normrN ger0_norm /geometric //= mul1r. -by rewrite ler_wiexpn2l // ?ltW // leq_min Nn. +by rewrite ler_wiXn2l // ?ltW // leq_min Nn. Unshelve. all: end_near. Qed. -Lemma contraction_cvg_fixed : closed U -> lim y = f (lim y). +Lemma contraction_cvg_fixed : closed U -> limn y = f (limn y). Proof. move=> clU; apply: cvg_lim => //. apply/cvgrPdist_lt => _/posnumP[e]; near_simpl; apply: near_inftyS. @@ -2623,7 +2862,7 @@ have [q_gt0 | | q0] := ltrgt0P q%:num. - near=> n => /=; apply: (le_lt_trans (@ctrfq (_, _) _)) => //=. + split; last exact: funS. by apply: closed_cvg contraction_cvg => //; apply: nearW => ?; exact: funS. - + rewrite -ltr_pdivl_mull //; near: n; move/cvgrPdist_lt: contraction_cvg; apply. + + rewrite -ltr_pdivlMl //; near: n; move/cvgrPdist_lt: contraction_cvg; apply. by rewrite mulr_gt0 // invr_gt0. - by rewrite ltNge//; exact: contraNP. - apply: nearW => /= n; apply: (le_lt_trans (@ctrfq (_, _) _)). diff --git a/theories/signed.v b/theories/signed.v index 5f8d66d66..a8959485e 100644 --- a/theories/signed.v +++ b/theories/signed.v @@ -1,9 +1,12 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) +From HB Require Import structures. From Coq Require Import ssreflect ssrfun ssrbool. From mathcomp Require Import ssrnat eqtype choice order ssralg ssrnum ssrint. -From mathcomp.classical Require Import mathcomp_extra. +From mathcomp Require Import mathcomp_extra. -(******************************************************************************) +(**md**************************************************************************) +(* # Positive, non-negative numbers, etc. *) +(* *) (* This file develops tools to make the manipulation of numbers with a known *) (* sign easier, thanks to canonical structures. This adds types like *) (* {posnum R} for positive values in R, a notation e%:pos that infers the *) @@ -12,7 +15,8 @@ From mathcomp.classical Require Import mathcomp_extra. (* For instance, given x, y : {posnum R}, we have *) (* ((x%:num + y%:num) / 2)%:pos : {posnum R} automatically inferred. *) (* *) -(* * types for values with known sign *) +(* ## Types for values with known sign *) +(* ``` *) (* {posnum R} == interface type for elements in R that are positive; R *) (* must have a zmodType structure. *) (* Allows to solve automatically goals of the form x > 0 if *) @@ -49,8 +53,10 @@ From mathcomp.classical Require Import mathcomp_extra. (* {!= x0 : T} == same with an explicit type T *) (* {?= x0} == {compare x0 & ?=0 & >?<0} *) (* {?= x0 : T} == same with an explicit type T *) +(* ``` *) (* *) -(* * casts from/to values with known sign *) +(* ## Casts from/to values with known sign *) +(* ``` *) (* x%:pos == explicitly casts x to {posnum R}, triggers the inference *) (* of a {posnum R} structure for x. *) (* x%:nng == explicitly casts x to {nonneg R}, triggers the inference *) @@ -62,23 +68,29 @@ From mathcomp.classical Require Import mathcomp_extra. (* particular this works from {posnum R} and {nonneg R} to R.*) (* x%:posnum == explicit cast from {posnum R} to R. *) (* x%:nngnum == explicit cast from {nonneg R} to R. *) +(* ``` *) (* *) -(* * nullity conditions nz *) +(* ## Nullity conditions nz *) (* All nz above can be the following (in scope snum_nullity_scope delimited *) (* by %snum_nullity) *) +(* ``` *) (* !=0 == to encode x != 0 *) (* ?=0 == unknown nullity *) +(* ``` *) (* *) -(* * reality conditions cond *) +(* ## Reality conditions cond *) (* All cond above can be the following (in scope snum_sign_scope delimited by *) (* by %snum_sign) *) +(* ``` *) (* =0 == to encode x == 0 *) (* >=0 == to encode x >= 0 *) (* <=0 == to encode x <= 0 *) (* >=<0 == to encode x >=< 0 *) (* >?<0 == unknown reality *) +(* ``` *) (* *) -(* * sign proofs *) +(* ## Sign proofs *) +(* ``` *) (* [sgn of x] == proof that x is of sign inferred by x%:sgn *) (* [gt0 of x] == proof that x > 0 *) (* [lt0 of x] == proof that x < 0 *) @@ -86,24 +98,29 @@ From mathcomp.classical Require Import mathcomp_extra. (* [le0 of x] == proof that x <= 0 *) (* [cmp0 of x] == proof that 0 >=< x *) (* [neq0 of x] == proof that x != 0 *) +(* ``` *) (* *) -(* * constructors *) +(* ## Constructors *) +(* ``` *) (* PosNum xgt0 == builds a {posnum R} from a proof xgt0 : x > 0 where x : R *) (* NngNum xge0 == builds a {posnum R} from a proof xgt0 : x >= 0 where x : R*) (* Signed.mk p == builds a {compare x0 & nz & cond} from a proof p that *) (* some x satisfies sign conditions encoded by nz and cond *) +(* ``` *) (* *) -(* * misc *) +(* ## Misc. *) +(* ``` *) (* !! x == triggers pretyping to fill the holes of the term x. The *) (* main use case is to trigger typeclass inference in the *) (* body of a ssreflect have := !! body. *) (* Credits: Enrico Tassi. *) -(* 2 == notation for 2%:R. *) +(* ``` *) (* *) -(* --> A number of canonical instances are provided for common operations, if *) +(* A number of canonical instances are provided for common operations, if *) (* your favorite operator is missing, look below for examples on how to add *) (* the appropriate Canonical. *) -(* --> Canonical instances are also provided according to types, as a *) +(* *) +(* Canonical instances are also provided according to types, as a *) (* fallback when no known operator appears in the expression. Look to *) (* nat_snum below for an example on how to add your favorite type. *) (******************************************************************************) @@ -230,7 +247,7 @@ Definition reality_cond (n : reality) (x : T) := | Real (Sign NonNeg) => x >= x0 | Real (Sign NonPos) => x <= x0 | Real AnySign => (x0 <= x) || (x <= x0) - | Arbitary => true + | Arbitrary => true end. Record def (nz : nullity) (cond : reality) := Def { @@ -306,7 +323,6 @@ Notation "x %:posnum" := (@num _ _ 0%R !=0 >=0 x) : ring_scope. Definition nonneg (R : numDomainType) of phant R := {>= 0%R : R}. Notation "{ 'nonneg' R }" := (@nonneg _ (Phant R)) : ring_scope. Notation "x %:nngnum" := (@num _ _ 0%R ?=0 >=0 x) : ring_scope. -Notation "2" := 2%:R : ring_scope. Arguments r {disp T x0 nz cond}. End Exports. End Signed. @@ -315,13 +331,8 @@ Export Signed.Exports. Section POrder. Variables (d : unit) (T : porderType d) (x0 : T) (nz : nullity) (cond : reality). Local Notation sT := {compare x0 & nz & cond}. -Canonical signed_subType := [subType for @Signed.r d T x0 nz cond]. -Definition signed_eqMixin := [eqMixin of sT by <:]. -Canonical signed_eqType := EqType sT signed_eqMixin. -Definition signed_choiceMixin := [choiceMixin of sT by <:]. -Canonical signed_choiceType := ChoiceType sT signed_choiceMixin. -Definition signed_porderMixin := [porderMixin of sT by <:]. -Canonical signed_porderType := POrderType d sT signed_porderMixin. +HB.instance Definition _ := [isSub for @Signed.r d T x0 nz cond]. +HB.instance Definition _ : Order.POrder d sT := [POrder of sT by <:]. End POrder. Lemma top_typ_subproof d (T : porderType d) (x0 x : T) : @@ -355,7 +366,7 @@ Lemma typ_snum_subproof d nz cond (xt : Signed.typ d nz cond) Signed.spec (Signed.sort_x0 xt) nz cond x. Proof. by move: xt x => []. Qed. -(* This adds _ <- Signed.r ( typ_snum ) +(** This adds _ <- Signed.r ( typ_snum ) to canonical projections (c.f., Print Canonical Projections Signed.r) meaning that if no other canonical instance (with a registered head symbol) is found, a canonical instance of @@ -538,12 +549,11 @@ Section Order. Variables (R : numDomainType) (nz : nullity) (r : real). Local Notation nR := {num R & nz & r}. -Lemma signed_le_total : totalPOrderMixin [porderType of nR]. +Lemma signed_le_total : total (<=%O : rel nR). Proof. by move=> x y; apply: real_comparable => /=. Qed. -Canonical signed_latticeType := LatticeType nR signed_le_total. -Canonical signed_distrLatticeType := DistrLatticeType nR signed_le_total. -Canonical signed_orderType := OrderType nR signed_le_total. +HB.instance Definition _ := Order.POrder_isTotal.Build ring_display nR + signed_le_total. End Order. @@ -736,7 +746,7 @@ Proof. rewrite {}/rnz {}/rrl; apply/andP; split. move: xr yr xnz ynz x y => [[[]|]|] [[[]|]|] [] []//= x y; by rewrite 1?addr_ss_eq0 ?(eq0F, ge0, le0, andbF, orbT). -have addr_le0 a b : a <= 0 -> b <= 0 -> a + b <= 0. +have addr_le0 (a b : R) : a <= 0 -> b <= 0 -> a + b <= 0. by rewrite -!oppr_ge0 opprD; apply: addr_ge0. move: xr yr xnz ynz x y => [[[]|]|] [[[]|]|] [] []//= x y; do ?[by rewrite addr_ge0|by rewrite addr_le0|by rewrite -realE realD @@ -925,11 +935,6 @@ Section NatStability. Local Open Scope nat_scope. Implicit Type (n : nat). -Lemma nat_snum_subproof n : Signed.spec 0 ?=0 >=0 n. -Proof. by []. Qed. - -Canonical nat_snum n := Signed.mk (nat_snum_subproof n). - Lemma zeron_snum_subproof : Signed.spec 0 ?=0 =0 0. Proof. by []. Qed. @@ -1025,6 +1030,26 @@ Canonical maxn_snum (xnz ynz : nullity) (xr yr : reality) End NatStability. +Section IntStability. + +Lemma Posz_snum_subproof (xnz : nullity) (xr : reality) + (x : {compare 0%N & xnz & xr}) : + Signed.spec 0%Z xnz xr (Posz x%:num). +Proof. +by apply/andP; split; move: xr xnz x => [[[]|]|] []//=; move=> [[|x]//= _]. +Qed. + +Canonical Posz_snum (xnz : nullity) (xr : reality) + (x : {compare 0%N & xnz & xr}) := + Signed.mk (Posz_snum_subproof x). + +Lemma Negz_snum_subproof (n : nat) : Signed.spec 0%Z !=0 <=0 (Negz n). +Proof. by []. Qed. + +Canonical Negz_snum n := Signed.mk (Negz_snum_subproof n). + +End IntStability. + Section Morph0. Context {R : numDomainType} {cond : reality}. Local Notation nR := {num R & ?=0 & cond}. @@ -1167,10 +1192,10 @@ Proof. by move=> xge0; rewrite xge0 -[x]/(NngNum xge0)%:num; constructor. Qed. (* End NonnegOrder. *) -(* These proofs help integrate more arithmetic with signed.v. The issue is *) -(* Terms like `0 < 1-q` with subtraction don't work well. So we hide the *) -(* subtractions behind `PosNum` and `NngNum` constructors, see sequences.v *) -(* for examples. *) +(** These proofs help integrate more arithmetic with signed.v. The issue is + Terms like `0 < 1-q` with subtraction don't work well. So we hide the + subtractions behind `PosNum` and `NngNum` constructors, see sequences.v + for examples. *) Section onem_signed. Variable R : numDomainType. Implicit Types r : R. diff --git a/theories/summability.v b/theories/summability.v index 1f9287723..09915bb10 100644 --- a/theories/summability.v +++ b/theories/summability.v @@ -1,10 +1,14 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) +From HB Require Import structures. Require Reals. From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum finmap matrix. From mathcomp Require Import interval zmodp. -From mathcomp.classical Require Import boolp classical_sets. -Require Import ereal reals. -Require Import Rstruct signed topology normedtype. +From mathcomp Require Import boolp classical_sets. +Require Import ereal reals Rstruct signed topology normedtype. + +(**md**************************************************************************) +(* (undocumented experiment) *) +(******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. @@ -23,12 +27,9 @@ Import fintype bigop finmap. Local Open Scope fset_scope. (* :TODO: when eventually is generalized to any lattice *) (* totally can just be replaced by eventually *) -Definition totally {I : choiceType} : set (set {fset I}) := +Definition totally {I : choiceType} : set_system {fset I} := filter_from setT (fun A => [set B | A `<=` B]). -Canonical totally_filter_source {I : choiceType} X := - @Filtered.Source X _ {fset I} (fun f => f @ totally). - Instance totally_filter {I : choiceType} : ProperFilter (@totally I). Proof. eapply filter_from_proper; last by move=> A _; exists A; rewrite /= fsubset_refl. @@ -40,7 +41,7 @@ Definition partial_sum {I : choiceType} {R : zmodType} (x : I -> R) (A : {fset I}) : R := \sum_(i : A) x (val i). Definition sum (I : choiceType) {K : numDomainType} {R : normedModType K} - (x : I -> R) : R := lim (partial_sum x). + (x : I -> R) : R := lim (partial_sum x @ totally). Definition summable (I : choiceType) {K : realType} {R : normedModType K} (x : I -> R) := diff --git a/theories/topology.v b/theories/topology.v index 4a80621cf..22dcb838c 100644 --- a/theories/topology.v +++ b/theories/topology.v @@ -1,259 +1,332 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) -From mathcomp Require Import all_ssreflect all_algebra finmap. -From mathcomp.classical Require Import boolp classical_sets functions. -From mathcomp.classical Require Import cardinality mathcomp_extra fsbigop. +From HB Require Import structures. +From mathcomp Require Import all_ssreflect all_algebra finmap generic_quotient. +From mathcomp Require Import boolp classical_sets functions. +From mathcomp Require Import cardinality mathcomp_extra fsbigop. Require Import reals signed. -(******************************************************************************) -(* Filters and basic topological notions *) +(**md**************************************************************************) +(* # Filters and basic topological notions *) (* *) (* This file develops tools for the manipulation of filters and basic *) -(* topological notions. The development of topological notions builds on *) -(* "filtered types". They are types equipped with an interface that *) -(* associates to each element a set of sets, intended to represent a filter. *) -(* The notions of limit and convergence are defined for filtered types and in *) -(* the documentation below we call "canonical filter" of an element the set *) -(* of sets associated to it by the interface of filtered types. *) +(* topological notions. *) +(* *) +(* The development of topological notions builds on "filtered types". They *) +(* are types equipped with an interface that associates to each element a *) +(* set of sets, intended to represent a filter. The notions of limit and *) +(* convergence are defined for filtered types and in the documentation below *) +(* we call "canonical filter" of an element the set of sets associated to it *) +(* by the interface of filtered types. *) +(* *) +(* We used these topological notions to prove, e.g., Tychonoff's Theorem, *) +(* which states that any product of compact sets is compact according to the *) +(* product topology or Arzela-Ascoli's theorem. *) +(* *) +(* Table of contents of the documentation: *) +(* 1. Filters *) +(* - Structure of filter *) +(* - Theory of filters *) +(* - Near notations and tactics *) +(* + Notations *) +(* + Tactics *) +(* 2. Basic topological notions *) +(* - Mathematical structures *) +(* + Topology *) +(* + Uniform spaces *) +(* + Pseudometric spaces *) +(* + Complete uniform spaces *) +(* + Complete pseudometric spaces *) +(* + Function space topologies *) +(* + Subspaces of topological spaces *) (* *) -(* monotonous A f := {in A &, {mono f : x y / x <= y}} \/ *) -(* {in A &, {mono f : x y /~ x <= y}}. *) +(******************************************************************************) + +(**md**************************************************************************) +(* # 1. Filters *) (* *) -(* * Filters : *) +(* ## Structure of filter *) +(* ``` *) (* filteredType U == interface type for types whose *) (* elements represent sets of sets on U. *) (* These sets are intended to be filters *) (* on U but this is not enforced yet. *) (* FilteredType U T m == packs the function m: T -> set (set U) *) (* to build a filtered type of type *) -(* filteredType U; T must have a *) -(* pointedType structure. *) +(* filteredType U *) +(* T must have a pointedType structure. *) (* [filteredType U of T for cT] == T-clone of the filteredType U *) -(* structure cT. *) +(* structure cT *) (* [filteredType U of T] == clone of a canonical structure of *) -(* filteredType U on T. *) +(* filteredType U on T *) (* Filtered.source Y Z == structure that records types X such *) (* that there is a function mapping *) (* functions of type X -> Y to filters on *) -(* Z. Allows to infer the canonical *) -(* filter associated to a function by *) +(* Z *) +(* Allows to infer the canonical filter *) +(* associated to a function by looking *) (* looking at its source type. *) (* Filtered.Source F == if F : (X -> Y) -> set (set Z), packs *) (* X with F in a Filtered.source Y Z *) -(* structure. *) +(* structure *) +(* ``` *) +(* *) +(* We endow several standard types with the structure of filter, e.g.: *) +(* - products: filtered_prod *) +(* - matrices: matrix_filtered *) +(* - natural numbers: nat_filteredType *) +(* *) +(* ## Theory of filters *) +(* ``` *) (* nbhs p == set of sets associated to p (in a *) -(* filtered type). *) +(* filtered type) *) (* filter_from D B == set of the supersets of the elements *) (* of the family of sets B whose indices *) -(* are in the domain D. *) +(* are in the domain D *) (* This is a filter if (B_i)_(i in D) *) (* forms a filter base. *) -(* filter_prod F G == product of the filters F and G. *) -(* [filter of x] == canonical filter associated to x. *) -(* F `=>` G <-> G is included in F; F and G are sets *) -(* of sets. *) +(* filter_prod F G == product of the filters F and G *) +(* [filter of x] == canonical filter associated to x *) +(* F `=>` G <-> G is included in F *) +(* F and G are sets of sets. *) (* F --> G <-> the canonical filter associated to G *) (* is included in the canonical filter *) -(* associated to F. *) +(* associated to F *) (* lim F == limit of the canonical filter *) (* associated with F if there is such a *) (* limit, i.e., an element l such that *) (* the canonical filter associated to l *) -(* is a subset of F. *) +(* is a subset of F *) (* [lim F in T] == limit of the canonical filter *) (* associated to F in T where T has type *) -(* filteredType U. *) +(* filteredType U *) (* [cvg F in T] <-> the canonical filter associated to F *) -(* converges in T. *) +(* converges in T *) (* cvg F <-> same as [cvg F in T] where T is *) (* inferred from the type of the *) -(* canonical filter associated to F. *) +(* canonical filter associated to F *) (* Filter F == type class proving that the set of *) -(* sets F is a filter. *) +(* sets F is a filter *) (* ProperFilter F == type class proving that the set of *) -(* sets F is a proper filter. *) +(* sets F is a proper filter *) (* UltraFilter F == type class proving that the set of *) (* sets F is an ultrafilter *) (* filter_on T == interface type for sets of sets on T *) -(* that are filters. *) +(* that are filters *) (* FilterType F FF == packs the set of sets F with the proof *) (* FF of Filter F to build a filter_on T *) -(* structure. *) +(* structure *) (* pfilter_on T == interface type for sets of sets on T *) -(* that are proper filters. *) +(* that are proper filters *) (* PFilterPack F FF == packs the set of sets F with the proof *) (* FF of ProperFilter F to build a *) -(* pfilter_on T structure. *) +(* pfilter_on T structure *) (* fmap f F == image of the filter F by the function *) (* f *) -(* E @[x --> F] == image of the canonical filter *) +(* E @[x --> F] == image of the canonical filter *) (* associated to F by the function *) -(* (fun x => E). *) +(* (fun x => E) *) (* f @ F == image of the canonical filter *) -(* associated to F by the function f. *) +(* associated to F by the function f *) (* fmapi f F == image of the filter F by the relation *) (* f *) -(* E `@[x --> F] == image of the canonical filter *) +(* E `@[x --> F] == image of the canonical filter *) (* associated to F by the relation *) -(* (fun x => E). *) +(* (fun x => E) *) (* f `@ F == image of the canonical filter *) -(* associated to F by the relation f. *) -(* globally A == filter of the sets containing A. *) +(* associated to F by the relation f *) +(* globally A == filter of the sets containing A *) (* @frechet_filter T := [set S : set T | finite_set (~` S)] *) (* a.k.a. cofinite filter *) -(* at_point a == filter of the sets containing a. *) +(* at_point a == filter of the sets containing a *) (* within D F == restriction of the filter F to the *) -(* domain D. *) -(* principal_filter x == filter containing every superset of x. *) +(* domain D *) +(* principal_filter x == filter containing every superset of x *) (* subset_filter F D == similar to within D F, but with *) -(* dependent types. *) -(* powerset_filter_from F == The filter of downward closed subsets *) -(* of F. Enables use of near notation to *) -(* pick suitably small members of F *) +(* dependent types *) +(* powerset_filter_from F == the filter of downward closed subsets *) +(* of F. *) +(* Enables use of near notation to pick *) +(* suitably small members of F *) (* in_filter F == interface type for the sets that *) -(* belong to the set of sets F. *) +(* belong to the set of sets F *) (* InFilter FP == packs a set P with a proof of F P to *) -(* build a in_filter F structure. *) +(* build a in_filter F structure *) (* \oo == "eventually" filter on nat: set of *) (* predicates on natural numbers that are *) -(* eventually true. *) +(* eventually true *) +(* clopen U == U is both open and closed *) +(* ``` *) (* *) -(* * Near notations and tactics: *) -(* --> The purpose of the near notations and tactics is to make the *) -(* manipulation of filters easier. Instead of proving F G, one can *) -(* prove G x for x "near F", i.e. for x such that H x for H arbitrarily *) -(* precise as long as F H. The near tactics allow for a delayed *) -(* introduction of H: H is introduced as an existential variable and *) -(* progressively instantiated during the proof process. *) -(* --> Notations: *) +(* ## Near notations and tactics *) +(* The purpose of the near notations and tactics is to make the manipulation *) +(* of filters easier. Instead of proving $F\; G$, one can prove $G\; x$ for *) +(* $x$ "near F", i.e., for x such that H x for H arbitrarily precise as long *) +(* as $F\; H$. The near tactics allow for a delayed introduction of $H$: *) +(* $H$ is introduced as an existential variable and progressively *) +(* instantiated during the proof process. *) +(* *) +(* ### Notations *) +(* ``` *) (* {near F, P} == the property P holds near the *) -(* canonical filter associated to F; P *) -(* must have the form forall x, Q x. *) +(* canonical filter associated to F *) +(* P must have the form forall x, Q x. *) (* Equivalent to F Q. *) (* \forall x \near F, P x <-> F (fun x => P x). *) (* \near x, P x := \forall y \near x, P y. *) (* {near F & G, P} == same as {near H, P}, where H is the *) -(* product of the filters F and G. *) -(* \forall x \near F & y \near G, P x y := {near F & G, forall x y, P x y}. *) -(* \forall x & y \near F, P x y == same as before, with G = F. *) -(* \near x & y, P x y := \forall z \near x & t \near y, P x y. *) -(* x \is_near F == x belongs to a set P : in_filter F. *) -(* --> Tactics: *) -(* - near=> x introduces x: *) -(* On the goal \forall x \near F, G x, introduces the variable x and an *) -(* "existential", and unaccessible hypothesis ?H x and asks the user to *) -(* prove (G x) in this context. *) -(* Under the hood delays the proof of F ?H and waits for near: x *) -(* Also exists under the form near=> x y. *) -(* - near: x discharges x: *) -(* On the goal H_i x, and where x \is_near F, it asks the user to prove *) -(* that (\forall x \near F, H_i x), provided that H_i x does not depend *) -(* on variables introduced after x. *) -(* Under the hood, it refines by intersection the existential variable *) -(* ?H attached to x, computes the intersection with F, and asks the *) -(* user to prove F H_i, right now *) -(* - end_near should be used to close remaining existentials trivially *) -(* - near F => x poses a variable near F, where F is a proper filter *) -(* adds to the context a variable x that \is_near F, i.e. one may *) -(* assume H x for any H in F. This new variable x can be dealt with *) -(* using near: x, as for variables introduced by near=>. *) +(* product of the filters F and G *) +(* \forall x \near F & y \near G, P x y := {near F & G, forall x y, P x y} *) +(* \forall x & y \near F, P x y == same as before, with G = F *) +(* \near x & y, P x y := \forall z \near x & t \near y, P x y *) +(* x \is_near F == x belongs to a set P : in_filter F *) +(* ``` *) +(* *) +(* ### Tactics *) +(* - near=> x introduces x: *) +(* On the goal \forall x \near F, G x, introduces the variable x and an *) +(* "existential", and an unaccessible hypothesis ?H x and asks the user to *) +(* prove (G x) in this context. *) +(* Under the hood, it delays the proof of F ?H and waits for near: x. *) +(* Also exists under the form near=> x y. *) +(* - near: x discharges x: *) +(* On the goal H_i x, and where x \is_near F, it asks the user to prove *) +(* that (\forall x \near F, H_i x), provided that H_i x does not depend on *) +(* variables introduced after x. *) +(* Under the hood, it refines by intersection the existential variable ?H *) +(* attached to x, computes the intersection with F, and asks the user to *) +(* prove F H_i, right now. *) +(* - end_near should be used to close remaining existentials trivially. *) +(* - near F => x poses a variable near F, where F is a proper filter *) +(* It adds to the context a variable x that \is_near F, i.e., one may *) +(* assume H x for any H in F. This new variable x can be dealt with using *) +(* near: x, as for variables introduced by near=>. *) (* *) -(* * Topology : *) +(******************************************************************************) + +(**md**************************************************************************) +(* # 2. Basic topological notions *) +(* *) +(* ## Mathematical structures *) +(* ### Topology *) +(* ``` *) (* topologicalType == interface type for topological space *) (* structure. *) +(* TopologicalType T m == packs the mixin m to build a *) +(* topologicalType *) +(* T must have a canonical structure of *) +(* filteredType T. *) (* TopologicalMixin nbhs_filt nbhsE == builds the mixin for a topological *) (* space from the proofs that nbhs *) (* outputs proper filters and defines the *) (* same notion of neighbourhood as the *) (* open sets. *) -(* topologyOfFilterMixin nbhs_filt nbhs_sing nbhs_nbhs == builds the mixin *) -(* for a topological space from the *) -(* properties of nbhs and hence assumes *) -(* that the carrier is a filterType *) -(* topologyOfOpenMixin opT opI op_bigU == builds the mixin for a *) -(* topological space from the properties *) -(* of open sets, assuming the carrier is *) -(* a pointed type. nbhs_of_open must be *) +(* [topologicalType of T for cT] == T-clone of the topologicalType *) +(* structure cT *) +(* [topologicalType of T] == clone of a canonical structure of *) +(* topologicalType on T *) +(* open == set of open sets *) +(* open_nbhs p == set of open neighbourhoods of p *) +(* basis B == a family of open sets that converges *) +(* to each point *) +(* second_countable T == T has a countable basis *) +(* continuous f <-> f is continuous w.r.t the topology *) +(* [locally P] := forall a, A a -> G (within A (nbhs x)) *) +(* if P is convertible to G (globally A) *) +(* topologyOfFilterMixin nbhs_filt nbhs_sing nbhs_nbhs == topology defined by *) +(* a filter *) +(* It builds the mixin for a topological *) +(* space from the properties of nbhs and *) +(* hence assumes that the carrier is a *) +(* filterType. *) +(* topologyOfOpenMixin opT opI op_bigU == topology defined by open sets *) +(* It builds the mixin for a topological *) +(* space from the properties of open *) +(* sets, assuming the carrier is a *) +(* pointed type. nbhs_of_open must be *) (* used to declare a filterType. *) -(* topologyOfBaseMixin b_cover b_join == builds the mixin for a topological *) +(* topologyOfBaseMixin b_cover b_join == topology defined by a base of open *) +(* sets *) +(* It builds the mixin for a topological *) (* space from the properties of a base of *) (* open sets; the type of indices must be *) (* a pointedType, as well as the carrier. *) (* nbhs_of_open \o open_from must be *) -(* used to declare a filterType *) -(* topologyOfSubbaseMixin D b == builds the mixin for a topological *) +(* used to declare a filterType. *) +(* filterI_iter F n == nth stage of recursively building the *) +(* filter of finite intersections of F *) +(* finI_from D f == set of \bigcap_(i in E) f i where E is *) +(* a finite subset of D *) +(* topologyOfSubbaseMixin D b == topology defined by a subbase of open *) +(* sets *) +(* It builds the mixin for a topological *) (* space from a subbase of open sets b *) (* indexed on domain D; the type of *) (* indices must be a pointedType. *) -(* TopologicalType T m == packs the mixin m to build a *) -(* topologicalType; T must have a *) -(* canonical structure of filteredType T. *) -(* weak_topologicalType f == weak topology by f : S -> T on S; S *) -(* must be a pointedType and T a *) +(* *) +(* We endow several standard types with the structure of topology, e.g.: *) +(* - products: prod_topologicalType *) +(* - matrices: matrix_topologicalType *) +(* - natural numbers: nat_topologicalType *) +(* *) +(* weak_topologicalType f == weak topology by a function f : S -> T *) +(* on S *) +(* S must be a pointedType and T a *) (* topologicalType. *) (* sup_topologicalType Tc == supremum topology of the family of *) -(* topologicalType structures Tc on T; T *) -(* must be a pointedType. *) +(* topologicalType structures Tc on T *) +(* T must be a pointedType. *) (* product_topologicalType T == product topology of the family of *) (* topologicalTypes T. *) -(* [topologicalType of T for cT] == T-clone of the topologicalType *) -(* structure cT. *) -(* [topologicalType of T] == clone of a canonical structure of *) -(* topologicalType on T. *) -(* open == set of open sets. *) -(* open_nbhs p == set of open neighbourhoods of p. *) -(* continuous f <-> f is continuous w.r.t the topology. *) +(* quotient_topology Q == the quotient topology corresponding to *) +(* quotient Q : quotType T. where T has *) +(* type topologicalType *) (* x^' == set of neighbourhoods of x where x is *) -(* excluded (a "deleted neighborhood"). *) +(* excluded (a "deleted neighborhood") *) (* closure A == closure of the set A. *) (* limit_point E == the set of limit points of E *) (* closed == set of closed sets. *) -(* cluster F == set of cluster points of F. *) +(* cluster F == set of cluster points of F *) (* compact == set of compact sets w.r.t. the filter- *) -(* based definition of compactness. *) +(* based definition of compactness *) +(* hausdorff_space T <-> T is a Hausdorff space (T2) *) (* compact_near F == the filter F contains a closed comapct *) (* set *) -(* precompact A == The set A is contained in a closed and *) +(* precompact A == the set A is contained in a closed and *) (* compact set *) (* locally_compact A == every point in A has a compact *) (* (and closed) neighborhood *) -(* hausdorff_space T <-> T is a Hausdorff space (T_2). *) (* discrete_space T <-> every nbhs is a principal filter *) +(* discrete_topology dscT == the discrete topology on T, provided *) +(* dscT : discrete space T *) +(* finite_subset_cover D F A == the family of sets F is a cover of A *) +(* for a finite number of indices in D *) (* cover_compact == set of compact sets w.r.t. the open *) -(* cover-based definition of compactness. *) +(* cover-based definition of compactness *) (* near_covering == a reformulation of covering compact *) (* better suited for use with `near` *) +(* near_covering_within == equivalent definition of near_covering *) +(* kolmogorov_space T <-> T is a Kolmogorov space (T0) *) +(* accessible_space T <-> T is an accessible space (T1) *) +(* close x y <-> x and y are arbitrarily close w.r.t. *) +(* to balls *) (* connected A <-> the only non empty subset of A which *) -(* is both open and closed in A is A. *) -(* kolmogorov_space T <-> T is a Kolmogorov space (T_0). *) -(* accessible_space T <-> T is an accessible space (T_1). *) +(* is both open and closed in A is A *) (* separated A B == the two sets A and B are separated *) -(* component x == the connected component of point x *) +(* connected_component x == the connected component of point x *) (* perfect_set A == A is closed, and is every point in A *) -(* is a limit point of A. *) -(* [locally P] := forall a, A a -> G (within A (nbhs x)) *) -(* if P is convertible to G (globally A) *) +(* is a limit point of A *) +(* totally_disconnected A == the only connected subsets of A are *) +(* empty or singletons *) +(* zero_dimensional T == points are separable by a clopen set *) +(* set_nbhs A == filter from open sets containing A *) +(* ``` *) (* *) -(* * Function space topologies : *) -(* {uniform` A -> V} == The space U -> V, equipped with the topology of *) -(* uniform convergence from a set A to V, where *) -(* V is a uniformType. *) -(* {uniform U -> V} := {uniform` @setT U -> V} *) -(* {uniform A, F --> f} == F converges to f in {uniform A -> V}. *) -(* {uniform, F --> f} := {uniform setT, F --> f} *) -(* {ptws U -> V} == The space U -> V, equipped with the topology of *) -(* pointwise convergence from U to V, where V is a *) -(* topologicalType. *) -(* {ptws, F --> f} == F converges to f in {ptws U -> V}. *) -(* {family fam, U -> V} == The space U -> V, equipped with the supremum *) -(* topology of {uniform A -> f} for each A in 'fam' *) -(* In particular {family compact, U -> V} is the *) -(* topology of compact convergence. *) -(* {family fam, F --> f} == F converges to f in {family fam, U -> V}. *) +(* We used these topological notions to prove Tychonoff's Theorem, which *) +(* states that any product of compact sets is compact according to the *) +(* product topology. *) (* *) -(* --> We used these topological notions to prove Tychonoff's Theorem, which *) -(* states that any product of compact sets is compact according to the *) -(* product topology. *) -(* * Uniform spaces : *) +(* ### Uniform spaces *) +(* ``` *) (* nbhs_ ent == neighbourhoods defined using entourages *) (* uniformType == interface type for uniform spaces: a *) (* type equipped with entourages *) @@ -273,93 +346,165 @@ Require Import reals signed. (* split_ent E == when E is an entourage, split_ent E is *) (* an entourage E' such that E' \o E' is *) (* included in E when seen as a relation *) -(* unif_continuous f <-> f is uniformly continuous. *) +(* countable_uniformity T == T's entourage has a countable base *) +(* This is equivalent to `T` being *) +(* metrizable. *) +(* unif_continuous f <-> f is uniformly continuous *) +(* entourage_ ball == entourages defined using balls *) (* weak_uniformType == the uniform space for weak topologies *) (* sup_uniformType == the uniform space for sup topologies *) +(* discrete_ent == entourages for the discrete topology *) +(* ``` *) +(* *) +(* We endow several standard types with the structure of uniform space, e.g.: *) +(* - products: prod_uniformType *) +(* - matrices: matrix_uniformType *) (* *) -(* * PseudoMetric spaces : *) +(* ### PseudoMetric spaces *) +(* ``` *) (* entourage_ ball == entourages defined using balls *) (* pseudoMetricType == interface type for pseudo metric space *) -(* structure: a type equipped with balls. *) +(* structure: a type equipped with balls *) (* PseudoMetricMixin brefl bsym btriangle nbhsb == builds the mixin for a *) (* pseudo metric space from the properties *) (* of balls and the compatibility between *) -(* balls and entourages. *) +(* balls and entourages *) (* PseudoMetricType T m == packs the pseudo metric space mixin into *) -(* a pseudoMetricType. T must have a *) -(* canonical structure of uniformType. *) +(* a pseudoMetricType *) +(* T must have a canonical structure of *) +(* uniformType. *) (* [pseudoMetricType R of T for cT] == T-clone of the pseudoMetricType *) -(* structure cT, with R the ball radius. *) +(* structure cT, with R the ball radius *) (* [pseudoMetricType R of T] == clone of a canonical structure of *) (* pseudoMetricType on T, with R the ball *) -(* radius. *) +(* radius *) (* uniformityOfBallMixin umixin == builds the mixin for a topological space *) (* from a mixin for a pseudoMetric space. *) (* ball x e == ball of center x and radius e. *) (* nbhs_ball_ ball == nbhs defined using the given balls *) (* nbhs_ball == nbhs defined using balls in a *) (* pseudometric space *) -(* close x y <-> x and y are arbitrarily close w.r.t. to *) -(* balls. *) -(* weak_pseudoMetricType == the metric space for weak topologies *) +(* discrete_ball == singleton balls for the discrete *) +(* topology *) +(* ``` *) (* *) -(* * Complete uniform spaces : *) +(* We endow several standard types with the structure of pseudometric space, *) +(* e.g.: *) +(* - products: prod_pseudoMetricType *) +(* - matrices: matrix_pseudoMetricType *) +(* - weak_pseudoMetricType (the metric space for weak topologies) *) +(* - sup_pseudoMetricType *) +(* - product_pseudoMetricType *) +(* *) +(* ### Complete uniform spaces *) +(* ``` *) (* cauchy F <-> the set of sets F is a cauchy filter *) (* (entourage definition) *) (* completeType == interface type for a complete uniform *) -(* space structure. *) +(* space structure *) (* CompleteType T cvgCauchy == packs the proof that every proper cauchy *) (* filter on T converges into a *) -(* completeType structure; T must have a *) -(* canonical structure of uniformType. *) +(* completeType structure *) +(* T must have a canonical structure of *) +(* uniformType. *) (* [completeType of T for cT] == T-clone of the completeType structure *) -(* cT. *) +(* cT *) (* [completeType of T] == clone of a canonical structure of *) -(* completeType on T. *) +(* completeType on T *) +(* ``` *) +(* *) +(* We endow several standard types with the structure of complete uniform *) +(* space, e.g.: *) +(* - matrices: matrix_completeType *) +(* - functions: fun_completeType *) (* *) -(* * Complete pseudometric spaces : *) +(* ### Complete pseudometric spaces *) +(* ``` *) (* cauchy_ex F <-> the set of sets F is a cauchy filter *) -(* (epsilon-delta definition). *) -(* cauchy F <-> the set of sets F is a cauchy filter *) -(* (using the near notations). *) +(* (epsilon-delta definition) *) +(* cauchy_ball F <-> the set of sets F is a cauchy filter *) +(* (using the near notations) *) (* completePseudoMetricType == interface type for a complete *) -(* pseudometric space structure. *) +(* pseudometric space structure *) (* CompletePseudoMetricType T cvgCauchy == packs the proof that every proper *) (* cauchy filter on T converges into a *) -(* completePseudoMetricType structure; T *) -(* must have a canonical structure of *) +(* completePseudoMetricType structure *) +(* T must have a canonical structure of *) (* pseudoMetricType. *) (* [completePseudoMetricType of T for cT] == T-clone of the *) (* completePseudoMetricType structure cT. *) (* [completePseudoMetricType of T] == clone of a canonical structure of *) (* completePseudoMetricType on T. *) -(* *) (* ball_ N == balls defined by the norm/absolute *) (* value N *) -(* dense S == the set (S : set T) is dense in T, with *) -(* T of type topologicalType *) +(* ``` *) +(* *) +(* We endow several standard types with the structure of complete *) +(* pseudometric space, e.g.: *) +(* - matrices: matrix_completePseudoMetricType *) +(* - functions: fct_completePseudoMetricType *) +(* *) +(* We endow numFieldType with the types of topological notions *) +(* (accessible with "Import numFieldTopology.Exports."): *) +(* - numField_filteredType *) +(* - numField_topologicalType *) +(* - numField_uniformType *) +(* - numField_pseudoMetricType *) (* *) -(* * Subspaces of topological spaces : *) -(* subspace A == for (A : set T), this is a copy of T with *) -(* a topology that ignores points outside A *) -(* incl_subspace x == with x of type subspace A with (A : set T), *) -(* inclusion of subspace A into T *) +(* ### Function space topologies *) +(* ``` *) +(* {uniform` A -> V} == the space U -> V, equipped with the topology *) +(* of uniform convergence from a set A to V, where *) +(* V is a uniformType *) +(* {uniform U -> V} := {uniform` [set: U] -> V} *) +(* {uniform A, F --> f} == F converges to f in {uniform A -> V} *) +(* {uniform, F --> f} := {uniform setT, F --> f} *) +(* {ptws U -> V} == the space U -> V, equipped with the topology of *) +(* pointwise convergence from U to V, where V is *) +(* a topologicalType *) +(* This is a notation for @fct_Pointwise U V. *) +(* {ptws, F --> f} == F converges to f in {ptws U -> V} *) +(* {family fam, U -> V} == the space U -> V, equipped with the supremum *) +(* topology of {uniform A -> f} for each A in *) +(* 'fam' *) +(* In particular {family compact, U -> V} is the *) +(* topology of compact convergence. *) +(* {family fam, F --> f} == F converges to f in {family fam, U -> V} *) +(* {compact_open, U -> V} == compact-open topology *) +(* {compact_open, F --> f} == F converges to f in {compact_open, U -> V} *) (* *) -(* * Arzela Ascoli' theorem : *) -(* singletons T := [set [set x] | x in [set: T]]. *) +(* dense S == the set (S : set T) is dense in T, with T of *) +(* type topologicalType *) +(* weak_pseudoMetricType == the metric space for weak topologies *) +(* ``` *) +(* *) +(* ### Subspaces of topological spaces *) +(* ``` *) +(* subspace A == for (A : set T), this is a copy of T with a *) +(* topology that ignores points outside A *) +(* incl_subspace x == with x of type subspace A with (A : set T), *) +(* inclusion of subspace A into T *) +(* separate_points_from_closed f == for a closed set U and point x outside *) +(* some member of the family f, it sends f_i(x) *) +(* outside (closure (f_i @` U)) *) +(* Used together with join_product. *) +(* join_product f == the function (x => f ^~ x) *) +(* When the family f separates points from closed *) +(* sets, join_product is an embedding. *) +(* singletons T := [set [set x] | x in [set: T]] *) +(* gauge E == for an entourage E, gauge E is a filter which *) +(* includes `iter n split_ent E` *) +(* Critically, `gauge E` forms a uniform space *) +(* with a countable uniformity. *) +(* gauge_pseudoMetricType E == the pseudoMetricType associated with the *) +(* `gauge E` *) +(* normal_space X == X is normal (sometimes called T4) *) +(* regular_space X == X is regular (sometimes called T3) *) (* equicontinuous W x == the set (W : X -> Y) is equicontinuous at x *) -(* pointwise_precompact W == For each (x : X), set of images [f x | f in W] *) -(* is precompact *) +(* pointwise_precompact W == for each (x : X), the set of images *) +(* [f x | f in W] is precompact *) +(* ``` *) (* *) -(* We endow several standard types with the types of topological notions: *) -(* - products: prod_topologicalType, prod_uniformType, prod_pseudoMetricType *) -(* - matrices: matrix_filtered, matrix_topologicalType, matrix_uniformType, *) -(* matrix_pseudoMetricType, matrix_completeType, *) -(* matrix_completePseudoMetricType *) -(* - nat: nat_filteredType, nat_topologicalType *) -(* - numFieldType: numField_filteredType, numField_topologicalType, *) -(* numField_uniformType, numField_pseudoMetricType (accessible with *) -(* "Import numFieldTopology.Exports.") *) (******************************************************************************) Reserved Notation "{ 'near' x , P }" (at level 0, format "{ 'near' x , P }"). @@ -388,6 +533,8 @@ Reserved Notation "[ 'cvg' F 'in' T ]" (format "[ 'cvg' F 'in' T ]"). Reserved Notation "x \is_near F" (at level 10, format "x \is_near F"). Reserved Notation "E @[ x --> F ]" (at level 60, x name, format "E @[ x --> F ]"). +Reserved Notation "E @[ x \oo ]" + (at level 60, x name, format "E @[ x \oo ]"). Reserved Notation "f @ F" (at level 60, format "f @ F"). Reserved Notation "E `@[ x --> F ]" (at level 60, x name, format "E `@[ x --> F ]"). @@ -415,6 +562,10 @@ Reserved Notation "{ 'family' fam , U -> V }" (at level 0, U at level 69, format "{ 'family' fam , U -> V }"). Reserved Notation "{ 'family' fam , F --> f }" (at level 0, F at level 69, format "{ 'family' fam , F --> f }"). +Reserved Notation "{ 'compact-open' , U -> V }" + (at level 0, U at level 69, format "{ 'compact-open' , U -> V }"). +Reserved Notation "{ 'compact-open' , F --> f }" + (at level 0, F at level 69, format "{ 'compact-open' , F --> f }"). Set Implicit Arguments. Unset Strict Implicit. @@ -476,9 +627,6 @@ Qed. End bigmaxmin. -Definition monotonous d (T : porderType d) (pT : predType T) (A : pT) (f : T -> T) := - {in A &, {mono f : x y / (x <= y)%O}} \/ {in A &, {mono f : x y /~ (x <= y)%O}}. - Lemma and_prop_in (T : Type) (p : mem_pred T) (P Q : T -> Prop) : {in p, forall x, P x /\ Q x} <-> {in p, forall x, P x} /\ {in p, forall x, Q x}. @@ -505,101 +653,61 @@ Qed. Section Linear1. Context (R : ringType) (U : lmodType R) (V : zmodType) (s : R -> V -> V). -Canonical linear_eqType := EqType {linear U -> V | s} gen_eqMixin. -Canonical linear_choiceType := ChoiceType {linear U -> V | s} gen_choiceMixin. +HB.instance Definition _ := gen_eqMixin {linear U -> V | s}. +HB.instance Definition _ := gen_choiceMixin {linear U -> V | s}. End Linear1. Section Linear2. -Context (R : ringType) (U : lmodType R) (V : zmodType) (s : R -> V -> V) - (s_law : GRing.Scale.law s). -Canonical linear_pointedType := PointedType {linear U -> V | GRing.Scale.op s_law} - (@GRing.null_fun_linear R U V s s_law). +Context (R : ringType) (U : lmodType R) (V : zmodType) (s : GRing.Scale.law R V). +HB.instance Definition _ := + isPointed.Build {linear U -> V | GRing.Scale.Law.sort s} \0. End Linear2. -Module Filtered. +Definition set_system U := set (set U). +Identity Coercion set_system_to_set : set_system >-> set. -(* Index a family of filters on a type, one for each element of the type *) -Definition nbhs_of U T := T -> set (set U). -Record class_of U T := Class { - base : Pointed.class_of T; - nbhs_op : nbhs_of U T +HB.mixin Record isFiltered U T := { + nbhs : T -> set_system U }. -Section ClassDef. -Variable U : Type. - -Structure type := Pack { sort; _ : class_of U sort }. -Local Coercion sort : type >-> Sortclass. -Variables (T : Type) (cT : type). -Definition class := let: Pack _ c := cT return class_of U cT in c. - -Definition clone c of phant_id class c := @Pack T c. -Let xT := let: Pack T _ := cT in T. -Notation xclass := (class : class_of U xT). -Local Coercion base : class_of >-> Pointed.class_of. +#[short(type="filteredType")] +HB.structure Definition Filtered (U : Type) := {T of Pointed T & isFiltered U T}. +Arguments nbhs {_ _} _ _ : simpl never. -Definition pack m := - fun bT b of phant_id (Pointed.class bT) b => @Pack T (Class b m). - -Definition eqType := @Equality.Pack cT xclass. -Definition choiceType := @Choice.Pack cT xclass. -Definition fpointedType := @Pointed.Pack cT xclass. +Notation "[ 'filteredType' U 'of' T ]" := (Filtered.clone U T _) + (at level 0, format "[ 'filteredType' U 'of' T ]") : form_scope. -End ClassDef. +HB.instance Definition _ T := Equality.on (set_system T). +HB.instance Definition _ T := Choice.on (set_system T). +HB.instance Definition _ T := Pointed.on (set_system T). +HB.instance Definition _ T := isFiltered.Build T (set_system T) id. -(* filter on arrow sources *) -Structure source Z Y := Source { - source_type :> Type; - _ : (source_type -> Z) -> set (set Y) -}. -Definition source_filter Z Y (F : source Z Y) : (F -> Z) -> set (set Y) := - let: Source X f := F in f. - -Module Exports. -Coercion sort : type >-> Sortclass. -Coercion base : class_of >-> Pointed.class_of. -Coercion nbhs_op : class_of >-> nbhs_of. -Coercion eqType : type >-> Equality.type. -Canonical eqType. -Coercion choiceType : type >-> Choice.type. -Canonical choiceType. -Coercion fpointedType : type >-> Pointed.type. -Canonical fpointedType. -Notation filteredType := type. -Notation FilteredType U T m := (@pack U T m _ _ idfun). -Notation "[ 'filteredType' U 'of' T 'for' cT ]" := (@clone U T cT _ idfun) - (at level 0, format "[ 'filteredType' U 'of' T 'for' cT ]") : form_scope. -Notation "[ 'filteredType' U 'of' T ]" := (@clone U T _ _ id) - (at level 0, format "[ 'filteredType' U 'of' T ]") : form_scope. +Arguments nbhs {_ _} _ _ : simpl never. -(* The default filter for an arbitrary element is the one obtained *) -(* from its type *) -Canonical default_arrow_filter Y (Z : pointedType) (X : source Z Y) := - FilteredType Y (X -> Z) (@source_filter _ _ X). -Canonical source_filter_filter Y := - @Source Prop _ (_ -> Prop) (fun x : (set (set Y)) => x). -Canonical source_filter_filter' Y := - @Source Prop _ (set _) (fun x : (set (set Y)) => x). +HB.mixin Record selfFiltered T := {}. -End Exports. -End Filtered. -Export Filtered.Exports. +HB.factory Record hasNbhs T := { nbhs : T -> set_system T }. +HB.builders Context T of hasNbhs T. + HB.instance Definition _ := isFiltered.Build T T nbhs. + HB.instance Definition _ := selfFiltered.Build T. +HB.end. -Definition nbhs {U} {T : filteredType U} : T -> set (set U) := - Filtered.nbhs_op (Filtered.class T). -Arguments nbhs {U T} _ _ : simpl never. +#[short(type="nbhsType")] +HB.structure Definition Nbhs := {T of Pointed T & hasNbhs T}. -Definition filter_from {I T : Type} (D : set I) (B : I -> set T) : set (set T) := - [set P | exists2 i, D i & B i `<=` P]. +Definition filter_from {I T : Type} (D : set I) (B : I -> set T) : + set_system T := [set P | exists2 i, D i & B i `<=` P]. (* the canonical filter on matrices on X is the product of the canonical filter on X *) -Canonical matrix_filtered m n X (Z : filteredType X) : filteredType 'M[X]_(m, n) := - FilteredType 'M[X]_(m, n) 'M[Z]_(m, n) (fun mx => filter_from +HB.instance Definition _ m n X (Z : filteredType X) := + isFiltered.Build 'M[X]_(m, n) 'M[Z]_(m, n) (fun mx => filter_from [set P | forall i j, nbhs (mx i j) (P i j)] (fun P => [set my : 'M[X]_(m, n) | forall i j, P i j (my i j)])). +HB.instance Definition _ m n (X : nbhsType) := selfFiltered.Build 'M[X]_(m, n). + Definition filter_prod {T U : Type} - (F : set (set T)) (G : set (set U)) : set (set (T * U)) := + (F : set_system T) (G : set_system U) : set_system (T * U) := filter_from (fun P => F P.1 /\ G P.2) (fun P => P.1 `*` P.2). Section Near. @@ -631,58 +739,62 @@ Notation "'\near' x & y , P" := (\forall x \near x & y \near y, P) : type_scope. Arguments prop_near1 : simpl never. Arguments prop_near2 : simpl never. -Lemma nearE {T} {F : set (set T)} (P : set T) : (\forall x \near F, P x) = F P. +Lemma nearE {T} {F : set_system T} (P : set T) : + (\forall x \near F, P x) = F P. Proof. by []. Qed. -Lemma eq_near {T} {F : set (set T)} (P Q : set T) : +Lemma eq_near {T} {F : set_system T} (P Q : set T) : (forall x, P x <-> Q x) -> (\forall x \near F, P x) = (\forall x \near F, Q x). Proof. by move=> /predeqP ->. Qed. -Definition filter_of X (fX : filteredType X) (x : fX) of phantom fX x := - nbhs x. -Notation "[ 'filter' 'of' x ]" := - (@filter_of _ _ _ (Phantom _ x)) : classical_set_scope. -Arguments filter_of _ _ _ _ _ /. - -Lemma filter_of_filterE {T : Type} (F : set (set T)) : [filter of F] = F. -Proof. by []. Qed. +(* Definition filter_of X (fX : filteredType X) (x : fX) of phantom fX x := *) +(* nbhs x. *) +(* Notation "[ 'filter' 'of' x ]" := *) +(* (@filter_of _ _ _ (Phantom _ x)) : classical_set_scope. *) +(* Arguments filter_of _ _ _ _ _ /. *) -Lemma nbhs_filterE {T : Type} (F : set (set T)) : nbhs F = F. +Lemma nbhs_filterE {T : Type} (F : set_system T) : nbhs F = F. Proof. by []. Qed. Module Export NbhsFilter. -Definition nbhs_simpl := (@filter_of_filterE, @nbhs_filterE). +Definition nbhs_simpl := (@nbhs_filterE). End NbhsFilter. -Definition cvg_to {T : Type} (F G : set (set T)) := G `<=` F. +Definition cvg_to {T : Type} (F G : set_system T) := G `<=` F. Notation "F `=>` G" := (cvg_to F G) : classical_set_scope. -Lemma cvg_refl T (F : set (set T)) : F `=>` F. +Lemma cvg_refl T (F : set_system T) : F `=>` F. Proof. exact. Qed. Arguments cvg_refl {T F}. #[global] Hint Resolve cvg_refl : core. -Lemma cvg_trans T (G F H : set (set T)) : +Lemma cvg_trans T (G F H : set_system T) : (F `=>` G) -> (G `=>` H) -> (F `=>` H). Proof. by move=> FG GH P /GH /FG. Qed. -Notation "F --> G" := (cvg_to [filter of F] [filter of G]) : classical_set_scope. -Definition type_of_filter {T} (F : set (set T)) := T. +Notation "F --> G" := (cvg_to (nbhs F) (nbhs G)) : classical_set_scope. +Definition type_of_filter {T} (F : set_system T) := T. Definition lim_in {U : Type} (T : filteredType U) := - fun F : set (set U) => get (fun l : T => F --> l). -Notation "[ 'lim' F 'in' T ]" := (@lim_in _ T [filter of F]) : classical_set_scope. -Notation lim F := [lim F in [filteredType _ of @type_of_filter _ [filter of F]]]. + fun F : set_system U => get (fun l : T => F --> l). +Notation "[ 'lim' F 'in' T ]" := (@lim_in _ T (nbhs F)) : classical_set_scope. +Definition lim {T : nbhsType} (F : set_system T) := [lim F in T]. Notation "[ 'cvg' F 'in' T ]" := (F --> [lim F in T]) : classical_set_scope. -Notation cvg F := [cvg F in [filteredType _ of @type_of_filter _ [filter of F]]]. +Notation cvg F := (F --> lim F). + +(* :TODO: ultimately nat could be replaced by any lattice *) +Definition eventually := filter_from setT (fun N => [set n | (N <= n)%N]). +Notation "'\oo'" := eventually : classical_set_scope. Section FilteredTheory. -Canonical filtered_prod X1 X2 (Z1 : filteredType X1) - (Z2 : filteredType X2) : filteredType (X1 * X2) := - FilteredType (X1 * X2) (Z1 * Z2) +HB.instance Definition _ X1 X2 (Z1 : filteredType X1) (Z2 : filteredType X2) := + isFiltered.Build (X1 * X2)%type (Z1 * Z2)%type (fun x => filter_prod (nbhs x.1) (nbhs x.2)). +HB.instance Definition _ (X1 X2 : nbhsType) := + selfFiltered.Build (X1 * X2)%type. + Lemma cvg_prod T {U U' V V' : filteredType T} (x : U) (l : U') (y : V) (k : V') : x --> l -> y --> k -> (x, y) --> (l, k). Proof. @@ -690,29 +802,48 @@ move=> xl yk X [[X1 X2] /= [HX1 HX2] H]; exists (X1, X2) => //=. split; [exact: xl | exact: yk]. Qed. -Lemma cvg_ex {U : Type} (T : filteredType U) (F : set (set U)) : +Lemma cvg_in_ex {U : Type} (T : filteredType U) (F : set_system U) : [cvg F in T] <-> (exists l : T, F --> l). Proof. by split=> [cvg|/getPex//]; exists [lim F in T]. Qed. -Lemma cvgP {U : Type} (T : filteredType U) (F : set (set U)) (l : T) : +Lemma cvg_ex (T : nbhsType) (F : set_system T) : + cvg F <-> (exists l : T, F --> l). +Proof. exact: cvg_in_ex. Qed. + +Lemma cvg_inP {U : Type} (T : filteredType U) (F : set_system U) (l : T) : F --> l -> [cvg F in T]. -Proof. by move=> Fl; apply/cvg_ex; exists l. Qed. +Proof. by move=> Fl; apply/cvg_in_ex; exists l. Qed. + +Lemma cvgP (T : nbhsType) (F : set_system T) (l : T) : F --> l -> cvg F. +Proof. exact: cvg_inP. Qed. -Lemma cvg_toP {U : Type} (T : filteredType U) (F : set (set U)) (l : T) : +Lemma cvg_in_toP {U : Type} (T : filteredType U) (F : set_system U) (l : T) : [cvg F in T] -> [lim F in T] = l -> F --> l. Proof. by move=> /[swap]->. Qed. -Lemma dvgP {U : Type} (T : filteredType U) (F : set (set U)) : +Lemma cvg_toP (T : nbhsType) (F : set_system T) (l : T) : + cvg F -> lim F = l -> F --> l. +Proof. exact: cvg_in_toP. Qed. + +Lemma dvg_inP {U : Type} (T : filteredType U) (F : set_system U) : ~ [cvg F in T] -> [lim F in T] = point. Proof. by rewrite /lim_in /=; case xgetP. Qed. -Lemma cvgNpoint {U} (T : filteredType U) (F : set (set U)) : +Lemma dvgP (T : nbhsType) (F : set_system T) : ~ cvg F -> lim F = point. +Proof. exact: dvg_inP. Qed. + +Lemma cvg_inNpoint {U} (T : filteredType U) (F : set_system U) : [lim F in T] != point -> [cvg F in T]. -Proof. by apply: contra_neqP; apply: dvgP. Qed. +Proof. by apply: contra_neqP; apply: dvg_inP. Qed. + +Lemma cvgNpoint (T : nbhsType) (F : set_system T) : lim F != point -> cvg F. +Proof. exact: cvg_inNpoint. Qed. End FilteredTheory. -Arguments cvgP {U T F} l. -Arguments dvgP {U} T {F}. +Arguments cvg_inP {U T F} l. +Arguments dvg_inP {U} T {F}. +Arguments cvgP {T F} l. +Arguments dvgP {T F}. Lemma nbhs_nearE {U} {T : filteredType U} (x : T) (P : set U) : nbhs x P = \near x, P x. @@ -722,19 +853,19 @@ Lemma near_nbhs {U} {T : filteredType U} (x : T) (P : set U) : (\forall x \near nbhs x, P x) = \near x, P x. Proof. by []. Qed. -Lemma near2_curry {U V} (F : set (set U)) (G : set (set V)) (P : U -> set V) : +Lemma near2_curry {U V} (F : set_system U) (G : set_system V) (P : U -> set V) : {near F & G, forall x y, P x y} = {near (F, G), forall x, P x.1 x.2}. Proof. by []. Qed. -Lemma near2_pair {U V} (F : set (set U)) (G : set (set V)) (P : set (U * V)) : +Lemma near2_pair {U V} (F : set_system U) (G : set_system V) (P : set (U * V)) : {near F & G, forall x y, P (x, y)} = {near (F, G), forall x, P x}. Proof. by symmetry; congr (nbhs _); rewrite predeqE => -[]. Qed. Definition near2E := (@near2_curry, @near2_pair). Lemma filter_of_nearI (X : Type) (fX : filteredType X) - (x : fX) (ph : phantom fX x) : forall P, - @filter_of X fX x ph P = @prop_near1 X fX x P (inPhantom (forall x, P x)). + (x : fX) : forall P, + nbhs x P = @prop_near1 X fX x P (inPhantom (forall x, P x)). Proof. by []. Qed. Module Export NearNbhs. @@ -742,25 +873,23 @@ Definition near_simpl := (@near_nbhs, @nbhs_nearE, filter_of_nearI). Ltac near_simpl := rewrite ?near_simpl. End NearNbhs. -Lemma near_swap {U V} (F : set (set U)) (G : set (set V)) (P : U -> set V) : +Lemma near_swap {U V} (F : set_system U) (G : set_system V) (P : U -> set V) : (\forall x \near F & y \near G, P x y) = (\forall y \near G & x \near F, P x y). Proof. rewrite propeqE; split => -[[/=A B] [FA FB] ABP]; by exists (B, A) => // -[x y] [/=Bx Ay]; apply: (ABP (y, x)). Qed. -(** * Filters *) - -(** ** Definitions *) +(** Filters *) -Class Filter {T : Type} (F : set (set T)) := { +Class Filter {T : Type} (F : set_system T) := { filterT : F setT ; filterI : forall P Q : set T, F P -> F Q -> F (P `&` Q) ; filterS : forall P Q : set T, P `<=` Q -> F P -> F Q }. Global Hint Mode Filter - ! : typeclass_instances. -Class ProperFilter' {T : Type} (F : set (set T)) := { +Class ProperFilter' {T : Type} (F : set_system T) := { filter_not_empty : not (F (fun _ => False)) ; filter_filter' : Filter F }. @@ -772,10 +901,10 @@ Arguments filter_not_empty {T} F {_}. Notation ProperFilter := ProperFilter'. -Lemma filter_setT (T' : Type) : Filter (@setT (set T')). +Lemma filter_setT (T' : Type) : Filter [set: set T']. Proof. by constructor. Qed. -Lemma filterP_strong T (F : set (set T)) {FF : Filter F} (P : set T) : +Lemma filterP_strong T (F : set_system T) {FF : Filter F} (P : set T) : (exists Q : set T, exists FQ : F Q, forall x : T, Q x -> P x) <-> F P. Proof. split; last by exists P. @@ -783,7 +912,7 @@ by move=> [Q [FQ QP]]; apply: (filterS QP). Qed. Structure filter_on T := FilterType { - filter :> (T -> Prop) -> Prop; + filter :> set_system T; _ : Filter filter }. Definition filter_class T (F : filter_on T) : Filter F := @@ -810,13 +939,11 @@ Definition PFilterType {T} (F : (T -> Prop) -> Prop) PFilterPack F (Build_ProperFilter' fN0 fF). Arguments PFilterType {T} F {fF} fN0. -Canonical filter_on_eqType T := EqType (filter_on T) gen_eqMixin. -Canonical filter_on_choiceType T := - ChoiceType (filter_on T) gen_choiceMixin. -Canonical filter_on_PointedType T := - PointedType (filter_on T) (FilterType _ (filter_setT T)). -Canonical filter_on_FilteredType T := - FilteredType T (filter_on T) (@filter T). +HB.instance Definition _ T := gen_eqMixin (filter_on T). +HB.instance Definition _ T := gen_choiceMixin (filter_on T). +HB.instance Definition _ T := isPointed.Build (filter_on T) + (FilterType _ (filter_setT T)). +HB.instance Definition _ T := isFiltered.Build T (filter_on T) (@filter T). Global Instance filter_on_Filter T (F : filter_on T) : Filter F. Proof. by case: F. Qed. @@ -839,49 +966,49 @@ by move; rewrite eqEsubset; split => // ? _; apply/sQR; rewrite QT. Qed. Canonical trivial_filter_on. -Lemma filter_nbhsT {T : Type} (F : set (set T)) : +Lemma filter_nbhsT {T : Type} (F : set_system T) : Filter F -> nbhs F setT. Proof. by move=> FF; apply: filterT. Qed. #[global] Hint Resolve filter_nbhsT : core. -Lemma nearT {T : Type} (F : set (set T)) : Filter F -> \near F, True. +Lemma nearT {T : Type} (F : set_system T) : Filter F -> \near F, True. Proof. by move=> FF; apply: filterT. Qed. #[global] Hint Resolve nearT : core. -Lemma filter_not_empty_ex {T : Type} (F : set (set T)) : +Lemma filter_not_empty_ex {T : Type} (F : set_system T) : (forall P, F P -> exists x, P x) -> ~ F set0. Proof. by move=> /(_ set0) ex /ex []. Qed. -Definition Build_ProperFilter {T : Type} (F : set (set T)) +Definition Build_ProperFilter {T : Type} (F : set_system T) (filter_ex : forall P, F P -> exists x, P x) (filter_filter : Filter F) := Build_ProperFilter' (filter_not_empty_ex filter_ex) (filter_filter). -Lemma filter_ex_subproof {T : Type} (F : set (set T)) : +Lemma filter_ex_subproof {T : Type} (F : set_system T) : ~ F set0 -> (forall P, F P -> exists x, P x). Proof. move=> NFset0 P FP; apply: contra_notP NFset0 => nex; suff <- : P = set0 by []. by rewrite funeqE => x; rewrite propeqE; split=> // Px; apply: nex; exists x. Qed. -Definition filter_ex {T : Type} (F : set (set T)) {FF : ProperFilter F} := +Definition filter_ex {T : Type} (F : set_system T) {FF : ProperFilter F} := filter_ex_subproof (filter_not_empty F). Arguments filter_ex {T F FF _}. -Lemma filter_getP {T : pointedType} (F : set (set T)) {FF : ProperFilter F} +Lemma filter_getP {T : pointedType} (F : set_system T) {FF : ProperFilter F} (P : set T) : F P -> P (get P). Proof. by move=> /filter_ex /getPex. Qed. (* Near Tactic *) -Record in_filter T (F : set (set T)) := InFilter { +Record in_filter T (F : set_system T) := InFilter { prop_in_filter_proj : T -> Prop; prop_in_filterP_proj : F prop_in_filter_proj }. (* add ball x e as a canonical instance of nbhs x *) Module Type PropInFilterSig. -Axiom t : forall (T : Type) (F : set (set T)), in_filter F -> T -> Prop. +Axiom t : forall (T : Type) (F : set_system T), in_filter F -> T -> Prop. Axiom tE : t = prop_in_filter_proj. End PropInFilterSig. Module PropInFilter : PropInFilterSig. @@ -942,9 +1069,9 @@ Tactic Notation "near:" ident(x) := else fail "the goal depends on variables introduced after" x. Ltac under_near i tac := near=> i; tac; near: i. -Tactic Notation "near=>" ident(i) "do" tactic1(tac) := under_near i ltac:(tac). +Tactic Notation "near=>" ident(i) "do" tactic3(tac) := under_near i ltac:(tac). Tactic Notation "near=>" ident(i) "do" "[" tactic4(tac) "]" := near=> i do tac. -Tactic Notation "near" "do" tactic1(tac) := +Tactic Notation "near" "do" tactic3(tac) := let i := fresh "i" in under_near i ltac:(tac). Tactic Notation "near" "do" "[" tactic4(tac) "]" := near do tac. @@ -966,40 +1093,40 @@ Arguments have_near {U fT} x. Tactic Notation "near" constr(F) "=>" ident(x) := apply: (have_near F); near=> x. -Lemma near T (F : set (set T)) P (FP : F P) (x : T) +Lemma near T (F : set_system T) P (FP : F P) (x : T) (Px : prop_of (InFilter FP) x) : P x. Proof. by move: Px; rewrite prop_ofE. Qed. Arguments near {T F P} FP x Px. -Lemma nearW {T : Type} {F : set (set T)} (P : T -> Prop) : +Lemma nearW {T : Type} {F : set_system T} (P : T -> Prop) : Filter F -> (forall x, P x) -> (\forall x \near F, P x). Proof. by move=> FF FP; apply: filterS filterT. Qed. -Lemma filterE {T : Type} {F : set (set T)} : +Lemma filterE {T : Type} {F : set_system T} : Filter F -> forall P : set T, (forall x, P x) -> F P. Proof. by move=> [FT _ +] P fP => /(_ setT); apply. Qed. -Lemma filter_app (T : Type) (F : set (set T)) : +Lemma filter_app (T : Type) (F : set_system T) : Filter F -> forall P Q : set T, F (fun x => P x -> Q x) -> F P -> F Q. Proof. by move=> FF P Q subPQ FP; near=> x do suff: P x. Unshelve. all: by end_near. Qed. -Lemma filter_app2 (T : Type) (F : set (set T)) : +Lemma filter_app2 (T : Type) (F : set_system T) : Filter F -> forall P Q R : set T, F (fun x => P x -> Q x -> R x) -> F P -> F Q -> F R. Proof. by move=> ???? PQR FP; apply: filter_app; apply: filter_app FP. Qed. -Lemma filter_app3 (T : Type) (F : set (set T)) : +Lemma filter_app3 (T : Type) (F : set_system T) : Filter F -> forall P Q R S : set T, F (fun x => P x -> Q x -> R x -> S x) -> F P -> F Q -> F R -> F S. Proof. by move=> ????? PQR FP; apply: filter_app2; apply: filter_app FP. Qed. -Lemma filterS2 (T : Type) (F : set (set T)) : +Lemma filterS2 (T : Type) (F : set_system T) : Filter F -> forall P Q R : set T, (forall x, P x -> Q x -> R x) -> F P -> F Q -> F R. Proof. by move=> ? ? ? ? ?; apply: filter_app2; apply: filterE. Qed. -Lemma filterS3 (T : Type) (F : set (set T)) : +Lemma filterS3 (T : Type) (F : set_system T) : Filter F -> forall P Q R S : set T, (forall x, P x -> Q x -> R x -> S x) -> F P -> F Q -> F R -> F S. Proof. by move=> ? ? ? ? ? ?; apply: filter_app3; apply: filterE. Qed. @@ -1020,7 +1147,7 @@ move=> FF; split=> [H|[H1 H2]]; first by split; apply: filterS H => ? []. by apply: filterS2 H1 H2. Qed. -Lemma nearP_dep {T U} {F : set (set T)} {G : set (set U)} +Lemma nearP_dep {T U} {F : set_system T} {G : set_system U} {FF : Filter F} {FG : Filter G} (P : T -> U -> Prop) : (\forall x \near F & y \near G, P x y) -> \forall x \near F, \forall y \near G, P x y. @@ -1029,7 +1156,7 @@ move=> [[Q R] [/=FQ GR]] QRP. by apply: filterS FQ => x Q1x; apply: filterS GR => y Q2y; apply: (QRP (_, _)). Qed. -Lemma filter2P T U (F : set (set T)) (G : set (set U)) +Lemma filter2P T U (F : set_system T) (G : set_system U) {FF : Filter F} {FG : Filter G} (P : set (T * U)) : (exists2 Q : set T * set U, F Q.1 /\ G Q.2 & forall (x : T) (y : U), Q.1 x -> Q.2 y -> P (x, y)) @@ -1040,20 +1167,20 @@ split=> [][[A B] /=[FA GB] ABP]; exists (A, B) => //=. by move=> a b Aa Bb; apply: (ABP (_, _)). Qed. -Lemma filter_ex2 {T U : Type} (F : set (set T)) (G : set (set U)) +Lemma filter_ex2 {T U : Type} (F : set_system T) (G : set_system U) {FF : ProperFilter F} {FG : ProperFilter G} (P : set T) (Q : set U) : F P -> G Q -> exists x : T, exists2 y : U, P x & Q y. Proof. by move=> /filter_ex [x Px] /filter_ex [y Qy]; exists x, y. Qed. Arguments filter_ex2 {T U F G FF FG _ _}. -Lemma filter_fromP {I T : Type} (D : set I) (B : I -> set T) (F : set (set T)) : +Lemma filter_fromP {I T : Type} (D : set I) (B : I -> set T) (F : set_system T) : Filter F -> F `=>` filter_from D B <-> forall i, D i -> F (B i). Proof. split; first by move=> FB i ?; apply/FB/in_filter_from. by move=> FB P [i Di BjP]; apply: (filterS BjP); apply: FB. Qed. -Lemma filter_fromTP {I T : Type} (B : I -> set T) (F : set (set T)) : +Lemma filter_fromTP {I T : Type} (B : I -> set T) (F : set_system T) : Filter F -> F `=>` filter_from setT B <-> forall i, F (B i). Proof. by move=> FF; rewrite filter_fromP; split=> [P i|P i _]; apply: P. Qed. @@ -1087,9 +1214,9 @@ by have [x Bix] := BN0 _ Di; exists x; apply: BiP. Qed. Lemma filter_bigI T (I : choiceType) (D : {fset I}) (f : I -> set T) - (F : set (set T)) : + (F : set_system T) : Filter F -> (forall i, i \in D -> F (f i)) -> - F (\bigcap_(i in [set i | i \in D]) f i). + F (\bigcap_(i in [set` D]) f i). Proof. move=> FF FfD. suff: F [set p | forall i, i \in enum_fset D -> f i p] by []. @@ -1101,7 +1228,7 @@ apply: filterI; first by apply: FfD; rewrite inE eq_refl. by apply: ihs => j sj; apply: FfD; rewrite inE sj orbC. Qed. -Lemma filter_forall T (I : finType) (f : I -> set T) (F : set (set T)) : +Lemma filter_forall T (I : finType) (f : I -> set T) (F : set_system T) : Filter F -> (forall i : I, \forall x \near F, f i x) -> \forall x \near F, forall i, f i x. Proof. @@ -1110,37 +1237,43 @@ move=> FF fIF; apply: filterS (@filter_bigI T I [fset x in I]%fset f F FF _). by move=> i; rewrite inE/= => _; apply: (fIF i). Qed. -Lemma filter_imply [T : Type] [P : Prop] [f : set T] [F : set (set T)] : +Lemma filter_imply [T : Type] [P : Prop] [f : set T] [F : set_system T] : Filter F -> (P -> \near F, f F) -> \near F, P -> f F. Proof. move=> ? PF; near do move=> /asboolP. by case: asboolP=> [/PF|_]; by [apply: filterS|apply: nearW]. Unshelve. all: by end_near. Qed. -(** ** Limits expressed with filters *) +(** Limits expressed with filters *) -Definition fmap {T U : Type} (f : T -> U) (F : set (set T)) := +Definition fmap {T U : Type} (f : T -> U) (F : set_system T) : set_system U := [set P | F (f @^-1` P)]. Arguments fmap _ _ _ _ _ /. Lemma fmapE {U V : Type} (f : U -> V) - (F : set (set U)) (P : set V) : fmap f F P = F (f @^-1` P). + (F : set_system U) (P : set V) : fmap f F P = F (f @^-1` P). Proof. by []. Qed. Notation "E @[ x --> F ]" := - (fmap (fun x => E) [filter of F]) : classical_set_scope. -Notation "f @ F" := (fmap f [filter of F]) : classical_set_scope. -Global Instance fmap_filter T U (f : T -> U) (F : set (set T)) : + (fmap (fun x => E) (nbhs F)) : classical_set_scope. +Notation "E @[ x \oo ]" := + (fmap (fun x => E) \oo) : classical_set_scope. +Notation "f @ F" := (fmap f (nbhs F)) : classical_set_scope. + +Notation limn F := (lim (F @ \oo)). +Notation cvgn F := (cvg (F @ \oo)). + +Global Instance fmap_filter T U (f : T -> U) (F : set_system T) : Filter F -> Filter (f @ F). Proof. -move=> FF; constructor => [|P Q|P Q PQ]; rewrite ?fmapE ?filter_ofE //=. +move=> FF; constructor => [|P Q|P Q PQ]; rewrite ?fmapE //=. - exact: filterT. - exact: filterI. - by apply: filterS=> ?/PQ. Qed. (*Typeclasses Opaque fmap.*) -Global Instance fmap_proper_filter T U (f : T -> U) (F : set (set T)) : +Global Instance fmap_proper_filter T U (f : T -> U) (F : set_system T) : ProperFilter F -> ProperFilter (f @ F). Proof. move=> FF; apply: Build_ProperFilter'; @@ -1148,19 +1281,20 @@ by rewrite fmapE; apply: filter_not_empty. Qed. Definition fmap_proper_filter' := fmap_proper_filter. -Definition fmapi {T U : Type} (f : T -> set U) (F : set (set T)) := +Definition fmapi {T U : Type} (f : T -> set U) (F : set_system T) : + set_system _ := [set P | \forall x \near F, exists y, f x y /\ P y]. Notation "E `@[ x --> F ]" := - (fmapi (fun x => E) [filter of F]) : classical_set_scope. -Notation "f `@ F" := (fmapi f [filter of F]) : classical_set_scope. + (fmapi (fun x => E) (nbhs F)) : classical_set_scope. +Notation "f `@ F" := (fmapi f (nbhs F)) : classical_set_scope. Lemma fmapiE {U V : Type} (f : U -> set V) - (F : set (set U)) (P : set V) : + (F : set_system U) (P : set V) : fmapi f F P = \forall x \near F, exists y, f x y /\ P y. Proof. by []. Qed. -Global Instance fmapi_filter T U (f : T -> set U) (F : set (set T)) : +Global Instance fmapi_filter T U (f : T -> set U) (F : set_system T) : infer {near F, is_totalfun f} -> Filter F -> Filter (f `@ F). Proof. move=> f_totalfun FF; rewrite /fmapi; apply: Build_Filter. @@ -1177,7 +1311,7 @@ Unshelve. all: by end_near. Qed. #[global] Typeclasses Opaque fmapi. Global Instance fmapi_proper_filter - T U (f : T -> U -> Prop) (F : set (set T)) : + T U (f : T -> U -> Prop) (F : set_system T) : infer {near F, is_totalfun f} -> ProperFilter F -> ProperFilter (f `@ F). Proof. @@ -1186,7 +1320,7 @@ by move=> P; rewrite /fmapi/= => /filter_ex [x [y [??]]]; exists y. Qed. Definition filter_map_proper_filter' := fmapi_proper_filter. -Lemma cvg_id T (F : set (set T)) : x @[x --> F] --> F. +Lemma cvg_id T (F : set_system T) : x @[x --> F] --> F. Proof. exact. Qed. Arguments cvg_id {T F}. @@ -1194,49 +1328,53 @@ Lemma fmap_comp {A B C} (f : B -> C) (g : A -> B) F: Filter F -> (f \o g)%FUN @ F = f @ (g @ F). Proof. by []. Qed. -Lemma appfilter U V (f : U -> V) (F : set (set U)) : +Lemma appfilter U V (f : U -> V) (F : set_system U) : f @ F = [set P : set _ | \forall x \near F, P (f x)]. Proof. by []. Qed. -Lemma cvg_app U V (F G : set (set U)) (f : U -> V) : +Lemma cvg_app U V (F G : set_system U) (f : U -> V) : F --> G -> f @ F --> f @ G. Proof. by move=> FG P /=; exact: FG. Qed. Arguments cvg_app {U V F G} _. -Lemma cvgi_app U V (F G : set (set U)) (f : U -> set V) : +Lemma cvgi_app U V (F G : set_system U) (f : U -> set V) : F --> G -> f `@ F --> f `@ G. Proof. by move=> FG P /=; exact: FG. Qed. Lemma cvg_comp T U V (f : T -> U) (g : U -> V) - (F : set (set T)) (G : set (set U)) (H : set (set V)) : + (F : set_system T) (G : set_system U) (H : set_system V) : f @ F `=>` G -> g @ G `=>` H -> g \o f @ F `=>` H. Proof. by move=> fFG gGH; apply: cvg_trans gGH => P /fFG. Qed. Lemma cvgi_comp T U V (f : T -> U) (g : U -> set V) - (F : set (set T)) (G : set (set U)) (H : set (set V)) : + (F : set_system T) (G : set_system U) (H : set_system V) : f @ F `=>` G -> g `@ G `=>` H -> g \o f `@ F `=>` H. Proof. by move=> fFG gGH; apply: cvg_trans gGH => P /fFG. Qed. -Lemma near_eq_cvg {T U} {F : set (set T)} {FF : Filter F} (f g : T -> U) : +Lemma near_eq_cvg {T U} {F : set_system T} {FF : Filter F} (f g : T -> U) : {near F, f =1 g} -> g @ F `=>` f @ F. Proof. by move=> eq_fg P /=; apply: filterS2 eq_fg => x /= <-. Qed. -Lemma eq_cvg (T T' : Type) (F : set (set T)) (f g : T -> T') (x : set (set T')) : +Lemma eq_cvg (T T' : Type) (F : set_system T) (f g : T -> T') (x : set_system T') : f =1 g -> (f @ F --> x) = (g @ F --> x). Proof. by move=> /funext->. Qed. -Lemma eq_is_cvg (T T' : Type) (fT : filteredType T') (F : set (set T)) (f g : T -> T') : +Lemma eq_is_cvg_in (T T' : Type) (fT : filteredType T') (F : set_system T) (f g : T -> T') : f =1 g -> [cvg (f @ F) in fT] = [cvg (g @ F) in fT]. Proof. by move=> /funext->. Qed. -Lemma neari_eq_loc {T U} {F : set (set T)} {FF : Filter F} (f g : T -> set U) : +Lemma eq_is_cvg (T : Type) (T' : nbhsType) (F : set_system T) (f g : T -> T') : + f =1 g -> cvg (f @ F) = cvg (g @ F). +Proof. by move=> /funext->. Qed. + +Lemma neari_eq_loc {T U} {F : set_system T} {FF : Filter F} (f g : T -> set U) : {near F, f =2 g} -> g `@ F `=>` f `@ F. Proof. move=> eq_fg P /=; apply: filterS2 eq_fg => x eq_fg [y [fxy Py]]. by exists y; rewrite -eq_fg. Qed. -Lemma cvg_near_const (T U : Type) (f : T -> U) (F : set (set T)) (G : set (set U)) : +Lemma cvg_near_const (T U : Type) (f : T -> U) (F : set_system T) (G : set_system U) : Filter F -> ProperFilter G -> (\forall y \near G, \forall x \near F, f x = y) -> f @ F --> G. Proof. @@ -1246,10 +1384,12 @@ Unshelve. all: by end_near. Qed. (* globally filter *) -Definition globally {T : Type} (A : set T) : set (set T) := +Definition globally {T : Type} (A : set T) : set_system T := [set P : set T | forall x, A x -> P x]. Arguments globally {T} A _ /. +Lemma globally0 {T : Type} (A : set T) : globally set0 A. Proof. by []. Qed. + Global Instance globally_filter {T : Type} (A : set T) : Filter (globally A). Proof. @@ -1261,7 +1401,7 @@ Global Instance globally_properfilter {T : Type} (A : set T) a : infer (A a) -> ProperFilter (globally A). Proof. by move=> Aa; apply: Build_ProperFilter' => /(_ a). Qed. -(** ** Specific filters *) +(** Specific filters *) Section frechet_filter. Variable T : Type. @@ -1297,7 +1437,7 @@ End at_point. (** Filters for pairs *) -Global Instance filter_prod_filter T U (F : set (set T)) (G : set (set U)) : +Global Instance filter_prod_filter T U (F : set_system T) (G : set_system U) : Filter F -> Filter G -> Filter (filter_prod F G). Proof. move=> FF FG; apply: filter_from_filter. @@ -1320,14 +1460,14 @@ by have [[x ?] [y ?]] := (filter_ex FA, filter_ex GB); exists (x, y). Qed. Definition filter_prod_proper' := @filter_prod_proper. -Lemma filter_prod1 {T U} {F : set (set T)} {G : set (set U)} +Lemma filter_prod1 {T U} {F : set_system T} {G : set_system U} {FG : Filter G} (P : set T) : (\forall x \near F, P x) -> \forall x \near F & _ \near G, P x. Proof. move=> FP; exists (P, setT)=> //= [|[?? []//]]. by split=> //; apply: filterT. Qed. -Lemma filter_prod2 {T U} {F : set (set T)} {G : set (set U)} +Lemma filter_prod2 {T U} {F : set_system T} {G : set_system U} {FF : Filter F} (P : set U) : (\forall y \near G, P y) -> \forall _ \near F & y \near G, P y. Proof. @@ -1335,7 +1475,7 @@ move=> FP; exists (setT, P)=> //= [|[?? []//]]. by split=> //; apply: filterT. Qed. -Program Definition in_filter_prod {T U} {F : set (set T)} {G : set (set U)} +Program Definition in_filter_prod {T U} {F : set_system T} {G : set_system U} (P : in_filter F) (Q : in_filter G) : in_filter (filter_prod F G) := @InFilter _ _ (fun x => prop_of P x.1 /\ prop_of Q x.2) _. Next Obligation. @@ -1343,7 +1483,7 @@ move=> T U F G P Q. by exists (prop_of P, prop_of Q) => //=; split; apply: prop_ofP. Qed. -Lemma near_pair {T U} {F : set (set T)} {G : set (set U)} +Lemma near_pair {T U} {F : set_system T} {G : set_system U} {FF : Filter F} {FG : Filter G} (P : in_filter F) (Q : in_filter G) x : prop_of P x.1 -> prop_of Q x.2 -> prop_of (in_filter_prod P Q) x. @@ -1357,12 +1497,12 @@ Lemma cvg_snd {T U F G} {FF : Filter F} : (@snd T U) @ filter_prod F G --> G. Proof. by move=> P; apply: filter_prod2. Qed. -Lemma near_map {T U} (f : T -> U) (F : set (set T)) (P : set U) : +Lemma near_map {T U} (f : T -> U) (F : set_system T) (P : set U) : (\forall y \near f @ F, P y) = (\forall x \near F, P (f x)). Proof. by []. Qed. Lemma near_map2 {T T' U U'} (f : T -> U) (g : T' -> U') - (F : set (set T)) (G : set (set T')) (P : U -> set U') : + (F : set_system T) (G : set_system T') (P : U -> set U') : Filter F -> Filter G -> (\forall y \near f @ F & y' \near g @ G, P y y') = (\forall x \near F & x' \near G , P (f x) (g x')). @@ -1377,11 +1517,11 @@ rewrite !nbhs_simpl /fmap /=; split. by apply: filterS fGB => x Bx; exists x. Qed. -Lemma near_mapi {T U} (f : T -> set U) (F : set (set T)) (P : set U) : +Lemma near_mapi {T U} (f : T -> set U) (F : set_system T) (P : set U) : (\forall y \near f `@ F, P y) = (\forall x \near F, exists y, f x y /\ P y). Proof. by []. Qed. -Lemma filter_pair_set (T T' : Type) (F : set (set T)) (F' : set (set T')) : +Lemma filter_pair_set (T T' : Type) (F : set_system T) (F' : set_system T') : Filter F -> Filter F' -> forall (P : set T) (P' : set T') (Q : set (T * T')), (forall x x', P x -> P' x' -> Q (x, x')) -> F P /\ F' P' -> @@ -1392,7 +1532,7 @@ by move=> FF FF' P P' Q PQ [FP FP']; [apply: cvg_fst | apply: cvg_snd]. Unshelve. all: by end_near. Qed. -Lemma filter_pair_near_of (T T' : Type) (F : set (set T)) (F' : set (set T')) : +Lemma filter_pair_near_of (T T' : Type) (F : set_system T) (F' : set_system T') : Filter F -> Filter F' -> forall (P : @in_filter T F) (P' : @in_filter T' F') (Q : set (T * T')), (forall x x', prop_of P x -> prop_of P' x' -> Q (x, x')) -> @@ -1412,7 +1552,7 @@ Definition near_simpl := (@near_simpl, @near_map, @near_mapi, @near_map2). Ltac near_simpl := rewrite ?near_simpl. End NearMap. -Lemma cvg_pair {T U V F} {G : set (set U)} {H : set (set V)} +Lemma cvg_pair {T U V F} {G : set_system U} {H : set_system V} {FF : Filter F} {FG : Filter G} {FH : Filter H} (f : T -> U) (g : T -> V) : f @ F --> G -> g @ F --> H -> (f x, g x) @[x --> F] --> (G, H). @@ -1422,7 +1562,7 @@ by apply: (ABP (_, _)); split=> //=; near: x; [apply: fFG|apply: gFH]. Unshelve. all: by end_near. Qed. Lemma cvg_comp2 {T U V W} - {F : set (set T)} {G : set (set U)} {H : set (set V)} {I : set (set W)} + {F : set_system T} {G : set_system U} {H : set_system V} {I : set_system W} {FF : Filter F} {FG : Filter G} {FH : Filter H} (f : T -> U) (g : T -> V) (h : U -> V -> W) : f @ F --> G -> g @ F --> H -> @@ -1433,7 +1573,7 @@ Arguments cvg_comp2 {T U V W F G H I FF FG FH f g h} _ _ _. Definition cvg_to_comp_2 := @cvg_comp2. (* Lemma cvgi_comp_2 {T U V W} *) -(* {F : set (set T)} {G : set (set U)} {H : set (set V)} {I : set (set W)} *) +(* {F : set_system T} {G : set_system U} {H : set_system V} {I : set_system W} *) (* {FF : Filter F} *) (* (f : T -> U) (g : T -> V) (h : U -> V -> set W) : *) (* f @ F --> G -> g @ F --> H -> *) @@ -1450,9 +1590,9 @@ Definition cvg_to_comp_2 := @cvg_comp2. Section within. Context {T : Type}. -Implicit Types (D : set T) (F : set (set T)). +Implicit Types (D : set T) (F : set_system T). -Definition within D F (P : set T) := {near F, D `<=` P}. +Definition within D F : set_system T := [set P | {near F, D `<=` P}]. Arguments within : simpl never. Lemma near_withinE D F (P : set T) : @@ -1460,7 +1600,7 @@ Lemma near_withinE D F (P : set T) : Proof. by []. Qed. Lemma withinT F D : Filter F -> within D F D. -Proof. by move=> FF; rewrite /within; apply: filterE. Qed. +Proof. by move=> FF; rewrite /within/=; apply: filterE. Qed. Lemma near_withinT F D : Filter F -> \forall x \near within D F, D x. Proof. exact: withinT. Qed. @@ -1470,15 +1610,15 @@ Proof. by move=> P; apply: filterS. Qed. Lemma withinET {F} {FF : Filter F} : within setT F = F. Proof. -rewrite eqEsubset /within; split => ?; apply: filter_app; apply: nearW => //. -by move=> ?; exact. +rewrite eqEsubset /within; split => X //=; +by apply: filter_app => //=; apply: nearW => // x; apply. Qed. End within. Global Instance within_filter T D F : Filter F -> Filter (@within T D F). Proof. -move=> FF; rewrite /within; constructor. +move=> FF; rewrite /within; constructor => /=. - by apply: filterE. - by move=> P Q; apply: filterS2 => x DP DQ Dx; split; [apply: DP|apply: DQ]. - by move=> P Q subPQ; apply: filterS => x DP /DP /subPQ. @@ -1489,7 +1629,13 @@ Qed. Canonical within_filter_on T D (F : filter_on T) := FilterType (within D F) (within_filter _ _). -Definition subset_filter {T} (F : set (set T)) (D : set T) := +Lemma filter_bigI_within T (I : choiceType) (D : {fset I}) (f : I -> set T) + (F : set (set T)) (P : set T) : + Filter F -> (forall i, i \in D -> F [set j | P j -> f i j]) -> + F ([set j | P j -> (\bigcap_(i in [set` D]) f i) j]). +Proof. move=> FF FfD; exact: (@filter_bigI T I D f _ (within_filter P FF)). Qed. + +Definition subset_filter {T} (F : set_system T) (D : set T) := [set P : set {x | D x} | F [set x | forall Dx : D x, P (exist _ x Dx)]]. Arguments subset_filter {T} F D _. @@ -1513,11 +1659,10 @@ Qed. (* For using near on sets in a filter *) Section NearSet. +Context {Y : Type}. +Context (F : set_system Y) (PF : ProperFilter F). -Context {T : choiceType} {Y : filteredType T}. -Context (F : set (set Y)) (PF : ProperFilter F). - -Definition powerset_filter_from : set (set (set Y)) := filter_from +Definition powerset_filter_from : set_system (set Y) := filter_from [set M | [/\ M `<=` F, (forall E1 E2, M E1 -> F E2 -> E2 `<=` E1 -> M E2) & M !=set0 ] ] id. @@ -1531,14 +1676,14 @@ apply: filter_from_filter. by exists F; split => //; exists setT; exact: filterT. move=> M N /= [entM subM [M0 MM0]] [entN subN [N0 NN0]]. exists [set E | exists P Q, [/\ M P, N Q & E = P `&` Q] ]; first split. -- by move=> ? [? [? [? ? ->]]]; apply filterI; [exact: entM | exact: entN]. +- by move=> ? [? [? [? ? ->]]]; apply: filterI; [exact: entM | exact: entN]. - move=> ? E2 [P [Q [MP MQ ->]]] entE2 E2subPQ; exists E2, E2. split; last by rewrite setIid. + by apply: (subM _ _ MP) => // ? /E2subPQ []. + by apply: (subN _ _ MQ) => // ? /E2subPQ []. - by exists (M0 `&` N0), M0, N0. - move=> E /= [P [Q [MP MQ ->]]]; have entPQ : F (P `&` Q). - by apply filterI; [exact: entM | exact: entN]. + by apply: filterI; [exact: entM | exact: entN]. by split; [apply: (subM _ _ MP) | apply: (subN _ _ MQ)] => // ? []. Qed. @@ -1550,7 +1695,7 @@ Lemma small_set_sub (E : set Y) : F E -> Proof. move=> entE; exists [set E' | F E' /\ E' `<=` E]; last by move=> ? []. split; [by move=> E' [] | | by exists E; split]. -by move=> E1 E2 [] ? sub ? ?; split => //; exact: subset_trans sub. +by move=> E1 E2 [] ? subE ? ?; split => //; exact: subset_trans subE. Qed. Lemma near_powerset_filter_fromP (P : set Y -> Prop) : @@ -1564,11 +1709,54 @@ split=> [E [] //| |]; last by exists U; split. by move=> E1 E2 [F1 E1U F2 E2subE1]; split => //; exact: subset_trans E1U. Qed. +Lemma powerset_filter_fromP C : + F C -> powerset_filter_from [set W | F W /\ W `<=` C]. +Proof. +move=> FC; exists [set W | F W /\ W `<=` C] => //; split; first by move=> ? []. + by move=> A B [_ AC] FB /subset_trans/(_ AC). +by exists C; split. +Qed. + End NearSet. +Lemma near_powerset_map {T U : Type} (f : T -> U) (F : set_system T) + (P : set U -> Prop) : + ProperFilter F -> + (\forall y \near powerset_filter_from (f x @[x --> F]), P y) -> + (\forall y \near powerset_filter_from F, P (f @` y)). +Proof. +move=> FF [] G /= [Gf Gs [D GD GP]]. +have PpF : ProperFilter (powerset_filter_from F). + exact: powerset_filter_from_filter. +have /= := Gf _ GD; rewrite nbhs_simpl => FfD. +near=> M; apply: GP; apply: (Gs D) => //. + apply: filterS; first exact: preimage_image. + exact: (near (near_small_set _) M). +have : M `<=` f @^-1` D by exact: (near (small_set_sub FfD) M). +by move/image_subset/subset_trans; apply; exact: image_preimage_subset. +Unshelve. all: by end_near. Qed. + +Lemma near_powerset_map_monoE {T U : Type} (f : T -> U) (F : set_system T) + (P : set U -> Prop) : + (forall X Y, X `<=` Y -> P Y -> P X) -> + ProperFilter F -> + (\forall y \near powerset_filter_from F, P (f @` y)) = + (\forall y \near powerset_filter_from (f x @[x --> F]), P y). +Proof. +move=> Pmono FF; rewrite propeqE; split; last exact: near_powerset_map. +case=> G /= [Gf Gs [D GD GP]]. +have PpF : ProperFilter (powerset_filter_from (f x @[x-->F])). + exact: powerset_filter_from_filter. +have /= := Gf _ GD; rewrite nbhs_simpl => FfD; have ffiD : fmap f F (f@` D). + by rewrite /fmap /=; apply: filterS; first exact: preimage_image. +near=> M; have FfM : fmap f F M by exact: (near (near_small_set _) M). +apply: (@Pmono _ (f @` D)); first exact: (near (small_set_sub ffiD) M). +exact: GP. +Unshelve. all: by end_near. Qed. + Section PrincipalFilters. -Definition principal_filter {X : Type} (x : X) : set (set X) := +Definition principal_filter {X : Type} (x : X) : set_system X := globally [set x]. Lemma principal_filterP {X} (x : X) (W : set X) : principal_filter x W <-> W x. @@ -1577,89 +1765,36 @@ Proof. by split=> [|? ? ->]; [exact|]. Qed. Lemma principal_filter_proper {X} (x : X) : ProperFilter (principal_filter x). Proof. exact: globally_properfilter. Qed. -Canonical bool_discrete_filter := FilteredType bool bool principal_filter. +HB.instance Definition _ := hasNbhs.Build bool principal_filter. End PrincipalFilters. -(** * Topological spaces *) - -Module Topological. - -Record mixin_of (T : Type) (nbhs : T -> set (set T)) := Mixin { - open : set (set T) ; - ax1 : forall p : T, ProperFilter (nbhs p) ; - ax2 : forall p : T, nbhs p = - [set A : set T | exists B : set T, open B /\ B p /\ B `<=` A] ; - ax3 : open = [set A : set T | A `<=` nbhs^~ A ] +(** Topological spaces *) +HB.mixin Record Nbhs_isTopological (T : Type) of Nbhs T := { + open : set_system T; + nbhs_pfilter_subproof : forall p : T, ProperFilter (nbhs p) ; + nbhsE_subproof : forall p : T, nbhs p = + [set A : set T | exists B : set T, [/\ open B, B p & B `<=` A] ] ; + openE_subproof : open = [set A : set T | A `<=` nbhs^~ A ] }. -Record class_of (T : Type) := Class { - base : Filtered.class_of T T; - mixin : mixin_of (Filtered.nbhs_op base) -}. - -Section ClassDef. - -Structure type := Pack { sort; _ : class_of sort }. -Local Coercion sort : type >-> Sortclass. -Variables (T : Type) (cT : type). -Definition class := let: Pack _ c := cT return class_of cT in c. - -Definition clone c of phant_id class c := @Pack T c. -Let xT := let: Pack T _ := cT in T. -Notation xclass := (class : class_of xT). -Local Coercion base : class_of >-> Filtered.class_of. -Local Coercion mixin : class_of >-> mixin_of. - -Definition pack nbhs' (m : @mixin_of T nbhs') := - fun bT (b : Filtered.class_of T T) of phant_id (@Filtered.class T bT) b => - fun m' of phant_id m (m' : @mixin_of T (Filtered.nbhs_op b)) => - @Pack T (@Class _ b m'). - -Definition eqType := @Equality.Pack cT xclass. -Definition choiceType := @Choice.Pack cT xclass. -Definition pointedType := @Pointed.Pack cT xclass. -Definition filteredType := @Filtered.Pack cT cT xclass. - -End ClassDef. - -Module Exports. - -Coercion sort : type >-> Sortclass. -Coercion base : class_of >-> Filtered.class_of. -Coercion mixin : class_of >-> mixin_of. -Coercion eqType : type >-> Equality.type. -Canonical eqType. -Coercion choiceType : type >-> Choice.type. -Canonical choiceType. -Coercion pointedType : type >-> Pointed.type. -Canonical pointedType. -Coercion filteredType : type >-> Filtered.type. -Canonical filteredType. -Notation topologicalType := type. -Notation TopologicalType T m := (@pack T _ m _ _ idfun _ idfun). -Notation TopologicalMixin := Mixin. -Notation "[ 'topologicalType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) - (at level 0, format "[ 'topologicalType' 'of' T 'for' cT ]") : form_scope. -Notation "[ 'topologicalType' 'of' T ]" := (@clone T _ _ id) - (at level 0, format "[ 'topologicalType' 'of' T ]") : form_scope. - -End Exports. - -End Topological. - -Export Topological.Exports. +#[short(type="topologicalType")] +HB.structure Definition Topological := + {T of Nbhs T & Nbhs_isTopological T}. Section Topological1. Context {T : topologicalType}. -Definition open := Topological.open (Topological.class T). - Definition open_nbhs (p : T) (A : set T) := open A /\ A p. +Definition basis (B : set (set T)) := + B `<=` open /\ forall x, filter_from [set U | B U /\ U x] id --> x. + +Definition second_countable := exists2 B, countable B & basis B. + Global Instance nbhs_pfilter (p : T) : ProperFilter (nbhs p). -Proof. by apply: Topological.ax1; case: T p => ? []. Qed. +Proof. by apply: nbhs_pfilter_subproof; case: T p => ? []. Qed. Typeclasses Opaque nbhs. Lemma nbhs_filter (p : T) : Filter (nbhs p). @@ -1668,17 +1803,17 @@ Proof. exact: (@nbhs_pfilter). Qed. Canonical nbhs_filter_on (x : T) := FilterType (nbhs x) (@nbhs_filter x). Lemma nbhsE (p : T) : - nbhs p = [set A : set T | exists B : set T, open_nbhs p B /\ B `<=` A]. + nbhs p = [set A : set T | exists2 B : set T, open_nbhs p B & B `<=` A]. Proof. -have -> : nbhs p = [set A : set T | exists B, open B /\ B p /\ B `<=` A]. - exact: Topological.ax2. -by rewrite predeqE => A; split=> [[B [? []]]|[B [[]]]]; exists B. +have -> : nbhs p = [set A : set T | exists B, [/\ open B, B p & B `<=` A] ]. + exact: nbhsE_subproof. +by rewrite predeqE => A; split=> [[B [?]]|[B[]]]; exists B. Qed. Lemma open_nbhsE (p : T) (A : set T) : open_nbhs p A = (open A /\ nbhs p A). Proof. -rewrite nbhsE propeqE; split=> [[? ?]|[? [B [[? ?] BA]]]]; split => //; - [by exists A; split | exact: BA]. +by rewrite nbhsE propeqE; split=> [[? ?]|[? [B [? ?] BA]]]; split => //; + [exists A | exact: BA]. Qed. Definition interior (A : set T) := (@nbhs _ T)^~ A. @@ -1687,25 +1822,25 @@ Local Notation "A ^°" := (interior A). Lemma interior_subset (A : set T) : A^° `<=` A. Proof. -by move=> p; rewrite /interior nbhsE => -[? [[??]]]; apply. +by move=> p; rewrite /interior nbhsE => -[? [? ?]]; apply. Qed. Lemma openE : open = [set A : set T | A `<=` A^°]. -Proof. exact: Topological.ax3. Qed. +Proof. exact: openE_subproof. Qed. Lemma nbhs_singleton (p : T) (A : set T) : nbhs p A -> A p. -Proof. by rewrite nbhsE => - [? [[_ ?]]]; apply. Qed. +Proof. by rewrite nbhsE => - [? [_ ?]]; apply. Qed. Lemma nbhs_interior (p : T) (A : set T) : nbhs p A -> nbhs p A^°. Proof. -rewrite nbhsE /open_nbhs openE => - [B [[Bop Bp] sBA]]. -by exists B; split=> // q Bq; apply: filterS sBA _; apply: Bop. +rewrite nbhsE /open_nbhs openE => - [B [Bop Bp] sBA]. +by exists B => // q Bq; apply: filterS sBA _; apply: Bop. Qed. -Lemma open0 : open set0. +Lemma open0 : open (set0 : set T). Proof. by rewrite openE. Qed. -Lemma openT : open setT. +Lemma openT : open (setT : set T). Proof. by rewrite openE => ??; apply: filterT. Qed. Lemma openI (A B : set T) : open A -> open B -> open (A `&` B). @@ -1735,15 +1870,15 @@ Qed. Lemma open_interior (A : set T) : open A^°. Proof. -rewrite openE => p; rewrite /interior nbhsE => - [B [[Bop Bp]]]. +rewrite openE => p; rewrite /interior nbhsE => - [B [Bop Bp]]. by rewrite open_subsetE //; exists B. Qed. Lemma interior_bigcup I (D : set I) (f : I -> set T) : \bigcup_(i in D) (f i)^° `<=` (\bigcup_(i in D) f i)^°. Proof. -move=> p [i Di]; rewrite /interior nbhsE => - [B [[Bop Bp] sBfi]]. -by exists B; split=> // ? /sBfi; exists i. +move=> p [i Di]; rewrite /interior nbhsE => - [B [Bop Bp] sBfi]. +by exists B => // ? /sBfi; exists i. Qed. Lemma open_nbhsT (p : T) : open_nbhs p setT. @@ -1754,14 +1889,14 @@ Lemma open_nbhsI (p : T) (A B : set T) : Proof. by move=> [Aop Ap] [Bop Bp]; split; [apply: openI|split]. Qed. Lemma open_nbhs_nbhs (p : T) (A : set T) : open_nbhs p A -> nbhs p A. -Proof. by rewrite nbhsE => p_A; exists A; split. Qed. +Proof. by rewrite nbhsE => p_A; exists A. Qed. Lemma interiorI (A B:set T): (A `&` B)^° = A^° `&` B^°. Proof. -rewrite /interior predeqE => //= x; rewrite nbhsE; split => [[B0 [?]] | []]. +rewrite /interior predeqE => //= x; rewrite nbhsE; split => [[B0 ?] | []]. - by rewrite subsetI => // -[? ?]; split; exists B0. -- move=> -[B0 [? ?]] [B1 [? ?]]; exists (B0 `&` B1); split; - [exact: open_nbhsI | by rewrite subsetI; split; apply: subIset; [left|right]]. +- by move=> -[B0 ? ?] [B1 ? ?]; exists (B0 `&` B1); + [exact: open_nbhsI | rewrite subsetI; split; apply: subIset; [left|right]]. Qed. End Topological1. @@ -1773,9 +1908,11 @@ End Topological1. Notation "A ^°" := (interior A) : classical_set_scope. -Notation continuous f := (forall x, f%function @ x --> f%function x). +Definition continuous_at (T U : nbhsType) (x : T) (f : T -> U) := + (f%function @ x --> f%function x). +Notation continuous f := (forall x, continuous_at x f). -Lemma near_fun (T T' : topologicalType) (f : T -> T') (x : T) (P : T' -> Prop) : +Lemma near_fun (T T' : nbhsType) (f : T -> T') (x : T) (P : T' -> Prop) : {for x, continuous f} -> (\forall y \near f x, P y) -> (\near x, P (f x)). Proof. exact. Qed. @@ -1785,8 +1922,8 @@ Lemma continuousP (S T : topologicalType) (f : S -> T) : continuous f <-> forall A, open A -> open (f @^-1` A). Proof. split=> fcont; first by rewrite !openE => A Aop ? /Aop /fcont. -move=> s A; rewrite nbhs_simpl /= !nbhsE => - [B [[Bop Bfs] sBA]]. -by exists (f @^-1` B); split; [split=> //; apply/fcont|move=> ? /sBA]. +move=> s A; rewrite nbhs_simpl /= !nbhsE => - [B [Bop Bfs] sBA]. +by exists (f @^-1` B); [split=> //; apply/fcont|move=> ? /sBA]. Qed. Lemma continuous_comp (R S T : topologicalType) (f : R -> S) (g : S -> T) x : @@ -1802,7 +1939,7 @@ by apply: fcont; [rewrite inE|apply: Dop]. Qed. Lemma cvg_fmap {T: topologicalType} {U : topologicalType} - (F : set (set T)) x (f : T -> U) : + (F : set_system T) x (f : T -> U) : {for x, continuous f} -> F --> x -> f @ F --> f x. Proof. by move=> cf fx P /cf /fx. Qed. @@ -1820,7 +1957,7 @@ Unshelve. all: by end_near. Qed. (* limit composition *) Lemma continuous_cvg {T : Type} {V U : topologicalType} - (F : set (set T)) (FF : Filter F) + (F : set_system T) (FF : Filter F) (f : T -> V) (h : V -> U) (a : V) : {for a, continuous h} -> f @ F --> a -> (h \o f) @ F --> h a. @@ -1829,7 +1966,7 @@ move=> h_continuous fa fb; apply: (cvg_trans _ h_continuous). exact: (@cvg_comp _ _ _ _ h _ _ _ fa). Qed. -Lemma continuous_is_cvg {T : Type} {V U : topologicalType} [F : set (set T)] +Lemma continuous_is_cvg {T : Type} {V U : topologicalType} [F : set_system T] (FF : Filter F) (f : T -> V) (h : V -> U) : (forall l, f x @[x --> F] --> l -> {for l, continuous h}) -> cvg (f x @[x --> F]) -> cvg ((h \o f) x @[x --> F]). @@ -1839,7 +1976,7 @@ by apply: continuous_cvg => //; exact: ach. Qed. Lemma continuous2_cvg {T : Type} {V W U : topologicalType} - (F : set (set T)) (FF : Filter F) + (F : set_system T) (FF : Filter F) (f : T -> V) (g : T -> W) (h : V -> W -> U) (a : V) (b : W) : h z.1 z.2 @[z --> (a, b)] --> h a b -> f @ F --> a -> g @ F --> b -> (fun x => h (f x) (g x)) @ F --> h a b. @@ -1849,7 +1986,7 @@ exact: (@cvg_comp _ _ _ _ (fun x => h x.1 x.2) _ _ _ (cvg_pair fa fb)). Qed. Lemma cvg_near_cst (T : Type) (U : topologicalType) - (l : U) (f : T -> U) (F : set (set T)) {FF : Filter F} : + (l : U) (f : T -> U) (F : set_system T) {FF : Filter F} : (\forall x \near F, f x = l) -> f @ F --> l. Proof. move=> fFl P /=; rewrite !near_simpl => Pl. @@ -1858,7 +1995,7 @@ Qed. Arguments cvg_near_cst {T U} l {f F FF}. Lemma is_cvg_near_cst (T : Type) (U : topologicalType) - (l : U) (f : T -> U) (F : set (set T)) {FF : Filter F} : + (l : U) (f : T -> U) (F : set_system T) {FF : Filter F} : (\forall x \near F, f x = l) -> cvg (f @ F). Proof. by move=> /cvg_near_cst/cvgP. Qed. Arguments is_cvg_near_cst {T U} l {f F FF}. @@ -1873,14 +2010,14 @@ Qed. Arguments near_cst_continuous {T U} l [f x]. Lemma cvg_cst (U : topologicalType) (x : U) (T : Type) - (F : set (set T)) {FF : Filter F} : + (F : set_system T) {FF : Filter F} : (fun _ : T => x) @ F --> x. Proof. by apply: cvg_near_cst; near=> x0. Unshelve. all: by end_near. Qed. Arguments cvg_cst {U} x {T F FF}. #[global] Hint Resolve cvg_cst : core. Lemma is_cvg_cst (U : topologicalType) (x : U) (T : Type) - (F : set (set T)) {FF : Filter F} : + (F : set_system T) {FF : Filter F} : cvg ((fun _ : T => x) @ F). Proof. by apply: cvgP; apply: cvg_cst. Qed. Arguments is_cvg_cst {U} x {T F FF}. @@ -1898,12 +2035,12 @@ Implicit Types B : set T. (* to be combined with lemmas such as boundedP in normedtype.v *) Lemma within_nbhsW (x : T) : A x -> within A (nbhs x) `=>` globally A. Proof. -move=> Ax P AP; rewrite /within; near=> y; apply: AP. +move=> Ax P AP; rewrite /within/=; near=> y; apply: AP. Unshelve. all: by end_near. Qed. (* [locally P] replaces a (globally A) in P by a within A (nbhs x) *) (* Can be combined with a notation taking a filter as its last argument *) -Definition locally_of (P : set (set T) -> Prop) of phantom Prop (P (globally A)) +Definition locally_of (P : set_system T -> Prop) of phantom Prop (P (globally A)) := forall x, A x -> P (within A (nbhs x)). Local Notation "[ 'locally' P ]" := (@locally_of _ _ _ (Phantom _ P)). (* e.g. [locally [bounded f x | x in A]] *) @@ -1912,17 +2049,16 @@ Local Notation "[ 'locally' P ]" := (@locally_of _ _ _ (Phantom _ P)). Lemma within_interior (x : T) : A^° x -> within A (nbhs x) = nbhs x. Proof. move=> Aox; rewrite eqEsubset; split; last exact: cvg_within. -rewrite ?nbhsE => W /= => [[B [+ BsubW]]]. +rewrite ?nbhsE => W /= => [[B + BsubW]]. rewrite open_nbhsE => [[oB nbhsB]]. -exists (B `&` A^°); split; last first. - by move=> t /= [] /BsubW + /interior_subset; apply. +exists (B `&` A^°); last by move=> t /= [] /BsubW + /interior_subset; apply. rewrite open_nbhsE; split; first by apply: openI => //; exact: open_interior. by apply: filterI => //; move:(open_interior A); rewrite openE; exact. Qed. Lemma within_subset B F : Filter F -> A `<=` B -> within A F `=>` within B F. Proof. -move=> FF AsubB W; rewrite /within; apply: filter_app; rewrite nbhs_simpl. +move=> FF AsubB W; rewrite /within/=; apply: filter_app; rewrite nbhs_simpl. by apply: filterE => ? + ?; apply; exact: AsubB. Qed. @@ -1932,11 +2068,11 @@ Proof. move=> FF; rewrite eqEsubset; split=> U. move=> Wu; exists [set x | A x -> U x] => //. by rewrite eqEsubset; split => t [L R]; split=> //; apply: L. -move=> [V FV AU]; rewrite /within /prop_near1 nbhs_simpl; near=> w => Aw. +move=> [V FV AU]; rewrite /within /prop_near1 nbhs_simpl/=; near=> w => Aw. by have []// : (U `&` A) w; rewrite AU; split => //; apply: (near FV). Unshelve. all: by end_near. Qed. -Lemma fmap_within_eq {S : topologicalType} (F : set (set T)) (f g : T -> S) : +Lemma fmap_within_eq {S : topologicalType} (F : set_system T) (f g : T -> S) : Filter F -> {in A, f =1 g} -> f @ within A F --> g @ within A F. Proof. move=> FF feq U /=; near_simpl; apply: filter_app. @@ -1945,88 +2081,112 @@ exact: (near (withinT A FF) w). Unshelve. all: by end_near. Qed. End within_topologicalType. + Notation "[ 'locally' P ]" := (@locally_of _ _ _ (Phantom _ P)). -(** ** Topology defined by a filter *) +(** Topology defined by a filter *) -Section TopologyOfFilter. +(* was topologyOfFilterMixin *) +HB.factory Record Nbhs_isNbhsTopological T of Nbhs T := { + nbhs_filter : forall p : T, ProperFilter (nbhs p); + nbhs_singleton : forall (p : T) (A : set T), nbhs p A -> A p; + nbhs_nbhs : forall (p : T) (A : set T), nbhs p A -> nbhs p (nbhs^~ A); +}. -Context {T : Type} {nbhs' : T -> set (set T)}. -Hypothesis (nbhs'_filter : forall p : T, ProperFilter (nbhs' p)). -Hypothesis (nbhs'_singleton : forall (p : T) (A : set T), nbhs' p A -> A p). -Hypothesis (nbhs'_nbhs' : forall (p : T) (A : set T), nbhs' p A -> nbhs' p (nbhs'^~ A)). +HB.builders Context T of Nbhs_isNbhsTopological T. -Definition open_of_nbhs := [set A : set T | A `<=` nbhs'^~ A]. +Definition open_of_nbhs := [set A : set T | A `<=` nbhs^~ A]. -Program Definition topologyOfFilterMixin : Topological.mixin_of nbhs' := - @Topological.Mixin T nbhs' open_of_nbhs _ _ _. -Next Obligation. -move=> p; rewrite predeqE => A; split=> [p_A|]; last first. - by move=> [B [Bop [Bp sBA]]]; apply: filterS sBA _; apply: Bop. -exists (nbhs'^~ A); split; first by move=> ?; apply: nbhs'_nbhs'. -by split => // q /nbhs'_singleton. +Lemma nbhsE_subproof (p : T) : + nbhs p = [set A | exists B, [/\ open_of_nbhs B, B p & B `<=` A] ]. +Proof. +rewrite predeqE => A; split=> [p_A|]; last first. + move=> [B [Bop Bp sBA]]; apply: filterS sBA _; last exact: Bop. + exact/filter_filter'/nbhs_filter. +exists (nbhs^~ A); split=> //; first by move=> ?; apply: nbhs_nbhs. +by move=> q /nbhs_singleton. Qed. -Next Obligation. done. Qed. -End TopologyOfFilter. +Lemma openE_subproof : open_of_nbhs = [set A : set T | A `<=` nbhs^~ A]. +Proof. by []. Qed. -(** ** Topology defined by open sets *) +HB.instance Definition _ := Nbhs_isTopological.Build T + nbhs_filter nbhsE_subproof openE_subproof. -Section TopologyOfOpen. +HB.end. -Variable (T : Type) (op : set T -> Prop). -Hypothesis (opT : op setT). -Hypothesis (opI : forall (A B : set T), op A -> op B -> op (A `&` B)). -Hypothesis (op_bigU : forall (I : Type) (f : I -> set T), - (forall i, op (f i)) -> op (\bigcup_i f i)). +(** Topology defined by open sets *) -Definition nbhs_of_open (p : T) (A : set T) := - exists B, op B /\ B p /\ B `<=` A. +Definition nbhs_of_open (T : pointedType) (op : set T -> Prop) (p : T) (A : set T) := + exists B, [/\ op B, B p & B `<=` A]. -Program Definition topologyOfOpenMixin : Topological.mixin_of nbhs_of_open := - @Topological.Mixin T nbhs_of_open op _ _ _. -Next Obligation. -move=> p; apply: Build_ProperFilter. - by move=> A [B [_ [Bp sBA]]]; exists p; apply: sBA. -split; first by exists setT. - move=> A B [C [Cop [Cp sCA]]] [D [Dop [Dp sDB]]]. - exists (C `&` D); split; first exact: opI. - by split=> // q [/sCA Aq /sDB Bq]. -move=> A B sAB [C [Cop [p_C sCA]]]. -by exists C; split=> //; split=> //; apply: subset_trans sAB. -Qed. -Next Obligation. done. Qed. -Next Obligation. +(* was topologyOfOpenMixin *) +HB.factory Record Pointed_isOpenTopological T of Pointed T := { + op : set T -> Prop; + opT : op setT; + opI : forall (A B : set T), op A -> op B -> op (A `&` B); + op_bigU : forall (I : Type) (f : I -> set T), (forall i, op (f i)) -> + op (\bigcup_i f i); +}. + +HB.builders Context T of Pointed_isOpenTopological T. + +HB.instance Definition _ := hasNbhs.Build T (nbhs_of_open op). + +Lemma nbhs_pfilter_subproof (p : T) : ProperFilter (nbhs p). +Proof. +apply: Build_ProperFilter. + by move=> A [B [_ Bp sBA]]; exists p; apply: sBA. +split; first by exists setT; split=> [|//|//]; exact: opT. + move=> A B [C [Cop Cp sCA]] [D [Dop Dp sDB]]. + exists (C `&` D); split=> //; first exact: opI. + by move=> q [/sCA Aq /sDB Bq]. +move=> A B sAB [C [Cop p_C sCA]]. +by exists C; split=> //; apply: subset_trans sAB. +Qed. + +Lemma nbhsE_subproof (p : T) : + nbhs p = [set A | exists B, [/\ op B, B p & B `<=` A] ]. +Proof. by []. Qed. + +Lemma openE_subproof : op = [set A : set T | A `<=` nbhs^~ A]. +Proof. rewrite predeqE => A; split=> [Aop p Ap|Aop]. by exists A; split=> //; split. suff -> : A = \bigcup_(B : {B : set T & op B /\ B `<=` A}) projT1 B. by apply: op_bigU => B; have [] := projT2 B. rewrite predeqE => p; split=> [|[B _ Bp]]; last by have [_] := projT2 B; apply. -by move=> /Aop [B [Bop [Bp sBA]]]; exists (existT _ B (conj Bop sBA)). +by move=> /Aop [B [Bop Bp sBA]]; exists (existT _ B (conj Bop sBA)). Qed. -End TopologyOfOpen. +HB.instance Definition _ := Nbhs_isTopological.Build T + nbhs_pfilter_subproof nbhsE_subproof openE_subproof. -(** ** Topology defined by a base of open sets *) +HB.end. -Section TopologyOfBase. +(** Topology defined by a base of open sets *) -Definition open_from I T (D : set I) (b : I -> set T) := - [set \bigcup_(i in D') b i | D' in subset^~ D]. +(* was topologyOfBaseMixin *) +HB.factory Record Pointed_isBaseTopological T of Pointed T := { + I : pointedType; + D : set I; + b : I -> (set T); + b_cover : \bigcup_(i in D) b i = setT; + b_join : forall i j t, D i -> D j -> b i t -> b j t -> + exists k, [/\ D k, b k t & b k `<=` b i `&` b j]; +}. -Lemma open_fromT I T (D : set I) (b : I -> set T) : - \bigcup_(i in D) b i = setT -> open_from D b setT. -Proof. by move=> ?; exists D. Qed. +HB.builders Context T of Pointed_isBaseTopological T. -Variable (I : pointedType) (T : Type) (D : set I) (b : I -> (set T)). -Hypothesis (b_cover : \bigcup_(i in D) b i = setT). -Hypothesis (b_join : forall i j t, D i -> D j -> b i t -> b j t -> - exists k, [/\ D k, b k t & b k `<=` b i `&` b j]). +Definition open_from := [set \bigcup_(i in D') b i | D' in subset^~ D]. -Program Definition topologyOfBaseMixin := - @topologyOfOpenMixin _ (open_from D b) (open_fromT b_cover) _ _. -Next Obligation. -move=> A B [DA sDAD AeUbA] [DB sDBD BeUbB]. +Lemma open_fromT : open_from setT. +Proof. exists D => //; exact: b_cover. Qed. + +Lemma open_fromI (A B : set T) : open_from A -> open_from B -> + open_from (A `&` B). +Proof. +move=> [DA sDAD AeUbA] [DB sDBD BeUbB]. have ABU : forall t, (A `&` B) t -> exists it, D it /\ b it t /\ b it `<=` A `&` B. move=> t [At Bt]. @@ -2045,8 +2205,10 @@ rewrite predeqE => t; split=> [[_ [s ABs <-] bDtst]|ABt]. by have /ABU/getPex [_ [_]] := ABs; apply. by exists (get (Dt t)); [exists t| have /ABU/getPex [? []]:= ABt]. Qed. -Next Obligation. -move=> I0 f. + +Lemma open_from_bigU (I0 : Type) (f : I0 -> set T) : + (forall i, open_from (f i)) -> open_from (\bigcup_i f i). +Proof. set fop := fun j => [set Dj | Dj `<=` D /\ f j = \bigcup_(i in Dj) b i]. exists (\bigcup_j get (fop j)). move=> i [j _ fopji]. @@ -2059,28 +2221,72 @@ have /getPex [_ ->] : exists Dj, fop j Dj by have [Dj] := H j; exists Dj. by move=> [i]; exists i => //; exists j. Qed. -End TopologyOfBase. +HB.instance Definition _ := Pointed_isOpenTopological.Build T + open_fromT open_fromI open_from_bigU. + +HB.end. + +Section filter_supremums. + +Global Instance smallest_filter_filter {T : Type} (F : set (set T)) : + Filter (smallest Filter F). +Proof. +split. +- by move=> G [? _]; apply: filterT. +- by move=> ? ? sFP sFQ ? [? ?]; apply: filterI; [apply: sFP | apply: sFQ]. +- by move=> ? ? /filterS + sFP ? [? ?]; apply; apply: sFP. +Qed. + +Fixpoint filterI_iter {T : Type} (F : set (set T)) (n : nat) := + if n is m.+1 + then [set P `&` Q | + P in filterI_iter F m & Q in filterI_iter F m] + else setT |` F. -(** ** Topology defined by a subbase of open sets *) +Lemma filterI_iter_sub {T : Type} (F : set (set T)) : + {homo filterI_iter F : i j / (i <= j)%N >-> i `<=` j}. +Proof. +move=> + j; elim: j; first by move=> i; rewrite leqn0 => /eqP ->. +move=> j IH i; rewrite leq_eqVlt => /predU1P[->//|]. +by move=> /IH/subset_trans; apply=> A ?; do 2 exists A => //; rewrite setIid. +Qed. + +Lemma filterI_iterE {T : Type} (F : set (set T)) : + smallest Filter F = filter_from (\bigcup_n (filterI_iter F n)) id. +Proof. +rewrite eqEsubset; split. + apply: smallest_sub => //; first last. + by move=> A FA; exists A => //; exists O => //; right. + apply: filter_from_filter; first by exists setT; exists O => //; left. + move=> P Q [i _ sFP] [j _ sFQ]; exists (P `&` Q) => //. + exists (maxn i j).+1 => //=; exists P. + by apply: filterI_iter_sub; first exact: leq_maxl. + by exists Q => //; apply: filterI_iter_sub; first exact: leq_maxr. +move=> + [+ [n _]]; elim: n => [A B|n IH/= A B]. + move=> [-> /[!(@subTset T)] ->|]; first exact: filterT. + by move=> FB /filterS; apply; apply: sub_gen_smallest. +move=> [P sFP] [Q sFQ] PQB /filterS; apply; rewrite -PQB. +by apply: (filterI _ _); [exact: (IH _ _ sFP)|exact: (IH _ _ sFQ)]. +Qed. + +(** Topology defined by a subbase of open sets *) Definition finI_from (I : choiceType) T (D : set I) (f : I -> set T) := - [set \bigcap_(i in [set i | i \in D']) f i | + [set \bigcap_(i in [set` D']) f i | D' in [set A : {fset I} | {subset A <= D}]]. Lemma finI_from_cover (I : choiceType) T (D : set I) (f : I -> set T) : \bigcup_(A in finI_from D f) A = setT. Proof. rewrite predeqE => t; split=> // _; exists setT => //. -by exists fset0 => //; rewrite predeqE. +by exists fset0 => //; rewrite set_fset0 bigcap_set0. Qed. Lemma finI_from1 (I : choiceType) T (D : set I) (f : I -> set T) i : D i -> finI_from D f (f i). Proof. -move=> Di; exists [fset i]%fset. - by move=> ?; rewrite !inE => /eqP->. -rewrite predeqE => t; split=> [|fit]; first by apply; rewrite /= inE. -by move=> ?; rewrite /= inE => /eqP->. +move=> Di; exists [fset i]%fset; first by move=> ?; rewrite !inE => /eqP ->. +by rewrite bigcap_fset big_seq_fset1. Qed. Lemma finI_from_countable (I : pointedType) T (D : set I) (f : I -> set T) : @@ -2090,14 +2296,64 @@ move=> ?; apply: (card_le_trans (card_image_le _ _)). exact: fset_subset_countable. Qed. -Section TopologyOfSubbase. +Lemma finI_fromI {I : choiceType} T D (f : I -> set T) A B : + finI_from D f A -> finI_from D f B -> finI_from D f (A `&` B) . +Proof. +case=> N ND <- [M MD <-]; exists (N `|` M)%fset. + by move=> ?; rewrite inE => /orP[/ND | /MD]. +by rewrite -bigcap_setU set_fsetU. +Qed. + +Lemma filterI_iter_finI {I : choiceType} T D (f : I -> set T) : + finI_from D f = \bigcup_n (filterI_iter (f @` D) n). +Proof. +rewrite eqEsubset; split. + move=> A [N /= + <-]; have /finite_setP[n] := finite_fset N; elim: n N. + move=> ?; rewrite II0 card_eq0 => /eqP -> _; rewrite bigcap_set0. + by exists O => //; left. + move=> n IH N /eq_cardSP[x Ax + ND]; rewrite -set_fsetD1 => Nxn. + have NxD : {subset (N `\ x)%fset <= D}. + by move=> ?; rewrite ?inE => /andP [_ /ND /set_mem]. + have [r _ xr] := IH _ Nxn NxD; exists r.+1 => //; exists (f x). + apply: (@filterI_iter_sub _ _ O) => //; right; exists x => //. + by rewrite -inE; apply: ND. + exists (\bigcap_(i in [set` (N `\ x)%fset]) f i) => //. + by rewrite -bigcap_setU1 set_fsetD1 setD1K. +move=> A [n _]; elim: n A. + move=> a [-> |[i Di <-]]; [exists fset0 | exists [fset i]%fset] => //. + - by rewrite set_fset0 bigcap_set0. + - by move=> ?; rewrite !inE => /eqP ->. + - by rewrite set_fset1 bigcap_set1. +by move=> n IH A /= [B snB [C snC <-]]; apply: finI_fromI; apply: IH. +Qed. + +Lemma smallest_filter_finI {T : choiceType} (D : set T) f : + filter_from (finI_from D f) id = smallest (@Filter T) (f @` D). +Proof. by rewrite filterI_iter_finI filterI_iterE. Qed. + +End filter_supremums. + +(* was TopologyOfSubbase *) +HB.factory Record Pointed_isSubBaseTopological T of Pointed T := { + I : pointedType; + D : set I; + b : I -> (set T); +}. + +HB.builders Context T of Pointed_isSubBaseTopological T. -Variable (I : pointedType) (T : Type) (D : set I) (b : I -> set T). +Local Notation finI_from := (finI_from D b). -Program Definition topologyOfSubbaseMixin := - @topologyOfBaseMixin _ _ (finI_from D b) id (finI_from_cover D b) _. -Next Obligation. -move=> A B t [DA sDAD AeIbA] [DB sDBD BeIbB] At Bt. +Lemma finI_from_cover : \bigcup_(A in finI_from) A = setT. +Proof. +rewrite predeqE => t; split=> // _; exists setT => //. +by exists fset0 => //; rewrite predeqE. +Qed. + +Lemma finI_from_join A B t : finI_from A -> finI_from B -> A t -> B t -> + exists k, [/\ finI_from k, k t & k `<=` A `&` B]. +Proof. +move=> [DA sDAD AeIbA] [DB sDBD BeIbB] At Bt. exists (A `&` B); split => //. exists (DA `|` DB)%fset; first by move=> i /fsetUP [/sDAD|/sDBD]. rewrite predeqE => s; split=> [Ifs|[As Bs] i /fsetUP]. @@ -2107,9 +2363,12 @@ by move=> [DAi|DBi]; [have := As; rewrite -AeIbA; apply|have := Bs; rewrite -BeIbB; apply]. Qed. -End TopologyOfSubbase. +HB.instance Definition _ := Pointed_isBaseTopological.Build T + finI_from_cover finI_from_join. -(* Topology on nat *) +HB.end. + +(** Topology on nat *) Section nat_topologicalType. @@ -2122,18 +2381,10 @@ Let bD : forall i j t, D i -> D j -> b i t -> b j t -> exists k, [/\ D k, b k t & b k `<=` b i `&` b j]. Proof. by move=> i j t _ _ -> ->; exists j. Qed. -Definition nat_topologicalTypeMixin := topologyOfBaseMixin bT bD. -Canonical nat_filteredType := FilteredType nat nat (nbhs_of_open (open_from D b)). -Canonical nat_topologicalType := TopologicalType nat nat_topologicalTypeMixin. +HB.instance Definition _ := Pointed_isBaseTopological.Build nat bT bD. End nat_topologicalType. -(* :TODO: ultimately nat could be replaced by any lattice *) -Definition eventually := filter_from setT (fun N => [set n | (N <= n)%N]). -Notation "'\oo'" := eventually : classical_set_scope. - -Canonical eventually_filter_source X := - @Filtered.Source X _ nat (fun f => f @ \oo). Global Instance eventually_filter : ProperFilter eventually. Proof. @@ -2158,27 +2409,27 @@ Proof. by move=> P [n _ Pn]; exists (n - N)%N => // m; rewrite /= leq_subLR => /Pn. Qed. -Lemma cvg_addnr N : addn^~ N --> \oo. +Lemma cvg_addnr N : addn^~ N @ \oo --> \oo. Proof. by under [addn^~ N]funext => n do rewrite addnC; apply: cvg_addnl. Qed. -Lemma cvg_subnr N : subn^~ N --> \oo. +Lemma cvg_subnr N : subn^~ N @ \oo --> \oo. Proof. move=> P [n _ Pn]; exists (N + n)%N => //= m le_m. by apply: Pn; rewrite /= leq_subRL// (leq_trans _ le_m)// leq_addr. Qed. -Lemma cvg_mulnl N : (N > 0)%N -> muln N --> \oo. +Lemma cvg_mulnl N : (N > 0)%N -> muln N @ \oo --> \oo. Proof. case: N => N // _ P [n _ Pn]; exists (n %/ N.+1).+1 => // m. by rewrite /= ltn_divLR// => n_lt; apply: Pn; rewrite mulnC /= ltnW. Qed. -Lemma cvg_mulnr N :(N > 0)%N -> muln^~ N --> \oo. +Lemma cvg_mulnr N :(N > 0)%N -> muln^~ N @ \oo --> \oo. Proof. by move=> N_gt0; under [muln^~ N]funext => n do rewrite mulnC; apply: cvg_mulnl. Qed. -Lemma cvg_divnr N : (N > 0)%N -> divn^~ N --> \oo. +Lemma cvg_divnr N : (N > 0)%N -> divn^~ N @ \oo --> \oo. Proof. move=> N_gt0 P [n _ Pn]; exists (n * N)%N => //= m. by rewrite /= -leq_divRL//; apply: Pn. @@ -2191,7 +2442,7 @@ Proof. case=> N _ NPS; exists (S N) => // [[]]; rewrite /= ?ltn0 //. Qed. Section infty_nat. Local Open Scope nat_scope. -Let cvgnyP {F : set (set nat)} {FF : Filter F} : [<-> +Let cvgnyP {F : set_system nat} {FF : Filter F} : [<-> (* 0 *) F --> \oo; (* 1 *) forall A, \forall x \near F, A <= x; (* 2 *) forall A, \forall x \near F, A < x; @@ -2211,7 +2462,7 @@ Unshelve. all: end_near. Qed. Section map. -Context {I : Type} {F : set (set I)} {FF : Filter F} (f : I -> nat). +Context {I : Type} {F : set_system I} {FF : Filter F} (f : I -> nat). Lemma cvgnyPge : f @ F --> \oo <-> forall A, \forall x \near F, A <= f x. @@ -2233,7 +2484,7 @@ End map. End infty_nat. -(** ** Topology on the product of two spaces *) +(** Topology on the product of two spaces *) Section Prod_Topology. @@ -2256,15 +2507,30 @@ move=> [QR [/nbhs_interior p1_Q /nbhs_interior p2_R] sQRA]. by exists (QR.1^°, QR.2^°) => // ??; exists QR. Qed. -Definition prod_topologicalTypeMixin := - topologyOfFilterMixin prod_nbhs_filter prod_nbhs_singleton prod_nbhs_nbhs. +HB.instance Definition _ := hasNbhs.Build (T * U)%type prod_nbhs. -Canonical prod_topologicalType := - TopologicalType (T * U) prod_topologicalTypeMixin. +HB.instance Definition _ := Nbhs_isNbhsTopological.Build (T * U)%type + prod_nbhs_filter prod_nbhs_singleton prod_nbhs_nbhs. End Prod_Topology. -(** ** Topology on matrices *) +(** Topology on matrices *) + +Lemma fst_open {U V : topologicalType} (A : set (U * V)) : + open A -> open (fst @` A). +Proof. +rewrite !openE => oA z [[a b/=] Aab <-]; rewrite /interior. +have [[P Q] [Pa Qb] pqA] := oA _ Aab; apply: (@filterS _ _ _ P) => // p Pp. +by exists (p, b) => //=; apply: pqA; split=> //=; exact: nbhs_singleton. +Qed. + +Lemma snd_open {U V : topologicalType} (A : set (U * V)) : + open A -> open (snd @` A). +Proof. +rewrite !openE => oA z [[a b/=] Aab <-]; rewrite /interior. +have [[P Q] [Pa Qb] pqA] := oA _ Aab; apply: (@filterS _ _ _ Q) => // q Qq. +by exists (a, q) => //=; apply: pqA; split => //; exact: nbhs_singleton. +Qed. Section matrix_Topology. @@ -2292,31 +2558,32 @@ move=> [P M_P sPA]; exists (fun i j => (P i j)^°). by move=> ? ?; exists P. Qed. -Definition matrix_topologicalTypeMixin := - topologyOfFilterMixin mx_nbhs_filter mx_nbhs_singleton mx_nbhs_nbhs. - -Canonical matrix_topologicalType := - TopologicalType 'M[T]_(m, n) matrix_topologicalTypeMixin. +HB.instance Definition _ := Nbhs_isNbhsTopological.Build 'M[T]_(m, n) + mx_nbhs_filter mx_nbhs_singleton mx_nbhs_nbhs. End matrix_Topology. -(** ** Weak topology by a function *) +(** Weak topology by a function *) + +Definition weak_topology {S : pointedType} {T : topologicalType} + (f : S -> T) : Type := S. Section Weak_Topology. Variable (S : pointedType) (T : topologicalType) (f : S -> T). +Local Notation W := (weak_topology f). Definition wopen := [set f @^-1` A | A in open]. -Lemma wopT : wopen setT. +Lemma wopT : wopen [set: W]. Proof. by exists setT => //; apply: openT. Qed. -Lemma wopI (A B : set S) : wopen A -> wopen B -> wopen (A `&` B). +Lemma wopI (A B : set W) : wopen A -> wopen B -> wopen (A `&` B). Proof. by move=> [C Cop <-] [D Dop <-]; exists (C `&` D) => //; apply: openI. Qed. -Lemma wop_bigU (I : Type) (g : I -> set S) : +Lemma wop_bigU (I : Type) (g : I -> set W) : (forall i, wopen (g i)) -> wopen (\bigcup_i g i). Proof. move=> gop. @@ -2330,63 +2597,61 @@ rewrite predeqE => s; split=> [[i _]|[i _]]; last by rewrite g_preim; exists i. by rewrite -[_ _]/((f @^-1` _) _) -g_preim; exists i. Qed. -Definition weak_topologicalTypeMixin := topologyOfOpenMixin wopT wopI wop_bigU. - -Let S_filteredClass := Filtered.Class (Pointed.class S) (nbhs_of_open wopen). -Definition weak_topologicalType := - Topological.Pack (@Topological.Class _ S_filteredClass - weak_topologicalTypeMixin). +HB.instance Definition _ := Pointed.on W. +HB.instance Definition _ := + Pointed_isOpenTopological.Build W wopT wopI wop_bigU. -Lemma weak_continuous : continuous (f : weak_topologicalType -> T). +Lemma weak_continuous : continuous (f : W -> T). Proof. by apply/continuousP => A ?; exists A. Qed. -Lemma cvg_image (F : set (set S)) (s : S) : +Lemma cvg_image (F : set_system S) (s : S) : Filter F -> f @` setT = setT -> - F --> (s : weak_topologicalType) <-> [set f @` A | A in F] --> f s. + F --> (s : W) <-> ([set f @` A | A in F] : set_system _) --> f s. Proof. move=> FF fsurj; split=> [cvFs|cvfFfs]. - move=> A /weak_continuous [B [Bop [Bs sBAf]]]. - have /cvFs FB : nbhs (s : weak_topologicalType) B by apply: open_nbhs_nbhs. + move=> A /weak_continuous [B [Bop Bs sBAf]]. + have /cvFs FB : nbhs (s : W) B by apply: open_nbhs_nbhs. rewrite nbhs_simpl; exists (f @^-1` A); first exact: filterS FB. exact: image_preimage. -move=> A /= [_ [[B Bop <-] [Bfs sBfA]]]. -have /cvfFfs [C FC fCeB] : nbhs (f s) B by rewrite nbhsE; exists B; split. +move=> A /= [_ [[B Bop <-] Bfs sBfA]]. +have /cvfFfs [C FC fCeB] : nbhs (f s) B by rewrite nbhsE; exists B. rewrite nbhs_filterE; apply: filterS FC. by apply: subset_trans sBfA; rewrite -fCeB; apply: preimage_image. Qed. End Weak_Topology. -(** ** Supremum of a family of topologies *) +(** Supremum of a family of topologies *) + +Definition sup_topology {T : pointedType} {I : Type} + (Tc : I -> Topological T) : Type := T. Section Sup_Topology. -Variable (T : pointedType) (I : Type) (Tc : I -> Topological.class_of T). +Variable (T : pointedType) (I : Type) (Tc : I -> Topological T). +Local Notation S := (sup_topology Tc). Let TS := fun i => Topological.Pack (Tc i). -Definition sup_subbase := \bigcup_i (@open (TS i) : set (set T)). - -Definition sup_topologicalTypeMixin := topologyOfSubbaseMixin sup_subbase id. +Definition sup_subbase := \bigcup_i (@open (TS i) : set_system T). -Definition sup_topologicalType := - Topological.Pack (@Topological.Class _ (Filtered.Class (Pointed.class T) _) - sup_topologicalTypeMixin). +HB.instance Definition _ := Pointed.on S. +HB.instance Definition _ := Pointed_isSubBaseTopological.Build S sup_subbase id. -Lemma cvg_sup (F : set (set T)) (t : T) : - Filter F -> F --> (t : sup_topologicalType) <-> forall i, F --> (t : TS i). +Lemma cvg_sup (F : set_system T) (t : T) : + Filter F -> F --> (t : S) <-> forall i, F --> (t : TS i). Proof. move=> Ffilt; split=> cvFt. - move=> i A /=; rewrite (@nbhsE (TS i)) => - [B [[Bop Bt] sBA]]. + move=> i A /=; rewrite (@nbhsE (TS i)) => - [B [Bop Bt] sBA]. apply: cvFt; exists B; split=> //; exists [set B]; last first. by rewrite predeqE => ?; split=> [[_ ->]|] //; exists B. move=> _ ->; exists [fset B]%fset. by move=> ?; rewrite inE inE => /eqP->; exists i. by rewrite predeqE=> ?; split=> [|??]; [apply|]; rewrite /= inE // =>/eqP->. -move=> A /=; rewrite (@nbhsE sup_topologicalType). -move=> [_ [[[B sB <-] [C BC Ct]] sUBA]]. +move=> A /=; rewrite (@nbhsE [the topologicalType of S]). +move=> [_ [[B sB <-] [C BC Ct] sUBA]]. rewrite nbhs_filterE; apply: filterS sUBA _; apply: (@filterS _ _ _ C). - by move=> ??; exists C. + by move=> ? ?; exists C. have /sB [D sD IDeC] := BC; rewrite -IDeC; apply: filter_bigI => E DE. have /sD := DE; rewrite inE => - [i _]; rewrite openE => Eop. by apply: (cvFt i); apply: Eop; move: Ct; rewrite -IDeC => /(_ _ DE). @@ -2394,32 +2659,41 @@ Qed. End Sup_Topology. -(** ** Product topology *) +(** Product topology *) Section Product_Topology. +Definition prod_topology {I : Type} (T : I -> Type) := forall i, T i. + Variable (I : Type) (T : I -> topologicalType). -Definition product_topologicalType := - sup_topologicalType (fun i => Topological.class - (weak_topologicalType (fun f : dep_arrow_pointedType T => f i))). +Definition product_topology_def := + sup_topology (fun i => Topological.class + (weak_topology (fun f : [the pointedType of (forall i : I, T i)] => f i))). + +HB.instance Definition _ := + Topological.copy (prod_topology T) product_topology_def. End Product_Topology. -(** dnbhs *) +(** deleted neighborhood *) Definition dnbhs {T : topologicalType} (x : T) := within (fun y => y != x) (nbhs x). Notation "x ^'" := (dnbhs x) : classical_set_scope. +Lemma nbhs_dnbhs_neq {T : topologicalType} (p : T) : + \forall x \near nbhs p^', x != p. +Proof. exact: withinT. Qed. + Lemma dnbhsE (T : topologicalType) (x : T) : nbhs x = x^' `&` at_point x. Proof. rewrite predeqE => A; split=> [x_A|[x_A Ax]]. split; last exact: nbhs_singleton. - move: x_A; rewrite nbhsE => -[B [x_B sBA]]; rewrite /dnbhs nbhsE. - by exists B; split=> // ? /sBA. -move: x_A; rewrite /dnbhs !nbhsE => -[B [x_B sBA]]; exists B. -by split=> // y /sBA Ay; case: (eqVneq y x) => [->|]. + move: x_A; rewrite nbhsE => -[B [oB x_B sBA]]; rewrite /dnbhs nbhsE. + by exists B => // ? /sBA. +move: x_A; rewrite /dnbhs !nbhsE => -[B [oB x_B sBA]]; exists B => //. +by move=> y /sBA Ay; case: (eqVneq y x) => [->|]. Qed. Global Instance dnbhs_filter {T : topologicalType} (x : T) : Filter x^'. @@ -2430,14 +2704,14 @@ Canonical dnbhs_filter_on (T : topologicalType) (x : T) := FilterType x^' (dnbhs_filter _). Lemma cvg_fmap2 (T U : Type) (f : T -> U): - forall (F G : set (set T)), G `=>` F -> f @ G `=>` f @ F. + forall (F G : set_system T), G `=>` F -> f @ G `=>` f @ F. Proof. by move=> F G H A fFA ; exact: H (preimage f A) fFA. Qed. -Lemma cvg_within_filter {T U} {f : T -> U} (F : set (set T)) {FF : (Filter F) } - (G : set (set U)) : forall (D : set T), (f @ F) --> G -> (f @ within D F) --> G. +Lemma cvg_within_filter {T U} {f : T -> U} (F : set_system T) {FF : (Filter F) } + (G : set_system U) : forall (D : set T), (f @ F) --> G -> (f @ within D F) --> G. Proof. move=> ?; exact: cvg_trans (cvg_fmap2 (cvg_within _)). Qed. -Lemma cvg_app_within {T} {U : topologicalType} (f : T -> U) (F : set (set T)) +Lemma cvg_app_within {T} {U : topologicalType} (f : T -> U) (F : set_system T) (D : set T): Filter F -> cvg (f @ F) -> cvg (f @ within D F). Proof. by move => FF /cvg_ex [l H]; apply/cvg_ex; exists l; exact: cvg_within_filter. Qed. @@ -2446,14 +2720,14 @@ Proof. exact: cvg_within. Qed. (** meets *) -Lemma meets_openr {T : topologicalType} (F : set (set T)) (x : T) : +Lemma meets_openr {T : topologicalType} (F : set_system T) (x : T) : F `#` nbhs x = F `#` open_nbhs x. Proof. rewrite propeqE; split; [exact/meetsSr/open_nbhs_nbhs|]. -by move=> P A B {}/P P; rewrite nbhsE => -[B' [/P + sB]]; apply: subsetI_neq0. +by move=> P A B {}/P P; rewrite nbhsE => -[B' /P + sB]; apply: subsetI_neq0. Qed. -Lemma meets_openl {T : topologicalType} (F : set (set T)) (x : T) : +Lemma meets_openl {T : topologicalType} (F : set_system T) (x : T) : nbhs x `#` F = open_nbhs x `#` F. Proof. by rewrite meetsC meets_openr meetsC. Qed. @@ -2470,17 +2744,17 @@ Proof. by rewrite meetsC meets_globallyl; under eq_forall do rewrite setIC. Qed. -Lemma meetsxx T (F : set (set T)) (FF : Filter F) : F `#` F = ~ (F set0). +Lemma meetsxx T (F : set_system T) (FF : Filter F) : F `#` F = ~ (F set0). Proof. rewrite propeqE; split => [FmF F0|]; first by have [x []] := FmF _ _ F0 F0. move=> FN0 A B /filterI FAI {}/FAI FAB; apply/set0P/eqP => AB0. by rewrite AB0 in FAB. Qed. -Lemma proper_meetsxx T (F : set (set T)) (FF : ProperFilter F) : F `#` F. +Lemma proper_meetsxx T (F : set_system T) (FF : ProperFilter F) : F `#` F. Proof. by rewrite meetsxx; apply: filter_not_empty. Qed. -(** ** Closed sets in topological spaces *) +(** Closed sets in topological spaces *) Section Closed. @@ -2504,6 +2778,11 @@ Proof. by under eq_fun do rewrite -meets_openr meets_globallyl. Qed. Lemma subset_closure (A : set T) : A `<=` closure A. Proof. by move=> p ??; exists p; split=> //; apply: nbhs_singleton. Qed. +Lemma closure_eq0 (A : set T) : closure A = set0 -> A = set0. +Proof. +by move=> A0; apply/seteqP; split => //; rewrite -A0; exact: subset_closure. +Qed. + Lemma closureI (A B : set T) : closure (A `&` B) `<=` closure A `&` closure B. Proof. by move=> p clABp; split=> ? /clABp [q [[]]]; exists q. Qed. @@ -2561,11 +2840,11 @@ Proof. rewrite predeqE => A; split=> Acl p; last first. by move=> clAp; apply: Acl; rewrite -nbhs_nearE => /clAp [? []]. rewrite -nbhs_nearE nbhsE => /asboolP. -rewrite asbool_neg => /forallp_asboolPn clAp. -apply: Acl => B; rewrite nbhsE => - [C [p_C sCB]]. +rewrite asbool_neg => /forallp_asboolPn2 clAp. +apply: Acl => B; rewrite nbhsE => - [C [oC pC]]. have /asboolP := clAp C. -rewrite asbool_neg asbool_and => /nandP [/asboolP//|/existsp_asboolPn [q]]. -move/asboolP; rewrite asbool_neg => /imply_asboolPn [/sCB Bq /contrapT Aq]. +rewrite asbool_or 2!asbool_neg => /orP[/asboolP/not_andP[]//|/existsp_asboolPn [q]]. +move/asboolP; rewrite asbool_neg => /imply_asboolPn[+ /contrapT Aq sCB] => /sCB. by exists q. Qed. @@ -2594,7 +2873,7 @@ Proof. rewrite !closedE=> f_continuous D_cl x /= xDf. apply: D_cl; apply: contra_not xDf => fxD. have NDfx : ~ D (f x). - by move: fxD; rewrite -nbhs_nearE nbhsE => - [A [[??]]]; apply. + by move: fxD; rewrite -nbhs_nearE nbhsE => - [A [? ?]]; apply. by apply: f_continuous fxD; rewrite inE. Qed. @@ -2613,8 +2892,8 @@ Lemma continuous_closedP (S T : topologicalType) (f : S -> T) : continuous f <-> forall A, closed A -> closed (f @^-1` A). Proof. rewrite continuousP; split=> ctsf ? ?. - by rewrite -openC preimage_setC; apply ctsf; rewrite openC. -by rewrite -closedC preimage_setC; apply ctsf; rewrite closedC. + by rewrite -openC preimage_setC; apply: ctsf; rewrite openC. +by rewrite -closedC preimage_setC; apply: ctsf; rewrite closedC. Qed. Lemma closedU (T : topologicalType) (D E : set T) : @@ -2629,6 +2908,15 @@ move=> scF; rewrite big_seq. by elim/big_ind : _ => //; [exact: closed0|exact: closedU]. Qed. +Lemma closed_bigcup (T : topologicalType) (I : choiceType) (A : set I) + (F : I -> set T) : + finite_set A -> (forall i, A i -> closed (F i)) -> + closed (\bigcup_(i in A) F i). +Proof. +move=> finA cF; rewrite -bigsetU_fset_set//; apply: closed_bigsetU => i. +by rewrite in_fset_set// inE; exact: cF. +Qed. + Section closure_lemmas. Variable T : topologicalType. Implicit Types E A B U : set T. @@ -2658,13 +2946,13 @@ Qed. End closure_lemmas. -(** ** Compact sets *) +(** Compact sets *) Section Compact. Context {T : topologicalType}. -Definition cluster (F : set (set T)) := [set p : T | F `#` nbhs p]. +Definition cluster (F : set_system T) := [set p : T | F `#` nbhs p]. Lemma cluster_nbhs t : cluster (nbhs t) t. Proof. by move=> A B /nbhs_singleton At /nbhs_singleton Bt; exists t. Qed. @@ -2693,7 +2981,7 @@ rewrite predeqE => p; have PF : ProperFilter F by []. split=> [clFp|[G Gproper [cvGp sFG]] A B]; last first. by move=> /sFG GA /cvGp GB; apply: (@filter_ex _ G); apply: filterI. exists (filter_from (\bigcup_(A in F) [set A `&` B | B in nbhs p]) id). - apply filter_from_proper; last first. + apply: filter_from_proper; last first. by move=> _ [A FA [B p_B <-]]; have := clFp _ _ FA p_B. apply: filter_from_filter. exists setT; exists setT; first exact: filterT. @@ -2714,7 +3002,7 @@ Lemma closureEcvg (E : set T): [set p | exists2 G, ProperFilter G & G --> p /\ globally E `<=` G]. Proof. by rewrite closureEcluster cluster_cvgE. Qed. -Definition compact A := forall (F : set (set T)), +Definition compact A := forall (F : set_system T), ProperFilter F -> F A -> A `&` cluster F !=set0. Lemma compact0 : compact set0. @@ -2754,13 +3042,40 @@ by apply: filter_ex; [exact: PF| exact: filterI]. Qed. End Compact. + Arguments hausdorff_space : clear implicits. +Section ClopenSets. +Implicit Type T : topologicalType. + +Definition clopen {T} (A : set T) := open A /\ closed A. + +Lemma clopenI {T} (A B : set T) : clopen A -> clopen B -> clopen (A `&` B). +Proof. by case=> ? ? [] ? ?; split; [exact: openI | exact: closedI]. Qed. + +Lemma clopenU {T} (A B : set T) : clopen A -> clopen B -> clopen (A `|` B). +Proof. by case=> ? ? [] ? ?; split; [exact: openU | exact: closedU]. Qed. + +Lemma clopenC {T} (A B : set T) : clopen A -> clopen (~`A). +Proof. by case=> ? ?; split;[exact: closed_openC | exact: open_closedC ]. Qed. + +Lemma clopen0 {T} : @clopen T set0. +Proof. by split; [exact: open0 | exact: closed0]. Qed. + +Lemma clopenT {T} : clopen [set: T]. +Proof. by split; [exact: openT | exact: closedT]. Qed. + +Lemma clopen_comp {T U : topologicalType} (f : T -> U) (A : set U) : + clopen A -> continuous f -> clopen (f @^-1` A). +Proof. by case=> ? ?; split; [ exact: open_comp | exact: closed_comp]. Qed. + +End ClopenSets. + Section near_covering. Context {X : topologicalType}. Definition near_covering (K : set X) := - forall (I : Type) (F : set (set I)) (P : I -> X -> Prop), + forall (I : Type) (F : set_system I) (P : I -> X -> Prop), Filter F -> (forall x, K x -> \forall x' \near x & i \near F, P i x') -> \near F, K `<=` P F. @@ -2774,7 +3089,7 @@ have /locK : forall x, K x -> move=> x Kx; have : ~ cluster F x. by apply: contraPnot KclstF0 => clstFx; apply/eqP/set0P; exists x. move=> /existsNP [U /existsNP [V /not_implyP [FU /not_implyP [nbhsV]]]] UV0. - near=> x' W => //= => Wx'; apply UV0; exists x'. + near=> x' W => //= => Wx'; apply: UV0; exists x'. by split; [exact: (near (small_set_sub FU) W) | exact: (near nbhsV x')]. case=> G [GF Gdown [U GU]] GP; apply: (@filterS _ _ _ U); last exact: GF. by move=> y Uy Ky; exact: (GP _ GU y Ky). @@ -2805,21 +3120,51 @@ move=> /(_ _ _ GP U1x) => [[x'[]]][] Kx' /[swap] U1x'. by case; split => // i [? ?]; exact: (subP (x', i)). Unshelve. end_near. Qed. -Lemma compact_near_coveringP : compact `<=>` near_covering. +Lemma compact_near_coveringP A : compact A <-> near_covering A. Proof. by split; [exact: compact_near_covering| exact: near_covering_compact]. Qed. +Definition near_covering_within (K : set X) := + forall (I : Type) (F : set_system I) (P : I -> X -> Prop), + Filter F -> + (forall x, K x -> \forall x' \near x & i \near F, K x' -> P i x') -> + \near F, K `<=` P F. + +Lemma near_covering_withinP (K : set X) : + near_covering_within K <-> near_covering K. +Proof. +split => cvrW I F P FF cvr; near=> i; + (suff: K `<=` fun q : X => K q -> P i q by move=> + k Kk; exact); near: i. + by apply: cvrW => x /cvr; apply: filter_app; near=> j. +have := cvrW _ _ (fun i q => K q -> P i q) FF. +by apply => x /cvr; apply: filter_app; near=> j => + ?; apply. +Unshelve. all: by end_near. Qed. + End near_covering. +Lemma compact_setM {U V : topologicalType} (P : set U) (Q : set V) : + compact P -> compact Q -> compact (P `*` Q). +Proof. +rewrite !compact_near_coveringP => cptP cptQ I F Pr Ff cvfPQ. +have := cptP I F (fun i u => forall q, Q q -> Pr i (u, q)) Ff. +set R := (R in (R -> _) -> _); suff R' : R. + by move/(_ R'); apply:filter_app; near=> i => + [a b] [Pa Qb]; apply. +rewrite /R => x Px; apply: (@cptQ _ (filter_prod _ _)) => v Qv. +case: (cvfPQ (x, v)) => // [[N G]] /= [[[N1 N2 /= [N1x N2v]]]] N1N2N FG ngPr. +exists (N2, N1`*`G); first by split => //; exists (N1, G). +case=> a [b i] /= [N2a [N1b]] Gi. +by apply: (ngPr (b, a, i)); split => //; exact: N1N2N. +Unshelve. all: by end_near. Qed. + Section Tychonoff. -Class UltraFilter T (F : set (set T)) := { +Class UltraFilter T (F : set_system T) := { ultra_proper :> ProperFilter F ; - max_filter : forall G : set (set T), ProperFilter G -> F `<=` G -> G = F + max_filter : forall G : set_system T, ProperFilter G -> F `<=` G -> G = F }. -Lemma ultra_cvg_clusterE (T : topologicalType) (F : set (set T)) : +Lemma ultra_cvg_clusterE (T : topologicalType) (F : set_system T) : UltraFilter F -> cluster F = [set p | F --> p]. Proof. move=> FU; rewrite predeqE => p; split. @@ -2827,11 +3172,11 @@ move=> FU; rewrite predeqE => p; split. by move=> cvFp; rewrite cluster_cvgE; exists F; [apply: ultra_proper|split]. Qed. -Lemma ultraFilterLemma T (F : set (set T)) : +Lemma ultraFilterLemma T (F : set_system T) : ProperFilter F -> exists G, UltraFilter G /\ F `<=` G. Proof. move=> FF. -set filter_preordset := ({G : set (set T) & ProperFilter G /\ F `<=` G}). +set filter_preordset := ({G : set_system T & ProperFilter G /\ F `<=` G}). set preorder := fun G1 G2 : filter_preordset => projT1 G1 `<=` projT1 G2. suff [G Gmax] : exists G : filter_preordset, premaximal preorder G. have [GF sFG] := projT2 G; exists (projT1 G); split=> //; split=> // H HF sGH. @@ -2850,7 +3195,7 @@ suff UAF : ProperFilter (\bigcup_(H in A) projT1 H). by move=> B FB; exists G => //; apply: sFG. exists (existT _ (\bigcup_(H in A) projT1 H) (conj UAF sFUA)) => H AH B HB /=. by exists H. -apply Build_ProperFilter. +apply: Build_ProperFilter. by move=> B [H AH HB]; have [HF _] := projT2 H; apply: (@filter_ex _ _ HF). split; first by exists G => //; apply: filterT. move=> B C [HB AHB HBB] [HC AHC HCC]; have [sHBC|sHCB] := Atot _ _ AHB AHC. @@ -2863,7 +3208,7 @@ exact: filterS HB. Qed. Lemma compact_ultra (T : topologicalType) : - compact = [set A | forall F : set (set T), + compact = [set A | forall F : set_system T, UltraFilter F -> F A -> A `&` [set p | F --> p] !=set0]. Proof. rewrite predeqE => A; split=> Aco F FF FA. @@ -2874,7 +3219,7 @@ rewrite /= -[_ --> p]/([set _ | _] p) -ultra_cvg_clusterE. by move=> /(cvg_cluster sFG); exists p. Qed. -Lemma filter_image (T U : Type) (f : T -> U) (F : set (set T)) : +Lemma filter_image (T U : Type) (f : T -> U) (F : set_system T) : Filter F -> f @` setT = setT -> Filter [set f @` A | A in F]. Proof. move=> FF fsurj; split. @@ -2889,10 +3234,10 @@ move=> FF fsurj; split. by apply: filterS FC => p Cp; apply: sAB; rewrite -fC_eqA; exists p. Qed. -Lemma proper_image (T U : Type) (f : T -> U) (F : set (set T)) : +Lemma proper_image (T U : Type) (f : T -> U) (F : set_system T) : ProperFilter F -> f @` setT = setT -> ProperFilter [set f @` A | A in F]. Proof. -move=> FF fsurj; apply Build_ProperFilter; last exact: filter_image. +move=> FF fsurj; apply: Build_ProperFilter; last exact: filter_image. by move=> _ [A FA <-]; have /filter_ex [p Ap] := FA; exists (f p); exists p. Qed. @@ -2905,14 +3250,14 @@ have /(filterI GU): G [set x] by exact/FG/principal_filterP. by rewrite setIC set1I; case: ifPn => // /[!inE]. Qed. -Lemma in_ultra_setVsetC T (F : set (set T)) (A : set T) : +Lemma in_ultra_setVsetC T (F : set_system T) (A : set T) : UltraFilter F -> F A \/ F (~` A). Proof. move=> FU; case: (pselect (F (~` A))) => [|nFnA]; first by right. left; suff : ProperFilter (filter_from (F `|` [set A `&` B | B in F]) id). move=> /max_filter <-; last by move=> B FB; exists B => //; left. by exists A => //; right; exists setT; [apply: filterT|rewrite setIT]. -apply filter_from_proper; last first. +apply: filter_from_proper; last first. move=> B [|[C FC <-]]; first exact: filter_ex. apply: contrapT => /asboolP; rewrite asbool_neg => /forallp_asboolPn AC0. by apply: nFnA; apply: filterS FC => p Cp Ap; apply: (AC0 p). @@ -2929,7 +3274,7 @@ exists (A `&` (DB `&` DC)); last by move=> ??; rewrite setIACA setIid. by right; exists (DB `&` DC) => //; apply: filterI. Qed. -Lemma ultra_image (T U : Type) (f : T -> U) (F : set (set T)) : +Lemma ultra_image (T U : Type) (f : T -> U) (F : set_system T) : UltraFilter F -> f @` setT = setT -> UltraFilter [set f @` A | A in F]. Proof. move=> FU fsurj; split; first exact: proper_image. @@ -2945,8 +3290,7 @@ Qed. Lemma tychonoff (I : eqType) (T : I -> topologicalType) (A : forall i, set (T i)) : (forall i, compact (A i)) -> - @compact (product_topologicalType T) - [set f : forall i, T i | forall i, A i (f i)]. + compact [set f : prod_topology T | forall i, A i (f i)]. Proof. move=> Aco; rewrite compact_ultra => F FU FA. set subst_coord := fun (i : I) (pi : T i) (f : forall x : I, T x) (j : I) => @@ -2957,10 +3301,10 @@ have subst_coordT i pi f : subst_coord i pi f i = pi. have subst_coordN i pi f j : i != j -> subst_coord i pi f j = f j. move=> inej; rewrite /subst_coord; case: eqP => // e. by move: inej; rewrite {1}e => /negP. -have pr_surj i : @^~ i @` (@setT (forall i, T i)) = setT. +have pr_surj i : @^~ i @` [set: forall i, T i] = setT. rewrite predeqE => pi; split=> // _. by exists (subst_coord i pi (fun _ => point))=> //; rewrite subst_coordT. -set pF := fun i => [set @^~ i @` B | B in F]. +pose pF i : set_system _ := [set @^~ i @` B | B in F]. have pFultra : forall i, UltraFilter (pF i). by move=> i; apply: ultra_image (pr_surj i). have pFA : forall i, pF i (A i). @@ -2979,6 +3323,28 @@ Qed. End Tychonoff. +Lemma compact_cluster_set1 {T : topologicalType} (x : T) F V : + hausdorff_space T -> compact V -> nbhs x V -> + ProperFilter F -> F V -> cluster F = [set x] -> F --> x. +Proof. +move=> ? cptV nxV PF FV clFx1 U nbhsU; rewrite nbhs_simpl. +wlog oU : U nbhsU / open U. + rewrite /= nbhsE in nbhsU; case: nbhsU => O oO OsubU /(_ O) WH. + by apply: (filterS OsubU); apply: WH; [exact: open_nbhs_nbhs | by case: oO]. +have /compact_near_coveringP : compact (V `\` U). + apply: (subclosed_compact _ cptV) => //. + by apply: closedI; [exact: compact_closed | exact: open_closedC]. +move=> /(_ _ (powerset_filter_from F) (fun W x => ~ W x))[]. + move=> z [Vz ?]; have zE : x <> z by move/nbhs_singleton: nbhsU => /[swap] ->. + have : ~ cluster F z by move: zE; apply: contra_not; rewrite clFx1 => ->. + case/existsNP=> C /existsPNP [D] FC /existsNP [Dz] /set0P/negP/negPn/eqP. + rewrite setIC => /disjoints_subset CD0; exists (D, [set W | F W /\ W `<=` C]). + by split; rewrite //= nbhs_simpl; exact: powerset_filter_fromP. + by case => t W [Dt] [FW] /subsetCP; apply; apply: CD0. +move=> M [MF ME2 [W] MW /(_ _ MW) VUW]. +apply: (@filterS _ _ _ (V `&` W)); last by apply: filterI => //; exact: MF. +by move=> t [Vt Wt]; apply: contrapT => Ut; exact: (VUW t). +Qed. Section Precompact. Context {X : topologicalType}. @@ -2992,9 +3358,14 @@ have /cptB[x BFx] : F B by apply: filterS FBA; exact: subIsetr. by exists x; right. Qed. +Lemma bigsetU_compact I (F : I -> set X) (s : seq I) (P : pred I) : + (forall i, P i -> compact (F i)) -> + compact (\big[setU/set0]_(i <- s | P i) F i). +Proof. by move=> ?; elim/big_ind : _ =>//; [exact:compact0|exact:compactU]. Qed. + (* The closed condition here is neccessary to make this definition work in a *) (* non-hausdorff setting. *) -Definition compact_near (F : set (set X)) := +Definition compact_near (F : set_system X) := exists2 U, F U & compact U /\ closed U. Definition precompact (C : set X) := compact_near (globally C). @@ -3014,11 +3385,11 @@ Proof. by move=> AsubB [B' B'subB cptB']; exists B' => // ? ?; exact/B'subB/AsubB. Qed. -Lemma compact_precompact (A B : set X) : +Lemma compact_precompact (A : set X) : hausdorff_space X -> compact A -> precompact A. Proof. move=> h c; rewrite precompactE ( _ : closure A = A)//. -apply/esym/closure_id; exact: compact_closed. +by apply/esym/closure_id; exact: compact_closed. Qed. Lemma precompact_closed (A : set X) : closed A -> precompact A = compact A. @@ -3035,12 +3406,15 @@ End Precompact. Section product_spaces. Context {I : eqType} {K : I -> topologicalType}. -Let PK := product_topologicalType K. +(* This a helper function to prove products preserve hausdorff. In particular *) +(* we use its continuity turn clustering in `product_topologicalType K` to *) +(* clustering in K x for each X. *) +Definition prod_topo_apply x (f : forall i, K i) := f x. (* Note we have to give the signature explicitly because there's no canonical *) (* topology associated with `K`. This should be cleaned up after HB port. *) -Lemma proj_continuous i : continuous (proj i : PK -> K i). +Lemma proj_continuous i : continuous (proj i : prod_topology K -> K i). Proof. move=> f; have /cvg_sup/(_ i)/cvg_image : f --> f by apply: cvg_id. move=> h; apply: cvg_trans (h _) => {h}. @@ -3049,22 +3423,22 @@ rewrite eqEsubset; split => y //; exists (dfwith (fun=> point) i y) => //. by rewrite dfwithin. Qed. -Lemma dfwith_continuous g (i : I) : continuous (dfwith g _ : K i -> PK). +Lemma dfwith_continuous g (i : I) : continuous (dfwith g _ : K i -> prod_topology K). Proof. -move=> z U [] P [] [] Q QfinP <- [] [] V JV Vpz. +move=> z U [] P [] [] Q QfinP <- [] V JV Vpz. move/(@preimage_subset _ _ (dfwith g i))/filterS; apply. apply: (@filterS _ _ _ ((dfwith g i) @^-1` V)); first by exists V. have [L Lsub /[dup] VL <-] := QfinP _ JV; rewrite preimage_bigcap. apply: filter_bigI => /= M /[dup] LM /Lsub /set_mem [] w _ [+] + /[dup] + <-. have [->|wnx] := eqVneq w i => N oN NM. - apply (@filterS _ _ _ N); first by move=> ? ?; rewrite /= dfwithin. + apply: (@filterS _ _ _ N); first by move=> ? ?; rewrite /= dfwithin. apply: open_nbhs_nbhs; split => //; move: Vpz. by rewrite -VL => /(_ _ LM); rewrite -NM /= dfwithin. apply: nearW => y /=; move: Vpz. by rewrite -VL => /(_ _ LM); rewrite -NM /= ? dfwithout // eq_sym. Qed. -Lemma proj_open i (A : set PK) : open A -> open (proj i @` A). +Lemma proj_open i (A : set (prod_topology K)) : open A -> open (proj i @` A). Proof. move=> oA; rewrite openE => z [f Af <-]; rewrite openE in oA. have {oA} := oA _ Af; rewrite /interior => nAf. @@ -3075,7 +3449,7 @@ by apply: functional_extensionality_dep => ?; case: dfwithP. Qed. Lemma hausdorff_product : - (forall x, hausdorff_space (K x)) -> hausdorff_space PK. + (forall x, hausdorff_space (K x)) -> hausdorff_space (prod_topology K). Proof. move=> hsdfK p q /= clstr; apply: functional_extensionality_dep => x. apply: hsdfK; move: clstr; rewrite ?cluster_cvgE /= => -[G PG [GtoQ psubG]]. @@ -3106,7 +3480,7 @@ move=> finIf; apply: (filter_from_proper (filter_from_filter _ _)). - by move=> _ [?? <-]; apply: finIf. Qed. -Lemma filter_finI (T : pointedType) (F : set (set T)) (D : set (set T)) +Lemma filter_finI (T : pointedType) (F : set_system T) (D : set_system T) (f : set T -> set T) : ProperFilter F -> (forall A, D A -> F (f A)) -> finI D f. Proof. @@ -3114,10 +3488,9 @@ move=> FF sDFf D' sD; apply: (@filter_ex _ F); apply: filter_bigI. by move=> A /sD; rewrite inE => /sDFf. Qed. -Definition finSubCover (I : choiceType) (D : set I) +Definition finite_subset_cover (I : choiceType) (D : set I) U (F : I -> set U) (A : set U) := - exists2 D' : {fset I}, {subset D' <= D} & - A `<=` \bigcup_(i in [set i | i \in D']) F i. + exists2 D' : {fset I}, {subset D' <= D} & A `<=` cover [set` D'] F. Section Covers. @@ -3125,18 +3498,17 @@ Variable T : topologicalType. Definition cover_compact (A : set T) := forall (I : choiceType) (D : set I) (f : I -> set T), - (forall i, D i -> open (f i)) -> A `<=` \bigcup_(i in D) f i -> - finSubCover D f A. + (forall i, D i -> open (f i)) -> A `<=` cover D f -> + finite_subset_cover D f A. Definition open_fam_of (A : set T) I (D : set I) (f : I -> set T) := exists2 g : I -> set T, (forall i, D i -> open (g i)) & forall i, D i -> f i = A `&` g i. -Lemma cover_compactE : - cover_compact = +Lemma cover_compactE : cover_compact = [set A | forall (I : choiceType) (D : set I) (f : I -> set T), - open_fam_of A D f -> A `<=` \bigcup_(i in D) f i -> finSubCover D f A]. - + open_fam_of A D f -> + A `<=` cover D f -> finite_subset_cover D f A]. Proof. rewrite predeqE => A; split=> [Aco I D f [g gop feAg] fcov|Aco I D f fop fcov]. have gcov : A `<=` \bigcup_(i in D) g i. @@ -3192,8 +3564,7 @@ split=> [Aco I D f [g gop feAg] fcov|Aco I D f [g gcl feAg]]. by move=> gip; apply: nfip; rewrite feAg. by rewrite feAg // => - []. move=> D' sD. - have /asboolP : ~ A `<=` \bigcup_(i in [set i | i \in D']) f i. - by move=> sAIf; apply: (sfncov D'). + have /asboolP : ~ A `<=` cover [set` D'] f by move=> sAIf; exact: (sfncov D'). rewrite asbool_neg => /existsp_asboolPn [p /asboolP]. rewrite asbool_neg => /imply_asboolPn [Ap nUfp]. by exists p => i D'i; split=> // fip; apply: nUfp; exists i. @@ -3223,8 +3594,80 @@ Qed. End Covers. +Lemma finite_compact {X : topologicalType} (A : set X) : + finite_set A -> compact A. +Proof. +case/finite_setP=> n; elim: n A => [A|n ih A /eq_cardSP[x Ax /ih ?]]. + by rewrite II0 card_eq0 => /eqP ->; exact: compact0. +by rewrite -(setD1K Ax); apply: compactU => //; exact: compact_set1. +Qed. + +Lemma clopen_countable {T : topologicalType}: + compact [set: T] -> @second_countable T -> countable (@clopen T). +Proof. +move=> cmpT [B /fset_subset_countable cntB] [obase Bbase]. +apply/(card_le_trans _ cntB)/pcard_surjP. +pose f := fun F : {fset set T} => \bigcup_(x in [set` F]) x; exists f. +move=> D [] oD cD /=; have cmpt : cover_compact D. + by rewrite -compact_cover; exact: (subclosed_compact _ cmpT). +have h (x : T) : exists V : set T, D x -> [/\ B V, nbhs x V & V `<=` D]. + have [Dx|] := pselect (D x); last by move=> ?; exists set0. + have [V [BV Vx VD]] := Bbase x D (open_nbhs_nbhs (conj oD Dx)). + exists V => _; split => //; apply: open_nbhs_nbhs; split => //. + exact: obase. +pose h' := fun z => projT1 (cid (h z)). +have [fs fsD DsubC] : finite_subset_cover D h' D. + apply: cmpt. + - by move=> z Dz; apply: obase; have [] := projT2 (cid (h z)) Dz. + - move=> z Dz; exists z => //; apply: nbhs_singleton. + by have [] := projT2 (cid (h z)) Dz. +exists [fset h' z | z in fs]%fset. + move=> U/imfsetP [z /=] /fsD /set_mem Dz ->; rewrite inE. + by have [] := projT2 (cid (h z)) Dz. +rewrite eqEsubset; split => z. + case=> y /imfsetP [x /= /fsD/set_mem Dx ->]; move: z. + by have [] := projT2 (cid (h x)) Dx. +move=> /DsubC /= [y /= yfs hyz]; exists (h' y) => //. +by rewrite set_imfset /=; exists y. +Qed. + +Section set_nbhs. +Context {T : topologicalType} (A : set T). + +Definition set_nbhs := \bigcap_(x in A) nbhs x. + +Global Instance set_nbhs_filter : Filter set_nbhs. +Proof. +split => P Q; first by exact: filterT. + by move=> Px Qx x Ax; apply: filterI; [exact: Px | exact: Qx]. +by move=> PQ + x Ax => /(_ _ Ax)/filterS; exact. +Qed. + +Global Instance set_nbhs_pfilter : A!=set0 -> ProperFilter set_nbhs. +Proof. +case=> x Ax; split; last exact: set_nbhs_filter. +by move/(_ x Ax)/nbhs_singleton. +Qed. + +Lemma set_nbhsP (B : set T) : + set_nbhs B <-> (exists C, [/\ open C, A `<=` C & C `<=` B]). +Proof. +split; first last. + by case=> V [? AV /filterS +] x /AV ?; apply; apply: open_nbhs_nbhs. +move=> snB; have Ux x : exists U, A x -> [/\ U x, open U & U `<=` B]. + have [/snB|?] := pselect (A x); last by exists point. + by rewrite nbhsE => -[V [? ? ?]]; exists V. +exists (\bigcup_(x in A) (projT1 (cid (Ux x)))); split. +- by apply: bigcup_open => x Ax; have [] := projT2 (cid (Ux x)). +- by move=> x Ax; exists x => //; have [] := projT2 (cid (Ux x)). +- by move=> x [y Ay]; have [//| _ _] := projT2 (cid (Ux y)); exact. +Qed. + +End set_nbhs. + + Section separated_topologicalType. -Variable (T : topologicalType). +Variable T : topologicalType. Implicit Types x y : T. Local Open Scope classical_set_scope. @@ -3239,14 +3682,14 @@ Lemma accessible_closed_set1 : accessible_space -> forall x, closed [set x]. Proof. move=> T1 x; rewrite -[X in closed X]setCK; apply: open_closedC. rewrite openE => y /eqP /T1 [U [oU [yU xU]]]. -rewrite /interior nbhsE /=; exists U; split; last by rewrite subsetC1. -by split=> //; rewrite inE in yU. +rewrite /interior nbhsE /=; exists U; last by rewrite subsetC1. +by split=> //; exact: set_mem. Qed. Lemma accessible_kolmogorov : accessible_space -> kolmogorov_space. Proof. move=> T1 x y /T1 [A [oA [xA yA]]]; exists A; left; split=> //. -by rewrite nbhsE inE; exists A; do !split=> //; rewrite inE in xA. +by rewrite nbhsE inE; exists A => //; rewrite inE in xA. Qed. Lemma accessible_finite_set_closed : @@ -3287,7 +3730,7 @@ Lemma close_refl x : close x x. Proof. exact: (@cvg_close (nbhs x)). Qed. Hint Resolve close_refl : core. -Lemma close_cvg (F1 F2 : set (set T)) {FF2 : ProperFilter F2} : +Lemma close_cvg (F1 F2 : set_system T) {FF2 : ProperFilter F2} : F1 --> F2 -> F2 --> F1 -> close (lim F1) (lim F2). Proof. move=> F12 F21. @@ -3317,13 +3760,13 @@ Lemma open_hausdorff : hausdorff_space T = [/\ open AB.1, open AB.2 & AB.1 `&` AB.2 == set0]. Proof. rewrite propeqE; split => [T_filterT2|T_openT2] x y. - have := @contra_not _ _ (T_filterT2 x y); rewrite (rwP eqP) (rwP negP). (* change @contra_not _ _ to contra_not when requiring MathComp > 1.14 *) + have := contra_not (T_filterT2 x y); rewrite (rwP eqP) (rwP negP). move=> /[apply] /asboolPn/existsp_asboolPn[A]; rewrite -existsNE => -[B]. rewrite [nbhs _ _ -> _](rwP imply_asboolP) => /negP. rewrite asbool_imply !negb_imply => /andP[/asboolP xA] /andP[/asboolP yB]. move=> /asboolPn; rewrite -set0P => /negP; rewrite negbK => /eqP AIB_eq0. move: xA yB; rewrite !nbhsE. - move=> - [oA [[oA_open oAx] oAA]] [oB [[oB_open oBx] oBB]]. + move=> - [oA [oA_open oAx] oAA] [oB [oB_open oBx] oBB]. by exists (oA, oB); rewrite ?inE; split => //; apply: subsetI_eq0 AIB_eq0. apply: contraPP => /eqP /T_openT2[[/=A B]]. rewrite !inE => - [xA yB] [Aopen Bopen /eqP AIB_eq0]. @@ -3331,6 +3774,20 @@ move=> /(_ A B (open_nbhs_nbhs _) (open_nbhs_nbhs _)). by rewrite -set0P => /(_ _ _)/negP; apply. Qed. +Definition hausdorff_accessible : hausdorff_space T -> accessible_space. +Proof. +rewrite open_hausdorff => hsdfT => x y /hsdfT [[U V] [xU yV]] [/= ? ? /eqP]. +rewrite setIC => /disjoints_subset VUc; exists U; repeat split => //. +by rewrite inE; apply: VUc; rewrite -inE. +Qed. + +Definition normal_space := + forall A : set T, closed A -> + filter_from (set_nbhs A) closure `=>` set_nbhs A. + +Definition regular_space := + forall a : T, filter_from (nbhs a) closure --> a. + Hypothesis sep : hausdorff_space T. Lemma closeE x y : close x y = (x = y). @@ -3342,13 +3799,14 @@ Qed. Lemma close_eq x y : close x y -> x = y. Proof. by rewrite closeE. Qed. + Lemma cvg_unique {F} {FF : ProperFilter F} : is_subset1 [set x : T | F --> x]. Proof. move=> Fx Fy; rewrite -closeE //; exact: (@cvg_close F). Qed. Lemma cvg_eq x y : x --> y -> x = y. Proof. by rewrite -closeE //; apply: cvg_close. Qed. -Lemma lim_id x : lim x = x. +Lemma lim_id x : lim (nbhs x) = x. Proof. by apply/esym/cvg_eq/cvg_ex; exists x. Qed. Lemma cvg_lim {U : Type} {F} {FF : ProperFilter F} (f : U -> T) (l : T) : @@ -3374,12 +3832,33 @@ Proof. move=> f_prop fl; apply: get_unique => // l' fl'; exact: cvgi_unique _ fl' fl. Qed. +Lemma compact_regular (x : T) V : compact V -> nbhs x V -> {for x, regular_space}. +Proof. +move=> cptv Vx; apply: (@compact_cluster_set1 T x _ V) => //. +- apply: filter_from_proper => //; first last. + by move=> ? /nbhs_singleton/subset_closure ?; exists x. + apply: filter_from_filter; first by exists setT; exact: filterT. + move=> P Q Px Qx; exists (P `&` Q); [exact: filterI | exact: closureI]. +- by exists V => //; have /closure_id <- : closed V by exact: compact_closed. +rewrite eqEsubset; split; first last. + move=> _ -> A B [C Cx CA /nbhs_singleton Bx]; exists x; split => //. + by apply/CA/subset_closure; exact: nbhs_singleton. +move=> y /=; apply: contraPeq; move: sep; rewrite open_hausdorff => /[apply]. +move=> [[B A]]/=; rewrite ?inE; case=> By Ax [oB oA BA0]. +apply/existsNP; exists (closure A); apply/existsNP; exists B; apply/not_implyP. +split; first by exists A => //; exact: open_nbhs_nbhs. +apply/not_implyP; split; first exact: open_nbhs_nbhs. +apply/set0P/negP; rewrite negbK; apply/eqP/disjoints_subset. +have /closure_id -> : closed (~` B); first by exact: open_closedC. +by apply/closure_subset/disjoints_subset; rewrite setIC. +Qed. + End separated_topologicalType. #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `cvg_lim`")] -Notation cvg_map_lim := cvg_lim. +Notation cvg_map_lim := cvg_lim (only parsing). #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed to `cvgi_lim`")] -Notation cvgi_map_lim := cvgi_lim. +Notation cvgi_map_lim := cvgi_lim (only parsing). Section connected_sets. Variable T : topologicalType. @@ -3408,7 +3887,7 @@ Lemma connectedPn A : ~ connected A <-> exists E : bool -> set T, [/\ forall b, E b !=set0, A = E false `|` E true & separated (E false) (E true)]. Proof. -rewrite -propeqE; apply notLR; rewrite propeqE. +rewrite -propeqE; apply: notLR; rewrite propeqE. split=> [conE [E [E0 EU [E1 E2]]]|conE B B0 [C oC BAC] [D cD BAD]]. suff : E true = A. move/esym/(congr1 (setD^~ (closure (E true)))); rewrite EU setDUl. @@ -3431,7 +3910,7 @@ exists (fun i => if i is false then A `\` C else A `&` C); split. + rewrite setIC; apply/disjoints_subset; rewrite closureC => x [? ?]. by exists C => //; split=> //; rewrite setDE setCI setCK; right. + apply/disjoints_subset => y -[Ay Cy]. - rewrite -BAC BAD=> /closureI[_]; rewrite -(proj1 (@closure_id _ _) cD)=> Dy. + rewrite -BAC BAD => /closureI[_]; move/closure_id : cD => <- Dy. by have : B y; [by rewrite BAD; split|rewrite BAC => -[]]. Qed. @@ -3500,6 +3979,20 @@ move=> [x [Ax Bx]] Ac Bc; rewrite -bigcup2inE; apply: bigcup_connected. by move=> [|[|[]]]. Qed. +Lemma connected_closure A : connected A -> connected (closure A). +Proof. +move=> ctdA U U0 [C1 oC1 C1E] [C2 cC2 C2E]; rewrite eqEsubset C2E; split => //. +suff : A `<=` U. + move/closure_subset; rewrite [_ `&` _](iffLR (closure_id _)) ?C2E//. + by apply: closedI => //; exact: closed_closure. +rewrite -setIidPl; apply: ctdA. +- move: U0; rewrite C1E => -[z [clAx C1z]]; have [] := clAx C1. + exact: open_nbhs_nbhs. + by move=> w [Aw C1w]; exists w; rewrite setIA (setIidl (@subset_closure _ _)). +- by exists C1 => //; rewrite C1E setIA (setIidl (@subset_closure _ _)). +- by exists C2 => //; rewrite C2E setIA (setIidl (@subset_closure _ _)). +Qed. + Definition connected_component (A : set T) (x : T) := \bigcup_(A in [set C : set T | [/\ C x, C `<=` A & connected C]]) A. @@ -3553,10 +4046,31 @@ move=> Axy; apply/seteqP; split => z; apply: connected_component_trans => //. by apply: connected_component_sym. Qed. +Lemma component_closed A x : closed A -> closed (connected_component A x). +Proof. +move=> clA; have [Ax|Ax] := pselect (A x); first last. + by rewrite connected_component_out //; exact: closed0. +rewrite closure_id eqEsubset; split; first exact: subset_closure. +move=> z Axz; exists (closure (connected_component A x)) => //. +split; first exact/subset_closure/connected_component_refl. + rewrite [X in _ `<=` X](closure_id A).1//. + by apply: closure_subset; exact: connected_component_sub. +by apply: connected_closure; exact: component_connected. +Qed. + +Lemma clopen_separatedP A : clopen A <-> separated A (~` A). +Proof. +split=> [[oA cA]|[] /[!(@disjoints_subset T)] /[!(@setCK T)] clAA AclA]. + rewrite /separated -((closure_id A).1 cA) setICr ; split => //. + by rewrite -((closure_id _).1 (open_closedC oA)) setICr. +split; last by rewrite closure_id eqEsubset; split => //; exact: subset_closure. +by rewrite -closedC closure_id eqEsubset; split; + [exact: subset_closure|exact: subsetCr]. +Qed. + End connected_sets. Arguments connected {T}. Arguments connected_component {T}. - Section DiscreteTopology. Section DiscreteMixin. Context {X : Type}. @@ -3568,13 +4082,9 @@ Lemma discrete_nbhs (p : X) (A : set X) : principal_filter p A -> principal_filter p (principal_filter^~ A). Proof. by move=> ?; exact/principal_filterP. Qed. -Definition discrete_topological_mixin := - topologyOfFilterMixin principal_filter_proper discrete_sing discrete_nbhs. - End DiscreteMixin. -Definition discrete_space (X : topologicalType) := - @nbhs X _ = @principal_filter X. +Definition discrete_space (X : nbhsType) := @nbhs X _ = @principal_filter X. Context {X : topologicalType} {dsc: discrete_space X}. @@ -3584,15 +4094,15 @@ by rewrite openE => ? ?; rewrite /interior dsc; exact/principal_filterP. Qed. Lemma discrete_set1 (x : X) : nbhs x [set x]. -Proof. by apply open_nbhs_nbhs; split => //; exact: discrete_open. Qed. +Proof. by apply: open_nbhs_nbhs; split => //; exact: discrete_open. Qed. Lemma discrete_closed (A : set X) : closed A. Proof. by rewrite -[A]setCK closedC; exact: discrete_open. Qed. -Lemma discrete_cvg (F : set (set X)) (x : X) : +Lemma discrete_cvg (F : set_system X) (x : X) : Filter F -> F --> x <-> F [set x]. Proof. -rewrite /filter_of dsc nbhs_simpl; split; first by exact. +rewrite dsc nbhs_simpl; split; first by exact. by move=> Fx U /principal_filterP ?; apply: filterS Fx => ? ->. Qed. @@ -3601,10 +4111,10 @@ Proof. by move=> p q /(_ _ _ (discrete_set1 p) (discrete_set1 q))[x [] -> ->]. Qed. -Canonical bool_discrete_topology : topologicalType := - TopologicalType bool discrete_topological_mixin. +HB.instance Definition _ := Nbhs_isNbhsTopological.Build bool + principal_filter_proper discrete_sing discrete_nbhs. -Lemma discrete_bool : discrete_space bool_discrete_topology. +Lemma discrete_bool : discrete_space [the topologicalType of bool : Type]. Proof. by []. Qed. Lemma bool_compact : compact [set: bool]. @@ -3626,160 +4136,212 @@ split. case=> _; rewrite eqEsubset; case=> _ + x Ox => /(_ x I [set x]). by case; [by apply: open_nbhs_nbhs; split |] => y [+ _] => /[swap] -> /eqP. move=> NOx; split; [exact: closedT |]; rewrite eqEsubset; split => x // _. -move=> U; rewrite nbhsE; case=> V [][] oV Vx VU. +move=> U; rewrite nbhsE; case=> V [] oV Vx VU. have Vnx: V != [set x] by apply/eqP => M; apply: (NOx x); rewrite -M. have /existsNP [y /existsNP [Vy Ynx]] : ~ forall y, V y -> y = x. - move/negP: Vnx; apply: contra_not => Vxy; apply/eqP; rewrite eqEsubset. - by split => // ? ->. + move/negP: Vnx; apply: contra_not => Vxy; apply/eqP; rewrite eqEsubset. + by split => // ? ->. by exists y; split => //; [exact/eqP | exact: VU]. Qed. Lemma perfect_prod {I : Type} (i : I) (K : I -> topologicalType) : - perfect_set [set: K i] -> perfect_set [set: product_topologicalType K]. + perfect_set [set: K i] -> perfect_set [set: prod_topology K]. Proof. move=> /perfectTP KPo; apply/perfectTP => f oF; apply: (KPo (f i)). rewrite (_ : [set f i] = proj i @` [set f]). - by apply: (@proj_open (classicType_choiceType I) _ i); exact: oF. + by apply: (@proj_open {classic I} _ i); exact: oF. by rewrite eqEsubset; split => ? //; [move=> -> /=; exists f | case=> g ->]. Qed. -Lemma perfect_diagonal (K : nat_topologicalType -> topologicalType) : +Lemma perfect_diagonal (K : nat -> topologicalType) : (forall i, exists (xy: K i * K i), xy.1 != xy.2) -> - perfect_set [set: product_topologicalType K]. + perfect_set [set: prod_topology K]. Proof. -move=> npts; split; [exact: closedT|]; rewrite eqEsubset; split => f // _. +move=> npts; split; first exact: closedT. +rewrite eqEsubset; split => f // _. pose distincts (i : nat) := projT1 (sigW (npts i)). pose derange (i : nat) (z : K i) := if z == (distincts i).1 then (distincts i).2 else (distincts i).1. pose g (N i : nat) := if (i < N)%nat then f i else derange _ (f i). -have gcvg : g @ \oo --> (f : product_topologicalType K). - apply/(@cvg_sup (product_topologicalType K)) => N U [V] [[W] oW <-] [] WfN WU. +have gcvg : g @ \oo --> f. + apply/cvg_sup => N U [V] [[W] oW <-] WfN WU. by apply: (filterS WU); rewrite nbhs_simpl /g; exists N.+1 => // i /= ->. move=> A /gcvg; rewrite nbhs_simpl; case=> N _ An. exists (g N); split => //; last by apply: An; rewrite /= ?leqnn //. apply/eqP => M; suff: g N N != f N by rewrite M; move/eqP. rewrite /g ltnn /derange eq_sym; case: (eqVneq (f N) (distincts N).1) => //. -by move=> ->; have := projT2 (sigW (npts N)). +by move=> ->; have := projT2 (sigW (npts N)). +Qed. + +Lemma perfect_set2 {T} : perfect_set [set: T] <-> + forall (U : set T), open U -> U !=set0 -> + exists x y, [/\ U x, U y & x != y] . +Proof. +apply: iff_trans; first exact: perfectTP; split. + move=> nx1 U oU [] x Ux; exists x. + have : U <> [set x] by move=> Ux1; apply: (nx1 x); rewrite -Ux1. + apply: contra_notP; move/not_existsP/contrapT=> Uyx; rewrite eqEsubset. + (split => //; last by move=> ? ->); move=> y Uy; have /not_and3P := Uyx y. + by case => // /negP; rewrite negbK => /eqP ->. +move=> Unxy x Ox; have [] := Unxy _ Ox; first by exists x. +by move=> y [] ? [->] -> /eqP. Qed. End perfect_sets. -(** * Uniform spaces *) +Section totally_disconnected. +Implicit Types T : topologicalType. + +Definition totally_disconnected {T} (A : set T) := + forall x, A x -> connected_component A x = [set x]. + +Definition zero_dimensional T := + (forall x y, x != y -> exists U : set T, [/\ clopen U, U x & ~ U y]). + +Lemma zero_dimension_prod (I : choiceType) (T : I -> topologicalType) : + (forall i, zero_dimensional (T i)) -> + zero_dimensional (prod_topology T). +Proof. +move=> dctTI x y /eqP xneqy. +have [i/eqP/dctTI [U [clU Ux nUy]]] : exists i, x i <> y i. + by apply/existsNP=> W; exact/xneqy/functional_extensionality_dep. +exists (proj i @^-1` U); split => //; apply: clopen_comp => //. +exact/proj_continuous. +Qed. + +Lemma discrete_zero_dimension {T} : discrete_space T -> zero_dimensional T. +Proof. +move=> dctT x y xny; exists [set x]; split => //; last exact/nesym/eqP. +by split; [exact: discrete_open | exact: discrete_closed]. +Qed. + +Lemma zero_dimension_totally_disconnected {T} : + zero_dimensional T -> totally_disconnected [set: T]. +Proof. +move=> zdA x _; rewrite eqEsubset. +split=> [z [R [Rx _ ctdR Rz]]|_ ->]; last exact: connected_component_refl. +apply: contrapT => /eqP znx; have [U [[oU cU] Uz Ux]] := zdA _ _ znx. +suff : R `&` U = R by move: Rx => /[swap] <- []. +by apply: ctdR; [exists z|exists U|exists U]. +Qed. + +Lemma totally_disconnected_cvg {T : topologicalType} (x : T) : + hausdorff_space T -> zero_dimensional T -> compact [set: T] -> + filter_from [set D : set T | D x /\ clopen D] id --> x. +Proof. +pose F := filter_from [set D : set T | D x /\ clopen D] id. +have FF : Filter F. + apply: filter_from_filter; first by exists setT; split => //; exact: clopenT. + by move=> A B [? ?] [? ?]; exists (A `&` B) => //; split=> //; exact: clopenI. +have PF : ProperFilter F by apply: filter_from_proper; move=> ? [? _]; exists x. +move=> hsdfT zdT cmpT U Ux; rewrite nbhs_simpl -/F. +wlog oU : U Ux / open U. + move: Ux; rewrite /= nbhsE => -[] V [? ?] /filterS + /(_ V) P. + by apply; apply: P => //; exists V. +have /(iffLR (compact_near_coveringP _)) : compact (~` U). + by apply: (subclosed_compact _ cmpT) => //; exact: open_closedC. +move=> /(_ _ _ setC (powerset_filter_from_filter PF))[]. + move=> y nUy; have /zdT [C [[oC cC] Cx Cy]] : x != y. + by apply: contra_notN nUy => /eqP <-; exact: nbhs_singleton. + exists (~` C, [set U | U `<=` C]); first split. + - by apply: open_nbhs_nbhs; split => //; exact: closed_openC. + - apply/near_powerset_filter_fromP; first by move=> ? ?; exact: subset_trans. + by exists C => //; exists C. + - by case=> i j [? /subsetC]; apply. +by move=> D [DF _ [C DC]]/(_ _ DC)/subsetC2/filterS; apply; exact: DF. +Qed. + +End totally_disconnected. + +(** Uniform spaces *) Local Notation "A ^-1" := ([set xy | A (xy.2, xy.1)]) : classical_set_scope. Local Notation "'to_set' A x" := ([set y | A (x, y)]) (at level 0, A at level 0) : classical_set_scope. -Definition nbhs_ {T T'} (ent : set (set (T * T'))) (x : T) := +Definition nbhs_ {T T'} (ent : set_system (T * T')) (x : T) := filter_from ent (fun A => to_set A x). -Lemma nbhs_E {T T'} (ent : set (set (T * T'))) x : +Lemma nbhs_E {T T'} (ent : set_system (T * T')) x : nbhs_ ent x = filter_from ent (fun A => to_set A x). Proof. by []. Qed. -Module Uniform. - -Record mixin_of (M : Type) (nbhs : M -> set (set M)) := Mixin { - entourage : (M * M -> Prop) -> Prop ; - ax1 : Filter entourage ; - ax2 : forall A, entourage A -> [set xy | xy.1 = xy.2] `<=` A ; - ax3 : forall A, entourage A -> entourage (A^-1)%classic ; - ax4 : forall A, entourage A -> exists2 B, entourage B & B \; B `<=` A ; - ax5 : nbhs = nbhs_ entourage +HB.mixin Record Nbhs_isUniform_mixin M of Nbhs M := { + entourage : set_system (M * M); + entourage_filter : Filter entourage; + entourage_refl_subproof : forall A, entourage A -> [set xy | xy.1 = xy.2] `<=` A; + entourage_inv_subproof : forall A, entourage A -> entourage (A^-1)%classic; + entourage_split_ex_subproof : + forall A, entourage A -> exists2 B, entourage B & B \; B `<=` A; + nbhsE_subproof : nbhs = nbhs_ entourage; }. -Record class_of (M : Type) := Class { - base : Topological.class_of M; - mixin : mixin_of (Filtered.nbhs_op base) +#[short(type="uniformType")] +HB.structure Definition Uniform := + {T of Topological T & Nbhs_isUniform_mixin T}. + +HB.factory Record Nbhs_isUniform M of Nbhs M := { + entourage : set_system (M * M); + entourage_filter : Filter entourage; + entourage_refl : forall A, entourage A -> [set xy | xy.1 = xy.2] `<=` A; + entourage_inv : forall A, entourage A -> entourage (A^-1)%classic; + entourage_split_ex : + forall A, entourage A -> exists2 B, entourage B & B \; B `<=` A; + nbhsE : nbhs = nbhs_ entourage; }. -Section ClassDef. - -Structure type := Pack { sort; _ : class_of sort }. -Local Coercion sort : type >-> Sortclass. -Variables (T : Type) (cT : type). -Definition class := let: Pack _ c := cT return class_of cT in c. - -Definition clone c of phant_id class c := @Pack T c. -Let xT := let: Pack T _ := cT in T. -Notation xclass := (class : class_of xT). -Local Coercion base : class_of >-> Topological.class_of. -Local Coercion mixin : class_of >-> mixin_of. - -Definition pack nbhs (m : @mixin_of T nbhs) := - fun bT (b : Topological.class_of T) of phant_id (@Topological.class bT) b => - fun m' of phant_id m (m' : @mixin_of T (Filtered.nbhs_op b)) => - @Pack T (@Class _ b m'). - -Definition eqType := @Equality.Pack cT xclass. -Definition choiceType := @Choice.Pack cT xclass. -Definition pointedType := @Pointed.Pack cT xclass. -Definition filteredType := @Filtered.Pack cT cT xclass. -Definition topologicalType := @Topological.Pack cT xclass. - -End ClassDef. - -Module Exports. - -Coercion sort : type >-> Sortclass. -Coercion base : class_of >-> Topological.class_of. -Coercion mixin : class_of >-> mixin_of. -Coercion eqType : type >-> Equality.type. -Canonical eqType. -Coercion choiceType : type >-> Choice.type. -Canonical choiceType. -Coercion pointedType : type >-> Pointed.type. -Canonical pointedType. -Coercion filteredType : type >-> Filtered.type. -Canonical filteredType. -Coercion topologicalType : type >-> Topological.type. -Canonical topologicalType. -Notation uniformType := type. -Notation UniformType T m := (@pack T _ m _ _ idfun _ idfun). -Notation UniformMixin := Mixin. -Notation "[ 'uniformType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) - (at level 0, format "[ 'uniformType' 'of' T 'for' cT ]") : form_scope. -Notation "[ 'uniformType' 'of' T ]" := (@clone T _ _ id) - (at level 0, format "[ 'uniformType' 'of' T ]") : form_scope. - -End Exports. - -End Uniform. - -Export Uniform.Exports. - -Section UniformTopology. - -Program Definition topologyOfEntourageMixin (T : Type) - (nbhs : T -> set (set T)) (m : Uniform.mixin_of nbhs) : - Topological.mixin_of nbhs := topologyOfFilterMixin _ _ _. -Next Obligation. -move=> T nbhsT m p. -rewrite (Uniform.ax5 m) nbhs_E; apply filter_from_proper; last first. - by move=> A entA; exists p; apply: Uniform.ax2 entA _ _. +HB.builders Context M of Nbhs_isUniform M. + +Lemma nbhs_filter (p : M) : ProperFilter (nbhs p). +Proof. +rewrite nbhsE nbhs_E; apply filter_from_proper; last first. + by move=> A entA; exists p; apply: entourage_refl entA _ _. apply: filter_from_filter. - by exists setT; apply: @filterT (Uniform.ax1 m). + by exists setT; apply: @filterT entourage_filter. move=> A B entA entB; exists (A `&` B) => //. -exact: (@filterI _ _ (Uniform.ax1 m)). +exact: (@filterI _ _ entourage_filter). Qed. -Next Obligation. -move=> T nbhsT m p A; rewrite (Uniform.ax5 m) nbhs_E => - [B entB sBpA]. -by apply: sBpA; apply: Uniform.ax2 entB _ _. + +Lemma nbhs_singleton (p : M) A : nbhs p A -> A p. +Proof. +rewrite nbhsE nbhs_E => - [B entB sBpA]. +by apply: sBpA; apply: entourage_refl entB _ _. Qed. -Next Obligation. -move=> T nbhsT m p A; rewrite (Uniform.ax5 m) nbhs_E => - [B entB sBpA]. -have /Uniform.ax4 [C entC sC2B] := entB. + +Lemma nbhs_nbhs (p : M) A : nbhs p A -> nbhs p (nbhs^~ A). +Proof. +rewrite nbhsE nbhs_E => - [B entB sBpA]. +have /entourage_split_ex[C entC sC2B] := entB. exists C => // q Cpq; rewrite nbhs_E; exists C => // r Cqr. by apply/sBpA/sC2B; exists q. Qed. -End UniformTopology. +HB.instance Definition _ := Nbhs_isNbhsTopological.Build M + nbhs_filter nbhs_singleton nbhs_nbhs. -Definition entourage {M : uniformType} := Uniform.entourage (Uniform.class M). +HB.instance Definition _ := Nbhs_isUniform_mixin.Build M + entourage_filter entourage_refl entourage_inv entourage_split_ex nbhsE. + +HB.end. + +HB.factory Record isUniform M of Pointed M := { + entourage : set_system (M * M); + entourage_filter : Filter entourage; + entourage_refl : forall A, entourage A -> [set xy | xy.1 = xy.2] `<=` A; + entourage_inv : forall A, entourage A -> entourage (A^-1)%classic; + entourage_split_ex : + forall A, entourage A -> exists2 B, entourage B & B \; B `<=` A; +}. + +HB.builders Context M of isUniform M. + HB.instance Definition _ := @hasNbhs.Build M (nbhs_ entourage). + HB.instance Definition _ := @Nbhs_isUniform.Build M entourage + entourage_filter entourage_refl entourage_inv entourage_split_ex erefl. +HB.end. Lemma nbhs_entourageE {M : uniformType} : nbhs_ (@entourage M) = nbhs. -Proof. by case: M=> [?[?[]]]. Qed. +Proof. by rewrite -Nbhs_isUniform_mixin.nbhsE_subproof. Qed. Lemma entourage_sym {X Y : Type} E (x : X) (y : Y) : E (x, y) <-> (E ^-1)%classic (y, x). @@ -3794,32 +4356,42 @@ Definition nbhs_simpl := (nbhs_simpl,@filter_from_entourageE,@nbhs_entourageE). End NbhsEntourage. -Lemma nbhsP {M : uniformType} (x : M) P : - nbhs x P <-> nbhs_ entourage x P. +Lemma nbhsP {M : uniformType} (x : M) P : nbhs x P <-> nbhs_ entourage x P. Proof. by rewrite nbhs_simpl. Qed. +Lemma filter_inv {T : Type} (F : set (set (T * T))) : + Filter F -> Filter [set (V^-1)%classic | V in F]. +Proof. +move=> FF; split => /=. +- by exists [set: T * T] => //; exact: filterT. +- by move=> P Q [R FR <-] [S FS <-]; exists (R `&` S) => //; exact: filterI. +- move=> P Q PQ [R FR RP]; exists Q^-1%classic => //; first last. + by rewrite eqEsubset; split; case. + by apply: filterS FR; case=> ? ? /= ?; apply: PQ; rewrite -RP. +Qed. + Section uniformType1. Context {M : uniformType}. Lemma entourage_refl (A : set (M * M)) x : entourage A -> A (x, x). -Proof. by move=> entA; apply: Uniform.ax2 entA _ _. Qed. +Proof. by move=> entA; apply: entourage_refl_subproof entA _ _. Qed. -Global Instance entourage_filter : ProperFilter (@entourage M). +Global Instance entourage_pfilter : ProperFilter (@entourage M). Proof. -apply Build_ProperFilter; last exact: Uniform.ax1. +apply Build_ProperFilter; last exact: entourage_filter. by move=> A entA; exists (point, point); apply: entourage_refl. Qed. -Lemma entourageT : entourage (@setT (M * M)). +Lemma entourageT : entourage [set: M * M]. Proof. exact: filterT. Qed. Lemma entourage_inv (A : set (M * M)) : entourage A -> entourage (A^-1)%classic. -Proof. exact: Uniform.ax3. Qed. +Proof. exact: entourage_inv_subproof. Qed. Lemma entourage_split_ex (A : set (M * M)) : entourage A -> exists2 B, entourage B & B \; B `<=` A. -Proof. exact: Uniform.ax4. Qed. +Proof. exact: entourage_split_ex_subproof. Qed. Definition split_ent (A : set (M * M)) := get (entourage `&` [set B | B \; B `<=` A]). @@ -3877,17 +4449,46 @@ Arguments entourage_split {M} z {x y A}. #[global] Hint Extern 0 (nbhs _ (to_set _ _)) => exact: nbhs_entourage : core. +Lemma ent_closure {M : uniformType} (x : M) E : entourage E -> + closure (to_set (split_ent E) x) `<=` to_set E x. +Proof. +pose E' := (split_ent E) `&` ((split_ent E)^-1)%classic. +move=> entE z /(_ [set y | E' (z, y)])[]. + by rewrite -nbhs_entourageE; exists E' => //; exact: filterI. +by move=> y [/=] + [_]; exact: entourage_split. +Qed. + Lemma continuous_withinNx {U V : uniformType} (f : U -> V) x : {for x, continuous f} <-> f @ x^' --> f x. Proof. split=> - cfx P /= fxP. - rewrite /dnbhs !near_simpl near_withinE. - by rewrite /dnbhs; apply: cvg_within; apply: cfx. + by rewrite !near_simpl; apply: cvg_within; apply: cfx. rewrite !nbhs_nearE !near_map !near_nbhs in fxP *; have /= := cfx P fxP. rewrite !near_simpl near_withinE near_simpl => Pf; near=> y. by have [->|] := eqVneq y x; [by apply: nbhs_singleton|near: y]. Unshelve. all: by end_near. Qed. +(* This property is primarily useful only for metrizability on uniform spaces *) +Definition countable_uniformity (T : uniformType) := + exists R : set (set (T * T)), [/\ + countable R, + R `<=` entourage & + forall P, entourage P -> exists2 Q, R Q & Q `<=` P]. + +Lemma countable_uniformityP {T : uniformType} : + countable_uniformity T <-> exists2 f : nat -> set (T * T), + (forall A, entourage A -> exists N, f N `<=` A) & + (forall n, entourage (f n)). +Proof. +split=> [[M []]|[f fsubE entf]]. + move=> /pfcard_geP[-> _ /(_ _ entourageT)[]//|/unsquash f eM Msub]. + exists f; last by move=> n; apply: eM; exact: funS. + by move=> ? /Msub [Q + ?] => /(@surj _ _ _ _ f)[n _ fQ]; exists n; rewrite fQ. +exists (range f); split; first exact: card_image_le. + by move=> E [n _] <-; exact: entf. +by move=> E /fsubE [n fnA]; exists (f n) => //; exists n. +Qed. + Section uniform_closeness. Variable (U : uniformType). @@ -3925,7 +4526,7 @@ apply: (entourage_split x) => //. by have := cxy _ (entourage_inv (entourage_split_ent entA)). Qed. -Lemma cvg_closeP (F : set (set U)) (l : U) : ProperFilter F -> +Lemma cvg_closeP (F : set_system U) (l : U) : ProperFilter F -> F --> l <-> ([cvg F in U] /\ close (lim F) l). Proof. move=> FF; split=> [Fl|[cvF]Cl]. @@ -3960,10 +4561,10 @@ Qed. Lemma prod_ent_filter : Filter prod_ent. Proof. -have prodF := filter_prod_filter (@entourage_filter U) (@entourage_filter V). +have prodF := filter_prod_filter (@entourage_pfilter U) (@entourage_pfilter V). split; rewrite /prod_ent; last 1 first. - by move=> A B sAB /=; apply: filterS => ? [xy /sAB ??]; exists xy. -- rewrite -setMTT; apply: prod_entP filterT filterT. +- by rewrite -setMTT; apply: prod_entP filterT filterT. move=> A B /= entA entB; apply: filterS (filterI entA entB) => xy []. move=> [zt Azt ztexy] [zt' Bzt' zt'exy]; exists zt => //; split=> //. move/eqP: ztexy; rewrite -zt'exy !xpair_eqE. @@ -4016,15 +4617,11 @@ move=> [zt Bzt /eqP]; rewrite !xpair_eqE andbACA -!xpair_eqE. by rewrite /= -!surjective_pairing => /eqP<-. Qed. -Definition prod_uniformType_mixin := - Uniform.Mixin prod_ent_filter prod_ent_refl prod_ent_inv prod_ent_split - prod_ent_nbhsE. +HB.instance Definition _ := Nbhs_isUniform.Build (U * V)%type + prod_ent_filter prod_ent_refl prod_ent_inv prod_ent_split prod_ent_nbhsE. End prod_Uniform. -Canonical prod_uniformType (U V : uniformType) := - UniformType (U * V) (@prod_uniformType_mixin U V). - (** matrices *) Section matrix_Uniform. @@ -4090,16 +4687,12 @@ move=> [B [C entC sCB] sBA]; exists (fun i j => to_set (C i j) (M i j)). by move=> N CMN; apply/sBA/sCB. Qed. -Definition matrix_uniformType_mixin := - Uniform.Mixin mx_ent_filter mx_ent_refl mx_ent_inv mx_ent_split - mx_ent_nbhsE. - -Canonical matrix_uniformType := - UniformType 'M[T]_(m, n) matrix_uniformType_mixin. +HB.instance Definition _ := Nbhs_isUniform.Build 'M[T]_(m, n) + mx_ent_filter mx_ent_refl mx_ent_inv mx_ent_split mx_ent_nbhsE. End matrix_Uniform. -Lemma cvg_mx_entourageP (T : uniformType) m n (F : set (set 'M[T]_(m,n))) +Lemma cvg_mx_entourageP (T : uniformType) m n (F : set_system 'M[T]_(m,n)) (FF : Filter F) (M : 'M[T]_(m,n)) : F --> M <-> forall A, entourage A -> \forall N \near F, @@ -4118,6 +4711,61 @@ Unshelve. all: by end_near. Qed. (** Functional metric spaces *) +Definition map_pair {S U} (f : S -> U) (x : (S * S)) : (U * U) := + (f x.1, f x.2). + +Section weak_uniform. + +Variable (pS : pointedType) (U : uniformType) (f : pS -> U). + +Let S := weak_topology f. + +Definition weak_ent : set_system (S * S) := + filter_from (@entourage U) (fun V => (map_pair f)@^-1` V). + +Lemma weak_ent_filter : Filter weak_ent. +Proof. +apply: filter_from_filter; first by exists setT; exact: entourageT. +by move=> P Q ??; (exists (P `&` Q); first exact: filterI) => ?. +Qed. + +Lemma weak_ent_refl A : weak_ent A -> [set fg | fg.1 = fg.2] `<=` A. +Proof. +by move=> [B ? sBA] [x y] /= ->; apply/sBA; exact: entourage_refl. +Qed. + +Lemma weak_ent_inv A : weak_ent A -> weak_ent (A^-1)%classic. +Proof. +move=> [B ? sBA]; exists (B^-1)%classic; first exact: entourage_inv. +by move=> ??; exact/sBA. +Qed. + +Lemma weak_ent_split A : weak_ent A -> exists2 B, weak_ent B & B \; B `<=` A. +Proof. +move=> [B entB sBA]; have : exists C, entourage C /\ C \; C `<=` B. + exact/exists2P/entourage_split_ex. +case=> C [entC CsubB]; exists ((map_pair f)@^-1` C); first by exists C. +by case=> x y [a ? ?]; apply/sBA/CsubB; exists (f a). +Qed. + +Lemma weak_ent_nbhs : nbhs = nbhs_ weak_ent. +Proof. +rewrite predeq2E => x V; split. + case=> [? [[B ? <-] ? BsubV]]; have: nbhs (f x) B by apply: open_nbhs_nbhs. + move=> /nbhsP [W ? WsubB]; exists ((map_pair f) @^-1` W); first by exists W. + by move=>??; exact/BsubV/WsubB. +case=> W [V' entV' V'subW] /filterS; apply. +have : nbhs (f x) to_set V' (f x) by apply/nbhsP; exists V'. +rewrite (@nbhsE U) => [[O [openU Ofx Osub]]]. +(exists (f @^-1` O); repeat split => //); first by exists O => //. +by move=> w ? ; apply: V'subW; exact: Osub. +Qed. + +HB.instance Definition _ := @Nbhs_isUniform.Build (weak_topology f) (*S nbhs*) + weak_ent weak_ent_filter weak_ent_refl weak_ent_inv weak_ent_split weak_ent_nbhs. + +End weak_uniform. + Section fct_Uniform. Variable (T : choiceType) (U : uniformType). @@ -4158,21 +4806,17 @@ move=> fg [h spBfh spBhg]. by apply: sBA => t; apply: entourage_split (spBfh t) (spBhg t). Qed. -Definition fct_uniformType_mixin := - UniformMixin fct_ent_filter fct_ent_refl fct_ent_inv fct_ent_split erefl. - -Definition fct_topologicalTypeMixin := - topologyOfEntourageMixin fct_uniformType_mixin. - -Canonical generic_source_filter := @Filtered.Source _ _ _ (nbhs_ fct_ent). -Canonical fct_topologicalType := - TopologicalType (T -> U) fct_topologicalTypeMixin. -Canonical fct_uniformType := UniformType (T -> U) fct_uniformType_mixin. +Definition arrow_uniform := isUniform.Build (T -> U) + fct_ent_filter fct_ent_refl fct_ent_inv fct_ent_split. End fct_Uniform. +Module Import DefaultUniformFun. +HB.instance Definition _ T U := @arrow_uniform T U. +End DefaultUniformFun. + Lemma cvg_fct_entourageP (T : choiceType) (U : uniformType) - (F : set (set (T -> U))) (FF : Filter F) (f : T -> U) : + (F : set_system (T -> U)) (FF : Filter F) (f : T -> U) : F --> f <-> forall A, entourage A -> \forall g \near F, forall t, A (f t, g t). @@ -4187,92 +4831,24 @@ Unshelve. all: by end_near. Qed. Definition entourage_set (U : uniformType) (A : set ((set U) * (set U))) := exists2 B, entourage B & forall PQ, A PQ -> forall p q, PQ.1 p -> PQ.2 q -> B (p,q). -Canonical set_filter_source (U : uniformType) := - @Filtered.Source Prop _ U (fun A => nbhs_ (@entourage_set U) A). - -(** * PseudoMetric spaces defined using balls *) - -Definition entourage_ {R : numDomainType} {T T'} (ball : T -> R -> set T') := - @filter_from R _ [set x | 0 < x] (fun e => [set xy | ball xy.1 e xy.2]). - -Lemma entourage_E {R : numDomainType} {T T'} (ball : T -> R -> set T') : - entourage_ ball = - @filter_from R _ [set x | 0 < x] (fun e => [set xy | ball xy.1 e xy.2]). -Proof. by []. Qed. - -Definition map_pair {S U} (f : S -> U) (x : (S * S)) : (U * U) := - (f x.1, f x.2). - -Section weak_uniform. - -Variable (pS : pointedType) (U : uniformType) (f : pS -> U). - -Let S := weak_topologicalType f. - -Definition weak_ent : set (set (S * S)) := - filter_from (@entourage U) (fun V => (map_pair f)@^-1` V). - -Lemma weak_ent_filter : Filter weak_ent. -Proof. -apply: filter_from_filter; first by exists setT; exact: entourageT. -by move=> P Q ??; (exists (P `&` Q); first exact: filterI) => ?. -Qed. - -Lemma weak_ent_refl A : weak_ent A -> [set fg | fg.1 = fg.2] `<=` A. -Proof. -by move=> [B ? sBA] [x y] /= ->; apply/sBA; exact: entourage_refl. -Qed. - -Lemma weak_ent_inv A : weak_ent A -> weak_ent (A^-1)%classic. -Proof. -move=> [B ? sBA]; exists (B^-1)%classic; first exact: entourage_inv. -by move=> ??; exact/sBA. -Qed. - -Lemma weak_ent_split A : weak_ent A -> exists2 B, weak_ent B & B \; B `<=` A. -Proof. -move=> [B entB sBA]; have : exists C, entourage C /\ C \; C `<=` B. - exact/exists2P/entourage_split_ex. -case=> C [entC CsubB]; exists ((map_pair f)@^-1` C); first by exists C. -by case=> x y [a ? ?]; apply/sBA/CsubB; exists (f a). -Qed. - -Lemma weak_ent_nbhs : nbhs = nbhs_ weak_ent. -Proof. -rewrite predeq2E => x V; split. - case=> [? [[B ? <-] [? BsubV]]]; have: nbhs (f x) B by apply: open_nbhs_nbhs. - move=> /nbhsP [W ? WsubB]; exists ((map_pair f) @^-1` W); first by exists W. - by move=>??; exact/BsubV/WsubB. -case=> W [V' entV' V'subW] /filterS; apply. -have : nbhs (f x) to_set V' (f x) by apply/nbhsP; exists V'. -rewrite (@nbhsE U) => [[O [[openU Ofx Osub]]]]. -(exists (f @^-1` O); repeat split => //); first by exists O => //. -by move=> w ? ; apply: V'subW; exact: Osub. -Qed. - -Definition weak_uniform_mixin := - @UniformMixin S nbhs weak_ent - weak_ent_filter weak_ent_refl weak_ent_inv weak_ent_split weak_ent_nbhs. - -Definition weak_uniformType := - UniformType S weak_uniform_mixin. - -End weak_uniform. +(* HB.instance Definition _ (U : uniformType) := isSource.Build Prop _ U *) +(* (fun A => nbhs_ (@entourage_set U) A). *) Section sup_uniform. -Variable (T : pointedType) (Ii : Type) (Tc : Ii -> Uniform.class_of T). +Variable (T : pointedType) (Ii : Type) (Tc : Ii -> Uniform T). -Let I : choiceType := classicType_choiceType Ii. +Let I : choiceType := {classic Ii}. Let TS := fun i => Uniform.Pack (Tc i). -Let Tt := @sup_topologicalType T I Tc. +Notation Tt := (sup_topology Tc). Let ent_of (p : I * set (T * T)) := `[< @entourage (TS p.1) p.2>]. -Let IEnt := ChoiceType {p : (I * set (T * T)) | ent_of p} (sig_choiceMixin _). +Let IEntType := {p : (I * set (T * T)) | ent_of p}. +Let IEnt : choiceType := IEntType. Local Lemma IEnt_pointT (i : I) : ent_of (i, setT). Proof. by apply/asboolP; exact: entourageT. Qed. -Definition sup_ent : (set (set (T * T))) := +Definition sup_ent : set_system (T * T) := filter_from (finI_from [set: IEnt] (fun p => (projT1 p).2)) id. Ltac IEntP := move=> [[ /= + + /[dup] /asboolP]]. @@ -4321,14 +4897,14 @@ Qed. Lemma sup_ent_nbhs : @nbhs Tt Tt = nbhs_ sup_ent. Proof. rewrite predeq2E => x V; split. - rewrite /nbhs_of_open => [[? [[B + <-] [[W BW Wx] BV]]]] => /(_ W BW) []. + move=> [/= X [[/= B + <-] [W BW Wx BV]]] => /(_ W BW) [] /=. move=> F Fsup Weq; move: Weq Wx BW => <- Fx BF. case (pselect ([set: I] = set0)) => [I0 | /eqP/set0P [i0 _]]. suff -> : V = setT by exists setT; apply: filterT; exact: sup_ent_filter. rewrite -subTset => ??; apply: BV; exists (\bigcap_(i in [set` F]) i) => //. by move=> w /Fsup/set_mem; rewrite /sup_subbase I0 bigcup_set0. have f : forall w, {p : IEnt | w \in F -> to_set ((projT1 p).2) x `<=` w}. - move=> /= v; apply cid; case (pselect (v \in F)); first last. + move=> /= v; apply: cid; case (pselect (v \in F)); first last. by move=> ?; exists (exist ent_of _ (IEnt_pointT i0)). move=> /[dup] /Fx vx /Fsup/set_mem [i _]; rewrite openE => /(_ x vx). by move=> /(@nbhsP (TS i)) [w /asboolP ent ?]; exists (exist _ (i, w) ent). @@ -4341,7 +4917,9 @@ rewrite predeq2E => x V; split. rewrite eqEsubset; split => y + z. by move=>/(_ (projT1 (f z))) => + ?; apply; apply/imfsetP; exists z. by move=> Fgy /imfsetP [/= u uF ->]; exact: Fgy. -case=> E [D [/= F FsubEnt <-] FsubE EsubV]; apply: (filterS EsubV). +case=> E [D [/= F FsubEnt <-] FsubE EsubV]. +have F_nbhs_x: Filter (nbhs x) by typeclasses eauto. +apply: (filterS EsubV). pose f : IEnt -> set T := fun w => @interior (TS (projT1 w).1) (to_set ((projT1 w).2) (x)). exists (\bigcap_(w in [set` F]) f w); repeat split. @@ -4354,145 +4932,172 @@ exists (\bigcap_(w in [set` F]) f w); repeat split. - by move=> t /= Ifwt; apply: FsubE => it /Ifwt/interior_subset. Qed. -Definition sup_uniform_mixin:= - @UniformMixin Tt nbhs - sup_ent sup_ent_filter sup_ent_refl sup_ent_inv sup_ent_split sup_ent_nbhs. - -Definition sup_uniformType := UniformType Tt sup_uniform_mixin. +HB.instance Definition _ := @Nbhs_isUniform.Build Tt sup_ent + sup_ent_filter sup_ent_refl sup_ent_inv sup_ent_split sup_ent_nbhs. + +Lemma countable_sup_ent : + countable [set: Ii] -> (forall n, countable_uniformity (TS n)) -> + countable_uniformity Tt. +Proof. +move=> Icnt countable_ent; pose f n := cid (countable_ent n). +pose g (n : Ii) : set (set (T * T)) := projT1 (f n). +have [I0 | /set0P [i0 _]] := eqVneq [set: I] set0. + exists [set setT]; split; [exact: countable1|move=> A ->; exact: entourageT|]. + move=> P [w [A _]] <- subP; exists setT => //. + apply: subset_trans subP; apply: sub_bigcap => i _ ? _. + by suff : [set: I] (projT1 i).1 by rewrite I0. +exists (finI_from (\bigcup_n g n) id); split. +- by apply/finI_from_countable/bigcup_countable => //i _; case: (projT2 (f i)). +- move=> E [A AsubGn AE]; exists E => //. + have h (w : set (T * T)) : { p : IEnt | w \in A -> w = (projT1 p).2 }. + apply: cid; have [|] := boolP (w \in A); last first. + by exists (exist ent_of _ (IEnt_pointT i0)). + move=> /[dup] /AsubGn /set_mem [n _ gnw] wA. + suff ent : ent_of (n, w) by exists (exist ent_of (n, w) ent). + by apply/asboolP; have [_ + _] := projT2 (f n); exact. + exists [fset sval (h w) | w in A]%fset; first by move=> ?; exact: in_setT. + rewrite -AE; rewrite eqEsubset; split => t Ia. + by move=> w Aw; rewrite (svalP (h w) Aw); apply/Ia/imfsetP; exists w. + case=> [[n w]] p /imfsetP [x /= xA M]; apply: Ia. + by rewrite (_ : w = x) // (svalP (h x) xA) -M. +- move=> E [w] [ A _ wIA wsubE]. + have ent_Ip (i : IEnt) : @entourage (TS (projT1 i).1) (projT1 i).2. + by apply/asboolP; exact: (projT2 i). + pose h (i : IEnt) : {x : set (T * T) | _} := cid2 (and3_rec + (fun _ _ P => P) (projT2 (f (projT1 i).1)) (projT1 i).2 (ent_Ip i)). + have ehi (i : IEnt) : ent_of ((projT1 i).1, projT1 (h i)). + apply/asboolP => /=; have [] := projT2 (h i). + by have [_ + _ ? ?] := projT2 (f (projT1 i).1); exact. + pose AH := [fset projT1 (h w) | w in A]%fset. + exists (\bigcap_(i in [set` AH]) i). + exists AH => // p /imfsetP [i iA ->]; rewrite inE //. + by exists (projT1 i).1 => //; have [] := projT2 (h i). + apply: subset_trans wsubE; rewrite -wIA => ? It i ?. + by have [?] := projT2 (h i); apply; apply: It; apply/imfsetP; exists i. +Qed. End sup_uniform. -Section product_uniform. - -Variable (I : choiceType) (T : I -> uniformType). +HB.instance Definition _ (I : Type) (T : I -> uniformType) := + Uniform.copy (prod_topology T) + (sup_topology (fun i => Uniform.class + [the uniformType of weak_topology (@proj _ T i)])). -Definition product_uniformType := - sup_uniformType (fun i => Uniform.class - (weak_uniformType (fun f : dep_arrow_pointedType T => f i))). +(** * PseudoMetric spaces defined using balls *) -End product_uniform. +Definition entourage_ {R : numDomainType} {T T'} (ball : T -> R -> set T') := + @filter_from R _ [set x | 0 < x] (fun e => [set xy | ball xy.1 e xy.2]). -Module PseudoMetric. +Lemma entourage_E {R : numDomainType} {T T'} (ball : T -> R -> set T') : + entourage_ ball = + @filter_from R _ [set x | 0 < x] (fun e => [set xy | ball xy.1 e xy.2]). +Proof. by []. Qed. -Record mixin_of (R : numDomainType) (M : Type) (entourage : set (set (M * M))) := Mixin { +HB.mixin Record Uniform_isPseudoMetric (R : numDomainType) M of Uniform M := { ball : M -> R -> M -> Prop ; - ax1 : forall x (e : R), 0 < e -> ball x e x ; - ax2 : forall x y (e : R), ball x e y -> ball y e x ; - ax3 : forall x y z e1 e2, ball x e1 y -> ball y e2 z -> ball x (e1 + e2) z; - ax4 : entourage = entourage_ ball + ball_center_subproof : forall x (e : R), 0 < e -> ball x e x ; + ball_sym_subproof : forall x y (e : R), ball x e y -> ball y e x ; + ball_triangle_subproof : + forall x y z e1 e2, ball x e1 y -> ball y e2 z -> ball x (e1 + e2) z; + entourageE_subproof : entourage = entourage_ ball }. -Record class_of (R : numDomainType) (M : Type) := Class { - base : Uniform.class_of M; - mixin : mixin_of R (Uniform.entourage base) +#[short(type="pseudoMetricType")] +HB.structure Definition PseudoMetric (R : numDomainType) := + {T of Uniform T & Uniform_isPseudoMetric R T}. + +Definition discrete_topology T (dsc : discrete_space T) : Type := T. + +Section discrete_uniform. + +Context {T : nbhsType} {dsc: discrete_space T}. + +Definition discrete_ent : set (set (T * T)) := + globally (range (fun x => (x, x))). + +Program Definition discrete_uniform_mixin := + @isUniform.Build (discrete_topology dsc) discrete_ent _ _ _ _. +Next Obligation. +by move=> ? + x x12; apply; exists x.1; rewrite // {2}x12 -surjective_pairing. +Qed. +Next Obligation. +by move=> ? dA x [i _ <-]; apply: dA; exists i. +Qed. +Next Obligation. +move=> ? dA; exists (range (fun x => (x, x))) => //. +by rewrite set_compose_diag => x [i _ <-]; apply: dA; exists i. +Qed. + +HB.instance Definition _ := Choice.on (discrete_topology dsc). +HB.instance Definition _ := Pointed.on (discrete_topology dsc). +HB.instance Definition _ := discrete_uniform_mixin. + +End discrete_uniform. + +(* was uniformityOfBallMixin *) +HB.factory Record Nbhs_isPseudoMetric (R : numFieldType) M of Nbhs M := { + ent : set_system (M * M); + nbhsE : nbhs = nbhs_ ent; + ball : M -> R -> M -> Prop ; + ball_center : forall x (e : R), 0 < e -> ball x e x ; + ball_sym : forall x y (e : R), ball x e y -> ball y e x ; + ball_triangle : + forall x y z e1 e2, ball x e1 y -> ball y e2 z -> ball x (e1 + e2) z; + entourageE : ent = entourage_ ball }. -Section ClassDef. -Variable R : numDomainType. -Structure type := Pack { sort; _ : class_of R sort }. -Local Coercion sort : type >-> Sortclass. -Variables (T : Type) (cT : type). -Definition class := let: Pack _ c := cT return class_of R cT in c. - -Definition clone c of phant_id class c := @Pack T c. -Let xT := let: Pack T _ := cT in T. -Notation xclass := (class : class_of R xT). -Local Coercion base : class_of >-> Uniform.class_of. -Local Coercion mixin : class_of >-> mixin_of. - -Definition pack ent (m : @mixin_of R T ent) := - fun bT (b : Uniform.class_of T) of phant_id (@Uniform.class bT) b => - fun m' of phant_id m (m' : @mixin_of R T (Uniform.entourage b)) => - @Pack T (@Class R _ b m'). - -Definition eqType := @Equality.Pack cT xclass. -Definition choiceType := @Choice.Pack cT xclass. -Definition pointedType := @Pointed.Pack cT xclass. -Definition filteredType := @Filtered.Pack cT cT xclass. -Definition topologicalType := @Topological.Pack cT xclass. -Definition uniformType := @Uniform.Pack cT xclass. - -End ClassDef. - -Module Exports. - -Coercion sort : type >-> Sortclass. -Coercion base : class_of >-> Uniform.class_of. -Coercion mixin : class_of >-> mixin_of. -Coercion eqType : type >-> Equality.type. -Canonical eqType. -Coercion choiceType : type >-> Choice.type. -Canonical choiceType. -Coercion pointedType : type >-> Pointed.type. -Canonical pointedType. -Coercion filteredType : type >-> Filtered.type. -Canonical filteredType. -Coercion topologicalType : type >-> Topological.type. -Canonical topologicalType. -Coercion uniformType : type >-> Uniform.type. -Canonical uniformType. -Notation pseudoMetricType := type. -Notation PseudoMetricType T m := (@pack _ T _ m _ _ idfun _ idfun). -Notation PseudoMetricMixin := Mixin. -Notation "[ 'pseudoMetricType' R 'of' T 'for' cT ]" := (@clone R T cT _ idfun) - (at level 0, format "[ 'pseudoMetricType' R 'of' T 'for' cT ]") : form_scope. -Notation "[ 'pseudoMetricType' R 'of' T ]" := (@clone R T _ _ id) - (at level 0, format "[ 'pseudoMetricType' R 'of' T ]") : form_scope. - -End Exports. - -End PseudoMetric. - -Export PseudoMetric.Exports. - -Section PseudoMetricUniformity. - -Lemma my_ball_le (R : numDomainType) (M : Type) (ent : set (set (M * M))) (m : PseudoMetric.mixin_of R ent) : - forall (x : M), {homo PseudoMetric.ball m x : e1 e2 / e1 <= e2 >-> e1 `<=` e2}. -Proof. -move=> x e1 e2 le12 y xe1_y. +HB.builders Context R M of Nbhs_isPseudoMetric R M. + +Lemma ball_le x : {homo ball x : e1 e2 / e1 <= e2 >-> e1 `<=` e2}. +Proof. +move=> e1 e2 le12 y xe1_y. move: le12; rewrite le_eqVlt => /orP [/eqP <- //|]. rewrite -subr_gt0 => lt12. -rewrite -[e2](subrK e1); apply: PseudoMetric.ax3 xe1_y. -suff : PseudoMetric.ball m x (PosNum lt12)%:num x by []. -exact: PseudoMetric.ax1. +rewrite -[e2](subrK e1); apply: ball_triangle xe1_y. +suff : ball x (PosNum lt12)%:num x by []. +exact: ball_center. Qed. -Program Definition uniformityOfBallMixin (R : numFieldType) (T : Type) - (ent : set (set (T * T))) (nbhs : T -> set (set T)) (nbhsE : nbhs = nbhs_ ent) - (m : PseudoMetric.mixin_of R ent) : Uniform.mixin_of nbhs := - UniformMixin _ _ _ _ nbhsE. -Next Obligation. -move=> R T ent nbhs nbhsE m; rewrite (PseudoMetric.ax4 m). -apply: filter_from_filter; first by exists 1 => /=. +Lemma entourage_filter_subproof : Filter ent. +Proof. +rewrite entourageE; apply: filter_from_filter; first by exists 1 => /=. move=> _ _ /posnumP[e1] /posnumP[e2]; exists (Num.min e1 e2)%:num => //=. -by rewrite subsetI; split=> ?; apply: my_ball_le; - rewrite -leEsub// le_minl lexx ?orbT. +by rewrite subsetI; split=> ?; apply: ball_le; + rewrite num_le// le_minl lexx ?orbT. Qed. -Next Obligation. -move=> R T ent nbhs nbhsE m A; rewrite (PseudoMetric.ax4 m). -move=> [e egt0 sbeA] xy xey. -apply: sbeA; rewrite /= xey; exact: PseudoMetric.ax1. + +Lemma ball_sym_subproof A : ent A -> [set xy | xy.1 = xy.2] `<=` A. +Proof. +rewrite entourageE; move=> [e egt0 sbeA] xy xey. +apply: sbeA; rewrite /= xey; exact: ball_center. Qed. -Next Obligation. -move=> R T ent nbhs nbhsE m A; rewrite (PseudoMetric.ax4 m) => - [e egt0 sbeA]. -by exists e => // xy xye; apply: sbeA; apply: PseudoMetric.ax2. + +Lemma ball_triangle_subproof A : ent A -> ent (A^-1)%classic. +Proof. +rewrite entourageE => - [e egt0 sbeA]. +by exists e => // xy xye; apply: sbeA; apply: ball_sym. Qed. -Next Obligation. -move=> R T ent nbhs nbhsE m A; rewrite (PseudoMetric.ax4 m). -move=> [_/posnumP[e] sbeA]. -exists [set xy | PseudoMetric.ball m xy.1 (e%:num / 2) xy.2]. + +Lemma entourageE_subproof A : ent A -> exists2 B, ent B & B \; B `<=` A. +Proof. +rewrite entourageE; move=> [_/posnumP[e] sbeA]. +exists [set xy | ball xy.1 (e%:num / 2) xy.2]. by exists (e%:num / 2) => /=. move=> xy [z xzhe zyhe]; apply: sbeA. -by rewrite [e%:num]splitr; apply: PseudoMetric.ax3 zyhe. +by rewrite [e%:num]splitr; apply: ball_triangle zyhe. Qed. -End PseudoMetricUniformity. +HB.instance Definition _ := Nbhs_isUniform.Build M + entourage_filter_subproof ball_sym_subproof ball_triangle_subproof + entourageE_subproof nbhsE. -Definition ball {R : numDomainType} {M : pseudoMetricType R} := PseudoMetric.ball (PseudoMetric.class M). +HB.instance Definition _ := Uniform_isPseudoMetric.Build R M + ball_center ball_sym ball_triangle entourageE. + +HB.end. Lemma entourage_ballE {R : numDomainType} {M : pseudoMetricType R} : entourage_ (@ball R M) = entourage. -Proof. by case: M=> [?[?[]]]. Qed. +Proof. by rewrite entourageE_subproof. Qed. Lemma entourage_from_ballE {R : numDomainType} {M : pseudoMetricType R} : @filter_from R _ [set x : R | 0 < x] @@ -4532,7 +5137,7 @@ Proof. by rewrite nbhs_simpl. Qed. Lemma ball_center {R : numDomainType} (M : pseudoMetricType R) (x : M) (e : {posnum R}) : ball x e%:num x. -Proof. exact: PseudoMetric.ax1. Qed. +Proof. exact: ball_center_subproof. Qed. #[global] Hint Resolve ball_center : core. Section pseudoMetricType_numDomainType. @@ -4542,19 +5147,22 @@ Lemma ballxx (x : M) (e : R) : 0 < e -> ball x e x. Proof. by move=> e_gt0; apply: ball_center (PosNum e_gt0). Qed. Lemma ball_sym (x y : M) (e : R) : ball x e y -> ball y e x. -Proof. exact: PseudoMetric.ax2. Qed. +Proof. exact: ball_sym_subproof. Qed. + +Lemma ball_symE (x y : M) (e : R) : ball x e y = ball y e x. +Proof. by rewrite propeqE; split; exact/ball_sym. Qed. Lemma ball_triangle (y x z : M) (e1 e2 : R) : ball x e1 y -> ball y e2 z -> ball x (e1 + e2) z. -Proof. exact: PseudoMetric.ax3. Qed. +Proof. exact: ball_triangle_subproof. Qed. -Lemma nbhsx_ballx (x : M) (eps : {posnum R}) : nbhs x (ball x eps%:num). -Proof. by apply/nbhs_ballP; exists eps%:num => /=. Qed. +Lemma nbhsx_ballx (x : M) (eps : R) : 0 < eps -> nbhs x (ball x eps). +Proof. by move=> e0; apply/nbhs_ballP; exists eps. Qed. Lemma open_nbhs_ball (x : M) (eps : {posnum R}) : open_nbhs x ((ball x eps%:num)^°). Proof. split; first exact: open_interior. -by apply: nbhs_singleton; apply: nbhs_interior; apply:nbhsx_ballx. +by apply: nbhs_singleton; apply: nbhs_interior; exact: nbhsx_ballx. Qed. Lemma le_ball (x : M) (e1 e2 : R) : e1 <= e2 -> ball x e1 `<=` ball x e2. @@ -4569,10 +5177,16 @@ apply: Build_ProperFilter; rewrite -entourage_ballE => A [_/posnumP[e] sbeA]. by exists (point, point); apply: sbeA; apply: ballxx. Qed. -Lemma near_ball (y : M) (eps : {posnum R}) : - \forall y' \near y, ball y eps%:num y'. +Lemma near_ball (y : M) (eps : R) : 0 < eps -> \forall y' \near y, ball y eps y'. Proof. exact: nbhsx_ballx. Qed. +Lemma dnbhs_ball (a : M) (e : R) : (0 < e)%R -> a^' (ball a e `\ a). +Proof. +move: e => _/posnumP[e]; rewrite /dnbhs /within /=; near=> r => ra. +split => //=; last exact/eqP. +by near: r; rewrite near_simpl; exact: near_ball. +Unshelve. all: by end_near. Qed. + Lemma fcvg_ballP {F} {FF : Filter F} (y : M) : F --> y <-> forall eps : R, 0 < eps -> \forall y' \near F, ball y eps y'. Proof. by rewrite -filter_fromP !nbhs_simpl /=. Qed. @@ -4585,7 +5199,7 @@ by apply/fcvg_ballP=> _/posnumP[eps] //. Qed. #[deprecated(since="mathcomp-analysis 0.6.0", note="use a combination of `cvg_ballP` and `posnumP`")] -Notation cvg_ballPpos := __deprecated__cvg_ballPpos. +Notation cvg_ballPpos := __deprecated__cvg_ballPpos (only parsing). Lemma fcvg_ball {F} {FF : Filter F} (y : M) : F --> y -> forall eps : R, 0 < eps -> \forall y' \near F, ball y eps y'. @@ -4621,8 +5235,11 @@ End pseudoMetricType_numDomainType. #[global] Hint Resolve close_refl : core. Arguments close_cvg {T} F1 F2 {FF2} _. +Arguments nbhsx_ballx {R M} x eps. +Arguments near_ball {R M} y eps. + #[deprecated(since="mathcomp-analysis 0.6.0", note="renamed `cvg_ball`")] -Notation app_cvg_locally := cvg_ball. +Notation app_cvg_locally := cvg_ball (only parsing). Section pseudoMetricType_numFieldType. Context {R : numFieldType} {M : pseudoMetricType R}. @@ -4688,7 +5305,19 @@ by rewrite /unif_continuous -!entourage_ballE filter_fromP. Qed. End entourages. -(** ** Specific pseudoMetric spaces *) +Lemma countable_uniformity_metric {R : realType} {T : pseudoMetricType R} : + countable_uniformity T. +Proof. +apply/countable_uniformityP. +exists (fun n => [set xy : T * T | ball xy.1 n.+1%:R^-1 xy.2]); last first. + by move=> n; exact: (entourage_ball _ n.+1%:R^-1%:pos). +move=> E; rewrite -entourage_ballE => -[e e0 subE]. +exists `|floor e^-1|%N; apply: subset_trans subE => xy; apply: le_ball. +rewrite /= -[leRHS]invrK lef_pV2 ?posrE ?invr_gt0// -natr1. +by rewrite natr_absz ger0_norm ?floor_ge0 ?invr_ge0// 1?ltW// lt_succ_floor. +Qed. + +(** Specific pseudoMetric spaces *) (** matrices *) Section matrix_PseudoMetric. @@ -4718,13 +5347,12 @@ move=> MN MN_min; apply: sPA => i j. have /(xgetPex 1%:pos): exists e : {posnum R}, diag e `<=` P i j. by have [_/posnumP[e]] := entP i j; exists e. apply; apply: le_ball (MN_min i j). -apply: le_trans (@bigmin_le _ [orderType of {posnum R}] _ _ i _) _. +apply: le_trans (@bigmin_le _ [the orderType _ of {posnum R}] _ _ i _) _. exact: bigmin_le. Qed. -Definition matrix_pseudoMetricType_mixin := - PseudoMetric.Mixin mx_ball_center mx_ball_sym mx_ball_triangle mx_entourage. -Canonical matrix_pseudoMetricType := - PseudoMetricType 'M[T]_(m, n) matrix_pseudoMetricType_mixin. + +HB.instance Definition _ := Uniform_isPseudoMetric.Build R 'M[T]_(m, n) + mx_ball_center mx_ball_sym mx_ball_triangle mx_entourage. End matrix_PseudoMetric. (** product of two pseudoMetric spaces *) @@ -4756,25 +5384,24 @@ move=> [[_/posnumP[eA] sbA] [_/posnumP[eB] sbB] sABP]. exists (Num.min eA eB)%:num => //= -[[a b] [c d] [/= bac bbd]]. suff /sABP [] : (A `*` B) ((a, c), (b, d)) by move=> [[??] [??]] ? [<-<-<-<-]. split; [apply: sbA|apply: sbB] => /=. - by apply: le_ball bac; rewrite -leEsub le_minl lexx. -by apply: le_ball bbd; rewrite -leEsub le_minl lexx orbT. + by apply: le_ball bac; rewrite num_le le_minl lexx. +by apply: le_ball bbd; rewrite num_le le_minl lexx orbT. Qed. -Definition prod_pseudoMetricType_mixin := - PseudoMetric.Mixin prod_ball_center prod_ball_sym prod_ball_triangle prod_entourage. + +HB.instance Definition _ := Uniform_isPseudoMetric.Build R (U * V)%type + prod_ball_center prod_ball_sym prod_ball_triangle prod_entourage. End prod_PseudoMetric. -Canonical prod_pseudoMetricType (R : numDomainType) (U V : pseudoMetricType R) := - PseudoMetricType (U * V) (@prod_pseudoMetricType_mixin R U V). Section Nbhs_fct2. Context {T : Type} {R : numDomainType} {U V : pseudoMetricType R}. -Lemma fcvg_ball2P {F : set (set U)} {G : set (set V)} +Lemma fcvg_ball2P {F : set_system U} {G : set_system V} {FF : Filter F} {FG : Filter G} (y : U) (z : V): (F, G) --> (y, z) <-> forall eps : R, eps > 0 -> \forall y' \near F & z' \near G, ball y eps y' /\ ball z eps z'. Proof. exact: fcvg_ballP. Qed. -Lemma cvg_ball2P {I J} {F : set (set I)} {G : set (set J)} +Lemma cvg_ball2P {I J} {F : set_system I} {G : set_system J} {FF : Filter F} {FG : Filter G} (f : I -> U) (g : J -> V) (y : U) (z : V): (f @ F, g @ G) --> (y, z) <-> forall eps : R, eps > 0 -> \forall i \near F & j \near G, @@ -4807,16 +5434,88 @@ rewrite predeqE => A; split; last first. move=> [P]; rewrite -entourage_ballE => -[_/posnumP[e] sbeP] sPA. by exists e%:num => //= fg fg_e; apply: sPA => t; apply: sbeP; apply: fg_e. Qed. -Definition fct_pseudoMetricType_mixin := - PseudoMetricMixin fct_ball_center fct_ball_sym fct_ball_triangle fct_entourage. -Canonical fct_pseudoMetricType := PseudoMetricType (T -> U) fct_pseudoMetricType_mixin. + +HB.instance Definition _ := Uniform_isPseudoMetric.Build R (T -> U) + fct_ball_center fct_ball_sym fct_ball_triangle fct_entourage. End fct_PseudoMetric. -(** ** Complete uniform spaces *) +Definition quotient_topology (T : topologicalType) (Q : quotType T) : Type := Q. + +Section quotients. +Local Open Scope quotient_scope. +Context {T : topologicalType} {Q0 : quotType T}. + +Local Notation Q := (quotient_topology Q0). + +HB.instance Definition _ := Quotient.copy Q Q0. +HB.instance Definition _ := [Sub Q of T by %/]. +HB.instance Definition _ := [Choice of Q by <:]. +HB.instance Definition _ := isPointed.Build Q (\pi_Q point : Q). + +Definition quotient_open U := open (\pi_Q @^-1` U). + +Program Definition quotient_topologicalType_mixin := + @Pointed_isOpenTopological.Build Q quotient_open _ _ _. +Next Obligation. by rewrite /quotient_open preimage_setT; exact: openT. Qed. +Next Obligation. by move=> ? ? ? ?; exact: openI. Qed. +Next Obligation. by move=> I f ofi; apply: bigcup_open => i _; exact: ofi. Qed. +HB.instance Definition _ := quotient_topologicalType_mixin. + +Lemma pi_continuous : continuous (\pi_Q : T -> Q). +Proof. exact/continuousP. Qed. + +Lemma quotient_continuous {Z : topologicalType} (f : Q -> Z) : + continuous f <-> continuous (f \o \pi_Q). +Proof. +split => /continuousP /= cts; apply/continuousP => A oA; last exact: cts. +by rewrite comp_preimage; move/continuousP: pi_continuous; apply; exact: cts. +Qed. + +Lemma repr_comp_continuous (Z : topologicalType) (g : T -> Z) : + continuous g -> {homo g : a b / \pi_Q a == \pi_Q b :> Q >-> a == b} -> + continuous (g \o repr : Q -> Z). +Proof. +move=> /continuousP ctsG rgE; apply/continuousP => A oA. +rewrite /open/= /quotient_open (_ : _ @^-1` _ = g @^-1` A); first exact: ctsG. +have greprE x : g (repr (\pi_Q x)) = g x by apply/eqP; rewrite rgE// reprK. +by rewrite eqEsubset; split => x /=; rewrite greprE. +Qed. + +End quotients. -Definition cauchy {T : uniformType} (F : set (set T)) := (F, F) --> entourage. +Section discrete_pseudoMetric. +Context {R : numDomainType} {T : nbhsType} {dsc : discrete_space T}. -Lemma cvg_cauchy {T : uniformType} (F : set (set T)) : Filter F -> +Definition discrete_ball (x : T) (eps : R) y : Prop := x = y. + +Lemma discrete_ball_center x (eps : R) : 0 < eps -> discrete_ball x eps x. +Proof. by []. Qed. + +Program Definition discrete_pseudometric_mixin := + @Uniform_isPseudoMetric.Build R (discrete_topology dsc) discrete_ball + _ _ _ _. +Next Obligation. by done. Qed. +Next Obligation. by move=> ? ? ? ->. Qed. +Next Obligation. by move=> ? ? ? ? ? -> ->. Qed. +Next Obligation. +rewrite predeqE => P; split; last first. + by case=> e _ leP; move=> [a b] [i _] [-> ->]; apply: leP. +move=> entP; exists 1 => //= z z12; apply: entP; exists z.1 => //. +by rewrite {2}z12 -surjective_pairing. +Qed. + +HB.instance Definition _ := discrete_pseudometric_mixin. + +End discrete_pseudoMetric. + +Definition pseudoMetric_bool {R : realType} := + [the pseudoMetricType R of discrete_topology discrete_bool : Type]. + +(** Complete uniform spaces *) + +Definition cauchy {T : uniformType} (F : set_system T) := (F, F) --> entourage. + +Lemma cvg_cauchy {T : uniformType} (F : set_system T) : Filter F -> [cvg F in T] -> cauchy F. Proof. move=> FF cvF A entA; have /entourage_split_ex [B entB sB2A] := entA. @@ -4826,79 +5525,33 @@ exists (to_set ((B^-1)%classic) (lim F), to_set B (lim F)). by move=> ab [/= Balima Blimb]; apply: sB2A; exists (lim F). Qed. -Module Complete. -Definition axiom (T : uniformType) := - forall (F : set (set T)), ProperFilter F -> cauchy F -> F --> lim F. -Section ClassDef. -Record class_of (T : Type) := Class { - base : Uniform.class_of T ; - mixin : axiom (Uniform.Pack base) +HB.mixin Record Uniform_isComplete T of Uniform T := { + cauchy_cvg : + forall (F : set_system T), ProperFilter F -> cauchy F -> cvg F }. -Local Coercion base : class_of >-> Uniform.class_of. -Local Coercion mixin : class_of >-> Complete.axiom. -Structure type := Pack { sort; _ : class_of sort }. -Local Coercion sort : type >-> Sortclass. -Variables (T : Type) (cT : type). -Definition class := let: Pack _ c := cT return class_of cT in c. -Definition clone c of phant_id class c := @Pack T c. -Let xT := let: Pack T _ := cT in T. -Notation xclass := (class : class_of xT). -Definition pack b0 (m0 : axiom (@Uniform.Pack T b0)) := - fun bT b of phant_id (@Uniform.class bT) b => - fun m of phant_id m m0 => @Pack T (@Class T b m). -Definition eqType := @Equality.Pack cT xclass. -Definition choiceType := @Choice.Pack cT xclass. -Definition pointedType := @Pointed.Pack cT xclass. -Definition filteredType := @Filtered.Pack cT cT xclass. -Definition topologicalType := @Topological.Pack cT xclass. -Definition uniformType := @Uniform.Pack cT xclass. -End ClassDef. -Module Exports. -Coercion base : class_of >-> Uniform.class_of. -Coercion mixin : class_of >-> axiom. -Coercion sort : type >-> Sortclass. -Coercion eqType : type >-> Equality.type. -Canonical eqType. -Coercion choiceType : type >-> Choice.type. -Canonical choiceType. -Coercion pointedType : type >-> Pointed.type. -Canonical pointedType. -Coercion filteredType : type >-> Filtered.type. -Canonical filteredType. -Coercion topologicalType : type >-> Topological.type. -Canonical topologicalType. -Coercion uniformType : type >-> Uniform.type. -Canonical uniformType. -Notation completeType := type. -Notation "[ 'completeType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) - (at level 0, format "[ 'completeType' 'of' T 'for' cT ]") : form_scope. -Notation "[ 'completeType' 'of' T ]" := (@clone T _ _ id) - (at level 0, format "[ 'completeType' 'of' T ]") : form_scope. -Notation CompleteType T m := (@pack T _ m _ _ idfun _ idfun). -End Exports. -End Complete. -Export Complete.Exports. + +#[short(type="completeType")] +HB.structure Definition Complete := {T of Uniform T & Uniform_isComplete T}. + +#[deprecated(since="mathcomp-analysis 2.0", note="use cauchy_cvg instead")] +Notation complete_ax := cauchy_cvg (only parsing). Section completeType1. Context {T : completeType}. -Lemma cauchy_cvg (F : set (set T)) (FF : ProperFilter F) : - cauchy F -> cvg F. -Proof. by case: T F FF => [? [?]]. Qed. - -Lemma cauchy_cvgP (F : set (set T)) (FF : ProperFilter F) : cauchy F <-> cvg F. +Lemma cauchy_cvgP (F : set_system T) (FF : ProperFilter F) : cauchy F <-> cvg F. Proof. by split=> [/cauchy_cvg|/cvg_cauchy]. Qed. End completeType1. -Arguments cauchy_cvg {T} F {FF} _. +Arguments cauchy_cvg {T} F {FF} _ : rename. Arguments cauchy_cvgP {T} F {FF}. Section matrix_Complete. Variables (T : completeType) (m n : nat). -Lemma mx_complete (F : set (set 'M[T]_(m, n))) : +Lemma mx_complete (F : set_system 'M[T]_(m, n)) : ProperFilter F -> cauchy F -> cvg F. Proof. move=> FF Fc. @@ -4915,7 +5568,7 @@ move: (i) (j); near: M'; near: M; apply: nearP_dep; apply: Fc. by exists (fun _ _ => (split_ent A)^-1%classic) => ?? //; apply: entourage_inv. Unshelve. all: by end_near. Qed. -Canonical matrix_completeType := CompleteType 'M[T]_(m, n) mx_complete. +HB.instance Definition _ := Uniform_isComplete.Build 'M[T]_(m, n) mx_complete. End matrix_Complete. @@ -4923,7 +5576,7 @@ Section fun_Complete. Context {T : choiceType} {U : completeType}. -Lemma fun_complete (F : set (set (T -> U))) +Lemma fun_complete (F : set_system (T -> U)) {FF : ProperFilter F} : cauchy F -> cvg F. Proof. move=> Fc. @@ -4937,14 +5590,13 @@ move: (t); near: g; near: f; apply: nearP_dep; apply: Fc. exists ((split_ent A)^-1)%classic=> //=. Unshelve. all: by end_near. Qed. -Canonical fun_completeType := CompleteType (T -> U) fun_complete. +HB.instance Definition _ := Uniform_isComplete.Build (T -> U) fun_complete. End fun_Complete. -(** ** Limit switching *) +(** Limit switching *) Section Cvg_switch. Context {T1 T2 : choiceType}. - Lemma cvg_switch_1 {U : uniformType} F1 {FF1 : ProperFilter F1} F2 {FF2 : Filter F2} (f : T1 -> T2 -> U) (g : T2 -> U) (h : T1 -> U) (l : U) : @@ -4986,21 +5638,21 @@ Lemma cvg_switch {U : completeType} exists l : U, h @ F1 --> l /\ g @ F2 --> l. Proof. move=> Hfg Hfh; have hcv := !! cvg_switch_2 Hfg Hfh. -by exists [lim h @ F1 in U]; split=> //; apply: cvg_switch_1 Hfg Hfh hcv. +by exists (lim (h @ F1)); split=> //; apply: cvg_switch_1 Hfg Hfh hcv. Qed. End Cvg_switch. -(** ** Complete pseudoMetric spaces *) +(** Complete pseudoMetric spaces *) -Definition cauchy_ex {R : numDomainType} {T : pseudoMetricType R} (F : set (set T)) := +Definition cauchy_ex {R : numDomainType} {T : pseudoMetricType R} (F : set_system T) := forall eps : R, 0 < eps -> exists x, F (ball x eps). -Definition cauchy_ball {R : numDomainType} {T : pseudoMetricType R} (F : set (set T)) := +Definition cauchy_ball {R : numDomainType} {T : pseudoMetricType R} (F : set_system T) := forall e, e > 0 -> \forall x & y \near F, ball x e y. Lemma cauchy_ballP (R : numDomainType) (T : pseudoMetricType R) - (F : set (set T)) (FF : Filter F) : + (F : set_system T) (FF : Filter F) : cauchy_ball F <-> cauchy F. Proof. split=> cauchyF; last first. @@ -5011,7 +5663,7 @@ Unshelve. all: by end_near. Qed. Arguments cauchy_ballP {R T} F {FF}. Lemma cauchy_exP (R : numFieldType) (T : pseudoMetricType R) - (F : set (set T)) (FF : Filter F) : + (F : set_system T) (FF : Filter F) : cauchy_ex F -> cauchy F. Proof. move=> Fc A; rewrite !nbhs_simpl /= -entourage_ballE => -[_/posnumP[e] sdeA]. @@ -5021,7 +5673,7 @@ Unshelve. all: by end_near. Qed. Arguments cauchy_exP {R T} F {FF}. Lemma cauchyP (R : numFieldType) (T : pseudoMetricType R) - (F : set (set T)) (PF : ProperFilter F) : + (F : set_system T) (PF : ProperFilter F) : cauchy F <-> cauchy_ex F. Proof. split=> [Fcauchy _/posnumP[e] |/cauchy_exP//]. @@ -5030,79 +5682,30 @@ exact/Fcauchy/entourage_ball. Unshelve. all: by end_near. Qed. Arguments cauchyP {R T} F {PF}. -Module CompletePseudoMetric. -Section ClassDef. -Variable R : numDomainType. -Record class_of (T : Type) := Class { - base : PseudoMetric.class_of R T; - mixin : Complete.axiom (Uniform.Pack base) -}. -Local Coercion base : class_of >-> PseudoMetric.class_of. -Definition base2 T m := Complete.Class (@mixin T m). -Local Coercion base2 : class_of >-> Complete.class_of. - -Structure type := Pack { sort; _ : class_of sort }. -Local Coercion sort : type >-> Sortclass. -Variables (T : Type) (cT : type). -Definition class := let: Pack _ c := cT return class_of cT in c. -Definition clone c of phant_id class c := @Pack T c. -Let xT := let: Pack T _ := cT in T. -Notation xclass := (class : class_of xT). -Definition pack := - fun bT b & phant_id (@PseudoMetric.class R bT) (b : PseudoMetric.class_of R T) => - fun mT m & phant_id (Complete.class mT) (@Complete.Class T b m) => - Pack (@Class T b m). -Definition eqType := @Equality.Pack cT xclass. -Definition choiceType := @Choice.Pack cT xclass. -Definition pointedType := @Pointed.Pack cT xclass. -Definition filteredType := @Filtered.Pack cT cT xclass. -Definition topologicalType := @Topological.Pack cT xclass. -Definition uniformType := @Uniform.Pack cT xclass. -Definition completeType := @Complete.Pack cT xclass. -Definition pseudoMetricType := @PseudoMetric.Pack R cT xclass. -Definition pseudoMetric_completeType := @Complete.Pack pseudoMetricType xclass. -End ClassDef. -Module Exports. -Coercion base : class_of >-> PseudoMetric.class_of. -Coercion mixin : class_of >-> Complete.axiom. -Coercion base2 : class_of >-> Complete.class_of. -Coercion sort : type >-> Sortclass. -Coercion eqType : type >-> Equality.type. -Canonical eqType. -Coercion choiceType : type >-> Choice.type. -Canonical choiceType. -Coercion pointedType : type >-> Pointed.type. -Canonical pointedType. -Coercion filteredType : type >-> Filtered.type. -Canonical filteredType. -Coercion topologicalType : type >-> Topological.type. -Canonical topologicalType. -Coercion uniformType : type >-> Uniform.type. -Canonical uniformType. -Coercion completeType : type >-> Complete.type. -Canonical completeType. -Coercion pseudoMetricType : type >-> PseudoMetric.type. -Canonical pseudoMetricType. -Canonical pseudoMetric_completeType. -Notation completePseudoMetricType := type. -Notation "[ 'completePseudoMetricType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) - (at level 0, format "[ 'completePseudoMetricType' 'of' T 'for' cT ]") : form_scope. -Notation "[ 'completePseudoMetricType' 'of' T ]" := (@clone T _ _ id) - (at level 0, format "[ 'completePseudoMetricType' 'of' T ]") : form_scope. -Notation CompletePseudoMetricType T m := (@pack _ T _ _ id _ _ id). -End Exports. -End CompletePseudoMetric. -Export CompletePseudoMetric.Exports. - -Canonical matrix_completePseudoMetricType (R : numFieldType) - (T : completePseudoMetricType R) (m n : nat) := - CompletePseudoMetricType 'M[T]_(m, n) mx_complete. - -Canonical fct_completePseudoMetricType (T : choiceType) (R : numFieldType) - (U : completePseudoMetricType R) := - CompletePseudoMetricType (T -> U) fun_complete. - -Definition pointed_of_zmodule (R : zmodType) : pointedType := PointedType R 0. +#[short(type="completePseudoMetricType")] +HB.structure Definition CompletePseudoMetric R := + {T of Complete T & PseudoMetric R T}. + +HB.instance Definition _ (R : numFieldType) (T : completePseudoMetricType R) + (m n : nat) := Uniform_isComplete.Build 'M[T]_(m, n) cauchy_cvg. + +HB.instance Definition _ (T : choiceType) (R : numFieldType) + (U : completePseudoMetricType R) := + Uniform_isComplete.Build (T -> U) cauchy_cvg. + +HB.instance Definition _ (R : zmodType) := isPointed.Build R 0. + +Lemma compact_cauchy_cvg {T : uniformType} (U : set T) (F : set_system T) : + ProperFilter F -> cauchy F -> F U -> compact U -> cvg F. +Proof. +move=> PF cf FU /(_ F PF FU) [x [_ clFx]]; apply: (cvgP x). +apply/cvg_entourageP => E entE. +have : nbhs entourage (split_ent E) by rewrite nbhs_filterE. +move=> /(cf (split_ent E))[] [D1 D2]/= /[!nbhs_simpl] -[FD1 FD2 D1D2E]. +have : nbhs x to_set (split_ent E) x by exact: nbhs_entourage. +move=> /(clFx _ (to_set (split_ent E) x) FD1)[z [Dz Exz]]. +by near=> t; apply/(entourage_split z entE Exz)/D1D2E; split => //; near: t. +Unshelve. all: by end_near. Qed. Definition ball_ (R : numDomainType) (V : zmodType) (norm : V -> R) (x : V) (e : R) := @@ -5121,27 +5724,25 @@ Lemma subset_ball_prop_in_itvcc (R : realDomainType) (x : R) e P : 0 < e -> {in `[(x - e), (x + e)], forall y, P y}. Proof. move=> e_gt0 PP y; rewrite in_itv/= -ler_distlC => ye; apply: PP => /=. -by rewrite (le_lt_trans ye)// ltr_pmull// ltr1n. +by rewrite (le_lt_trans ye)// ltr_pMl// ltr1n. Qed. -Global Instance ball_filter (R : realFieldType) (t : R) : Filter +Global Instance ball_filter (R : realDomainType) (t : R) : Filter [set P | exists2 i : R, 0 < i & ball_ Num.norm t i `<=` P]. Proof. -apply Build_Filter; [by exists 1 | move=> P Q | move=> P Q PQ]; rewrite /mkset. +apply: Build_Filter; [by exists 1 | move=> P Q | move=> P Q PQ]; rewrite /mkset. - move=> -[x x0 xP] [y ? yQ]; exists (Num.min x y); first by rewrite lt_minr x0. move=> z tz; split. - by apply xP; rewrite /= (lt_le_trans tz) // le_minl lexx. - by apply yQ; rewrite /= (lt_le_trans tz) // le_minl lexx orbT. + by apply: xP; rewrite /= (lt_le_trans tz) // le_minl lexx. + by apply: yQ; rewrite /= (lt_le_trans tz) // le_minl lexx orbT. - by move=> -[x ? xP]; exists x => //; apply: (subset_trans xP). Qed. -Definition filtered_of_normedZmod (K : numDomainType) (R : normedZmodType K) - : filteredType R := Filtered.Pack (Filtered.Class - (@Pointed.class (pointed_of_zmodule R)) - (nbhs_ball_ (ball_ (fun x => `|x|)))). +#[global] Hint Extern 0 (Filter [set P | exists2 i, _ & ball_ _ _ i `<=` P]) => + (apply: ball_filter) : typeclass_instances. Section pseudoMetric_of_normedDomain. -Variables (K : numDomainType) (R : normedZmodType K). +Context {K : numDomainType} {R : normedZmodType K}. Lemma ball_norm_center (x : R) (e : K) : 0 < e -> ball_ Num.norm x e x. Proof. by move=> ? /=; rewrite subrr normr0. Qed. Lemma ball_norm_symmetric (x y : R) (e : K) : @@ -5150,12 +5751,10 @@ Proof. by rewrite /= distrC. Qed. Lemma ball_norm_triangle (x y z : R) (e1 e2 : K) : ball_ Num.norm x e1 y -> ball_ Num.norm y e2 z -> ball_ Num.norm x (e1 + e2) z. Proof. -move=> /= ? ?; rewrite -(subr0 x) -(subrr y) opprD opprK (addrA x _ y) -addrA. -by rewrite (le_lt_trans (ler_norm_add _ _)) // ltr_add. +move=> /= ? ?; rewrite -(subr0 x) -(subrr y) opprD opprK addrA -(addrA _ y). +by rewrite (le_lt_trans (ler_normD _ _)) // ltrD. Qed. -Definition pseudoMetric_of_normedDomain - : PseudoMetric.mixin_of K (@entourage_ K R R (ball_ (fun x => `|x|))) - := PseudoMetricMixin ball_norm_center ball_norm_symmetric ball_norm_triangle erefl. + Lemma nbhs_ball_normE : @nbhs_ball_ K R R (ball_ Num.norm) = nbhs_ (entourage_ (ball_ Num.norm)). Proof. @@ -5166,355 +5765,36 @@ by move=> [E [e egt0 sbeE] sEA]; exists e => // ??; apply/sEA/sbeE. Qed. End pseudoMetric_of_normedDomain. -Module regular_topology. - -Section regular_topology. -Local Canonical pointedType (R : zmodType) : pointedType := - [pointedType of R^o for pointed_of_zmodule R]. -Local Canonical filteredType (R : numDomainType) : filteredType R := - [filteredType R of R^o for filtered_of_normedZmod R]. -Local Canonical topologicalType (R : numFieldType) : topologicalType := - TopologicalType R^o (topologyOfEntourageMixin (uniformityOfBallMixin - (@nbhs_ball_normE _ _) (pseudoMetric_of_normedDomain _))). -Local Canonical uniformType (R : numFieldType) : uniformType := - UniformType R^o (uniformityOfBallMixin - (@nbhs_ball_normE _ _) (pseudoMetric_of_normedDomain _)). -Local Canonical pseudoMetricType (R : numFieldType) := - PseudoMetricType R^o (@pseudoMetric_of_normedDomain R R). -End regular_topology. - -Module Exports. -Canonical pointedType. -Canonical filteredType. -Canonical topologicalType. -Canonical uniformType. -Canonical pseudoMetricType. -End Exports. - -End regular_topology. -Export regular_topology.Exports. +HB.instance Definition _ (R : zmodType) := Pointed.on R^o. + +HB.instance Definition _ (R : numDomainType) := hasNbhs.Build R^o + (nbhs_ball_ (ball_ (fun x => `|x|))). + +HB.instance Definition _ (R : numFieldType) := + Nbhs_isPseudoMetric.Build R R^o + nbhs_ball_normE ball_norm_center ball_norm_symmetric ball_norm_triangle erefl. Module numFieldTopology. -Section realType. -Variable (R : realType). -Local Canonical real_pointedType := [pointedType of R for [pointedType of R^o]]. -Local Canonical real_filteredType := - [filteredType R of R for [filteredType R of R^o]]. -Local Canonical real_topologicalType := - [topologicalType of R for [topologicalType of R^o]]. -Local Canonical real_uniformType := [uniformType of R for [uniformType of R^o]]. -Local Canonical real_pseudoMetricType := - [pseudoMetricType R of R for [pseudoMetricType R of R^o]]. -End realType. - -Section rcfType. -Variable (R : rcfType). -Local Canonical rcf_pointedType := [pointedType of R for [pointedType of R^o]]. -Local Canonical rcf_filteredType := - [filteredType R of R for [filteredType R of R^o]]. -Local Canonical rcf_topologicalType := - [topologicalType of R for [topologicalType of R^o]]. -Local Canonical rcf_uniformType := [uniformType of R for [uniformType of R^o]]. -Local Canonical rcf_pseudoMetricType := - [pseudoMetricType R of R for [pseudoMetricType R of R^o]]. -End rcfType. - -Section archiFieldType. -Variable (R : archiFieldType). -Local Canonical archiField_pointedType := - [pointedType of R for [pointedType of R^o]]. -Local Canonical archiField_filteredType := - [filteredType R of R for [filteredType R of R^o]]. -Local Canonical archiField_topologicalType := - [topologicalType of R for [topologicalType of R^o]]. -Local Canonical archiField_uniformType := - [uniformType of R for [uniformType of R^o]]. -Local Canonical archiField_pseudoMetricType := - [pseudoMetricType R of R for [pseudoMetricType R of R^o]]. -End archiFieldType. - -Section realFieldType. -Variable (R : realFieldType). -Local Canonical realField_pointedType := - [pointedType of R for [pointedType of R^o]]. -Local Canonical realField_filteredType := - [filteredType R of R for [filteredType R of R^o]]. -Local Canonical realField_topologicalType := - [topologicalType of R for [topologicalType of R^o]]. -Local Canonical realField_uniformType := - [uniformType of R for [uniformType of R^o]]. -Local Canonical realField_pseudoMetricType := - [pseudoMetricType R of R for [pseudoMetricType R of R^o]]. -Definition pointed_latticeType := [latticeType of realField_pointedType]. -Definition pointed_distrLatticeType := - [distrLatticeType of realField_pointedType]. -Definition pointed_orderType := [orderType of realField_pointedType]. -Definition pointed_realDomainType := - [realDomainType of realField_pointedType]. -Definition filtered_latticeType := [latticeType of realField_filteredType]. -Definition filtered_distrLatticeType := - [distrLatticeType of realField_filteredType]. -Definition filtered_orderType := [orderType of realField_filteredType]. -Definition filtered_realDomainType := - [realDomainType of realField_filteredType]. -Definition topological_latticeType := - [latticeType of realField_topologicalType]. -Definition topological_distrLatticeType := - [distrLatticeType of realField_topologicalType]. -Definition topological_orderType := [orderType of realField_topologicalType]. -Definition topological_realDomainType := - [realDomainType of realField_topologicalType]. -Definition uniform_latticeType := [latticeType of realField_uniformType]. -Definition uniform_distrLatticeType := - [distrLatticeType of realField_uniformType]. -Definition uniform_orderType := [orderType of realField_uniformType]. -Definition uniform_realDomainType := [realDomainType of realField_uniformType]. -Definition pseudoMetric_latticeType := - [latticeType of realField_pseudoMetricType]. -Definition pseudoMetric_distrLatticeType := - [distrLatticeType of realField_pseudoMetricType]. -Definition pseudoMetric_orderType := [orderType of realField_pseudoMetricType]. -Definition pseudoMetric_realDomainType := - [realDomainType of realField_pseudoMetricType]. -End realFieldType. - -Section numClosedFieldType. -Variable (R : numClosedFieldType). -Local Canonical numClosedField_pointedType := - [pointedType of R for [pointedType of R^o]]. -Local Canonical numClosedField_filteredType := - [filteredType R of R for [filteredType R of R^o]]. -Local Canonical numClosedField_topologicalType := - [topologicalType of R for [topologicalType of R^o]]. -Local Canonical numClosedField_uniformType := - [uniformType of R for [uniformType of R^o]]. -Local Canonical numClosedField_pseudoMetricType := - [pseudoMetricType R of R for [pseudoMetricType R of R^o]]. -Definition pointed_decFieldType := - [decFieldType of numClosedField_pointedType]. -Definition pointed_closedFieldType := - [closedFieldType of numClosedField_pointedType]. -Definition filtered_decFieldType := - [decFieldType of numClosedField_filteredType]. -Definition filtered_closedFieldType := - [closedFieldType of numClosedField_filteredType]. -Definition topological_decFieldType := - [decFieldType of numClosedField_topologicalType]. -Definition topological_closedFieldType := - [closedFieldType of numClosedField_topologicalType]. -Definition uniform_decFieldType := [decFieldType of numClosedField_uniformType]. -Definition uniform_closedFieldType := - [closedFieldType of numClosedField_uniformType]. -Definition pseudoMetric_decFieldType := - [decFieldType of numClosedField_pseudoMetricType]. -Definition pseudoMetric_closedFieldType := - [closedFieldType of numClosedField_pseudoMetricType]. -End numClosedFieldType. - -Section numFieldType. -Variable (R : numFieldType). -Local Canonical numField_pointedType := - [pointedType of R for [pointedType of R^o]]. -Local Canonical numField_filteredType := - [filteredType R of R for [filteredType R of R^o]]. -Local Canonical numField_topologicalType := - [topologicalType of R for [topologicalType of R^o]]. -Local Canonical numField_uniformType := - [uniformType of R for [uniformType of R^o]]. -Local Canonical numField_pseudoMetricType := - [pseudoMetricType R of R for [pseudoMetricType R of R^o]]. -Definition pointed_ringType := [ringType of numField_pointedType]. -Definition pointed_comRingType := [comRingType of numField_pointedType]. -Definition pointed_unitRingType := [unitRingType of numField_pointedType]. -Definition pointed_comUnitRingType := [comUnitRingType of numField_pointedType]. -Definition pointed_idomainType := [idomainType of numField_pointedType]. -Definition pointed_fieldType := [fieldType of numField_pointedType]. -Definition pointed_porderType := [porderType of numField_pointedType]. -Definition pointed_numDomainType := [numDomainType of numField_pointedType]. -Definition filtered_ringType := [ringType of numField_filteredType]. -Definition filtered_comRingType := [comRingType of numField_filteredType]. -Definition filtered_unitRingType := [unitRingType of numField_filteredType]. -Definition filtered_comUnitRingType := - [comUnitRingType of numField_filteredType]. -Definition filtered_idomainType := [idomainType of numField_filteredType]. -Definition filtered_fieldType := [fieldType of numField_filteredType]. -Definition filtered_porderType := [porderType of numField_filteredType]. -Definition filtered_numDomainType := [numDomainType of numField_filteredType]. -Definition topological_ringType := [ringType of numField_topologicalType]. -Definition topological_comRingType := [comRingType of numField_topologicalType]. -Definition topological_unitRingType := - [unitRingType of numField_topologicalType]. -Definition topological_comUnitRingType := - [comUnitRingType of numField_topologicalType]. -Definition topological_idomainType := [idomainType of numField_topologicalType]. -Definition topological_fieldType := [fieldType of numField_topologicalType]. -Definition topological_porderType := [porderType of numField_topologicalType]. -Definition topological_numDomainType := - [numDomainType of numField_topologicalType]. -Definition uniform_ringType := [ringType of numField_uniformType]. -Definition uniform_comRingType := [comRingType of numField_uniformType]. -Definition uniform_unitRingType := [unitRingType of numField_uniformType]. -Definition uniform_comUnitRingType := [comUnitRingType of numField_uniformType]. -Definition uniform_idomainType := [idomainType of numField_uniformType]. -Definition uniform_fieldType := [fieldType of numField_uniformType]. -Definition uniform_porderType := [porderType of numField_uniformType]. -Definition uniform_numDomainType := [numDomainType of numField_uniformType]. -Definition pseudoMetric_ringType := [ringType of numField_pseudoMetricType]. -Definition pseudoMetric_comRingType := - [comRingType of numField_pseudoMetricType]. -Definition pseudoMetric_unitRingType := - [unitRingType of numField_pseudoMetricType]. -Definition pseudoMetric_comUnitRingType := - [comUnitRingType of numField_pseudoMetricType]. -Definition pseudoMetric_idomainType := - [idomainType of numField_pseudoMetricType]. -Definition pseudoMetric_fieldType := [fieldType of numField_pseudoMetricType]. -Definition pseudoMetric_porderType := [porderType of numField_pseudoMetricType]. -Definition pseudoMetric_numDomainType := - [numDomainType of numField_pseudoMetricType]. -End numFieldType. - -Module Exports. -(* realType *) -Canonical real_pointedType. -Canonical real_filteredType. -Canonical real_topologicalType. -Canonical real_uniformType. -Canonical real_pseudoMetricType. -Coercion real_pointedType : realType >-> pointedType. -Coercion real_filteredType : realType >-> filteredType. -Coercion real_topologicalType : realType >-> topologicalType. -Coercion real_uniformType : realType >-> uniformType. -Coercion real_pseudoMetricType : realType >-> pseudoMetricType. -(* rcfType *) -Canonical rcf_pointedType. -Canonical rcf_filteredType. -Canonical rcf_topologicalType. -Canonical rcf_uniformType. -Canonical rcf_pseudoMetricType. -Coercion rcf_pointedType : rcfType >-> pointedType. -Coercion rcf_filteredType : rcfType >-> filteredType. -Coercion rcf_topologicalType : rcfType >-> topologicalType. -Coercion rcf_uniformType : rcfType >-> uniformType. -Coercion rcf_pseudoMetricType : rcfType >-> pseudoMetricType. -(* archiFieldType *) -Canonical archiField_pointedType. -Canonical archiField_filteredType. -Canonical archiField_topologicalType. -Canonical archiField_uniformType. -Canonical archiField_pseudoMetricType. -Coercion archiField_pointedType : archiFieldType >-> pointedType. -Coercion archiField_filteredType : archiFieldType >-> filteredType. -Coercion archiField_topologicalType : archiFieldType >-> topologicalType. -Coercion archiField_uniformType : archiFieldType >-> uniformType. -Coercion archiField_pseudoMetricType : archiFieldType >-> pseudoMetricType. -(* realFieldType *) -Canonical realField_pointedType. -Canonical realField_filteredType. -Canonical realField_topologicalType. -Canonical realField_uniformType. -Canonical realField_pseudoMetricType. -Canonical pointed_latticeType. -Canonical pointed_distrLatticeType. -Canonical pointed_orderType. -Canonical pointed_realDomainType. -Canonical filtered_latticeType. -Canonical filtered_distrLatticeType. -Canonical filtered_orderType. -Canonical filtered_realDomainType. -Canonical topological_latticeType. -Canonical topological_distrLatticeType. -Canonical topological_orderType. -Canonical topological_realDomainType. -Canonical uniform_latticeType. -Canonical uniform_distrLatticeType. -Canonical uniform_orderType. -Canonical uniform_realDomainType. -Canonical pseudoMetric_latticeType. -Canonical pseudoMetric_distrLatticeType. -Canonical pseudoMetric_orderType. -Canonical pseudoMetric_realDomainType. -Coercion realField_pointedType : realFieldType >-> pointedType. -Coercion realField_filteredType : realFieldType >-> filteredType. -Coercion realField_topologicalType : realFieldType >-> topologicalType. -Coercion realField_uniformType : realFieldType >-> uniformType. -Coercion realField_pseudoMetricType : realFieldType >-> pseudoMetricType. -(* numClosedFieldType *) -Canonical numClosedField_pointedType. -Canonical numClosedField_filteredType. -Canonical numClosedField_topologicalType. -Canonical numClosedField_uniformType. -Canonical numClosedField_pseudoMetricType. -Canonical pointed_decFieldType. -Canonical pointed_closedFieldType. -Canonical filtered_decFieldType. -Canonical filtered_closedFieldType. -Canonical topological_decFieldType. -Canonical topological_closedFieldType. -Canonical uniform_decFieldType. -Canonical uniform_closedFieldType. -Canonical pseudoMetric_decFieldType. -Canonical pseudoMetric_closedFieldType. -Coercion numClosedField_pointedType : numClosedFieldType >-> pointedType. -Coercion numClosedField_filteredType : numClosedFieldType >-> filteredType. -Coercion numClosedField_topologicalType : - numClosedFieldType >-> topologicalType. -Coercion numClosedField_uniformType : numClosedFieldType >-> uniformType. -Coercion numClosedField_pseudoMetricType : - numClosedFieldType >-> pseudoMetricType. -(* numFieldType *) -Canonical numField_pointedType. -Canonical numField_filteredType. -Canonical numField_topologicalType. -Canonical numField_uniformType. -Canonical numField_pseudoMetricType. -Canonical pointed_ringType. -Canonical pointed_comRingType. -Canonical pointed_unitRingType. -Canonical pointed_comUnitRingType. -Canonical pointed_idomainType. -Canonical pointed_fieldType. -Canonical pointed_porderType. -Canonical pointed_numDomainType. -Canonical filtered_ringType. -Canonical filtered_comRingType. -Canonical filtered_unitRingType. -Canonical filtered_comUnitRingType. -Canonical filtered_idomainType. -Canonical filtered_fieldType. -Canonical filtered_porderType. -Canonical filtered_numDomainType. -Canonical topological_ringType. -Canonical topological_comRingType. -Canonical topological_unitRingType. -Canonical topological_comUnitRingType. -Canonical topological_idomainType. -Canonical topological_fieldType. -Canonical topological_porderType. -Canonical topological_numDomainType. -Canonical uniform_ringType. -Canonical uniform_comRingType. -Canonical uniform_unitRingType. -Canonical uniform_comUnitRingType. -Canonical uniform_idomainType. -Canonical uniform_fieldType. -Canonical uniform_porderType. -Canonical uniform_numDomainType. -Canonical pseudoMetric_ringType. -Canonical pseudoMetric_comRingType. -Canonical pseudoMetric_unitRingType. -Canonical pseudoMetric_comUnitRingType. -Canonical pseudoMetric_idomainType. -Canonical pseudoMetric_fieldType. -Canonical pseudoMetric_porderType. -Canonical pseudoMetric_numDomainType. -Coercion numField_pointedType : numFieldType >-> pointedType. -Coercion numField_filteredType : numFieldType >-> filteredType. -Coercion numField_topologicalType : numFieldType >-> topologicalType. -Coercion numField_uniformType : numFieldType >-> uniformType. -Coercion numField_pseudoMetricType : numFieldType >-> pseudoMetricType. -End Exports. +#[export, non_forgetful_inheritance] +HB.instance Definition _ (R : realType) := PseudoMetric.copy R R^o. + +#[export, non_forgetful_inheritance] +HB.instance Definition _ (R : rcfType) := PseudoMetric.copy R R^o. + +#[export, non_forgetful_inheritance] +HB.instance Definition _ (R : archiFieldType) := PseudoMetric.copy R R^o. + +#[export, non_forgetful_inheritance] +HB.instance Definition _ (R : realFieldType) := PseudoMetric.copy R R^o. + +#[export, non_forgetful_inheritance] +HB.instance Definition _ (R : numClosedFieldType) := PseudoMetric.copy R R^o. + +#[export, non_forgetful_inheritance] +HB.instance Definition _ (R : numFieldType) := PseudoMetric.copy R R^o. + +Module Exports. HB.reexport. End Exports. End numFieldTopology. Import numFieldTopology.Exports. @@ -5526,42 +5806,53 @@ apply: Build_ProperFilter => A /nbhs_ballP[_/posnumP[e] Ae]. exists (x + e%:num / 2)%R; apply: Ae; last first. by rewrite eq_sym addrC -subr_eq subrr eq_sym. rewrite /ball /= opprD addrA subrr distrC subr0 ger0_norm //. -by rewrite {2}(splitr e%:num) ltr_spaddl. +by rewrite {2}(splitr e%:num) ltr_pwDl. Qed. -Section RestrictedUniformTopology. -Context {U : choiceType} (A : set U) {V : uniformType} . +Definition uniform_fun {U : Type} (A : set U) (V : Type) := U -> V. -Definition fct_RestrictedUniform := let _ := A in U -> V. -Definition fct_RestrictedUniformTopology := - @weak_uniformType - ([pointedType of @fct_RestrictedUniform]) - (fct_uniformType [choiceType of { x : U | x \in A }] V) - (@sigL U V A). +Notation "{ 'uniform`' A -> V }" := (@uniform_fun _ A V) : type_scope. +Notation "{ 'uniform' U -> V }" := ({uniform` [set: U] -> V}) : type_scope. +Notation "{ 'uniform' A , F --> f }" := + (cvg_to F (nbhs (f : {uniform` A -> _}))) : classical_set_scope. +Notation "{ 'uniform' , F --> f }" := + (cvg_to F (nbhs (f : {uniform _ -> _}))) : classical_set_scope. -Canonical fct_RestrictUniformFilteredType:= - [filteredType fct_RestrictedUniform of - fct_RestrictedUniform for - fct_RestrictedUniformTopology]. +(* BUG: + topology_Uniform__to__classical_sets_isPointed is already defined + HB did not try to give a fresh name + workaround: put a module around +*) +Module Export UniformFun. +HB.instance Definition _ (U : choiceType) (A : set U) (V : uniformType) := + Uniform.copy {uniform` A -> V} (weak_topology (@sigL _ V A)). +End UniformFun. -Canonical fct_RestrictUniformTopologicalType := - [topologicalType of fct_RestrictedUniform for fct_RestrictedUniformTopology]. +Lemma Rhausdorff (R : realFieldType) : hausdorff_space R. +Proof. +move=> x y clxy; apply/eqP; rewrite eq_le. +apply/in_segment_addgt0Pr => _ /posnumP[e]. +rewrite in_itv /= -ler_distl; have he : 0 < (e%:num / 2) by []. +have [z [zx_he yz_he]] := clxy _ _ (nbhsx_ballx x _ he) (nbhsx_ballx y _ he). +have := ball_triangle yz_he (ball_sym zx_he). +by rewrite -mulr2n -(mulr_natr (_ / _) 2) divfK// => /ltW. +Qed. -Canonical fct_restrictedUniformType := - [uniformType of fct_RestrictedUniform for fct_RestrictedUniformTopology]. +Section RestrictedUniformTopology. +Context {U : choiceType} (A : set U) {V : uniformType} . -Lemma uniform_nbhs (f : fct_RestrictedUniformTopology) P: +Lemma uniform_nbhs (f : {uniform` A -> V}) P: nbhs f P <-> (exists E, entourage E /\ [set h | forall y, A y -> E(f y, h y)] `<=` P). Proof. -split=> [[Q [[/= W oW <- /=] [Wf subP]]]|[E [entE subP]]]. +split=> [[Q [[/= W oW <- /=] Wf subP]]|[E [entE subP]]]. rewrite openE /= /interior in oW. case: (oW _ Wf) => ? [ /= E entE] Esub subW. exists E; split=> // h Eh; apply/subP/subW/Esub => /= [[u Au]]. by apply: Eh => /=; rewrite -inE. near=> g; apply: subP => y /mem_set Ay; rewrite -!(sigLE A). move: (SigSub _); near: g. -have := (@cvg_image _ _ (sigL A) _ f (nbhs_filter f) +have := (@cvg_image _ _ (@sigL _ V A) _ f (nbhs_filter f) (image_sigL point)).1 cvg_id [set h | forall y, E (sigL A f y, h y)]. case; first by exists [set fg | forall y, E (fg.1 y, fg.2 y)]; [exists E|]. move=> B nbhsB rBrE; apply: (filterS _ nbhsB) => g Bg [y yA]. @@ -5569,7 +5860,7 @@ by move: rBrE; rewrite eqEsubset; case => [+ _]; apply; exists g. Unshelve. all: by end_near. Qed. Lemma uniform_entourage : - @entourage fct_restrictedUniformType = + @entourage [the uniformType of {uniform` A -> V}] = filter_from (@entourage V) (fun P => [set fg | forall t : U, A t -> P (fg.1 t, fg.2 t)]). @@ -5585,65 +5876,54 @@ Qed. End RestrictedUniformTopology. -Notation "{ 'uniform`' A -> V }" := (@fct_RestrictedUniform _ A V) : - classical_set_scope. -Notation "{ 'uniform' U -> V }" := ({uniform` (@setT U) -> V}) : - classical_set_scope. - -Notation "{ 'uniform' A , F --> f }" := - (cvg_to [filter of F] - (filter_of (Phantom (fct_RestrictedUniform A) f))) - : classical_set_scope. -Notation "{ 'uniform' , F --> f }" := - (cvg_to [filter of F] - (filter_of (Phantom (fct_RestrictedUniform setT) f))) - : classical_set_scope. - (* We use this function to help coq identify the correct notation to use when printing. Otherwise you get goals like `F --> f -> F --> f` *) Lemma restricted_cvgE {U : choiceType} {V : uniformType} - (F : set (set (U -> V))) A (f : U -> V) : + (F : set_system (U -> V)) A (f : U -> V) : {uniform A, F --> f} = (F --> (f : {uniform` A -> V})). Proof. by []. Qed. -Definition fct_Pointwise U (V: topologicalType) := U -> V. - -Definition fct_PointwiseTopology (U : Type) (V : topologicalType) := - @product_topologicalType U (fun=> V). - -Canonical fct_PointwiseFilteredType (U : Type) (V : topologicalType) := - [filteredType @fct_Pointwise U V of - @fct_Pointwise U V for - @fct_PointwiseTopology U V]. - -Canonical fct_PointwiseTopologicalType (U : Type) (V : topologicalType) := - [topologicalType of - @fct_Pointwise U V for - @fct_PointwiseTopology U V]. - -Notation "{ 'ptws' U -> V }" := (@fct_Pointwise U V). - +Definition pointwise_fun (U V : Type) := U -> V. +Notation "{ 'ptws' U -> V }" := (@pointwise_fun U V) : type_scope. Notation "{ 'ptws' , F --> f }" := - (cvg_to [filter of F] (filter_of (Phantom (@fct_Pointwise _ _) f))) - : classical_set_scope. + (cvg_to F (nbhs (f : {ptws _ -> _}))) : classical_set_scope. + +Module Export PtwsFun. +HB.instance Definition _ (U : Type) (V : topologicalType) := + Topological.copy {ptws U -> V} (prod_topology (fun _ : U => V)). +End PtwsFun. Lemma pointwise_cvgE {U : Type} {V : topologicalType} - (F : set (set(U -> V))) (A : set U) (f : U -> V) : + (F : set_system(U -> V)) (A : set U) (f : U -> V) : {ptws, F --> f} = (F --> (f : {ptws U -> V})). Proof. by []. Qed. +Definition uniform_fun_family {U} V (fam : set U -> Prop) := U -> V. + +Notation "{ 'family' fam , U -> V }" := (@uniform_fun_family U V fam). +Notation "{ 'family' fam , F --> f }" := + (cvg_to F (@nbhs _ {family fam, _ -> _} f)) : type_scope. + +Module Export FamilyFun. +HB.instance Definition _ + {U : choiceType} {V : uniformType} (fam : set U -> Prop) := + Uniform.copy {family fam, U -> V} + (sup_topology (fun k : sigT fam => + Uniform.class [the uniformType of {uniform` projT1 k -> V}])). +End FamilyFun. + Section UniformCvgLemmas. Context {U : choiceType} {V : uniformType}. Lemma uniform_set1 F (f : U -> V) (x : U) : - Filter F -> {uniform [set x], F --> f} = ((g x) @[g --> F] --> f x). + Filter F -> {uniform [set x], F --> f} = (g x @[g --> F] --> f x). Proof. move=> FF; rewrite propeqE; split. - move=> + W => /(_ [set t | W (t x)]) +; rewrite /filter_of -nbhs_entourageE. + move=> + W => /(_ [set t | W (t x)]) +; rewrite -nbhs_entourageE. rewrite uniform_nbhs => + [Q entQ subW]. by apply; exists Q; split => // h Qf; exact/subW/Qf. -move=> Ff W; rewrite /filter_of uniform_nbhs => [[E] [entE subW]]. +move=> Ff W; rewrite uniform_nbhs => [[E] [entE subW]]. apply: (filterS subW); move/(nbhs_entourage (f x))/Ff: entE => //=; near_simpl. by apply: filter_app; apply: nearW=> ? ? ? ->. Qed. @@ -5663,7 +5943,7 @@ move => FF /uniform_subset_nbhs => /(_ f). by move=> nbhsF Acvg; apply: cvg_trans; [exact: Acvg|exact: nbhsF]. Qed. -Lemma pointwise_uniform_cvg (f : U -> V) (F : set (set (U -> V))) : +Lemma pointwise_uniform_cvg (f : U -> V) (F : set_system (U -> V)) : Filter F -> {uniform, F --> f} -> {ptws, F --> f}. Proof. move=> FF; rewrite cvg_sup => + i; have isubT : [set i] `<=` setT by move=> ?. @@ -5673,15 +5953,15 @@ apply: cvg_trans => W /=; rewrite nbhs_simpl; exists (@^~ i @^-1` W) => //. by rewrite image_preimage // eqEsubset; split=> // j _; exists (fun _ => j). Qed. -Lemma cvg_sigL (A : set U) (f : U -> V) (F : set (set (U -> V))) : +Lemma cvg_sigL (A : set U) (f : U -> V) (F : set_system (U -> V)) : Filter F -> {uniform A, F --> f} <-> {uniform, sigL A @ F --> sigL A f}. Proof. move=> FF; split. -- move=> cvgF P' /= /uniform_nbhs [ E [/= entE EsubP]]. +- move=> cvgF P' /uniform_nbhs [E [entE EsubP]]. apply: (filterS EsubP); apply: cvgF => /=. - apply: (filterS ( P:= [set h | forall y, A y -> E(f y, h y)])). + apply: (filterS (P := [set h | forall y, A y -> E(f y, h y)])). + by move=> h/= Eh [y ?] _; apply Eh; rewrite -inE. + by (apply/uniform_nbhs; eexists; split; eauto). - move=> cvgF P' /= /uniform_nbhs [ E [/= entE EsubP]]. @@ -5713,7 +5993,7 @@ by rewrite uniform_entourage; exists X'. Qed. Lemma uniform_restrict_cvg - (F : set (set (U -> V))) (f : U -> V) A : Filter F -> + (F : set_system (U -> V)) (f : U -> V) A : Filter F -> {uniform A, F --> f} <-> {uniform, restrict A @ F --> restrict A f}. Proof. move=> FF; rewrite cvg_sigL; split. @@ -5732,7 +6012,18 @@ move=> FF; rewrite cvg_sigL; split. by have := R u I; rewrite /patch Au. Qed. -Lemma cvg_uniformU (f : U -> V) (F : set (set (U -> V))) A B : Filter F -> +Lemma uniform_nbhsT (f : U -> V) : + (nbhs (f : {uniform U -> V})) = nbhs (f : [the topologicalType of U -> V]). +Proof. +rewrite eqEsubset; split=> A. + case/uniform_nbhs => E [entE] /filterS; apply. + exists [set fh | forall y, E (fh.1 y, fh.2 y)]; first by exists E. + by move=> ? /=. +case => J [E entE EJ] /filterS; apply; apply/uniform_nbhs; exists E. +by split => // z /= Efz; apply: EJ => t /=; exact: Efz. +Qed. + +Lemma cvg_uniformU (f : U -> V) (F : set_system (U -> V)) A B : Filter F -> {uniform A, F --> f} -> {uniform B, F --> f} -> {uniform (A `|` B), F --> f}. Proof. @@ -5741,50 +6032,24 @@ apply: (filterS EsubQ). rewrite (_: [set h | (forall y : U, (A `|` B) y -> E (f y, h y))] = [set h | forall y, A y -> E (f y, h y)] `&` [set h | forall y, B y -> E (f y, h y)]). -- apply filterI; [apply: AFf| apply: BFf]. +- apply: filterI; [apply: AFf| apply: BFf]. + by apply/uniform_nbhs; exists E; split. + by apply/uniform_nbhs; exists E; split. - rewrite eqEsubset; split=> h. - + by move=> R; split=> t ?; apply R;[left| right]. - + by move=> [R1 R2] y [? | ?]; [apply R1| apply R2]. + + by move=> R; split=> t ?; apply: R;[left| right]. + + by move=> [R1 R2] y [? | ?]; [apply: R1| apply: R2]. Qed. -Lemma cvg_uniform_set0 (F : set (set (U -> V))) (f : U -> V) : Filter F -> +Lemma cvg_uniform_set0 (F : set_system (U -> V)) (f : U -> V) : Filter F -> {uniform set0, F --> f}. Proof. move=> FF P /= /uniform_nbhs [E [? R]]. -suff -> : P = setT by apply filterT. +suff -> : P = setT by exact: filterT. rewrite eqEsubset; split => //=. by apply: subset_trans R => g _ ?. Qed. -Definition fct_UniformFamily (fam : (set U) -> Prop) := U -> V. - -Definition family_cvg_uniformType (fam: set U -> Prop) := - @sup_uniformType _ - (sigT fam) - (fun k => Uniform.class (@fct_restrictedUniformType U (projT1 k) V)). - -Canonical fct_UniformFamilyFilteredType fam := - [filteredType fct_UniformFamily fam of - fct_UniformFamily fam for - family_cvg_uniformType fam]. - -Canonical fct_UniformFamilyTopologicalType fam := - [topologicalType of - fct_UniformFamily fam for - family_cvg_uniformType fam]. - -Canonical fct_UniformFamilyUniformType fam := - [uniformType of - fct_UniformFamily fam for - family_cvg_uniformType fam]. - -Local Notation "{ 'family' fam , F --> f }" := - (cvg_to [filter of F] (filter_of (Phantom (fct_UniformFamily fam) f))) - : classical_set_scope. - -Lemma fam_cvgP (fam : set U -> Prop) (F : set (set (U -> V))) (f : U -> V) : +Lemma fam_cvgP (fam : set U -> Prop) (F : set_system (U -> V)) (f : U -> V) : Filter F -> {family fam, F --> f} <-> (forall A : set U, fam A -> {uniform A, F --> f }). Proof. @@ -5792,7 +6057,7 @@ split; first by move=> /cvg_sup + A FA; move/(_ (existT _ _ FA)). by move=> famFf /=; apply/cvg_sup => [[? ?] FA]; apply: famFf. Qed. -Lemma family_cvg_subset (famA famB : set U -> Prop) (F : set (set (U -> V))) +Lemma family_cvg_subset (famA famB : set U -> Prop) (F : set_system (U -> V)) (f : U -> V) : Filter F -> famA `<=` famB -> {family famB, F --> f} -> {family famA, F --> f}. Proof. @@ -5800,30 +6065,26 @@ by move=> FF S /fam_cvgP famBFf; apply/fam_cvgP => A ?; apply/famBFf/S. Qed. Lemma family_cvg_finite_covers (famA famB : set U -> Prop) - (F : set (set (U -> V))) (f : U -> V) : Filter F -> + (F : set_system (U -> V)) (f : U -> V) : Filter F -> (forall P, famA P -> exists (I : choiceType) f, - (forall i, famB (f i)) /\ finSubCover (@setT I) f P) -> + (forall i, famB (f i)) /\ finite_subset_cover [set: I] f P) -> {family famB, F --> f} -> {family famA, F --> f}. Proof. move=> FF ex_finCover /fam_cvgP rFf; apply/fam_cvgP => A famAA. move: ex_finCover => /(_ _ famAA) [R [g [g_famB [D _]]]]. move/uniform_subset_cvg; apply. elim/finSet_rect: D => X IHX. -have [/eqP ->|/set0P[x xX]] := boolP ([set i | i \in X] == set0). - by rewrite bigcup_set0; apply: cvg_uniform_set0. -rewrite (bigcup_fsetD1 x)//; apply: cvg_uniformU. +have [->|/set0P[x xX]] := eqVneq [set` X] set0. + by rewrite coverE bigcup_set0; apply: cvg_uniform_set0. +rewrite coverE (bigcup_fsetD1 x)//; apply: cvg_uniformU. exact/rFf/g_famB. exact/IHX/fproperD1. Qed. -End UniformCvgLemmas. -Notation "{ 'family' fam , U -> V }" := (@fct_UniformFamily U V fam). -Notation "{ 'family' fam , F --> f }" := - (cvg_to [filter of F] (filter_of (Phantom (fct_UniformFamily fam) f))) - : classical_set_scope. +End UniformCvgLemmas. -Lemma fam_cvgE {U : choiceType} {V : uniformType} (F : set (set (U -> V))) +Lemma fam_cvgE {U : choiceType} {V : uniformType} (F : set_system (U -> V)) (f : U -> V) fam : {family fam, F --> f} = (F --> (f : {family fam, U -> V})). Proof. by []. Qed. @@ -5836,11 +6097,182 @@ move=> entE famA; have /fam_cvgP /(_ A) : (nbhs f --> f) by []; apply => //. by apply uniform_nbhs; exists E; split. Qed. +Lemma fam_compact_nbhs {U : topologicalType} {V : uniformType} + (A : set U) (O : set V) (f : {family compact, U -> V}) : + open O -> f @` A `<=` O -> compact A -> continuous f -> + nbhs (f : {family compact, U -> V}) [set g | forall y, A y -> O (g y)]. +Proof. +move=> oO fAO /[dup] cA /compact_near_coveringP/near_covering_withinP cfA ctsf. +near=> z => /=; (suff: A `<=` [set y | O (z y)] by exact); near: z. +apply: cfA => x Ax; have : O (f x) by exact: fAO. +move: (oO); rewrite openE /= => /[apply] /[dup] /ctsf Ofx /=. +rewrite /interior -nbhs_entourageE => -[E entE EfO]. +exists (f @^-1` to_set (split_ent E) (f x), + [set g | forall w, A w -> split_ent E (f w, g w)]). + split => //=; last exact: fam_nbhs. + by apply: ctsf; rewrite /= -nbhs_entourageE; exists (split_ent E). +case=> y g [/= Efxy] AEg Ay; apply: EfO; apply: subset_split_ent => //. +by exists (f y) => //=; exact: AEg. +Unshelve. all: by end_near. Qed. + +(**md It turns out `{family compact, U -> V}` can be generalized to only assume + `topologicalType` on `V`. This topology is called the compact-open topology. + This topology is special because it is the _only_ topology that will allow + `curry`/`uncurry` to be continuous. *) + +Section compact_open. +Context {T U : topologicalType}. + +Definition compact_open : Type := T -> U. + +Section compact_open_setwise. +Context {K : set T}. + +Definition compact_openK := let _ := K in compact_open. + +Definition compact_openK_nbhs (f : compact_openK) := + filter_from + [set O | f @` K `<=` O /\ open O] + (fun O => [set g | g @` K `<=` O]). + +Global Instance compact_openK_nbhs_filter (f : compact_openK) : + ProperFilter (compact_openK_nbhs f). +Proof. +split; first by case=> g [gKO oO] /(_ f); apply. +apply: filter_from_filter; first by exists setT; split => //; exact: openT. +move=> P Q [fKP oP] [fKQ oQ]; exists (P `&` Q); first split. +- by move=> ? [z Kz M-]; split; [apply: fKP | apply: fKQ]; exists z. +- exact: openI. +by move=> g /= gPQ; split; exact: (subset_trans gPQ). +Qed. + +HB.instance Definition _ := Pointed.on compact_openK. + +HB.instance Definition _ := hasNbhs.Build compact_openK compact_openK_nbhs. + +Definition compact_open_of_nbhs := [set A : set compact_openK | A `<=` nbhs^~ A]. + +Lemma compact_openK_nbhsE_subproof (p : compact_openK) : + compact_openK_nbhs p = + [set A | exists B : set compact_openK, + [/\ compact_open_of_nbhs B, B p & B `<=` A]]. +Proof. +rewrite eqEsubset; split => A /=. + case=> B /= [fKB oB gKBA]; exists [set g | g @` K `<=` B]; split => //. + by move=> h /= hKB; exists B. +by case=> B [oB Bf /filterS]; apply; exact: oB. +Qed. + +Lemma compact_openK_openE_subproof : + compact_open_of_nbhs = [set A | A `<=` compact_openK_nbhs^~ A]. +Proof. by []. Qed. + +HB.instance Definition _ := + Nbhs_isTopological.Build compact_openK compact_openK_nbhs_filter + compact_openK_nbhsE_subproof compact_openK_openE_subproof. + +End compact_open_setwise. + +HB.instance Definition _ := Pointed.on compact_open. + +Definition compact_open_def := + sup_topology (fun i : sigT (@compact T) => + Topological.class (@compact_openK (projT1 i))). + +HB.instance Definition _ := Nbhs.copy compact_open compact_open_def. + +HB.instance Definition _ : Nbhs_isTopological compact_open := + Topological.copy compact_open compact_open_def. + +Lemma compact_open_cvgP (F : set_system compact_open) + (f : compact_open) : + Filter F -> + F --> f <-> forall K O, @compact T K -> @open U O -> f @` K `<=` O -> + F [set g | g @` K `<=` O]. +Proof. +move=> FF; split. + by move/cvg_sup => + K O cptK ? ? => /(_ (existT _ _ cptK)); apply; exists O. +move=> fko; apply/cvg_sup => -[A cptK] O /= [C /= [fAC oC]]. +by move/filterS; apply; exact: fko. +Qed. + +Lemma compact_open_open (K : set T) (O : set U) : + compact K -> open O -> open ([set g | g @` K `<=` O] : set compact_open). +Proof. +pose C := [set g | g @` K `<=` O]; move=> cptK oO. +exists [set C]; last by rewrite bigcup_set1. +move=> _ ->; exists (fset1 C) => //; last by rewrite set_fset1 bigcap_set1. +by move=> _ /[!inE] ->; exists (existT _ _ cptK) => // z Cz; exists O. +Qed. + +End compact_open. + +Lemma compact_closedI {T : topologicalType} (A B : set T) : + compact A -> closed B -> compact (A `&` B). +Proof. +move=> cptA clB F PF FAB; have FA : F A by move: FAB; exact: filterS. +(have FB : F B by move: FAB; apply: filterS); have [x [Ax]] := cptA F PF FA. +move=> /[dup] clx; rewrite {1}clusterE => /(_ (closure B)); move: clB. +by rewrite closure_id => /[dup] + <- => <- /(_ FB) Bx; exists x. +Qed. + +Notation "{ 'compact-open' , U -> V }" := (@compact_open U V). +Notation "{ 'compact-open' , F --> f }" := + (F --> (f : @compact_open _ _)). + +Section compact_open_uniform. +Context {U : topologicalType} {V : uniformType}. + +Let small_ent_sub := @small_set_sub _ (@entourage V). + +Lemma compact_open_fam_compactP (f : U -> V) (F : set_system (U -> V)) : + continuous f -> Filter F -> + {compact-open, F --> f} <-> {family compact, F --> f}. +Proof. +move=> ctsf FF; split; first last. + move=> cptF; apply/compact_open_cvgP => K O cptK oO fKO. + apply: cptF; have := fam_compact_nbhs oO fKO cptK ctsf; apply: filter_app. + by near=> g => /= gKO ? [z Kx <-]; exact: gKO. +move/compact_open_cvgP=> cptOF; apply/cvg_sup => -[K cptK R]. +case=> D [[E oE <-] Ekf] /filterS; apply. +move: oE; rewrite openE => /(_ _ Ekf); case => A [J entJ] EKR KfE. +near=> z; apply/KfE/EKR => -[u Kp]; rewrite /= /set_val /= /eqincl /incl. +(have Ku : K u by rewrite inE in Kp); move: u Ku {D Kp}; near: z. +move/compact_near_coveringP/near_covering_withinP : (cptK); apply. +move=> u Ku; near (powerset_filter_from (@entourage V)) => E'. +have entE' : entourage E' by exact: (near (near_small_set _)). +pose C := f @^-1` to_set E' (f u). +pose B := \bigcup_(z in K `&` closure C) interior (to_set E' (f z)). +have oB : open B by apply: bigcup_open => ? ?; exact: open_interior. +have fKB : f @` (K `&` closure C) `<=` B. + move=> _ [z KCz <-]; exists z => //; rewrite /interior. + by rewrite -nbhs_entourageE; exists E'. +have cptKC : compact (K `&` closure C). + by apply: compact_closedI => //; exact: closed_closure. +have := cptOF (K `&` closure C) B cptKC oB fKB. +exists (C, [set g | [set g x | x in K `&` closure C] `<=` B]). + split; last exact: cptOF. + by apply: (ctsf) => //; rewrite /filter_of -nbhs_entourageE; exists E'. +case=> z h /= [Cz KB Kz]. +case: (KB (h z)); first by exists z; split => //; exact: subset_closure. +move=> w [Kw Cw /interior_subset Jfwhz]; apply: subset_split_ent => //. +exists (f w); last apply: (near (small_ent_sub _) E') => //. +apply: subset_split_ent => //; exists (f u). + by apply/entourage_sym; apply: (near (small_ent_sub _) E'). +have [] := Cw (f@^-1` (to_set E' (f w))). + by apply: ctsf; rewrite /= -nbhs_entourageE; exists E'. +move=> r [Cr /= Ewr]; apply: subset_split_ent => //; exists (f r). + exact: (near (small_ent_sub _) E'). +by apply/entourage_sym; apply: (near (small_ent_sub _) E'). +Unshelve. all: by end_near. Qed. + +End compact_open_uniform. + Definition compactly_in {U : topologicalType} (A : set U) := [set B | B `<=` A /\ compact B]. Lemma compact_cvg_within_compact {U : topologicalType} {V : uniformType} - (C : set U) (F : set (set (U -> V))) (f : U -> V) : + (C : set U) (F : set_system (U -> V)) (f : U -> V) : Filter F -> compact C -> {uniform C, F --> f} <-> {family compactly_in C, F --> f}. Proof. @@ -5857,7 +6289,7 @@ apply: Build_ProperFilter => A /nbhs_ballP[_/posnumP[e] Ae]. exists (x + e%:num / 2)%R; apply: Ae; last first. by rewrite eq_sym addrC -subr_eq subrr eq_sym. rewrite /ball /= opprD addrA subrr distrC subr0 ger0_norm //. -by rewrite {2}(splitr e%:num) ltr_spaddl. +by rewrite {2}(splitr e%:num) ltr_pwDl. Qed. Definition dense (T : topologicalType) (S : set T) := @@ -5874,28 +6306,48 @@ Qed. Lemma dense_rat (R : realType) : dense (@ratr R @` setT). Proof. move=> A [r Ar]; rewrite openE => /(_ _ Ar)/nbhs_ballP[_/posnumP[e] reA]. -have /rat_in_itvoo[q /itvP qre] : r < r + e%:num by rewrite ltr_addl. +have /rat_in_itvoo[q /itvP qre] : r < r + e%:num by rewrite ltrDl. exists (ratr q) => //; split; last by exists q. apply: reA; rewrite /ball /= distrC ltr_distl qre andbT. -by rewrite (@le_lt_trans _ _ r)// ?qre// ler_subl_addl ler_addr ltW. +by rewrite (@le_lt_trans _ _ r)// ?qre// lerBlDl lerDr ltW. +Qed. + +Lemma separated_open_countable + {R : realType} (I : Type) (B : I -> set R) (D : set I) : + (forall i, open (B i)) -> (forall i, B i !=set0) -> + trivIset D B -> countable D. +Proof. +move=> oB B0 tB; have [f fB] : + {f : I -> rat & forall i, D i -> B i (ratr (f i))}. + apply: (@choice _ _ (fun x y => D x -> B x (ratr y))) => i. + have [r [Bir [q _ qr]]] := dense_rat (B0 _) (oB i). + by exists q => Di; rewrite qr. +have inj_f : {in D &, injective f}. + move=> i j /[!inE] Di Dj /(congr1 ratr) ratrij. + have ? : (B i `&` B j) (ratr (f i)). + by split => //; [exact: fB|rewrite ratrij; exact: fB]. + by apply/(tB _ _ Di Dj); exists (ratr (f i)). +apply/pcard_injP; have /card_bijP/cid[g bijg] := card_rat. +pose nat_of_rat (q : rat) : nat := set_val (g (to_setT q)). +have inj_nat_of_rat : injective nat_of_rat. + rewrite /nat_of_rat; apply: inj_comp => //; apply: inj_comp => //. + exact/bij_inj. +by exists (nat_of_rat \o f) => i j Di Dj /inj_nat_of_rat/inj_f; exact. Qed. Section weak_pseudoMetric. Context {R : realType} (pS : pointedType) (U : pseudoMetricType R) . Variable (f : pS -> U). -Let S := weak_uniformType f. +Notation S := (weak_topology f). Definition weak_ball (x : S) (r : R) (y : S) := ball (f x) r (f y). -Program Definition weak_pseudoMetricType_mixin := - @PseudoMetric.Mixin R S entourage weak_ball - _ _ _ _. +Lemma weak_pseudo_metric_ball_center (x : S) (e : R) : 0 < e -> weak_ball x e x. +Proof. by move=> /posnumP[{}e]; exact: ball_center. Qed. -Next Obligation. by move=> ? _/posnumP[e]; exact: ball_center. Qed. -Next Obligation. by move=> ? ? ?; exact: ball_sym. Qed. -Next Obligation. move=> ? ? ? ? ?; exact: ball_triangle. Qed. -Next Obligation. +Lemma weak_pseudo_metric_entourageE : entourage = entourage_ weak_ball. +Proof. rewrite /entourage /= /weak_ent -entourage_ballE /entourage_. have -> : (fun e => [set xy | ball (f xy.1) e (f xy.2)]) = (preimage (map_pair f) \o fun e => [set xy | ball xy.1 e xy.2])%FUN. @@ -5918,15 +6370,51 @@ rewrite eqEsubset; split; apply/filter_fromP. - by move=> e ?; exists ([set xy | ball xy.1 e xy.2]) => //; by exists e => /=. Qed. -Definition weak_pseudoMetricType := - PseudoMetricType S weak_pseudoMetricType_mixin. +HB.instance Definition _ := Uniform_isPseudoMetric.Build R S + weak_pseudo_metric_ball_center (fun _ _ _ => @ball_sym _ _ _ _ _) + (fun _ _ _ _ _ => @ball_triangle _ _ _ _ _ _ _) + weak_pseudo_metric_entourageE. -Lemma weak_ballE (e : R) (x : weak_pseudoMetricType) : - f@^-1` (ball (f x) e) = ball x e. +Lemma weak_ballE (e : R) (x : S) : f@^-1` (ball (f x) e) = ball x e. Proof. by []. Qed. End weak_pseudoMetric. +Lemma compact_second_countable {R : realType} {T : pseudoMetricType R} : + compact [set: T] -> @second_countable T. +Proof. +have npos n : (0:R) < n.+1%:R^-1 by []. +pose f n (z : T): set T := (ball z (PosNum (npos n))%:num)^°. +move=> cmpt; have h n : finite_subset_cover [set: T] (f n) [set: T]. + move: cmpt; rewrite compact_cover; apply. + - by move=> z _; rewrite /f; exact: open_interior. + - by move=> z _; exists z => //; rewrite /f /interior; exact: nbhsx_ballx. +pose h' n := cid (iffLR (exists2P _ _) (h n)). +pose h'' n := projT1 (h' n). +pose B := \bigcup_n (f n) @` [set` h'' n]; exists B;[|split]. +- apply: bigcup_countable => // n _; apply: finite_set_countable. + exact/finite_image/ finite_fset. +- by move => ? [? _ [? _ <-]]; exact: open_interior. +- move=> x V /nbhs_ballP [] _/posnumP[eps] ballsubV. + have [//|N] := @ltr_add_invr R 0%R (eps%:num/2) _; rewrite add0r => deleps. + have [w wh fx] : exists2 w : T, w \in h'' N & f N w x. + by have [_ /(_ x) [// | w ? ?]] := projT2 (h' N); exists w. + exists (f N w); first split => //; first (by exists N). + apply: (subset_trans _ ballsubV) => z bz. + rewrite [_%:num]splitr; apply: (@ball_triangle _ _ w). + by apply: (le_ball (ltW deleps)); apply/ball_sym; apply: interior_subset. + by apply: (le_ball (ltW deleps)); apply: interior_subset. +Qed. + +Lemma clopen_surj {R : realType} {T : pseudoMetricType R} : + compact [set: T] -> $|{surjfun [set: nat] >-> @clopen T}|. +Proof. +move=> cmptT. +suff : @clopen T = set0 \/ $|{surjfun [set: nat] >-> @clopen T}|. + by case => //; rewrite eqEsubset => -[/(_ _ clopenT)]. +exact/pfcard_geP/clopen_countable/compact_second_countable. +Qed. + (* This section proves that uniform spaces, with a countable base for their entourage, are metrizable. The definition of this metric is rather arcane, and the proof is tough. That's ok because the resulting metric is not @@ -5936,12 +6424,19 @@ End weak_pseudoMetric. - `in metric spaces, compactness and sequential compactness agree` - infinite products of metric spaces are metrizable *) +Module countable_uniform. Section countable_uniform. -Context {R : realType} {T : uniformType} (f_ : nat -> set (T * T)). +Context {R : realType} {T : uniformType}. + +Hypothesis cnt_unif : @countable_uniformity T. -Hypothesis countableBase : forall A, entourage A -> exists N, f_ N `<=` A. +Let f_ := projT1 (cid2 (iffLR countable_uniformityP cnt_unif)). -Hypothesis entF : forall n, entourage (f_ n). +Local Lemma countableBase : forall A, entourage A -> exists N, f_ N `<=` A. +Proof. by have [] := projT2 (cid2 (iffLR countable_uniformityP cnt_unif)). Qed. + +Let entF : forall n, entourage (f_ n). +Proof. by have [] := projT2 (cid2 (iffLR countable_uniformityP cnt_unif)). Qed. (* Step 1: We build a nicer base `g` for `entourage` with better assumptions than `f` @@ -5954,14 +6449,12 @@ Local Fixpoint g_ (n : nat) : set (T * T) := if n is S n then let W := split_ent (split_ent (g_ n)) `&` f_ n in W `&` W^-1 else [set: T*T]. -Local Lemma entG (n : nat) : entourage (g_ n). +Let entG (n : nat) : entourage (g_ n). Proof. elim: n => /=; first exact: entourageT. by move=> n entg; apply/entourage_invI; exact: filterI. Qed. -#[local] Hint Resolve entG : core. - Local Lemma symG (n : nat) : ((g_ n)^-1)%classic = g_ n. Proof. by case: n => // n; rewrite eqEsubset; split; case=> ? ?; rewrite /= andC. @@ -5974,7 +6467,7 @@ apply: subIset; left; apply: subIset; left; apply: subset_trans. by apply: subset_trans; last exact: split_ent_subset. Qed. -Local Lemma descendG (n m: nat) : (m <= n)%N -> g_ n `<=` g_ m. +Local Lemma descendG (n m : nat) : (m <= n)%N -> g_ n `<=` g_ m. Proof. elim: n; rewrite ?leqn0; first by move=>/eqP ->. move=> n IH; rewrite leq_eqVlt ltnS => /orP [/eqP <- //|] /IH. @@ -6031,11 +6524,11 @@ Local Lemma distN_le e1 e2 : e1 > 0 -> e1 <= e2 -> (distN e2 <= distN e1)%N. Proof. move=> e1pos e1e2; rewrite /distN; apply: lez_abs2. by rewrite floor_ge0 ltW// invr_gt0 (lt_le_trans _ e1e2). -by rewrite le_floor// lef_pinv ?invrK ?invr_gt0//; exact: (lt_le_trans _ e1e2). +by rewrite le_floor// lef_pV2 ?invrK ?invr_gt0//; exact: (lt_le_trans _ e1e2). Qed. Local Fixpoint n_step_ball n x e z := - if n is S n then exists y d1 d2, + if n is n.+1 then exists y d1 d2, [/\ n_step_ball n x d1 y, 0 < d1, 0 < d2, @@ -6122,7 +6615,7 @@ move: x e1 e2; elim: n. by apply: descendG; last (exact: gxy); exact: distN_le. move=> n IH x e1 e2 e1e2 z [y] [d1] [d2] [] /IH P d1pos d2pos gyz d1d2e1. have d1e1d2 : d1 = e1 - d2 by rewrite -d1d2e1 -addrA subrr addr0. -have e2d2le : e1 - d2 <= e2 - d2 by exact: ler_sub. +have e2d2le : e1 - d2 <= e2 - d2 by exact: lerB. exists y, (e2 - d2), d2; split => //. - by apply: P; apply: le_trans e2d2le; rewrite d1e1d2. - by apply: lt_le_trans e2d2le; rewrite -d1e1d2. @@ -6136,7 +6629,7 @@ Proof. by move=> e1e2 ? [n P]; exists n; exact: (n_step_ball_le e1e2). Qed. Local Lemma distN_half (n : nat) : n.+1%:R^-1 / (2:R) <= n.+2%:R^-1. Proof. rewrite -invrM //; [|exact: unitf_gt0 |exact: unitf_gt0]. -rewrite lef_pinv ?posrE // -?natrM ?ler_nat -addn1 -addn1 -addnA mulnDr. +rewrite lef_pV2 ?posrE // -?natrM ?ler_nat -addn1 -addn1 -addnA mulnDr. by rewrite muln1 leq_add2r leq_pmull. Qed. @@ -6156,25 +6649,25 @@ move: e1 e2 x z; elim: n. move=> e1d1; exists x, y, 0%N, 0%N; split. - exact: n_step_ball_center. - apply: n_step_ball_le; last exact: Oxy. - by rewrite -deE ler_addl; apply: ltW. + by rewrite -deE lerDl; apply: ltW. - apply: (@n_step_ball_le _ _ d2); last by split. - rewrite -[e2]addr0 -(subrr e1) addrA -ler_subl_addr opprK addrC. - by rewrite [e2 + _]addrC -deE; exact: ler_add. + rewrite -[e2]addr0 -(subrr e1) addrA -lerBlDr opprK addrC. + by rewrite [e2 + _]addrC -deE; exact: lerD. - by rewrite addn0. move=> /negP; rewrite -real_ltNge ?num_real //. move=> e1d1; exists y, z, 0%N, 0%N; split. - by apply: n_step_ball_le; last (exact: Oxy); exact: ltW. - rewrite -deE; apply: (@n_step_ball_le _ _ d2) => //. - by rewrite ler_addr; apply: ltW. + by rewrite lerDr; apply: ltW. - exact: n_step_ball_center. - by rewrite addn0. move=> n IH e1 e2 x z e1pos e2pos [y] [d1] [d2] [] Od1xy d1pos d2pos gd2yz deE. case: (pselect (e2 <= d2)). move=> e2d2; exists y, z, n.+1, 0%N; split. - apply: (@n_step_ball_le _ _ d1); rewrite // -[e1]addr0 -(subrr e2) addrA. - by rewrite -deE -ler_subl_addr opprK ler_add. + by rewrite -deE -lerBlDr opprK lerD. - apply: (@n_step_ball_le _ _ d2); last by split. - by rewrite -deE ler_addr; exact: ltW. + by rewrite -deE lerDr; exact: ltW. - exact: n_step_ball_center. - by rewrite addn0. have d1E' : d1 = e1 + (e2 - d2). @@ -6183,7 +6676,7 @@ move=> /negP; rewrite -?real_ltNge // ?num_real // => d2lee2. case: (IH e1 (e2 - d2) x y); rewrite ?subr_gt0 // -d1E' //. move=> t1 [t2] [c1] [c2] [] Oxy1 gt1t2 t2y <-. exists t1, t2, c1, c2.+1; split => //. - - by apply: (@n_step_ball_le _ _ d1); rewrite -?deE // ?ler_addl; exact: ltW. + - by apply: (@n_step_ball_le _ _ d1); rewrite -?deE // ?lerDl; exact: ltW. - exists y, (e2 - d2), d2; split; rewrite // ?subr_gt0//. by rewrite -addrA [-_ + _]addrC subrr addr0. - by rewrite addnS. @@ -6206,10 +6699,8 @@ move=> l ln1 Ox1x4. case: (@split_n_step_ball l x1 (N.+1%:R^-1/2) (N.+1%:R^-1/2) x4) => //. by rewrite -splitr. move=> x2 [x3] [l1] [l2] [] P1 [? +] P3 l1l2; rewrite -splitr distN_nat => ?. -have l1n : (l1 <= n)%N. - by apply (leq_trans (leq_addr l2 l1)); rewrite l1l2 -ltnS. -have l2n : (l2 <= n)%N. - by apply (leq_trans (leq_addl l1 l2)); rewrite l1l2 -ltnS. +have l1n : (l1 <= n)%N by rewrite (leq_trans (leq_addr l2 l1))// l1l2 -ltnS. +have l2n : (l2 <= n)%N by rewrite (leq_trans (leq_addl l1 l2))// l1l2 -ltnS. apply: splitG3; exists x3; [exists x2 => //|]. by move/(n_step_ball_le (distN_half N))/(IH1 _ l1n) : P1. by move/(n_step_ball_le (distN_half N))/(IH1 _ l2n) : P3. @@ -6229,11 +6720,54 @@ apply: (subset_trans _ fN); apply: subset_trans; last apply: gsubf. by case=> x y /= N1ball; apply: (@subset_step_ball x N.+1). Qed. -(* Note this is the only non-local result from this section *) -Definition countable_uniform_pseudoMetricType_mixin := PseudoMetric.Mixin +Definition type : Type := let _ := countableBase in let _ := entF in T. + +#[export] HB.instance Definition _ := Uniform.on type. +#[export] HB.instance Definition _ := Uniform_isPseudoMetric.Build R type step_ball_center step_ball_sym step_ball_triangle step_ball_entourage. +Lemma countable_uniform_bounded (x y : T) : + let U := [the pseudoMetricType R of type] + in @ball _ U x 2 y. +Proof. +rewrite /ball; exists O%N; rewrite /n_step_ball; split; rewrite // /distN. +suff -> : @floor R 2^-1 = 0 by rewrite absz0 /=. +apply/eqP; rewrite -[_ == _]negbK; rewrite floor_neq0 negb_or -?ltNge -?leNgt. +by apply/andP; split => //; rewrite invf_lt1 //= ltrDl. +Qed. + +End countable_uniform. +Module Exports. HB.reexport. End Exports. End countable_uniform. +Export countable_uniform.Exports. + +Notation countable_uniform := countable_uniform.type. + +Definition sup_pseudometric (R : realType) (T : pointedType) (Ii : Type) + (Tc : Ii -> PseudoMetric R T) (Icnt : countable [set: Ii]) : Type := T. + +Section sup_pseudometric. +Variable (R : realType) (T : pointedType) (Ii : Type). +Variable (Tc : Ii -> PseudoMetric R T). + +Hypothesis Icnt : countable [set: Ii]. + +Local Notation S := (sup_pseudometric Tc Icnt). + +Let TS := fun i => PseudoMetric.Pack (Tc i). + +Definition countable_uniformityT := @countable_sup_ent T Ii Tc Icnt + (fun i => @countable_uniformity_metric _ (TS i)). + +HB.instance Definition _ : PseudoMetric R S := + PseudoMetric.on (countable_uniform countable_uniformityT). + +End sup_pseudometric. + +HB.instance Definition _ (R : realType) (Ii : countType) + (Tc : Ii -> pseudoMetricType R) := PseudoMetric.copy (prod_topology Tc) + (sup_pseudometric (fun i => PseudoMetric.class + [the pseudoMetricType R of weak_topology (@proj _ Tc i)]) (countableP _)). Definition subspace {T : Type} (A : set T) := T. Arguments subspace {T} _ : simpl never. @@ -6243,16 +6777,16 @@ Definition incl_subspace {T A} (x : subspace A) : T := x. Section Subspace. Context {T : topologicalType} (A : set T). -Definition nbhs_subspace (x : subspace A) : set (set (subspace A)) := +Definition nbhs_subspace (x : subspace A) : set_system (subspace A) := if x \in A then within A (nbhs x) else globally [set x]. -Variant nbhs_subspace_spec x : Prop -> Prop -> bool -> set (set T) -> Type := +Variant nbhs_subspace_spec x : Prop -> Prop -> bool -> set_system T -> Type := | WithinSubspace : A x -> nbhs_subspace_spec x True False true (within A (nbhs x)) | WithoutSubspace : ~ A x -> nbhs_subspace_spec x False True false (globally [set x]). -Lemma nbhs_subspaceP x : +Lemma nbhs_subspaceP_subproof x : nbhs_subspace_spec x (A x) (~ A x) (x \in A) (nbhs_subspace x). Proof. rewrite /nbhs_subspace; case:(boolP (x \in A)); rewrite ?(inE, notin_set) => xA. @@ -6261,41 +6795,43 @@ by rewrite (@propext (A x) False)// not_False; constructor. Qed. Lemma nbhs_subspace_in (x : T) : A x -> within A (nbhs x) = nbhs_subspace x. -Proof. by case: nbhs_subspaceP. Qed. +Proof. by case: nbhs_subspaceP_subproof. Qed. Lemma nbhs_subspace_out (x : T) : ~ A x -> globally [set x] = nbhs_subspace x. -Proof. by case: nbhs_subspaceP. Qed. +Proof. by case: nbhs_subspaceP_subproof. Qed. Lemma nbhs_subspace_filter (x : subspace A) : ProperFilter (nbhs_subspace x). Proof. -case: nbhs_subspaceP => ?; last exact: globally_properfilter. +case: nbhs_subspaceP_subproof => ?; last exact: globally_properfilter. by apply: within_nbhs_proper; apply: subset_closure. Qed. -Definition subspace_pointedType := PointedType (subspace A) point. +HB.instance Definition _ := Choice.copy (subspace A) _. -Canonical subspace_filteredType := - FilteredType (subspace A) (subspace A) nbhs_subspace. +HB.instance Definition _ := isPointed.Build (subspace A) point. -Program Definition subspace_topologicalMixin : - Topological.mixin_of (nbhs_subspace) := @topologyOfFilterMixin - (subspace A) nbhs_subspace nbhs_subspace_filter _ _. -Next Obligation. -by move=> p A0; case: nbhs_subspaceP => ? => [/nbhs_singleton|]; apply. -Qed. -Next Obligation. -move=> p A0; case: nbhs_subspaceP => [|] Ap. +HB.instance Definition _ := hasNbhs.Build (subspace A) nbhs_subspace. + +Lemma nbhs_subspaceP (x : subspace A) : + nbhs_subspace_spec x (A x) (~ A x) (x \in A) (nbhs x). +Proof. exact: nbhs_subspaceP_subproof. Qed. + +Lemma nbhs_subspace_singleton (p : subspace A) B : nbhs p B -> B p. +Proof. by case: nbhs_subspaceP => ? => [/nbhs_singleton|]; apply. Qed. + +Lemma nbhs_subspace_nbhs (p : subspace A) B : nbhs p B -> nbhs p (nbhs^~ B). +Proof. +case: nbhs_subspaceP => [|] Ap. by move=> /nbhs_interior; apply: filterS => y A0y Ay; case: nbhs_subspaceP. by move=> E x ->; case: nbhs_subspaceP. Qed. -Canonical subspace_topologicalType := - TopologicalType (subspace A) subspace_topologicalMixin. +HB.instance Definition _ := Nbhs_isNbhsTopological.Build (subspace A) + nbhs_subspace_filter nbhs_subspace_singleton nbhs_subspace_nbhs. -Lemma subspace_cvgP (F : set (set T)) (x : T) : - Filter F -> A x -> +Lemma subspace_cvgP (F : set_system T) (x : T) : Filter F -> A x -> (F --> (x : subspace A)) <-> (F --> within A (nbhs x)). -Proof. by case: (y in F --> y) / nbhs_subspaceP. Qed. +Proof. by case: _ / nbhs_subspaceP. Qed. Lemma subspace_continuousP {S : topologicalType} (f : T -> S) : continuous (f : subspace A -> S) <-> @@ -6303,7 +6839,7 @@ Lemma subspace_continuousP {S : topologicalType} (f : T -> S) : Proof. split => [ctsf x Ax W /=|wA x]. by rewrite nbhs_simpl //= nbhs_subspace_in //=; apply: ctsf. -case: (y in _ @[_ --> y]) / (nbhs_subspaceP x) => Ax. +rewrite /continuous_at; case: _ / (nbhs_subspaceP x) => Ax. exact: (cvg_trans _ (wA _ Ax)). by move=> ? /nbhs_singleton //= ?; rewrite nbhs_simpl => ? ->. Qed. @@ -6311,14 +6847,14 @@ Qed. Lemma subspace_eq_continuous {S : topologicalType} (f g : subspace A -> S) : {in A, f =1 g} -> continuous f -> continuous g. Proof. -rewrite ?subspace_continuousP=> feq L x Ax; rewrite -(feq x) ?inE //. +rewrite ?subspace_continuousP => feq L x Ax; rewrite -(feq x) ?inE //. by apply: cvg_trans _ (L x Ax); apply: fmap_within_eq=> ? ?; rewrite feq. Qed. Lemma continuous_subspace_in {U : topologicalType} (f : subspace A -> U) : continuous f = {in A, continuous f}. Proof. -rewrite propeqE in_setP subspace_continuousP/filter_of/nbhs //=; split. +rewrite propeqE in_setP subspace_continuousP /continuous_at //=; split. by move=> Q x Ax; case: (nbhs_subspaceP x) => //=; exact: Q. by move=> + x Ax => /(_ x Ax); case: (nbhs_subspaceP x) => //=; exact: Q. Qed. @@ -6343,7 +6879,7 @@ Section SubspaceOpen. Lemma open_subspace1out (x : subspace A) : ~ A x -> open [set x]. Proof. move=> /nbhs_subspace_out E; have : nbhs x [set x] by rewrite /nbhs //= -E. -rewrite nbhsE => [[U [[]]]] oU Ux Usub; suff : U = [set x] by move=> <-. +rewrite nbhsE => [[U []]] oU Ux Usub; suff : U = [set x] by move=> <-. by rewrite eqEsubset; split => // t ->. Qed. @@ -6380,27 +6916,32 @@ Lemma open_subspaceP (U : set T) : open (U : set (subspace A)) <-> exists V, open (V : set T) /\ V `&` A = U `&` A. Proof. -split=> [|[V [oV UV]]]; first last. - rewrite -open_subspaceIT -UV => x //= []; case: nbhs_subspaceP => //=. - rewrite withinE /= => Ax Vx _; exists V; last by rewrite -setIA setIid. - by move: oV; rewrite openE; exact. +split; first last. + case=> V [oV UV]; rewrite -open_subspaceIT -UV. + move=> x //= []; case: nbhs_subspaceP; rewrite //= withinE. + move=> ? ? _; exists V; last by rewrite -setIA setIid. + by move: oV; rewrite openE /interior; apply. rewrite -open_subspaceIT => oUA. -have oxF x : (U `&` A) x -> exists2 V, open_nbhs x V & V `&` A `<=` U `&` A. - move=> /[dup] UAx [Ux Ax]; move: (oUA _ UAx); case: nbhs_subspaceP => // _. - rewrite withinE /= => -[V nbhsV]; rewrite -setIA setIid => UV. - exists V^°; rewrite ?open_nbhsE. - - by split; [exact: open_interior|exact: nbhs_interior]. - - by rewrite UV => t [/interior_subset]. -pose f x := - if pselect ((U `&` A) x) is left e then projT1 (cid2 (oxF x e)) else set0. -exists (\bigcup_(x in U `&` A) f x); split. - apply: bigcup_open => i UAi; rewrite /f; case: pselect => // ?. - by case: (cid2 _) => //= W; rewrite open_nbhsE => -[]. -rewrite eqEsubset /f; split. - move=> t [[u UAu]] /=; case: pselect => //= ?. - by case: (cid2 _) => /= W _ + ? ?; exact. -move=> t UAt; split; last by case: UAt. -by exists t => //; case: pselect => //= -[Ut At]; case: (cid2 _) => //= W []. +have oxF : (forall (x : T), (U `&` A) x -> + exists V, (open_nbhs (x : T) V) /\ (V `&` A `<=` U `&` A)). + move=> x /[dup] UAx /= [??]; move: (oUA _ UAx); + case: nbhs_subspaceP => // ?. + rewrite withinE /= => [[V nbhsV UV]]; rewrite -setIA setIid in UV. + exists V^°; split; first rewrite open_nbhsE; first split => //. + - exact: open_interior. + - exact: nbhs_interior. + - by rewrite UV=> t [/interior_subset] ??; split. +pose f (x : T) := + if pselect ((U `&` A) x) is left e then projT1 (cid (oxF x e)) else set0. +set V := \bigcup_(x in (U `&` A)) (f x); exists V; split. + apply: bigcup_open => i UAi; rewrite /f; case: pselect => // ?; case: (cid _). + by move=> //= W; rewrite open_nbhsE=> -[[]]. +rewrite eqEsubset /V /f; split. + move=> t [[u]] UAu /=; case: pselect => //= ?. + by case: (cid _) => //= W [] _ + ? ?; apply; split. +move=> t UAt; split => //; last by case: UAt. +exists t => //; case: pselect => //= [[? ?]]. +by case: (cid _) => //= W [] [] _. Qed. Lemma closed_subspaceP (U : set T) : @@ -6448,18 +6989,19 @@ Lemma closure_subspaceW (U : set T) : U `<=` A -> closure (U : set (subspace A)) = closure (U : set T) `&` A. Proof. have /closed_subspaceP := (@closed_closure _ (U : set (subspace A))). -move=> [V] [clV VAclUA] /[dup] /(@closure_subset subspace_topologicalType). -have/closure_id <- := (closed_subspaceT) => /setIidr <-; rewrite setIC. +move=> [V] [clV VAclUA]. +move=> /[dup] /(@closure_subset [the topologicalType of subspace _]). +have /closure_id <- := closed_subspaceT => /setIidr <-; rewrite setIC. move=> UsubA; rewrite eqEsubset; split. apply: setSI; rewrite closureE; apply: smallest_sub (@subset_closure _ U). by apply: closed_subspaceW; exact: closed_closure. -rewrite -VAclUA; apply setSI; rewrite closureE //=; apply: smallest_sub => //. +rewrite -VAclUA; apply: setSI; rewrite closureE //=; apply: smallest_sub => //. apply: subset_trans (@subIsetl _ V A); rewrite VAclUA subsetI; split => //. exact: (@subset_closure _ (U : set (subspace A))). Qed. Lemma subspace_hausdorff : - hausdorff_space T -> hausdorff_space [topologicalType of subspace A]. + hausdorff_space T -> hausdorff_space [the topologicalType of subspace A]. Proof. rewrite ?open_hausdorff => + x y xNy => /(_ x y xNy). move=> [[P Q]] /= [Px Qx] /= [/open_subspaceW oP /open_subspaceW oQ]. @@ -6480,6 +7022,22 @@ rewrite withinE => W/= -[V nbhsV WV]; apply: filterS (V `&` (U `&` A)) _ _ _. by apply: filterI; rewrite nbhs_simpl //; exact: Fp. Qed. +Lemma clopen_connectedP : connected A <-> + (forall U, @clopen [the topologicalType of subspace A] U -> + U `<=` A -> U !=set0 -> U = A). +Proof. +split. + move=> + U [/open_subspaceP oU /closed_subspaceP cU] UA U0; apply => //. + - case: oU => V [oV VAUA]; exists V; rewrite // setIC VAUA. + exact/esym/setIidPl. + - case: cU => V [cV VAUA]; exists V => //; rewrite setIC VAUA. + exact/esym/setIidPl. +move=> clpnA U Un0 [V oV UVA] [W cW UWA]; apply: clpnA => //; first split. +- by apply/open_subspaceP; exists V; rewrite setIC UVA setIAC setIid. +- by apply/closed_subspaceP; exists W; rewrite setIC UWA setIAC setIid. +- by rewrite UWA; exact: subIsetl. +Qed. + End Subspace. Global Instance subspace_filter {T : topologicalType} @@ -6490,11 +7048,10 @@ Global Instance subspace_proper_filter {T : topologicalType} (A : set T) (x : subspace A) : ProperFilter (nbhs_subspace x) := nbhs_subspace_filter x. -(*Notation "{ 'within' A , 'continuous' f }" := - (continuous (f : subspace A -> _)).*) -Notation "{ 'within' A , 'continuous' f }" := (forall x, - cvg_to [filter of fmap f (filter_of (Phantom (subspace A) x))] - [filter of f x]). +Notation "{ 'within' A , 'continuous' f }" := + (continuous (f : subspace A -> _)) : classical_set_scope. + +Arguments nbhs_subspaceP {T} A x. Section SubspaceRelative. Context {T : topologicalType}. @@ -6503,7 +7060,7 @@ Implicit Types (U : topologicalType) (A B : set T). Lemma nbhs_subspace_subset A B (x : T) : A `<=` B -> nbhs (x : subspace B) `<=` nbhs (x : subspace A). Proof. -rewrite /nbhs //= => AB; case: (nbhs_subspaceP A); case: (nbhs_subspaceP B). +rewrite /= => AB; case: (nbhs_subspaceP A); case: (nbhs_subspaceP B). - by move=> ? ?; apply: within_subset => //=; exact: (nbhs_filter x). - by move=> ? /AB. - by move=> Bx ? W /nbhs_singleton /(_ Bx) ? ? ->. @@ -6519,7 +7076,7 @@ Qed. Lemma nbhs_subspaceT (x : T) : nbhs (x : subspace setT) = nbhs x. Proof. -rewrite {1}/nbhs //=; have [_|] := nbhs_subspaceP (@setT T); last by cbn. +have [_|] := nbhs_subspaceP [set: T]; last by cbn. rewrite eqEsubset withinE; split => [W [V nbhsV]|W ?]; last by exists W. by rewrite 2!setIT => ->. Qed. @@ -6527,17 +7084,17 @@ Qed. Lemma continuous_subspaceT_for {U} A (f : T -> U) (x : T) : A x -> {for x, continuous f} -> {for x, continuous (f : subspace A -> U)}. Proof. -rewrite /filter_of/nbhs/=/prop_for => inA ctsf. +rewrite /continuous_at /prop_for => inA ctsf. have [_|//] := nbhs_subspaceP A x. apply: (cvg_trans _ ctsf); apply: cvg_fmap2; apply: cvg_within. -by rewrite /subspace; exact: nbhs_filter. +exact: (nbhs_filter x). Qed. Lemma continuous_in_subspaceT {U} A (f : T -> U) : {in A, continuous f} -> {within A, continuous f}. Proof. rewrite continuous_subspace_in ?in_setP => ctsf t At. -by apply continuous_subspaceT_for => //=; apply: ctsf. +by apply: continuous_subspaceT_for => //=; apply: ctsf. Qed. Lemma continuous_subspaceT {U} A (f : T -> U) : @@ -6552,7 +7109,7 @@ Lemma continuous_open_subspace {U} A (f : T -> U) : Proof. rewrite openE continuous_subspace_in /= => oA; rewrite propeqE ?in_setP. by split => + x /[dup] Ax /oA Aox => /(_ _ Ax); - rewrite /filter_of -(nbhs_subspace_interior Aox). + rewrite /continuous_at -(nbhs_subspace_interior Aox). Qed. Lemma continuous_inP {U} A (f : T -> U) : open A -> @@ -6591,14 +7148,14 @@ Qed. Lemma continuous_subspace0 {U} (f : T -> U) : {within set0, continuous f}. Proof. -move=> x Q; rewrite nbhs_simpl /= {2}/nbhs /=. +move=> x Q /=. by case: (nbhs_subspaceP (@set0 T) x) => // _ /nbhs_singleton /= ? ? ->. Qed. Lemma continuous_subspace1 {U} (a : T) (f : T -> U) : {within [set a], continuous f}. Proof. -move=> x Q; rewrite nbhs_simpl /= {2}/nbhs /=. +move=> x Q /=. case: (nbhs_subspaceP [set a] x); last by move=> _ /nbhs_singleton /= ? ? ->. by move=> -> /nbhs_singleton ?; apply: nearW => ? ->. Qed. @@ -6613,35 +7170,48 @@ Definition subspace_ent := filter_from (@entourage X) (fun E => [set xy | (xy.1 = xy.2) \/ (A xy.1 /\ A xy.2 /\ E xy)]). -Program Definition subspace_uniformMixin := - @Uniform.Mixin (subspace A) (@nbhs_subspace _ _) subspace_ent _ _ _ _ _. -Next Obligation. +Let Filter_subspace_ent : Filter subspace_ent. +Proof. apply: filter_from_filter; first by (exists setT; exact: filterT). move=> P Q entP entQ; exists (P `&` Q); first exact: filterI. move=> [x y] /=; case; first (by move=> ->; split=> /=; left). by move=> [Ax [Ay [Pxy Qxy]]]; split=> /=; right. Qed. -Next Obligation. by move=> ? + [x y]/= ->; case=> V entV; apply; left. Qed. -Next Obligation. + +Let subspace_uniform_entourage_refl : forall X : set (subspace A * subspace A), + subspace_ent X -> [set xy | xy.1 = xy.2] `<=` X. +Proof. +by move=> ? + [x y]/= ->; case=> V entV; apply; left. +Qed. + +Let subspace_uniform_entourage_inv : forall A : set (subspace A * subspace A), + subspace_ent A -> subspace_ent (A^-1)%classic. +Proof. move=> ?; case=> V ? Vsub; exists (V^-1)%classic; first exact: entourage_inv. move=> [x y] /= G; apply: Vsub; case: G; first by (move=> <-; left). by move=> [? [? Vxy]]; right; repeat split => //. Qed. -Next Obligation. + +Let subspace_uniform_entourage_split_ex : + forall A : set (subspace A * subspace A), + subspace_ent A -> exists2 B, subspace_ent B & B \; B `<=` A. +Proof. move=> ?; case=> E entE Esub. exists [set xy | xy.1 = xy.2 \/ A xy.1 /\ A xy.2 /\ split_ent E xy]. by exists (split_ent E). move=> [x y] [z /= Ez zE] /=; case: Ez; case: zE. - - by move=> -> ->; apply Esub; left. - - move=> [ ? []] ? G xy; subst; apply Esub; right; repeat split => //=. + - by move=> -> ->; apply: Esub; left. + - move=> [ ? []] ? G xy; subst; apply: Esub; right; repeat split => //=. by apply: entourage_split => //=; first exact: G; exact: entourage_refl. - - move=> -> [ ? []] ? G; apply Esub; right; repeat split => //=. + - move=> -> [ ? []] ? G; apply: Esub; right; repeat split => //=. by apply: entourage_split => //=; first exact: G; exact: entourage_refl. - - move=> []? []? ?[]?[]??; apply Esub; right; repeat split => //=. + - move=> []? []? ?[]?[]??; apply: Esub; right; repeat split => //=. by apply: subset_split_ent => //; exists z. Qed. -Next Obligation. -pose EA := [set xy | xy.1 = xy.2 \/ A xy.1 /\ A xy.2]. + +Let subspace_uniform_nbhsE : @nbhs _ (subspace A) = nbhs_ subspace_ent. +Proof. +pose EA := [set xy | xy.1 = xy.2 \/ A xy.1 /\ A xy.2]. have entEA : subspace_ent EA. exists setT; first exact: filterT. by move=> [??] /= [ ->|[?] [?]];[left|right]. @@ -6665,8 +7235,11 @@ case: (@nbhs_subspaceP X A x); rewrite propeqE; split => //=. by apply: subU; apply: subW; left. Unshelve. all: by end_near. Qed. -Canonical subspace_uniformType := - UniformType (subspace A) subspace_uniformMixin. +HB.instance Definition _ := Nbhs_isUniform_mixin.Build (subspace A) + Filter_subspace_ent subspace_uniform_entourage_refl + subspace_uniform_entourage_inv subspace_uniform_entourage_split_ex + subspace_uniform_nbhsE. + End SubspaceUniform. Section SubspacePseudoMetric. @@ -6675,26 +7248,33 @@ Context {R : numDomainType} {X : pseudoMetricType R} (A : set X). Definition subspace_ball (x : subspace A) (r : R) := if x \in A then A `&` ball (x : X) r else [set x]. -Program Definition subspace_pseudoMetricType_mixin := - @PseudoMetric.Mixin R (subspace A) (subspace_ent A) (subspace_ball) - _ _ _ _. -Next Obligation. -move=> x e; rewrite /subspace_ball; case: ifP => //= /asboolP ? ?. +Lemma subspace_pm_ball_center x (e : R) : 0 < e -> subspace_ball x e x. +Proof. +rewrite /subspace_ball; case: ifP => //= /asboolP ? ?. by split=> //; exact: ballxx. Qed. -Next Obligation. -move=> x y e; rewrite /subspace_ball; case: ifP => //= /asboolP ?. + +Lemma subspace_pm_ball_sym x y (e : R) : + subspace_ball x e y -> subspace_ball y e x. +Proof. +rewrite /subspace_ball; case: ifP => //= /asboolP ?. by move=> [] Ay /ball_sym yBx; case: ifP => /asboolP. by move=> ->; case: ifP => /asboolP. Qed. -Next Obligation. -move=> x y z e1 e2; rewrite /subspace_ball; (repeat case: ifP => /asboolP). + +Lemma subspace_pm_ball_triangle x y z e1 e2 : + subspace_ball x e1 y -> subspace_ball y e2 z -> subspace_ball x (e1 + e2) z. +Proof. +rewrite /subspace_ball; (repeat case: ifP => /asboolP). - by move=>?? [??] [??]; split => //=; apply: ball_triangle; eauto. - by move=> ?? [??] ->. - by move=> + /[swap] => /[swap] => ->. - by move=> _ _ -> ->. Qed. -Next Obligation. + +Lemma subspace_pm_entourageE : + @entourage (subspace A) = entourage_ subspace_ball. +Proof. rewrite eqEsubset; split; rewrite /subspace_ball. move=> U [W + subU]; rewrite -entourage_ballE => [[eps] nneg subW]. exists eps => //; apply: (subset_trans _ subU). @@ -6708,8 +7288,10 @@ move=> [x y] /= [->|[]Ax []Ay xBy]; apply: subE => //=. by case: ifP => /asboolP. Qed. -Canonical subspace_pseudoMetricType := - PseudoMetricType (subspace A) subspace_pseudoMetricType_mixin. +HB.instance Definition _ := + @Uniform_isPseudoMetric.Build R (subspace A) subspace_ball + subspace_pm_ball_center subspace_pm_ball_sym subspace_pm_ball_triangle + subspace_pm_entourageE. End SubspacePseudoMetric. @@ -6717,9 +7299,7 @@ Section SubspaceWeak. Context {T : topologicalType} {U : pointedType}. Variables (f : U -> T). -Let U' := weak_topologicalType f. - -Lemma weak_subspace_open (A : set U') : +Lemma weak_subspace_open (A : set (weak_topology f)) : open A -> open (f @` A : set (subspace (range f))). Proof. case=> B oB <-; apply/open_subspaceP; exists B; split => //; rewrite eqEsubset. @@ -6729,6 +7309,121 @@ Qed. End SubspaceWeak. +Definition separate_points_from_closed {I : Type} {T : topologicalType} + {U_ : I -> topologicalType} (f_ : forall i, T -> U_ i) := + forall (U : set T) x, + closed U -> ~ U x -> exists i, ~ (closure (f_ i @` U)) (f_ i x). + +(* A handy technique for embedding a space T into a product. The key interface + is 'separate_points_from_closed', which guarantees that the topologies + - T's native topology + - sup (weak f_i) - the sup of all the weak topologies of f_i + - weak (x => (f_1 x, f_2 x,...)) - the weak topology from the product space + are equivalent (the last equivalence seems to require accessible_space). +*) +Section product_embeddings. +Context {I : choiceType} {T : topologicalType} {U_ : I -> topologicalType}. +Variable (f_ : forall i, T -> U_ i). + +Hypothesis sepf : separate_points_from_closed f_. +Hypothesis ctsf : forall i, continuous (f_ i). + +Let weakT := [the topologicalType of + sup_topology (fun i => Topological.on (weak_topology (f_ i)))]. + +Let PU := [the topologicalType of prod_topology U_]. + +Local Notation sup_open := (@open weakT). +Local Notation "'weak_open' i" := (@open weakT) (at level 0). +Local Notation natural_open := (@open T). + +Lemma weak_sep_cvg (F : set_system T) (x : T) : + Filter F -> (F --> (x : T)) <-> (F --> (x : weakT)). +Proof. +move=> FF; split. + move=> FTx; apply/cvg_sup => i U. + have /= -> := @nbhsE (weak_topology (f_ i)) x. + case=> B [[C oC <- ?]] /filterS; apply; apply: FTx; rewrite /= nbhsE. + by exists (f_ i @^-1` C) => //; split => //; exact: open_comp. +move/cvg_sup => wiFx U; rewrite /= nbhs_simpl nbhsE => [[B [oB ?]]]. +move/filterS; apply; have [//|i nclfix] := @sepf _ x (open_closedC oB). +apply: (wiFx i); have /= -> := @nbhsE (weak_topology (f_ i)) x. +exists (f_ i @^-1` (~` closure [set f_ i x | x in ~` B])); [split=>//|]. + apply: open_comp; last by rewrite ?openC; last apply: closed_closure. + by move=> + _; exact: (@weak_continuous _ _ (f_ i)). +rewrite closureC preimage_bigcup => z [V [oV]] VnB => /VnB. +by move/forall2NP => /(_ z) [] // /contrapT. +Qed. + +Lemma weak_sep_nbhsE x : @nbhs T T x = @nbhs T weakT x. +Proof. +rewrite predeqE => U; split; move: U. + by have P := weak_sep_cvg x (nbhs_filter (x : weakT)); exact/P. +by have P := weak_sep_cvg x (nbhs_filter (x : T)); exact/P. +Qed. + +Lemma weak_sep_openE : @open T = @open weakT. +Proof. +rewrite predeqE => A; rewrite ?openE /interior. +by split => + z => /(_ z); rewrite weak_sep_nbhsE. +Qed. + +Definition join_product (x : T) : PU := f_ ^~ x. + +Lemma join_product_continuous : continuous join_product. +Proof. +suff : continuous (join_product : weakT -> PU). + by move=> cts x U => /cts; rewrite nbhs_simpl /= -weak_sep_nbhsE. +move=> x; apply/cvg_sup; first exact/fmap_filter/(nbhs_filter (x : weakT)). +move=> i; move: x; apply/(@continuousP _ (weak_topology (@^~ i))) => A [B ? E]. +rewrite -E (_ : @^~ i = proj i) //. +have -> : join_product @^-1` (proj i @^-1` B) = f_ i @^-1` B by []. +apply: open_comp => // + _; rewrite /cvg_to => x U. +by rewrite nbhs_simpl /= -weak_sep_nbhsE; move: x U; exact: ctsf. +Qed. + +Local Notation prod_open := (@open (subspace (range join_product))). + +Lemma join_product_open (A : set T) : open A -> + open ((join_product @` A) : set (subspace (range join_product))). +Proof. +move=> oA; rewrite openE => y /= [x Ax] jxy. +have [// | i nAfiy] := @sepf (~` A) x (open_closedC oA). +pose B : set PU := proj i @^-1` (~` closure (f_ i @` ~` A)). +apply: (@filterS _ _ _ (range join_product `&` B)). + move=> z [[w ?]] wzE Bz; exists w => //. + move: Bz; rewrite /B -wzE closureC; case=> K [oK KsubA] /KsubA. + have -> : proj i (join_product w) = f_ i w by []. + by move=> /exists2P/forallNP/(_ w)/not_andP [] // /contrapT. +apply: open_nbhs_nbhs; split; last by rewrite -jxy. +apply: openI; first exact: open_subspaceT. +apply: open_subspaceW; apply: open_comp; last exact/closed_openC/closed_closure. +by move=> + _; exact: proj_continuous. +Qed. + +Lemma join_product_inj : accessible_space T -> set_inj [set: T] join_product. +Proof. +move=> /accessible_closed_set1 cl1 x y; case: (eqVneq x y) => // xny _ _ jxjy. +have [] := (@sepf [set y] x (cl1 y)); first by exact/eqP. +move=> i P; suff : join_product x i != join_product y i by rewrite jxjy => /eqP. +apply/negP; move: P; apply: contra_not => /eqP; rewrite /join_product => ->. +by apply: subset_closure; exists y. +Qed. + +Lemma join_product_weak : set_inj [set: T] join_product -> + @open T = @open (weak_topology join_product). +Proof. +move=> inj; rewrite predeqE => U; split; first last. + by move=> [V ? <-]; apply: open_comp => // + _; exact: join_product_continuous. +move=> /join_product_open/open_subspaceP [V [oU VU]]. +exists V => //; have := @f_equal _ _ (preimage join_product) _ _ VU. +rewrite !preimage_setI // !preimage_range !setIT => ->. +rewrite eqEsubset; split; last exact: preimage_image. +by move=> z [w Uw] /inj <- //; rewrite inE. +Qed. + +End product_embeddings. + Lemma continuous_compact {T U : topologicalType} (f : T -> U) A : {within A, continuous f} -> compact A -> compact (f @` A). Proof. @@ -6750,7 +7445,7 @@ Lemma connected_continuous_connected (T U : topologicalType) (A : set T) (f : T -> U) : connected A -> {within A, continuous f} -> connected (f @` A). Proof. -move=> cA cf; apply contrapT => /connectedPn[E [E0 fAE sE]]. +move=> cA cf; apply: contrapT => /connectedPn[E [E0 fAE sE]]. set AfE := fun b =>(A `&` f @^-1` E b) : set (subspace A). suff sAfE : separated (AfE false) (AfE true). move: cA; apply/connectedPn; exists AfE; split; last (rewrite /AfE; split). @@ -6770,7 +7465,7 @@ have [fAfE cEIE] : split; last by case: sE => ? ?; case: b => //; rewrite setIC. rewrite eqEsubset; split => [|u Ebu]. apply: (subset_trans sub_image_setI). - by apply subIset; right; exact: image_preimage_subset. + by apply: subIset; right; exact: image_preimage_subset. have [t [At ftu]] : exists t, A t /\ f t = u. suff [t At ftu] : (f @` A) u by exists t. by rewrite fAE; case: b Ebu; [left|right]. @@ -6786,11 +7481,11 @@ have ? : f @` closure (AfE b) `<=` closure (E b). apply/eqP/negPn/negP/set0P => -[t [? ?]]. have : f @` closure (AfE b) `&` f @` AfE (~~ b) = set0. by rewrite fAfE; exact: subsetI_eq0 cEIE. -by rewrite predeqE => /(_ (f t)) [fcAfEb] _; apply fcAfEb; split; exists t. +by rewrite predeqE => /(_ (f t)) [fcAfEb] _; apply: fcAfEb; split; exists t. Qed. Lemma uniform_limit_continuous {U : topologicalType} {V : uniformType} - (F : set (set (U -> V))) (f : U -> V) : + (F : set_system (U -> V)) (f : U -> V) : ProperFilter F -> (\forall g \near F, continuous (g : U -> V)) -> {uniform, F --> f} -> continuous f. Proof. @@ -6804,14 +7499,13 @@ by split; [exact: entourage_inv | move=> g fg; near_simpl; near=> z; exact: fg]. Unshelve. all: end_near. Qed. Lemma uniform_limit_continuous_subspace {U : topologicalType} {V : uniformType} - (K : set U) (F : set (set (U -> V))) (f : subspace K -> V) : + (K : set U) (F : set_system (U -> V)) (f : subspace K -> V) : ProperFilter F -> (\forall g \near F, continuous (g : subspace K -> V)) -> {uniform K, F --> f} -> {within K, continuous f}. Proof. move=> PF ctsF Ff; apply: (@subspace_eq_continuous _ _ _ (restrict K f)). by rewrite /restrict => ? ->. -apply: (@uniform_limit_continuous - (subspace_topologicalType K) _ (restrict K @ F) _). +apply: (@uniform_limit_continuous (subspace K) _ (restrict K @ F) _). apply: (filterS _ ctsF) => g; apply: subspace_eq_continuous. by rewrite /restrict => ? ->. by apply (@uniform_restrict_cvg _ _ F ) => //; exact: PF. @@ -6826,22 +7520,39 @@ split; first by move=> ? ?; near=> U; apply: continuous_subspaceT=> ?; exact. move=> + x => /(_ x)/near_powerset_filter_fromP. case; first by move=> ? ?; exact: continuous_subspaceW. move=> U nbhsU wctsf; wlog oU : U wctsf nbhsU / open U. - move: nbhsU; rewrite nbhsE => -[] W [[oW Wx WU]] /(_ W). - move/(_ (continuous_subspaceW WU wctsf)); apply => //. - by exists W; split. + move: nbhsU; rewrite nbhsE => -[] W [oW Wx WU] /(_ W). + by move/(_ (continuous_subspaceW WU wctsf)); apply => //; exists W. move/nbhs_singleton: nbhsU; move: x; apply/in_setP. by rewrite -continuous_open_subspace. Unshelve. end_near. Qed. +Lemma totally_disconnected_prod (I : choiceType) + (T : I -> topologicalType) (A : forall i, set (T i)) : + (forall i, totally_disconnected (A i)) -> + @totally_disconnected (prod_topology T) + (fun f => forall i, A i (f i)). +Proof. +move=> dsctAi x /= Aix; rewrite eqEsubset; split; last first. + by move=> ? ->; exact: connected_component_refl. +move=> f /= [C /= [Cx CA ctC Cf]]; apply/functional_extensionality_dep => i. +suff : proj i @` C `<=` [set x i] by apply; exists f. +rewrite -(dsctAi i) // => Ti ?; exists (proj i @` C) => //. +split; [by exists x | by move=> ? [r Cr <-]; exact: CA |]. +apply/(connected_continuous_connected ctC)/continuous_subspaceT. +exact: proj_continuous. +Qed. + Section UniformPointwise. Context {U : topologicalType} {V : uniformType}. -Definition singletons {T : Type} := [set [set x] | x in @setT T]. +Definition singletons {T : Type} := [set [set x] | x in [set: T]]. Lemma pointwise_cvg_family_singleton F (f: U -> V): Filter F -> {ptws, F --> f} = {family @singletons U, F --> f}. Proof. -move=> FF; rewrite propeqE fam_cvgP cvg_sup; split. +move=> FF; apply/propext. +rewrite (@fam_cvgP _ _ singletons). (* BUG: slowdown if no arguments *) +rewrite cvg_sup; split. move=> + A [x _ <-] => /(_ x); rewrite uniform_set1. rewrite cvg_image; last by rewrite eqEsubset; split=> v // _; exists (cst v). apply: cvg_trans => W /=; rewrite ?nbhs_simpl /fmap /= => [[W' + <-]]. @@ -6860,8 +7571,113 @@ move=> PF; rewrite pointwise_cvg_family_singleton; apply: family_cvg_subset. by move=> A [x _ <-]; exact: compact_set1. Qed. +Lemma pointwise_cvgP F (f: U -> V): + Filter F -> {ptws, F --> f} <-> forall (t : U), (fun g => g t) @ F --> f t. +Proof. +move=> Ff; rewrite pointwise_cvg_family_singleton; split. + move/fam_cvgP => + t A At => /(_ [set t]); rewrite uniform_set1; apply => //. + by exists t. +by move=> pf; apply/fam_cvgP => ? [t _ <-]; rewrite uniform_set1; exact: pf. +Qed. + End UniformPointwise. +Module gauge. +Section gauge. + +Let split_sym {T : uniformType} (W : set (T * T)) := + (split_ent W) `&` (split_ent W)^-1. + +Section entourage_gauge. +Context {T : uniformType} (E : set (T * T)) (entE : entourage E). + +Definition gauge := + filter_from [set: nat] (fun n => iter n split_sym (E `&` E^-1)). + +Lemma iter_split_ent j : entourage (iter j split_sym (E `&` E^-1)). +Proof. by elim: j => [|i IH]; exact: filterI. Qed. + +Lemma gauge_ent A : gauge A -> entourage A. +Proof. +case=> n; elim: n A; first by move=> ? _ /filterS; apply; apply: filterI. +by move=> n ? A _ /filterS; apply; apply: filterI; have ? := iter_split_ent n. +Qed. + +Lemma gauge_filter : Filter gauge. +Proof. +apply: filter_from_filter; first by exists 0%N. +move=> i j _ _; wlog ilej : i j / (i <= j)%N. + by move=> WH; have [|/ltnW] := leqP i j; + [|rewrite (setIC (iter _ _ _))]; exact: WH. +exists j => //; rewrite subsetI; split => //; elim: j i ilej => [i|j IH i]. + by rewrite leqn0 => /eqP ->. +rewrite leq_eqVlt => /predU1P[<-//|/ltnSE/IH]; apply: subset_trans. +by move=> x/= [jx _]; apply: split_ent_subset => //; exact: iter_split_ent. +Qed. + +Lemma gauge_refl A : gauge A -> [set fg | fg.1 = fg.2] `<=` A. +Proof. +case=> n _; apply: subset_trans => -[_ a]/= ->. +by apply: entourage_refl; exact: iter_split_ent. +Qed. + +Lemma gauge_inv A : gauge A -> gauge (A^-1)%classic. +Proof. +case=> n _ EA; apply: (@filterS _ _ _ (iter n split_sym (E `&` E^-1))). +- exact: gauge_filter. +- by case: n EA; last move=> n; move=> EA [? ?] [/=] ? ?; exact: EA. +- by exists n . +Qed. + +Lemma gauge_split A : gauge A -> exists2 B, gauge B & B \; B `<=` A. +Proof. +case => n _ EA; exists (iter n.+1 split_sym (E `&` E^-1)); first by exists n.+1. +apply: subset_trans EA; apply: subset_trans; first last. + by apply: subset_split_ent; exact: iter_split_ent. +by case=> a c [b] [] ? ? [] ? ?; exists b. +Qed. + +Let gauged : Type := T. + +HB.instance Definition _ := Pointed.on gauged. +HB.instance Definition _ := + @isUniform.Build gauged gauge gauge_filter gauge_refl gauge_inv gauge_split. + +Lemma gauge_countable_uniformity : countable_uniformity gauged. +Proof. +exists [set iter n split_sym (E `&` E^-1) | n in [set: nat]]. +split; [exact: card_image_le | by move=> W [n] _ <-; exists n|]. +by move=> D [n _ ?]; exists (iter n split_sym (E `&` E^-1)). +Qed. + +Definition type := countable_uniform.type gauge_countable_uniformity. + +#[export] HB.instance Definition _ := Uniform.on type. +#[export] HB.instance Definition _ {R : realType} : PseudoMetric R _ := + PseudoMetric.on type. + +End entourage_gauge. +End gauge. +Module Exports. HB.reexport. End Exports. +End gauge. +Export gauge.Exports. + +Lemma uniform_pseudometric_sup {R : realType} {T : uniformType} : + @entourage T = @sup_ent T {E : set (T * T) | @entourage T E} + (fun E => Uniform.class (@gauge.type T (projT1 E) (projT2 E))). +Proof. +rewrite eqEsubset; split => [E entE|E]. + exists E => //=. + pose pe : {classic {E0 : set (T * T) | _}} * _ := (exist _ E entE, E). + have entPE : `[< @entourage (gauge.type entE) E >]. + by apply/asboolP; exists 0%N => // ? []. + exists (fset1 (exist _ pe entPE)) => //=; first by move=> ?; rewrite in_setE. + by rewrite set_fset1 bigcap_set1. +case=> W /= [/= J] _ <- /filterS; apply; apply: filter_bigI => -[] [] [] /= D. +move=> entD G /[dup] /asboolP [n _ + _ _] => /filterS; apply. +exact: gauge.iter_split_ent. +Qed. + Section ArzelaAscoli. Context {X : topologicalType}. Context {Y : uniformType}. @@ -6873,7 +7689,7 @@ Implicit Types (I : Type). Definition equicontinuous {I} (W : set I) (d : I -> (X -> Y)) := forall x (E : set (Y * Y)), entourage E -> - \forall y \near x, forall i, W i -> E(d i x, d i y). + \forall y \near x, forall i, W i -> E (d i x, d i y). Lemma equicontinuous_subset {I J} (W : set I) (V : set J) {fW : I -> X -> Y} {fV : J -> X -> Y} : @@ -6907,7 +7723,7 @@ Qed. (* A convenient notion that is in between compactness in {family compact, X -> y} and compactness in {ptws X -> y}.*) Definition pointwise_precompact {I} (W : set I) (d : I -> X -> Y) := - forall x, precompact [set (d i x) | i in W]. + forall x, precompact [set d i x | i in W]. Lemma pointwise_precompact_subset {I J} (W : set I) (V : set J) {fW : I -> X -> Y} {fV : J -> X -> Y} : @@ -6930,12 +7746,12 @@ apply: (subclosed_compact _ C); first exact: closed_closure. have WsubR : (fW @` W) `<=` R. move=> f Wf x; rewrite /R /K closure_limit_point; left. by case: Wf => i ? <-; exists i. -rewrite closureE; apply: smallest_sub (compact_closed _ C) WsubR. +rewrite closureE; apply: smallest_sub (compact_closed _ C) WsubR. exact: hausdorff_product. Qed. Lemma uniform_pointwise_compact (W : set (X -> Y)) : - compact (W : set (@fct_UniformFamily X Y compact)) -> + compact (W : set (@uniform_fun_family X Y compact)) -> compact (W : set {ptws X -> Y}). Proof. rewrite [x in x _ -> _]compact_ultra [x in _ -> x _]compact_ultra. @@ -6977,9 +7793,9 @@ apply: (@entourage_split _ (g y)) => //; first exact: (near (@ectsW x _ _)). by apply/entourage_sym; exact: (near (pointwise_cvg_entourage _ _ _)). Unshelve. all: by end_near. Qed. -Definition small_ent_sub := @small_set_sub _ _ (@entourage Y). +Definition small_ent_sub := @small_set_sub _ (@entourage Y). -Lemma pointwise_compact_cvg (F : set (set {ptws X -> Y})) (f : {ptws X -> Y}) : +Lemma pointwise_compact_cvg (F : set_system {ptws X -> Y}) (f : {ptws X -> Y}) : ProperFilter F -> (\forall W \near powerset_filter_from F, equicontinuous W id) -> {ptws, F --> f} <-> {family compact, F --> f}. @@ -6987,30 +7803,32 @@ Proof. move=> PF /near_powerset_filter_fromP; case. exact: equicontinuous_subset_id. move=> W; wlog Wf : f W / W f. - move=> + FW /equicontinuous_closure => /(_ f (closure W)) Q. + move=> + FW /equicontinuous_closure => /(_ f (closure (W : set {ptws X -> Y}))) Q. split => Ff; last by apply: pointwise_cvg_compact_family. - apply Q => //; last by (apply: (filterS _ FW); exact: subset_closure). - by rewrite closureEcvg; exists F; [|split] => // ? /filterS; apply. + apply/Q => //. + by rewrite closureEcvg; exists F; [|split] => // ? /= /filterS; apply. + by apply: (filterS _ FW) => z Wz; apply: subset_closure. move=> FW ectsW; split=> [ptwsF|]; last exact: pointwise_cvg_compact_family. apply/fam_cvgP => K ? U /=; rewrite uniform_nbhs => [[E [eE EsubU]]]. -suff : \forall g \near within W (nbhs f), forall y, K y -> E (f y, g y). +suff : \forall g \near within W (nbhs (f : {ptws X -> Y})), + forall y, K y -> E (f y, g y). rewrite near_withinE; near_simpl => N; apply: (filter_app _ _ FW). - by apply ptwsF; near=> g => ?; apply EsubU; apply: (near N g). + by apply: ptwsF; near=> g => ?; apply: EsubU; apply: (near N g). near (powerset_filter_from (@entourage Y)) => E'. have entE' : entourage E' by exact: (near (near_small_set _)). pose Q := fun (h : X -> Y) x => E' (f x, h x). -apply: compact_near_coveringP.1 => // x Kx. +apply: (iffLR (compact_near_coveringP K)) => // x Kx. near=> y g => /=. apply: (entourage_split (f x) eE). apply entourage_sym; apply: (near (small_ent_sub _) E') => //. exact: (near (ectsW x E' entE') y). apply: (@entourage_split _ (g x)) => //. apply: (near (small_ent_sub _) E') => //. - near: g; near_simpl; apply: (@cvg_within _ (nbhs f)). + near: g; near_simpl; apply: (@cvg_within _ (nbhs (f : {ptws X -> Y}))). exact: pointwise_cvg_entourage. apply: (near (small_ent_sub _) E') => //. apply: (near (ectsW x E' entE')) => //. -exact: (near (withinT _ (nbhs_filter f))). +exact: (near (withinT _ (nbhs_filter (f : {ptws X -> Y})))). Unshelve. all: end_near. Qed. Lemma pointwise_compact_closure (W : set (X -> Y)) : @@ -7035,16 +7853,17 @@ Lemma pointwise_precompact_equicontinuous (W : set (X -> Y)) : Proof. move=> /pointwise_precompact_precompact + ectsW. rewrite ?precompactE compact_ultra compact_ultra pointwise_compact_closure //. -move=> /= + F UF FcW => /(_ F UF); rewrite image_id; case => // p [cWp Fp]. -exists p; split => //; apply/(pointwise_compact_cvg) => //. +move=> /= + F UF FcW => /(_ F UF); rewrite image_id => /(_ FcW)[p [cWp Fp]]. +exists p; split => //; apply/pointwise_compact_cvg => //. apply/near_powerset_filter_fromP; first exact: equicontinuous_subset_id. -exists (closure (W : set {ptws X -> Y })) => //; exact: equicontinuous_closure. +exists (closure (W : set {ptws X -> Y })) => //. +exact: equicontinuous_closure. Qed. Section precompact_equicontinuous. -Hypothesis lcptX : locally_compact (@setT X). +Hypothesis lcptX : locally_compact [set: X]. -Let compact_equicontinuous (W : set {family compact, X -> Y}) : +Lemma compact_equicontinuous (W : set {family compact, X -> Y}) : (forall f, W f -> continuous f) -> compact (W : set {family compact, X -> Y}) -> equicontinuous W id. @@ -7054,7 +7873,7 @@ have [//|U UWx [cptU clU]] := @lcptX x; rewrite withinET in UWx. near (powerset_filter_from (@entourage Y)) => E'. have entE' : entourage E' by exact: (near (near_small_set _)). pose Q := fun (y : X) (f : {family compact, X -> Y}) => E' (f x, f y). -apply: (compact_near_coveringP.1 _ cptW) => f Wf; near=> g y => /=. +apply: (iffLR (compact_near_coveringP W)) => // f Wf; near=> g y => /=. apply: (entourage_split (f x) entE). apply/entourage_sym; apply: (near (small_ent_sub _) E') => //. exact: (near (fam_nbhs _ entE' (@compact_set1 _ x)) g). @@ -7062,7 +7881,7 @@ apply: (entourage_split (f y) (entourage_split_ent entE)). apply: (near (small_ent_sub _) E') => //. by near: y; apply: ((@ctsW f Wf x) (to_set _ _)); exact: nbhs_entourage. apply: (near (small_ent_sub _) E') => //. -by apply (near (fam_nbhs _ entE' cptU) g) => //; exact: (near UWx y). +by apply: (near (fam_nbhs _ entE' cptU) g) => //; exact: (near UWx y). Unshelve. all: end_near. Qed. Lemma precompact_equicontinuous (W : set {family compact, X -> Y}) : @@ -7070,7 +7889,7 @@ Lemma precompact_equicontinuous (W : set {family compact, X -> Y}) : precompact (W : set {family compact, X -> Y}) -> equicontinuous W id. Proof. -move=> pcptW ctsW; apply (equicontinuous_subset_id (@subset_closure _ W)). +move=> pcptW ctsW; apply: (equicontinuous_subset_id (@subset_closure _ W)). apply: compact_equicontinuous; last by rewrite -precompactE. move=> f; rewrite closureEcvg => [[G PG [Gf GW]]] x B /=. rewrite -nbhs_entourageE => -[E entE] /filterS; apply; near_simpl. @@ -7099,3 +7918,170 @@ exact: precompact_pointwise_precompact. Qed. End ArzelaAscoli. + +Lemma uniform_regular {T : uniformType} : @regular_space T. +Proof. +move=> x R /=; rewrite -{1}nbhs_entourageE => -[E entE ER]. +pose E' := split_ent E; have eE' : entourage E' by exact: entourage_split_ent. +exists (to_set (E' `&` E'^-1%classic) x). + rewrite -nbhs_entourageE; exists (E' `&` E'^-1%classic) => //. + exact: filterI. +move=> z /= clEz; apply: ER; apply: subset_split_ent => //. +have [] := clEz (to_set (E' `&` E'^-1%classic) z). + rewrite -nbhs_entourageE; exists (E' `&` E'^-1%classic) => //. + exact: filterI. +by move=> y /= [[? ?]] [? ?]; exists y. +Qed. + +#[global] Hint Resolve uniform_regular : core. + +Section currying. +Local Notation "U '~>' V" := + ({compact-open, [the topologicalType of U] -> [the topologicalType of V]}) + (at level 99, right associativity). + +Section cartesian_closed. +Context {U V W : topologicalType}. + +(**md In this section, we consider under what conditions \ + `[f in U ~> V ~> W | continuous f /\ forall u, continuous (f u)]` \ + and \ + `[f in U * V ~> W | continuous f]` \ + are homeomorphic. + - Always: \ + `curry` sends continuous functions to continuous functions. + - `V` locally_compact + regular or Hausdorff: \ + `uncurry` sends continuous functions to continuous functions. + - `U` regular or Hausdorff: \ + `curry` itself is a continuous map. + - `U` regular or Hausdorff AND `V` locally_compact + regular or Hausdorff \ + `uncurry` itself is a continuous map. \ + Therefore `curry`/`uncurry` are homeomorphisms. + + So the category of locally compact regular spaces is cartesian closed. +*) + +Lemma continuous_curry (f : (U * V)%type ~> W) : + continuous f -> + continuous (curry f : U ~> V ~> W) /\ forall u, continuous (curry f u). +Proof. +move=> ctsf; split; first last. + move=> u z; apply: continuous_comp; last exact: ctsf. + by apply: cvg_pair => //=; exact: cvg_cst. +move=> x; apply/compact_open_cvgP => K O /= cptK oO fKO. +near=> z => w /= [+ + <-]; near: z. +move/compact_near_coveringP/near_covering_withinP : cptK; apply. +move=> v Kv; have [[P Q] [Px Qv] PQfO] : nbhs (x, v) (f @^-1` O). + by apply: ctsf; move: oO; rewrite openE; apply; apply: fKO; exists v. +by exists (Q, P) => // -[b a] /= [Qb Pa] Kb; exact: PQfO. +Unshelve. all: by end_near. Qed. + +Lemma continuous_uncurry_regular (f : U ~> V ~> W) : + locally_compact [set: V] -> @regular_space V -> continuous f -> + (forall u, continuous (f u)) -> continuous (uncurry f : (U * V)%type ~> W). +Proof. +move=> lcV reg cf cfp /= [u v] D; rewrite /= nbhsE => -[O [oO Ofuv]] /filterS. +apply; have [B] := @lcV v I; rewrite withinET => Bv [cptB clB]. +have [R Rv RO] : exists2 R, nbhs v R & forall z, closure R z -> O (f u z). + have [] := reg v (f u @^-1` O); first by apply: cfp; exact: open_nbhs_nbhs. + by move=> R ? ?; exists R. +exists (f @^-1` [set g | g @` (B `&` closure R) `<=` O], B `&` closure R). + split; [apply/cf/open_nbhs_nbhs; split | apply: filterI] => //. + - apply: compact_open_open => //; apply: compact_closedI => //. + exact: closed_closure. + - by move=> ? [x [? + <-]]; apply: RO. + - by apply: filterS; first exact: subset_closure. +by case=> a r /= [fBMO [Br] cmR]; apply: fBMO; exists r. +Qed. + +Lemma continuous_uncurry (f : U ~> V ~> W) : + locally_compact [set: V] -> hausdorff_space V -> continuous f -> + (forall u, continuous (f u)) -> + continuous ((uncurry : (U ~> V ~> W) -> ((U * V)%type ~> W)) f). +Proof. +move=> lcV hsdf ctsf cf; apply: continuous_uncurry_regular => //. +move=> v; have [B] := @lcV v I; rewrite withinET => Bv [cptB clB]. +by move=> z; exact: (@compact_regular V hsdf v B). +Qed. + +Lemma curry_continuous (f : (U * V)%type ~> W) : continuous f -> @regular_space U -> + {for f, continuous (curry : ((U * V)%type ~> W) -> (U ~> V ~> W))}. +Proof. +move=> ctsf regU; apply/compact_open_cvgP. + by apply: fmap_filter; exact: nbhs_filter. +move=> K ? cptK [D OfinIo <-] fKD /=; near=> z => w [+ + <-]; near: z. +move/compact_near_coveringP/near_covering_withinP : (cptK); apply => u Ku. +have [] := fKD (curry f u); first by exists u. +move=> E /[dup] /[swap] /OfinIo [N Asub <- DIN INf]. +suff : \forall x' \near u & i \near nbhs f, K x' -> + (\bigcap_(i in [set` N]) i) (curry i x'). + apply: filter_app; near=> a b => /[apply] ?. + by exists (\bigcap_(i in [set` N]) i). +apply: filter_bigI_within => R RN; have /set_mem [[M cptM _]] := Asub _ RN. +have Rfu : R (curry f u) by exact: INf. +move/(_ _ Rfu) => [O [fMO oO] MOR]; near=> p => /= Ki; apply: MOR => + [+ + <-]. +move=> _ v Mv; move: v Mv Ki; near: p. +have umb : \forall y \near u, (forall b, M b -> nbhs (y, b) (f @^-1` O)). + move/compact_near_coveringP/near_covering_withinP : (cptM); apply => v Mv. + have [[P Q] [Pu Qv] PQO] : nbhs (u, v) (f @^-1` O). + by apply: ctsf; apply: open_nbhs_nbhs; split => //; apply: fMO; exists v. + exists (Q, P); [by []| move=> [b a [/= Qb Pa Mb]]]. + by apply: ctsf; apply: open_nbhs_nbhs; split => //; exact: PQO. +move/compact_near_coveringP/near_covering_withinP : (cptM); apply => v Mv. +have [P' P'u cPO] := regU u _ umb. +pose L := [set h | h @` ((K `&` closure P') `*` M) `<=` O]. +exists (setT, P' `*` L). + split => //; [exact: filterT|]; exists (P', L) => //; split => //. + apply: open_nbhs_nbhs; split; first apply: compact_open_open => //. + apply: compact_setM => //; apply: compact_closedI => //. + exact: closed_closure. + by move=> ? [[a b] [[Ka /cPO +] Mb <-]] => /(_ _ Mb)/nbhs_singleton. +move=> [b [a h]] [/= _ [Pa] +] Ma Ka; apply. +by exists (a, b); split => //; split => //; exact/subset_closure. +Unshelve. all: by end_near. Qed. + +Lemma uncurry_continuous (f : U ~> V ~> W) : + locally_compact [set: V] -> @regular_space V -> @regular_space U -> + continuous f -> (forall u, continuous (f u)) -> + {for f, continuous (uncurry : (U ~> V ~> W) -> ((U * V)%type ~> W))}. +Proof. +move=> lcV regV regU ctsf ctsfp; apply/compact_open_cvgP. + by apply: fmap_filter; exact:nbhs_filter. +move=> /= K O cptK oO fKO; near=> h => ? [+ + <-]; near: h. +move/compact_near_coveringP/near_covering_withinP: (cptK); apply. +case=> u v Kuv. +have : exists P Q, [/\ closed P, compact Q, nbhs u P, + nbhs v Q & P `*` Q `<=` uncurry f @^-1` O]. + have : continuous (uncurry f) by exact: continuous_uncurry_regular. + move/continuousP/(_ _ oO); rewrite openE => /(_ (u, v))[]. + by apply: fKO; exists (u, v). + case=> /= P' Q' [P'u Q'v] PQO. + have [B] := @lcV v I; rewrite withinET; move=> Bv [cptB clB]. + have [P Pu cPP'] := regU u P' P'u; have [Q Qv cQQ'] := regV v Q' Q'v. + exists (closure P), (B `&` closure Q); split. + - exact: closed_closure. + - by apply: compact_closedI => //; exact: closed_closure. + - by apply: filterS; first exact: subset_closure. + - by apply: filterI=> //; apply: filterS; first exact: subset_closure. + - by case => a b [/cPP' ?] [_ /cQQ' ?]; exact: PQO. +case=> P [Q [clP cptQ Pu Qv PQfO]]; pose R := [set g : V ~> W | g @` Q `<=` O]. +(have oR : open R by exact: compact_open_open); pose P' := f @^-1` R. +pose L := [set h : U ~> V ~> W | h @` (fst @` K `&` P) `<=` R]. +exists ((P `&` P') `*` Q, L); first split => /=. +- exists (P `&` P', Q) => //; split => //=; apply: filterI => //. + apply: ctsf; apply: open_nbhs_nbhs; split => // _ [b Qb <-]. + by apply: (PQfO (u, b)); split => //; exact: nbhs_singleton. +- rewrite nbhs_simpl /=; apply: open_nbhs_nbhs; split. + apply: compact_open_open => //; apply: compact_closedI => //. + apply: continuous_compact => //; apply: continuous_subspaceT => x. + exact: cvg_fst. + move=> /= _ [a [Kxa Pa] <-] _ [b Qb <-]. + by apply: (PQfO (a, b)); split => //; exact: nbhs_singleton. +move=> [[a b h]] [/= [[Pa P'a] Qb Lh] Kab]. +apply: (Lh (h a)); first by exists a => //; split => //; exists (a, b). +by exists b. +Unshelve. all: by end_near. Qed. + +End cartesian_closed. + +End currying. diff --git a/theories/trigo.v b/theories/trigo.v index 80ac45e1c..709eabf1f 100644 --- a/theories/trigo.v +++ b/theories/trigo.v @@ -1,17 +1,17 @@ (* mathcomp analysis (c) 2017 Inria and AIST. License: CeCILL-C. *) From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum matrix. From mathcomp Require Import interval rat. -From mathcomp.classical Require Import boolp classical_sets functions. -From mathcomp.classical Require Import mathcomp_extra. +From mathcomp Require Import mathcomp_extra boolp classical_sets functions. Require Import reals ereal nsatz_realtype signed topology normedtype landau. Require Import sequences derive realfun exp. -(******************************************************************************) -(* Theory of trigonometric functions *) +(**md**************************************************************************) +(* # Theory of trigonometric functions *) (* *) (* This file provides the definitions of basic trigonometric functions and *) (* develops their theories. *) (* *) +(* ``` *) (* periodic f T == f is a periodic function of period T *) (* alternating f T == f is an alternating function of period T *) (* sin_coeff x == the sequence of coefficients of sin x *) @@ -25,6 +25,7 @@ Require Import sequences derive realfun exp. (* acos x == the arccos function *) (* asin x == the arcsin function *) (* atan x == the arctangent function *) +(* ``` *) (* *) (* Acknowledgments: the proof of cos 2 < 0 is inspired from HOL-light, some *) (* proofs of trigonometric relations are taken from *) @@ -71,8 +72,8 @@ Qed. (* /NB: backport to mathcomp in progress *) Lemma cvg_series_cvg_series_group (R : realFieldType) (f : R ^nat) k : - cvg (series f) -> (0 < k)%N -> - [series \sum_(n * k <= i < n.+1 * k) f i]_n --> lim (series f). + cvg (series f @ \oo) -> (0 < k)%N -> + [series \sum_(n * k <= i < n.+1 * k) f i]_n @ \oo --> lim (series f @ \oo). Proof. move=> /cvg_ballP cf k0; apply/cvg_ballP => _/posnumP[e]. have := !! cf _ (gt0 e) => -[n _ nl]; near=> m. @@ -82,9 +83,10 @@ have /nl : (n <= m * k)%N. by rewrite /ball /= distrC. Unshelve. all: by end_near. Qed. -Lemma lt_sum_lim_series (R : realFieldType) (f : R ^nat) n : cvg (series f) -> +Lemma lt_sum_lim_series (R : realFieldType) (f : R ^nat) n : + cvg (series f @ \oo) -> (forall d, 0 < f (n + d.*2)%N + f (n + d.*2.+1)%N) -> - \sum_(0 <= i < n) f i < lim (series f). + \sum_(0 <= i < n) f i < lim (series f @ \oo). Proof. move=> /cvg_ballP cf fn. have fn0 : 0 < f n + f n.+1 by have := fn 0%N; rewrite double0 addn0 addn1. @@ -92,14 +94,14 @@ rewrite ltNge; apply: contraPN cf => ffn /(_ _ fn0). have nf_ub N : \sum_(0 <= i < n.+2) f i <= \sum_(0 <= i < N.+1.*2 + n) f i. elim: N => // N /le_trans ->//; rewrite -(addn1 (N.+1)) doubleD addnAC. rewrite [in leRHS]/index_iota subn0 iotaD big_cat. - rewrite -[in X in _ <= X + _](subn0 (N.+1.*2 + n)%N) ler_addl /= add0n. + rewrite -[in X in _ <= X + _](subn0 (N.+1.*2 + n)%N) lerDl /= add0n. by rewrite 2!big_cons big_nil addr0 -(addnC n) ltW// -addnS fn. -case=> N _ Nfn; have /Nfn/ltr_distlC_addr : (N.+1.*2 + n >= N)%N. +case=> N _ Nfn; have /Nfn/ltr_distlCDr : (N.+1.*2 + n >= N)%N. by rewrite doubleS -addn2 -addnn -2!addnA leq_addr. rewrite addrA => ffnfn. -have : lim (series f) + f n + f n.+1 <= \sum_(0 <= i < N.+1.*2 + n) f i. +have : lim (series f @ \oo) + f n + f n.+1 <= \sum_(0 <= i < N.+1.*2 + n) f i. apply: (le_trans _ (nf_ub N)). - by do 2 rewrite big_nat_recr //=; by rewrite -2!addrA ler_add2r. + by do 2 rewrite big_nat_recr //=; by rewrite -2!addrA lerD2r. by move/(lt_le_trans ffnfn); rewrite ltxx. Qed. @@ -144,7 +146,7 @@ Proof. by apply/funext => i; rewrite /sin_coeff /= -!mulrA [_ / _]mulrC. Qed. Lemma sin_coeff_even n x : sin_coeff x n.*2 = 0. Proof. by rewrite /sin_coeff /= odd_double /= !mul0r. Qed. -Lemma is_cvg_series_sin_coeff x : cvg (series (sin_coeff x)). +Lemma is_cvg_series_sin_coeff x : cvg (series (sin_coeff x) @ \oo). Proof. apply: normed_cvg. apply: series_le_cvg; last exact: (@is_cvg_series_exp_coeff _ `|x|). @@ -155,10 +157,10 @@ apply: series_le_cvg; last exact: (@is_cvg_series_exp_coeff _ `|x|). by case: odd; [rewrite mul1r| rewrite !mul0r]. Qed. -Definition sin x : R := lim (series (sin_coeff x)). +Definition sin x : R := lim (series (sin_coeff x) @ \oo). Lemma sinE : sin = fun x => - lim (pseries (fun n => (odd n)%:R * (-1) ^+ n.-1./2 * (n`!%:R)^-1) x). + lim (pseries (fun n => (odd n)%:R * (-1) ^+ n.-1./2 * (n`!%:R)^-1) x @ \oo). Proof. by apply/funext => x; rewrite /pseries -sin_coeffE. Qed. Definition sin_coeff' x (n : nat) := (-1)^n * x ^+ n.*2.+1 / n.*2.+1`!%:R. @@ -168,12 +170,12 @@ Proof. by rewrite /sin_coeff' /sin_coeff /= odd_double mul1r -2!mulrA doubleK. Qed. -Lemma cvg_sin_coeff' x : series (sin_coeff' x) --> sin x. +Lemma cvg_sin_coeff' x : series (sin_coeff' x) @ \oo --> sin x. Proof. have /(@cvg_series_cvg_series_group _ _ 2) := @is_cvg_series_sin_coeff x. move=> /(_ isT); apply: cvg_trans. -rewrite [X in _ --> series X](_ : _ = (fun n => sin_coeff x n.*2.+1)). - rewrite [X in series X --> _](_ : _ = (fun n => sin_coeff x n.*2.+1)) //. +rewrite [X in _ --> series X @ \oo](_ : _ = (fun n => sin_coeff x n.*2.+1)). + rewrite [X in series X @ \oo --> _](_ : _ = (fun n => sin_coeff x n.*2.+1)) //. by rewrite funeqE => n; exact: sin_coeff'E. rewrite funeqE=> n; rewrite /= 2!muln2 big_nat_recl //= sin_coeff_even add0r. by rewrite big_nat_recl // big_geq // addr0. @@ -227,7 +229,7 @@ Proof. by apply/funext => i; rewrite /cos_coeff /= -!mulrA [_ / _]mulrC. Qed. -Lemma is_cvg_series_cos_coeff x : cvg (series (cos_coeff x)). +Lemma is_cvg_series_cos_coeff x : cvg (series (cos_coeff x) @ \oo). Proof. apply: normed_cvg. apply: series_le_cvg; last exact: (@is_cvg_series_exp_coeff _ `|x|). @@ -238,12 +240,12 @@ apply: series_le_cvg; last exact: (@is_cvg_series_exp_coeff _ `|x|). by case: odd; [rewrite !mul0r | rewrite mul1r]. Qed. -Definition cos x : R := lim (series (cos_coeff x)). +Definition cos x : R := lim (series (cos_coeff x) @ \oo). Lemma cosE : cos = fun x => lim (series (fun n => (fun n => (~~(odd n))%:R * (-1)^+ n./2 * (n`!%:R)^-1) n - * x ^+ n)). + * x ^+ n) @ \oo). Proof. by apply/funext => x; rewrite -cos_coeffE. Qed. Definition cos_coeff' x (n : nat) := (-1)^n * x ^+ n.*2 / n.*2`!%:R. @@ -254,14 +256,14 @@ rewrite /cos_coeff' /cos_coeff /= odd_double /= mul1r -2!mulrA; congr (_ * _). by rewrite (half_bit_double n false). Qed. -Lemma cvg_cos_coeff' x : series (cos_coeff' x) --> cos x. +Lemma cvg_cos_coeff' x : series (cos_coeff' x) @ \oo --> cos x. Proof. have /(@cvg_series_cvg_series_group _ _ 2) := @is_cvg_series_cos_coeff x. move=> /(_ isT); apply: cvg_trans. -rewrite [X in _ --> series X](_ : _ = (fun n => cos_coeff x n.*2)); last first. +rewrite [X in _ --> series X @ \oo](_ : _ = (fun n => cos_coeff x n.*2)); last first. rewrite funeqE=> n; rewrite /= 2!muln2 big_nat_recr //= cos_coeff_odd addr0. by rewrite big_nat_recl//= /index_iota subnn big_nil addr0. -rewrite [X in series X --> _](_ : _ = (fun n => cos_coeff x n.*2)) //. +rewrite [X in series X @ \oo --> _](_ : _ = (fun n => cos_coeff x n.*2)) //. by rewrite funeqE => n; exact: cos_coeff'E. Qed. @@ -359,11 +361,11 @@ Qed. Lemma cos_max x : `| cos x | <= 1. Proof. rewrite -(expr_le1 (_ : 0 < 2)%nat) // -normrX ger0_norm ?exprn_even_ge0 //. -by rewrite -(cos2Dsin2 x) ler_addl ?sqr_ge0. +by rewrite -(cos2Dsin2 x) lerDl ?sqr_ge0. Qed. Lemma cos_geN1 x : -1 <= cos x. -Proof. by rewrite ler_oppl; have /ler_normlP[] := cos_max x. Qed. +Proof. by rewrite lerNl; have /ler_normlP[] := cos_max x. Qed. Lemma cos_le1 x : cos x <= 1. Proof. by have /ler_normlP[] := cos_max x. Qed. @@ -371,11 +373,11 @@ Proof. by have /ler_normlP[] := cos_max x. Qed. Lemma sin_max x : `| sin x | <= 1. Proof. rewrite -(expr_le1 (_ : 0 < 2)%nat) // -normrX ger0_norm ?exprn_even_ge0 //. -by rewrite -(cos2Dsin2 x) ler_addr ?sqr_ge0. +by rewrite -(cos2Dsin2 x) lerDr ?sqr_ge0. Qed. Lemma sin_geN1 x : -1 <= sin x. -Proof. by rewrite ler_oppl; have /ler_normlP[] := sin_max x. Qed. +Proof. by rewrite lerNl; have /ler_normlP[] := sin_max x. Qed. Lemma sin_le1 x : sin x <= 1. Proof. by have /ler_normlP[] := sin_max x. Qed. @@ -488,7 +490,7 @@ Implicit Types (x y : R) (n k : nat). Definition pi : R := get [set x | 0 <= x <= 2 /\ cos x = 0] *+ 2. Lemma pihalfE : pi / 2 = get [set x | 0 <= x <= 2 /\ cos x = 0]. -Proof. by rewrite /pi -(mulr_natr (get _)) -mulrA divff ?mulr1. Qed. +Proof. by rewrite /pi -[_ *+ 2]mulr_natr -mulrA divff ?mulr1. Qed. Lemma cos2_lt0 : cos 2 < 0 :> R. Proof. @@ -508,10 +510,10 @@ rewrite (_ : 4 = 2 * 2)%N // -(exprnP _ (2 * 2)) (exprM (-1)) sqrr_sign. rewrite mul1r [(-1) ^ 3](_ : _ = -1) ?mulN1r ?mulNr ?opprK; last first. by rewrite -exprnP 2!exprS expr1 mulrN1 opprK mulr1. rewrite subr_gt0. -rewrite addnS doubleS -[X in 2 ^+ X]addn2 exprD -mulrA ltr_pmul2l//. +rewrite addnS doubleS -[X in 2 ^+ X]addn2 exprD -mulrA ltr_pM2l//. rewrite factS factS 2!natrM mulrA invfM !mulrA. -rewrite ltr_pdivr_mulr ?ltr0n ?fact_gt0// mulVf ?pnatr_eq0 ?gtn_eqF ?fact_gt0//. -rewrite ltr_pdivr_mulr ?mul1r //. +rewrite ltr_pdivrMr ?ltr0n ?fact_gt0// mulVf ?pnatr_eq0 ?gtn_eqF ?fact_gt0//. +rewrite ltr_pdivrMr ?mul1r //. by rewrite expr2 -!natrM ltr_nat !mulSn !add2n mul0n !addnS. Qed. @@ -522,7 +524,7 @@ have sinx := @cvg_sin_coeff' _ x. rewrite -(cvg_lim (@Rhausdorff R) sinx). rewrite [ltLHS](_ : 0 = \sum_(0 <= i < 0) sin_coeff' x i :> R); last first. by rewrite big_nil. -rewrite lt_sum_lim_series //; first by move/cvgP in sinx. +apply: lt_sum_lim_series; first by move/cvgP in sinx. move=> d. rewrite /sin_coeff' 2!exprzD_nat (exprSz _ d.*2) -[in (-1) ^ d.*2](muln2 d). rewrite -(exprnP _ (d * 2)) (exprM (-1)) sqrr_sign 2!mulr1 -exprSzr. @@ -536,9 +538,9 @@ rewrite -[X in _ < X - _]mul1r !mulrA -mulrBl divr_gt0 //; last first. rewrite subr_gt0. set v := _ ^_ _; rewrite -[ltRHS](divff (_ : v%:R != 0)); last first. by rewrite lt0r_neq0 // (ltr_nat _ 0) ffact_gt0 leq_addl. -rewrite ltr_pmul2r; last by rewrite invr_gt0 (ltr_nat _ 0) ffact_gt0 leq_addl. +rewrite ltr_pM2r; last by rewrite invr_gt0 (ltr_nat _ 0) ffact_gt0 leq_addl. rewrite {}/v !addnS addn0 !ffactnS ffactn0 muln1 /= natrM. -by rewrite (ltr_pmul (ltW _ ) (ltW _)) // (lt_le_trans x_lt2) // ler_nat. +by rewrite (ltr_pM (ltW _ ) (ltW _)) // (lt_le_trans x_lt2) // ler_nat. Qed. Lemma cos1_gt0 : cos 1 > 0 :> R. @@ -547,12 +549,12 @@ have h := @cvg_cos_coeff' R 1; rewrite -(cvg_lim (@Rhausdorff R) h). apply: (@lt_trans _ _ (\sum_(0 <= i < 2) cos_coeff' 1 i)). rewrite big_nat_recr//= big_nat_recr//= big_nil add0r. rewrite /cos_coeff' expr0z expr1n fact0 !mul1r expr1n expr1z. - by rewrite !mulNr subr_gt0 mul1r div1r ltf_pinv ?posrE ?ltr0n// ltr_nat. -rewrite lt_sum_lim_series //; [by move/cvgP in h|move=> d]. + by rewrite !mulNr subr_gt0 mul1r div1r ltf_pV2 ?posrE ?ltr0n// ltr_nat. +apply: lt_sum_lim_series; [by move/cvgP in h|move=> d]. rewrite /cos_coeff' !(expr1n,mulr1). rewrite -muln2 -mulSn muln2 -exprnP -signr_odd odd_double expr0. rewrite -exprnP -signr_odd oddD/= muln2 odd_double/= expr1 add2n. -rewrite mulNr subr_gt0 2!div1r ltf_pinv ?posrE ?ltr0n ?fact_gt0//. +rewrite mulNr subr_gt0 2!div1r ltf_pV2 ?posrE ?ltr0n ?fact_gt0//. by rewrite ltr_nat ltn_pfact//ltn_double doubleS. Qed. @@ -618,7 +620,7 @@ Lemma pihalf_lt2 : pi / 2 < 2. Proof. by have /andP[] := pihalf_12. Qed. Lemma pi_ge2 : 2 <= pi. -Proof. by have := pihalf_ge1; rewrite ler_pdivl_mulr// mul1r. Qed. +Proof. by have := pihalf_ge1; rewrite ler_pdivlMr// mul1r. Qed. Lemma pi_gt0 : 0 < pi. Proof. by rewrite (lt_le_trans _ pi_ge2). Qed. @@ -634,7 +636,7 @@ Lemma cos_gt0_pihalf x : -(pi / 2) < x < pi / 2 -> 0 < cos x. Proof. wlog : x / 0 <= x => [Hw|x_ge0]. case: (leP 0 x) => [/Hw//| x_lt_0]. - rewrite -{-1}[x]opprK ltr_oppl andbC [-- _ < _]ltr_oppl cosN. + rewrite -{-1}[x]opprK ltrNl andbC [-- _ < _]ltrNl cosN. by apply: Hw => //; rewrite oppr_cp0 ltW. move=> /andP[x_gt0 xLpi2]; case: (ler0P (cos x)) => // cx_le0. have /IVT[]// : minr (cos 0) (cos x) <= 0 <= maxr (cos 0) (cos x). @@ -676,8 +678,7 @@ Qed. Lemma sinpi : sin pi = 0. Proof. -have := sinD (pi / 2) (pi / 2); rewrite cos_pihalf mulr0 mul0r. -by rewrite -mulrDl -mulr2n -mulr_natr -mulrA divff// mulr1 addr0. +by have := sinD (pi / 2) (pi / 2); rewrite cos_pihalf mulr0 mul0r -splitr addr0. Qed. Lemma cos2pi : cos (pi *+ 2) = 1. @@ -713,13 +714,13 @@ Proof. by rewrite sinB cos_pihalf mulr0 add0r sin_pihalf mulr1. Qed. Lemma sin_ge0_pi x : 0 <= x <= pi -> 0 <= sin x. Proof. move=> xI; rewrite -cosBpihalf cos_ge0_pihalf //. -by rewrite ler_subr_addl subrr ler_sub_addr -mulr2n -[_ *+ 2]mulr_natr divfK. +by rewrite lerBrDl subrr lerBDr -mulr2n -[_ *+ 2]mulr_natr divfK. Qed. Lemma sin_gt0_pi x : 0 < x < pi -> 0 < sin x. Proof. move=> xI; rewrite -cosBpihalf cos_gt0_pihalf //. -by rewrite ltr_subr_addl subrr ltr_sub_addr -mulr2n -[_ *+ 2]mulr_natr divfK. +by rewrite ltrBrDl subrr ltrBDr -mulr2n -[_ *+ 2]mulr_natr divfK. Qed. Lemma ltr_cos : {in `[0, pi] &, {mono cos : x y /~ y < x}}. @@ -763,10 +764,10 @@ Qed. Lemma ltr_sin : {in `[ (- (pi/2)), pi/2] &, {mono sin : x y / x < y}}. Proof. -move=> x y /itvP xpi /itvP ypi; rewrite -[sin x]opprK ltr_oppl. -rewrite -!cosDpihalf -[x < y](ltr_add2r (pi /2)) ltr_cos// !in_itv/=. -- by rewrite -ler_subl_addr sub0r xpi/= [leRHS]splitr ler_add2r xpi. -- by rewrite -ler_subl_addr sub0r ypi/= [leRHS]splitr ler_add2r ypi. +move=> x y /itvP xpi /itvP ypi; rewrite -[sin x]opprK ltrNl. +rewrite -!cosDpihalf -[x < y](ltrD2r (pi /2)) ltr_cos// !in_itv/=. +- by rewrite -lerBlDr sub0r xpi/= [leRHS]splitr lerD2r xpi. +- by rewrite -lerBlDr sub0r ypi/= [leRHS]splitr lerD2r ypi. Qed. Lemma cos_inj : {in `[0,pi] &, injective (@cos R)}. @@ -780,8 +781,8 @@ Lemma sin_inj : {in `[(- (pi/2)), (pi/2)] &, injective sin}. Proof. move=> x y /itvP xpi /itvP ypi sinE; have : - sin x = - sin y by rewrite sinE. rewrite -!cosDpihalf => /cos_inj h; apply/(addIr (pi/2))/h; rewrite !in_itv/=. -- by rewrite -ler_subl_addr sub0r xpi/= [leRHS]splitr ler_add2r xpi. -- by rewrite -ler_subl_addr sub0r ypi/= [leRHS]splitr ler_add2r ypi. +- by rewrite -lerBlDr sub0r xpi/= [leRHS]splitr lerD2r xpi. +- by rewrite -lerBlDr sub0r ypi/= [leRHS]splitr lerD2r ypi. Qed. End Pi. @@ -840,7 +841,7 @@ Lemma tan_piquarter : tan (pi / 4%:R) = 1. Proof. rewrite /tan -cosBpihalf (splitr (pi / 2)) opprD addrA -mulrA -invfM -natrM. rewrite subrr sub0r cosN divff// gt_eqF// cos_gt0_pihalf//. -rewrite ltr_pmul2l ?pi_gt0// ltf_pinv ?qualifE// ltr_nat andbT. +rewrite ltr_pM2l ?pi_gt0// ltf_pV2 ?qualifE//= ltr_nat andbT. by rewrite (@lt_trans _ _ 0)// ?oppr_lt0 ?divr_gt0 ?pi_gt0. Qed. @@ -909,7 +910,7 @@ Proof. move=> xB; rewrite /acos; case: xgetP => //= He. pose f y := cos y - x. have /(IVT (@pi_ge0 _))[] // : minr (f 0) (f pi) <= 0 <= maxr (f 0) (f pi). - rewrite /f cos0 cospi /minr /maxr ltr_add2r -subr_lt0 opprK (_ : 1 + 1 = 2)//. + rewrite /f cos0 cospi /minr /maxr ltrD2r -subr_lt0 opprK (_ : 1 + 1 = 2)//. by rewrite ltrn0 subr_le0 subr_ge0. - move=> y y0pi. by apply: continuousB; apply/continuous_in_subspaceT => ? ?; @@ -960,14 +961,14 @@ Lemma acos0 : acos (0 : R) = pi / 2%:R. Proof. have := @cosK (pi / 2%:R). rewrite cos_pihalf => -> //; rewrite in_itv//= divr_ge0 ?ler0n ?pi_ge0//=. -by rewrite ler_pdivr_mulr ?ltr0n// ler_pemulr ?pi_ge0// ler1n. +by rewrite ler_pdivrMr ?ltr0n// ler_peMr ?pi_ge0// ler1n. Qed. Lemma acosN a : -1 <= a <= 1 -> acos (- a) = pi - acos a. Proof. -move=> a1; have ? : -1 <= - a <= 1 by rewrite ler_oppl opprK ler_oppl andbC. +move=> a1; have ? : -1 <= - a <= 1 by rewrite lerNl opprK lerNl andbC. apply: cos_inj; first by rewrite in_itv/= acos_ge0//= acos_lepi. -- by rewrite in_itv/= subr_ge0 acos_lepi//= ler_subl_addl ler_addr acos_ge0. +- by rewrite in_itv/= subr_ge0 acos_lepi//= lerBlDl lerDr acos_ge0. - by rewrite addrC cosDpi cosN !acosK. Qed. @@ -976,7 +977,7 @@ Proof. by rewrite acosN ?acos1 ?subr0 ?lexx// -subr_ge0 opprK addr_ge0. Qed. Lemma cosKN a : - pi <= a <= 0 -> acos (cos a) = - a. Proof. -by move=> pia0; rewrite -(cosN a) cosK// in_itv/= ler_oppr oppr0 ler_oppl andbC. +by move=> pia0; rewrite -(cosN a) cosK// in_itv/= lerNr oppr0 lerNl andbC. Qed. Lemma sin_acos x : -1 <= x <= 1 -> sin (acos x) = Num.sqrt (1 - x^+2). @@ -1014,7 +1015,7 @@ apply: (@is_derive_inverse R cos). by near: z. - by near=> z; apply: continuous_cos. - rewrite oppr_eq0 sin_acos ?ltW // sqrtr_eq0 // -ltNge subr_gt0. - rewrite -real_normK ?qualifE; last by case: ltrgt0P. + rewrite -real_normK ?qualifE/=; last by case: ltrgt0P. by rewrite exprn_cp1 // ltr_norml x_gtN1. Unshelve. all: by end_near. Qed. @@ -1035,7 +1036,7 @@ move=> xB; rewrite /asin; case: xgetP => //= He. pose f y := sin y - x. have /IVT[] // : minr (f (-(pi/2))) (f (pi/2)) <= 0 <= maxr (f (-(pi/2))) (f (pi/2)). - rewrite /f sinN sin_pihalf /minr /maxr ltr_add2r -subr_gt0 opprK. + rewrite /f sinN sin_pihalf /minr /maxr ltrD2r -subr_gt0 opprK. by rewrite (_ : 1 + 1 = 2)// ltr0n/= subr_le0 subr_ge0. - by rewrite -subr_ge0 opprK -splitr pi_ge0. - by move=> *; apply: continuousB; apply/continuous_in_subspaceT => ? ?; @@ -1113,7 +1114,7 @@ apply: (@is_derive_inverse R sin). by near: z. - by near=> z; exact: continuous_sin. - rewrite cos_asin ?ltW // sqrtr_eq0 // -ltNge subr_gt0. - rewrite -real_normK ?qualifE; last by case: ltrgt0P. + rewrite -real_normK ?qualifE/=; last by case: ltrgt0P. by rewrite exprn_cp1 // ltr_norml x_gtN1. Unshelve. all: by end_near. Qed. @@ -1134,11 +1135,11 @@ Proof. rewrite /atan; case: xgetP => //= He. pose x1 := Num.sqrt (1 + x^+ 2) ^-1. have ox2_gt0 : 0 < 1 + x^2. - by apply: lt_le_trans (_ : 1 <= _); rewrite ?ler_addl ?sqr_ge0. + by apply: lt_le_trans (_ : 1 <= _); rewrite ?lerDl ?sqr_ge0. have ox2_ge0 : 0 <= 1 + x^2 by rewrite ltW. have x1B : -1 <= x1 <= 1. rewrite -ler_norml /x1 ger0_norm ?sqrtr_ge0 // -[leRHS]sqrtr1. - by rewrite ler_psqrt ?qualifE ?invr_gte0 //= invf_cp1 // ler_addl sqr_ge0. + by rewrite ler_psqrt ?qualifE/= ?invr_gte0 //= invf_cp1 // lerDl sqr_ge0. case: (He (Num.sg x * acos x1)); split; last first. case: (x =P 0) => [->|/eqP xD0]; first by rewrite /tan sgr0 mul0r sin0 mul0r. rewrite /tan sin_sg cos_sg // acosK ?sin_acos //. @@ -1155,7 +1156,7 @@ case: (x =P 0) => [->|/eqP xD0]; first by rewrite sgr0 normr0 mul0r. rewrite normr_sg xD0 mul1r ltr_norml. rewrite (@lt_le_trans _ _ 0) ?acos_ge0 ?oppr_cp0 //=. rewrite -ltr_cos ?in_itv/= ?acos_ge0/= ?acos_lepi//; last first. - by rewrite divr_ge0 ?pi_ge0//= ler_pdivr_mulr// ler_pmulr ?pi_gt0// ler1n. + by rewrite divr_ge0 ?pi_ge0//= ler_pdivrMr// ler_pMr ?pi_gt0// ler1n. by rewrite cos_pihalf acosK // ?sqrtr_gt0 ?invr_gt0. Qed. @@ -1183,14 +1184,14 @@ apply: tan_inj; first 2 last. rewrite in_itv/= -mulNr (lt_trans _ (_ : 0 < _ )) /=; last 2 first. by rewrite mulNr oppr_cp0 divr_gt0 // pi_gt0. by rewrite divr_gt0 ?pi_gt0 // ltr0n. -rewrite ltr_pdivr_mulr// -mulrA ltr_pmulr// ?pi_gt0//. +rewrite ltr_pdivrMr// -mulrA ltr_pMr// ?pi_gt0//. by rewrite (natrM _ 2 2) mulrA mulVf// mul1r ltr1n. Qed. Lemma atanN x : atan (- x) = - atan x. Proof. apply: tan_inj; first by rewrite in_itv/= atan_ltpi2 atan_gtNpi2. -- by rewrite in_itv/= ltr_oppl opprK ltr_oppl andbC atan_ltpi2 atan_gtNpi2. +- by rewrite in_itv/= ltrNl opprK ltrNl andbC atan_ltpi2 atan_gtNpi2. - by rewrite tanN !atanK. Qed. @@ -1235,7 +1236,7 @@ apply: (@is_derive_inverse R tan). - by near=> z; apply: tanK; near: z. - by near=> z; apply/continuous_tan/lt0r_neq0/cos_gt0_pihalf; near: z. - by rewrite -[X in 1 + X ^+ 2]atanK -cos2_tan2 //; exact: is_derive_tan. -by apply/lt0r_neq0/(@lt_le_trans _ _ 1) => //; rewrite ler_addl sqr_ge0. +by apply/lt0r_neq0/(@lt_le_trans _ _ 1) => //; rewrite lerDl sqr_ge0. Unshelve. all: by end_near. Qed. End Atan.