pax_global_header00006660000000000000000000000064147256627350014533gustar00rootroot0000000000000052 comment=ea1d342e2c7d58e83cc7e53d27e7b37e373288a6 real-closed-2.0.2/000077500000000000000000000000001472566273500137265ustar00rootroot00000000000000real-closed-2.0.2/.github/000077500000000000000000000000001472566273500152665ustar00rootroot00000000000000real-closed-2.0.2/.github/workflows/000077500000000000000000000000001472566273500173235ustar00rootroot00000000000000real-closed-2.0.2/.github/workflows/docker-action.yml000066400000000000000000000024061472566273500225720ustar00rootroot00000000000000# This file was generated from `meta.yml`, please do not edit manually. # Follow the instructions on https://github.com/coq-community/templates to regenerate. 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:2.1.0-coq-8.17' - 'mathcomp/mathcomp:2.1.0-coq-8.18' - 'mathcomp/mathcomp:2.2.0-coq-8.17' - 'mathcomp/mathcomp:2.2.0-coq-8.18' - 'mathcomp/mathcomp:2.2.0-coq-8.19' - 'mathcomp/mathcomp:2.3.0-coq-8.19' - 'mathcomp/mathcomp:2.3.0-coq-8.20' - 'mathcomp/mathcomp:2.3.0-coq-dev' - 'mathcomp/mathcomp-dev:coq-8.18' - 'mathcomp/mathcomp-dev:coq-8.19' - 'mathcomp/mathcomp-dev:coq-dev' fail-fast: false steps: - uses: actions/checkout@v4 - uses: coq-community/docker-coq-action@v1 with: opam_file: 'coq-mathcomp-real-closed.opam' custom_image: ${{ matrix.image }} # See also: # https://github.com/coq-community/docker-coq-action#readme # https://github.com/erikmd/docker-coq-github-action-demo real-closed-2.0.2/.github/workflows/nix-action-8.17.yml000066400000000000000000001112461472566273500225170ustar00rootroot00000000000000jobs: 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 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" coqeal: needs: - coq - multinomials - mathcomp-real-closed 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target coqeal run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.17\" --argstr job \"coqeal\" \\\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: 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: bignums' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr job "bignums" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: paramcoq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr job "paramcoq" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: multinomials' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr job "multinomials" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr job "mathcomp-real-closed" - 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 "coqeal" 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 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: 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 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" mathcomp-abel: needs: - coq - mathcomp-real-closed 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-abel run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.17\" --argstr job \"mathcomp-abel\" \\\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: 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-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr job "mathcomp-real-closed" - 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-abel" mathcomp-algebra-tactics: needs: - coq - mathcomp-zify 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-algebra-tactics run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.17\" --argstr job \"mathcomp-algebra-tactics\" \\\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: 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: mathcomp-zify' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr job "mathcomp-zify" - 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-algebra-tactics" mathcomp-apery: needs: - coq - coqeal - mathcomp-real-closed - mathcomp-bigenough - mathcomp-zify - mathcomp-algebra-tactics 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-apery run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.17\" --argstr job \"mathcomp-apery\" \\\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: 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: coqeal' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr job "coqeal" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr job "mathcomp-real-closed" - 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: mathcomp-zify' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr job "mathcomp-zify" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-algebra-tactics' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr job "mathcomp-algebra-tactics" - 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-apery" mathcomp-bigenough: 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-bigenough run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.17\" --argstr job \"mathcomp-bigenough\" \\\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-bigenough" 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 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)\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: 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" mathcomp-real-closed: needs: - coq - mathcomp-bigenough 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-real-closed run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.17\" --argstr job \"mathcomp-real-closed\" \\\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 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-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-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-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-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 current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr job "mathcomp-real-closed" mathcomp-zify: 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-zify run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.17\" --argstr job \"mathcomp-zify\" \\\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: 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-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 current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr job "mathcomp-zify" multinomials: needs: - coq - mathcomp-finmap - mathcomp-bigenough 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target multinomials run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.17\" --argstr job \"multinomials\" \\\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: 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-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-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-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 current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr job "multinomials" 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 real-closed-2.0.2/.github/workflows/nix-action-8.18.yml000066400000000000000000001112461472566273500225200ustar00rootroot00000000000000jobs: 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 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" coqeal: needs: - coq - multinomials - mathcomp-real-closed 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target coqeal run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.18\" --argstr job \"coqeal\" \\\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: 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: bignums' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr job "bignums" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: paramcoq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr job "paramcoq" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: multinomials' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr job "multinomials" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr job "mathcomp-real-closed" - 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 "coqeal" 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 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: 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 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" mathcomp-abel: needs: - coq - mathcomp-real-closed 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-abel run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.18\" --argstr job \"mathcomp-abel\" \\\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: 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-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr job "mathcomp-real-closed" - 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-abel" mathcomp-algebra-tactics: needs: - coq - mathcomp-zify 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-algebra-tactics run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.18\" --argstr job \"mathcomp-algebra-tactics\" \\\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: 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: mathcomp-zify' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr job "mathcomp-zify" - 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-algebra-tactics" mathcomp-apery: needs: - coq - coqeal - mathcomp-real-closed - mathcomp-bigenough - mathcomp-zify - mathcomp-algebra-tactics 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-apery run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.18\" --argstr job \"mathcomp-apery\" \\\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: 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: coqeal' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr job "coqeal" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr job "mathcomp-real-closed" - 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: mathcomp-zify' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr job "mathcomp-zify" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-algebra-tactics' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr job "mathcomp-algebra-tactics" - 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-apery" mathcomp-bigenough: 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-bigenough run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.18\" --argstr job \"mathcomp-bigenough\" \\\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-bigenough" 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 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)\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: 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" mathcomp-real-closed: needs: - coq - mathcomp-bigenough 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-real-closed run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.18\" --argstr job \"mathcomp-real-closed\" \\\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 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-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-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-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-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 current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr job "mathcomp-real-closed" mathcomp-zify: 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-zify run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.18\" --argstr job \"mathcomp-zify\" \\\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: 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-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 current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr job "mathcomp-zify" multinomials: needs: - coq - mathcomp-finmap - mathcomp-bigenough 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target multinomials run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.18\" --argstr job \"multinomials\" \\\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: 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-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-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-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 current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr job "multinomials" 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 real-closed-2.0.2/.github/workflows/nix-action-8.19.yml000066400000000000000000001112461472566273500225210ustar00rootroot00000000000000jobs: 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 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.19\" --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.19" --argstr job "coq" coqeal: needs: - coq - multinomials - mathcomp-real-closed 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target coqeal run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.19\" --argstr job \"coqeal\" \\\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.19" --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.19" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: bignums' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr job "bignums" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: paramcoq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr job "paramcoq" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: multinomials' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr job "multinomials" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr job "mathcomp-real-closed" - 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.19" --argstr job "coqeal" 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 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.19\" --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.19" --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.19" --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.19" --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.19" --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.19" --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.19" --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.19" --argstr job "mathcomp-character" - 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.19" --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.19" --argstr job "mathcomp" mathcomp-abel: needs: - coq - mathcomp-real-closed 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-abel run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.19\" --argstr job \"mathcomp-abel\" \\\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.19" --argstr job "coq" - 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.19" --argstr job "mathcomp-field" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr job "mathcomp-real-closed" - 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.19" --argstr job "mathcomp-abel" mathcomp-algebra-tactics: needs: - coq - mathcomp-zify 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-algebra-tactics run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.19\" --argstr job \"mathcomp-algebra-tactics\" \\\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.19" --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.19" --argstr job "mathcomp-algebra" - 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.19" --argstr job "coq-elpi" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-zify' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr job "mathcomp-zify" - 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.19" --argstr job "mathcomp-algebra-tactics" mathcomp-apery: needs: - coq - coqeal - mathcomp-real-closed - mathcomp-bigenough - mathcomp-zify - mathcomp-algebra-tactics 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-apery run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.19\" --argstr job \"mathcomp-apery\" \\\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.19" --argstr job "coq" - 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.19" --argstr job "mathcomp-field" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: coqeal' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr job "coqeal" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr job "mathcomp-real-closed" - 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.19" --argstr job "mathcomp-bigenough" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-zify' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr job "mathcomp-zify" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-algebra-tactics' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr job "mathcomp-algebra-tactics" - 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.19" --argstr job "mathcomp-apery" mathcomp-bigenough: 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-bigenough run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.19\" --argstr job \"mathcomp-bigenough\" \\\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.19" --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.19" --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.19" --argstr job "mathcomp-bigenough" 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 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.19\" --argstr job \"mathcomp-finmap\" \\\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.19" --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.19" --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.19" --argstr job "mathcomp-finmap" mathcomp-real-closed: needs: - coq - mathcomp-bigenough 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-real-closed run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.19\" --argstr job \"mathcomp-real-closed\" \\\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.19" --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.19" --argstr job "mathcomp-ssreflect" - 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.19" --argstr job "mathcomp-algebra" - 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.19" --argstr job "mathcomp-field" - 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.19" --argstr job "mathcomp-fingroup" - 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.19" --argstr job "mathcomp-solvable" - 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.19" --argstr job "mathcomp-bigenough" - 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.19" --argstr job "mathcomp-real-closed" mathcomp-zify: 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-zify run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.19\" --argstr job \"mathcomp-zify\" \\\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.19" --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.19" --argstr job "mathcomp-algebra" - 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.19" --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.19" --argstr job "mathcomp-fingroup" - 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.19" --argstr job "mathcomp-zify" multinomials: needs: - coq - mathcomp-finmap - mathcomp-bigenough 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target multinomials run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.19\" --argstr job \"multinomials\" \\\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.19" --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.19" --argstr job "mathcomp-ssreflect" - 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.19" --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.19" --argstr job "mathcomp-finmap" - 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.19" --argstr job "mathcomp-fingroup" - 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.19" --argstr job "mathcomp-bigenough" - 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.19" --argstr job "multinomials" name: Nix CI for bundle 8.19 on: pull_request: paths: - .github/workflows/nix-action-8.19.yml pull_request_target: paths-ignore: - .github/workflows/nix-action-8.19.yml types: - opened - synchronize - reopened push: branches: - master real-closed-2.0.2/.github/workflows/nix-action-8.20.yml000066400000000000000000001112461472566273500225110ustar00rootroot00000000000000jobs: 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 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.20\" --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.20" --argstr job "coq" coqeal: needs: - coq - multinomials - mathcomp-real-closed 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target coqeal run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.20\" --argstr job \"coqeal\" \\\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.20" --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.20" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: bignums' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr job "bignums" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: paramcoq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr job "paramcoq" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: multinomials' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr job "multinomials" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr job "mathcomp-real-closed" - 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.20" --argstr job "coqeal" 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 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.20\" --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.20" --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.20" --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.20" --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.20" --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.20" --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.20" --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.20" --argstr job "mathcomp-character" - 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.20" --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.20" --argstr job "mathcomp" mathcomp-abel: needs: - coq - mathcomp-real-closed 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-abel run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.20\" --argstr job \"mathcomp-abel\" \\\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.20" --argstr job "coq" - 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.20" --argstr job "mathcomp-field" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr job "mathcomp-real-closed" - 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.20" --argstr job "mathcomp-abel" mathcomp-algebra-tactics: needs: - coq - mathcomp-zify 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-algebra-tactics run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.20\" --argstr job \"mathcomp-algebra-tactics\" \\\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.20" --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.20" --argstr job "mathcomp-algebra" - 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.20" --argstr job "coq-elpi" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-zify' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr job "mathcomp-zify" - 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.20" --argstr job "mathcomp-algebra-tactics" mathcomp-apery: needs: - coq - coqeal - mathcomp-real-closed - mathcomp-bigenough - mathcomp-zify - mathcomp-algebra-tactics 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-apery run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.20\" --argstr job \"mathcomp-apery\" \\\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.20" --argstr job "coq" - 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.20" --argstr job "mathcomp-field" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: coqeal' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr job "coqeal" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr job "mathcomp-real-closed" - 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.20" --argstr job "mathcomp-bigenough" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-zify' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr job "mathcomp-zify" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-algebra-tactics' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr job "mathcomp-algebra-tactics" - 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.20" --argstr job "mathcomp-apery" mathcomp-bigenough: 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-bigenough run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.20\" --argstr job \"mathcomp-bigenough\" \\\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.20" --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.20" --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.20" --argstr job "mathcomp-bigenough" 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 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.20\" --argstr job \"mathcomp-finmap\" \\\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.20" --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.20" --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.20" --argstr job "mathcomp-finmap" mathcomp-real-closed: needs: - coq - mathcomp-bigenough 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-real-closed run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.20\" --argstr job \"mathcomp-real-closed\" \\\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.20" --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.20" --argstr job "mathcomp-ssreflect" - 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.20" --argstr job "mathcomp-algebra" - 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.20" --argstr job "mathcomp-field" - 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.20" --argstr job "mathcomp-fingroup" - 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.20" --argstr job "mathcomp-solvable" - 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.20" --argstr job "mathcomp-bigenough" - 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.20" --argstr job "mathcomp-real-closed" mathcomp-zify: 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-zify run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.20\" --argstr job \"mathcomp-zify\" \\\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.20" --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.20" --argstr job "mathcomp-algebra" - 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.20" --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.20" --argstr job "mathcomp-fingroup" - 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.20" --argstr job "mathcomp-zify" multinomials: needs: - coq - mathcomp-finmap - mathcomp-bigenough 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target multinomials run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"8.20\" --argstr job \"multinomials\" \\\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.20" --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.20" --argstr job "mathcomp-ssreflect" - 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.20" --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.20" --argstr job "mathcomp-finmap" - 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.20" --argstr job "mathcomp-fingroup" - 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.20" --argstr job "mathcomp-bigenough" - 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.20" --argstr job "multinomials" name: Nix CI for bundle 8.20 on: pull_request: paths: - .github/workflows/nix-action-8.20.yml pull_request_target: paths-ignore: - .github/workflows/nix-action-8.20.yml types: - opened - synchronize - reopened push: branches: - master real-closed-2.0.2/.github/workflows/nix-action-master.yml000066400000000000000000001357111472566273500234200ustar00rootroot00000000000000jobs: bignums: 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target bignums run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"master\" --argstr job \"bignums\" \\\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 "master" --argstr job "coq" - 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" --argstr job "bignums" 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 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 \"master\" --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 "master" --argstr job "coq" coq-elpi: 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck 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 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 current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" --argstr job "coq-elpi" coqeal: needs: - coq - bignums - paramcoq - multinomials - mathcomp-real-closed 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target coqeal run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"master\" --argstr job \"coqeal\" \\\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 "master" --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 "master" --argstr job "mathcomp-algebra" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: bignums' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" --argstr job "bignums" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: paramcoq' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" --argstr job "paramcoq" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: multinomials' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" --argstr job "multinomials" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" --argstr job "mathcomp-real-closed" - 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" --argstr job "coqeal" hierarchy-builder: needs: - coq - 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck 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 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 current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" --argstr job "hierarchy-builder" mathcomp: needs: - coq - 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 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 \"master\" --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 "master" --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 "master" --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 "master" --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 "master" --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 "master" --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 "master" --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 "master" --argstr job "mathcomp-character" - 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 current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" --argstr job "mathcomp" mathcomp-abel: needs: - coq - mathcomp-real-closed 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-abel run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"master\" --argstr job \"mathcomp-abel\" \\\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 "master" --argstr job "coq" - 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" --argstr job "mathcomp-field" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" --argstr job "mathcomp-real-closed" - 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" --argstr job "mathcomp-abel" mathcomp-algebra-tactics: needs: - coq - coq-elpi - mathcomp-zify 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-algebra-tactics run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"master\" --argstr job \"mathcomp-algebra-tactics\" \\\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 "master" --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 "master" --argstr job "mathcomp-algebra" - 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: mathcomp-zify' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" --argstr job "mathcomp-zify" - 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" --argstr job "mathcomp-algebra-tactics" mathcomp-apery: needs: - coq - coqeal - mathcomp-real-closed - mathcomp-bigenough - mathcomp-zify - mathcomp-algebra-tactics 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-apery run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"master\" --argstr job \"mathcomp-apery\" \\\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 "master" --argstr job "coq" - 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" --argstr job "mathcomp-field" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: coqeal' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" --argstr job "coqeal" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" --argstr job "mathcomp-real-closed" - 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 "master" --argstr job "mathcomp-bigenough" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-zify' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" --argstr job "mathcomp-zify" - if: steps.stepCheck.outputs.status == 'built' name: 'Building/fetching previous CI target: mathcomp-algebra-tactics' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" --argstr job "mathcomp-algebra-tactics" - 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" --argstr job "mathcomp-apery" mathcomp-bigenough: 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck 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 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: mathcomp-ssreflect' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "master" --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 "master" --argstr job "mathcomp-bigenough" 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 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 \"master\" --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 "master" --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 "master" --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 "master" --argstr job "mathcomp-finmap" mathcomp-real-closed: needs: - coq - mathcomp-bigenough 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-real-closed run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"master\" --argstr job \"mathcomp-real-closed\" \\\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 "master" --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 "master" --argstr job "mathcomp-ssreflect" - 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 "master" --argstr job "mathcomp-algebra" - 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" --argstr job "mathcomp-field" - 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 "master" --argstr job "mathcomp-fingroup" - 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 "master" --argstr job "mathcomp-solvable" - 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 "master" --argstr job "mathcomp-bigenough" - 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" --argstr job "mathcomp-real-closed" mathcomp-zify: 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target mathcomp-zify run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"master\" --argstr job \"mathcomp-zify\" \\\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 "master" --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 "master" --argstr job "mathcomp-algebra" - 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" --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 "master" --argstr job "mathcomp-fingroup" - 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" --argstr job "mathcomp-zify" multinomials: needs: - coq - mathcomp-finmap - mathcomp-bigenough 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target multinomials run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"master\" --argstr job \"multinomials\" \\\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 "master" --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 "master" --argstr job "mathcomp-ssreflect" - 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 "master" --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 "master" --argstr job "mathcomp-finmap" - 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 "master" --argstr job "mathcomp-fingroup" - 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 "master" --argstr job "mathcomp-bigenough" - 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" --argstr job "multinomials" paramcoq: 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@v4 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@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community name: math-comp - id: stepCheck name: Checking presence of CI target paramcoq run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr bundle \"master\" --argstr job \"paramcoq\" \\\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 "master" --argstr job "coq" - 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" --argstr job "paramcoq" name: Nix CI for bundle master on: pull_request: paths: - .github/workflows/nix-action-master.yml pull_request_target: paths-ignore: - .github/workflows/nix-action-master.yml types: - opened - synchronize - reopened push: branches: - master real-closed-2.0.2/.gitignore000066400000000000000000000001401472566273500157110ustar00rootroot00000000000000*.d *.vo *.vio *.vos *.vok *.cm* *~ *.glob *.aux *.a *.o Make*.coq Make*.coq.bak Make*.coq.conf real-closed-2.0.2/.nix/000077500000000000000000000000001472566273500146025ustar00rootroot00000000000000real-closed-2.0.2/.nix/config.nix000066400000000000000000000071471472566273500166000ustar00rootroot00000000000000{ ## DO NOT CHANGE THIS format = "1.0.0"; ## unless you made an automated or manual update ## to another supported format. ## The attribute to build from the local sources, ## either using nixpkgs data or the overlays located in `.nix/coq-overlays` ## Will determine the default main-job of the bundles defined below attribute = "mathcomp-real-closed"; ## If you want to select a different attribute (to build from the local sources as well) ## when calling `nix-shell` and `nix-build` without the `--argstr job` argument # shell-attribute = "{{nix_name}}"; ## Maybe the shortname of the library is different from ## the name of the nixpkgs attribute, if so, set it here: # pname = "{{shortname}}"; ## Lists the dependencies, phrased in terms of nix attributes. ## No need to list Coq, it is already included. ## These dependencies will systematically be added to the currently ## known dependencies, if any more than Coq. ## /!\ Remove this field as soon as the package is available on nixpkgs. ## /!\ Manual overlays in `.nix/coq-overlays` should be preferred then. # buildInputs = [ ]; ## Indicate the relative location of your _CoqProject ## If not specified, it defaults to "_CoqProject" # coqproject = "_CoqProject"; ## select an entry to build in the following `bundles` set ## defaults to "default" default-bundle = "8.20"; ## write one `bundles.name` attribute set per ## alternative configuration ## When generating GitHub Action CI, one workflow file ## will be created per bundle bundles = let common-bundles = { coqeal.override.version = "master"; mathcomp-apery.override.version = "master"; mathcomp-algebra-tactics.override.version = "master"; mathcomp-bigenough.override.version = "master"; mathcomp-finmap.override.version = "master"; mathcomp-zify.override.version = "master"; multinomials.override.version = "master"; mathcomp-abel.override.version = "master"; }; in { "8.17".coqPackages = common-bundles // { coq.override.version = "8.17"; mathcomp.override.version = "2.1.0"; }; "8.18".coqPackages = common-bundles // { coq.override.version = "8.18"; mathcomp.override.version = "2.3.0"; }; "8.19".coqPackages = common-bundles // { coq.override.version = "8.19"; mathcomp.override.version = "2.3.0"; }; "8.20".coqPackages = common-bundles // { coq.override.version = "8.20"; mathcomp.override.version = "2.3.0"; }; "master".coqPackages = common-bundles // { coq.override.version = "master"; bignums.override.version = "master"; paramcoq.override.version = "master"; coq-elpi.override.version = "master"; hierarchy-builder.override.version = "master"; mathcomp.override.version = "master"; }; "master".ocamlPackages = { elpi.override.version = "1.19.2"; }; }; ## Cachix caches to use in CI ## Below we list some standard ones 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. } real-closed-2.0.2/.nix/coq-nix-toolbox.nix000066400000000000000000000000531472566273500203620ustar00rootroot00000000000000"858ff8dd010deded3b9cab8e04fbfad20151af5c" real-closed-2.0.2/.nix/nixpkgs.nix000066400000000000000000000003221472566273500170020ustar00rootroot00000000000000fetchTarball { url = "https://github.com/CohenCyril/nixpkgs/archive/948447c4fbc2b037d08b25c7b7f3339145ab9235.tar.gz"; sha256 = "09hjqk8vnfkywydr6ha3cjam9r9xlkx3zz02fj6z29j8p3sk5fqi"; } real-closed-2.0.2/AUTHORS000066400000000000000000000000641472566273500147760ustar00rootroot00000000000000Cyril Cohen Inria Assia Mahboubi Inria real-closed-2.0.2/CeCILL-B000066400000000000000000000526231472566273500150330ustar00rootroot00000000000000CeCILL-B FREE SOFTWARE LICENSE AGREEMENT Notice This Agreement is a Free Software license agreement that is the result of discussions between its authors in order to ensure compliance with the two main principles guiding its drafting: * firstly, compliance with the principles governing the distribution of Free Software: access to source code, broad rights granted to users, * secondly, the election of a governing law, French law, with which it is conformant, both as regards the law of torts and intellectual property law, and the protection that it offers to both authors and holders of the economic rights over software. The authors of the CeCILL-B (for Ce[a] C[nrs] I[nria] L[ogiciel] L[ibre]) license are: Commissariat à l'Energie Atomique - CEA, a public scientific, technical and industrial research establishment, having its principal place of business at 25 rue Leblanc, immeuble Le Ponant D, 75015 Paris, France. Centre National de la Recherche Scientifique - CNRS, a public scientific and technological establishment, having its principal place of business at 3 rue Michel-Ange, 75794 Paris cedex 16, France. Institut National de Recherche en Informatique et en Automatique - INRIA, a public scientific and technological establishment, having its principal place of business at Domaine de Voluceau, Rocquencourt, BP 105, 78153 Le Chesnay cedex, France. Preamble This Agreement is an open source software license intended to give users significant freedom to modify and redistribute the software licensed hereunder. The exercising of this freedom is conditional upon a strong obligation of giving credits for everybody that distributes a software incorporating a software ruled by the current license so as all contributions to be properly identified and acknowledged. In consideration of access to the source code and the rights to copy, modify and redistribute granted by the license, users are provided only with a limited warranty and the software's author, the holder of the economic rights, and the successive licensors only have limited liability. In this respect, the risks associated with loading, using, modifying and/or developing or reproducing the software by the user are brought to the user's attention, given its Free Software status, which may make it complicated to use, with the result that its use is reserved for developers and experienced professionals having in-depth computer knowledge. Users are therefore encouraged to load and test the suitability of the software as regards their requirements in conditions enabling the security of their systems and/or data to be ensured and, more generally, to use and operate it in the same conditions of security. This Agreement may be freely reproduced and published, provided it is not altered, and that no provisions are either added or removed herefrom. This Agreement may apply to any or all software for which the holder of the economic rights decides to submit the use thereof to its provisions. Article 1 - DEFINITIONS For the purpose of this Agreement, when the following expressions commence with a capital letter, they shall have the following meaning: Agreement: means this license agreement, and its possible subsequent versions and annexes. Software: means the software in its Object Code and/or Source Code form and, where applicable, its documentation, "as is" when the Licensee accepts the Agreement. Initial Software: means the Software in its Source Code and possibly its Object Code form and, where applicable, its documentation, "as is" when it is first distributed under the terms and conditions of the Agreement. Modified Software: means the Software modified by at least one Contribution. Source Code: means all the Software's instructions and program lines to which access is required so as to modify the Software. Object Code: means the binary files originating from the compilation of the Source Code. Holder: means the holder(s) of the economic rights over the Initial Software. Licensee: means the Software user(s) having accepted the Agreement. Contributor: means a Licensee having made at least one Contribution. Licensor: means the Holder, or any other individual or legal entity, who distributes the Software under the Agreement. Contribution: means any or all modifications, corrections, translations, adaptations and/or new functions integrated into the Software by any or all Contributors, as well as any or all Internal Modules. Module: means a set of sources files including their documentation that enables supplementary functions or services in addition to those offered by the Software. External Module: means any or all Modules, not derived from the Software, so that this Module and the Software run in separate address spaces, with one calling the other when they are run. Internal Module: means any or all Module, connected to the Software so that they both execute in the same address space. Parties: mean both the Licensee and the Licensor. These expressions may be used both in singular and plural form. Article 2 - PURPOSE The purpose of the Agreement is the grant by the Licensor to the Licensee of a non-exclusive, transferable and worldwide license for the Software as set forth in Article 5 hereinafter for the whole term of the protection granted by the rights over said Software. Article 3 - ACCEPTANCE 3.1 The Licensee shall be deemed as having accepted the terms and conditions of this Agreement upon the occurrence of the first of the following events: * (i) loading the Software by any or all means, notably, by downloading from a remote server, or by loading from a physical medium; * (ii) the first time the Licensee exercises any of the rights granted hereunder. 3.2 One copy of the Agreement, containing a notice relating to the characteristics of the Software, to the limited warranty, and to the fact that its use is restricted to experienced users has been provided to the Licensee prior to its acceptance as set forth in Article 3.1 hereinabove, and the Licensee hereby acknowledges that it has read and understood it. Article 4 - EFFECTIVE DATE AND TERM 4.1 EFFECTIVE DATE The Agreement shall become effective on the date when it is accepted by the Licensee as set forth in Article 3.1. 4.2 TERM The Agreement shall remain in force for the entire legal term of protection of the economic rights over the Software. Article 5 - SCOPE OF RIGHTS GRANTED The Licensor hereby grants to the Licensee, who accepts, the following rights over the Software for any or all use, and for the term of the Agreement, on the basis of the terms and conditions set forth hereinafter. Besides, if the Licensor owns or comes to own one or more patents protecting all or part of the functions of the Software or of its components, the Licensor undertakes not to enforce the rights granted by these patents against successive Licensees using, exploiting or modifying the Software. If these patents are transferred, the Licensor undertakes to have the transferees subscribe to the obligations set forth in this paragraph. 5.1 RIGHT OF USE The Licensee is authorized to use the Software, without any limitation as to its fields of application, with it being hereinafter specified that this comprises: 1. permanent or temporary reproduction of all or part of the Software by any or all means and in any or all form. 2. loading, displaying, running, or storing the Software on any or all medium. 3. entitlement to observe, study or test its operation so as to determine the ideas and principles behind any or all constituent elements of said Software. This shall apply when the Licensee carries out any or all loading, displaying, running, transmission or storage operation as regards the Software, that it is entitled to carry out hereunder. 5.2 ENTITLEMENT TO MAKE CONTRIBUTIONS The right to make Contributions includes the right to translate, adapt, arrange, or make any or all modifications to the Software, and the right to reproduce the resulting software. The Licensee is authorized to make any or all Contributions to the Software provided that it includes an explicit notice that it is the author of said Contribution and indicates the date of the creation thereof. 5.3 RIGHT OF DISTRIBUTION In particular, the right of distribution includes the right to publish, transmit and communicate the Software to the general public on any or all medium, and by any or all means, and the right to market, either in consideration of a fee, or free of charge, one or more copies of the Software by any means. The Licensee is further authorized to distribute copies of the modified or unmodified Software to third parties according to the terms and conditions set forth hereinafter. 5.3.1 DISTRIBUTION OF SOFTWARE WITHOUT MODIFICATION The Licensee is authorized to distribute true copies of the Software in Source Code or Object Code form, provided that said distribution complies with all the provisions of the Agreement and is accompanied by: 1. a copy of the Agreement, 2. a notice relating to the limitation of both the Licensor's warranty and liability as set forth in Articles 8 and 9, and that, in the event that only the Object Code of the Software is redistributed, the Licensee allows effective access to the full Source Code of the Software at a minimum during the entire period of its distribution of the Software, it being understood that the additional cost of acquiring the Source Code shall not exceed the cost of transferring the data. 5.3.2 DISTRIBUTION OF MODIFIED SOFTWARE If the Licensee makes any Contribution to the Software, the resulting Modified Software may be distributed under a license agreement other than this Agreement subject to compliance with the provisions of Article 5.3.4. 5.3.3 DISTRIBUTION OF EXTERNAL MODULES When the Licensee has developed an External Module, the terms and conditions of this Agreement do not apply to said External Module, that may be distributed under a separate license agreement. 5.3.4 CREDITS Any Licensee who may distribute a Modified Software hereby expressly agrees to: 1. indicate in the related documentation that it is based on the Software licensed hereunder, and reproduce the intellectual property notice for the Software, 2. ensure that written indications of the Software intended use, intellectual property notice and license hereunder are included in easily accessible format from the Modified Software interface, 3. mention, on a freely accessible website describing the Modified Software, at least throughout the distribution term thereof, that it is based on the Software licensed hereunder, and reproduce the Software intellectual property notice, 4. where it is distributed to a third party that may distribute a Modified Software without having to make its source code available, make its best efforts to ensure that said third party agrees to comply with the obligations set forth in this Article . If the Software, whether or not modified, is distributed with an External Module designed for use in connection with the Software, the Licensee shall submit said External Module to the foregoing obligations. 5.3.5 COMPATIBILITY WITH THE CeCILL AND CeCILL-C LICENSES Where a Modified Software contains a Contribution subject to the CeCILL license, the provisions set forth in Article 5.3.4 shall be optional. A Modified Software may be distributed under the CeCILL-C license. In such a case the provisions set forth in Article 5.3.4 shall be optional. Article 6 - INTELLECTUAL PROPERTY 6.1 OVER THE INITIAL SOFTWARE The Holder owns the economic rights over the Initial Software. Any or all use of the Initial Software is subject to compliance with the terms and conditions under which the Holder has elected to distribute its work and no one shall be entitled to modify the terms and conditions for the distribution of said Initial Software. The Holder undertakes that the Initial Software will remain ruled at least by this Agreement, for the duration set forth in Article 4.2. 6.2 OVER THE CONTRIBUTIONS The Licensee who develops a Contribution is the owner of the intellectual property rights over this Contribution as defined by applicable law. 6.3 OVER THE EXTERNAL MODULES The Licensee who develops an External Module is the owner of the intellectual property rights over this External Module as defined by applicable law and is free to choose the type of agreement that shall govern its distribution. 6.4 JOINT PROVISIONS The Licensee expressly undertakes: 1. not to remove, or modify, in any manner, the intellectual property notices attached to the Software; 2. to reproduce said notices, in an identical manner, in the copies of the Software modified or not. The Licensee undertakes not to directly or indirectly infringe the intellectual property rights of the Holder and/or Contributors on the Software and to take, where applicable, vis-à-vis its staff, any and all measures required to ensure respect of said intellectual property rights of the Holder and/or Contributors. Article 7 - RELATED SERVICES 7.1 Under no circumstances shall the Agreement oblige the Licensor to provide technical assistance or maintenance services for the Software. However, the Licensor is entitled to offer this type of services. The terms and conditions of such technical assistance, and/or such maintenance, shall be set forth in a separate instrument. Only the Licensor offering said maintenance and/or technical assistance services shall incur liability therefor. 7.2 Similarly, any Licensor is entitled to offer to its licensees, under its sole responsibility, a warranty, that shall only be binding upon itself, for the redistribution of the Software and/or the Modified Software, under terms and conditions that it is free to decide. Said warranty, and the financial terms and conditions of its application, shall be subject of a separate instrument executed between the Licensor and the Licensee. Article 8 - LIABILITY 8.1 Subject to the provisions of Article 8.2, the Licensee shall be entitled to claim compensation for any direct loss it may have suffered from the Software as a result of a fault on the part of the relevant Licensor, subject to providing evidence thereof. 8.2 The Licensor's liability is limited to the commitments made under this Agreement and shall not be incurred as a result of in particular: (i) loss due the Licensee's total or partial failure to fulfill its obligations, (ii) direct or consequential loss that is suffered by the Licensee due to the use or performance of the Software, and (iii) more generally, any consequential loss. In particular the Parties expressly agree that any or all pecuniary or business loss (i.e. loss of data, loss of profits, operating loss, loss of customers or orders, opportunity cost, any disturbance to business activities) or any or all legal proceedings instituted against the Licensee by a third party, shall constitute consequential loss and shall not provide entitlement to any or all compensation from the Licensor. Article 9 - WARRANTY 9.1 The Licensee acknowledges that the scientific and technical state-of-the-art when the Software was distributed did not enable all possible uses to be tested and verified, nor for the presence of possible defects to be detected. In this respect, the Licensee's attention has been drawn to the risks associated with loading, using, modifying and/or developing and reproducing the Software which are reserved for experienced users. The Licensee shall be responsible for verifying, by any or all means, the suitability of the product for its requirements, its good working order, and for ensuring that it shall not cause damage to either persons or properties. 9.2 The Licensor hereby represents, in good faith, that it is entitled to grant all the rights over the Software (including in particular the rights set forth in Article 5). 9.3 The Licensee acknowledges that the Software is supplied "as is" by the Licensor without any other express or tacit warranty, other than that provided for in Article 9.2 and, in particular, without any warranty as to its commercial value, its secured, safe, innovative or relevant nature. Specifically, the Licensor does not warrant that the Software is free from any error, that it will operate without interruption, that it will be compatible with the Licensee's own equipment and software configuration, nor that it will meet the Licensee's requirements. 9.4 The Licensor does not either expressly or tacitly warrant that the Software does not infringe any third party intellectual property right relating to a patent, software or any other property right. Therefore, the Licensor disclaims any and all liability towards the Licensee arising out of any or all proceedings for infringement that may be instituted in respect of the use, modification and redistribution of the Software. Nevertheless, should such proceedings be instituted against the Licensee, the Licensor shall provide it with technical and legal assistance for its defense. Such technical and legal assistance shall be decided on a case-by-case basis between the relevant Licensor and the Licensee pursuant to a memorandum of understanding. The Licensor disclaims any and all liability as regards the Licensee's use of the name of the Software. No warranty is given as regards the existence of prior rights over the name of the Software or as regards the existence of a trademark. Article 10 - TERMINATION 10.1 In the event of a breach by the Licensee of its obligations hereunder, the Licensor may automatically terminate this Agreement thirty (30) days after notice has been sent to the Licensee and has remained ineffective. 10.2 A Licensee whose Agreement is terminated shall no longer be authorized to use, modify or distribute the Software. However, any licenses that it may have granted prior to termination of the Agreement shall remain valid subject to their having been granted in compliance with the terms and conditions hereof. Article 11 - MISCELLANEOUS 11.1 EXCUSABLE EVENTS Neither Party shall be liable for any or all delay, or failure to perform the Agreement, that may be attributable to an event of force majeure, an act of God or an outside cause, such as defective functioning or interruptions of the electricity or telecommunications networks, network paralysis following a virus attack, intervention by government authorities, natural disasters, water damage, earthquakes, fire, explosions, strikes and labor unrest, war, etc. 11.2 Any failure by either Party, on one or more occasions, to invoke one or more of the provisions hereof, shall under no circumstances be interpreted as being a waiver by the interested Party of its right to invoke said provision(s) subsequently. 11.3 The Agreement cancels and replaces any or all previous agreements, whether written or oral, between the Parties and having the same purpose, and constitutes the entirety of the agreement between said Parties concerning said purpose. No supplement or modification to the terms and conditions hereof shall be effective as between the Parties unless it is made in writing and signed by their duly authorized representatives. 11.4 In the event that one or more of the provisions hereof were to conflict with a current or future applicable act or legislative text, said act or legislative text shall prevail, and the Parties shall make the necessary amendments so as to comply with said act or legislative text. All other provisions shall remain effective. Similarly, invalidity of a provision of the Agreement, for any reason whatsoever, shall not cause the Agreement as a whole to be invalid. 11.5 LANGUAGE The Agreement is drafted in both French and English and both versions are deemed authentic. Article 12 - NEW VERSIONS OF THE AGREEMENT 12.1 Any person is authorized to duplicate and distribute copies of this Agreement. 12.2 So as to ensure coherence, the wording of this Agreement is protected and may only be modified by the authors of the License, who reserve the right to periodically publish updates or new versions of the Agreement, each with a separate number. These subsequent versions may address new issues encountered by Free Software. 12.3 Any Software distributed under a given version of the Agreement may only be subsequently distributed under the same version of the Agreement or a subsequent version. Article 13 - GOVERNING LAW AND JURISDICTION 13.1 The Agreement is governed by French law. The Parties agree to endeavor to seek an amicable solution to any disagreements or disputes that may arise during the performance of the Agreement. 13.2 Failing an amicable solution within two (2) months as from their occurrence, and unless emergency proceedings are necessary, the disagreements or disputes shall be referred to the Paris Courts having jurisdiction, by the more diligent Party. Version 1.0 dated 2006-09-05. real-closed-2.0.2/Makefile000066400000000000000000000016571472566273500153770ustar00rootroot00000000000000# KNOWNTARGETS will not be passed along to CoqMakefile KNOWNTARGETS := Makefile.coq # KNOWNFILES will not get implicit targets from the final rule, and so # depending on them won't invoke the submake # Warning: These files get declared as PHONY, so any targets depending # on them always get rebuilt KNOWNFILES := Makefile _CoqProject .DEFAULT_GOAL := invoke-coqmakefile Makefile.coq: Makefile _CoqProject $(COQBIN)coq_makefile -f _CoqProject -o Makefile.coq invoke-coqmakefile: Makefile.coq $(MAKE) --no-print-directory -f Makefile.coq $(filter-out $(KNOWNTARGETS),$(MAKECMDGOALS)) .PHONY: invoke-coqmakefile $(KNOWNFILES) #################################################################### ## Your targets here ## #################################################################### # This should be the last rule, to handle any targets not declared above %: invoke-coqmakefile @true real-closed-2.0.2/README.md000066400000000000000000000126221472566273500152100ustar00rootroot00000000000000 # Real closed fields [![Docker CI][docker-action-shield]][docker-action-link] [docker-action-shield]: https://github.com/math-comp/real-closed/actions/workflows/docker-action.yml/badge.svg?branch=master [docker-action-link]: https://github.com/math-comp/real-closed/actions/workflows/docker-action.yml This library contains definitions and theorems about real closed fields, with a construction of the real closure and the algebraic closure (including a proof of the fundamental theorem of algebra). It also contains a proof of decidability of the first order theory of real closed field, through quantifier elimination. ## Meta - Author(s): - Cyril Cohen (initial) - Assia Mahboubi (initial) - License: [CeCILL-B](CECILL-B) - Compatible Coq versions: Coq 8.17 or later - Additional dependencies: - [MathComp ssreflect 2.1 or later](https://math-comp.github.io) - [MathComp algebra](https://math-comp.github.io) - [MathComp field](https://math-comp.github.io) - [MathComp bigenough 1.0.0 or later](https://github.com/math-comp/bigenough) - Coq namespace: `mathcomp.real_closed` - Related publication(s): - [Formal proofs in real algebraic geometry: from ordered fields to quantifier elimination](https://hal.inria.fr/inria-00593738v4) doi:[10.2168/LMCS-8(1:2)2012](https://doi.org/10.2168/LMCS-8(1:2)2012) - [Construction of real algebraic numbers in Coq](https://hal.inria.fr/hal-00671809v2) doi:[10.1007/978-3-642-32347-8_6](https://doi.org/10.1007/978-3-642-32347-8_6) ## Building and installation instructions The easiest way to install the latest released version of Real closed fields is via [OPAM](https://opam.ocaml.org/doc/Install.html): ```shell opam repo add coq-released https://coq.inria.fr/opam/released opam install coq-mathcomp-real-closed ``` To instead build and install manually, do: ``` shell git clone https://github.com/math-comp/real-closed.git cd real-closed make # or make -j make install ``` ## Documentation The repository contains - the decision procedure `rcf_sat` and its corectness lemma [`rcf_satP`](https://github.com/math-comp/real-closed/blob/3721886fffb13ea9c80824043f119ffed0c780f2/theories/qe_rcf.v#L991) for the first order theory of real closed fields through [certified quantifier elimination](https://hal.inria.fr/inria-00593738v4) - the definition `{realclosure F}` , a [construction of the real closure of an archimedean field](https://hal.inria.fr/hal-00671809v2), which is canonically a [`rcfType`](https://github.com/math-comp/math-comp/blob/c1ec9cd8e7e50f73159613c492aad4c6c40bc3aa/mathcomp/algebra/ssrnum.v#L63) when `F` is an archimedean field, and the characteristic theorems of section [`RealClosureTheory`](https://github.com/math-comp/real-closed/blob/3721886fffb13ea9c80824043f119ffed0c780f2/theories/realalg.v#L1477). - the definition `complex R`, a construction of the algebraic closure of a real closed field, which is canonically a [`numClosedFieldType`](https://github.com/math-comp/math-comp/blob/c1ec9cd8e7e50f73159613c492aad4c6c40bc3aa/mathcomp/algebra/ssrnum.v#L73) that additionally satisfies [`complexalg_algebraic`](https://github.com/math-comp/real-closed/blob/3721886fffb13ea9c80824043f119ffed0c780f2/theories/complex.v#L1324). Except for the end-results listed above, one should not rely on anything. The formalization is based on the [Mathematical Components](https://github.com/math-comp/math-comp) library for the [Coq](https://coq.inria.fr) proof assistant. ## Development instructions ### With nix. 1. Install nix: - To install it on a single-user unix system where you have admin rights, just type: > sh <(curl https://nixos.org/nix/install) You should run this under your usual user account, not as root. The script will invoke `sudo` as needed. 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 **log out of your desktop session and log in again** before you proceed to step 2. - Step 1. only need to be done once on a same machine. 2. Open a new terminal. Navigate to the root of the Abel 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. 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. - 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`. real-closed-2.0.2/_CoqProject000066400000000000000000000010611472566273500160570ustar00rootroot00000000000000theories/all_real_closed.v theories/cauchyreals.v theories/complex.v theories/ordered_qelim.v theories/polyorder.v theories/polyrcf.v theories/qe_rcf_th.v theories/qe_rcf.v theories/realalg.v theories/mxtens.v -R theories mathcomp.real_closed -arg -w -arg -projection-no-head-constant -arg -w -arg -redundant-canonical-projection -arg -w -arg -notation-overridden -arg -w -arg +duplicate-clear -arg -w -arg +non-primitive-record -arg -w -arg +undeclared-scope -arg -w -arg -ambiguous-paths -arg -w -arg -uniform-inheritance -arg -w -arg -deprecated-since-8.19 real-closed-2.0.2/config.nix000066400000000000000000000000641472566273500157130ustar00rootroot00000000000000{ coq = "8.11"; mathcomp = "mathcomp-1.12.0"; } real-closed-2.0.2/coq-mathcomp-real-closed.opam000066400000000000000000000022411472566273500213630ustar00rootroot00000000000000# This file was generated from `meta.yml`, please do not edit manually. # Follow the instructions on https://github.com/coq-community/templates to regenerate. opam-version: "2.0" maintainer: "Cyril Cohen " version: "dev" homepage: "https://github.com/math-comp/real-closed" dev-repo: "git+https://github.com/math-comp/real-closed.git" bug-reports: "https://github.com/math-comp/real-closed/issues" license: "CECILL-B" synopsis: "Mathematical Components Library on real closed fields" description: """ This library contains definitions and theorems about real closed fields, with a construction of the real closure and the algebraic closure (including a proof of the fundamental theorem of algebra). It also contains a proof of decidability of the first order theory of real closed field, through quantifier elimination.""" build: [make "-j%{jobs}%"] install: [make "install"] depends: [ "coq" {>= "8.17"} "coq-mathcomp-ssreflect" {>= "2.1"} "coq-mathcomp-algebra" "coq-mathcomp-field" "coq-mathcomp-bigenough" {>= "1.0.0"} ] tags: [ "keyword:real closed field" "logpath:mathcomp.real_closed" ] authors: [ "Cyril Cohen" "Assia Mahboubi" ] real-closed-2.0.2/default.nix000066400000000000000000000006611472566273500160750ustar00rootroot00000000000000{ config ? {}, withEmacs ? false, print-env ? false, do-nothing ? false, update-nixpkgs ? false, ci-matrix ? false, override ? {}, ocaml-override ? {}, global-override ? {}, bundle ? null, job ? null, inNixShell ? null, src ? ./., }@args: let auto = fetchGit { url = "https://github.com/coq-community/coq-nix-toolbox.git"; ref = "master"; rev = import .nix/coq-nix-toolbox.nix; }; in import auto ({inherit src;} // args) real-closed-2.0.2/dune000066400000000000000000000002221472566273500146000ustar00rootroot00000000000000(coq.theory (name mathcomp.real_closed) (package coq-mathcomp-real-closed) (synopsis "Mathematical Components Library on real closed fields")) real-closed-2.0.2/dune-project000066400000000000000000000000631472566273500162470ustar00rootroot00000000000000(lang dune 2.5) (using coq 0.2) (name real-closed) real-closed-2.0.2/index.md000066400000000000000000000040211472566273500153540ustar00rootroot00000000000000--- title: Real closed fields lang: en header-includes: - | ---
View the project on GitHub
## About Welcome to the Real closed fields project website! This library contains definitions and theorems about real closed fields, with a construction of the real closure and the algebraic closure (including a proof of the fundamental theorem of algebra). It also contains a proof of decidability of the first order theory of real closed field, through quantifier elimination. This is an open source project, licensed under the CeCILL-B. ## Get the code The current stable release of Real closed fields can be [downloaded from GitHub](https://github.com/math-comp/real-closed/releases). ## Documentation Related publications, if any, are listed below. - [Formal proofs in real algebraic geometry: from ordered fields to quantifier elimination](https://hal.inria.fr/inria-00593738v4) doi:[10.2168/LMCS-8(1:2)2012](https://doi.org/10.2168/LMCS-8(1:2)2012) - [Construction of real algebraic numbers in Coq](https://hal.inria.fr/hal-00671809v2) doi:[10.1007/978-3-642-32347-8_6](https://doi.org/10.1007/978-3-642-32347-8_6) ## Help and contact - Report issues on [GitHub](https://github.com/math-comp/real-closed/issues) ## Authors and contributors - Cyril Cohen - Assia Mahboubi real-closed-2.0.2/meta.yml000066400000000000000000000135111472566273500154000ustar00rootroot00000000000000fullname: Real closed fields shortname: real-closed organization: math-comp opam_name: coq-mathcomp-real-closed community: false action: true coqdoc: false synopsis: >- Mathematical Components Library on real closed fields description: |- This library contains definitions and theorems about real closed fields, with a construction of the real closure and the algebraic closure (including a proof of the fundamental theorem of algebra). It also contains a proof of decidability of the first order theory of real closed field, through quantifier elimination. publications: - pub_url: https://hal.inria.fr/inria-00593738v4 pub_title: "Formal proofs in real algebraic geometry: from ordered fields to quantifier elimination" pub_doi: 10.2168/LMCS-8(1:2)2012 - pub_url: https://hal.inria.fr/hal-00671809v2 pub_title: Construction of real algebraic numbers in Coq pub_doi: 10.1007/978-3-642-32347-8_6 authors: - name: Cyril Cohen initial: true - name: Assia Mahboubi initial: true opam-file-maintainer: Cyril Cohen opam-file-version: dev license: fullname: CeCILL-B identifier: CECILL-B file: CECILL-B supported_coq_versions: text: Coq 8.17 or later opam: '{>= "8.17"}' tested_coq_opam_versions: - version: '2.1.0-coq-8.17' repo: 'mathcomp/mathcomp' - version: '2.1.0-coq-8.18' repo: 'mathcomp/mathcomp' - version: '2.2.0-coq-8.17' repo: 'mathcomp/mathcomp' - version: '2.2.0-coq-8.18' repo: 'mathcomp/mathcomp' - version: '2.2.0-coq-8.19' repo: 'mathcomp/mathcomp' - version: '2.3.0-coq-8.19' repo: 'mathcomp/mathcomp' - version: '2.3.0-coq-8.20' repo: 'mathcomp/mathcomp' - version: '2.3.0-coq-dev' repo: 'mathcomp/mathcomp' - version: 'coq-8.18' repo: 'mathcomp/mathcomp-dev' - version: 'coq-8.19' repo: 'mathcomp/mathcomp-dev' - version: 'coq-dev' repo: 'mathcomp/mathcomp-dev' dependencies: - opam: name: coq-mathcomp-ssreflect version: '{>= "2.1"}' description: |- [MathComp ssreflect 2.1 or later](https://math-comp.github.io) - opam: name: coq-mathcomp-algebra description: |- [MathComp algebra](https://math-comp.github.io) - opam: name: coq-mathcomp-field description: |- [MathComp field](https://math-comp.github.io) - opam: name: coq-mathcomp-bigenough version: '{>= "1.0.0"}' description: |- [MathComp bigenough 1.0.0 or later](https://github.com/math-comp/bigenough) namespace: mathcomp.real_closed keywords: - name: real closed field documentation: |- ## Documentation The repository contains - the decision procedure `rcf_sat` and its corectness lemma [`rcf_satP`](https://github.com/math-comp/real-closed/blob/3721886fffb13ea9c80824043f119ffed0c780f2/theories/qe_rcf.v#L991) for the first order theory of real closed fields through [certified quantifier elimination](https://hal.inria.fr/inria-00593738v4) - the definition `{realclosure F}` , a [construction of the real closure of an archimedean field](https://hal.inria.fr/hal-00671809v2), which is canonically a [`rcfType`](https://github.com/math-comp/math-comp/blob/c1ec9cd8e7e50f73159613c492aad4c6c40bc3aa/mathcomp/algebra/ssrnum.v#L63) when `F` is an archimedean field, and the characteristic theorems of section [`RealClosureTheory`](https://github.com/math-comp/real-closed/blob/3721886fffb13ea9c80824043f119ffed0c780f2/theories/realalg.v#L1477). - the definition `complex R`, a construction of the algebraic closure of a real closed field, which is canonically a [`numClosedFieldType`](https://github.com/math-comp/math-comp/blob/c1ec9cd8e7e50f73159613c492aad4c6c40bc3aa/mathcomp/algebra/ssrnum.v#L73) that additionally satisfies [`complexalg_algebraic`](https://github.com/math-comp/real-closed/blob/3721886fffb13ea9c80824043f119ffed0c780f2/theories/complex.v#L1324). Except for the end-results listed above, one should not rely on anything. The formalization is based on the [Mathematical Components](https://github.com/math-comp/math-comp) library for the [Coq](https://coq.inria.fr) proof assistant. ## Development instructions ### With nix. 1. Install nix: - To install it on a single-user unix system where you have admin rights, just type: > sh <(curl https://nixos.org/nix/install) You should run this under your usual user account, not as root. The script will invoke `sudo` as needed. 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 **log out of your desktop session and log in again** before you proceed to step 2. - Step 1. only need to be done once on a same machine. 2. Open a new terminal. Navigate to the root of the Abel 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. 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. - 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`. real-closed-2.0.2/package.nix000066400000000000000000000000271472566273500160400ustar00rootroot00000000000000"mathcomp-real-closed" real-closed-2.0.2/theories/000077500000000000000000000000001472566273500155505ustar00rootroot00000000000000real-closed-2.0.2/theories/all_real_closed.v000066400000000000000000000003431472566273500210430ustar00rootroot00000000000000Require Export cauchyreals. Require Export complex. Require Export ordered_qelim. Require Export polyorder. Require Export polyrcf. Require Export qe_rcf_th. Require Export qe_rcf. Require Export realalg. Require Export mxtens.real-closed-2.0.2/theories/cauchyreals.v000066400000000000000000001765201472566273500202550ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq choice. From mathcomp Require Import fintype bigop binomial order perm ssralg poly. From mathcomp Require Import polydiv ssrnum ssrint rat matrix mxpoly polyXY. From mathcomp Require Import bigenough polyorder. (***************************************************************************) (* This is a standalone construction of Cauchy reals over an arbitrary *) (* discrete archimedian field R. *) (* creals R == setoid of Cauchy sequences, it is not discrete and *) (* cannot be equipped with any ssreflect algebraic structure *) (***************************************************************************) Import Order.TTheory GRing.Theory Num.Theory BigEnough. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Declare Scope creal_scope. Delimit Scope creal_scope with CR. Section poly_extra. Local Open Scope ring_scope. Lemma monic_monic_from_neq0 (F : fieldType) (p : {poly F}) : (p != 0)%B -> (lead_coef p) ^-1 *: p \is monic. Proof. by move=> ?; rewrite monicE lead_coefZ mulVf ?lead_coef_eq0. Qed. (* GG -- lemmas with ssrnum dependencies cannot go in poly! *) Lemma size_derivn (R : realDomainType) (p : {poly R}) n : size p^`(n) = (size p - n)%N. Proof. elim: n=> [|n ihn]; first by rewrite derivn0 subn0. by rewrite derivnS size_deriv ihn -subnS. Qed. Lemma size_nderivn (R : realDomainType) (p : {poly R}) n : size p^`N(n) = (size p - n)%N. Proof. rewrite -size_derivn nderivn_def -mulr_natl. by rewrite -polyC1 -!polyCMn size_Cmul // pnatr_eq0 -lt0n fact_gt0. Qed. End poly_extra. Local Notation eval := horner_eval. Section ordered_extra. Definition gtr0E := (invr_gt0, exprn_gt0, ltr0n, @ltr01). Definition ger0E := (invr_ge0, exprn_ge0, ler0n, @ler01). End ordered_extra. Section polyorder_extra. Variable F : realDomainType. Local Open Scope ring_scope. Definition poly_bound (p : {poly F}) (a r : F) : F := 1 + \sum_(i < size p) `|p`_i| * (`|a| + `|r|) ^+ i. Lemma poly_boundP p a r x : `|x - a| <= r -> `|p.[x]| <= poly_bound p a r. Proof. have [r_ge0|r_lt0] := lerP 0 r; last first. by move=> hr; have := le_lt_trans hr r_lt0; rewrite normr_lt0. rewrite ler_distl=> /andP[lx ux]. rewrite ler_wpDl //. elim/poly_ind: p=> [|p c ihp]. by rewrite horner0 normr0 size_poly0 big_ord0. rewrite hornerMXaddC size_MXaddC. have [->|p_neq0 /=] := altP eqP. rewrite horner0 !mul0r !add0r size_poly0. have [->|c_neq0] /= := altP eqP; first by rewrite normr0 big_ord0. rewrite big_ord_recl big_ord0 addr0 coefC /=. by rewrite ler_pMr ?normr_gt0 // lerDl ler_maxr !normr_ge0. rewrite big_ord_recl coefD coefMX coefC eqxx add0r. rewrite (le_trans (ler_normD _ _)) // addrC lerD //. by rewrite expr0 mulr1. rewrite normrM. move: ihp=> /(ler_wpM2r (normr_ge0 x)) /le_trans-> //. rewrite mulr_suml ler_sum // => i _. rewrite coefD coefC coefMX /= addr0 exprSr mulrA. rewrite ler_wpM2l //. by rewrite ?mulr_ge0 ?exprn_ge0 ?ler_maxr ?addr_ge0 ?normr_ge0 // ltrW. rewrite (ger0_norm r_ge0) ler_norml opprD. rewrite (le_trans _ lx) ?(le_trans ux) // lerD2r. by rewrite ler_normr lexx. by rewrite lerNl ler_normr lexx orbT. Qed. Lemma poly_bound_gt0 p a r : 0 < poly_bound p a r. Proof. rewrite ltr_wpDr // sumr_ge0 // => i _. by rewrite mulr_ge0 ?exprn_ge0 ?addr_ge0 ?ler_maxr ?normr_ge0 // ltrW. Qed. Lemma poly_bound_ge0 p a r : 0 <= poly_bound p a r. Proof. by rewrite ltW // poly_bound_gt0. Qed. Definition poly_accr_bound (p : {poly F}) (a r : F) : F := (Num.max 1 (2%:R * r)) ^+ (size p).-1 * (1 + \sum_(i < (size p).-1) poly_bound p^`N(i.+1) a r). Lemma poly_accr_bound1P p a r x y : `|x - a| <= r -> `|y - a| <= r -> `|p.[y] - p.[x]| <= `|y - x| * poly_accr_bound p a r. Proof. have [|r_lt0] := lerP 0 r; last first. by move=> hr; have := le_lt_trans hr r_lt0; rewrite normr_lt0. rewrite le0r=> /orP[/eqP->|r_gt0 hx hy]. by rewrite !normr_le0 !subr_eq0=> /eqP-> /eqP->; rewrite !subrr normr0 mul0r. rewrite mulrA mulrDr mulr1 ler_wpDl ?mulr_ge0 ?normr_ge0 //=. by rewrite exprn_ge0 ?le_max ?mulr_ge0 ?ger0E ?ltW. rewrite -{1}(addNKr x y) [- _ + _]addrC /= -mulrA. rewrite nderiv_taylor; last exact: mulrC. have [->|p_neq0] := eqVneq p 0. rewrite size_poly0 big_ord0 horner0 subr0 normr0 mulr_ge0 ?normr_ge0 //. by rewrite big_ord0 mulr0 lexx. rewrite -[size _]prednK ?lt0n ?size_poly_eq0 //. rewrite big_ord_recl expr0 mulr1 nderivn0 [X in `|X|]addrC addKr !mulr_sumr. have := le_trans (ler_norm_sum _ _ _); apply. rewrite ler_sum // => i _. rewrite exprSr mulrA !normrM mulrC ler_wpM2l ?normr_ge0 //. suff /ler_wpM2l /le_trans : `|(y - x) ^+ i| <= Num.max 1 (2%:R * r) ^+ (size p).-1. apply; rewrite ?normr_ge0 // mulrC ler_wpM2l ?poly_boundP //. by rewrite ?exprn_ge0 // le_max ler01 mulr_ge0 ?ler0n ?ltW. case: (leP _ 1)=> hr. rewrite expr1n normrX exprn_ile1 ?normr_ge0 //. rewrite (le_trans (ler_distD a _ _)) // addrC distrC. by rewrite (le_trans _ hr) // mulrDl lerD ?mul1r. apply: le_trans (_ : (2%:R * r) ^+ i <= _). rewrite normrX lerXn2r -?topredE /= ?normr_ge0 ?mulr_ge0 ?ler0n //. by rewrite ltW. rewrite (le_trans (ler_distD a _ _)) // addrC distrC. by rewrite mulrDl lerD ?mul1r. by rewrite ler_eXn2l // ltnW. Qed. Lemma poly_accr_bound_gt0 p a r : 0 < poly_accr_bound p a r. Proof. rewrite /poly_accr_bound pmulr_rgt0 //. rewrite ltr_wpDr ?ltr01 //. by rewrite sumr_ge0 // => i; rewrite poly_bound_ge0. by rewrite exprn_gt0 // lt_max ltr01 pmulr_rgt0 ?ltr0n. Qed. Lemma poly_accr_bound_ge0 p a r : 0 <= poly_accr_bound p a r. Proof. by rewrite ltW // poly_accr_bound_gt0. Qed. (* Todo : move to polyorder => need char 0 *) Lemma gdcop_eq0 (p q : {poly F}) : (gdcop p q == 0)%B = (q == 0)%B && (p != 0)%B. Proof. have [[->|q_neq0] [->|p_neq0] /=] := (altP (q =P 0), altP (p =P 0)). + by rewrite gdcop0 eqxx oner_eq0. + by rewrite gdcop0 (negPf p_neq0) eqxx. + apply/negP=> /eqP hg; have := coprimep_gdco 0 q_neq0. by rewrite hg coprimep0 eqp01. by apply/negP=> /eqP hg; have := dvdp_gdco p q; rewrite hg dvd0p; apply/negP. Qed. End polyorder_extra. Section polyXY_order_extra. Variable F : realFieldType. Local Open Scope ring_scope. Local Notation "p ^ f" := (map_poly f p) : ring_scope. Local Notation "'Y" := 'X%:P. Definition norm_poly2 (p : {poly {poly F}}) := p ^ (map_poly (fun x => `|x|)). Lemma coef_norm_poly2 p i j : (norm_poly2 p)`_i`_j = `|p`_i`_j|. Proof. rewrite !coef_map_id0 ?normr0 //; last first. by rewrite /map_poly poly_def size_poly0 big_ord0. Qed. Lemma size_norm_poly2 p : size (norm_poly2 p) = size p. Proof. rewrite /norm_poly2; have [->|p0] := eqVneq p 0. by rewrite /map_poly poly_def !(size_poly0, big_ord0). rewrite /map_poly size_poly_eq // -size_poly_eq0 size_poly_eq //. by rewrite -lead_coefE size_poly_eq0 lead_coef_eq0. by rewrite -!lead_coefE normr_eq0 !lead_coef_eq0. Qed. End polyXY_order_extra. Section polyorder_field_extra. Variable F : realFieldType. Local Open Scope ring_scope. Definition poly_accr_bound2 (p : {poly F}) (a r : F) : F := (Num.max 1 (2%:R * r)) ^+ (size p).-2 * (1 + \sum_(i < (size p).-2) poly_bound p^`N(i.+2) a r). Lemma poly_accr_bound2_gt0 p a r : 0 < poly_accr_bound2 p a r. Proof. rewrite /poly_accr_bound pmulr_rgt0 //. rewrite ltr_wpDr ?ltr01 //. by rewrite sumr_ge0 // => i; rewrite poly_bound_ge0. by rewrite exprn_gt0 // lt_max ltr01 pmulr_rgt0 ?ltr0n. Qed. Lemma poly_accr_bound2_ge0 p a r : 0 <= poly_accr_bound2 p a r. Proof. by rewrite ltW // poly_accr_bound2_gt0. Qed. Lemma poly_accr_bound2P p (a r x y : F) : (x != y)%B -> `|x - a| <= r -> `|y - a| <= r -> `|(p.[y] - p.[x]) / (y - x) - p^`().[x]| <= `|y - x| * poly_accr_bound2 p a r. Proof. have [|r_lt0] := lerP 0 r; last first. by move=> _ hr; have := le_lt_trans hr r_lt0; rewrite normr_lt0. rewrite le0r=> /orP[/eqP->|r_gt0]. rewrite !normr_le0 !subr_eq0. by move=> nxy /eqP xa /eqP xb; rewrite xa xb eqxx in nxy. move=> neq_xy hx hy. rewrite mulrA mulrDr mulr1 ler_wpDl ?mulr_ge0 ?normr_ge0 //=. by rewrite exprn_ge0 ?le_max ?mulr_ge0 ?ger0E ?ltW. rewrite -{1}(addNKr x y) [- _ + _]addrC /= -mulrA. rewrite nderiv_taylor; last exact: mulrC. have [->|p_neq0] := eqVneq p 0. by rewrite derivC !horner0 size_poly0 !(big_ord0, subrr, mul0r) normr0 !mulr0. rewrite -[size _]prednK ?lt0n ?size_poly_eq0 //. rewrite big_ord_recl expr0 mulr1 nderivn0 /= -size_deriv. have [->|p'_neq0] := eqVneq p^`() 0. by rewrite horner0 size_poly0 !big_ord0 addr0 !(subrr, mul0r) normr0 !mulr0. rewrite -[size _]prednK ?lt0n ?size_poly_eq0 // big_ord_recl expr1. rewrite addrAC subrr add0r mulrDl mulfK; last by rewrite subr_eq0 eq_sym. rewrite nderivn1 addrAC subrr add0r mulr_sumr normrM normfV. rewrite ler_pdivrMr ?normr_gt0; last by rewrite subr_eq0 eq_sym. rewrite mulrAC -expr2 mulrC mulr_suml. have := le_trans (ler_norm_sum _ _ _); apply. rewrite ler_sum // => i _ /=; rewrite /bump /= !add1n. rewrite normrM normrX 3!exprSr expr1 !mulrA !ler_wpM2r ?normr_ge0 //. suff /ler_wpM2l /le_trans : `|(y - x)| ^+ i <= Num.max 1 (2%:R * r) ^+ (size p^`()).-1. apply; rewrite ?normr_ge0 // mulrC ler_wpM2l ?poly_boundP //. by rewrite ?exprn_ge0 // le_max ler01 mulr_ge0 ?ler0n ?ltW. case: (leP _ 1)=> hr. rewrite expr1n exprn_ile1 ?normr_ge0 //. rewrite (le_trans (ler_distD a _ _)) // addrC distrC. by rewrite (le_trans _ hr) // mulrDl lerD ?mul1r. apply: le_trans (_ : (2%:R * r) ^+ i <= _). rewrite lerXn2r -?topredE /= ?normr_ge0 ?mulr_ge0 ?ler0n //. by rewrite ltW. rewrite (le_trans (ler_distD a _ _)) // addrC distrC. by rewrite mulrDl lerD ?mul1r. by rewrite ler_eXn2l // ltnW. Qed. End polyorder_field_extra. Section monotony. Variable F : realFieldType. Local Open Scope ring_scope. Definition accr_pos p (a r : F) := ({ k | 0 < k & forall x y, (x != y)%B -> `|x - a| <= r -> `|y - a| <= r -> (p.[x] - p.[y]) / (x - y) > k } * forall x, `|x - a| <= r -> p^`().[x] > 0)%type. Definition accr_neg p (a r : F) := ({ k | 0 < k & forall x y, (x != y)%B -> `|x - a| <= r -> `|y - a| <= r -> (p.[x] - p.[y]) / (x - y) < - k} * forall x, `|x - a| <= r -> p^`().[x] < 0)%type. Definition strong_mono p (a r : F) := (accr_pos p a r + accr_neg p a r)%type. Lemma accr_pos_incr p a r : accr_pos p a r -> forall x y, `|x - a| <= r -> `|y - a| <= r -> (p.[x] <= p.[y]) = (x <= y). Proof. move=> [[k k_gt0 hk] _] x y hx hy. have [->|neq_xy] := eqVneq x y; first by rewrite !lexx. have hkxy := hk _ _ neq_xy hx hy. have := lt_trans k_gt0 hkxy. have [lpxpy|lpypx|->] := ltrgtP p.[x] p.[y]. + by rewrite nmulr_rgt0 ?subr_lt0 // ?invr_lt0 subr_lt0=> /ltW->. + by rewrite pmulr_rgt0 ?subr_gt0 // ?invr_gt0 subr_gt0 leNgt=> ->. by rewrite subrr mul0r ltxx. Qed. Lemma accr_neg_decr p a r : accr_neg p a r -> forall x y, `|x - a| <= r -> `|y - a| <= r -> (p.[x] <= p.[y]) = (y <= x). Proof. move=> [] [k]; rewrite -oppr_lt0=> Nk_lt0 hk _ x y hx hy. have [->|neq_xy] := eqVneq x y; first by rewrite !lexx. have hkxy := hk _ _ neq_xy hx hy. have := lt_trans hkxy Nk_lt0. have [lpxpy|lpypx|->] := ltrgtP p.[x] p.[y]. + by rewrite nmulr_rlt0 ?subr_lt0 // ?invr_gt0 subr_gt0=> /ltW->. + by rewrite pmulr_rlt0 ?subr_gt0 // ?invr_lt0 subr_lt0 leNgt=> ->. by rewrite subrr mul0r ltxx. Qed. Lemma accr_negN p a r : accr_pos p a r -> accr_neg (- p) a r. Proof. case=> [[k k_gt0 hk] h]. split; [ exists k=> // x y nxy hx hy; by rewrite !hornerN -opprD mulNr ltrN2; apply: hk | by move=> x hx; rewrite derivN hornerN oppr_lt0; apply: h ]. Qed. Lemma accr_posN p a r : accr_neg p a r -> accr_pos (- p) a r. Proof. case=> [[k k_gt0 hk] h]. split; [ exists k=> // x y nxy hx hy; by rewrite !hornerN -opprD mulNr ltrNr; apply: hk | by move=> x hx; rewrite derivN hornerN oppr_gt0; apply: h ]. Qed. Lemma strong_monoN p a r : strong_mono p a r -> strong_mono (- p) a r. Proof. by case=> [] hp; [right; apply: accr_negN|left; apply: accr_posN]. Qed. Lemma strong_mono_bound p a r : strong_mono p a r -> {k | 0 < k & forall x y, `|x - a| <= r -> `|y - a| <= r -> `| x - y | <= k * `| p.[x] - p.[y] | }. Proof. case=> [] [[k k_gt0 hk] _]; exists k^-1; rewrite ?invr_gt0=> // x y hx hy; have [->|neq_xy] := eqVneq x y; do ?[by rewrite !subrr normr0 mulr0]; move: (hk _ _ neq_xy hx hy); rewrite 1?ltrNr ler_pdivlMl //; rewrite -ler_pdivlMr ?normr_gt0 ?subr_eq0 // => /ltW /le_trans-> //; by rewrite -normfV -normrM ler_normr lexx ?orbT. Qed. Definition merge_intervals (ar1 ar2 : F * F) := let l := Num.min (ar1.1 - ar1.2) (ar2.1 - ar2.2) in let u := Num.max (ar1.1 + ar1.2) (ar2.1 + ar2.2) in ((l + u) / 2%:R, (u - l) / 2%:R). Local Notation center ar1 ar2 := ((merge_intervals ar1 ar2).1). Local Notation radius ar1 ar2 := ((merge_intervals ar1 ar2).2). Lemma split_interval (a1 a2 r1 r2 x : F) : 0 < r1 -> 0 < r2 -> `|a1 - a2| <= r1 + r2 -> (`|x - center (a1, r1) (a2, r2)| <= radius (a1, r1) (a2, r2)) = (`|x - a1| <= r1) || (`|x - a2| <= r2). Proof. move=> r1_gt0 r2_gt0 le_ar. rewrite /merge_intervals /=. set l : F := Num.min _ _; set u : F := Num.max _ _. rewrite ler_pdivlMr ?gtr0E // -{2}[2%:R]ger0_norm ?ger0E //. rewrite -normrM mulrBl mulfVK ?pnatr_eq0 // ler_distl. rewrite opprB addrCA addrK (addrC (l + u)) addrA addrNK. rewrite -!mulr2n !mulr_natr !lerMn2r !orFb. rewrite ge_min le_max !ler_distl /=. set le := <=%R; rewrite {}/le. have [] := lerP=> /= a1N; have [] := lerP=> //= a1P; have [] := lerP=> //= a2P; rewrite ?(andbF, andbT) //; symmetry. rewrite ltW // (le_lt_trans _ a1P) //. rewrite (monoLR (addrK _) (lerD2r _)) -addrA. rewrite (monoRL (addNKr _) (lerD2l _)) [leLHS]addrC. by rewrite (le_trans _ le_ar) // ler_normr opprB lexx orbT. rewrite ltW // (lt_le_trans a1N) //. rewrite (monoLR (addrK _) (lerD2r _)) -addrA. rewrite (monoRL (addNKr _) (lerD2l _)) [leRHS]addrC [leLHS]addrC. by rewrite (le_trans _ le_ar) // ler_normr lexx. Qed. Lemma merge_mono p a1 a2 r1 r2 : 0 < r1 -> 0 < r2 -> `|a1 - a2| <= (r1 + r2) -> strong_mono p a1 r1 -> strong_mono p a2 r2 -> strong_mono p (center (a1, r1) (a2, r2)) (radius (a1, r1) (a2, r2)). Proof. move=> r1_gt0 r2_gt0 har sm1; wlog : p sm1 / accr_pos p a1 r1. move=> hwlog; case: (sm1); first exact: hwlog. move=> accr_p smp; rewrite -[p]opprK; apply: strong_monoN. apply: hwlog=> //; do ?exact: strong_monoN. exact: accr_posN. case=> [[k1 k1_gt0 hk1]] h1. move=> [] accr2_p; last first. set m := (r2 * a1 + r1 * a2) / (r1 + r2). have pm_gt0 := h1 m. case: accr2_p=> [_] /(_ m) pm_lt0. suff: 0 < 0 :> F by rewrite ltxx. have r_gt0 : 0 < r1 + r2 by rewrite ?addr_gt0. apply: (lt_trans (pm_gt0 _) (pm_lt0 _)). rewrite -(@ler_pM2l _ (r1 + r2)) //. rewrite -{1}[r1 + r2]ger0_norm ?(ltW r_gt0) //. rewrite -normrM mulrBr /m mulrC mulrVK ?unitfE ?gt_eqF //. rewrite mulrDl opprD addrA addrC addrA addKr. rewrite distrC -mulrBr normrM ger0_norm ?(ltW r1_gt0) //. by rewrite mulrC ler_wpM2r // ltW. rewrite -(@ler_pM2l _ (r1 + r2)) //. rewrite -{1}[r1 + r2]ger0_norm ?(ltW r_gt0) //. rewrite -normrM mulrBr /m mulrC mulrVK ?unitfE ?gt_eqF //. rewrite mulrDl opprD addrA addrK. rewrite -mulrBr normrM ger0_norm ?(ltW r2_gt0) //. by rewrite mulrC ler_wpM2r // ltW. case: accr2_p=> [[k2 k2_gt0 hk2]] h2. left; split; last by move=> x; rewrite split_interval // => /orP [/h1|/h2]. exists (Num.min k1 k2); first by rewrite lt_min k1_gt0. move=> x y neq_xy; rewrite !split_interval //. wlog lt_xy: x y neq_xy / y < x. move=> hwlog; have [] := ltrP y x; first exact: hwlog. rewrite le_eqVlt (negPf neq_xy) /= => /hwlog hwlog' hx hy. rewrite -mulrNN -!invrN !opprB. by apply: hwlog'; rewrite // eq_sym. move=> {h1} {h2} {sm1}. wlog le_xr1 : a1 a2 r1 r2 k1 k2 r1_gt0 r2_gt0 k1_gt0 k2_gt0 har hk1 hk2 / `|x - a1| <= r1. move=> hwlog h; move: (h)=> /orP [/hwlog|]; first exact. move=> /(hwlog a2 a1 r2 r1 k2 k1) hwlog' ley; rewrite minC. by apply: hwlog'; rewrite 1?orbC // distrC [r2 + _]addrC. move=> _. have [le_yr1|gt_yr1] := (lerP _ r1)=> /= [_|le_yr2]. by rewrite gt_min hk1. rewrite ltr_pdivlMr ?subr_gt0 //. pose z := a1 - r1. have hz1 : `|z - a1| <= r1 by rewrite addrC addKr normrN gtr0_norm. have gt_yr1' : y + r1 < a1. rewrite addrC; move: gt_yr1. rewrite (monoLR (addrNK _) (ltrD2r _)). rewrite /z ltr_normr opprB=> /orP[|-> //]. rewrite (monoRL (addrK a1) (ltrD2r _))=> /lt_trans /(_ lt_xy). by rewrite ltNge addrC; move: le_xr1; rewrite ler_distl=> /andP [_ ->]. have lt_yz : y < z by rewrite (monoRL (addrK _) (ltrD2r _)). have hz2 : `|z - a2| <= r2. move: (har); rewrite ler_norml=> /andP [la ua]. rewrite addrAC ler_distl ua andbT. rewrite -[a1](addrNK y) -[_ - _ + _ - _]addrA. rewrite lerD //. by rewrite (monoRL (addrK _) (lerD2r _)) addrC ltW. by move: le_yr2; rewrite ler_norml=> /andP[]. have [<-|neq_zx] := eqVneq z x. by rewrite -ltr_pdivlMr ?subr_gt0 // gt_min hk2 ?orbT // gt_eqF. have lt_zx : z < x. rewrite lt_neqAle neq_zx /=. move: le_xr1; rewrite distrC ler_norml=> /andP[_]. by rewrite !(monoLR (addrK _) (lerD2r _)) addrC. rewrite -{1}[x](addrNK z) -{1}[p.[x]](addrNK p.[z]). rewrite !addrA -![_ - _ + _ - _]addrA mulrDr ltrD //. rewrite -ltr_pdivlMr ?subr_gt0 //. by rewrite gt_min hk1 ?gt_eqF. rewrite -ltr_pdivlMr ?subr_gt0 //. by rewrite gt_min hk2 ?orbT ?gt_eqF. Qed. End monotony. Section CauchyReals. Local Open Scope creal_scope. Local Open Scope ring_scope. Definition asympt1 (R : numDomainType) (P : R -> nat -> Prop) := {m : R -> nat | forall eps i, 0 < eps -> (m eps <= i)%N -> P eps i}. Definition asympt2 (R : numDomainType) (P : R -> nat -> nat -> Prop) := {m : R -> nat | forall eps i j, 0 < eps -> (m eps <= i)%N -> (m eps <= j)%N -> P eps i j}. Notation "{ 'asympt' e : i / P }" := (asympt1 (fun e i => P)) (at level 0, e name, i name, format "{ 'asympt' e : i / P }") : type_scope. Notation "{ 'asympt' e : i j / P }" := (asympt2 (fun e i j => P)) (at level 0, e name, i name, j name, format "{ 'asympt' e : i j / P }") : type_scope. Lemma asympt1modP (R : numDomainType) P (a : asympt1 P) e i : 0 < e :> R -> (projT1 a e <= i)%N -> P e i. Proof. by case: a e i. Qed. Lemma asympt2modP (R : numDomainType) P (a : asympt2 P) e i j : 0 < e :> R -> (projT1 a e <= i)%N -> (projT1 a e <= j)%N -> P e i j. Proof. by case: a e i j. Qed. Variable F : realFieldType. (* Lemma asympt_mulLR (k : F) (hk : 0 < k) (P : F -> nat -> Prop) : *) (* {asympt e : i / P e i} -> {asympt e : i / P (e * k) i}. *) (* Proof. *) (* case=> m hm; exists (fun e => m (e * k))=> e i he hi. *) (* by apply: hm=> //; rewrite -ltr_pdivrMr // mul0r. *) (* Qed. *) (* Lemma asympt_mulRL (k : F) (hk : 0 < k) (P : F -> nat -> Prop) : *) (* {asympt e : i / P (e * k) i} -> {asympt e : i / P e i}. *) (* Proof. *) (* case=> m hm; exists (fun e => m (e / k))=> e i he hi. *) (* rewrite -[e](@mulfVK _ k) ?gtr_eqF //. *) (* by apply: hm=> //; rewrite -ltr_pdivrMr ?invr_gt0 // mul0r. *) (* Qed. *) Lemma asymptP (P1 : F -> nat -> Prop) (P2 : F -> nat -> Prop) : (forall e i, 0 < e -> P1 e i -> P2 e i) -> {asympt e : i / P1 e i} -> {asympt e : i / P2 e i}. Proof. by move=> hP; case=> m hm; exists m=> e i he me; apply: hP=> //; apply: hm. Qed. (* Lemma asympt2_mulLR (k : F) (hk : 0 < k) (P : F -> nat -> nat -> Prop) : *) (* {asympt e : i j / P e i j} -> {asympt e : i j / P (e * k) i j}. *) (* Proof. *) (* case=> m hm; exists (fun e => m (e * k))=> e i j he hi hj. *) (* by apply: hm=> //; rewrite -ltr_pdivrMr // mul0r. *) (* Qed. *) (* Lemma asympt2_mulRL (k : F) (hk : 0 < k) (P : F -> nat -> nat -> Prop) : *) (* {asympt e : i j / P (e * k) i j} -> {asympt e : i j / P e i j}. *) (* Proof. *) (* case=> m hm; exists (fun e => m (e / k))=> e i j he hi hj. *) (* rewrite -[e](@mulfVK _ k) ?gtr_eqF //. *) (* by apply: hm=> //; rewrite -ltr_pdivrMr ?invr_gt0 // mul0r. *) (* Qed. *) (* Lemma asympt2P (P1 : F -> nat -> nat -> Prop) (P2 : F -> nat -> nat -> Prop) : *) (* (forall e i j, 0 < e -> P1 e i j -> P2 e i j) -> *) (* {asympt e : i j / P1 e i j} -> {asympt e : i j / P2 e i j}. *) (* Proof. *) (* move=> hP; case=> m hm; exists m=> e i j he mei mej. *) (* by apply: hP=> //; apply: hm. *) (* Qed. *) Lemma splitf (n : nat) (e : F) : e = iterop n +%R (e / n%:R) e. Proof. case: n=> // n; set e' := (e / _). have -> : e = e' * n.+1%:R by rewrite mulfVK ?pnatr_eq0. move: e'=> {}e; rewrite iteropS. by elim: n=> /= [|n <-]; rewrite !mulr_natr ?mulr1n. Qed. Lemma splitD (x y e : F) : x < e / 2%:R -> y < e / 2%:R -> x + y < e. Proof. by move=> hx hy; rewrite [e](splitf 2) ltrD. Qed. Lemma divrn_gt0 (e : F) (n : nat) : 0 < e -> (0 < n)%N -> 0 < e / n%:R. Proof. by move=> e_gt0 n_gt0; rewrite pmulr_rgt0 ?gtr0E. Qed. Lemma split_norm_add (x y e : F) : `|x| < e / 2%:R -> `|y| < e / 2%:R -> `|x + y| < e. Proof. by move=> hx hy; rewrite (le_lt_trans (ler_normD _ _)) // splitD. Qed. Lemma split_norm_sub (x y e : F) : `|x| < e / 2%:R -> `|y| < e / 2%:R -> `|x - y| < e. Proof. by move=> hx hy; rewrite (le_lt_trans (ler_normB _ _)) // splitD. Qed. Lemma split_dist_add (z x y e : F) : `|x - z| < e / 2%:R -> `|z - y| < e / 2%:R -> `|x - y| < e. Proof. by move=> *; rewrite (le_lt_trans (ler_distD z _ _)) ?splitD // 1?distrC. Qed. Definition creal_axiom (x : nat -> F) := {asympt e : i j / `|x i - x j| < e}. Record creal := CReal {cauchyseq :> nat -> F; _ : creal_axiom cauchyseq}. Bind Scope creal_scope with creal. Lemma crealP (x : creal) : {asympt e : i j / `|x i - x j| < e}. Proof. by case: x. Qed. Definition cauchymod := nosimpl (fun (x : creal) => let: CReal _ m := x in projT1 m). Lemma cauchymodP (x : creal) eps i j : 0 < eps -> (cauchymod x eps <= i)%N -> (cauchymod x eps <= j)%N -> `|x i - x j| < eps. Proof. by case: x=> [x [m mP] //] /mP; apply. Qed. Definition neq_creal (x y : creal) : Prop := exists eps, (0 < eps) && (eps * 3%:R <= `|x (cauchymod x eps) - y (cauchymod y eps)|). Notation "!=%CR" := neq_creal : creal_scope. Notation "x != y" := (neq_creal x y) : creal_scope. Definition eq_creal x y := (~ (x != y)%CR). Notation "x == y" := (eq_creal x y) : creal_scope. Lemma ltr_distl_creal (e : F) (i : nat) (x : creal) (j : nat) (a b : F) : 0 < e -> (cauchymod x e <= i)%N -> (cauchymod x e <= j)%N -> `| x i - a | <= b - e -> `| x j - a | < b. Proof. move=> e_gt0 hi hj hb. rewrite (le_lt_trans (ler_distD (x i) _ _)) ?ltr_leD //. by rewrite -[b](addrNK e) addrC ler_ltD ?cauchymodP. Qed. Lemma ltr_distr_creal (e : F) (i : nat) (x : creal) (j : nat) (a b : F) : 0 < e -> (cauchymod x e <= i)%N -> (cauchymod x e <= j)%N -> a + e <= `| x i - b | -> a < `| x j - b |. Proof. move=> e_gt0 hi hj hb; apply: contraLR hb; rewrite -ltNge -leNgt. by move=> ha; rewrite (@ltr_distl_creal e j) // addrK. Qed. (* Lemma asympt_neq (x y : creal) : x != y -> *) (* {e | 0 < e & forall i, (cauchymod x e <= i)%N -> *) (* (cauchymod y e <= i)%N -> `|x i - y i| >= e}. *) (* Proof. *) (* case/sigW=> e /andP[e_gt0 hxy]. *) (* exists e=> // i hi hj; move: hxy; rewrite !lerNgt; apply: contra=> hxy. *) (* rewrite !mulrDr !mulr1 distrC (@ltr_distl_creal i) //. *) (* by rewrite distrC ltrW // (@ltr_distl_creal i) // ltrW. *) (* Qed. *) Definition lbound (x y : creal) (neq_xy : x != y) : F := projT1 (sigW neq_xy). Lemma lboundP (x y : creal) (neq_xy : x != y) i : (cauchymod x (lbound neq_xy) <= i)%N -> (cauchymod y (lbound neq_xy) <= i)%N -> lbound neq_xy <= `|x i - y i|. Proof. rewrite /lbound; case: (sigW _)=> /= d /andP[d_gt0 hd] hi hj. apply: contraLR hd; rewrite -!ltNge=> hd. rewrite (@ltr_distl_creal d i) // distrC ltW // (@ltr_distl_creal d i) //. by rewrite distrC ltW // !mulrDr mulr1 !addrA !addrK. Qed. Notation lbound_of p := (@lboundP _ _ p _ _ _). Lemma lbound_gt0 (x y : creal) (neq_xy : x != y) : lbound neq_xy > 0. Proof. by rewrite /lbound; case: (sigW _)=> /= d /andP[]. Qed. Definition lbound_ge0 x y neq_xy := (ltW (@lbound_gt0 x y neq_xy)). Lemma cst_crealP (x : F) : creal_axiom (fun _ => x). Proof. by exists (fun _ => 0%N)=> *; rewrite subrr normr0. Qed. Definition cst_creal (x : F) := CReal (cst_crealP x). Notation "x %:CR" := (cst_creal x) (at level 2, left associativity, format "x %:CR") : creal_scope. Notation "0" := (0 %:CR) : creal_scope. Lemma lbound0P (x : creal) (x_neq0 : x != 0) i : (cauchymod x (lbound x_neq0) <= i)%N -> (cauchymod 0%CR (lbound x_neq0) <= i)%N -> lbound x_neq0 <= `|x i|. Proof. by move=> cx c0; rewrite -[X in `|X|]subr0 -[0]/(0%CR i) lboundP. Qed. Notation lbound0_of p := (@lbound0P _ p _ _ _). Lemma neq_crealP e i j (e_gt0 : 0 < e) (x y : creal) : (cauchymod x (e / 5%:R) <= i)%N -> (cauchymod y (e / 5%:R) <= j)%N -> e <= `|x i - y j| -> x != y. Proof. move=> hi hj he; exists (e / 5%:R); rewrite pmulr_rgt0 ?gtr0E //=. rewrite distrC ltW // (@ltr_distr_creal (e / 5%:R) j) ?pmulr_rgt0 ?gtr0E //. rewrite distrC ltW // (@ltr_distr_creal (e / 5%:R) i) ?pmulr_rgt0 ?gtr0E //. by rewrite mulr_natr -!mulrSr -mulrnAr -mulr_natr mulVf ?pnatr_eq0 ?mulr1. Qed. Lemma eq_crealP (x y : creal) : {asympt e : i / `|x i - y i| < e} -> (x == y)%CR. Proof. case=> m hm neq_xy; pose d := lbound neq_xy. pose_big_enough i. have := (hm d i); rewrite lbound_gt0; big_enough => /(_ isT isT). by apply/negP; rewrite -leNgt lboundP. by close. Qed. Lemma eq0_crealP (x : creal) : {asympt e : i / `|x i| < e} -> x == 0. Proof. by move=> hx; apply: eq_crealP; apply: asymptP hx=> e i; rewrite subr0. Qed. Lemma asympt_eq (x y : creal) (eq_xy : x == y) : {asympt e : i / `|x i - y i| < e}. Proof. exists_big_modulus m F. move=> e i e0 hi; rewrite ltNge; apply/negP=> he; apply: eq_xy. by apply: (@neq_crealP e i i). by close. Qed. Lemma asympt_eq0 (x : creal) : x == 0 -> {asympt e : i / `|x i| < e}. Proof. by move/asympt_eq; apply: asymptP=> e i; rewrite subr0. Qed. Definition eq_mod (x y : creal) (eq_xy : x == y) := projT1 (asympt_eq eq_xy). Lemma eq_modP (x y : creal) (eq_xy : x == y) eps i : 0 < eps -> (eq_mod eq_xy eps <= i)%N -> `|x i - y i| < eps. Proof. by move=> eps_gt0; rewrite /eq_mod; case: (asympt_eq _)=> /= m hm /hm; apply. Qed. Lemma eq0_modP (x : creal) (x_eq0 : x == 0) eps i : 0 < eps -> (eq_mod x_eq0 eps <= i)%N -> `|x i| < eps. Proof. by move=> eps_gt0 hi; rewrite -[X in `|X|]subr0 -[0]/(0%CR i) eq_modP. Qed. Lemma eq_creal_refl x : x == x. Proof. apply: eq_crealP; exists (fun _ => 0%N). by move=> e i e_gt0 _; rewrite subrr normr0. Qed. Hint Resolve eq_creal_refl : core. Lemma neq_creal_sym x y : x != y -> y != x. Proof. move=> neq_xy; pose_big_enough i. apply: (@neq_crealP (lbound neq_xy) i i); by rewrite ?lbound_gt0 1?distrC ?(lbound_of neq_xy). by close. Qed. Lemma eq_creal_sym x y : x == y -> y == x. Proof. by move=> eq_xy /neq_creal_sym. Qed. Lemma eq_creal_trans x y z : x == y -> y == z -> x == z. Proof. move=> eq_xy eq_yz; apply: eq_crealP; exists_big_modulus m F. by move=> e i *; rewrite (@split_dist_add (y i)) ?eq_modP ?divrn_gt0. by close. Qed. Lemma creal_neq_always (x y : creal) i (neq_xy : x != y) : (cauchymod x (lbound neq_xy) <= i)%N -> (cauchymod y (lbound neq_xy) <= i)%N -> (x i != y i)%B. Proof. move=> hx hy; rewrite -subr_eq0 -normr_gt0. by rewrite (lt_le_trans _ (lbound_of neq_xy)) ?lbound_gt0. Qed. Definition creal_neq0_always (x : creal) := @creal_neq_always x 0. Definition lt_creal (x y : creal) : Prop := exists eps, (0 < eps) && (x (cauchymod x eps) + eps * 3%:R <= y (cauchymod y eps)). Notation "<%CR" := lt_creal : creal_scope. Notation "x < y" := (lt_creal x y) : creal_scope. Definition le_creal (x y : creal) : Prop := ~ (y < x)%CR. Notation "<=%CR" := le_creal : creal_scope. Notation "x <= y" := (le_creal x y) : creal_scope. Lemma ltr_creal (e : F) (i : nat) (x : creal) (j : nat) (a : F) : 0 < e -> (cauchymod x e <= i)%N -> (cauchymod x e <= j)%N -> x i <= a - e -> x j < a. Proof. move=> e_gt0 hi hj ha; have := cauchymodP e_gt0 hj hi. rewrite ltr_distl=> /andP[_ /lt_le_trans-> //]. by rewrite -(lerD2r (- e)) addrK. Qed. Lemma gtr_creal (e : F) (i : nat) (x : creal) (j : nat) (a : F) : 0 < e -> (cauchymod x e <= i)%N -> (cauchymod x e <= j)%N -> a + e <= x i-> a < x j. Proof. move=> e_gt0 hi hj ha; have := cauchymodP e_gt0 hj hi. rewrite ltr_distl=> /andP[/(le_lt_trans _)-> //]. by rewrite -(lerD2r e) addrNK. Qed. Definition diff (x y : creal) (lt_xy : (x < y)%CR) : F := projT1 (sigW lt_xy). Lemma diff_gt0 (x y : creal) (lt_xy : (x < y)%CR) : diff lt_xy > 0. Proof. by rewrite /diff; case: (sigW _)=> /= d /andP[]. Qed. Definition diff_ge0 x y lt_xy := (ltW (@diff_gt0 x y lt_xy)). Lemma diffP (x y : creal) (lt_xy : (x < y)%CR) i : (cauchymod x (diff lt_xy) <= i)%N -> (cauchymod y (diff lt_xy) <= i)%N -> x i + diff lt_xy <= y i. Proof. rewrite /diff; case: (sigW _)=> /= e /andP[e_gt0 he] hi hj. rewrite ltW // (@gtr_creal e (cauchymod y e)) // (le_trans _ he) //. rewrite !mulrDr mulr1 !addrA !lerD2r ltW //. by rewrite (@ltr_creal e (cauchymod x e)) // addrK. Qed. Notation diff_of p := (@diffP _ _ p _ _ _). Lemma diff0P (x : creal) (x_gt0 : (0 < x)%CR) i : (cauchymod x (diff x_gt0) <= i)%N -> (cauchymod 0%CR (diff x_gt0) <= i)%N -> diff x_gt0 <= x i. Proof. by move=> cx c0; rewrite -[diff _]add0r -[0]/(0%CR i) diffP. Qed. Notation diff0_of p := (@diff0P _ p _ _ _). Lemma lt_crealP e i j (e_gt0 : 0 < e) (x y : creal) : (cauchymod x (e / 5%:R) <= i)%N -> (cauchymod y (e / 5%:R) <= j)%N -> x i + e <= y j -> (x < y)%CR. Proof. move=> hi hj he; exists (e / 5%:R); rewrite pmulr_rgt0 ?gtr0E //=. rewrite ltW // (@gtr_creal (e / 5%:R) j) ?pmulr_rgt0 ?gtr0E //. rewrite (le_trans _ he) // -addrA (monoLR (addrNK _) (lerD2r _)). rewrite ltW // (@ltr_creal (e / 5%:R) i) ?pmulr_rgt0 ?gtr0E //. rewrite -!addrA lerDl !addrA -mulrA -{1}[e]mulr1 -!(mulrBr, mulrDr). rewrite pmulr_rge0 // {1}[1](splitf 5) /= !mul1r !mulrDr mulr1. by rewrite !opprD !addrA !addrK addrN. Qed. Lemma le_crealP i (x y : creal) : (forall j, (i <= j)%N -> x j <= y j) -> (x <= y)%CR. Proof. move=> hi lt_yx; pose_big_enough j. have := hi j; big_enough => /(_ isT); apply/negP; rewrite -ltNge. by rewrite (lt_le_trans _ (diff_of lt_yx)) ?ltr_pwDr ?diff_gt0. by close. Qed. Lemma le_creal_refl (x : creal) : (x <= x)%CR. Proof. by apply: (@le_crealP 0%N). Qed. Hint Resolve le_creal_refl : core. Lemma lt_neq_creal (x y : creal) : (x < y)%CR -> x != y. Proof. move=> ltxy; pose_big_enough i. apply: (@neq_crealP (diff ltxy) i i) => //; first by rewrite diff_gt0. by rewrite distrC leNgt ltr_distl negb_and -!leNgt diffP ?orbT. by close. Qed. Lemma creal_lt_always (x y : creal) i (lt_xy : (x < y)%CR) : (cauchymod x (diff lt_xy) <= i)%N -> (cauchymod y (diff lt_xy) <= i)%N -> x i < y i. Proof. by move=> hx hy; rewrite (lt_le_trans _ (diff_of lt_xy)) ?ltrDl ?diff_gt0. Qed. Definition creal_gt0_always := @creal_lt_always 0. Lemma eq_le_creal (x y : creal) : x == y -> (x <= y)%CR. Proof. by move=> /eq_creal_sym ? /lt_neq_creal. Qed. Lemma asympt_le (x y : creal) (le_xy : (x <= y)%CR) : {asympt e : i / x i < y i + e}. Proof. exists_big_modulus m F. move=> e i e0 hm; rewrite ltNge; apply/negP=> he; apply: le_xy. by apply: (@lt_crealP e i i). by close. Qed. Lemma asympt_ge0 (x : creal) : (0 <= x)%CR -> {asympt e : i / - e < x i}. Proof. by move/asympt_le; apply: asymptP=> *; rewrite -subr_gt0 opprK. Qed. Definition le_mod (x y : creal) (le_xy : (x <= y)%CR) := projT1 (asympt_le le_xy). Lemma le_modP (x y : creal) (le_xy : (x <= y)%CR) eps i : 0 < eps -> (le_mod le_xy eps <= i)%N -> x i < y i + eps. Proof. by move=> eps_gt0; rewrite /le_mod; case: (asympt_le _)=> /= m hm /hm; apply. Qed. Lemma ge0_modP (x : creal) (x_ge0 : (0 <= x)%CR) eps i : 0 < eps -> (le_mod x_ge0 eps <= i)%N -> - eps < x i. Proof. by move=> eps_gt0 hi; rewrite -(ltrD2r eps) addNr -[0]/(0%CR i) le_modP. Qed. Lemma opp_crealP (x : creal) : creal_axiom (fun i => - x i). Proof. by case: x=> [x [m mP]]; exists m=> *; rewrite /= -opprD normrN mP. Qed. Definition opp_creal (x : creal) := CReal (opp_crealP x). Notation "-%CR" := opp_creal : creal_scope. Notation "- x" := (opp_creal x) : creal_scope. Lemma add_crealP (x y : creal) : creal_axiom (fun i => x i + y i). Proof. exists_big_modulus m F. move=> e i j he hi hj; rewrite opprD addrAC addrA -addrA [- _ + _]addrC. by rewrite split_norm_add ?cauchymodP ?divrn_gt0. by close. Qed. Definition add_creal (x y : creal) := CReal (add_crealP x y). Notation "+%CR" := add_creal : creal_scope. Notation "x + y" := (add_creal x y) : creal_scope. Notation "x - y" := (x + - y)%CR : creal_scope. Lemma ubound_subproof (x : creal) : {b : F | b > 0 & forall i, `|x i| <= b}. Proof. pose_big_enough i; first set b := 1 + `|x i|. exists (foldl Num.max b [seq `|x n| | n <- iota 0 i]) => [|n]. have : 0 < b by rewrite ltr_pwDl. by elim: iota b => //= a l IHl b b_gt0; rewrite IHl ?lt_max ?b_gt0. have [|le_in] := (ltnP n i). elim: i b => [|i IHi] b //. rewrite ltnS -addn1 iotaD add0n map_cat foldl_cat /= le_max leq_eqVlt. by case/orP=> [/eqP->|/IHi->] //; rewrite lexx orbT. set xn := `|x n|; suff : xn <= b. by elim: iota xn b => //= a l IHl xn b Hxb; rewrite IHl ?le_max ?Hxb. rewrite -lerBlDr (le_trans (ler_norm _)) //. by rewrite (le_trans (ler_dist_dist _ _)) ?ltW ?cauchymodP. by close. Qed. Definition ubound (x : creal) := nosimpl (let: exist2 b _ _ := ubound_subproof x in b). Lemma uboundP (x : creal) i : `|x i| <= ubound x. Proof. by rewrite /ubound; case: ubound_subproof. Qed. Lemma ubound_gt0 x : 0 < ubound x. Proof. by rewrite /ubound; case: ubound_subproof. Qed. Definition ubound_ge0 x := (ltW (ubound_gt0 x)). Lemma mul_crealP (x y : creal) : creal_axiom (fun i => x i * y i). Proof. exists_big_modulus m F. move=> e i j e_gt0 hi hj. rewrite -[_ * _]subr0 -(subrr (x j * y i)) opprD opprK addrA. rewrite -mulrBl -addrA -mulrBr split_norm_add // !normrM. have /ler_wpM2l /le_lt_trans-> // := uboundP y i. rewrite -ltr_pdivlMr ?ubound_gt0 ?cauchymodP //. by rewrite !pmulr_rgt0 ?invr_gt0 ?ubound_gt0 ?ltr0n. rewrite mulrC; have /ler_wpM2l /le_lt_trans-> // := uboundP x j. rewrite -ltr_pdivlMr ?ubound_gt0 ?cauchymodP //. by rewrite !pmulr_rgt0 ?gtr0E ?ubound_gt0. by close. Qed. Definition mul_creal (x y : creal) := CReal (mul_crealP x y). Notation "*%CR" := mul_creal : creal_scope. Notation "x * y" := (mul_creal x y) : creal_scope. Lemma inv_crealP (x : creal) (x_neq0 : x != 0) : creal_axiom (fun i => (x i)^-1). Proof. pose d := lbound x_neq0. exists_big_modulus m F. (* exists (fun e => [CC x # e * d ^+ 2; ! x_neq0]). *) move=> e i j e_gt0 hi hj. have /andP[xi_neq0 xj_neq0] : (x i != 0) && (x j != 0). by rewrite -!normr_gt0 !(lt_le_trans _ (lbound0_of x_neq0)) ?lbound_gt0. rewrite -(@ltr_pM2r _ `|x i * x j|); last by rewrite normr_gt0 mulf_neq0. rewrite -normrM !mulrBl mulrA mulVf // mulrCA mulVf // mul1r mulr1. apply: lt_le_trans (_ : e * d ^+ 2 <= _). by apply: cauchymodP; rewrite // !pmulr_rgt0 ?lbound_gt0. rewrite ler_wpM2l ?(ltW e_gt0) // normrM. have /(_ j) hx /= := lbound0_of x_neq0. have -> // := (le_trans (ler_wpM2l _ (hx _ _))). by rewrite ltW // lbound_gt0. by rewrite ler_wpM2r ?normr_ge0 // lbound0P. by close. Qed. Definition inv_creal (x : creal) (x_neq0 : x != 0) := CReal (inv_crealP x_neq0). Notation "x_neq0 ^-1" := (inv_creal x_neq0) : creal_scope. Notation "x / y_neq0" := (x * (y_neq0 ^-1))%CR : creal_scope. Lemma norm_crealP (x : creal) : creal_axiom (fun i => `|x i|). Proof. exists (cauchymod x). by move=> *; rewrite (le_lt_trans (ler_dist_dist _ _)) ?cauchymodP. Qed. Definition norm_creal x := CReal (norm_crealP x). Local Notation "`| x |" := (norm_creal x) : creal_scope. Lemma horner_crealP (p : {poly F}) (x : creal) : creal_axiom (fun i => p.[x i]). Proof. exists_big_modulus m F=> [e i j e_gt0 hi hj|]. rewrite (le_lt_trans (@poly_accr_bound1P _ p (x (cauchymod x 1)) 1 _ _ _ _)); do ?[by rewrite ?e_gt0 | by rewrite ltW // cauchymodP]. rewrite -ltr_pdivlMr ?poly_accr_bound_gt0 ?cauchymodP //. by rewrite pmulr_rgt0 ?invr_gt0 ?poly_accr_bound_gt0. by close. Qed. Definition horner_creal (p : {poly F}) (x : creal) := CReal (horner_crealP p x). Notation "p .[ x ]" := (horner_creal p x) : creal_scope. Lemma neq_creal_horner p (x y : creal) : p.[x] != p.[y] -> x != y. Proof. move=> neq_px_py. pose d := lbound neq_px_py. pose_big_enough i. pose k := 2%:R + poly_accr_bound p (y i) d. have /andP[d_gt0 k_gt0] : (0 < d) && (0 < k). rewrite ?(ltr_pwDl, poly_accr_bound_ge0); by rewrite ?ltr0n ?ltW ?ltr01 ?lbound_gt0. pose_big_enough j. apply: (@neq_crealP (d / k) j j) => //. by rewrite ?(pmulr_lgt0, invr_gt0, ltr0n). rewrite ler_pdivrMr //. have /(_ j) // := (lbound_of neq_px_py). big_enough=> /(_ isT isT). apply: contraLR; rewrite -!ltNge=> hxy. rewrite (le_lt_trans (@poly_accr_bound1P _ _ (y i) d _ _ _ _)) //. + by rewrite ltW // cauchymodP. + rewrite ltW // (@split_dist_add (y j)) //; last first. by rewrite cauchymodP ?divrn_gt0. rewrite ltr_pdivlMr ?ltr0n // (le_lt_trans _ hxy) //. by rewrite ler_wpM2l ?normr_ge0 // ler_wpDr // poly_accr_bound_ge0. rewrite (le_lt_trans _ hxy) // ler_wpM2l ?normr_ge0 //. by rewrite ler_wpDl // ?ler0n. by close. by close. Qed. Lemma eq_creal_horner p (x y : creal) : x == y -> p.[x] == p.[y]. Proof. by move=> hxy /neq_creal_horner. Qed. Import Setoid Relation_Definitions. Add Relation creal eq_creal reflexivity proved by eq_creal_refl symmetry proved by eq_creal_sym transitivity proved by eq_creal_trans as eq_creal_rel. Global Existing Instance eq_creal_rel. Add Morphism add_creal with signature eq_creal ==> eq_creal ==> eq_creal as add_creal_morph. Proof. move=> x y eq_xy z t eq_zt; apply: eq_crealP. exists_big_modulus m F. move=> e i e_gt0 hi; rewrite opprD addrA [X in X + _]addrAC -addrA. by rewrite split_norm_add ?eq_modP ?divrn_gt0. by close. Qed. Global Existing Instance add_creal_morph_Proper. Add Morphism opp_creal with signature eq_creal ==> eq_creal as opp_creal_morph. Proof. move=> x y /asympt_eq [m hm]; apply: eq_crealP; exists m. by move=> e i e_gt0 hi /=; rewrite -opprD normrN hm. Qed. Global Existing Instance opp_creal_morph_Proper. Add Morphism mul_creal with signature eq_creal ==> eq_creal ==> eq_creal as mul_creal_morph. Proof. move=> x y eq_xy z t eq_zt; apply: eq_crealP. exists_big_modulus m F. move=> e i e_gt0 hi. rewrite (@split_dist_add (y i * z i)) // -(mulrBl, mulrBr) normrM. have /ler_wpM2l /le_lt_trans-> // := uboundP z i. rewrite -ltr_pdivlMr ?ubound_gt0 ?eq_modP //. by rewrite !pmulr_rgt0 ?invr_gt0 ?ubound_gt0 ?ltr0n. rewrite mulrC; have /ler_wpM2l /le_lt_trans-> // := uboundP y i. rewrite -ltr_pdivlMr ?ubound_gt0 ?eq_modP //. by rewrite !pmulr_rgt0 ?invr_gt0 ?ubound_gt0 ?ltr0n. by close. Qed. Global Existing Instance mul_creal_morph_Proper. Lemma eq_creal_inv (x y : creal) (x_neq0 : x != 0) (y_neq0 : y != 0) : (x == y) -> (x_neq0^-1 == y_neq0^-1). Proof. move=> eq_xy; apply: eq_crealP; exists_big_modulus m F. move=> e i e_gt0 hi /=. rewrite -(@ltr_pM2r _ (lbound x_neq0 * lbound y_neq0)); do ?by rewrite ?pmulr_rgt0 ?lbound_gt0. apply: le_lt_trans (_ : `|(x i)^-1 - (y i)^-1| * (`|x i| * `|y i|) < _). rewrite ler_wpM2l ?normr_ge0 //. apply: le_trans (_ : `|x i| * lbound y_neq0 <= _). by rewrite ler_wpM2r ?lbound_ge0 ?lbound0P. by rewrite ler_wpM2l ?normr_ge0 ?lbound0P. rewrite -!normrM mulrBl mulKf ?creal_neq0_always //. rewrite mulrCA mulVf ?mulr1 ?creal_neq0_always //. by rewrite distrC eq_modP ?pmulr_rgt0 ?lbound_gt0. by close. Qed. Add Morphism horner_creal with signature (@eq _) ==> eq_creal ==> eq_creal as horner_creal_morph. Proof. exact: eq_creal_horner. Qed. Global Existing Instance horner_creal_morph_Proper. Add Morphism lt_creal with signature eq_creal ==> eq_creal ==> iff as lt_creal_morph. Proof. move=> x y eq_xy z t eq_zt. wlog lxz : x y z t eq_xy eq_zt / (x < z)%CR. move=> hwlog; split=> h1; move: (h1) => /hwlog; apply=> //; by apply: eq_creal_sym. split=> // _. pose e' := diff lxz / 4%:R. have e'_gt0 : e' > 0 by rewrite pmulr_rgt0 ?gtr0E ?diff_gt0. have le_zt : (z <= t)%CR by apply: eq_le_creal. have le_xy : (y <= x)%CR by apply: eq_le_creal; apply: eq_creal_sym. pose_big_enough i. apply: (@lt_crealP e' i i)=> //. rewrite ltW // -(ltrD2r e'). rewrite (le_lt_trans _ (@le_modP _ _ le_zt _ _ _ _)) //. rewrite -addrA (monoLR (@addrNK _ _) (@lerD2r _ _)) ltW //. rewrite (lt_le_trans (@le_modP _ _ le_xy e' _ _ _)) //. rewrite -(monoLR (@addrNK _ _) (@lerD2r _ _)) ltW //. rewrite (lt_le_trans _ (diff_of lxz)) //. rewrite -addrA ler_ltD // /e' -!mulrDr gtr_pMr ?diff_gt0 //. by rewrite [X in _ < X](splitf 4) /= mul1r !ltrDr ?gtr0E. by close. Qed. Global Existing Instance lt_creal_morph_Proper. Add Morphism le_creal with signature eq_creal ==> eq_creal ==> iff as le_creal_morph. Proof. by move=> x y exy z t ezt; rewrite /le_creal exy ezt. Qed. Global Existing Instance le_creal_morph_Proper. Add Morphism norm_creal with signature eq_creal ==> eq_creal as norm_creal_morph. Proof. move=> x y hxy; apply: eq_crealP; exists_big_modulus m F. move=> e i e_gt0 hi. by rewrite (le_lt_trans (ler_dist_dist _ _)) ?eq_modP. by close. Qed. Global Existing Instance norm_creal_morph_Proper. Lemma neq_creal_ltVgt (x y : creal) : x != y -> {(x < y)%CR} + {(y < x)%CR}. Proof. move=> neq_xy; pose_big_enough i. have := (@lboundP _ _ neq_xy i); big_enough => /(_ isT isT). have [le_xy|/ltW le_yx'] := lerP (x i) (y i). rewrite -(lerD2r (x i)) ?addrNK addrC. move=> /lt_crealP; rewrite ?lbound_gt0; big_enough. by do 3!move/(_ isT); left. rewrite -(lerD2r (y i)) ?addrNK addrC. move=> /lt_crealP; rewrite ?lbound_gt0; big_enough. by do 3!move/(_ isT); right. by close. Qed. Lemma lt_creal_neq (x y : creal) : (x < y -> x != y)%CR. Proof. move=> lxy; pose_big_enough i. apply: (@neq_crealP (diff lxy) i i); rewrite ?diff_gt0 //. rewrite distrC ler_normr (monoRL (addrK _) (lerD2r _)) addrC. by rewrite (diff_of lxy). by close. Qed. Lemma gt_creal_neq (x y : creal) : (y < x -> x != y)%CR. Proof. by move/lt_creal_neq /neq_creal_sym. Qed. Lemma lt_creal_trans (x y z : creal) : (x < y -> y < z -> x < z)%CR. Proof. move=> lt_xy lt_yz; pose_big_enough i. apply: (@lt_crealP (diff lt_xy + diff lt_yz) i i) => //. by rewrite addr_gt0 ?diff_gt0. rewrite (le_trans _ (diff_of lt_yz)) //. by rewrite addrA lerD2r (diff_of lt_xy). by close. Qed. Lemma lt_crealW (x y : creal) : (x < y)%CR -> (x <= y)%CR. Proof. by move=> /lt_creal_trans /(_ _) /le_creal_refl. Qed. Add Morphism neq_creal with signature eq_creal ==> eq_creal ==> iff as neq_creal_morph. Proof. move=> x y eq_xy z t eq_zt; split=> /neq_creal_ltVgt []. + by rewrite eq_xy eq_zt=> /lt_creal_neq. + by rewrite eq_xy eq_zt=> /gt_creal_neq. + by rewrite -eq_xy -eq_zt=> /lt_creal_neq. by rewrite -eq_xy -eq_zt=> /gt_creal_neq. Qed. Global Existing Instance neq_creal_morph_Proper. Local Notation m0 := (fun (_ : F) => 0%N). Lemma add_0creal x : 0 + x == x. Proof. by apply: eq_crealP; exists m0=> * /=; rewrite add0r subrr normr0. Qed. Lemma add_creal0 x : x + 0 == x. Proof. by apply: eq_crealP; exists m0=> * /=; rewrite addr0 subrr normr0. Qed. Lemma mul_creal0 x : x * 0 == 0. Proof. by apply: eq_crealP; exists m0=> * /=; rewrite mulr0 subrr normr0. Qed. Lemma mul_0creal x : 0 * x == 0. Proof. by apply: eq_crealP; exists m0=> * /=; rewrite mul0r subrr normr0. Qed. Lemma mul_creal1 x : x * 1%:CR == x. Proof. by apply: eq_crealP; exists m0=> * /=; rewrite mulr1 subrr normr0. Qed. Lemma mul_1creal x : 1%:CR * x == x. Proof. by apply: eq_crealP; exists m0=> * /=; rewrite mul1r subrr normr0. Qed. Lemma opp_creal0 : - 0 == 0. Proof. by apply: eq_crealP; exists m0=> * /=; rewrite oppr0 addr0 normr0. Qed. Lemma horner_crealX (x : creal) : 'X.[x] == x. Proof. by apply: eq_crealP; exists m0=> *; rewrite /= hornerX subrr normr0. Qed. Lemma horner_crealM (p q : {poly F}) (x : creal) : ((p * q).[x] == p.[x] * q.[x])%CR. Proof. by apply: eq_crealP; exists m0=> * /=; rewrite hornerM subrr normr0. Qed. Lemma neq_creal_cst x y : reflect (cst_creal x != cst_creal y) (x != y). Proof. apply: (iffP idP)=> neq_xy; pose_big_enough i. + by apply (@neq_crealP `|x - y| i i); rewrite ?normr_gt0 ?subr_eq0 . + by close. + by rewrite (@creal_neq_always _ _ i neq_xy). + by close. Qed. Lemma eq_creal_cst x y : reflect (cst_creal x == cst_creal y) (x == y). Proof. apply: (iffP idP)=> [|eq_xy]; first by move/eqP->. by apply/negP=> /negP /neq_creal_cst; rewrite eq_xy; apply: eq_creal_refl. Qed. Lemma lt_creal_cst x y : reflect (cst_creal x < cst_creal y)%CR (x < y). Proof. apply: (iffP idP)=> lt_xy; pose_big_enough i. + apply: (@lt_crealP (y - x) i i); rewrite ?subr_gt0 //=. by rewrite addrCA subrr addr0. + by close. + by rewrite (@creal_lt_always _ _ i lt_xy). + by close. Qed. Lemma le_creal_cst x y : reflect (cst_creal x <= cst_creal y)%CR (x <= y). Proof. by rewrite leNgt; apply: (iffP negP)=> ? /lt_creal_cst. Qed. Lemma mul_creal_neq0 x y : x != 0 -> y != 0 -> x * y != 0. Proof. move=> x_neq0 y_neq0. pose d := lbound x_neq0 * lbound y_neq0. have d_gt0 : 0 < d by rewrite pmulr_rgt0 lbound_gt0. pose_big_enough i. apply: (@neq_crealP d i i)=> //; rewrite subr0 normrM. apply: le_trans (_ : `|x i| * lbound y_neq0 <= _). by rewrite ler_wpM2r ?lbound_ge0 // lbound0P. by rewrite ler_wpM2l ?normr_ge0 // lbound0P. by close. Qed. Lemma mul_neq0_creal x y : x * y != 0 -> y != 0. Proof. move=> xy_neq0; pose_big_enough i. apply: (@neq_crealP ((ubound x)^-1 * lbound xy_neq0) i i) => //. by rewrite pmulr_rgt0 ?invr_gt0 ?lbound_gt0 ?ubound_gt0. rewrite subr0 ler_pdivrMl ?ubound_gt0 //. have /(_ i)-> // := (le_trans (lbound0_of xy_neq0)). by rewrite normrM ler_wpM2r ?normr_ge0 ?uboundP. by close. Qed. Lemma poly_mul_creal_eq0_coprime p q x : coprimep p q -> p.[x] * q.[x] == 0 -> {p.[x] == 0} + {q.[x] == 0}. Proof. move=> /Bezout_eq1_coprimepP /sig_eqW [[u v] /= hpq]; pose_big_enough i. have := (erefl ((1 : {poly F}).[x i])). rewrite -{1}hpq /= hornerD hornerC. set upxi := (u * _).[_]. move=> hpqi. have [p_small|p_big] := lerP `|upxi| 2%:R^-1=> pqx0; [left|right]. move=> px0; apply: pqx0; apply: mul_creal_neq0=> //. apply: (@mul_neq0_creal v.[x]). apply: (@neq_crealP 2%:R^-1 i i); rewrite ?gtr0E //. rewrite /= subr0 -hornerM -(lerD2l `|upxi|). rewrite (le_trans _ (ler_normD _ _)) // hpqi normr1. rewrite (monoLR (addrNK _) (lerD2r _)). by rewrite {1}[1](splitf 2) /= mul1r addrK. move=> qx0; apply: pqx0; apply: mul_creal_neq0=> //. apply: (@mul_neq0_creal u.[x]). apply: (@neq_crealP 2%:R^-1 i i); rewrite ?gtr0E //. by rewrite /= subr0 -hornerM ltW. by close. Qed. Lemma dvdp_creal_eq0 p q x : p %| q -> p.[x] == 0 -> q.[x] == 0. Proof. by move=> dpq px0; rewrite -[q](divpK dpq) horner_crealM px0 mul_creal0. Qed. Lemma root_poly_expn_creal p k x : (0 < k)%N -> (p ^+ k).[x] == 0 -> p.[x] == 0. Proof. move=> k_gt0 pkx_eq0; apply: eq_crealP; exists_big_modulus m F. move=> e i e_gt0 hi; rewrite /= subr0. rewrite -(@ltr_pXn2r _ k) -?topredE /= ?normr_ge0 ?ltW //. by rewrite -normrX -horner_exp (@eq0_modP _ pkx_eq0) ?exprn_gt0 //. by close. Qed. Lemma horner_cst_creal c x : c%:P.[x] == c%:CR. Proof. apply: eq_crealP; exists (fun _ => 0%N)=> e i e_gt0 _. by rewrite /= hornerC subrr normr0. Qed. Lemma horner_creal_cst (p : {poly F}) (x : F) : p.[x%:CR] == p.[x]%:CR. Proof. by apply: eq_crealP; exists m0=> *; rewrite /= subrr normr0. Qed. Lemma poly_mul_creal_eq0 p q x : p.[x] * q.[x] == 0 -> {p.[x] == 0} + {q.[x] == 0}. Proof. move=> mul_px_qx_eq0. have [->|p_neq0] := altP (p =P 0); first by left; rewrite horner_cst_creal. have [->|q_neq0] := altP (q =P 0); first by right; rewrite horner_cst_creal. pose d := gcdp p q; pose p' := gdcop d p; pose q' := gdcop d q. have cop_q'_d': coprimep p' q'. rewrite /coprimep size_poly_eq1. apply: (@coprimepP _ p' d _). + by rewrite coprimep_gdco. + by rewrite dvdp_gcdl. rewrite dvdp_gcd (dvdp_trans (dvdp_gcdl _ _)) ?dvdp_gdco //. by rewrite (dvdp_trans (dvdp_gcdr _ _)) ?dvdp_gdco. suff : (p' * q').[x] * (d ^+ (size p + size q)).[x] == 0. case/poly_mul_creal_eq0_coprime. + by rewrite coprimep_expr // coprimepMl ?coprimep_gdco. + move=> p'q'x_eq0. have : p'.[x] * q'.[x] == 0 by rewrite -horner_crealM. case/poly_mul_creal_eq0_coprime=> // /dvdp_creal_eq0 hp'q'. by left; apply: hp'q'; rewrite dvdp_gdco. by right; apply: hp'q'; rewrite dvdp_gdco. move/root_poly_expn_creal. rewrite addn_gt0 lt0n size_poly_eq0 p_neq0=> /(_ isT) dx_eq0. by left; apply: dvdp_creal_eq0 dx_eq0; rewrite dvdp_gcdl. move: mul_px_qx_eq0; rewrite -!horner_crealM. rewrite exprD mulrAC mulrA -mulrA [_ ^+ _ * _]mulrC. apply: dvdp_creal_eq0; rewrite ?dvdp_mul // dvdp_gdcor //; by rewrite gcdp_eq0 negb_and p_neq0. Qed. Lemma coprimep_root (p q : {poly F}) x : coprimep p q -> p.[x] == 0 -> q.[x] != 0. Proof. move=> /Bezout_eq1_coprimepP /sig_eqW [[u v] hpq] px0. have upx_eq0 : u.[x] * p.[x] == 0 by rewrite px0 mul_creal0. pose_big_enough i. have := (erefl ((1 : {poly F}).[x i])). rewrite -{1}hpq /= hornerD hornerC. set upxi := (u * _).[_] => hpqi. apply: (@neq_crealP ((ubound v.[x])%CR^-1 / 2%:R) i i) => //. by rewrite pmulr_rgt0 ?gtr0E // ubound_gt0. rewrite /= subr0 ler_pdivrMl ?ubound_gt0 //. apply: le_trans (_ : `|(v * q).[x i]| <= _); last first. by rewrite hornerM normrM ler_wpM2r ?normr_ge0 ?(uboundP v.[x]). rewrite -(lerD2l `|upxi|) (le_trans _ (ler_normD _ _)) // hpqi normr1. rewrite (monoLR (addrNK _) (lerD2r _)). rewrite {1}[1](splitf 2) /= mul1r addrK ltW // /upxi hornerM. by rewrite (@eq0_modP _ upx_eq0) ?gtr0E. by close. Qed. Lemma deriv_neq0_mono (p : {poly F}) (x : creal) : p^`().[x] != 0 -> { r : F & 0 < r & { i : nat & (cauchymod x r <= i)%N & (strong_mono p (x i) r)} }. Proof. move=> px_neq0. wlog : p px_neq0 / (0 < p^`().[x])%CR. case/neq_creal_ltVgt: (px_neq0)=> px_lt0; last exact. case/(_ (- p)). + pose_big_enough i. apply: (@neq_crealP (lbound px_neq0) i i); do ?by rewrite ?lbound_gt0. rewrite /= derivN hornerN subr0 normrN. by rewrite (lbound0_of px_neq0). by close. + pose_big_enough i. apply: (@lt_crealP (diff px_lt0) i i); do ?by rewrite ?diff_gt0. rewrite /= add0r derivN hornerN -subr_le0 opprK addrC. by rewrite (diff_of px_lt0) //. by close. move=> r r_ge0 [i hi]; move/strong_monoN; rewrite opprK=> sm. by exists r=> //; exists i. move=> px_gt0. pose b1 := poly_accr_bound p^`() 0 (1 + ubound x). pose b2 := poly_accr_bound2 p 0 (1 + ubound x). pose r : F := Num.min 1 (Num.min (diff px_gt0 / 4%:R / b1) (diff px_gt0 / 4%:R / b2 / 2%:R)). exists r. rewrite !lt_min ?ltr01 ?pmulr_rgt0 ?gtr0E ?diff_gt0; by rewrite ?poly_accr_bound2_gt0 ?poly_accr_bound_gt0. pose_big_enough i. exists i => //; left; split; last first. move=> y hy; have := (@poly_accr_bound1P _ p^`() 0 (1 + ubound x) (x i) y). rewrite ?subr0 ler_wpDl ?ler01 ?uboundP //. rewrite (le_trans (_ : _ <= r + `|x i|)) ?subr0; last 2 first. + rewrite (monoRL (addrNK _) (lerD2r _)). by rewrite (le_trans (lerB_dist _ _)). + by rewrite lerD ?ge_min ?lexx ?uboundP. move=> /(_ isT isT). rewrite ler_distl=> /andP[le_py ge_py]. rewrite (lt_le_trans _ le_py) // subr_gt0 -/b1. rewrite (lt_le_trans _ (diff0_of px_gt0)) //. apply: le_lt_trans (_ : r * b1 < _). by rewrite ler_wpM2r ?poly_accr_bound_ge0. rewrite -ltr_pdivlMr ?poly_accr_bound_gt0 //. rewrite !gt_min ltr_pM2r ?invr_gt0 ?poly_accr_bound_gt0 //. by rewrite gtr_pMr ?diff_gt0 // invf_lt1 ?gtr0E ?ltr1n ?orbT. exists (diff px_gt0 / 4%:R). by rewrite pmulr_rgt0 ?gtr0E ?diff_gt0. move=> y z neq_yz hy hz. have := (@poly_accr_bound1P _ p^`() 0 (1 + ubound x) (x i) z). have := @poly_accr_bound2P _ p 0 (1 + ubound x) z y; rewrite eq_sym !subr0. rewrite neq_yz ?ler01 ?ubound_ge0=> // /(_ isT). rewrite (le_trans (_ : _ <= r + `|x i|)); last 2 first. + rewrite (monoRL (addrNK _) (lerD2r _)). by rewrite (le_trans (lerB_dist _ _)). + by rewrite lerD ?ge_min ?lexx ?uboundP. rewrite (le_trans (_ : _ <= r + `|x i|)); last 2 first. + rewrite (monoRL (addrNK _) (lerD2r _)). by rewrite (le_trans (lerB_dist _ _)). + by rewrite lerD ?ge_min ?lexx ?uboundP. rewrite ler_wpDl ?uboundP ?ler01 //. move=> /(_ isT isT); rewrite ler_distl=> /andP [haccr _]. move=> /(_ isT isT); rewrite ler_distl=> /andP [hp' _]. rewrite (lt_le_trans _ haccr) // (monoRL (addrK _) (ltrD2r _)). rewrite (lt_le_trans _ hp') // (monoRL (addrK _) (ltrD2r _)). rewrite (lt_le_trans _ (diff0_of px_gt0)) //. rewrite {2}[diff _](splitf 4) /= -!addrA ltrD2l ltr_pwDl //. by rewrite pmulr_rgt0 ?gtr0E ?diff_gt0. rewrite -/b1 -/b2 lerD //. + rewrite -ler_pdivlMr ?poly_accr_bound2_gt0 //. rewrite (le_trans (ler_distD (x i) _ _)) //. apply: le_trans (_ : r * 2%:R <= _). by rewrite mulrDr mulr1 lerD // distrC. by rewrite -ler_pdivlMr ?ltr0n // !ge_min lexx !orbT. + rewrite -ler_pdivlMr ?poly_accr_bound_gt0 //. by rewrite (le_trans hz) // !ge_min lexx !orbT. by close. Qed. Lemma smaller_factor (p q : {poly F}) x : p \is monic-> p.[x] == 0 -> ~~(p %| q) -> ~~ coprimep p q -> {r : {poly F} | (size r < size p)%N && (r \is monic) & r.[x] == 0}. Proof. move=> monic_p px0 ndvd_pq. rewrite /coprimep; set d := gcdp _ _=> sd_neq1. pose r1 : {poly F} := (lead_coef d)^-1 *: d. pose r2 := p %/ r1. have ld_neq0 : lead_coef d != 0 :> F. by rewrite lead_coef_eq0 gcdp_eq0 negb_and monic_neq0. have monic_r1 : r1 \is monic. by rewrite monicE /r1 -mul_polyC lead_coefM lead_coefC mulVf. have eq_p_r2r1: p = r2 * r1. by rewrite divpK // (@eqp_dvdl _ d) ?dvdp_gcdl // eqp_scale ?invr_eq0. have monic_r2 : r2 \is monic by rewrite -(monicMr _ monic_r1) -eq_p_r2r1. have eq_sr1_sd : size r1 = size d by rewrite size_scale ?invr_eq0. have sr1 : (1 < size r1)%N. by rewrite ltn_neqAle eq_sym lt0n size_poly_eq0 monic_neq0 ?andbT ?eq_sr1_sd. have sr2 : (1 < size r2)%N. rewrite size_divp ?size_dvdp ?monic_neq0 //. rewrite ltn_subRL addn1 prednK ?(leq_trans _ sr1) // eq_sr1_sd. rewrite ltn_neqAle dvdp_leq ?monic_neq0 ?andbT ?dvdp_size_eqp ?dvdp_gcdl //. by apply: contra ndvd_pq=> /eqp_dvdl <-; rewrite dvdp_gcdr. move: (px0); rewrite eq_p_r2r1=> r2r1x_eq0. have : (r2.[x] * r1.[x] == 0) by rewrite -horner_crealM. case/poly_mul_creal_eq0=> [r2x_eq0|r1x_eq0]. exists r2; rewrite ?monic_r2 ?andbT // mulrC. by rewrite -ltn_divpl ?divpp ?monic_neq0 // size_poly1. exists r1; rewrite ?monic_r1 ?andbT //. by rewrite -ltn_divpl ?divpp ?monic_neq0 // size_poly1. Qed. Lemma root_cst_creal (x : F) : ('X - x%:P).[cst_creal x] == 0. Proof. apply: eq_crealP; exists_big_modulus m F. by move=> e i e_gt0 hi; rewrite /= subr0 !hornerE subrr normr0. by close. Qed. Lemma has_root_creal_size_gt1 (x : creal) (p : {poly F}) : (p != 0)%B -> p.[x] == 0 -> (1 < size p)%N. Proof. move=> p_neq0 rootpa. rewrite ltnNge leq_eqVlt ltnS leqn0 size_poly_eq0 (negPf p_neq0) orbF. apply/negP=> /size_poly1P [c c_neq0 eq_pc]; apply: rootpa. by rewrite eq_pc horner_cst_creal; apply/neq_creal_cst. Qed. Definition bound_poly_bound (z : creal) (q : {poly {poly F}}) (a r : F) i := (1 + \sum_(j < sizeY q) `|(norm_poly2 q).[(ubound z)%:P]^`N(i.+1)`_j| * (`|a| + `|r|) ^+ j). Lemma bound_poly_boundP (z : creal) i (q : {poly {poly F}}) (a r : F) j : poly_bound q.[(z i)%:P]^`N(j.+1) a r <= bound_poly_bound z q a r j. Proof. rewrite /poly_bound. pose f (q : {poly F}) (k : nat) := `|q^`N(j.+1)`_k| * (`|a| + `|r|) ^+ k. rewrite lerD //=. rewrite (big_ord_widen (sizeY q) (f q.[(z i)%:P])); last first. rewrite size_nderivn leq_subLR (leq_trans (max_size_evalC _ _)) //. by rewrite leq_addl. rewrite big_mkcond /= ler_sum // /f => k _. case: ifP=> _; last by rewrite mulr_ge0 ?exprn_ge0 ?addr_ge0 ?normr_ge0. rewrite ler_wpM2r ?exprn_ge0 ?addr_ge0 ?normr_ge0 //. rewrite !horner_coef. rewrite !(@big_morph _ _ (fun p => p^`N(j.+1)) 0 +%R); do ?[by rewrite raddf0|by move=> x y /=; rewrite raddfD]. rewrite !coef_sum. rewrite (le_trans (ler_norm_sum _ _ _)) //. rewrite ger0_norm; last first. rewrite sumr_ge0=> //= l _. rewrite coef_nderivn mulrn_wge0 ?natr_ge0 //. rewrite -polyC_exp coefMC coef_norm_poly2 mulr_ge0 ?normr_ge0 //. by rewrite exprn_ge0 ?ltW ?ubound_gt0. rewrite size_norm_poly2 ler_sum //= => l _. rewrite !{1}coef_nderivn normrMn ler_pMn2r ?bin_gt0 ?leq_addr //. rewrite -!polyC_exp !coefMC coef_norm_poly2 normrM ler_wpM2l ?normr_ge0 //. rewrite normrX; case: (val l)=> // {}l. by rewrite ler_pXn2r -?topredE //= ?uboundP ?ltW ?ubound_gt0. Qed. Lemma bound_poly_bound_ge0 z q a r i : 0 <= bound_poly_bound z q a r i. Proof. by rewrite (le_trans _ (bound_poly_boundP _ 0%N _ _ _ _)) ?poly_bound_ge0. Qed. Definition bound_poly_accr_bound (z : creal) (q : {poly {poly F}}) (a r : F) := Num.max 1 (2%:R * r) ^+ (sizeY q).-1 * (1 + \sum_(i < (sizeY q).-1) bound_poly_bound z q a r i). Lemma bound_poly_accr_boundP (z : creal) i (q : {poly {poly F}}) (a r : F) : poly_accr_bound q.[(z i)%:P] a r <= bound_poly_accr_bound z q a r. Proof. rewrite /poly_accr_bound /bound_poly_accr_bound /=. set ui := _ ^+ _; set u := _ ^+ _; set vi := 1 + _. apply: le_trans (_ : u * vi <= _). rewrite ler_wpM2r //. by rewrite addr_ge0 ?ler01 // sumr_ge0 //= => j _; rewrite poly_bound_ge0. rewrite /ui /u; case: (ltP 1%R); last by rewrite !expr1n. move=> r2_gt1; rewrite ler_eXn2l //. rewrite -subn1 leq_subLR add1n (leq_trans _ (leqSpred _)) //. by rewrite max_size_evalC. rewrite ler_wpM2l ?exprn_ge0 ?le_max ?ler01 // lerD //. pose f j := poly_bound q.[(z i)%:P]^`N(j.+1) a r. rewrite (big_ord_widen (sizeY q).-1 f); last first. rewrite -subn1 leq_subLR add1n (leq_trans _ (leqSpred _)) //. by rewrite max_size_evalC. rewrite big_mkcond /= ler_sum // /f => k _. by case: ifP=> _; rewrite ?bound_poly_bound_ge0 ?bound_poly_boundP. Qed. Lemma bound_poly_accr_bound_gt0 (z : creal) (q : {poly {poly F}}) (a r : F) : 0 < bound_poly_accr_bound z q a r. Proof. rewrite (lt_le_trans _ (bound_poly_accr_boundP _ 0%N _ _ _)) //. by rewrite poly_accr_bound_gt0. Qed. Lemma horner2_crealP (p : {poly {poly F}}) (x y : creal) : creal_axiom (fun i => p.[x i, y i]). Proof. set a := x (cauchymod x 1). exists_big_modulus m F. move=> e i j e_gt0 hi hj; rewrite (@split_dist_add p.[x i, y j]) //. rewrite (le_lt_trans (@poly_accr_bound1P _ _ 0 (ubound y) _ _ _ _)) //; do ?by rewrite ?subr0 ?uboundP. apply: le_lt_trans (_ : `|y i - y j| * bound_poly_accr_bound x p 0 (ubound y) < _). by rewrite ler_wpM2l ?normr_ge0 // bound_poly_accr_boundP. rewrite -ltr_pdivlMr ?bound_poly_accr_bound_gt0 //. by rewrite cauchymodP // !pmulr_rgt0 ?gtr0E ?bound_poly_accr_bound_gt0. rewrite -[p]swapXYK ![(swapXY (swapXY _)).[_, _]]horner2_swapXY. rewrite (le_lt_trans (@poly_accr_bound1P _ _ 0 (ubound x) _ _ _ _)) //; do ?by rewrite ?subr0 ?uboundP. apply: le_lt_trans (_ : `|x i - x j| * bound_poly_accr_bound y (swapXY p) 0 (ubound x) < _). by rewrite ler_wpM2l ?normr_ge0 // bound_poly_accr_boundP. rewrite -ltr_pdivlMr ?bound_poly_accr_bound_gt0 //. by rewrite cauchymodP // !pmulr_rgt0 ?gtr0E ?bound_poly_accr_bound_gt0. by close. Qed. Definition horner2_creal (p : {poly {poly F}}) (x y : creal) := CReal (horner2_crealP p x y). Notation "p .[ x , y ]" := (horner2_creal p x y) (at level 2, left associativity) : creal_scope. Lemma root_monic_from_neq0 (p : {poly F}) (x : creal) : p.[x] == 0 -> ((lead_coef p) ^-1 *: p).[x] == 0. Proof. by rewrite -mul_polyC horner_crealM; move->; rewrite mul_creal0. Qed. Lemma root_sub_annihilant_creal (x y : creal) (p q : {poly F}) : (p != 0)%B -> (q != 0)%B -> p.[x] == 0 -> q.[y] == 0 -> (sub_annihilant p q).[x - y] == 0. Proof. move=> p_neq0 q_neq0 px_eq0 qy_eq0. have [||[u v] /= [hu hv] hpq] := @sub_annihilant_in_ideal _ p q. + by rewrite (@has_root_creal_size_gt1 x). + by rewrite (@has_root_creal_size_gt1 y). apply: eq_crealP; exists_big_modulus m F. move=> e i e_gt0 hi /=; rewrite subr0. rewrite (hpq (y i)) addrCA subrr addr0 split_norm_add // normrM. apply: le_lt_trans (_ : (ubound u.[y, x - y]) * `|p.[x i]| < _). by rewrite ler_wpM2r ?normr_ge0 // (uboundP u.[y, x - y] i). rewrite -ltr_pdivlMl ?ubound_gt0 //. by rewrite (@eq0_modP _ px_eq0) // !pmulr_rgt0 ?gtr0E ?ubound_gt0. apply: le_lt_trans (_ : (ubound v.[y, x - y]) * `|q.[y i]| < _). by rewrite ler_wpM2r ?normr_ge0 // (uboundP v.[y, x - y] i). rewrite -ltr_pdivlMl ?ubound_gt0 //. by rewrite (@eq0_modP _ qy_eq0) // !pmulr_rgt0 ?gtr0E ?ubound_gt0. by close. Qed. Lemma root_div_annihilant_creal (x y : creal) (p q : {poly F}) (y_neq0 : y != 0) : (p != 0)%B -> (q != 0)%B -> p.[x] == 0 -> q.[y] == 0 -> (div_annihilant p q).[(x / y_neq0)%CR] == 0. Proof. move=> p_neq0 q_neq0 px_eq0 qy_eq0. have [||[u v] /= [hu hv] hpq] := @div_annihilant_in_ideal _ p q. + by rewrite (@has_root_creal_size_gt1 x). + by rewrite (@has_root_creal_size_gt1 y). apply: eq_crealP; exists_big_modulus m F. move=> e i e_gt0 hi /=; rewrite subr0. rewrite (hpq (y i)) mulrCA divff ?mulr1; last first. by rewrite -normr_gt0 (lt_le_trans _ (lbound0_of y_neq0)) ?lbound_gt0. rewrite split_norm_add // normrM. apply: le_lt_trans (_ : (ubound u.[y, x / y_neq0]) * `|p.[x i]| < _). by rewrite ler_wpM2r ?normr_ge0 // (uboundP u.[y, x / y_neq0] i). rewrite -ltr_pdivlMl ?ubound_gt0 //. by rewrite (@eq0_modP _ px_eq0) // !pmulr_rgt0 ?gtr0E ?ubound_gt0. apply: le_lt_trans (_ : (ubound v.[y, x / y_neq0]) * `|q.[y i]| < _). by rewrite ler_wpM2r ?normr_ge0 // (uboundP v.[y, x / y_neq0] i). rewrite -ltr_pdivlMl ?ubound_gt0 //. by rewrite (@eq0_modP _ qy_eq0) // !pmulr_rgt0 ?gtr0E ?ubound_gt0. by close. Qed. Definition exp_creal x n := (iterop n *%CR x 1%:CR). Notation "x ^+ n" := (exp_creal x n) : creal_scope. Add Morphism exp_creal with signature eq_creal ==> (@eq _) ==> eq_creal as exp_creal_morph. Proof. move=> x y eq_xy [//|n]; rewrite /exp_creal !iteropS. by elim: n=> //= n ->; rewrite eq_xy. Qed. Global Existing Instance exp_creal_morph_Proper. Lemma horner_coef_creal p x : p.[x] == \big[+%CR/0%:CR]_(i < size p) ((p`_i)%:CR * (x ^+ i))%CR. Proof. apply: eq_crealP; exists m0=> e n e_gt0 hn /=; rewrite horner_coef. rewrite (@big_morph _ _ (fun u : creal => u n) 0%R +%R) //. rewrite -sumrB /= big1 ?normr0=> //= i _. apply/eqP; rewrite subr_eq0; apply/eqP; congr (_ * _). case: val=> {i} // i; rewrite exprS /exp_creal iteropS. by elim: i=> [|i ihi]; rewrite ?expr0 ?mulr1 //= exprS ihi. Qed. End CauchyReals. Notation "x == y" := (eq_creal x y) : creal_scope. Notation "!=%CR" := neq_creal : creal_scope. Notation "x != y" := (neq_creal x y) : creal_scope. Notation "x %:CR" := (cst_creal x) (at level 2, left associativity, format "x %:CR") : creal_scope. Notation "0" := (0 %:CR)%CR : creal_scope. Notation "<%CR" := lt_creal : creal_scope. Notation "x < y" := (lt_creal x y) : creal_scope. Notation "<=%CR" := le_creal : creal_scope. Notation "x <= y" := (le_creal x y) : creal_scope. Notation "-%CR" := opp_creal : creal_scope. Notation "- x" := (opp_creal x) : creal_scope. Notation "+%CR" := add_creal : creal_scope. Notation "x + y" := (add_creal x y) : creal_scope. Notation "x - y" := (x + - y)%CR : creal_scope. Notation "*%CR" := mul_creal : creal_scope. Notation "x * y" := (mul_creal x y) : creal_scope. Notation "x_neq0 ^-1" := (inv_creal x_neq0) : creal_scope. Notation "x / y_neq0" := (x * (y_neq0 ^-1))%CR : creal_scope. Notation "p .[ x ]" := (horner_creal p x) : creal_scope. Notation "p .[ x , y ]" := (horner2_creal p x y) (at level 2, left associativity) : creal_scope. Notation "x ^+ n" := (exp_creal x n) : creal_scope. Notation "`| x |" := (norm_creal x) : creal_scope. #[global] Hint Resolve eq_creal_refl le_creal_refl : core. Notation lbound_of p := (@lboundP _ _ _ p _ _ _). Notation lbound0_of p := (@lbound0P _ _ p _ _ _). Notation diff_of p := (@diffP _ _ _ p _ _ _). Notation diff0_of p := (@diff0P _ _ p _ _ _). Notation "{ 'asympt' e : i / P }" := (asympt1 (fun e i => P)) (at level 0, e name, i name, format "{ 'asympt' e : i / P }") : type_scope. Notation "{ 'asympt' e : i j / P }" := (asympt2 (fun e i j => P)) (at level 0, e name, i name, j name, format "{ 'asympt' e : i j / P }") : type_scope. real-closed-2.0.2/theories/complex.v000066400000000000000000001347661472566273500174270ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From HB Require Import structures. From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq div. From mathcomp Require Import choice fintype tuple bigop binomial order ssralg. From mathcomp Require Import zmodp poly ssrnum ssrint archimedean rat matrix. From mathcomp Require Import mxalgebra mxpoly closed_field polyrcf realalg. (**********************************************************************) (* This files defines the extension R[i] of a real field R, *) (* and provide it a structure of numeric field with a norm operator. *) (* When R is a real closed field, it also provides a structure of *) (* algebraically closed field for R[i], using a proof by Derksen *) (* (cf comments below, thanks to Pierre Lairez for finding the paper) *) (**********************************************************************) Import Order.TTheory GRing.Theory Num.Theory. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. #[local] Obligation Tactic := idtac. Local Open Scope ring_scope. Reserved Notation "x +i* y" (at level 40, left associativity, format "x +i* y"). Reserved Notation "x -i* y" (at level 40, left associativity, format "x -i* y"). Reserved Notation "R [i]" (at level 2, left associativity, format "R [i]"). Local Notation sgr := Num.sg. Local Notation sqrtr := Num.sqrt. Record complex (R : Type) : Type := Complex { Re : R; Im : R }. Declare Scope complex_scope. Delimit Scope complex_scope with C. Local Open Scope complex_scope. Definition real_complex_def (F : ringType) (phF : phant F) (x : F) := Complex x 0. Notation real_complex F := (@real_complex_def _ (Phant F)). Notation "x %:C" := (real_complex _ x) (at level 2, left associativity, format "x %:C") : complex_scope. Notation "x +i* y" := (Complex x y) : complex_scope. Notation "x -i* y" := (Complex x (- y)) : complex_scope. Notation "x *i " := (Complex 0 x) (at level 8, format "x *i") : complex_scope. Notation "''i'" := (Complex 0 1) : complex_scope. Notation "R [i]" := (complex R) (at level 2, left associativity, format "R [i]"). (* Module ComplexInternal. *) Module ComplexEqChoice. Section ComplexEqChoice. Variable R : Type. Definition sqR_of_complex (x : R[i]) := let: a +i* b := x in [:: a; b]. Definition complex_of_sqR (x : seq R) := if x is [:: a; b] then Some (a +i* b) else None. Lemma complex_of_sqRK : pcancel sqR_of_complex complex_of_sqR. Proof. by case. Qed. End ComplexEqChoice. End ComplexEqChoice. HB.instance Definition _ (R : eqType) := Equality.copy R[i] (pcan_type (@ComplexEqChoice.complex_of_sqRK R)). HB.instance Definition _ (R : choiceType) := Choice.copy R[i] (pcan_type (@ComplexEqChoice.complex_of_sqRK R)). HB.instance Definition _ (R : countType) := Countable.copy R[i] (pcan_type (@ComplexEqChoice.complex_of_sqRK R)). Lemma eq_complex : forall (R : eqType) (x y : complex R), (x == y) = (Re x == Re y) && (Im x == Im y). Proof. move=> R [a b] [c d] /=. apply/eqP/andP; first by move=> [-> ->]; split. by case; move/eqP->; move/eqP->. Qed. Lemma complexr0 (R : ringType) (x : R) : x +i* 0 = x%:C. Proof. by []. Qed. Module ComplexField. Section ComplexField_ringType. Variable R : ringType. Local Notation C := R[i]. Local Notation C0 := ((0 : R)%:C). Definition addc (x y : R[i]) := let: a +i* b := x in let: c +i* d := y in (a + c) +i* (b + d). Definition oppc (x : R[i]) := let: a +i* b := x in (- a) +i* (- b). Program Definition complex_zmodMixin := @GRing.isZmodule.Build R[i] C0 oppc addc _ _ _ _. Next Obligation. by move=> [a b] [c d] [e f] /=; rewrite !addrA. Qed. Next Obligation. by move=> [a b] [c d] /=; congr (_ +i* _); rewrite addrC. Qed. Next Obligation. by move=> [a b] /=; rewrite !add0r. Qed. Next Obligation. by move=> [a b] /=; rewrite !addNr. Qed. HB.instance Definition _ := complex_zmodMixin. Definition scalec (a : R) (x : R[i]) := let: b +i* c := x in (a * b) +i* (a * c). Program Definition complex_lmodMixin := @GRing.Zmodule_isLmodule.Build R R[i] scalec _ _ _ _. Next Obligation. by move=> a b [c d] /=; rewrite !mulrA. Qed. Next Obligation. by move=> [a b] /=; rewrite !mul1r. Qed. Next Obligation. by move=> a [b c] [d e] /=; rewrite !mulrDr. Qed. Next Obligation. by move=> [a b] c d /=; rewrite !mulrDl. Qed. #[local] HB.instance Definition _ := complex_lmodMixin. End ComplexField_ringType. Section ComplexField_comRingType. Variable R : comRingType. Local Notation C := R[i]. Definition mulc (x y : C) := let: a +i* b := x in let: c +i* d := y in ((a * c) - (b * d)) +i* ((a * d) + (b * c)). Lemma mulcC : commutative mulc. Proof. move=> [a b] [c d] /=. by rewrite [c * b + _]addrC ![_ * c]mulrC ![_ * d]mulrC. Qed. Lemma mulcA : associative mulc. Proof. move=> [a b] [c d] [e f] /=. rewrite !mulrDr !mulrDl !mulrN !mulNr !mulrA !opprD -!addrA. by congr ((_ + _) +i* (_ + _)); rewrite !addrA addrAC; congr (_ + _); rewrite addrC. Qed. End ComplexField_comRingType. Section ComplexField_fieldType. Variable R : fieldType. Local Notation C := R[i]. Local Notation C0 := ((0 : R)%:C). Local Notation C1 := ((1 : R)%:C). Definition invc (x : R[i]) := let: a +i* b := x in let n2 := (a ^+ 2 + b ^+ 2) in (a / n2) -i* (b / n2). Lemma mul1c : left_id C1 (@mulc R). Proof. by move=> [a b] /=; rewrite !mul1r !mul0r subr0 addr0. Qed. Lemma mulc_addl : left_distributive (@mulc R) (@addc R). Proof. move=> [a b] [c d] [e f] /=; rewrite !mulrDl !opprD -!addrA. by congr ((_ + _) +i* (_ + _)); rewrite addrCA. Qed. Lemma nonzero1c : C1 != C0. Proof. by rewrite eq_complex /= oner_eq0. Qed. HB.instance Definition _ := GRing.Zmodule_isComRing.Build R[i] (@mulcA R) (@mulcC R) mul1c mulc_addl nonzero1c. #[local] HB.instance Definition _ := complex_lmodMixin R. Program Definition complex_lalgMixin := @GRing.Lmodule_isLalgebra.Build R R[i] _. Next Obligation. by move=> a [ru iu] [rv iv]; apply/eqP; do 2?[apply/andP; split]; rewrite // mulrDr ?mulrN !mulrA. Qed. #[local] HB.instance Definition _ := complex_lalgMixin. End ComplexField_fieldType. Local Ltac simpc := do ? [ rewrite -[(_ +i* _) - (_ +i* _)]/(_ +i* _) | rewrite -[(_ +i* _) + (_ +i* _)]/(_ +i* _) | rewrite -[(_ +i* _) * (_ +i* _)]/(_ +i* _)]. Section ComplexField_realFieldType. Variable R : realFieldType. Local Notation C := R[i]. Local Notation C0 := ((0 : R)%:C). Local Notation C1 := ((1 : R)%:C). Lemma mulVc : forall x, x != C0 -> mulc (invc x) x = C1. Proof. move=> [a b]; rewrite eq_complex => /= hab; rewrite !mulNr opprK. rewrite ![_ / _ * _]mulrAC [b * a]mulrC subrr complexr0 -mulrDl mulfV //. by rewrite paddr_eq0 -!expr2 ?expf_eq0 ?sqr_ge0. Qed. Lemma invc0 : invc C0 = C0. Proof. by rewrite /= !mul0r oppr0. Qed. HB.instance Definition _ := GRing.ComRing_isField.Build C mulVc invc0. Lemma real_complex_is_additive : additive (real_complex R). Proof. by move=> a b /=; simpc; rewrite subrr. Qed. Lemma real_complex_is_multiplicative : multiplicative (real_complex R). Proof. by split=> // a b /=; simpc; rewrite !mulr0 !mul0r addr0 subr0. Qed. HB.instance Definition _ := GRing.isAdditive.Build R R[i] (real_complex R) real_complex_is_additive. HB.instance Definition _ := GRing.isMultiplicative.Build R R[i] (real_complex R) real_complex_is_multiplicative. End ComplexField_realFieldType. Module Normc. Section Normc. Variable R : rcfType. Implicit Types x : R[i]. (* TODO: when Pythagorean Fields are added, weaken to Pythagorean Field *) Definition normc x := let: a +i* b := x in sqrtr (a ^+ 2 + b ^+ 2). Lemma normc0 : normc 0%C = 0 :> R. Proof. by rewrite /normc /= expr0n/= addr0 sqrtr0. Qed. Lemma normc1 : normc 1%C = 1 :> R. Proof. by rewrite /normc /= expr0n/= expr1n addr0 sqrtr1. Qed. Lemma eq0_normc x : normc x = 0 -> x = 0. Proof. case: x => a b /= /eqP; rewrite sqrtr_eq0 le_eqVlt => /orP[|]; last first. by rewrite ltNge addr_ge0 ?sqr_ge0. by rewrite paddr_eq0 ?sqr_ge0 ?expf_eq0 //= => /andP[/eqP -> /eqP ->]. Qed. Lemma normcM x y : normc (x * y) = normc x * normc y. Proof. move: x y => [a b] [c d] /=; rewrite -sqrtrM ?addr_ge0 ?sqr_ge0 //. rewrite sqrrB sqrrD mulrDl !mulrDr -!exprMn. rewrite mulrAC [b * d]mulrC !mulrA. suff -> : forall (u v w z t : R), (u - v + w) + (z + v + t) = u + w + (z + t). by rewrite addrAC !addrA. by move=> u v w z t; rewrite [_ - _ + _]addrAC [z + v]addrC !addrA addrNK. Qed. Lemma normcV x : normc x^-1 = (normc x)^-1. Proof. have [->|x0] := eqVneq x 0; first by rewrite ?(invr0,normc0). have nx0 : normc x != 0 by apply: contra x0 => /eqP/eq0_normc ->. by apply: (mulfI nx0); rewrite -normcM !divrr ?unitfE// normc1. Qed. End Normc. End Normc. Section ComplexField. Variable R : rcfType. Implicit Types x y : R[i]. Local Notation C := R[i]. Local Notation C0 := ((0 : R)%:C). Local Notation C1 := ((1 : R)%:C). #[local] HB.instance Definition _ := complex_lmodMixin R. Lemma Re_is_scalar : scalar (@Re R). Proof. by move=> a [b c] [d e]. Qed. HB.instance Definition _ := GRing.isLinear.Build R [the lmodType R of R[i]] R _ (@Re R) Re_is_scalar. Lemma Im_is_scalar : scalar (@Im R). Proof. by move=> a [b c] [d e]. Qed. HB.instance Definition _ := GRing.isLinear.Build R [the lmodType R of R[i]] R _ (@Im R) Im_is_scalar. Definition lec x y := let: a +i* b := x in let: c +i* d := y in (d == b) && (a <= c). Definition ltc x y := let: a +i* b := x in let: c +i* d := y in (d == b) && (a < c). Lemma ltc0_add x y : ltc 0 x -> ltc 0 y -> ltc 0 (x + y). Proof. move: x y => [a b] [c d] /= /andP [/eqP-> ha] /andP [/eqP-> hc]. by rewrite addr0 eqxx addr_gt0. Qed. Lemma ge0_lec_total x y : lec 0 x -> lec 0 y -> lec x y || lec y x. Proof. move: x y => [a b] [c d] /= /andP[/eqP -> a_ge0] /andP[/eqP -> c_ge0]. by rewrite eqxx le_total. Qed. Lemma subc_ge0 x y : lec 0 (y - x) = lec x y. Proof. by move: x y => [a b] [c d] /=; simpc; rewrite subr_ge0 subr_eq0. Qed. Lemma ltc_def x y : ltc x y = (y != x) && lec x y. Proof. move: x y => [a b] [c d] /=; simpc; rewrite eq_complex /=. by have [] := altP eqP; rewrite ?(andbF, andbT) //= lt_def. Qed. Import Normc. Notation normC x := (normc x)%:C. Lemma eq0_normC x : normC x = 0 -> x = 0. Proof. by case=> /eq0_normc. Qed. Lemma normCM x y : normC (x * y) = normC x * normC y. Proof. by rewrite -rmorphM normcM. Qed. Lemma lec_def x y : lec x y = (normC (y - x) == y - x). Proof. rewrite -subc_ge0; move: (_ - _) => [a b]; rewrite eq_complex /= eq_sym. have [<- /=|_] := altP eqP; last by rewrite andbF. by rewrite [0 ^+ _]mul0r addr0 andbT sqrtr_sqr ger0_def. Qed. Lemma lec_normD x y : lec (normC (x + y)) (normC x + normC y). Proof. move: x y => [a b] [c d] /=; simpc; rewrite addr0 eqxx /=. rewrite -(@ler_pXn2r _ 2) -?topredE /= ?(ler_wpDr, sqrtr_ge0) //. rewrite [X in _ <= X] sqrrD ?sqr_sqrtr; do ?by rewrite ?(ler_wpDr, sqrtr_ge0, sqr_ge0, mulr_ge0) //. rewrite -addrA addrCA (monoRL (addrNK _) (lerD2r _)) !sqrrD. set u := _ *+ 2; set v := _ *+ 2. rewrite [a ^+ _ + _ + _]addrAC [b ^+ _ + _ + _]addrAC -[X in X - _]addrA. rewrite [u + _]addrC [X in _ - X]addrAC [b ^+ _ + _]addrC. rewrite [u]lock [v]lock !addrA; set x := (a ^+ 2 + _ + _ + _). rewrite -addrA [leLHS]addrC addKr -!lock addrC. have [huv|] := ger0P (u + v); last first. by move=> /ltW /le_trans -> //; rewrite pmulrn_lge0 // mulr_ge0 ?sqrtr_ge0. rewrite -(@ler_pXn2r _ 2) -?topredE //=; last first. by rewrite ?(pmulrn_lge0, mulr_ge0, sqrtr_ge0) //. rewrite -mulr_natl !exprMn !sqr_sqrtr ?(ler_wpDr, sqr_ge0) //. rewrite -mulrnDl -[in leLHS]mulr_natl !exprMn ler_pM2l ?exprn_gt0 ?ltr0n //. rewrite sqrrD mulrDl !mulrDr -!exprMn addrAC -!addrA lerD2l !addrA. rewrite [_ + (b * d) ^+ 2]addrC -addrA lerD2l. have: 0 <= (a * d - b * c) ^+ 2 by rewrite sqr_ge0. by rewrite sqrrB addrAC subr_ge0 [_ * c]mulrC mulrACA [d * _]mulrC. Qed. HB.instance Definition _ := Num.IntegralDomain_isNumRing.Build C lec_normD ltc0_add eq0_normC ge0_lec_total normCM lec_def ltc_def. End ComplexField. End ComplexField. HB.export ComplexField. (* we do not export the canonical structure of lmodType on purpose *) (* i.e. no: Canonical ComplexField.complex_lmodType. *) (* indeed, this would prevent C fril having a normed module over C *) Definition conjc {R : ringType} (x : R[i]) := let: a +i* b := x in a -i* b. Notation "x ^*" := (conjc x) (at level 2, format "x ^*") : complex_scope. Local Open Scope complex_scope. Delimit Scope complex_scope with C. Ltac simpc := do ? [ rewrite -[- (_ +i* _)%C]/(_ +i* _)%C | rewrite -[(_ +i* _)%C - (_ +i* _)%C]/(_ +i* _)%C | rewrite -[(_ +i* _)%C + (_ +i* _)%C]/(_ +i* _)%C | rewrite -[(_ +i* _)%C * (_ +i* _)%C]/(_ +i* _)%C | rewrite -[(_ +i* _)%C ^*]/(_ +i* _)%C | rewrite -[_ *: (_ +i* _)%C]/(_ +i* _)%C | rewrite -[(_ +i* _)%C <= (_ +i* _)%C]/((_ == _) && (_ <= _)) | rewrite -[(_ +i* _)%C < (_ +i* _)%C]/((_ == _) && (_ < _)) | rewrite -[`|(_ +i* _)%C|]/(sqrtr (_ + _))%:C%C | rewrite (mulrNN, mulrN, mulNr, opprB, opprD, mulr0, mul0r, subr0, sub0r, addr0, add0r, mulr1, mul1r, subrr, opprK, oppr0, eqxx) ]. Section ComplexTheory. Variable R : rcfType. Implicit Types (k : R) (x y z : R[i]). Lemma ReiNIm : forall x, Re (x * 'i%C) = - Im x. Proof. by case=> a b; simpc. Qed. Lemma ImiRe : forall x, Im (x * 'i%C) = Re x. Proof. by case=> a b; simpc. Qed. Lemma complexE x : x = (Re x)%:C + 'i%C * (Im x)%:C :> R[i]. Proof. by case: x => *; simpc. Qed. Local Lemma real_complexE_deprecated k : k%:C = k +i* 0 :> R[i]. Proof. done. Qed. #[deprecated(since="1.1.3", note="Use complexr0 instead.")] Notation real_complexE := real_complexE_deprecated. Lemma sqr_i : 'i%C ^+ 2 = -1 :> R[i]. Proof. by rewrite exprS; simpc; rewrite complexr0 rmorphN. Qed. Lemma complexI : injective (real_complex R). Proof. by move=> x y []. Qed. Lemma ler0c k : (0 <= k%:C) = (0 <= k). Proof. by simpc. Qed. Lemma lecE : forall x y, (x <= y) = (Im y == Im x) && (Re x <= Re y). Proof. by move=> [a b] [c d]. Qed. Lemma ltcE : forall x y, (x < y) = (Im y == Im x) && (Re x < Re y). Proof. by move=> [a b] [c d]. Qed. Lemma lecR : forall k k', (k%:C <= k'%:C) = (k <= k'). Proof. by move=> k k'; simpc. Qed. Lemma ltcR : forall k k', (k%:C < k'%:C) = (k < k'). Proof. by move=> k k'; simpc. Qed. Lemma conjc_is_additive : additive (@conjc R). Proof. by move=> [a b] [c d] /=; simpc; rewrite [d - _]addrC. Qed. Lemma conjc_is_multiplicative : multiplicative (@conjc R). Proof. by split=> [[a b] [c d]|] /=; simpc. Qed. HB.instance Definition _ := GRing.isAdditive.Build R[i] R[i] conjc conjc_is_additive. HB.instance Definition _ := GRing.isMultiplicative.Build R[i] R[i] conjc conjc_is_multiplicative. Lemma conjcK : involutive (@conjc R). Proof. by move=> [a b] /=; rewrite opprK. Qed. Lemma mulcJ_ge0 (x : R[i]) : 0 <= x * x^*%C. Proof. by move: x=> [a b]; simpc; rewrite mulrC addNr eqxx addr_ge0 ?sqr_ge0. Qed. Lemma conjc_real (x : R) : x%:C^* = x%:C. Proof. by rewrite /= oppr0. Qed. Lemma ReJ_add (x : R[i]) : (Re x)%:C = (x + x^*%C) / 2%:R. Proof. case: x => a b; simpc; rewrite [0 ^+ 2]mul0r addr0 /=. rewrite -!mulr2n -mulr_natr -mulrA [_ * (_ / _)]mulrA. by rewrite divff ?mulr1 // -natrM pnatr_eq0. Qed. Lemma ImJ_sub (x : R[i]) : (Im x)%:C = (x^*%C - x) / 2%:R * 'i%C. Proof. case: x => a b; simpc; rewrite [0 ^+ 2]mul0r addr0 /=. rewrite -!mulr2n -mulr_natr -mulrA [_ * (_ / _)]mulrA. by rewrite divff ?mulr1 ?opprK // -natrM pnatr_eq0. Qed. Lemma ger0_Im (x : R[i]) : 0 <= x -> Im x = 0. Proof. by move: x=> [a b] /=; simpc => /andP [/eqP]. Qed. (* Todo : extend theory of : *) (* - signed exponents *) Lemma conj_ge0 : forall x, (0 <= x ^*) = (0 <= x). Proof. by move=> [a b] /=; simpc; rewrite oppr_eq0. Qed. Lemma conjc_nat : forall n, (n%:R : R[i])^* = n%:R. Proof. exact: rmorph_nat. Qed. Lemma conjc0 : (0 : R[i]) ^* = 0. Proof. exact: (conjc_nat 0). Qed. Lemma conjc1 : (1 : R[i]) ^* = 1. Proof. exact: (conjc_nat 1). Qed. Lemma conjc_eq0 : forall x, (x ^* == 0) = (x == 0). Proof. by move=> [a b]; rewrite !eq_complex /= eqr_oppLR oppr0. Qed. Lemma conjc_inv: forall x, (x^-1)^* = (x^*%C )^-1. Proof. exact: fmorphV. Qed. Lemma complex_root_conj (p : {poly R[i]}) (x : R[i]) : root (map_poly conjc p) x = root p x^*. Proof. by rewrite /root -{1}[x]conjcK horner_map /= conjc_eq0. Qed. Lemma complex_algebraic_trans (T : comRingType) (toR : {rmorphism T -> R}) : integralRange toR -> integralRange (real_complex R \o toR). Proof. set f := _ \o _ => R_integral [a b]. have integral_real k : integralOver f (k%:C) by apply: integral_rmorph. rewrite [_ +i* _]complexE. apply: integral_add => //; apply: integral_mul => //=. exists ('X^2 + 1). by rewrite monicE lead_coefDl ?size_polyXn ?size_poly1 ?lead_coefXn. by rewrite rmorphD rmorph1 /= ?map_polyXn rootE !hornerE -?expr2 sqr_i addNr. (* FIXME: remove the -?expr2 when requiring MC >= 1.16.0 *) Qed. Lemma normc_def (z : R[i]) : `|z| = (sqrtr ((Re z)^+2 + (Im z)^+2))%:C. Proof. by case: z. Qed. Lemma add_Re2_Im2 (z : R[i]) : ((Re z)^+2 + (Im z)^+2)%:C = `|z|^+2. Proof. by rewrite normc_def -rmorphXn sqr_sqrtr ?addr_ge0 ?sqr_ge0. Qed. Lemma addcJ (z : R[i]) : z + z^*%C = 2%:R * (Re z)%:C. Proof. by rewrite ReJ_add mulrC mulfVK ?pnatr_eq0. Qed. Lemma subcJ (z : R[i]) : z - z^*%C = 2%:R * (Im z)%:C * 'i%C. Proof. rewrite ImJ_sub mulrCA mulrA mulfVK ?pnatr_eq0 //. by rewrite -mulrA ['i%C * _]sqr_i mulrN1 opprB. Qed. Lemma complex_real (a b : R) : a +i* b \is Num.real = (b == 0). Proof. rewrite realE; simpc; rewrite [0 == _]eq_sym. by have [] := ltrgtP 0 a; rewrite ?(andbF, andbT, orbF, orbb). Qed. Lemma complex_realP x : reflect (exists k, x = k%:C) (x \is Num.real). Proof. case: x=> [a b] /=; rewrite complex_real. by apply: (iffP eqP) => [->|[c []//]]; exists a. Qed. Lemma RRe_real x : x \is Num.real -> (Re x)%:C = x. Proof. by move=> /complex_realP [y ->]. Qed. Lemma RIm_real x : x \is Num.real -> (Im x)%:C = 0. Proof. by move=> /complex_realP [y ->]. Qed. End ComplexTheory. Definition Rcomplex := complex. HB.instance Definition _ (R : eqType) := Equality.on (Rcomplex R). HB.instance Definition _ (R : countType) := Countable.on (Rcomplex R). HB.instance Definition _ (R : choiceType) := Choice.on (Rcomplex R). HB.instance Definition _ (R : rcfType) := GRing.Field.on (Rcomplex R). HB.instance Definition _ (R : rcfType) := complex_lmodMixin R. HB.instance Definition _ (R : rcfType) := complex_lalgMixin R. HB.instance Definition _ (R : rcfType) := GRing.Lalgebra.on (Rcomplex R). Section RComplexLMod. Variable R : rcfType. Implicit Types (k : R) (x y z : Rcomplex R). Lemma conjc_is_scalable : scalable (conjc : Rcomplex R -> Rcomplex R). Proof. by move=> a [b c]; simpc. Qed. HB.instance Definition _ := GRing.isScalable.Build R R[i] R[i] *:%R conjc conjc_is_scalable. End RComplexLMod. (* Section RcfDef. *) (* Variable R : realFieldType. *) (* Notation C := (complex R). *) (* Definition rcf_odd := forall (p : {poly R}), *) (* ~~odd (size p) -> {x | p.[x] = 0}. *) (* Definition rcf_square := forall x : R, *) (* {y | (0 <= y) && if 0 <= x then (y ^ 2 == x) else y == 0}. *) (* Lemma rcf_odd_sqr_from_ivt : rcf_axiom R -> rcf_odd * rcf_square. *) (* Proof. *) (* move=> ivt. *) (* split. *) (* move=> p sp. *) (* move: (ivt p). *) (* admit. *) (* move=> x. *) (* case: (boolP (0 <= x)) (@ivt ('X^2 - x%:P) 0 (1 + x))=> px; last first. *) (* by move=> _; exists 0; rewrite lerr eqxx. *) (* case. *) (* * by rewrite ler_wpDr ?ler01. *) (* * rewrite !horner_lin oppr_le0 px /=. *) (* rewrite subr_ge0 (@ler_trans _ (1 + x)) //. *) (* by rewrite ler_wpDl ?ler01 ?lerr. *) (* by rewrite ler_peMr // addrC -subr_ge0 ?addrK // subr0 ler_wpDl ?ler01. *) (* * move=> y hy; rewrite /root !horner_lin; move/eqP. *) (* move/(canRL (@addrNK _ _)); rewrite add0r=> <-. *) (* by exists y; case/andP: hy=> -> _; rewrite eqxx. *) (* Qed. *) (* Lemma ivt_from_closed : GRing.ClosedField.axiom [ringType of C] -> rcf_axiom R. *) (* Proof. *) (* rewrite /GRing.ClosedField.axiom /= => hclosed. *) (* move=> p a b hab. *) (* Admitted. *) (* Lemma closed_form_rcf_odd_sqr : rcf_odd -> rcf_square *) (* -> GRing.ClosedField.axiom [ringType of C]. *) (* Proof. *) (* Admitted. *) (* Lemma closed_form_ivt : rcf_axiom R -> GRing.ClosedField.axiom [ringType of C]. *) (* Proof. *) (* move/rcf_odd_sqr_from_ivt; case. *) (* exact: closed_form_rcf_odd_sqr. *) (* Qed. *) (* End RcfDef. *) Section ComplexClosed. Variable R : rcfType. Definition sqrtc (x : R[i]) : R[i] := let: a +i* b := x in let sgr1 b := if b == 0 then 1 else sgr b in let r := sqrtr (a^+2 + b^+2) in (sqrtr ((r + a)/2%:R)) +i* (sgr1 b * sqrtr ((r - a)/2%:R)). Lemma sqr_sqrtc : forall x, (sqrtc x) ^+ 2 = x. Proof. have sqr: forall x : R, x ^+ 2 = x * x. by move=> x; rewrite exprS expr1. case=> a b; rewrite exprS expr1; simpc. have F0: 2%:R != 0 :> R by rewrite pnatr_eq0. have F1: 0 <= 2%:R^-1 :> R by rewrite invr_ge0 ler0n. have F2: `|a| <= sqrtr (a^+2 + b^+2). rewrite -sqrtr_sqr ler_wsqrtr //. by rewrite addrC -subr_ge0 addrK exprn_even_ge0. have F3: 0 <= (sqrtr (a ^+ 2 + b ^+ 2) - a) / 2%:R. rewrite mulr_ge0 // subr_ge0 (le_trans _ F2) //. by rewrite -(maxrN a) le_max lexx. have F4: 0 <= (sqrtr (a ^+ 2 + b ^+ 2) + a) / 2%:R. rewrite mulr_ge0 // -{2}[a]opprK subr_ge0 (le_trans _ F2) //. by rewrite -(maxrN a) le_max lexx orbT. congr (_ +i* _); set u := if _ then _ else _. rewrite mulrCA !mulrA. have->: (u * u) = 1. rewrite /u; case: (altP (_ =P _)); rewrite ?mul1r //. by rewrite -expr2 sqr_sg => ->. rewrite mul1r -!sqr !sqr_sqrtr //. rewrite [_+a]addrC -mulrBl opprD addrA addrK. by rewrite opprK -mulr2n -[a *+ 2]mulr_natl [_*a]mulrC mulfK. rewrite mulrCA -mulrA -mulrDr [sqrtr _ * _]mulrC. rewrite -mulr2n -sqrtrM // mulrAC !mulrA ?[_ * (_ - _)]mulrC -subr_sqr. rewrite sqr_sqrtr; last first. by rewrite ler_wpDr // exprn_even_ge0. rewrite [_^+2 + _]addrC addrK -mulrA -expr2 sqrtrM ?exprn_even_ge0 //. rewrite !sqrtr_sqr -(mulr_natr (_ * _)). rewrite [`|_^-1|]ger0_norm // -mulrA [_ * _%:R]mulrC divff //. rewrite mulr1 /u; case: (_ =P _)=>[->|]. by rewrite normr0 mulr0. by rewrite mulr_sg_norm. Qed. Lemma sqrtc_sqrtr : forall (x : R[i]), 0 <= x -> sqrtc x = (sqrtr (Re x))%:C. Proof. move=> [a b] /andP [/eqP->] /= a_ge0. rewrite eqxx mul1r [0 ^+ _]exprS mul0r addr0 sqrtr_sqr. rewrite ger0_norm // subrr mul0r sqrtr0 -mulr2n. by rewrite -[_*+2]mulr_natr mulfK // pnatr_eq0. Qed. Lemma sqrtc0 : sqrtc 0 = 0. Proof. by rewrite sqrtc_sqrtr ?lexx // sqrtr0. Qed. Lemma sqrtc1 : sqrtc 1 = 1. Proof. by rewrite sqrtc_sqrtr ?ler01 // sqrtr1. Qed. Lemma sqrtN1 : sqrtc (-1) = 'i. Proof. rewrite /sqrtc /= oppr0 eqxx [0^+_]exprS mulr0 addr0. rewrite exprS expr1 mulN1r opprK sqrtr1 subrr mul0r sqrtr0. by rewrite mul1r -mulr2n divff ?sqrtr1 // pnatr_eq0. Qed. Lemma sqrtc_ge0 (x : R[i]) : (0 <= sqrtc x) = (0 <= x). Proof. apply/idP/idP=> [psx|px]; last first. by rewrite sqrtc_sqrtr // lecR sqrtr_ge0. by rewrite -[x]sqr_sqrtc exprS expr1 mulr_ge0. Qed. Lemma sqrtc_eq0 (x : R[i]) : (sqrtc x == 0) = (x == 0). Proof. apply/eqP/eqP=> [eqs|->]; last by rewrite sqrtc0. by rewrite -[x]sqr_sqrtc eqs exprS mul0r. Qed. Lemma normcE x : `|x| = sqrtc (x * x^*%C). Proof. case: x=> a b; simpc; rewrite [b * a]mulrC addNr sqrtc_sqrtr //. by simpc; rewrite /= addr_ge0 ?sqr_ge0. Qed. Lemma sqr_normc (x : R[i]) : (`|x| ^+ 2) = x * x^*%C. Proof. by rewrite normcE sqr_sqrtc. Qed. Lemma normc_ge_Re (x : R[i]) : `|Re x|%:C <= `|x|. Proof. by case: x => a b; simpc; rewrite -sqrtr_sqr ler_wsqrtr // lerDl sqr_ge0. Qed. Lemma normcJ (x : R[i]) : `|x^*%C| = `|x|. Proof. by case: x => a b; simpc; rewrite /= sqrrN. Qed. Lemma invc_norm (x : R[i]) : x^-1 = `|x|^-2 * x^*%C. Proof. case: (altP (x =P 0)) => [->|dx]; first by rewrite rmorph0 mulr0 invr0. apply: (mulIf dx); rewrite mulrC divff // -mulrA [_^*%C * _]mulrC -(sqr_normc x). by rewrite mulVf // expf_neq0 ?normr_eq0. Qed. Lemma canonical_form (a b c : R[i]) : a != 0 -> let d := b ^+ 2 - 4%:R * a * c in let r1 := (- b - sqrtc d) / 2%:R / a in let r2 := (- b + sqrtc d) / 2%:R / a in a *: 'X^2 + b *: 'X + c%:P = a *: (('X - r1%:P) * ('X - r2%:P)). Proof. move=> a_neq0 d r1 r2. rewrite !(mulrDr, mulrDl, mulNr, mulrN, opprK, scalerDr). rewrite [_ * _%:P]mulrC !mul_polyC !scalerN !scalerA -!addrA; congr (_ + _). rewrite addrA; congr (_ + _). rewrite -opprD -scalerDl -scaleNr; congr(_ *: _). rewrite ![a * _]mulrC !divfK // !mulrDl addrACA !mulNr addNr addr0. rewrite -opprD opprK -mulrDr -mulr2n. by rewrite -(mulr_natl (_^-1)) divff ?mulr1 ?pnatr_eq0. symmetry; rewrite -!alg_polyC scalerA; congr (_%:A). rewrite [a * _]mulrC divfK // /r2 mulrA mulrACA -invfM -natrM -subr_sqr. rewrite sqr_sqrtc sqrrN /d opprB addrC addrNK -2!mulrA. by rewrite mulrACA -natf_div // mul1r mulrAC divff ?mul1r. Qed. Lemma monic_canonical_form (b c : R[i]) : let d := b ^+ 2 - 4%:R * c in let r1 := (- b - sqrtc d) / 2%:R in let r2 := (- b + sqrtc d) / 2%:R in 'X^2 + b *: 'X + c%:P = (('X - r1%:P) * ('X - r2%:P)). Proof. by rewrite /= -['X^2]scale1r canonical_form ?oner_eq0 // scale1r mulr1 !divr1. Qed. Section extramx. (* missing lemmas from matrix.v or mxalgebra.v *) Lemma mul_mx_rowfree_eq0 (K : fieldType) (m n p: nat) (W : 'M[K]_(m,n)) (V : 'M[K]_(n,p)) : row_free V -> (W *m V == 0) = (W == 0). Proof. by move=> free; rewrite -!mxrank_eq0 mxrankMfree ?mxrank_eq0. Qed. Lemma sub_sums_genmxP (F : fieldType) (I : finType) (P : pred I) (m n : nat) (A : 'M[F]_(m, n)) (B_ : I -> 'M_(m, n)) : reflect (exists u_ : I -> 'M_m, A = \sum_(i | P i) u_ i *m B_ i) (A <= \sum_(i | P i) <>)%MS. Proof. apply: (iffP idP); last first. by move=> [u_ ->]; rewrite summx_sub_sums // => i _; rewrite genmxE submxMl. move=> /sub_sumsmxP [u_ hA]. have Hu i : exists v, u_ i *m <>%MS = v *m B_ i. by apply/submxP; rewrite (submx_trans (submxMl _ _)) ?genmxE. exists (fun i => projT1 (sig_eqW (Hu i))); rewrite hA. by apply: eq_bigr => i /= P_i; case: sig_eqW. Qed. Lemma mulmxP (K : fieldType) (m n : nat) (A B : 'M[K]_(m, n)) : reflect (forall u : 'rV__, u *m A = u *m B) (A == B). Proof. apply: (iffP eqP) => [-> //|eqAB]. apply: (@row_full_inj _ _ _ _ 1%:M); first by rewrite row_full_unit unitmx1. by apply/row_matrixP => i; rewrite !row_mul eqAB. Qed. Section Skew. Variable (K : numFieldType). Implicit Types (phK : phant K) (n : nat). Definition skew_vec n i j : 'rV[K]_(n * n) := (mxvec ((delta_mx i j)) - (mxvec (delta_mx j i))). Definition skew_def phK n : 'M[K]_(n * n) := (\sum_(i | ((i.2 : 'I__) < (i.1 : 'I__))%N) <>)%MS. Variable (n : nat). Local Notation skew := (@skew_def (Phant K) n). Lemma skew_direct_sum : mxdirect skew. Proof. apply/mxdirect_sumsE => /=; split => [i _|]; first exact: mxdirect_trivial. apply/mxdirect_sumsP => [] [i j] /= lt_ij; apply/eqP; rewrite -submx0. apply/rV_subP => v; rewrite sub_capmx => /andP []; rewrite !genmxE. move=> /submxP [w ->] /sub_sums_genmxP [/= u_]. move/matrixP => /(_ 0 (mxvec_index i j)); rewrite !mxE /= big_ord1. rewrite /skew_vec /= !mxvec_delta !mxE !eqxx /=. have /(_ _ _ (_, _) (_, _)) /= eq_mviE := inj_eq (bij_inj (onT_bij (curry_mxvec_bij _ _))). rewrite eq_mviE xpair_eqE -!val_eqE /= eq_sym andbb. rewrite ltn_eqF // subr0 mulr1 summxE big1. rewrite [w as X in X *m _]mx11_scalar => ->. by rewrite mul_scalar_mx scale0r submx0. move=> [i' j'] /= /andP[lt_j'i']. rewrite xpair_eqE /= => neq'_ij. rewrite /= !mxvec_delta !mxE big_ord1 !mxE !eqxx !eq_mviE. rewrite !xpair_eqE /= [_ == i']eq_sym [_ == j']eq_sym (negPf neq'_ij) /=. set z := (_ && _); suff /negPf -> : ~~ z by rewrite subrr mulr0. by apply: contraL lt_j'i' => /andP [/eqP <- /eqP <-]; rewrite ltnNge ltnW. Qed. Hint Resolve skew_direct_sum : core. Lemma rank_skew : \rank skew = (n * n.-1)./2. Proof. rewrite /skew (mxdirectP _) //= -bin2 -triangular_sum big_mkord. rewrite (eq_bigr (fun _ => 1%N)); last first. move=> [i j] /= lt_ij; rewrite genmxE. apply/eqP; rewrite eqn_leq rank_leq_row /= lt0n mxrank_eq0. rewrite /skew_vec /= !mxvec_delta /= subr_eq0. set j1 := mxvec_index _ _. apply/negP => /eqP /matrixP /(_ 0 j1) /=; rewrite !mxE /= eqxx. have /(_ _ _ (_, _) (_, _)) -> := inj_eq (bij_inj (onT_bij (curry_mxvec_bij _ _))). rewrite xpair_eqE -!val_eqE /= eq_sym andbb ltn_eqF //. by move/eqP; rewrite oner_eq0. transitivity (\sum_(i < n) (\sum_(j < n | j < i) 1))%N. by rewrite pair_big_dep. apply: eq_bigr => [] [[|i] Hi] _ /=; first by rewrite big1. rewrite (eq_bigl _ _ (fun _ => ltnS _ _)). have [n_eq0|n_gt0] := posnP n; first by move: Hi (Hi); rewrite {1}n_eq0. rewrite -[n]prednK // big_ord_narrow_leq /=. by rewrite -ltnS prednK // (leq_trans _ Hi). by rewrite sum_nat_const card_ord muln1. Qed. Lemma skewP (M : 'rV_(n * n)) : reflect ((vec_mx M)^T = - vec_mx M) (M <= skew)%MS. Proof. apply: (iffP idP). move/sub_sumsmxP => [v ->]; rewrite !linear_sum /=. apply: eq_bigr => [] [i j] /= lt_ij; rewrite !mulmx_sum_row !linear_sum /=. apply: eq_bigr => k _; rewrite !linearZ /=; congr (_ *: _) => {v}. set r := << _ >>%MS; move: (row _ _) (row_sub k r) => v. move: @r; rewrite /= genmxE => /sub_rVP [a ->]; rewrite !linearZ /=. by rewrite /skew_vec !linearB /= !mxvecK !scalerN opprK addrC !trmx_delta. move=> skewM; pose M' := vec_mx M. pose xM i j := (M' i j - M' j i) *: skew_vec i j. suff -> : M = 2%:R^-1 *: (\sum_(i | true && ((i.2 : 'I__) < (i.1 : 'I__))%N) xM i.1 i.2). rewrite scalemx_sub // summx_sub_sums // => [] [i j] /= lt_ij. by rewrite scalemx_sub // genmxE. rewrite /xM /= /skew_vec (eq_bigr _ (fun _ _ => scalerBr _ _ _)). rewrite big_split /= sumrN !(eq_bigr _ (fun _ _ => scalerBl _ _ _)). rewrite !big_split /= !sumrN opprD ?opprK addrACA [- _ + _]addrC. rewrite -!sumrN -2!big_split /=. rewrite /xM /= /skew_vec -!(eq_bigr _ (fun _ _ => scalerBr _ _ _)). apply: (can_inj vec_mxK); rewrite !(linearZ, linearB, linearD, linear_sum) /=. have -> /= : vec_mx M = 2%:R^-1 *: (M' - M'^T). by rewrite skewM opprK -mulr2n -scaler_nat scalerA mulVf ?pnatr_eq0 ?scale1r. rewrite [M' in LHS]matrix_sum_delta; congr (_ *: _). rewrite pair_big /= !linear_sum /= -big_split /=. rewrite (bigID (fun ij => (ij.2 : 'I__) < (ij.1 : 'I__))%N) /=; congr (_ + _). apply: eq_bigr => [] [i j] /= lt_ij. by rewrite !linearZ linearB /= ?mxvecK trmx_delta scalerN scalerBr. rewrite (bigID (fun ij => (ij.1 : 'I__) == (ij.2 : 'I__))%N) /=. rewrite big1 ?add0r; last first. by move=> [i j] /= /andP[_ /eqP ->]; rewrite linearZ /= trmx_delta subrr. rewrite (@reindex_inj _ _ _ _ (fun ij => (ij.2, ij.1))) /=; last first. by move=> [? ?] [? ?] [] -> ->. apply: eq_big => [] [i j] /=; first by rewrite -leqNgt ltn_neqAle andbC. by rewrite !linearZ linearB /= ?mxvecK trmx_delta scalerN scalerBr. Qed. End Skew. Notation skew K n := (@skew_def _ (Phant K) n). Section Restriction. Variable K : fieldType. Variable m : nat. Variable (V : 'M[K]_m). Implicit Types f : 'M[K]_m. Definition restrict f : 'M_(\rank V) := row_base V *m f *m (pinvmx (row_base V)). Lemma stable_row_base f : (row_base V *m f <= row_base V)%MS = (V *m f <= V)%MS. Proof. rewrite eq_row_base. by apply/idP/idP=> /(submx_trans _) ->; rewrite ?submxMr ?eq_row_base. Qed. Lemma eigenspace_restrict f : (V *m f <= V)%MS -> forall n a (W : 'M_(n, \rank V)), (W <= eigenspace (restrict f) a)%MS = (W *m row_base V <= eigenspace f a)%MS. Proof. move=> f_stabV n a W; apply/eigenspaceP/eigenspaceP; rewrite scalemxAl. by move<-; rewrite -mulmxA -[X in _ = X]mulmxA mulmxKpV ?stable_row_base. move/(congr1 (mulmx^~ (pinvmx (row_base V)))). rewrite -2!mulmxA [_ *m (f *m _)]mulmxA => ->. by apply: (row_free_inj (row_base_free V)); rewrite mulmxKpV ?submxMl. Qed. Lemma eigenvalue_restrict f : (V *m f <= V)%MS -> {subset eigenvalue (restrict f) <= eigenvalue f}. Proof. move=> f_stabV a /eigenvalueP [x /eigenspaceP]; rewrite eigenspace_restrict //. move=> /eigenspaceP Hf x_neq0; apply/eigenvalueP. by exists (x *m row_base V); rewrite ?mul_mx_rowfree_eq0 ?row_base_free. Qed. Lemma restrictM : {in [pred f | (V *m f <= V)%MS] &, {morph restrict : f g / f *m g}}. Proof. move=> f g; rewrite !inE => Vf Vg /=. by rewrite /restrict 2!mulmxA mulmxA mulmxKpV ?stable_row_base. Qed. End Restriction. End extramx. Notation skew K n := (@skew_def _ (Phant K) n). Section Paper_HarmDerksen. (* Following http://www.math.lsa.umich.edu/~hderksen/preprints/linalg.pdf *) (* quite literally except for Lemma5 where we don't use hermitian matrices. *) (* Instead we encode the morphism by hand in 'M[R]_(n * n), which turns out *) (* to be very clumsy for formalizing commutation and the end of Lemma 4. *) (* Moreover, the Qed takes time, so it would be far much better to formalize *) (* Herm C n and use it instead ! *) Implicit Types (K : fieldType). Definition CommonEigenVec_def K (phK : phant K) (d r : nat) := forall (m : nat) (V : 'M[K]_m), ~~ (d %| \rank V) -> forall (sf : seq 'M_m), size sf = r -> {in sf, forall f, (V *m f <= V)%MS} -> {in sf &, forall f g, f *m g = g *m f} -> exists2 v : 'rV_m, (v != 0) & forall f, f \in sf -> exists a, (v <= eigenspace f a)%MS. Notation CommonEigenVec K d r := (@CommonEigenVec_def _ (Phant K) d r). Definition Eigen1Vec_def K (phK : phant K) (d : nat) := forall (m : nat) (V : 'M[K]_m), ~~ (d %| \rank V) -> forall (f : 'M_m), (V *m f <= V)%MS -> exists a, eigenvalue f a. Notation Eigen1Vec K d := (@Eigen1Vec_def _ (Phant K) d). Lemma Eigen1VecP (K : fieldType) (d : nat) : CommonEigenVec K d 1%N <-> Eigen1Vec K d. Proof. split=> [Hd m V HV f|Hd m V HV [] // f [] // _ /(_ _ (mem_head _ _))] f_stabV. have [] := Hd _ _ HV [::f] (erefl _). + by move=> ?; rewrite in_cons orbF => /eqP ->. + by move=> ? ?; rewrite /= !in_cons !orbF => /eqP -> /eqP ->. move=> v v_neq0 /(_ f (mem_head _ _)) [a /eigenspaceP]. by exists a; apply/eigenvalueP; exists v. have [a /eigenvalueP [v /eigenspaceP v_eigen v_neq0]] := Hd _ _ HV _ f_stabV. by exists v => // ?; rewrite in_cons orbF => /eqP ->; exists a. Qed. Lemma Lemma3 K d : Eigen1Vec K d -> forall r, CommonEigenVec K d r.+1. Proof. move=> E1V_K_d; elim=> [|r IHr m V]; first exact/Eigen1VecP. move: (\rank V) {-2}V (leqnn (\rank V)) => n {V}. elim: n m => [|n IHn] m V. by rewrite leqn0 => /eqP ->; rewrite dvdn0. move=> le_rV_Sn HrV [] // f sf /= [] ssf f_sf_stabV f_sf_comm. have [->|f_neq0] := altP (f =P 0). have [||v v_neq0 Hsf] := (IHr _ _ HrV _ ssf). + by move=> g f_sf /=; rewrite f_sf_stabV // in_cons f_sf orbT. + move=> g h g_sf h_sf /=. by apply: f_sf_comm; rewrite !in_cons ?g_sf ?h_sf ?orbT. exists v => // g; rewrite in_cons => /orP [/eqP->|]; last exact: Hsf. by exists 0; apply/eigenspaceP; rewrite mulmx0 scale0r. have f_stabV : (V *m f <= V)%MS by rewrite f_sf_stabV ?mem_head. have sf_stabV : {in sf, forall f, (V *m f <= V)%MS}. by move=> g g_sf /=; rewrite f_sf_stabV // in_cons g_sf orbT. pose f' := restrict V f; pose sf' := map (restrict V) sf. have [||a a_eigen_f'] := E1V_K_d _ 1%:M _ f'; do ?by rewrite ?mxrank1 ?submx1. pose W := (eigenspace f' a)%MS; pose Z := (f' - a%:M). have rWZ : (\rank W + \rank Z)%N = \rank V. by rewrite (mxrank_ker (f' - a%:M)) subnK // rank_leq_row. have f'_stabW : (W *m f' <= W)%MS. by rewrite (eigenspaceP (submx_refl _)) scalemx_sub. have f'_stabZ : (Z *m f' <= Z)%MS. rewrite (submx_trans _ (submxMl f' _)) //. by rewrite mulmxDl mulmxDr mulmxN mulNmx scalar_mxC. have sf'_comm : {in [::f' & sf'] &, forall f g, f *m g = g *m f}. move=> g' h' /=; rewrite -!map_cons. move=> /mapP [g g_s_sf -> {g'}] /mapP [h h_s_sf -> {h'}]. by rewrite -!restrictM ?inE /= ?f_sf_stabV // f_sf_comm. have sf'_stabW : {in sf', forall f, (W *m f <= W)%MS}. move=> g g_sf /=; apply/eigenspaceP. rewrite -mulmxA -[g *m _]sf'_comm ?(mem_head, in_cons, g_sf, orbT) //. by rewrite mulmxA scalemxAl (eigenspaceP (submx_refl _)). have sf'_stabZ : {in sf', forall f, (Z *m f <= Z)%MS}. move=> g g_sf /=. rewrite mulmxBl sf'_comm ?(mem_head, in_cons, g_sf, orbT) //. by rewrite -scalar_mxC -mulmxBr submxMl. have [eqWV|neqWV] := altP (@eqmxP _ _ _ _ W 1%:M). have [] // := IHr _ W _ sf'; do ?by rewrite ?eqWV ?mxrank1 ?size_map. move=> g h g_sf' h_sf'; apply: sf'_comm; by rewrite in_cons (g_sf', h_sf') orbT. move=> v v_neq0 Hv; exists (v *m row_base V). by rewrite mul_mx_rowfree_eq0 ?row_base_free. move=> g; rewrite in_cons => /orP [/eqP ->|g_sf]; last first. have [|b] := Hv (restrict V g); first by rewrite map_f. by rewrite eigenspace_restrict // ?sf_stabV //; exists b. by exists a; rewrite -eigenspace_restrict // eqWV submx1. have lt_WV : (\rank W < \rank V)%N. rewrite -[X in (_ < X)%N](@mxrank1 K) rank_ltmx //. by rewrite ltmxEneq neqWV // submx1. have ltZV : (\rank Z < \rank V)%N. rewrite -[X in (_ < X)%N]rWZ -subn_gt0 addnK lt0n mxrank_eq0 -lt0mx. move: a_eigen_f' => /eigenvalueP [v /eigenspaceP] sub_vW v_neq0. by rewrite (ltmx_sub_trans _ sub_vW) // lt0mx. have [] // := IHn _ (if d %| \rank Z then W else Z) _ _ [:: f' & sf']. + by rewrite -ltnS (@leq_trans (\rank V)) //; case: ifP. + by apply: contra HrV; case: ifP => [*|-> //]; rewrite -rWZ dvdn_add. + by rewrite /= size_map ssf. + move=> g; rewrite in_cons => /= /orP [/eqP -> {g}|g_sf']; case: ifP => _ //; by rewrite (sf'_stabW, sf'_stabZ). move=> v v_neq0 Hv; exists (v *m row_base V). by rewrite mul_mx_rowfree_eq0 ?row_base_free. move=> g Hg; have [|b] := Hv (restrict V g); first by rewrite -map_cons map_f. rewrite eigenspace_restrict //; first by exists b. by move: Hg; rewrite in_cons => /orP [/eqP -> //|/sf_stabV]. Qed. Lemma Lemma4 r : CommonEigenVec R 2 r.+1. Proof. apply: Lemma3=> m V hV f f_stabV. have [|a] := @odd_poly_root _ (char_poly (restrict V f)). by rewrite size_char_poly /= -dvdn2. rewrite -eigenvalue_root_char => /eigenvalueP [v] /eigenspaceP v_eigen v_neq0. exists a; apply/eigenvalueP; exists (v *m row_base V). by apply/eigenspaceP; rewrite -eigenspace_restrict. by rewrite mul_mx_rowfree_eq0 ?row_base_free. Qed. Notation toC := (real_complex R). Notation MtoC := (map_mx toC). Lemma Lemma5 : Eigen1Vec R[i] 2. Proof. move=> m V HrV f f_stabV. suff: exists a, eigenvalue (restrict V f) a. by move=> [a /eigenvalue_restrict Hf]; exists a; apply: Hf. move: (\rank V) (restrict V f) => {f f_stabV V m} n f in HrV *. pose u := map_mx (@Re R) f; pose v := map_mx (@Im R) f. have fE : f = MtoC u + 'i%C *: MtoC v. rewrite /u /v [f]lock; apply/matrixP => i j; rewrite !mxE /=. by case: (locked f i j) => a b; simpc. move: u v => u v in fE *. pose L1fun : 'M[R]_n -> _ := 2%:R^-1 \*: (mulmxr u \+ (mulmxr v \o trmx) \+ ((mulmx (u^T)) \- (mulmx (v^T) \o trmx))). pose L1 := lin_mx L1fun. pose L2fun : 'M[R]_n -> _ := 2%:R^-1 \*: (((@GRing.opp _) \o (mulmxr u \o trmx) \+ mulmxr v) \+ ((mulmx (u^T) \o trmx) \+ (mulmx (v^T)))). pose L2 := lin_mx L2fun. have [] := @Lemma4 _ _ 1%:M _ [::L1; L2] (erefl _). + by move: HrV; rewrite mxrank1 !dvdn2 ?negbK oddM andbb. + by move=> ? _ /=; rewrite submx1. + suff {f fE}: L1 *m L2 = L2 *m L1. move: L1 L2 => L1 L2 commL1L2 La Lb. rewrite !{1}in_cons !{1}in_nil !{1}orbF. by move=> /orP [] /eqP -> /orP [] /eqP -> //; symmetry. apply/eqP/mulmxP => x; rewrite [X in X = _]mulmxA [X in _ = X]mulmxA. rewrite 4!mul_rV_lin !mxvecK /= /L1fun /L2fun /=; congr (mxvec (_ *: _)). move=> {L1 L2 L1fun L2fun}. case: n {x} (vec_mx x) => [//|n] x in HrV u v *. do ?[rewrite -(scalemxAl, scalemxAr, scalerN, scalerDr) |rewrite (mulmxN, mulNmx, trmxK, trmx_mul) |rewrite ?[(_ *: _)^T]linearZ ?[(_ + _)^T]linearD ?[(- _)^T]linearN /=]. congr (_ *: _). rewrite !(mulmxDr, mulmxDl, mulNmx, mulmxN, mulmxA, opprD, opprK). do ![move: (_ *m _ *m _)] => t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12. rewrite [X in X + _ + _]addrC [X in X + _ = _]addrACA. rewrite [X in _ = (_ + _ + X) + _]addrC [X in _ = X + _]addrACA. rewrite [X in _ + (_ + _ + X) = _]addrC [X in _ + X = _]addrACA. rewrite [X in _ = _ + (X + _)]addrC [X in _ = _ + X]addrACA. rewrite [X in X = _]addrACA [X in _ = X]addrACA; congr (_ + _). by rewrite addrC [X in X + _ = _]addrACA [X in _ + X = _]addrACA. move=> g g_neq0 Hg; have [] := (Hg L1, Hg L2). rewrite !(mem_head, in_cons, orbT) => []. move=> [//|a /eigenspaceP g_eigenL1] [//|b /eigenspaceP g_eigenL2]. rewrite !mul_rV_lin /= /L1fun /L2fun /= in g_eigenL1 g_eigenL2. do [move=> /(congr1 vec_mx); rewrite mxvecK linearZ /=] in g_eigenL1. do [move=> /(congr1 vec_mx); rewrite mxvecK linearZ /=] in g_eigenL2. move=> {L1 L2 L1fun L2fun Hg HrV}. set vg := vec_mx g in g_eigenL1 g_eigenL2. exists (a +i* b); apply/eigenvalueP. pose w := (MtoC vg - 'i%C *: MtoC vg^T). exists (nz_row w); last first. rewrite nz_row_eq0 subr_eq0; apply: contraNneq g_neq0 => Hvg. rewrite -vec_mx_eq0; apply/eqP/matrixP => i j; rewrite !mxE /=. move: Hvg => /matrixP /(_ i j); rewrite !mxE /=; case. by rewrite !(mul0r, mulr0, add0r, mul1r, oppr0) => ->. apply/eigenspaceP. case: n f => [|n] f in u v g g_neq0 vg w fE g_eigenL1 g_eigenL2 *. by rewrite thinmx0 eqxx in g_neq0. rewrite (submx_trans (nz_row_sub _)) //; apply/eigenspaceP. rewrite fE [a +i* b]complexE /=. rewrite !(mulmxDr, mulmxBl, =^~scalemxAr, =^~scalemxAl) -!map_mxM. rewrite !(scalerDl, scalerDr, scalerN, =^~scalemxAr, =^~scalemxAl). rewrite !scalerA /= mulrAC ['i%C * _]sqr_i ?mulN1r scaleN1r scaleNr !opprK. rewrite [_ * 'i%C]mulrC -!scalerA -!map_mxZ /=. rewrite ['i%C *: _ + _]addrC [LHS]addrACA ['i%C *: _ + _]addrC [RHS]addrACA. rewrite [X in _ + _ + X]addrC -scalerBr -!(rmorphB, rmorphD)/=. rewrite [- _ + _ in RHS]addrC -scalerBr -!(rmorphB, rmorphD)/=. congr (_ + 'i%C *: _); congr map_mx; rewrite -[_ *: _^T]linearZ /=; rewrite -g_eigenL1 -g_eigenL2 linearZ -(scalerDr, scalerBr); do ?rewrite ?trmxK ?trmx_mul ?[(_ + _)^T]linearD ?[(- _)^T]linearN /=; rewrite -[in X in _ *: (_ + X)]addrC 1?opprD 1?opprB ?mulmxN ?mulNmx; rewrite [X in _ *: X]addrACA. rewrite -mulr2n [X in _ *: (_ + X)]addrACA subrr addNr !addr0. by rewrite -scaler_nat scalerA mulVf ?pnatr_eq0 // scale1r. rewrite subrr addr0 addrA addrAC -addrA -mulr2n addrC. by rewrite -scaler_nat scalerA mulVf ?pnatr_eq0 // scale1r. Qed. Lemma Lemma6 k r : CommonEigenVec R[i] (2^k.+1) r.+1. Proof. elim: k {-2}k (leqnn k) r => [|k IHk] l. by rewrite leqn0 => /eqP ->; apply: Lemma3; apply: Lemma5. rewrite leq_eqVlt ltnS => /orP [/eqP ->|/IHk //] r {l}. apply: Lemma3 => m V Hn f f_stabV {r}. have [dvd2n|Ndvd2n] := boolP (2 %| \rank V); last first. exact: @Lemma5 _ _ Ndvd2n _ f_stabV. suff: exists a, eigenvalue (restrict V f) a. by move=> [a /eigenvalue_restrict Hf]; exists a; apply: Hf. case: (\rank V) (restrict V f) => {f f_stabV V m} [|n] f in Hn dvd2n *. by rewrite dvdn0 in Hn. pose L1 := lin_mx (mulmxr f \+ mulmx f^T). pose L2 := lin_mx (mulmxr f \o mulmx f^T). have [] /= := IHk _ (leqnn _) _ _ (skew R[i] n.+1) _ [::L1; L2] (erefl _). + rewrite rank_skew; apply: contra Hn. rewrite -(@dvdn_pmul2r 2) //= -expnSr muln2 -[_.*2]add0n. have n_odd : odd n by rewrite dvdn2 /= ?negbK in dvd2n *. have {2}<- : odd (n.+1 * n) = 0%N :> nat by rewrite oddM /= andNb. by rewrite odd_double_half Gauss_dvdl // coprime_pexpl // coprime2n. + move=> L; rewrite 2!in_cons in_nil orbF => /orP [] /eqP ->; apply/rV_subP => v /submxP [s -> {v}]; rewrite mulmxA; apply/skewP; set u := _ *m skew _ _; do [have /skewP : (u <= skew R[i] n.+1)%MS by rewrite submxMl]; rewrite mul_rV_lin /= !mxvecK => skew_u. by rewrite opprD linearD /= !trmx_mul skew_u mulmxN mulNmx addrC trmxK. by rewrite !trmx_mul trmxK skew_u mulNmx mulmxN mulmxA. + suff commL1L2: L1 *m L2 = L2 *m L1. move=> La Lb; rewrite !in_cons !in_nil !orbF. by move=> /orP [] /eqP -> /orP [] /eqP -> //; symmetry. apply/eqP/mulmxP => u; rewrite !mulmxA !mul_rV_lin ?mxvecK /=. by rewrite !(mulmxDr, mulmxDl, mulmxA). move=> v v_neq0 HL1L2; have [] := (HL1L2 L1, HL1L2 L2). rewrite !(mem_head, in_cons) orbT => [] [] // a vL1 [] // b vL2 {HL1L2}. move/eigenspaceP in vL1; move/eigenspaceP in vL2. move: vL2 => /(congr1 vec_mx); rewrite linearZ mul_rV_lin /= mxvecK. move: vL1 => /(congr1 vec_mx); rewrite linearZ mul_rV_lin /= mxvecK. move=> /(canRL (addKr _)) ->; rewrite mulmxDl mulNmx => Hv. pose p := 'X^2 + (- a) *: 'X + b%:P. have : vec_mx v *m (horner_mx f p) = 0. rewrite !(rmorphN, rmorphB, rmorphD, rmorphM) /= linearZ /=. rewrite horner_mx_X horner_mx_C !mulmxDr mul_mx_scalar -Hv. rewrite addrAC addrA mulmxA addrN add0r. by rewrite -scalemxAl -scalemxAr scaleNr addrN. rewrite [p]monic_canonical_form; move: (_ / 2%:R) (_ / 2%:R). move=> r2 r1 {Hv p a b L1 L2 Hn}. rewrite rmorphM /= !rmorphB /= horner_mx_X !horner_mx_C mulmxA => Hv. have: exists2 w : 'M_n.+1, w != 0 & exists a, (w <= eigenspace f a)%MS. move: Hv; set w := vec_mx _ *m _. have [w_eq0 _|w_neq0 r2_eigen] := altP (w =P 0). exists (vec_mx v); rewrite ?vec_mx_eq0 //; exists r1. apply/eigenspaceP/eqP. by rewrite -mul_mx_scalar -subr_eq0 -mulmxBr -/w w_eq0. exists w => //; exists r2; apply/eigenspaceP/eqP. by rewrite -mul_mx_scalar -subr_eq0 -mulmxBr r2_eigen. move=> [w w_neq0 [a /(submx_trans (nz_row_sub _)) /eigenspaceP Hw]]. by exists a; apply/eigenvalueP; exists (nz_row w); rewrite ?nz_row_eq0. Qed. (* We enunciate a corollary of Theorem 7 *) Corollary Theorem7' (m : nat) (f : 'M[R[i]]_m) : (0 < m)%N -> exists a, eigenvalue f a. Proof. case: m f => // m f _; have /Eigen1VecP := @Lemma6 m 0. move=> /(_ m.+1 1 _ f) []; last by move=> a; exists a. + by rewrite mxrank1 (contra (dvdn_leq _)) // -ltnNge ltn_expl. + by rewrite submx1. Qed. Lemma complex_acf_axiom : GRing.closed_field_axiom R[i]. Proof. move=> n c n_gt0; pose p := 'X^n - \poly_(i < n) c i. suff [x rpx] : exists x, root p x. exists x; move: rpx; rewrite /root /p hornerD hornerN hornerXn subr_eq0. by move=> /eqP ->; rewrite horner_poly. have p_monic : p \is monic. rewrite qualifE/= lead_coefDl ?lead_coefXn //. by rewrite size_opp size_polyXn ltnS size_poly. have sp_gt1 : (size p > 1)%N. by rewrite size_addl size_polyXn // size_opp ltnS size_poly. case: n n_gt0 p => //= n _ p in p_monic sp_gt1 *. have [] := Theorem7' (companionmx p); first by rewrite -(subnK sp_gt1) addn2. by move=> x; rewrite eigenvalue_root_char companionmxK //; exists x. Qed. HB.instance Definition _ := Field_isAlgClosed.Build R[i] complex_acf_axiom. HB.instance Definition _ := Num.NumField_isImaginary.Build R[i] (sqr_i R) sqr_normc. End Paper_HarmDerksen. End ComplexClosed. Section ComplexClosedTheory. Variable R : rcfType. Lemma complexiE : 'i%C = 'i%R :> R[i]. Proof. by []. Qed. Lemma complexRe (x : R[i]) : (Re x)%:C = 'Re x. Proof. rewrite {1}[x]Crect raddfD /= mulrC ReiNIm rmorphB /=. by rewrite ?RRe_real ?RIm_real ?Creal_Im ?Creal_Re // subr0. Qed. Lemma complexIm (x : R[i]) : (Im x)%:C = 'Im x. Proof. rewrite {1}[x]Crect raddfD /= mulrC ImiRe rmorphD /=. by rewrite ?RRe_real ?RIm_real ?Creal_Im ?Creal_Re // add0r. Qed. End ComplexClosedTheory. Definition complexalg := realalg[i]. HB.instance Definition _ := Num.ClosedField.on complexalg. Lemma complexalg_algebraic : integralRange (@ratr complexalg). Proof. move=> x; suff [p p_monic] : integralOver (real_complex _ \o realalg_of _) x. by rewrite (eq_map_poly (fmorph_eq_rat _)); exists p. by apply: complex_algebraic_trans; apply: realalg_algebraic. Qed. real-closed-2.0.2/theories/mxtens.v000066400000000000000000000264251472566273500172660ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq div. From mathcomp Require Import choice fintype bigop ssralg zmodp matrix. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import GRing.Theory. Local Open Scope ring_scope. Section ExtraBigOp. Lemma sumr_add : forall (R : ringType) m n (F : 'I_(m + n) -> R), \sum_(i < m + n) F i = \sum_(i < m) F (lshift _ i) + \sum_(i < n) F (rshift _ i). Proof. move=> R; elim=> [|m ihm] n F. rewrite !big_ord0 add0r; apply: congr_big=> // [[i hi]] _. by rewrite /rshift /=; congr F; apply: val_inj. rewrite !big_ord_recl ihm -addrA. congr (_ + _); first by congr F; apply: val_inj. congr (_ + _); by apply: congr_big=> // i _ /=; congr F; apply: val_inj. Qed. Lemma mxtens_index_proof m n (ij : 'I_m * 'I_n) : ij.1 * n + ij.2 < m * n. Proof. case: m ij=> [[[] //]|] m ij; rewrite mulSn addnC -addSn leq_add //. by rewrite leq_mul2r; case: n ij=> // n ij; rewrite leq_ord orbT. Qed. Definition mxtens_index m n ij := Ordinal (@mxtens_index_proof m n ij). Lemma mxtens_index_proof1 m n (k : 'I_(m * n)) : k %/ n < m. Proof. by move: m n k=> [_ [] //|m] [|n] k; rewrite ?divn0 // ltn_divLR. Qed. Lemma mxtens_index_proof2 m n (k : 'I_(m * n)) : k %% n < n. Proof. by rewrite ltn_mod; case: n k=> //; rewrite muln0=> [] []. Qed. Definition mxtens_unindex m n k := (Ordinal (@mxtens_index_proof1 m n k), Ordinal (@mxtens_index_proof2 m n k)). Arguments mxtens_index {m n}. Arguments mxtens_unindex {m n}. Lemma mxtens_indexK m n : cancel (@mxtens_index m n) (@mxtens_unindex m n). Proof. case: m=> [[[] //]|m]; case: n=> [[_ [] //]|n]. move=> [i j]; congr (_, _); apply: val_inj=> /=. by rewrite divnMDl // divn_small ?addn0. by rewrite modnMDl // modn_small. Qed. Lemma mxtens_unindexK m n : cancel (@mxtens_unindex m n) (@mxtens_index m n). Proof. case: m=> [[[] //]|m]. case: n=> [|n] k. by suff: False by []; move: k; rewrite muln0=> [] []. by apply: val_inj=> /=; rewrite -divn_eq. Qed. Variant is_mxtens_index (m n : nat) : 'I_(m * n) -> Type := IsMxtensIndex : forall (i : 'I_m) (j : 'I_n), is_mxtens_index (mxtens_index (i, j)). Lemma mxtens_indexP (m n : nat) (k : 'I_(m * n)) : is_mxtens_index k. Proof. by rewrite -[k]mxtens_unindexK; constructor. Qed. Lemma mulr_sum (R : ringType) m n (Fm : 'I_m -> R) (Fn : 'I_n -> R) : (\sum_(i < m) Fm i) * (\sum_(i < n) Fn i) = \sum_(i < m * n) ((Fm (mxtens_unindex i).1) * (Fn (mxtens_unindex i).2)). Proof. rewrite mulr_suml; transitivity (\sum_i (\sum_(j < n) Fm i * Fn j)). by apply: eq_big=> //= i _; rewrite -mulr_sumr. rewrite pair_big; apply: reindex=> //=. by exists mxtens_index=> i; rewrite (mxtens_indexK, mxtens_unindexK). Qed. End ExtraBigOp. Section ExtraMx. Lemma castmx_mul (R : ringType) (m m' n p p': nat) (em : m = m') (ep : p = p') (M : 'M[R]_(m, n)) (N : 'M[R]_(n, p)) : castmx (em, ep) (M *m N) = castmx (em, erefl _) M *m castmx (erefl _, ep) N. Proof. by case: m' / em; case: p' / ep. Qed. Lemma mulmx_cast (R : ringType) (m n n' p p' : nat) (en : n' = n) (ep : p' = p) (M : 'M[R]_(m, n)) (N : 'M[R]_(n', p')) : M *m (castmx (en, ep) N) = (castmx (erefl _, (esym en)) M) *m (castmx (erefl _, ep) N). Proof. by case: n / en in M *; case: p / ep in N *. Qed. Lemma castmx_row (R : Type) (m m' n1 n2 n1' n2' : nat) (eq_n1 : n1 = n1') (eq_n2 : n2 = n2') (eq_n12 : (n1 + n2 = n1' + n2')%N) (eq_m : m = m') (A1 : 'M[R]_(m, n1)) (A2 : 'M_(m, n2)) : castmx (eq_m, eq_n12) (row_mx A1 A2) = row_mx (castmx (eq_m, eq_n1) A1) (castmx (eq_m, eq_n2) A2). Proof. case: _ / eq_n1 in eq_n12 *; case: _ / eq_n2 in eq_n12 *. by case: _ / eq_m; rewrite castmx_id. Qed. Lemma castmx_col (R : Type) (m m' n1 n2 n1' n2' : nat) (eq_n1 : n1 = n1') (eq_n2 : n2 = n2') (eq_n12 : (n1 + n2 = n1' + n2')%N) (eq_m : m = m') (A1 : 'M[R]_(n1, m)) (A2 : 'M_(n2, m)) : castmx (eq_n12, eq_m) (col_mx A1 A2) = col_mx (castmx (eq_n1, eq_m) A1) (castmx (eq_n2, eq_m) A2). Proof. case: _ / eq_n1 in eq_n12 *; case: _ / eq_n2 in eq_n12 *. by case: _ / eq_m; rewrite castmx_id. Qed. Lemma castmx_block (R : Type) (m1 m1' m2 m2' n1 n2 n1' n2' : nat) (eq_m1 : m1 = m1') (eq_n1 : n1 = n1') (eq_m2 : m2 = m2') (eq_n2 : n2 = n2') (eq_m12 : (m1 + m2 = m1' + m2')%N) (eq_n12 : (n1 + n2 = n1' + n2')%N) (ul : 'M[R]_(m1, n1)) (ur : 'M[R]_(m1, n2)) (dl : 'M[R]_(m2, n1)) (dr : 'M[R]_(m2, n2)) : castmx (eq_m12, eq_n12) (block_mx ul ur dl dr) = block_mx (castmx (eq_m1, eq_n1) ul) (castmx (eq_m1, eq_n2) ur) (castmx (eq_m2, eq_n1) dl) (castmx (eq_m2, eq_n2) dr). Proof. case: _ / eq_m1 in eq_m12 *; case: _ / eq_m2 in eq_m12 *. case: _ / eq_n1 in eq_n12 *; case: _ / eq_n2 in eq_n12 *. by rewrite !castmx_id. Qed. End ExtraMx. Section MxTens. Variable R : ringType. Definition tensmx {m n p q : nat} (A : 'M_(m, n)) (B : 'M_(p, q)) : 'M[R]_(_,_) := nosimpl (\matrix_(i, j) (A (mxtens_unindex i).1 (mxtens_unindex j).1 * B (mxtens_unindex i).2 (mxtens_unindex j).2)). Notation "A *t B" := (tensmx A B) (at level 40, left associativity, format "A *t B"). Lemma tensmxE {m n p q} (A : 'M_(m, n)) (B : 'M_(p, q)) i j k l : (A *t B) (mxtens_index (i, j)) (mxtens_index (k, l)) = A i k * B j l. Proof. by rewrite !mxE !mxtens_indexK. Qed. Lemma tens0mx {m n p q} (M : 'M[R]_(p,q)) : (0 : 'M_(m,n)) *t M = 0. Proof. by apply/matrixP=> i j; rewrite !mxE mul0r. Qed. Lemma tensmx0 {m n p q} (M : 'M[R]_(m,n)) : M *t (0 : 'M_(p,q)) = 0. Proof. by apply/matrixP=> i j; rewrite !mxE mulr0. Qed. Lemma tens_scalar_mx (m n : nat) (c : R) (M : 'M_(m,n)): c%:M *t M = castmx (esym (mul1n _), esym (mul1n _)) (c *: M). Proof. apply/matrixP=> i j. case: (mxtens_indexP i)=> i0 i1; case: (mxtens_indexP j)=> j0 j1. rewrite tensmxE [i0]ord1 [j0]ord1 !castmxE !mxE /= mulr1n. by congr (_ * M _ _); apply: val_inj. Qed. Lemma tens_scalar1mx (m n : nat) (M : 'M_(m,n)) : 1 *t M = castmx (esym (mul1n _), esym (mul1n _)) M. Proof. by rewrite tens_scalar_mx scale1r. Qed. Lemma tens_scalarN1mx (m n : nat) (M : 'M_(m,n)) : (-1) *t M = castmx (esym (mul1n _), esym (mul1n _)) (-M). Proof. by rewrite [-1]mx11_scalar /= tens_scalar_mx !mxE scaleNr scale1r. Qed. Lemma trmx_tens {m n p q} (M :'M[R]_(m,n)) (N : 'M[R]_(p,q)) : (M *t N)^T = M^T *t N^T. Proof. by apply/matrixP=> i j; rewrite !mxE. Qed. Lemma tens_col_mx {m n p q} (r : 'rV[R]_n) (M :'M[R]_(m, n)) (N : 'M[R]_(p, q)) : (col_mx r M) *t N = castmx (esym (mulnDl _ _ _), erefl _) (col_mx (r *t N) (M *t N)). Proof. apply/matrixP=> i j. case: (mxtens_indexP i)=> i0 i1; case: (mxtens_indexP j)=> j0 j1. rewrite !tensmxE castmxE /= cast_ord_id esymK !mxE /=. case: splitP=> i0' /= hi0'; case: splitP=> k /= hk. + case: (mxtens_indexP k) hk=> k0 k1 /=; rewrite tensmxE. move=> /(f_equal (edivn^~ p)); rewrite !edivn_eq // => [] [h0 h1]. by congr (r _ _ * N _ _); apply: val_inj; rewrite /= -?h0 ?h1. + move: hk (ltn_ord i1); rewrite hi0'. by rewrite [i0']ord1 mul0n mul1n add0n ltnNge=> ->; rewrite leq_addr. + move: (ltn_ord k); rewrite -hk hi0' ltnNge {1}mul1n. by rewrite mulnDl {1}mul1n -addnA leq_addr. case: (mxtens_indexP k) hk=> k0 k1 /=; rewrite tensmxE. rewrite hi0' mulnDl -addnA=> /addnI. move=> /(f_equal (edivn^~ p)); rewrite !edivn_eq // => [] [h0 h1]. by congr (M _ _ * N _ _); apply: val_inj; rewrite /= -?h0 ?h1. Qed. Lemma tens_row_mx {m n p q} (r : 'cV[R]_m) (M :'M[R]_(m,n)) (N : 'M[R]_(p,q)) : (row_mx r M) *t N = castmx (erefl _, esym (mulnDl _ _ _)) (row_mx (r *t N) (M *t N)). Proof. rewrite -[_ *t _]trmxK trmx_tens tr_row_mx tens_col_mx. apply/eqP; rewrite -(can2_eq (castmxKV _ _) (castmxK _ _)); apply/eqP. by rewrite trmx_cast castmx_comp castmx_id tr_col_mx -!trmx_tens !trmxK. Qed. Lemma tens_block_mx {m n p q} (ul : 'M[R]_1) (ur : 'rV[R]_n) (dl : 'cV[R]_m) (M :'M[R]_(m,n)) (N : 'M[R]_(p,q)) : (block_mx ul ur dl M) *t N = castmx (esym (mulnDl _ _ _), esym (mulnDl _ _ _)) (block_mx (ul *t N) (ur *t N) (dl *t N) (M *t N)). Proof. rewrite !block_mxEv tens_col_mx !tens_row_mx -!cast_col_mx castmx_comp. by congr (castmx (_,_)); apply nat_irrelevance. Qed. Fixpoint ntensmx_rec {m n} (A : 'M_(m,n)) k : 'M_(m ^ k.+1,n ^ k.+1) := if k is k'.+1 then (A *t (ntensmx_rec A k')) else A. Definition ntensmx {m n} (A : 'M_(m, n)) k := nosimpl (if k is k'.+1 return 'M[R]_(m ^ k,n ^ k) then ntensmx_rec A k' else 1). Notation "A ^t k" := (ntensmx A k) (at level 39, left associativity, format "A ^t k"). Lemma ntensmx0 : forall {m n} (A : 'M_(m,n)) , A ^t 0 = 1. Proof. by []. Qed. Lemma ntensmx1 : forall {m n} (A : 'M_(m,n)) , A ^t 1 = A. Proof. by []. Qed. Lemma ntensmx2 : forall {m n} (A : 'M_(m,n)) , A ^t 2 = A *t A. Proof. by []. Qed. Lemma ntensmxSS : forall {m n} (A : 'M_(m,n)) k, A ^t k.+2 = A *t A ^t k.+1. Proof. by []. Qed. Definition ntensmxS := (@ntensmx1, @ntensmx2, @ntensmxSS). End MxTens. Notation "A *t B" := (tensmx A B) (at level 40, left associativity, format "A *t B"). Notation "A ^t k" := (ntensmx A k) (at level 39, left associativity, format "A ^t k"). Section MapMx. Variables (aR rR : ringType). Hypothesis f : {rmorphism aR -> rR}. Local Notation "A ^f" := (map_mx f A) : ring_scope. Variables m n p q: nat. Implicit Type A : 'M[aR]_(m, n). Implicit Type B : 'M[aR]_(p, q). Lemma map_mxT A B : (A *t B)^f = A^f *t B^f :> 'M_(m*p, n*q). Proof. by apply/matrixP=> i j; rewrite !mxE /= rmorphM. Qed. End MapMx. Section Misc. Lemma tensmx_mul (R : comRingType) m n p q r s (A : 'M[R]_(m,n)) (B : 'M[R]_(p,q)) (C : 'M[R]_(n, r)) (D : 'M[R]_(q, s)) : (A *t B) *m (C *t D) = (A *m C) *t (B *m D). Proof. apply/matrixP=> /= i j. case (mxtens_indexP i)=> [im ip] {i}; case (mxtens_indexP j)=> [jr js] {j}. rewrite !mxE !mxtens_indexK mulr_sum; apply: congr_big=> // k _. by rewrite !mxE !mxtens_indexK mulrCA !mulrA [C _ _ * A _ _]mulrC. Qed. (* Todo : move to div ? *) Lemma eq_addl_mul q q' m m' d : m < d -> m' < d -> (q * d + m == q' * d + m')%N = ((q, m) == (q', m')). Proof. move=> lt_md lt_m'd; apply/eqP/eqP; last by move=> [-> ->]. by move=> /(f_equal (edivn^~ d)); rewrite !edivn_eq. Qed. Lemma tensmx_unit (R : fieldType) m n (A : 'M[R]_m%N) (B : 'M[R]_n%N) : m != 0%N -> n != 0%N -> A \in unitmx -> B \in unitmx -> (A *t B) \in unitmx. Proof. move: m n A B => [|m] [|n] // A B _ _ uA uB. suff : (A^-1 *t B^-1) *m (A *t B) = 1 by case/mulmx1_unit. rewrite tensmx_mul !mulVmx //; apply/matrixP=> /= i j. rewrite !mxE /=; symmetry; rewrite -natrM -!val_eqE /=. rewrite {1}(divn_eq i n.+1) {1}(divn_eq j n.+1). by rewrite eq_addl_mul ?ltn_mod // xpair_eqE mulnb. Qed. Lemma tens_mx_scalar : forall (R : comRingType) (m n : nat) (c : R) (M : 'M[R]_(m,n)), M *t c%:M = castmx (esym (muln1 _), esym (muln1 _)) (c *: M). Proof. move=> R0 m n c M; apply/matrixP=> i j. case: (mxtens_indexP i)=> i0 i1; case: (mxtens_indexP j)=> j0 j1. rewrite tensmxE [i1]ord1 [j1]ord1 !castmxE !mxE /= mulr1n mulrC. by congr (_ * M _ _); apply: val_inj=> /=; rewrite muln1 addn0. Qed. Lemma tensmx_decr : forall (R : comRingType) m n (M :'M[R]_m) (N : 'M[R]_n), M *t N = (M *t 1%:M) *m (1%:M *t N). Proof. by move=> R0 m n M N; rewrite tensmx_mul mul1mx mulmx1. Qed. Lemma tensmx_decl : forall (R : comRingType) m n (M :'M[R]_m) (N : 'M[R]_n), M *t N = (1%:M *t N) *m (M *t 1%:M). Proof. by move=> R0 m n M N; rewrite tensmx_mul mul1mx mulmx1. Qed. End Misc. real-closed-2.0.2/theories/ordered_qelim.v000066400000000000000000001371601472566273500205620ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From HB Require Import structures. From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq div. From mathcomp Require Import choice fintype bigop finset order fingroup. From mathcomp Require Import ssralg zmodp poly ssrnum. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Local Open Scope ring_scope. Import GRing. Reserved Notation "p <% q" (at level 70, no associativity). Reserved Notation "p <=% q" (at level 70, no associativity). (* Set Printing Width 30. *) Module ord. Section Formulas. Variable T : Type. Inductive formula : Type := | Bool of bool | Equal of (term T) & (term T) | Lt of (term T) & (term T) | Le of (term T) & (term T) | Unit of (term T) | And of formula & formula | Or of formula & formula | Implies of formula & formula | Not of formula | Exists of nat & formula | Forall of nat & formula. End Formulas. Fixpoint term_eq (T : eqType)(t1 t2 : term T) := match t1, t2 with | Var n1, Var n2 => n1 == n2 | Const r1, Const r2 => r1 == r2 | NatConst n1, NatConst n2 => n1 == n2 | Add r1 s1, Add r2 s2 => (term_eq r1 r2) && (term_eq s1 s2) | Opp r1, Opp r2 => term_eq r1 r2 | NatMul r1 n1, NatMul r2 n2 => (term_eq r1 r2) && (n1 == n2) | Mul r1 s1, Mul r2 s2 => (term_eq r1 r2) && (term_eq s1 s2) | Inv r1, Inv r2 => term_eq r1 r2 | Exp r1 n1, Exp r2 n2 => (term_eq r1 r2) && (n1 == n2) |_, _ => false end. Lemma term_eqP (T : eqType) : Equality.axiom (@term_eq T). Proof. move=> t1 t2; apply: (iffP idP) => [|<-]; last first. by elim: t1 {t2} => //= t -> // n; rewrite eqxx. elim: t1 t2. - by move=> n1 /= [] // n2 /eqP ->. - by move=> r1 /= [] // r2 /eqP ->. - by move=> n1 /= [] // n2 /eqP ->. - by move=> r1 hr1 r2 hr2 [] //= s1 s2 /andP [] /hr1 -> /hr2 ->. - by move=> r1 hr1 [] //= s1 /hr1 ->. - by move=> s1 hs1 n1 [] //= s2 n2 /andP [] /hs1 -> /eqP ->. - by move=> r1 hr1 r2 hr2 [] //= s1 s2 /andP [] /hr1 -> /hr2 ->. - by move=> r1 hr1 [] //= s1 /hr1 ->. - by move=> s1 hs1 n1 [] //= s2 n2 /andP [] /hs1 -> /eqP ->. Qed. HB.instance Definition _ (T : eqType) := hasDecEq.Build (term T) (@term_eqP T). Arguments term_eqP T {x y}. Prenex Implicits term_eq. Declare Scope oterm_scope. Bind Scope oterm_scope with term. Bind Scope oterm_scope with formula. Delimit Scope oterm_scope with oT. Arguments Add _ _%oT _%oT. Arguments Opp _ _%oT. Arguments NatMul _ _%oT _%N. Arguments Mul _ _%oT _%oT. Arguments Mul _ _%oT _%oT. Arguments Inv _ _%oT. Arguments Exp _ _%oT _%N. Arguments Equal _ _%oT _%oT. Arguments Unit _ _%oT. Arguments And _ _%oT _%oT. Arguments Or _ _%oT _%oT. Arguments Implies _ _%oT _%oT. Arguments Not _ _%oT. Arguments Exists _ _%N _%oT. Arguments Forall _ _%N _%oT. Arguments Bool [T]. Prenex Implicits Const Add Opp NatMul Mul Exp Bool Unit And Or Implies Not. Prenex Implicits Exists Forall Lt. Notation True := (Bool true). Notation False := (Bool false). Notation "''X_' i" := (Var _ i) : oterm_scope. Notation "n %:R" := (NatConst _ n) : oterm_scope. Notation "x %:T" := (Const x) : oterm_scope. Notation "0" := 0%:R%oT : oterm_scope. Notation "1" := 1%:R%oT : oterm_scope. Infix "+" := Add : oterm_scope. Notation "- t" := (Opp t) : oterm_scope. Notation "t - u" := (Add t (- u)) : oterm_scope. Infix "*" := Mul : oterm_scope. Infix "*+" := NatMul : oterm_scope. Notation "t ^-1" := (Inv t) : oterm_scope. Notation "t / u" := (Mul t u^-1) : oterm_scope. Infix "^+" := Exp : oterm_scope. Notation "t ^- n" := (t^-1 ^+ n)%oT : oterm_scope. Infix "==" := Equal : oterm_scope. Infix "<%" := Lt : oterm_scope. Infix "<=%" := Le : oterm_scope. Infix "/\" := And : oterm_scope. Infix "\/" := Or : oterm_scope. Infix "==>" := Implies : oterm_scope. Notation "~ f" := (Not f) : oterm_scope. Notation "x != y" := (Not (x == y)) : oterm_scope. Notation "''exists' ''X_' i , f" := (Exists i f) : oterm_scope. Notation "''forall' ''X_' i , f" := (Forall i f) : oterm_scope. Section Substitution. Variable T : Type. Fixpoint fsubst (f : formula T) (s : nat * term T) := match f with | Bool _ => f | (t1 == t2) => (tsubst t1 s == tsubst t2 s) | (t1 <% t2) => (tsubst t1 s <% tsubst t2 s) | (t1 <=% t2) => (tsubst t1 s <=% tsubst t2 s) | (Unit t1) => Unit (tsubst t1 s) | (f1 /\ f2) => (fsubst f1 s /\ fsubst f2 s) | (f1 \/ f2) => (fsubst f1 s \/ fsubst f2 s) | (f1 ==> f2) => (fsubst f1 s ==> fsubst f2 s) | (~ f1) => (~ fsubst f1 s) | ('exists 'X_i, f1) => ('exists 'X_i, if i == s.1 then f1 else fsubst f1 s) | ('forall 'X_i, f1) => ('forall 'X_i, if i == s.1 then f1 else fsubst f1 s) end%oT. End Substitution. Section OrderedClause. Inductive oclause (R : Type) : Type := Oclause : seq (term R) -> seq (term R) -> seq (term R) -> seq (term R) -> oclause R. Definition eq_of_oclause (R : Type)(x : oclause R) := let: Oclause y _ _ _ := x in y. Definition neq_of_oclause (R : Type)(x : oclause R) := let: Oclause _ y _ _ := x in y. Definition lt_of_oclause (R : Type) (x : oclause R) := let: Oclause _ _ y _ := x in y. Definition le_of_oclause (R : Type) (x : oclause R) := let: Oclause _ _ _ y := x in y. End OrderedClause. Declare Scope oclause_scope. Delimit Scope oclause_scope with OCLAUSE. Open Scope oclause_scope. (* TODO: add `at level 1, left associativity` when dropping the support for Coq 8.19 *) Notation "p .1" := (@eq_of_oclause _ p) (format "p .1") : oclause_scope. Notation "p .2" := (@neq_of_oclause _ p) (format "p .2") : oclause_scope. Notation "p .3" := (@lt_of_oclause _ p) (at level 1, left associativity, format "p .3") : oclause_scope. Notation "p .4" := (@le_of_oclause _ p) (at level 1, left associativity, format "p .4") : oclause_scope. Definition oclause_eq (T : eqType)(t1 t2 : oclause T) := let: Oclause eq_l1 neq_l1 lt_l1 leq_l1 := t1 in let: Oclause eq_l2 neq_l2 lt_l2 leq_l2 := t2 in [&& eq_l1 == eq_l2, neq_l1 == neq_l2, lt_l1 == lt_l2 & leq_l1 == leq_l2]. Lemma oclause_eqP (T : eqType) : Equality.axiom (@oclause_eq T). Proof. move=> t1 t2; apply: (iffP idP) => [|<-] /=; last first. by rewrite /oclause_eq; case: t1=> l1 l2 l3 l4; rewrite !eqxx. case: t1 => [l1 l2 l3 l4]; case: t2 => m1 m2 m3 m4 /=; case/and4P. by move/eqP=> -> /eqP -> /eqP -> /eqP ->. Qed. HB.instance Definition _ (T : eqType) := hasDecEq.Build (oclause T) (@oclause_eqP T). Arguments oclause_eqP T {x y}. Prenex Implicits oclause_eq. Section EvalTerm. Variable R : realDomainType. (* Evaluation of a reified formula *) Fixpoint holds (e : seq R) (f : ord.formula R) {struct f} : Prop := match f with | Bool b => b | (t1 == t2)%oT => eval e t1 = eval e t2 | (t1 <% t2)%oT => eval e t1 < eval e t2 | (t1 <=% t2)%oT => eval e t1 <= eval e t2 | Unit t1 => eval e t1 \in unit | (f1 /\ f2)%oT => holds e f1 /\ holds e f2 | (f1 \/ f2)%oT => holds e f1 \/ holds e f2 | (f1 ==> f2)%oT => holds e f1 -> holds e f2 | (~ f1)%oT => ~ holds e f1 | ('exists 'X_i, f1)%oT => exists x, holds (set_nth 0 e i x) f1 | ('forall 'X_i, f1)%oT => forall x, holds (set_nth 0 e i x) f1 end. (* Extensionality of formula evaluation *) Lemma eq_holds e e' f : same_env e e' -> holds e f -> holds e' f. Proof. pose sv := set_nth (0 : R). have eq_i i v e1 e2: same_env e1 e2 -> same_env (sv e1 i v) (sv e2 i v). by move=> eq_e j; rewrite !nth_set_nth /= eq_e. elim: f e e' => //=. - by move=> t1 t2 e e' eq_e; rewrite !(eq_eval _ eq_e). - by move=> t1 t2 e e' eq_e; rewrite !(eq_eval _ eq_e). - by move=> t1 t2 e e' eq_e; rewrite !(eq_eval _ eq_e). - by move=> t e e' eq_e; rewrite (eq_eval _ eq_e). - by move=> f1 IH1 f2 IH2 e e' eq_e; move/IH2: (eq_e); move/IH1: eq_e; tauto. - by move=> f1 IH1 f2 IH2 e e' eq_e; move/IH2: (eq_e); move/IH1: eq_e; tauto. - by move=> f1 IH1 f2 IH2 e e' eq_e f12; move/IH1: (same_env_sym eq_e); eauto. - by move=> f1 IH1 e e'; move/same_env_sym; move/IH1; tauto. - by move=> i f1 IH1 e e'; move/(eq_i i)=> eq_e [x f_ex]; exists x; eauto. by move=> i f1 IH1 e e'; move/(eq_i i); eauto. Qed. (* Evaluation and substitution by a constant *) Lemma holds_fsubst e f i v : holds e (fsubst f (i, v%:T)%T) <-> holds (set_nth 0 e i v) f. Proof. elim: f e => //=; do [ by move=> *; rewrite !eval_tsubst | move=> f1 IHf1 f2 IHf2 e; move: (IHf1 e) (IHf2 e); tauto | move=> f IHf e; move: (IHf e); tauto | move=> j f IHf e]. - case eq_ji: (j == i); first rewrite (eqP eq_ji). by split=> [] [x f_x]; exists x; rewrite set_set_nth eqxx in f_x *. split=> [] [x f_x]; exists x; move: f_x; rewrite set_set_nth eq_sym eq_ji; have:= IHf (set_nth 0 e j x); tauto. case eq_ji: (j == i); first rewrite (eqP eq_ji). by split=> [] f_ x; move: (f_ x); rewrite set_set_nth eqxx. split=> [] f_ x; move: (IHf (set_nth 0 e j x)) (f_ x); by rewrite set_set_nth eq_sym eq_ji; tauto. Qed. (* Boolean test selecting formulas in the theory of rings *) Fixpoint rformula (f : formula R) := match f with | Bool _ => true | t1 == t2 => rterm t1 && rterm t2 | t1 <% t2 => rterm t1 && rterm t2 | t1 <=% t2 => rterm t1 && rterm t2 | Unit t1 => false | (f1 /\ f2) | (f1 \/ f2) | (f1 ==> f2) => rformula f1 && rformula f2 | (~ f1) | ('exists 'X__, f1) | ('forall 'X__, f1) => rformula f1 end%oT. (* An oformula stating that t1 is equal to 0 in the ring theory. *) Definition eq0_rform t1 := let m := @ub_var R t1 in let: (t1', r1) := to_rterm t1 [::] m in let fix loop r i := match r with | [::] => t1' == 0 | t :: r' => let f := ('X_i * t == 1 /\ t * 'X_i == 1) in 'forall 'X_i, (f \/ 'X_i == t /\ ~ ('exists 'X_i, f)) ==> loop r' i.+1 end%oT in loop r1 m. (* An oformula stating that t1 is less than 0 in the equational ring theory. Definition leq0_rform t1 := let m := @ub_var R t1 in let: (t1', r1) := to_rterm t1 [::] m in let fix loop r i := match r with | [::] => 'exists 'X_m.+1, t1' == 'X_m.+1 * 'X_m.+1 | t :: r' => let f := ('X_i * t == 1 /\ t * 'X_i == 1) in 'forall 'X_i, (f \/ 'X_i == t /\ ~ ('exists 'X_i, f)) ==> loop r' i.+1 end%oT in loop r1 m. *) Definition leq0_rform t1 := let m := @ub_var R t1 in let: (t1', r1) := to_rterm t1 [::] m in let fix loop r i := match r with | [::] => t1' <=% 0 | t :: r' => let f := ('X_i * t == 1 /\ t * 'X_i == 1) in 'forall 'X_i, (f \/ 'X_i == t /\ ~ ('exists 'X_i, f)) ==> loop r' i.+1 end%oT in loop r1 m. (* Definition lt0_rform t1 := *) (* let m := @ub_var R t1 in *) (* let: (t1', r1) := to_rterm t1 [::] m in *) (* let fix loop r i := match r with *) (* | [::] => 'exists 'X_m.+1, (t1' == 'X_m.+1 * 'X_m.+1 /\ ~ ('X_m.+1 == 0)) *) (* | t :: r' => *) (* let f := ('X_i * t == 1 /\ t * 'X_i == 1) in *) (* 'forall 'X_i, (f \/ 'X_i == t /\ ~ ('exists 'X_i, f)) ==> loop r' i.+1 *) (* end%oT *) (* in loop r1 m. *) Definition lt0_rform t1 := let m := @ub_var R t1 in let: (t1', r1) := to_rterm t1 [::] m in let fix loop r i := match r with | [::] => t1' <% 0 | t :: r' => let f := ('X_i * t == 1 /\ t * 'X_i == 1) in 'forall 'X_i, (f \/ 'X_i == t /\ ~ ('exists 'X_i, f)) ==> loop r' i.+1 end%oT in loop r1 m. (* Transformation of a formula in the theory of rings with units into an *) (* equivalent formula in the sub-theory of rings. *) Fixpoint to_rform f := match f with | Bool b => f | t1 == t2 => eq0_rform (t1 - t2) | t1 <% t2 => lt0_rform (t1 - t2) | t1 <=% t2 => leq0_rform (t1 - t2) | Unit t1 => eq0_rform (t1 * t1^-1 - 1) | f1 /\ f2 => to_rform f1 /\ to_rform f2 | f1 \/ f2 => to_rform f1 \/ to_rform f2 | f1 ==> f2 => to_rform f1 ==> to_rform f2 | ~ f1 => ~ to_rform f1 | ('exists 'X_i, f1) => 'exists 'X_i, to_rform f1 | ('forall 'X_i, f1) => 'forall 'X_i, to_rform f1 end%oT. (* The transformation gives a ring formula. *) (* the last part of the proof consists in 3 cases that are exactly the same. how to factorize ? *) Lemma to_rform_rformula f : rformula (to_rform f). Proof. suffices [h1 h2 h3]: [/\ forall t1, rformula (eq0_rform t1), forall t1, rformula (lt0_rform t1) & forall t1, rformula (leq0_rform t1)]. by elim: f => //= => f1 ->. split=> t1. - rewrite /eq0_rform; move: (ub_var t1) => m. set tr := _ m. suffices: all (@rterm R) (tr.1 :: tr.2)%PAIR. case: tr => {}t1 r /= /andP[t1_r]. by elim: r m => [|t r IHr] m; rewrite /= ?andbT // => /andP[->]; apply: IHr. have: all (@rterm R) [::] by []. rewrite {}/tr; elim: t1 [::] => //=. + move=> t1 IHt1 t2 IHt2 r. move/IHt1; case: to_rterm => {r IHt1}t1 r /= /andP[t1_r]. move/IHt2; case: to_rterm => {r IHt2}t2 r /= /andP[t2_r]. by rewrite t1_r t2_r. + by move=> t1 IHt1 r /IHt1; case: to_rterm. + by move=> t1 IHt1 n r /IHt1; case: to_rterm. + move=> t1 IHt1 t2 IHt2 r. move/IHt1; case: to_rterm => {r IHt1}t1 r /= /andP[t1_r]. move/IHt2; case: to_rterm => {r IHt2}t2 r /= /andP[t2_r]. by rewrite t1_r t2_r. + move=> t1 IHt1 r. by move/IHt1; case: to_rterm => {r IHt1}t1 r /=; rewrite all_rcons. + by move=> t1 IHt1 n r /IHt1; case: to_rterm. - rewrite /lt0_rform; move: (ub_var t1) => m; set tr := _ m. suffices: all (@rterm R) (tr.1 :: tr.2)%PAIR. case: tr => {}t1 r /= /andP[t1_r]. by elim: r m => [|t r IHr] m; rewrite /= ?andbT // => /andP[->]; apply: IHr. have: all (@rterm R) [::] by []. rewrite {}/tr; elim: t1 [::] => //=. + move=> t1 IHt1 t2 IHt2 r. move/IHt1; case: to_rterm => {r IHt1}t1 r /= /andP[t1_r]. move/IHt2; case: to_rterm => {r IHt2}t2 r /= /andP[t2_r]. by rewrite t1_r t2_r. + by move=> t1 IHt1 r /IHt1; case: to_rterm. + by move=> t1 IHt1 n r /IHt1; case: to_rterm. + move=> t1 IHt1 t2 IHt2 r. move/IHt1; case: to_rterm => {r IHt1}t1 r /= /andP[t1_r]. move/IHt2; case: to_rterm => {r IHt2}t2 r /= /andP[t2_r]. by rewrite t1_r t2_r. + move=> t1 IHt1 r. by move/IHt1; case: to_rterm => {r IHt1}t1 r /=; rewrite all_rcons. + by move=> t1 IHt1 n r /IHt1; case: to_rterm. - rewrite /leq0_rform; move: (ub_var t1) => m; set tr := _ m. suffices: all (@rterm R) (tr.1 :: tr.2)%PAIR. case: tr => {}t1 r /= /andP[t1_r]. by elim: r m => [|t r IHr] m; rewrite /= ?andbT // => /andP[->]; apply: IHr. have: all (@rterm R) [::] by []. rewrite {}/tr; elim: t1 [::] => //=. + move=> t1 IHt1 t2 IHt2 r. move/IHt1; case: to_rterm => {r IHt1}t1 r /= /andP[t1_r]. move/IHt2; case: to_rterm => {r IHt2}t2 r /= /andP[t2_r]. by rewrite t1_r t2_r. + by move=> t1 IHt1 r /IHt1; case: to_rterm. + by move=> t1 IHt1 n r /IHt1; case: to_rterm. + move=> t1 IHt1 t2 IHt2 r. move/IHt1; case: to_rterm => {r IHt1}t1 r /= /andP[t1_r]. move/IHt2; case: to_rterm => {r IHt2}t2 r /= /andP[t2_r]. by rewrite t1_r t2_r. + move=> t1 IHt1 r. by move/IHt1; case: to_rterm => {r IHt1}t1 r /=; rewrite all_rcons. + by move=> t1 IHt1 n r /IHt1; case: to_rterm. Qed. Import Order.TTheory Num.Theory. (* Correctness of the transformation. *) Lemma to_rformP e f : holds e (to_rform f) <-> holds e f. Proof. suffices{e f} [equal0_equiv lt0_equiv le0_equiv]: [/\ forall e t1 t2, holds e (eq0_rform (t1 - t2)) <-> (eval e t1 == eval e t2), forall e t1 t2, holds e (lt0_rform (t1 - t2)) <-> (eval e t1 < eval e t2) & forall e t1 t2, holds e (leq0_rform (t1 - t2)) <-> (eval e t1 <= eval e t2)]. - elim: f e => /=; try tauto. + move=> t1 t2 e. by split; [move/equal0_equiv/eqP | move/eqP/equal0_equiv]. + by move=> t1 t2 e; split; move/lt0_equiv. + by move=> t1 t2 e; split; move/le0_equiv. + by move=> t1 e; rewrite unitrE; apply: equal0_equiv. + by move=> f1 IHf1 f2 IHf2 e; move: (IHf1 e) (IHf2 e); tauto. + by move=> f1 IHf1 f2 IHf2 e; move: (IHf1 e) (IHf2 e); tauto. + by move=> f1 IHf1 f2 IHf2 e; move: (IHf1 e) (IHf2 e); tauto. + by move=> f1 IHf1 e; move: (IHf1 e); tauto. + by move=> n f1 IHf1 e; split=> [] [x] /IHf1; exists x. + by move=> n f1 IHf1 e; split=> Hx x; apply/IHf1. suffices h e t1 t2 : [/\ holds e (eq0_rform (t1 - t2)) <-> (eval e t1 == eval e t2), holds e (lt0_rform (t1 - t2)) <-> (eval e t1 < eval e t2) & holds e (leq0_rform (t1 - t2)) <-> (eval e t1 <= eval e t2)]. by split => e t1 t2; case: (h e t1 t2). rewrite -{1}(add0r (eval e t2)) -(can2_eq (subrK _) (addrK _)). rewrite -subr_lt0 -subr_le0 -/(eval e (t1 - t2)); move: {t1 t2}(t1 - t2)%T => t. have sub_var_tsubst s t0: (s.1%PAIR >= ub_var t0)%N -> tsubst t0 s = t0. elim: t0 {t} => //=. - by move=> n; case: ltngtP. - by move=> t1 IHt1 t2 IHt2; rewrite geq_max => /andP[/IHt1-> /IHt2->]. - by move=> t1 IHt1 /IHt1->. - by move=> t1 IHt1 n /IHt1->. - by move=> t1 IHt1 t2 IHt2; rewrite geq_max => /andP[/IHt1-> /IHt2->]. - by move=> t1 IHt1 /IHt1->. - by move=> t1 IHt1 n /IHt1->. pose fix rsub t' m r : term R := if r is u :: r' then tsubst (rsub t' m.+1 r') (m, u^-1)%T else t'. pose fix ub_sub m r : Prop := if r is u :: r' then (ub_var u <= m)%N /\ ub_sub m.+1 r' else true. suffices{t} rsub_to_r t r0 m: (m >= ub_var t)%N -> ub_sub _ m r0 -> let: (t', r) := to_rterm t r0 m in [/\ take (size r0) r = r0, ub_var t' <= m + size r, ub_sub _ m r & rsub t' m r = t]%N. - have:= rsub_to_r t [::] _ (leqnn _); rewrite /eq0_rform /lt0_rform /leq0_rform. case: (to_rterm _ _ _) => [t1' r1] /= [//| _ _ ub_r1 def_t]. rewrite -{2 4 6}def_t {def_t}. elim: r1 (ub_var t) e ub_r1 => [|u r1 IHr1] m e /= => [_|[ub_u ub_r1]]. by split => //; split=> /eqP. rewrite eval_tsubst /=; set y := eval e u; split; split => //= t_h0. + case: (IHr1 m.+1 (set_nth 0 e m y^-1) ub_r1) => h _ _; apply/h. apply: t_h0. rewrite nth_set_nth /= eqxx -(eval_tsubst e u (m, Const _)). rewrite sub_var_tsubst //= -/y. case Uy: (y \in unit); [left | right]; first by rewrite mulVr ?divrr. split=> [|[z]]; first by rewrite invr_out ?Uy. rewrite nth_set_nth /= eqxx. rewrite -!(eval_tsubst _ _ (m, Const _)) !sub_var_tsubst // -/y => yz1. by case/unitrP: Uy; exists z. + move=> x def_x. case: (IHr1 m.+1 (set_nth 0 e m x) ub_r1) => h _ _. apply/h. suff ->: x = y^-1 by []; move: def_x. rewrite nth_set_nth /= eqxx -(eval_tsubst e u (m, Const _)). rewrite sub_var_tsubst //= -/y; case=> [[xy1 yx1] | [xy nUy]]. by rewrite -[y^-1]mul1r -[1]xy1 mulrK //; apply/unitrP; exists x. rewrite invr_out //; apply/unitrP=> [[z yz1]]; case: nUy; exists z. rewrite nth_set_nth /= eqxx -!(eval_tsubst _ _ (m, _%:T)%T). by rewrite !sub_var_tsubst. + case: (IHr1 m.+1 (set_nth 0 e m y^-1) ub_r1) => _ h _. apply/h. apply: t_h0. rewrite nth_set_nth /= eqxx -(eval_tsubst e u (m, Const _)). rewrite sub_var_tsubst //= -/y. case Uy: (y \in unit); [left | right]; first by rewrite mulVr ?divrr. split=> [|[z]]; first by rewrite invr_out ?Uy. rewrite nth_set_nth /= eqxx. rewrite -!(eval_tsubst _ _ (m, Const _)) !sub_var_tsubst // -/y => yz1. by case/unitrP: Uy; exists z. + move=> x def_x. case: (IHr1 m.+1 (set_nth 0 e m x) ub_r1) => _ h _. apply/h. suff ->: x = y^-1 by []; move: def_x. rewrite nth_set_nth /= eqxx -(eval_tsubst e u (m, Const _)). rewrite sub_var_tsubst //= -/y; case=> [[xy1 yx1] | [xy nUy]]. by rewrite -[y^-1]mul1r -[1]xy1 mulrK //; apply/unitrP; exists x. rewrite invr_out //; apply/unitrP=> [[z yz1]]; case: nUy; exists z. rewrite nth_set_nth /= eqxx -!(eval_tsubst _ _ (m, _%:T)%T). by rewrite !sub_var_tsubst. + case: (IHr1 m.+1 (set_nth 0 e m y^-1) ub_r1) => _ _ h. apply/h. apply: t_h0. rewrite nth_set_nth /= eqxx -(eval_tsubst e u (m, Const _)). rewrite sub_var_tsubst //= -/y. case Uy: (y \in unit); [left | right]; first by rewrite mulVr ?divrr. split=> [|[z]]; first by rewrite invr_out ?Uy. rewrite nth_set_nth /= eqxx. rewrite -!(eval_tsubst _ _ (m, Const _)) !sub_var_tsubst // -/y => yz1. by case/unitrP: Uy; exists z. + move=> x def_x. case: (IHr1 m.+1 (set_nth 0 e m x) ub_r1) => _ _ h. apply/h. suff ->: x = y^-1 by []; move: def_x. rewrite nth_set_nth /= eqxx -(eval_tsubst e u (m, Const _)). rewrite sub_var_tsubst //= -/y; case=> [[xy1 yx1] | [xy nUy]]. by rewrite -[y^-1]mul1r -[1]xy1 mulrK //; apply/unitrP; exists x. rewrite invr_out //; apply/unitrP=> [[z yz1]]; case: nUy; exists z. rewrite nth_set_nth /= eqxx -!(eval_tsubst _ _ (m, _%:T)%T). by rewrite !sub_var_tsubst. have rsub_id r t0 n: (ub_var t0 <= n)%N -> rsub t0 n r = t0. by elim: r n => //= t1 r IHr n let0n; rewrite IHr ?sub_var_tsubst ?leqW. have rsub_acc r s t1 m1: (ub_var t1 <= m1 + size r)%N -> rsub t1 m1 (r ++ s) = rsub t1 m1 r. elim: r t1 m1 => [|t1 r IHr] t2 m1 /=; first by rewrite addn0; apply: rsub_id. by move=> letmr; rewrite IHr ?addSnnS. elim: t r0 m => /=; try do [ by move=> n r m hlt hub; rewrite take_size (ltn_addr _ hlt) rsub_id | by move=> n r m hlt hub; rewrite leq0n take_size rsub_id | move=> t1 IHt1 t2 IHt2 r m; rewrite geq_max; case/andP=> hub1 hub2 hmr; case: to_rterm {IHt1 hub1 hmr}(IHt1 r m hub1 hmr) => t1' r1; case=> htake1 hub1' hsub1 <-; case: to_rterm {IHt2 hub2 hsub1}(IHt2 r1 m hub2 hsub1) => t2' r2 /=; rewrite geq_max; case=> htake2 -> hsub2 /= <-; rewrite -{1 2}(cat_take_drop (size r1) r2) htake2; set r3 := drop _ _; rewrite size_cat addnA (leq_trans _ (leq_addr _ _)) //; split=> {hsub2}//; first by [rewrite takel_cat // -htake1 size_take geq_minr]; rewrite -(rsub_acc r1 r3 t1') {hub1'}// -{htake1}htake2 {r3}cat_take_drop; by elim: r2 m => //= u r2 IHr2 m; rewrite IHr2 | do [ move=> t1 IHt1 r m; do 2!move/IHt1=> {}IHt1 | move=> t1 IHt1 n r m; do 2!move/IHt1=> {}IHt1]; case: to_rterm IHt1 => t1' r1 [-> -> hsub1 <-]; split=> {hsub1}//; by elim: r1 m => //= u r1 IHr1 m; rewrite IHr1]. move=> t1 IH r m letm /IH {IH} /(_ letm) {letm}. case: to_rterm => t1' r1 /= [def_r ub_t1' ub_r1 <-]. rewrite size_rcons addnS leqnn -{1}cats1 takel_cat ?def_r; last first. by rewrite -def_r size_take geq_minr. elim: r1 m ub_r1 ub_t1' {def_r} => /= [|u r1 IHr1] m => [_|[->]]. by rewrite addn0 eqxx. by rewrite -addSnnS => /IHr1 IH /IH[_ _ ub_r1 ->]. Qed. (* The above proof is ugly but is in fact copypaste *) (* Boolean test selecting formulas which describe a constructible set, *) (* i.e. formulas without quantifiers. *) (* The quantifier elimination check. *) Fixpoint qf_form (f : formula R) := match f with | Bool _ | _ == _ | Unit _ | Lt _ _ | Le _ _ => true | f1 /\ f2 | f1 \/ f2 | f1 ==> f2 => qf_form f1 && qf_form f2 | ~ f1 => qf_form f1 | _ => false end%oT. (* Boolean holds predicate for quantifier free formulas *) Definition qf_eval e := fix loop (f : formula R) : bool := match f with | Bool b => b | t1 == t2 => (eval e t1 == eval e t2)%bool | t1 <% t2 => (eval e t1 < eval e t2)%bool | t1 <=% t2 => (eval e t1 <= eval e t2)%bool | Unit t1 => eval e t1 \in unit | f1 /\ f2 => loop f1 && loop f2 | f1 \/ f2 => loop f1 || loop f2 | f1 ==> f2 => (loop f1 ==> loop f2)%bool | ~ f1 => ~~ loop f1 |_ => false end%oT. (* qf_eval is equivalent to holds *) Lemma qf_evalP e f : qf_form f -> reflect (holds e f) (qf_eval e f). Proof. elim: f => //=; try by move=> *; apply: idP. - by move=> t1 t2 _; apply: eqP. - move=> f1 IHf1 f2 IHf2 /= /andP[/IHf1[] f1T]; last by right; case. by case/IHf2; [left | right; case]. - move=> f1 IHf1 f2 IHf2 /= /andP[/IHf1[] f1F]; first by do 2 left. by case/IHf2; [left; right | right; case]. - move=> f1 IHf1 f2 IHf2 /= /andP[/IHf1[] f1T]; last by left. by case/IHf2; [left | right; move/(_ f1T)]. by move=> f1 IHf1 /IHf1[]; [right | left]. Qed. (* Quantifier-free formula are normalized into DNF. A DNF is *) (* represented by the type seq (seq (term R) * seq (term R)), where we *) (* separate positive and negative literals *) (* DNF preserving conjunction *) Definition and_odnf (bcs1 bcs2 : seq (oclause R)) := \big[cat/nil]_(bc1 <- bcs1) map (fun bc2 : oclause R => (Oclause (bc1.1 ++ bc2.1) (bc1.2 ++ bc2.2) (bc1.3 ++ bc2.3) (bc1.4 ++ bc2.4)))%OCLAUSE bcs2. (* Computes a DNF from a qf ring formula *) Fixpoint qf_to_odnf (f : formula R) (neg : bool) {struct f} : seq (oclause R) := match f with | Bool b => if b (+) neg then [:: (Oclause [::] [::] [::] [::])] else [::] | t1 == t2 => [:: if neg then (Oclause [::] [:: t1 - t2] [::] [::]) else (Oclause [:: t1 - t2] [::] [::] [::])] | t1 <% t2 => [:: if neg then (Oclause [::] [::] [::] [:: t1 - t2]) else (Oclause [::] [::] [:: t2 - t1] [::])] | t1 <=% t2 => [:: if neg then (Oclause [::] [::] [:: t1 - t2] [::]) else (Oclause [::] [::] [::] [:: t2 - t1])] | f1 /\ f2 => (if neg then cat else and_odnf) [rec f1, neg] [rec f2, neg] | f1 \/ f2 => (if neg then and_odnf else cat) [rec f1, neg] [rec f2, neg] | f1 ==> f2 => (if neg then and_odnf else cat) [rec f1, ~~ neg] [rec f2, neg] | ~ f1 => [rec f1, ~~ neg] | _ => if neg then [:: (Oclause [::] [::] [::] [::])] else [::] end%oT where "[ 'rec' f , neg ]" := (qf_to_odnf f neg). (* Conversely, transforms a DNF into a formula *) Definition odnf_to_oform := let pos_lit t := And (t == 0)%oT in let neg_lit t := And (t != 0)%oT in let lt_lit t := And (0 <% t)%oT in let le_lit t := And (0 <=% t)%oT in let ocls (bc : oclause R) := Or (foldr pos_lit True bc.1 /\ foldr neg_lit True bc.2 /\ foldr lt_lit True bc.3 /\ foldr le_lit True bc.4) in foldr ocls False. (* Catenation of dnf is the Or of formulas *) Lemma cat_dnfP e bcs1 bcs2 : qf_eval e (odnf_to_oform (bcs1 ++ bcs2)) = qf_eval e (odnf_to_oform bcs1 \/ odnf_to_oform bcs2). Proof. by elim: bcs1 => //= bc1 bcs1 IH1; rewrite -orbA; congr orb; rewrite IH1. Qed. (* and_dnf is the And of formulas *) Lemma and_odnfP e bcs1 bcs2 : qf_eval e (odnf_to_oform (and_odnf bcs1 bcs2)) = qf_eval e (odnf_to_oform bcs1 /\ odnf_to_oform bcs2). Proof. elim: bcs1 => [|bc1 bcs1 IH1] /=; first by rewrite /and_odnf big_nil. rewrite /and_odnf big_cons -/(and_odnf bcs1 bcs2) cat_dnfP /=. rewrite {}IH1 /= andb_orl; congr orb. elim: bcs2 bc1 {bcs1} => [|bc2 bcs2 IH] bc1 /=; first by rewrite andbF. rewrite {}IH /= andb_orr; congr orb => {bcs2}. suffices aux (l1 l2 : seq (term R)) g : let redg := foldr (And \o g) True in qf_eval e (redg (l1 ++ l2)) = qf_eval e (redg l1 /\ redg l2)%oT. + rewrite !aux /= !andbA; congr (_ && _); rewrite -!andbA; congr (_ && _). rewrite -andbCA; congr (_ && _); bool_congr; rewrite andbCA; bool_congr. by rewrite andbA andbC !andbA. by elim: l1 => [| t1 l1 IHl1] //=; rewrite -andbA IHl1. Qed. Lemma qf_to_dnfP e : let qev f b := qf_eval e (odnf_to_oform (qf_to_odnf f b)) in forall f, qf_form f && rformula f -> qev f false = qf_eval e f. Proof. move=> qev; have qevT f: qev f true = ~~ qev f false. rewrite {}/qev; elim: f => //=; do [by case | move=> f1 IH1 f2 IH2 | ]. - by move=> t1 t2; rewrite !andbT !orbF. - by move=> t1 t2; rewrite !andbT !orbF; rewrite !subr_gte0 -leNgt. - by move=> t1 t2; rewrite !andbT !orbF; rewrite !subr_gte0 -ltNge. - by rewrite and_odnfP cat_dnfP negb_and -IH1 -IH2. - by rewrite and_odnfP cat_dnfP negb_or -IH1 -IH2. - by rewrite and_odnfP cat_dnfP /= negb_or IH1 -IH2 negbK. by move=> t1 ->; rewrite negbK. rewrite /qev; elim=> //=; first by case. - by move=> t1 t2 _; rewrite subr_eq0 !andbT orbF. - by move=> t1 t2 _; rewrite orbF !andbT subr_gte0. - by move=> t1 t2 _; rewrite orbF !andbT subr_gte0. - move=> f1 IH1 f2 IH2; rewrite andbCA -andbA andbCA andbA; case/andP. by rewrite and_odnfP /= => /IH1-> /IH2->. - move=> f1 IH1 f2 IH2; rewrite andbCA -andbA andbCA andbA; case/andP. by rewrite cat_dnfP /= => /IH1-> => /IH2->. - move=> f1 IH1 f2 IH2; rewrite andbCA -andbA andbCA andbA; case/andP. by rewrite cat_dnfP /= [qf_eval _ _]qevT -implybE => /IH1 <- /IH2->. by move=> f1 IH1 /IH1 <-; rewrite -qevT. Qed. Lemma dnf_to_form_qf bcs : qf_form (odnf_to_oform bcs). Proof. elim: bcs => //= [[clT clF] clLt clLe ? ->] /=; elim: clT => //=. by rewrite andbT; elim: clF; elim: clLt => //; elim: clLe. Qed. Definition dnf_rterm (cl : oclause R) := [&& all (@rterm R) cl.1, all (@rterm R) cl.2, all (@rterm R) cl.3 & all (@rterm R) cl.4]. Lemma qf_to_dnf_rterm f b : rformula f -> all dnf_rterm (qf_to_odnf f b). Proof. set ok := all dnf_rterm. have cat_ok bcs1 bcs2: ok bcs1 -> ok bcs2 -> ok (bcs1 ++ bcs2). by move=> ok1 ok2; rewrite [ok _]all_cat; apply/andP. have and_ok bcs1 bcs2: ok bcs1 -> ok bcs2 -> ok (and_odnf bcs1 bcs2). rewrite /and_odnf unlock; elim: bcs1 => //= cl1 bcs1 IH1; rewrite -andbA. case/and3P=> ok11 ok12 ok1 ok2; rewrite cat_ok ?{}IH1 {bcs1 ok1}//. elim: bcs2 ok2 => //= cl2 bcs2 IH2 /andP[ok2 /IH2->]. by rewrite /dnf_rterm /= !all_cat andbT ok11; case/and3P: ok12=> -> -> ->. elim: f b => //=; [ by move=> [] [] | by move=> ? ? []; rewrite /dnf_rterm /= !andbT | by move=> ? ? []; rewrite /dnf_rterm /= !andbT andbC | by move=> ? ? [] /andP[]; rewrite /dnf_rterm/= => -> -> | by move=> f hf g hg [] /andP[/hf ? /hg ?]; auto | by move=> f hf g hg [] /andP[/hf ? /hg ?]; auto | by move=> f hf g hg [] /andP[/hf ? /hg ?]; auto | by move=> ? h [] /= /h | by move=> _ ? ? [] | by move=> _ ? ? [] ]. Qed. Lemma dnf_to_rform bcs : rformula (odnf_to_oform bcs) = all dnf_rterm bcs. Proof. elim: bcs => //= [[cl1 cl2 cl3 cl4] bcs ->]; rewrite {2}/dnf_rterm /=; congr (_ && _). congr andb; first by elim: cl1 => //= t cl ->; rewrite andbT. congr andb; first by elim: cl2 => //= t cl ->; rewrite andbT. congr andb; first by elim: cl3 => //= t cl ->. by elim: cl4 => //= t cl ->. Qed. Implicit Type f : formula R. Fixpoint leq_elim_aux (eq_l lt_l le_l : seq (term R)) := match le_l with [::] => [:: (eq_l, lt_l)] |le1 :: le_l' => let res := leq_elim_aux eq_l lt_l le_l' in let as_eq := map (fun x => (le1 :: x.1%PAIR, x.2%PAIR)) res in let as_lt := map (fun x => (x.1%PAIR, le1 :: x.2%PAIR)) res in as_eq ++ as_lt end. Definition oclause_leq_elim oc : seq (oclause R) := let: Oclause eq_l neq_l lt_l le_l := oc in map (fun x => Oclause x.1%PAIR neq_l x.2%PAIR [::]) (leq_elim_aux eq_l lt_l le_l). Definition terms_of_oclause (oc : oclause R) := let: Oclause eq_l neq_l lt_l le_l := oc in eq_l ++ neq_l ++ lt_l ++ le_l. Lemma terms_of_leq_elim oc1 oc2: oc2 \in (oclause_leq_elim oc1) -> (terms_of_oclause oc2) =i (terms_of_oclause oc1). case: oc1 => eq1 neq1 lt1 leq1 /=. elim: leq1 eq1 lt1 oc2 => [|t1 leq1 ih] eq1 lt1 [eq2 neq2 lt2 leq2] /=. by rewrite inE; case/eqP=> -> -> -> -> ?. rewrite map_cat /= mem_cat -!map_comp; set f := fun _ => _. rewrite -/f in ih; case/orP. case/mapP=> [[y1 y2]] yin ye. move: (ih eq1 lt1 (f (y1, y2))); rewrite mem_map //; last first. by move=> [u1 u2] [v1 v2]; rewrite /f /=; case=> -> ->. move/(_ yin); move: ye; rewrite /f /=; case=> -> -> -> -> /= h. move=> u; rewrite in_cons (h u) !mem_cat in_cons. by rewrite orbC !orbA; set x := _ || (u \in lt1); rewrite orbAC. case/mapP=> [[y1 y2]] yin ye. move: (ih eq1 lt1 (f (y1, y2))); rewrite mem_map //; last first. by move=> [u1 u2] [v1 v2]; rewrite /f /=; case=> -> ->. move/(_ yin); move: ye; rewrite /f /=; case=> -> -> -> -> /= h u. rewrite !mem_cat !in_cons orbA orbCA -!orbA; move: (h u); rewrite !mem_cat=> ->. by rewrite orbC !orbA; set x := _ || (u \in lt1); rewrite orbAC. Qed. Lemma odnf_to_oform_cat e c d : holds e (odnf_to_oform (c ++ d)) <-> holds e ((odnf_to_oform c) \/ (odnf_to_oform d))%oT. Proof. elim: c d => [| tc c ihc] d /=; first by split => // hd; [right | case: hd]. rewrite ihc /=; split. case; first by case=> ?; case=> ?; case=> ? ?; left; left. case; first by move=> ?; left; right. by move=> ?; right. case; last by move=> ?; right; right. case; last by move=> ?; right; left. by do 3!case=> ?; move=> ?; left. Qed. Lemma oclause_leq_elimP oc e : holds e (odnf_to_oform [:: oc]) <-> holds e (odnf_to_oform (oclause_leq_elim oc)). Proof. case: oc => eq_l neq_l lt_l le_l; rewrite /oclause_leq_elim. elim: le_l eq_l neq_l lt_l => [|t le_l ih] eq_l neq_l lt_l //=. move: (ih eq_l neq_l lt_l) => /= {ih}. set x1 := foldr _ _ _; set x2 := foldr _ _ _; set x3 := foldr _ _ _. set x4 := foldr _ _ _ => h. have -> : (holds e x1 /\ holds e x2 /\ holds e x3 /\ 0%:R <= eval e t /\ holds e x4 \/ false) <-> (0%:R <= eval e t) /\ (holds e x1 /\ holds e x2 /\ holds e x3 /\ holds e x4 \/ false). split; first by case=> //; do 4!(case=> ?); move=> ?; split => //; left. by case=> ?; case=> //; do 3!(case=> ?); move=> ?; left. rewrite h {h} /= !map_cat /= -!map_comp. set s1 := [seq _ | _ <- _]; set s2 := [seq _ | _ <- _]. set s3 := [seq _ | _ <- _]. rewrite odnf_to_oform_cat. suff {x1 x2 x3 x4} /= -> : holds e (odnf_to_oform s2) <-> eval e t == 0%:R /\ holds e (odnf_to_oform s1). suff /= -> : holds e (odnf_to_oform s3) <-> 0%:R < eval e t /\ holds e (odnf_to_oform s1). rewrite le_eqVlt eq_sym; split; first by case; case/orP=> -> ?; [left|right]. by case; [case=> -> ? /= |case=> ->; rewrite orbT]. rewrite /s1 /s3. elim: (leq_elim_aux eq_l lt_l le_l) => /= [| t1 l ih]; first by split=> // [[]]. rewrite /= ih; split. case; last by case=> -> ?; split=> //; right. by do 2!case=> ?; case; case=> -> ? _; split => //; auto. by case=> ->; case; [do 3!case=> ?; move=> _; left | right]. rewrite /s2 /s1. elim: (leq_elim_aux eq_l lt_l le_l) => /= [| t1 l ih]; first by split=> // [[]]. rewrite /= ih; split. case; last by case=> -> ?; split=> //; right. by case; case=> /eqP ? ?; do 2!case=> ?; move=> _; split=> //; left. case=> /eqP ?; case; first by do 3!case=> ?; move=> _; left. by right; split=> //; apply/eqP. Qed. Fixpoint neq_elim_aux (lt_l neq_l : seq (term R)) := match neq_l with [::] => [:: lt_l] |neq1 :: neq_l' => let res := neq_elim_aux lt_l neq_l' in let as_pos := map (fun x => neq1 :: x) res in let as_neg := map (fun x => Opp neq1 :: x) res in as_pos ++ as_neg end. Definition oclause_neq_elim oc : seq (oclause R) := let: Oclause eq_l neq_l lt_l le_l := oc in map (fun x => Oclause eq_l [::] x le_l) (neq_elim_aux lt_l neq_l). Lemma terms_of_neq_elim oc1 oc2: oc2 \in (oclause_neq_elim oc1) -> {subset (terms_of_oclause oc2) <= (terms_of_oclause oc1) ++ (map Opp oc1.2)}. Proof. case: oc1 => eq1 neq1 lt1 leq1 /=. elim: neq1 lt1 oc2 => [|t1 neq1 ih] lt1 [eq2 neq2 lt2 leq2] /=. by rewrite inE; case/eqP=> -> -> -> ->; rewrite !cats0 !cat0s. rewrite map_cat /= mem_cat -!map_comp; set f := fun _ => _. rewrite -/f in ih; case/orP. case/mapP=> y yin ye. move: (ih lt1 (f y)); rewrite mem_map //; last first. by move=> u v; rewrite /f /=; case. move/(_ yin); move: ye; rewrite /f /=; case=> -> -> -> -> /= h. move=> u. rewrite !mem_cat !in_cons orbAC orbC mem_cat -!orbA. case/orP; first by move->; rewrite !orbT. rewrite !orbA [_ || (_ \in eq1)]orbC; move: (h u); rewrite !mem_cat=> hu. by move/hu; do 2!(case/orP; last by move->; rewrite !orbT); move->. case/mapP=> y yin ye. move: (ih lt1 (f y)); rewrite mem_map //; last first. by move=> u v; rewrite /f /=; case. move/(_ yin); move: ye; rewrite /f /=; case=> -> -> -> -> /= h. move=> u; rewrite !mem_cat !in_cons orbAC orbC mem_cat -!orbA. case/orP; first by move->; rewrite !orbT. rewrite !orbA [_ || (_ \in eq1)]orbC; move: (h u); rewrite !mem_cat=> hu. by move/hu; do 2!(case/orP; last by move->; rewrite !orbT); move->. Qed. Lemma oclause_neq_elimP oc e : holds e (odnf_to_oform [:: oc]) <-> holds e (odnf_to_oform (oclause_neq_elim oc)). Proof. case: oc => eq_l neq_l lt_l le_l; rewrite /oclause_neq_elim. elim: neq_l lt_l => [|t neq_l ih] lt_l //=. move: (ih lt_l) => /= {ih}. set x1 := foldr _ _ _; set x2 := foldr _ _ _; set x3 := foldr _ _ _. set x4 := foldr _ _ _ => h /=. have -> : holds e x1 /\ (eval e t <> 0%:R /\ holds e x2) /\ holds e x3 /\ holds e x4 \/ false <-> (eval e t <> 0%:R) /\ (holds e x1 /\ holds e x2 /\ holds e x3 /\ holds e x4 \/ false). split; case=> //. - by case=> ?; case; case=> ? ? [] ? ?; split=> //; left. - by move=> ?; case=> //; do 3!case=> ?; move=> ?; left. rewrite h {h} /= !map_cat /= -!map_comp. set s1 := [seq _ | _ <- _]; set s2 := [seq _ | _ <- _]. set s3 := [seq _ | _ <- _]; rewrite odnf_to_oform_cat. suff {x1 x2 x3 x4} /= -> : holds e (odnf_to_oform s2) <-> 0%:R < eval e t/\ holds e (odnf_to_oform s1). suff /= -> : holds e (odnf_to_oform s3) <-> 0%:R < - eval e t /\ holds e (odnf_to_oform s1). rewrite oppr_gt0; split. by case; move/eqP; rewrite neq_lt; case/orP=> -> h1; [right | left]. by case; case=> h ?; split=> //; apply/eqP; rewrite neq_lt h ?orbT. rewrite /s1 /s3. elim: (neq_elim_aux lt_l neq_l) => /= [| t1 l ih] /=; first by split => //; case. set y1 := foldr _ _ _; set y2 := foldr _ _ _; set y3 := foldr _ _ _. rewrite ih; split. case; first by case=> ?; case=> _; case; case=> -> ? ?; split=> //; left. by case=> ? ?; split=> //; right. by case=> ->; case; [case=> ?; case=> _; case=> ? ?; left| move=> ?; right]. rewrite /s1 /s2. elim: (neq_elim_aux lt_l neq_l) => /= [| t1 l ih] /=; first by split => //; case. set y1 := foldr _ _ _; set y2 := foldr _ _ _; set y3 := foldr _ _ _. rewrite ih; split. case; first by case=> ? [] _ [] [] ? ? ?; split=> //; left. by case=> ? ?; split=> //; right. case=> ? []; last by right. by case=> ? [] _ [] ? ?; left. Qed. Definition oclause_neq_leq_elim oc := flatten (map oclause_neq_elim (oclause_leq_elim oc)). Lemma terms_of_neq_leq_elim oc1 oc2: oc2 \in (oclause_neq_leq_elim oc1) -> {subset (terms_of_oclause oc2) <= (terms_of_oclause oc1) ++ map Opp oc1.2}. Proof. rewrite /oclause_neq_leq_elim/flatten; rewrite foldr_map. suff : forall oc3, oc3 \in (oclause_leq_elim oc1) -> (terms_of_oclause oc3 =i terms_of_oclause oc1) /\ oc3.2 = oc1.2. elim: (oclause_leq_elim oc1) => [| t l ih] //= h1. rewrite mem_cat; case/orP. - move/terms_of_neq_elim=> h u; move/(h u); rewrite !mem_cat. by case: (h1 t (mem_head _ _)); move/(_ u)=> -> ->. - by move=> h; apply: (ih _ h) => ? loc3; apply: h1; rewrite in_cons loc3 orbT. move=> {oc2} oc3 hoc3; split; first exact: terms_of_leq_elim. case: oc3 hoc3=> eq2 neq2 lt2 leq2 /=; case: oc1=> eq1 neq1 lt1 leq1 /=. elim: leq1 => [| t1 le1 ih] //=; first by rewrite inE; case/eqP=> _ ->. rewrite map_cat mem_cat; move: ih. elim: (leq_elim_aux eq1 lt1 le1) => [| t2 l2 ih2] //=; rewrite !in_cons. move=> h1; case/orP=> /=. case/orP; first by case/eqP. by move=> h2; apply: ih2; rewrite ?h2 // => - h3; apply: h1; rewrite h3 orbT. case/orP; first by case/eqP. move=> h3; apply: ih2; last by rewrite h3 orbT. by move=> h2; apply: h1; rewrite h2 orbT. Qed. Lemma oclause_neq_leq_elimP oc e : holds e (odnf_to_oform [:: oc]) <-> holds e (odnf_to_oform (oclause_neq_leq_elim oc)). Proof. rewrite /oclause_neq_leq_elim. rewrite oclause_leq_elimP; elim: (oclause_leq_elim oc) => [| t l ih] //=. rewrite odnf_to_oform_cat /= ih -oclause_neq_elimP /=. suff -> : forall A, A \/ false <-> A by []. by intuition. Qed. Definition oclause_to_w oc := let s := oclause_neq_leq_elim oc in map (fun x => let: Oclause eq_l neq_l lt_l leq_l := x in (eq_l, lt_l)) s. Definition w_to_oclause (t : seq (term R) * seq (term R)) := Oclause t.1%PAIR [::] t.2%PAIR [::]. Lemma oclause_leq_elim4 bc oc : oc \in (oclause_leq_elim bc) -> oc.4 == [::]. Proof. case: bc => bc1 bc2 bc3 bc4; elim: bc4 bc1 bc3 oc => [|t bc4 ih] bc1 bc3 /= oc. by rewrite inE; move/eqP; case: oc => ? ? ? oc4 /=; case=> _ _ _ /eqP. rewrite map_cat; move: (ih bc1 bc3 oc) => /= {ih}. elim: (leq_elim_aux bc1 bc3 bc4) => [| t2 l2 ih2] //= ih1. rewrite in_cons; case/orP. by move/eqP; case: oc {ih1 ih2} => ? ? ? ? [] /= _ _ _ /eqP. rewrite mem_cat; case/orP=> [hoc1|]. apply: ih2; first by move=> hoc2; apply: ih1; rewrite in_cons hoc2 orbT. by rewrite mem_cat hoc1. rewrite in_cons; case/orP=> [| hoc1]. by move/eqP; case: {ih1 ih2} oc=> ? ? ? ? [] /= _ _ _ /eqP. apply: ih2; first by move=> hoc2; apply: ih1; rewrite in_cons hoc2 orbT. by rewrite mem_cat hoc1 orbT. Qed. Lemma oclause_neq_elim2 bc oc : oc \in (oclause_neq_elim bc) -> (oc.2 == [::]) && (oc.4 == bc.4). Proof. case: bc => bc1 bc2 bc3 bc4; elim: bc2 bc4 oc => [|t bc2 /= ih] bc4 /= oc. by rewrite inE; move/eqP; case: oc => ? ? ? oc4 /=; case=> _ /eqP -> _ /eqP. rewrite map_cat; move: (ih bc4 oc) => /= {ih}. elim: (neq_elim_aux bc3 bc2) => [| t2 l2 ih2] //= ih1. rewrite in_cons; case/orP. by move/eqP; case: oc {ih1 ih2} => ? ? ? ? [] /= _ -> _ ->; rewrite !eqxx. rewrite mem_cat; case/orP=> [hoc1|]. apply: ih2; first by move=> hoc2; apply: ih1; rewrite in_cons hoc2 orbT. by rewrite mem_cat hoc1. rewrite in_cons; case/orP=> [| hoc1]. by move/eqP; case: {ih1 ih2} oc=> ? ? ? ? [] /= _ -> _ ->; rewrite !eqxx. apply: ih2; first by move=> hoc2; apply: ih1; rewrite in_cons hoc2 orbT. by rewrite mem_cat hoc1 orbT. Qed. Lemma oclause_to_wP e bc : holds e (odnf_to_oform (oclause_neq_leq_elim bc)) <-> holds e (odnf_to_oform (map w_to_oclause (oclause_to_w bc))). Proof. rewrite /oclause_to_w /oclause_neq_leq_elim. move: (@oclause_leq_elim4 bc). elim: (oclause_leq_elim bc) => [| t1 l1 ih1] //= h4. rewrite !map_cat !odnf_to_oform_cat. rewrite -[holds e (_ \/ _)]/(holds e _ \/ holds e _). suff <- : (oclause_neq_elim t1) = map w_to_oclause [seq (let: Oclause eq_l _ lt_l _ := x in (eq_l, lt_l)) | x <- oclause_neq_elim t1]. by rewrite ih1 // => - oc hoc; apply: h4; rewrite in_cons hoc orbT. have : forall oc, oc \in (oclause_neq_elim t1) -> oc.2 = [::] /\ oc.4 = [::]. move=> oc hoc; move/oclause_neq_elim2: (hoc); case/andP=> /eqP -> /eqP ->. by move/eqP: (h4 _ (mem_head _ _))->. elim: (oclause_neq_elim t1) => [| [teq1 tneq1 tleq1 tlt1] l2 ih2] h24 //=. rewrite /w_to_oclause /=; move: (h24 _ (mem_head _ _ ))=> /= [] -> ->. by congr (_ :: _); apply: ih2 => oc hoc; apply: h24; rewrite in_cons hoc orbT. Qed. Variable wproj : nat -> (seq (term R) * seq (term R)) -> formula R. Definition proj (n : nat)(oc : oclause R) := foldr Or False (map (wproj n) (oclause_to_w oc)). Hypothesis wf_QE_wproj : forall i bc (bc_i := wproj i bc), dnf_rterm (w_to_oclause bc) -> qf_form bc_i && rformula bc_i. Lemma dnf_rterm_subproof bc : dnf_rterm bc -> all (dnf_rterm \o w_to_oclause) (oclause_to_w bc). Proof. case: bc => leq lneql llt lle; rewrite /dnf_rterm /=; case/and4P=> req rneq rlt rle. rewrite /oclause_to_w /= !all_map. apply/allP => [] [oc_eq oc_neq oc_le oc_lt] hoc; rewrite /dnf_rterm /= andbT. rewrite -all_cat; apply/allP=> u hu; move/terms_of_neq_leq_elim: hoc => /=. move/(_ u); rewrite !mem_cat. have {}hu : [|| u \in oc_eq, u \in oc_neq, u \in oc_le | u \in oc_lt]. by move: hu; rewrite mem_cat; case/orP=> ->; rewrite ?orbT. move/(_ hu); case/orP; last first. move: rneq. have <- : (all (@rterm R) (map Opp lneql)) = all (@rterm R) lneql. by elim: lneql => [| t l] //= ->. by move/allP; apply. case/orP; first by apply: (allP req). case/orP; first by apply: (allP rneq). case/orP; first by apply: (allP rlt). exact: (allP rle). Qed. Lemma wf_QE_proj i : forall bc (bc_i := proj i bc), dnf_rterm bc -> qf_form bc_i && rformula bc_i. Proof. case=> leq lneql llt lle /= hdnf; move: (hdnf). rewrite /dnf_rterm /=; case/and4P=> req rneq rlt rle; rewrite /proj; apply/andP. move: (dnf_rterm_subproof hdnf). elim: (oclause_to_w _ ) => //= [a t] ih /andP [h1 h2]. by case: (ih h2)=> -> ->; case/andP: (wf_QE_wproj i h1) => -> ->. Qed. Hypothesis valid_QE_wproj : forall i bc (bc' := w_to_oclause bc) (ex_i_bc := ('exists 'X_i, odnf_to_oform [:: bc'])%oT) e, dnf_rterm bc' -> reflect (holds e ex_i_bc) (qf_eval e (wproj i bc)). Lemma valid_QE_proj e i : forall bc (bc_i := proj i bc) (ex_i_bc := ('exists 'X_i, odnf_to_oform [:: bc])%oT), dnf_rterm bc -> reflect (holds e ex_i_bc) (qf_eval e (proj i bc)). Proof. move=> bc; rewrite /dnf_rterm => hdnf; rewrite /proj; apply: (equivP idP). have -> : holds e ('exists 'X_i, odnf_to_oform [:: bc]) <-> (exists x : R, holds (set_nth 0 e i x) (odnf_to_oform (oclause_neq_leq_elim bc))). split; case=> x h; exists x; first by rewrite -oclause_neq_leq_elimP. by rewrite oclause_neq_leq_elimP. have -> : (exists x : R, holds (set_nth 0 e i x) (odnf_to_oform (oclause_neq_leq_elim bc))) <-> (exists x : R, holds (set_nth 0 e i x) (odnf_to_oform (map w_to_oclause (oclause_to_w bc)))). by split; case=> x; move/oclause_to_wP=> h; exists x. move: (dnf_rterm_subproof hdnf). rewrite /oclause_to_w; elim: (oclause_neq_leq_elim bc) => /= [|a l ih]. by split=> //; case. case/andP=> h1 h2; have {h2} ih := (ih h2); split. - case/orP. move/(valid_QE_wproj i e h1)=> /= [x /=] [] // [] h2 [] _ [] h3 _; exists x. by left. by case/ih => x h; exists x; right. - case=> x [] /=. + case=> h2 [] _ h3; apply/orP; left; apply/valid_QE_wproj => //=. by exists x; left. + by move=> hx; apply/orP; right; apply/ih; exists x. Qed. Let elim_aux f n := foldr Or False (map (proj n) (qf_to_odnf f false)). Fixpoint quantifier_elim f := match f with | f1 /\ f2 => (quantifier_elim f1) /\ (quantifier_elim f2) | f1 \/ f2 => (quantifier_elim f1) \/ (quantifier_elim f2) | f1 ==> f2 => (~ quantifier_elim f1) \/ (quantifier_elim f2) | ~ f => ~ quantifier_elim f | ('exists 'X_n, f) => elim_aux (quantifier_elim f) n | ('forall 'X_n, f) => ~ elim_aux (~ quantifier_elim f) n | _ => f end%oT. Lemma quantifier_elim_wf f : let qf := quantifier_elim f in rformula f -> qf_form qf && rformula qf. Proof. suffices aux_wf f0 n : let qf := elim_aux f0 n in rformula f0 -> qf_form qf && rformula qf. - by elim: f => //=; do ?[ move=> f1 IH1 f2 IH2; case/andP=> rf1 rf2; case/andP:(IH1 rf1)=> -> ->; case/andP:(IH2 rf2)=> -> -> // | move=> n f1 IH rf1; case/andP: (IH rf1)=> qff rf; rewrite aux_wf ]. rewrite /elim_aux => rf. suffices or_wf fs : let ofs := foldr Or False fs in all qf_form fs && all rformula fs -> qf_form ofs && rformula ofs. - apply: or_wf. suffices map_proj_wf bcs: let mbcs := map (proj n) bcs in all dnf_rterm bcs -> all qf_form mbcs && all rformula mbcs. by apply: map_proj_wf; apply: qf_to_dnf_rterm. elim: bcs => [|bc bcs ihb] bcsr //= /andP[rbc rbcs]. by rewrite andbAC andbA wf_QE_proj //= andbC ihb. elim: fs => //= g gs ihg; rewrite -andbA => /and4P[-> qgs -> rgs] /=. by apply: ihg; rewrite qgs rgs. Qed. Lemma quantifier_elim_rformP e f : rformula f -> reflect (holds e f) (qf_eval e (quantifier_elim f)). Proof. pose rc e n f := exists x, qf_eval (set_nth 0 e n x) f. have auxP f0 e0 n0: qf_form f0 && rformula f0 -> reflect (rc e0 n0 f0) (qf_eval e0 (elim_aux f0 n0)). + rewrite /elim_aux => cf; set bcs := qf_to_odnf f0 false. apply: (@iffP (rc e0 n0 (odnf_to_oform bcs))); last first. - by case=> x; rewrite -qf_to_dnfP //; exists x. - by case=> x; rewrite qf_to_dnfP //; exists x. have: all dnf_rterm bcs by case/andP: cf => _; apply: qf_to_dnf_rterm. elim: {f0 cf}bcs => [|bc bcs IHbcs] /=; first by right; case. case/andP=> r_bc /IHbcs {IHbcs}bcsP. have f_qf := dnf_to_form_qf [:: bc]. case: valid_QE_proj => //= [ex_x|no_x]. left; case: ex_x => x /(qf_evalP _ f_qf); rewrite /= orbF => bc_x. by exists x; rewrite /= bc_x. apply: (iffP bcsP) => [[x bcs_x] | [x]] /=. by exists x; rewrite /= bcs_x orbT. case/orP => [bc_x|]; last by exists x. by case: no_x; exists x; apply/(qf_evalP _ f_qf); rewrite /= bc_x. elim: f e => //. - by move=> b e _; apply: idP. - by move=> t1 t2 e _; apply: eqP. - by move=> t1 t2 e _; apply: idP. - by move=> t1 t2 e _; apply: idP. - move=> f1 IH1 f2 IH2 e /= /andP[/IH1[] f1e]; last by right; case. by case/IH2; [left | right; case]. - move=> f1 IH1 f2 IH2 e /= /andP[/IH1[] f1e]; first by do 2!left. by case/IH2; [left; right | right; case]. - move=> f1 IH1 f2 IH2 e /= /andP[/IH1[] f1e]; last by left. by case/IH2; [left | right; move/(_ f1e)]. - by move=> f IHf e /= /IHf[]; [right | left]. - move=> n f IHf e /= rf; have rqf := quantifier_elim_wf rf. by apply: (iffP (auxP _ _ _ rqf)) => [] [x]; exists x; apply/IHf. move=> n f IHf e /= rf; have rqf := quantifier_elim_wf rf. case: auxP => // [f_x|no_x]; first by right=> no_x; case: f_x => x /IHf[]. by left=> x; apply/IHf=> //; apply/idPn=> f_x; case: no_x; exists x. Qed. Definition proj_sat e f := qf_eval e (quantifier_elim (to_rform f)). Lemma proj_satP : forall e f, reflect (holds e f) (proj_sat e f). Proof. move=> e f; have fP := quantifier_elim_rformP e (to_rform_rformula f). by apply: (iffP fP); move/to_rformP. Qed. End EvalTerm. End ord. real-closed-2.0.2/theories/polyorder.v000066400000000000000000000230601472566273500177570ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq choice. From mathcomp Require Import fintype ssralg zmodp poly polydiv ssrnum interval. Import GRing.Theory Num.Theory Pdiv.Idomain. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Local Open Scope ring_scope. Section Multiplicity. Variable R : idomainType. Implicit Types x y c : R. Implicit Types p q r d : {poly R}. (* Definition multiplicity (x : R) (p : {poly R}) : nat := *) (* (odflt ord0 (pick (fun i : 'I_(size p).+1 => ((('X - x%:P) ^+ i %| p)) *) (* && (~~ (('X - x%:P) ^+ i.+1 %| p))))). *) (* Notation "'\mu_' x" := (multiplicity x) *) (* (at level 8, format "'\mu_' x") : ring_scope. *) (* Lemma mu0 : forall x, \mu_x 0 = 0%N. *) (* Proof. *) (* by move=> x; rewrite /multiplicity; case: pickP=> //= i; rewrite !dvdp0. *) (* Qed. *) (* Lemma muP : forall p x, p != 0 -> *) (* (('X - x%:P) ^+ (\mu_x p) %| p) && ~~(('X - x%:P) ^+ (\mu_x p).+1 %| p). *) (* Proof. *) (* move=> p x np0; rewrite /multiplicity; case: pickP=> //= hp. *) (* have {hp} hip: forall i, i <= size p *) (* -> (('X - x%:P) ^+ i %| p) -> (('X - x%:P) ^+ i.+1 %| p). *) (* move=> i; rewrite -ltnS=> hi; move/negbT: (hp (Ordinal hi)). *) (* by rewrite -negb_imply negbK=> /implyP. *) (* suff: forall i, i <= size p -> ('X - x%:P) ^+ i %| p. *) (* move=> /(_ _ (leqnn _)) /(size_dvdp np0). *) (* rewrite -[size _]prednK; first by rewrite size_exp size_XsubC mul1n ltnn. *) (* by rewrite lt0n size_poly_eq0 expf_eq0 polyXsubC_eq0 lt0n size_poly_eq0 np0. *) (* elim=> [|i ihi /ltnW hsp]; first by rewrite expr0 dvd1p. *) (* by rewrite hip // ihi. *) (* Qed. *) (* Lemma cofactor_XsubC : forall p a, p != 0 -> *) (* exists2 q : {poly R}, (~~ root q a) & p = q * ('X - a%:P) ^+ (\mu_a p). *) (* Proof. *) (* move=> p a np0. *) Definition multiplicity (x : R) (p : {poly R}) := if p == 0 then 0%N else sval (multiplicity_XsubC p x). Notation "'\mu_' x" := (multiplicity x) (at level 8, format "'\mu_' x") : ring_scope. Lemma mu_spec p a : p != 0 -> { q : {poly R} & (~~ root q a) & ( p = q * ('X - a%:P) ^+ (\mu_a p)) }. Proof. move=> nz_p; rewrite /multiplicity -if_neg. by case: (_ p a) => m /=/sig2_eqW[q]; rewrite nz_p; exists q. Qed. Lemma mu0 x : \mu_x 0 = 0%N. Proof. by rewrite /multiplicity {1}eqxx. Qed. Lemma root_mu p x : ('X - x%:P) ^+ (\mu_x p) %| p. Proof. case p0: (p == 0); first by rewrite (eqP p0) mu0 expr0 dvd1p. case: (@mu_spec p x); first by rewrite p0. by move=> q qn0 hp //=; rewrite {2}hp dvdp_mulIr. Qed. (* Lemma size_exp_XsubC : forall x n, size (('X - x%:P) ^+ n) = n.+1. *) (* Proof. *) (* move=> x n; rewrite -[size _]prednK ?size_exp ?size_XsubC ?mul1n //. *) (* by rewrite ltnNge leqn0 size_poly_eq0 expf_neq0 // polyXsubC_eq0. *) (* Qed. *) Lemma root_muN p x : p != 0 -> (('X - x%:P)^+(\mu_x p).+1 %| p) = false. Proof. move=> pn0; case: (mu_spec x pn0)=> q qn0 hp /=. rewrite {2}hp exprS dvdp_mul2r; last first. by rewrite expf_neq0 // polyXsubC_eq0. apply: negbTE; rewrite -eqp_div_XsubC; apply: contra qn0. by move/eqP->; rewrite rootM root_XsubC eqxx orbT. Qed. Lemma root_le_mu p x n : p != 0 -> ('X - x%:P)^+n %| p = (n <= \mu_x p)%N. Proof. move=> pn0; case: leqP=> hn; last apply/negP=> hp. apply: (@dvdp_trans _ (('X - x%:P) ^+ (\mu_x p))); last by rewrite root_mu. by rewrite dvdp_Pexp2l // size_XsubC. suff : ('X - x%:P) ^+ (\mu_x p).+1 %| p by rewrite root_muN. by apply: dvdp_trans hp; rewrite dvdp_Pexp2l // size_XsubC. Qed. Lemma muP p x n : p != 0 -> (('X - x%:P)^+n %| p) && ~~(('X - x%:P)^+n.+1 %| p) = (n == \mu_x p). Proof. by move=> hp0; rewrite !root_le_mu//; case: (ltngtP n (\mu_x p)). Qed. Lemma mu_gt0 p x : p != 0 -> (0 < \mu_x p)%N = root p x. Proof. by move=> pn0; rewrite -root_le_mu// expr1 root_factor_theorem. Qed. Lemma muNroot p x : ~~ root p x -> \mu_x p = 0%N. Proof. case p0: (p == 0); first by rewrite (eqP p0) rootC eqxx. by move=> pnx0; apply/eqP; rewrite -leqn0 leqNgt mu_gt0 ?p0. Qed. Lemma mu_polyC c x : \mu_x (c%:P) = 0%N. Proof. case c0: (c == 0); first by rewrite (eqP c0) mu0. by apply: muNroot; rewrite rootC c0. Qed. Lemma cofactor_XsubC_mu x p n : ~~ root p x -> \mu_x (p * ('X - x%:P) ^+ n) = n. Proof. move=> p0; apply/eqP; rewrite eq_sym -muP//; last first. apply: contra p0; rewrite mulf_eq0 expf_eq0 polyXsubC_eq0 andbF orbF. by move/eqP->; rewrite root0. rewrite dvdp_mulIr /= exprS dvdp_mul2r -?root_factor_theorem //. by rewrite expf_eq0 polyXsubC_eq0 andbF //. Qed. Lemma mu_mul p q x : p * q != 0 -> \mu_x (p * q) = (\mu_x p + \mu_x q)%N. Proof. move=> hpqn0; apply/eqP; rewrite eq_sym -muP//. rewrite exprD dvdp_mul ?root_mu//=. move: hpqn0; rewrite mulf_eq0 negb_or; case/andP=> hp0 hq0. move: (mu_spec x hp0)=> [qp qp0 hp]. move: (mu_spec x hq0)=> [qq qq0 hq]. rewrite {2}hp {2}hq exprS exprD !mulrA [qp * _ * _]mulrAC. rewrite !dvdp_mul2r ?expf_neq0 ?polyXsubC_eq0 // -eqp_div_XsubC. move: (mulf_neq0 qp0 qq0); rewrite -hornerM; apply: contra; move/eqP->. by rewrite hornerM hornerXsubC subrr mulr0. Qed. Lemma mu_XsubC x : \mu_x ('X - x%:P) = 1%N. Proof. apply/eqP; rewrite eq_sym -muP; last by rewrite polyXsubC_eq0. by rewrite expr1 dvdpp/= -{2}[_ - _]expr1 dvdp_Pexp2l // size_XsubC. Qed. Lemma mu_mulC c p x : c != 0 -> \mu_x (c *: p) = \mu_x p. Proof. move=> cn0; case p0: (p == 0); first by rewrite (eqP p0) scaler0. by rewrite -mul_polyC mu_mul ?mu_polyC// mulf_neq0 ?p0 ?polyC_eq0. Qed. Lemma mu_opp p x : \mu_x (-p) = \mu_x p. Proof. rewrite -mulN1r -polyC1 -polyCN mul_polyC mu_mulC //. by rewrite -oppr0 (inj_eq (inv_inj (@opprK _))) oner_eq0. Qed. Lemma mu_exp p x n : \mu_x (p ^+ n) = (\mu_x p * n)%N. Proof. elim: n p => [|n ihn] p; first by rewrite expr0 mu_polyC muln0. case p0: (p == 0); first by rewrite (eqP p0) exprS mul0r mu0 mul0n. by rewrite exprS mu_mul ?ihn ?mulnS// mulf_eq0 expf_eq0 p0 andbF. Qed. Lemma mu_addr p q x : p != 0 -> (\mu_x p < \mu_x q)%N -> \mu_x (p + q) = \mu_x p. Proof. move=> pn0 mupq. have pqn0 : p + q != 0. move: mupq; rewrite ltnNge; apply: contra. by rewrite -[q]opprK subr_eq0; move/eqP->; rewrite opprK mu_opp leqnn. have qn0: q != 0 by move: mupq; apply: contraL; move/eqP->; rewrite mu0 ltn0. case: (mu_spec x pn0)=> [qqp qqp0] hp. case: (mu_spec x qn0)=> [qqq qqq0] hq. rewrite hp hq -(subnK (ltnW mupq)). rewrite mu_mul ?mulf_eq0; last first. rewrite expf_eq0 polyXsubC_eq0 andbF orbF. by apply: contra qqp0; move/eqP->; rewrite root0. rewrite mu_exp mu_XsubC mul1n [\mu_x qqp]muNroot // add0n. rewrite exprD mulrA -mulrDl mu_mul; last first. by rewrite mulrDl -mulrA -exprD subnK 1?ltnW // -hp -hq. rewrite muNroot ?add0n ?mu_exp ?mu_XsubC ?mul1n //. rewrite rootE !hornerE ?horner_exp ?hornerXsubC subrr. (* FIXME: remove ?horner_exp ?hornerXsubC when requiring MC >= 1.16.0 *) by rewrite -subnSK // subnS exprS mul0r mulr0 addr0. Qed. Lemma mu_addl p q x : q != 0 -> (\mu_x p > \mu_x q)%N -> \mu_x (p + q) = \mu_x q. Proof. by move=> q0 hmu; rewrite addrC mu_addr. Qed. Lemma mu_div p x n : (n <= \mu_x p)%N -> \mu_x (p %/ ('X - x%:P) ^+ n) = (\mu_x p - n)%N. Proof. move=> hn. case p0: (p == 0); first by rewrite (eqP p0) div0p mu0 sub0n. case: (@mu_spec p x); rewrite ?p0 // => q hq hp. rewrite {1}hp -{1}(subnK hn) exprD mulrA. rewrite Pdiv.IdomainMonic.mulpK; last by apply: monic_exp; apply: monicXsubC. rewrite mu_mul ?mulf_eq0 ?expf_eq0 ?polyXsubC_eq0 ?andbF ?orbF; last first. by apply: contra hq; move/eqP->; rewrite root0. by rewrite mu_exp muNroot // add0n mu_XsubC mul1n. Qed. End Multiplicity. Notation "'\mu_' x" := (multiplicity x) (at level 8, format "'\mu_' x") : ring_scope. Section PolyrealIdomain. (*************************************************************************) (* This should be replaced by a 0-characteristic condition + integrality *) (* and merged into poly and polydiv *) (*************************************************************************) Variable R : realDomainType. Lemma size_deriv (p : {poly R}) : size p^`() = (size p).-1. Proof. have [lep1|lt1p] := leqP (size p) 1. by rewrite {1}[p]size1_polyC // derivC size_poly0 -subn1 (eqnP lep1). rewrite size_poly_eq // mulrn_eq0 -subn2 -subSn // subn2. by rewrite lead_coef_eq0 -size_poly_eq0 -(subnKC lt1p). Qed. Lemma derivn_poly0 : forall (p : {poly R}) n, (size p <= n)%N = (p^`(n) == 0). Proof. move=> p n; apply/idP/idP. move=> Hpn; apply/eqP; apply/polyP=>i; rewrite coef_derivn. rewrite nth_default; first by rewrite mul0rn coef0. by apply: leq_trans Hpn _; apply leq_addr. elim: n {-2}n p (leqnn n) => [m | n ihn [| m]] p. - by rewrite leqn0; move/eqP->; rewrite derivn0 leqn0 -size_poly_eq0. - by move=> _; apply: ihn; rewrite leq0n. - rewrite derivSn => hmn hder; case e: (size p) => [|sp] //. rewrite -(prednK (ltn0Sn sp)) [(_.-1)%N]lock -e -lock -size_deriv ltnS. exact: ihn. Qed. Lemma mu_deriv : forall x (p : {poly R}), root p x -> \mu_x (p^`()) = (\mu_x p - 1)%N. Proof. move=> x p px0; have [-> | nz_p] := eqVneq p 0; first by rewrite derivC mu0. have [q nz_qx Dp] := mu_spec x nz_p. case Dm: (\mu_x p) => [|m]; first by rewrite Dp Dm mulr1 (negPf nz_qx) in px0. rewrite subn1 Dp Dm !derivCE exprS mul1r mulrnAr -mulrnAl mulrA -mulrDl. rewrite cofactor_XsubC_mu // rootE !(hornerE, hornerMn) subrr mulr0 add0r. by rewrite mulrn_eq0. Qed. Lemma mu_deriv_root : forall x (p : {poly R}), p != 0 -> root p x -> \mu_x p = (\mu_x (p^`()) + 1)%N. Proof. by move=> x p p0 rpx; rewrite mu_deriv // subn1 addn1 prednK // mu_gt0. Qed. End PolyrealIdomain. real-closed-2.0.2/theories/polyrcf.v000066400000000000000000002163611472566273500174260ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import all_ssreflect all_algebra polyorder. (****************************************************************************) (* This files contains basic (and unformatted) theory for polynomials *) (* over a realclosed fields. From the IVT (contained in the rcfType *) (* structure), we derive Rolle's Theorem, the Mean Value Theorem, a root *) (* isolation procedure and the notion of neighborhood. *) (* *) (* sgp_minfty p == the sign of p in -oo *) (* sgp_pinfty p == the sign of p in +oo *) (* cauchy_bound p == the cauchy bound of p *) (* (this strictly bounds the norm of roots of p) *) (* roots p a b == the ordered list of roots of p in `[a, b] *) (* defaults to [::] when p == 0 *) (* rootsR p == the ordered list of all roots of p, ([::] if p == 0). *) (* next_root p x b == the smallest root of p contained in `[x, maxn x b] *) (* if p has no root on `[x, maxn x b], we pick maxn x b. *) (* prev_root p x a == the smallest root of p contained in `[minn x a, x] *) (* if p has no root on `[minn x a, x], we pick minn x a. *) (* neighpr p a b := `]a, next_root p a b[. *) (* == an open interval of the form `]a, x[, with x <= b *) (* in which p has no root. *) (* neighpl p a b := `]prev_root p a b, b[. *) (* == an open interval of the form `]x, b[, with a <= x *) (* in which p has no root. *) (* sgp_right p a == the sign of p on the right of a. *) (****************************************************************************) Import Order.Theory GRing.Theory Num.Theory Pdiv.Idomain. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Local Open Scope ring_scope. Local Notation noroot p := (forall x, ~~ root p x). Local Notation mid x y := ((x + y) / 2%:R). Local Notation maxr := Num.max. Local Notation minr := Num.min. Local Notation sgr := Num.sg. Section more. Section SeqR. Lemma last1_neq0 (R : ringType) (s : seq R) (c : R) : c != 0 -> (last c s != 0) = (last 1 s != 0). Proof. by elim: s c => [|t s ihs] c cn0 //; rewrite oner_eq0 cn0. Qed. End SeqR. Section poly. Import Pdiv.Ring Pdiv.ComRing. Variable R : idomainType. Implicit Types p q : {poly R}. Lemma lead_coefDr p q : (size q > size p)%N -> lead_coef (p + q) = lead_coef q. Proof. exact: lead_coefDr. Qed. Lemma leq1_size_polyC (c : R) : (size c%:P <= 1)%N. Proof. exact: size_polyC_leq1. Qed. Lemma my_size_exp p n : p != 0 -> (size (p ^+ n)) = ((size p).-1 * n).+1%N. Proof. by move=> hp; rewrite -size_exp prednK // size_poly_gt0 expf_neq0. Qed. Lemma coef_comp_poly p q n : (p \Po q)`_n = \sum_(i < size p) p`_i * (q ^+ i)`_n. Proof. exact: coef_comp_poly. Qed. Lemma gt_size_poly p n : (size p > n)%N -> p != 0. Proof. by rewrite -size_poly_gt0; apply: leq_trans. Qed. Lemma lead_coef_comp_poly p q : (size q > 1)%N -> lead_coef (p \Po q) = (lead_coef p) * (lead_coef q) ^+ (size p).-1. Proof. exact: lead_coef_comp. Qed. End poly. End more. (******************************************************************) (* Definitions and properties for polynomials in a numDomainType. *) (******************************************************************) Section PolyNumDomain. Variable R : numDomainType. Implicit Types (p q : {poly R}). Definition sgp_pinfty (p : {poly R}) := Num.sg (lead_coef p). Definition sgp_minfty (p : {poly R}) := Num.sg ((-1) ^+ (size p).-1 * (lead_coef p)). End PolyNumDomain. (******************************************************************) (* Definitions and properties for polynomials in a realFieldType. *) (******************************************************************) Section PolyRealField. Variable R : realFieldType. Implicit Types (p q : {poly R}). Section SgpInfty. Lemma sgp_pinfty_sym p : sgp_pinfty (p \Po -'X) = sgp_minfty p. Proof. rewrite /sgp_pinfty /sgp_minfty lead_coef_comp ?size_opp ?size_polyX //. by rewrite lead_coefN lead_coefX mulrC. Qed. Lemma poly_pinfty_gt_lc p : lead_coef p > 0 -> exists n, forall x, x >= n -> p.[x] >= lead_coef p. Proof. elim/poly_ind: p => [| q c IHq]; first by rewrite lead_coef0 ltxx. have [->|q_neq0] := eqVneq q 0. by rewrite mul0r add0r lead_coefC => c_gt0; exists 0 => x _; rewrite hornerC. rewrite lead_coefDl ?size_mulX ?size_polyC // ?lead_coefMX; last first. by apply: (leq_trans (leq_b1 _)); rewrite size_poly_gt0. move=> lq_gt0; have [y Hy] := IHq lq_gt0. pose z := (1 + (lead_coef q) ^-1 * `|c|); exists (maxr y z) => x. have z_gt0: 0 < z by rewrite ltr_pwDl ?ltr01 ?mulr_ge0 ?invr_ge0 // ltW. rewrite !hornerE ge_max => /andP[/Hy Hq Hc]. apply: le_trans (_ : lead_coef q * z + c <= _); last first. rewrite lerD2r (le_trans (_ : _ <= q.[x] * z)) // ?ler_pM2r //. by rewrite ler_pM2l // (lt_le_trans _ Hq). rewrite mulrDr mulr1 -addrA lerDl mulVKf ?gt_eqF //. by rewrite -[c]opprK subr_ge0 normrN ler_norm. Qed. (* :REMARK: not necessary here ! *) Lemma poly_lim_infty p m : lead_coef p > 0 -> (size p > 1)%N -> exists n, forall x, x >= n -> p.[x] >= m. Proof. elim/poly_ind: p m => [| q c _] m; first by rewrite lead_coef0 ltxx. have [-> _|q_neq0] := eqVneq q 0. by rewrite mul0r add0r size_polyC ltnNge leq_b1. rewrite lead_coefDl ?size_mulX ?size_polyC // ?lead_coefMX; last first. by apply: (leq_trans (leq_b1 _)); rewrite size_poly_gt0. move=> lq_gt0; have [y Hy _] := poly_pinfty_gt_lc lq_gt0. pose z := (1 + (lead_coef q) ^-1 * (`|m| + `|c|)); exists (maxr y z) => x. have z_gt0 : 0 < z. by rewrite ltr_pwDl ?ltr01 ?mulr_ge0 ?invr_ge0 ?addr_ge0 // ?ltW. rewrite !hornerE ge_max => /andP[/Hy Hq Hc]. apply: le_trans (_ : lead_coef q * z + c <= _); last first. rewrite lerD2r (le_trans (_ : _ <= q.[x] * z)) // ?ler_pM2r //. by rewrite ler_pM2l // (lt_le_trans _ Hq). rewrite mulrDr mulr1 mulVKf ?gt_eqF // addrA -(addrA _ _ c) ler_wpDr //. by rewrite -[c]opprK subr_ge0 normrN ler_norm. by rewrite ler_wpDl ?ler_norm // ?ltW. Qed. End SgpInfty. Section CauchyBound. Definition cauchy_bound (p : {poly R}) := 1 + `|lead_coef p|^-1 * \sum_(i < size p) `|p`_i|. (* Could be a sharp bound, and proof should shrink... *) Lemma cauchy_boundP (p : {poly R}) x : p != 0 -> p.[x] = 0 -> `| x | < cauchy_bound p. Proof. move=> np0 rpx; rewrite ltr_pwDl ?ltr01 //. have sp_gt0 : (size p > 0)%N by rewrite size_poly_gt0. have lcn0 : `|lead_coef p| != 0 by rewrite normr_eq0 lead_coef_eq0. have lcp : `|lead_coef p| > 0 by rewrite lt_def lcn0 /=. have [x_le1|x_gt1] := lerP `|x| 1. rewrite (le_trans x_le1) // ler_pdivlMl // mulr1. by rewrite polySpred// big_ord_recr/= lerDr sumr_ge0. have x_gt0 : `|x| > 0 by rewrite (lt_trans ltr01). have [sp_le1|sp_gt1] := leqP (size p) 1. by move: rpx np0; rewrite [p]size1_polyC// hornerC polyC_eq0 => /eqP->. rewrite ler_pdivlMl//. pose n := (size p).-1; have n_gt0 : (n > 0)%N by rewrite /n -subn1 subn_gt0. have : `|p`_n| * `|x| ^+ n <= \sum_(i < n) `|p`_i * x ^+ i|. rewrite (le_trans _ (ler_norm_sum _ _ _))//. have := rpx; rewrite horner_coef polySpred// !big_ord_recr/=. by move=> /(canRL (@addrK _ _))->; rewrite sub0r normrN normrM normrX. rewrite -[n in _ ^+ n]prednK// exprS mulrA. rewrite -[X in _ X -> _]ler_pdivlMr ?exprn_gt0// => /le_trans->//. rewrite polySpred// big_ord_recr/= ler_wpDr// mulr_suml ler_sum => //i _. rewrite normrM normrX ler_pdivrMr ?exprn_gt0// ler_pM ?exprn_ge0//. by rewrite ler_weXn2l// 1?ltW// -ltnS prednK//. Qed. Lemma root_in_cauchy_bound (p : {poly R}) : p != 0 -> {subset root p <= `](- cauchy_bound p), (cauchy_bound p)[ }. Proof. by move=> p_neq0 x /eqP /(cauchy_boundP p_neq0); rewrite ltr_norml. Qed. Definition root_cauchy_boundP (p : {poly R}) pN0 x (rpx : root p x) := itvP (root_in_cauchy_bound pN0 rpx). Lemma le_cauchy_bound p : p != 0 -> {in `]-oo, (- cauchy_bound p)], noroot p}. Proof. move=> p_neq0 x; rewrite in_itv /=; apply/contra_leN. by case/rootP/(cauchy_boundP p_neq0)/ltr_normlP; rewrite ltrNl. Qed. Hint Resolve le_cauchy_bound : core. Lemma ge_cauchy_bound p : p != 0 -> {in `[cauchy_bound p, +oo[, noroot p}. Proof. move=> p_neq0 x; rewrite in_itv andbT /=; apply/contra_leN. by case/rootP/(cauchy_boundP p_neq0)/ltr_normlP; rewrite ltrNl. Qed. Hint Resolve ge_cauchy_bound : core. Lemma cauchy_bound_gt0 p : cauchy_bound p > 0. Proof. by rewrite ltr_pwDl ?ltr01 // mulrC divr_ge0 ?normr_ge0 ?sumr_ge0. Qed. Hint Resolve cauchy_bound_gt0 : core. Lemma cauchy_bound_ge0 p : cauchy_bound p >= 0. Proof. by rewrite ltW. Qed. Hint Resolve cauchy_bound_ge0 : core. Lemma cauchy_bound_neq0 p : cauchy_bound p != 0. Proof. by rewrite gt_eqF. Qed. Hint Resolve cauchy_bound_neq0 : core. End CauchyBound. End PolyRealField. #[export] Hint Resolve le_cauchy_bound ge_cauchy_bound : core. #[export] Hint Resolve cauchy_bound_gt0 cauchy_bound_ge0 : core. #[export] Hint Resolve cauchy_bound_neq0 : core. (************************************************************) (* Definitions and properties for polynomials in a rcfType. *) (************************************************************) Section PolyRCF. Variable R : rcfType. Section Prelim. Implicit Types a b c : R. Implicit Types x y z t : R. Implicit Types p q r : {poly R}. (* we restate poly_ivt in a nicer way. Perhaps the def of PolyRCF should *) (* be moved in this file, juste above this section *) Definition poly_ivtW := poly_ivt. Lemma poly_ivt p a b : a <= b -> p.[a] * p.[b] <= 0 -> {x | x \in `[a, b] & root p x}. Proof. move=> le_ab sgp; apply/sig2W; have []//= := @poly_ivt _ (p.[b] *: p) a b. by rewrite !hornerZ sqr_ge0 mulrC sgp. move=> x axb; have [|?] := boolP (root p b); last by rewrite rootZ //; exists x. by move=> rpb; exists b; rewrite // in_itv/= lexx andbT. Qed. Lemma poly_ivtoo p a b : a <= b -> p.[a] * p.[b] < 0 -> {x | x \in `]a, b[ & root p x}. Proof. move=> le_ab; rewrite lt_neqAle mulf_eq0 negb_or -andbA => /and3P[pa0 pb0]. move=> /(poly_ivt le_ab) [c cab rpc]. exists c => //; rewrite in_itv; apply/andP => /=. by split; rewrite lt_neqAle (itvP cab) andbT; [move: pa0|move: pb0]; apply: contraNneq; [move->|move<-]. Qed. Lemma ivt_sign_deprecated (p : {poly R}) (a b : R) : a <= b -> sgr p.[a] * sgr p.[b] = -1 -> { x : R | x \in `]a, b[ & root p x}. Proof. move=> le_ab sgpab_eqN1; apply: poly_ivtoo => //. by rewrite -sgr_cp0 sgrM sgpab_eqN1. Qed. Definition has_ivt_root p a b := if (a <= b) && (p.[a] * p.[b] <= 0) =P true isn't ReflectT pp then None else Some (projT1 (poly_ivt (proj1 (andP pp)) (proj2 (andP pp)))). Notation ivt_root p a b := (odflt 0 (has_ivt_root p a b)). CoInductive has_itv_root_spec p a b : bool -> option R -> Type := | HasItvRoot x of (p.[a] * p.[b] <= 0) & x \in `[a, b] & root p x : has_itv_root_spec p a b true (Some x) | NoItvRoot of (p.[a] * p.[b] > 0) : has_itv_root_spec p a b false None. Lemma has_itv_rootP p a b : a <= b -> has_itv_root_spec p a b (p.[a] * p.[b] <= 0) (has_ivt_root p a b). Proof. move=> le_ab; rewrite /has_ivt_root; case: eqP => /= [pp|/negP]. move: {-}(pp) => /andP[_ pab]; rewrite {1}pab; constructor => //; by case: poly_ivt. by rewrite le_ab /= -ltNge => pab; rewrite lt_geF //; constructor. Qed. Lemma some_ivt_root p a b x : has_ivt_root p a b = Some x -> root p x. Proof. by rewrite /has_ivt_root; case: eqP => //= pp; case: poly_ivt => //= ??? [<-]. Qed. Lemma has_ivt_rootE p a b : has_ivt_root p a b = (a <= b) && (p.[a] * p.[b] <= 0) :> bool. Proof. by rewrite /has_ivt_root; case: eqP => //= /negP/negPf->. Qed. Lemma ivt_root_in p a b : a <= b -> p.[a] * p.[b] <= 0 -> ivt_root p a b \in `[a, b]. Proof. by move=> ab; case: has_itv_rootP. Qed. Lemma ivt_rootP p a b : a <= b -> p.[a] * p.[b] <= 0 -> root p (ivt_root p a b). Proof. by move=> leab; case: has_itv_rootP. Qed. Lemma sub_cc_itv a b (i : interval R) : (a \in i) -> (b \in i) -> (`[a, b] <= i)%O. Proof. case: i => [c d]; rewrite !inE/= !/(_ <= Interval _ _)%O/=. by move=> /andP[-> _] /andP[_ ->]. Qed. Lemma sub_oo_itv a b (i : interval R) : (a \in i) -> (b \in i) -> (`]a, b[ <= i)%O. Proof. case: i => [c d]; rewrite !inE/= !/(_ <= Interval _ _)%O/=. move=> /andP[ca _] /andP[_ bd]. by rewrite (le_trans ca) ?bnd_simp// (le_trans _ bd) ?bnd_simp. Qed. Lemma polyrN0_itv (i : interval R) (p : {poly R}) : {in i, noroot p} -> {in i & , forall y x : R, sgr p.[x] = sgr p.[y]}. Proof. move=> hi y x hy hx; wlog xy: x y hx hy / x <= y => [hwlog|]. by case/orP: (le_total x y)=> xy; [|symmetry]; apply: hwlog. have hxyi: {subset `[x, y] <= i} by apply/subitvP; rewrite sub_cc_itv. have [r _ rin|] := @has_itv_rootP p x y xy. by rewrite (negPf (hi _ _)) // hxyi. rewrite -sgr_cp0 sgrM eq_sym; do 2!case: sgzP => //; by rewrite ?(mul0r, mulr0, mul1r, mulr1, oner_eq0) // => _ _ /eqP. Qed. Lemma nth_root x n : x > 0 -> { y | y > 0 & y ^+ (n.+1) = x }. Proof. move=> x_gt0; apply/sig2_eqW; pose p := ('X ^+ n.+1 - x%:P). have xS_ge1: x + 1 >= 1 by rewrite ler_wpDl // ltW. have xS_ge0: x + 1 > 0 by rewrite (lt_le_trans (@ltr01 _)). have [//||y /andP[y_ge0 _]] := @poly_ivtW _ p 0 (x + 1); first exact: ltW. rewrite !(hornerE, horner_exp) expr0n /= sub0r oppr_le0 (ltW x_gt0) /=. by rewrite subr_ge0 (le_trans _ (ler_eXnr _ _)) // ler_wpDr ?ler01. rewrite /root !(hornerE, horner_exp) subr_eq0 => /eqP x_eq; exists y => //. rewrite lt_neqAle y_ge0 andbT; apply: contra_eqN x_eq => /eqP<-. by rewrite eq_sym expr0n gt_eqF. Qed. (* REMOVE or DISPLACE *) Lemma poly_div_factor (a : R) (P : {poly R} -> Prop) : (forall k, P k%:P) -> (forall p n k, ~~ root p a -> P p -> P (p * ('X - a%:P) ^+ n.+1 + k%:P)%R) -> forall p, P p. Proof. move=> Pk Pq p; elim: size {-2}p (leqnn (size p)) => {p} [p|n ihn p size_p]. by rewrite size_poly_leq0 => /eqP->; apply: Pk. have [/size1_polyC->//|p_gt1] := leqP (size p) 1. have p_neq0 : p != 0 by rewrite -size_poly_eq0 -lt0n ltnW. rewrite (Pdiv.IdomainMonic.divp_eq (monicXsubC a) p). have [n' [q /implyP rqa pmod_eq]] := multiplicity_XsubC (p %/ ('X - a%:P)) a. have Xsuba_neq0 : 'X - a%:P != 0 by rewrite -size_poly_eq0 size_XsubC. have /size1_polyC-> : (size (p %% ('X - a%:P))%R <= 1)%N. by rewrite -ltnS (leq_trans (ltn_modpN0 _ _))// ?size_XsubC. rewrite pmod_eq -mulrA -exprSr; apply: Pq; last apply: ihn. by rewrite rqa// divpN0// ?size_XsubC. have [->//|q_neq0] := eqVneq q 0; first by rewrite size_poly0. rewrite (@leq_trans (size (q * ('X - a%:P) ^ n')))//. rewrite size_Mmonic// ?monic_exp ?monicXsubC//. by rewrite size_exp_XsubC addnS/= leq_addr. rewrite -pmod_eq -ltnS (leq_trans _ size_p)// ltn_divpl//. by rewrite size_Mmonic// ?monicXsubC// ?size_XsubC ?addn2. Qed. Lemma poly_ltsp_roots p (rs : seq R) : (size rs >= size p)%N -> uniq rs -> all (root p) rs -> p = 0. Proof. move=> hrs urs rrs; apply/eqP; apply: contraLR hrs=> np0. by rewrite -ltnNge; apply: max_poly_roots. Qed. Theorem poly_rolle a b p : a < b -> p.[a] = p.[b] -> {c | c \in `]a, b[ & p^`().[c] = 0}. Proof. gen have rolle_weak : a b p / a < b -> p.[a] = 0 -> p.[b] = 0 -> {c | (c \in `]a, b[) & (p^`().[c] == 0) || (p.[c] == 0)}. move=> lab pa0 pb0; have ltab := ltW lab; apply/sig2W. have [->|p_neq0] := eqVneq p 0. by exists (mid a b); rewrite ?mid_in_itv// derivC horner0 eqxx. have [n [p' p'a0 hp]] := multiplicity_XsubC p a; rewrite p_neq0 /= in p'a0. case: n hp pa0 p_neq0 pb0 p'a0 => [ | n -> _ p0 pb0 p'a0]. by rewrite {1}expr0 mulr1 rootE=> ->; move/eqP->. have [m [q qb0 hp']] := multiplicity_XsubC p' b. rewrite (contraNneq _ p'a0) /= in qb0 => [|->]; last exact: root0. case: m hp' pb0 p0 p'a0 qb0=> [|m]. rewrite {1}expr0 mulr1=> ->; move/eqP. rewrite !(hornerE, horner_exp, mulf_eq0). by rewrite !expf_eq0 !subr_eq0 !(gt_eqF lab) !andbF !orbF !rootE=> ->. move=> -> _ p0 p'a0 qb0; case: (sgrP (q.[a] * q.[b])); first 2 last. - move=> /poly_ivtoo [] // c lacb rqc; exists c=> //. by rewrite !hornerM (eqP rqc) !mul0r eqxx orbT. - move/eqP; rewrite mulf_eq0 (rootPf qb0) orbF; move/eqP=> qa0. by move: p'a0; rewrite ?rootM rootE qa0 eqxx. move=> hspq; rewrite !derivCE /= !mul1r mulrDl !pmulrn. set xan := (('X - a%:P) ^+ n); set xbm := (('X - b%:P) ^+ m). have ->: ('X - a%:P) ^+ n.+1 = ('X - a%:P) * xan by rewrite exprS. have ->: ('X - b%:P) ^+ m.+1 = ('X - b%:P) * xbm by rewrite exprS. rewrite -mulrzl -[_ *~ n.+1]mulrzl. have fac : forall x y z : {poly R}, x * (y * xbm) * (z * xan) = (y * z * x) * (xbm * xan). by move=> x y z; rewrite mulrCA !mulrA [_ * y]mulrC mulrA. rewrite !fac -!mulrDl; set r := _ + _ + _. case: (@poly_ivtoo (sgr q.[b] *: r) a b) => // [|c lecb]. rewrite !hornerZ mulrACA -expr2 sqr_sg (rootPf qb0) mul1r. rewrite !(subrr, mul0r, mulr0, addr0, add0r, hornerC, hornerXsubC, hornerD, hornerN, hornerM, hornerMn) [_ * _%:R]mulrC. rewrite mulrACA pmulr_llt0 // mulrACA pmulr_rlt0 ?mulr_gt0 ?ltr0n //. by rewrite -opprB mulNr oppr_lt0 mulr_gt0 ?subr_gt0. rewrite rootE hornerZ mulf_eq0 sgr_cp0 (rootPf qb0) orFb => rc0. by exists c => //; rewrite !hornerM !mulf_eq0 rc0. move=> lab pab; wlog pb0 : p pab / p.[b] = 0 => [hwlog|]. case: (hwlog (p - p.[b]%:P)); rewrite ?hornerE ?pab ?subrr //. by move=> c acb; rewrite derivE derivC subr0=> hc; exists c. move: pab; rewrite pb0=> pa0. have: (forall rs : seq R, {subset rs <= `]a, b[} -> (size p <= size rs)%N -> uniq rs -> all (root p) rs -> p = 0). by move=> rs hrs; apply: poly_ltsp_roots. elim: (size p) a b lab pa0 pb0=> [|n ihn] a b lab pa0 pb0 max_roots. rewrite (@max_roots [::]) //=. by exists (mid a b); rewrite ?mid_in_itv // derivE horner0. case: (@rolle_weak a b p); rewrite // ?pa0 ?pb0 //=. move=> c hc; case: (altP (_ =P 0))=> //= p'c0 pc0; first by exists c. suff: { d : R | d \in `]a, c[ & (p^`()).[d] = 0 }. case=> [d hd] p'd0; exists d=> //. by apply: subitvPr hd; rewrite bnd_simp (itvP hc). apply: ihn => //; [by rewrite (itvP hc)|exact/eqP|]. move=> rs hrs srs urs rrs; apply: (max_roots (c :: rs))=> //=; last exact/andP. move=> x; rewrite in_cons; case/predU1P=> hx; first by rewrite hx. have: x \in `]a, c[ by apply: hrs. by apply: subitvPr; rewrite bnd_simp (itvP hc). by rewrite urs andbT; apply/negP => /hrs; rewrite bound_in_itv. Qed. Theorem poly_mvt a b p : a < b -> {c | c \in `]a, b[ & p.[b] - p.[a] = p^`().[c] * (b - a)}. Proof. pose q := (p.[b] - p.[a])%:P * ('X - a%:P) - (b - a)%:P * (p - p.[a]%:P). move=> lt_ab; have [//||c le_acb q'x0] := @poly_rolle a b q. by rewrite /q !hornerE !(subrr,mulr0) mulrC subrr. exists c=> //; move: q'x0; rewrite /q !derivE !(mul0r,add0r,subr0,mulr1). by move/eqP; rewrite !hornerE mulrC subr_eq0; move/eqP. Qed. Lemma poly_lipshitz p a b : { k | k >= 1 & {in `[a, b] &, forall x y, `|p.[y] - p.[x]| <= k * `|y - x| }}. Proof. have [ub p_le] := @poly_itv_bound _ p^`() a b; exists (1 + `|ub|). by rewrite lerDl. move=> x y xi yi; wlog lt_xy : x y xi yi / x < y => [hw|]. set d := `|y - _|; have [/hw->//|xy|xy//] := ltrgtP x y; last first. by rewrite /d xy !subrr normr0 mulr0. by rewrite /d (distrC y) (distrC p.[y]) hw. have [c ci ->] := poly_mvt p lt_xy; rewrite normrM ler_pM2r ?p_le //; last first. by rewrite ?normr_gt0 ?subr_eq0 gt_eqF. rewrite ler_wpDl // (le_trans _ (ler_norm _)) // p_le //. by have: c \in `[a, b] by apply: subitvP ci; rewrite sub_oo_itv. Qed. Lemma poly_cont x p e : e > 0 -> exists2 d, d > 0 & forall y, `|y - x| < d -> `|p.[y] - p.[x]| < e. Proof. move=> e_gt0; have [k k_ge1 kP] := poly_lipshitz p (x - e) (x + e). have k_gt0 : k > 0 by rewrite (lt_le_trans ltr01). exists (e / k) => [|y]; first by rewrite mulr_gt0 ?invr_gt0. have [y_small|y_big] := lerP `|y - x| e. rewrite ltr_pdivlMr // mulrC; apply/le_lt_trans/kP => //; by rewrite -![_ \in _]ler_distl ?subrr ?normr0 // ?ltW. by move=> /(lt_trans y_big); rewrite ltr_pMr // invf_gt1 // le_gtF. Qed. Lemma ler_hornerW a b p : (forall x, x \in `]a, b[ -> p^`().[x] >= 0) -> {in `[a, b] &, {homo horner p : x y / x <= y}}. Proof. move=> der_nneg x y axb ayb; rewrite le_eqVlt => /orP[/eqP->//|ltxy]. have [c xcy /(canRL (@subrK _ _))->]:= poly_mvt p ltxy. rewrite lerDr mulr_ge0 ?subr_ge0 ?(ltW ltxy) ?der_nneg //. by apply: subitvP xcy; rewrite /(_ <= _)%O/= !bnd_simp ?(itvP axb) ?(itvP ayb). Qed. End Prelim. Lemma le_itv (a a' b b' : itv_bound R) : (Interval a b <= Interval a' b')%O = (a' <= a)%O && (b <= b')%O. Proof. by []. Qed. Section MonotonictyAndRoots. Section DerPos. Variable (p : {poly R}). Variables (a b : R). Hypothesis der_gt0 : forall x, x \in `]a, b[ -> (p^`()).[x] > 0. Lemma ltr_hornerW : {in `[a, b] &, {homo horner p : x y / x < y}}. Proof. move=> x y axb ayb ltxy; have [c xcy /(canRL (@subrK _ _))->]:= poly_mvt p ltxy. rewrite ltrDr mulr_gt0 ?subr_gt0 ?der_gt0 //. apply: subitvP xcy; rewrite le_itv !bnd_simp. by rewrite /= (itvP axb) (itvP ayb). Qed. Lemma ler_horner : {in `[a, b] &, {mono horner p : x y / x <= y}}. Proof. exact/le_mono_in/ltr_hornerW. Qed. Lemma ltr_horner : {in `[a, b] &, {mono horner p : x y / x < y}}. Proof. exact/leW_mono_in/ler_horner. Qed. Lemma derp_inj : {in `[a, b] &, injective (horner p)}. Proof. exact/inc_inj_in/ler_horner. Qed. Lemma derpr x : x \in `]a, b] -> p.[x] > p.[a]. Proof. by move=> axb; rewrite ltr_horner ?(itvP axb) // subset_itv_oc_cc. Qed. Lemma derpl x : x \in `[a, b[ -> p.[x] < p.[b]. Proof. by move=> axb; rewrite ltr_horner ?(itvP axb) // subset_itv_co_cc. Qed. Lemma derprW x : x \in `[a, b] -> p.[x] >= p.[a]. Proof. by move=> axb; rewrite ler_horner ?(itvP axb). Qed. Lemma derplW x : x \in `[a, b] -> p.[x] <= p.[b]. Proof. by move=> axb; rewrite ler_horner ?(itvP axb). Qed. End DerPos. Section NoRoot_sg. Variable (p : {poly R}). Variables (a b c : R). Hypothesis lt_ab : a < b. Hypothesis derp_neq0 : {in `]a, b[, noroot p^`()}. Let mid_in : mid a b \in `]a, b[. Proof. exact: mid_in_itv. Qed. Hint Resolve mid_in : core. Local Notation s := (p^`().[mid a b] < 0). Local Notation sp' := ((- 1) ^+ s). Let q := (sp' *: p). Lemma sgr_sign : sgr ((-1) ^+ s) = (-1) ^+ s :> R. Proof. by case: s; rewrite ?(sgr1, sgrN1). Qed. Fact signpE : p = (sp' *: q). Proof. by rewrite scalerA [_ ^+ _ * _]sqrr_sign scale1r. Qed. Fact sgp x : sgr p.[x] = sp' * sgr q.[x]. Proof. by rewrite {1}signpE hornerZ sgrM sgr_sign. Qed. Fact derq_gt0 x : x \in `]a, b[ -> (q^`()).[x] > 0. Proof. move=> hx; rewrite derivZ hornerZ -sgr_cp0 neqr0_sign ?(derp_neq0 _) //. rewrite sgrM sgr_id mulr_sg_eq1 ?derp_neq0 //=. by apply/eqP; apply: (@polyrN0_itv `]a, b[). Qed. Hint Resolve derq_gt0 : core. Lemma lgtr_horner : {in `[a, b] &, forall x y, p.[x] < p.[y] = (sp' * x < sp' * y)}. Proof. move=> x y axb ayb; rewrite /= [in LHS]signpE ![(_ *: q).[_]]hornerZ. by case: s; rewrite ?mul1r ?mulN1r ?ltrN2 (ltr_horner derq_gt0). Qed. Lemma lger_horner : {in `[a, b] &, forall x y, p.[x] <= p.[y] = (sp' * x <= sp' * y)}. Proof. move=> x y axb ayb; rewrite /= [in LHS]signpE ![(_ *: q).[_]]hornerZ. by case: s; rewrite ?mul1r ?mulN1r ?lerN2 (ler_horner derq_gt0). Qed. Lemma horner_inj : {in `[a, b] &, injective (horner p)}. Proof. move=> x y xab yab; rewrite signpE ![(_ *: q).[_]]hornerE. by move=> /mulfI /(derp_inj derq_gt0)-> //; rewrite signr_eq0. Qed. Lemma uniq_root : {in `[a, b] &, forall x y, root p x -> root p y -> x = y}. Proof. by move=> x y ?? /eqP? /eqP rpy; apply: horner_inj; rewrite //rpy. Qed. Lemma sgrB (x y : R) : sgr (x - y) = (- 1) ^+ (x < y)%R *+ (x != y). Proof. case: ltrgtP => //= [xy|xy|->]; last by rewrite subrr sgr0. by rewrite ltr0_sg ?subr_lt0. by rewrite gtr0_sg ?subr_gt0. Qed. Lemma root_sgp : {in `[a, b] &, forall x y, root p x -> sgr p.[y] = (- 1) ^+ s * sgr (y - x)}. Proof. move=> x y xab yab rpx; rewrite {1}signpE hornerZ sgrM sgr_sign; congr (_ * _). have rqx : root q x by rewrite /root hornerZ mulf_eq0 [p.[_] == _]rpx orbT. rewrite sgrB; have [xy|xy|<-]/= := ltrgtP x y; last first. - by rewrite hornerZ sgrM (eqP rpx) sgr0 mulr0. - by apply/eqP; rewrite sgr_cp0 -(eqP rqx) (ltr_horner derq_gt0). - by apply/eqP; rewrite sgr_cp0 -(eqP rqx) (ltr_horner derq_gt0). Qed. Lemma root_has_ivt r : r \in `[a, b] -> root p r -> {in `[a, r] & `[r, b], forall x y, p.[x] * p.[y] <= 0}. Proof. move=> rab rpr x y xar yrb; rewrite -sgr_le0 sgrM. have xab : x \in `[a, b] by apply: subitvP xar; rewrite /= le_itv !bnd_simp ?(itvP rab). have yab : y \in `[a, b] by apply: subitvP yrb; rewrite /= le_itv !bnd_simp ?(itvP rab). rewrite ?(root_sgp _ _ rpr)// mulrACA [_ ^+ _ * _]sqrr_sign mul1r -sgrM sgr_le0. by rewrite mulr_le0_ge0 ?subr_ge0 ?subr_le0 ?(itvP xar) ?(itvP yrb). Qed. Lemma noroot_noivt : {in `[a, b], forall r, ~~ root p r} -> {in `[a, b] &, forall x y, p.[x] * p.[y] > 0}. Proof. move=> rpr x y xar yrb; wlog lt_xy : x y xar yrb / x <= y => [hw|]. by have /orP[/hw->//|/hw] := le_total x y; rewrite mulrC; apply. rewrite ltNge; case: has_itv_rootP => // r _ r_in. rewrite (negPf (rpr _ _)) //; apply: subitvP r_in; by rewrite le_itv !bnd_simp /= ?(itvP xar) ?(itvP yrb). Qed. Fact gtr0_sgp x : 0 < q.[x] -> sgr p.[x] = sp'. Proof. by move=> qx_gt0; rewrite sgp gtr0_sg ?mulr1. Qed. Fact ltr0_sgpN x : q.[x] < 0 -> sgr p.[x] = - sp'. Proof. by move=> qx_gt0; rewrite sgp ltr0_sg ?mulrN1. Qed. Lemma root_dersr : p.[a] = 0 -> {in `]a, b], forall x, sgr p.[x] = sp'}. Proof. move=> pa0 x xab; have qa0 : q.[a] = 0 by rewrite hornerE pa0 mulr0. by rewrite gtr0_sgp// -qa0 (derpr derq_gt0). Qed. Lemma derspr : sgr p.[a] = sp' -> {in `[a, b], forall x, sgr p.[x] = sp'}. Proof. move=> pa_sp' x xab; rewrite gtr0_sgp// (lt_le_trans _ (derprW derq_gt0 _))//. by rewrite hornerE -sgr_cp0 sgrM sgr_sign pa_sp' [_ * _]sqrr_sign. Qed. Lemma root_dersl : p.[b] = 0 -> {in `[a, b[, forall x, sgr p.[x] = - sp'}. Proof. move=> pb0 x xab; have qb0 : q.[b] = 0 by rewrite hornerE pb0 mulr0. by rewrite ltr0_sgpN// -qb0 (derpl derq_gt0). Qed. Lemma derspl : sgr p.[b] = - sp' -> forall x, x \in `[a, b] -> sgr p.[x] = - sp'. Proof. move=> pbNsp' x xab; rewrite ltr0_sgpN// (le_lt_trans (derplW derq_gt0 _))//. by rewrite hornerE -sgr_cp0 sgrM sgr_sign pbNsp' mulrN [_ * _]sqrr_sign. Qed. End NoRoot_sg. Section DerNeg. Variable (p : {poly R}). Variables (a b : R). Hypothesis der_neg : forall x, x \in `]a, b[ -> (p^`()).[x] < 0. Let dern_gt0 x : x \in `]a, b[ -> ((- p)^`()).[x] > 0. Proof. by move=> axb; rewrite derivN hornerN oppr_gt0 der_neg. Qed. Lemma gtr_hornerW : {in `[a, b] &, {homo horner p : x y /~ x < y}}. Proof. by move=> x y axb ayb yx; rewrite -ltrN2 -!hornerN (ltr_hornerW dern_gt0). Qed. Lemma ger_horner : {in `[a, b] &, {mono horner p : x y /~ x <= y}}. Proof. exact/le_nmono_in/gtr_hornerW. Qed. Lemma gtr_horner : {in `[a, b] &, {mono horner p : x y /~ x < y}}. Proof. exact/leW_nmono_in/ger_horner. Qed. Lemma dernr x : x \in `]a, b] -> p.[x] < p.[a]. Proof. by move=> axb; rewrite gtr_horner ?(itvP axb) //; apply: subset_itv_oc_cc. Qed. Lemma dernl x : x \in `[a, b[ -> p.[x] > p.[b]. Proof. by move=> axb; rewrite gtr_horner ?(itvP axb) //; apply: subset_itv_co_cc. Qed. Lemma dernrW x : x \in `[a, b] -> p.[x] <= p.[a]. Proof. by move=> axb; rewrite ger_horner ?(itvP axb). Qed. Lemma dernlW x : x \in `[a, b] -> p.[x] >= p.[b]. Proof. by move=> axb; rewrite ger_horner ?(itvP axb). Qed. End DerNeg. Variable (p : {poly R}) (a b : R). Section der_root. Hypothesis der_pos : forall x, x \in `]a, b[ -> (p^`()).[x] > 0. Lemma derp_root : a <= b -> p.[a] * p.[b] < 0 -> { r : R | [/\ forall x, x \in `[a, r[ -> p.[x] < 0, p.[r] = 0, r \in `]a, b[ & forall x, x \in `]r, b] -> p.[x] > 0] }. Proof. move=> leab hpab; have [r arb pr0] := poly_ivtoo leab hpab. exists r; split => //; last 2 first. - by move/eqP: pr0. - move=> x rxb; have hd : forall t, t \in `]r, b[ -> 0 < (p^`()).[t]. by move=> t ht; rewrite der_pos // ?(subitvPl _ ht) /<=%O //= ?(itvP arb). by rewrite (le_lt_trans _ (derpr hd _)) ?(eqP pr0). - move=> x rxb; have hd : forall t, t \in `]a, r[ -> 0 < (p^`()).[t]. by move=> t ht; rewrite der_pos // ?(subitvPr _ ht) /<=%O //= ?(itvP arb). by rewrite (lt_le_trans (derpl hd _)) ?(eqP pr0). Qed. End der_root. End MonotonictyAndRoots. Section RootsOn. Variable T : predType R. Definition roots_on (p : {poly R}) (i : T) (s : seq R) := forall x, (x \in i) && (root p x) = (x \in s). Lemma roots_onP p i s : roots_on p i s -> {in i, root p =1 mem s}. Proof. by move=> hp x hx; move: (hp x); rewrite hx. Qed. Lemma roots_on_in p i s : roots_on p i s -> forall x, x \in s -> x \in i. Proof. by move=> hp x; rewrite -hp; case/andP. Qed. Lemma roots_on_root p i s : roots_on p i s -> forall x, x \in s -> root p x. Proof. by move=> hp x; rewrite -hp; case/andP. Qed. Lemma root_roots_on p i s : roots_on p i s -> forall x, x \in i -> root p x -> x \in s. Proof. by move=> hp x; rewrite -hp=> ->. Qed. Lemma roots_on_opp p i s : roots_on (- p) i s -> roots_on p i s. Proof. by move=> hp x; rewrite -hp rootN. Qed. Lemma roots_on_nil p i : roots_on p i [::] -> {in i, noroot p}. Proof. by move=> hp x hx; move: (hp x); rewrite in_nil hx /=; move->. Qed. Lemma roots_on_same s' p i s : s =i s' -> (roots_on p i s <-> roots_on p i s'). Proof. by move=> hss'; split=> hs x; rewrite (hss', (I, hss')). Qed. End RootsOn. (* (* Symmetry of center a *) *) (* Definition symr (a x : R) := a - x. *) (* Lemma symr_inv : forall a, involutive (symr a). *) (* Proof. by move=> a y; rewrite /symr opprD addrA subrr opprK add0r. Qed. *) (* Lemma symr_inj : forall a, injective (symr a). *) (* Proof. by move=> a; apply: inv_inj; apply: symr_inv. Qed. *) (* Lemma ltr_sym : forall a x y, (symr a x < symr a y) = (y < x). *) (* Proof. by move=> a x y; rewrite lterD2rr lterNr opprK. Qed. *) (* Lemma symr_add_itv : forall a b x, *) (* (a < symr (a + b) x < b) = (a < x < b). *) (* Proof. *) (* move=> a b x; rewrite andbC. *) (* by rewrite lter_subrA lterD2rr -lter_addlA lterD2rl. *) (* Qed. *) Lemma roots_on_comp p a b s : roots_on (p \Po (-'X)) `](-b), (-a)[ (map (-%R) s) <-> roots_on p `]a, b[ s. Proof. split=> /= hs x; rewrite ?root_comp ?hornerE. move: (hs (- x)); rewrite (mem_map oppr_inj). by rewrite root_comp ?hornerE oppr_itv !opprK. by rewrite -[x]opprK oppr_itv /= (mem_map oppr_inj) -(hs (- x)) !opprK. Qed. Lemma min_roots_on p a b x s : all (> x) s -> roots_on p `]a, b[ (x :: s) -> [/\ x \in `]a, b[, roots_on p `]a, x[ [::], root p x & roots_on p `]x, b[ s]. Proof. move=> lxs hxs. have hx: x \in `]a, b[ by rewrite (roots_on_in hxs) ?mem_head. rewrite hx (roots_on_root hxs) ?mem_head //. split=> // y; move: (hxs y); rewrite ?in_nil ?in_cons /=. case hy: (y \in `]a, x[)=> //=. rewrite (subitvPr _ hy) /<=%O /= ?lt_eqF ?(itvP hx) ?(itvP hy) //= => ->. by apply/negP; move/allP: lxs=> lxs /lxs; rewrite ?(itvP hy). case: eqVneq => [-> _|eyx]. by rewrite boundl_in_itv; apply/esym/negP; move/(allP lxs); rewrite ltxx. case: root; rewrite !(andbT, andbF) // !in_itv /=. case: (boolP (y \in s)) (allP lxs y) => [_ /(_ isT) -> /andP [] // | ys _]. by apply/contraFF => /andP [xy ->]; rewrite (lt_trans _ xy) ?(itvP hx). Qed. Lemma max_roots_on p a b x s : all (< x) s -> roots_on p `]a, b[ (x :: s) -> [/\ x \in `]a, b[, roots_on p `]x, b[ [::], root p x & roots_on p `]a, x[ s]. Proof. move/allP=> lsx /roots_on_comp/=/min_roots_on[]. apply/allP=> y; rewrite -[y]opprK (mem_map oppr_inj). by move/lsx; rewrite ltrN2. rewrite oppr_itv root_comp !hornerE !opprK=> -> rxb -> rax. by split=> //; apply/roots_on_comp. Qed. Lemma roots_on_cons p a b r s : sorted <%R (r :: s) -> roots_on p `]a, b[ (r :: s) -> roots_on p `]r, b[ s. Proof. move=> /= hrs hr. have allrs := order_path_min lt_trans hrs. by case: (min_roots_on allrs hr). Qed. (* move=> p a b r s hp hr x; apply/andP/idP. *) (* have:= (order_path_min (@ltr_trans _) hp) => /=; case/andP=> ar1 _. *) (* case; move/ooitvP=> rxb rpx; move: (hr x); rewrite in_cons rpx andbT. *) (* by rewrite rxb andbT (ltr_trans ar1) 1?eq_sym ?ltr_eqF ?rxb. *) (* move=> spx. *) (* have xrsp: x \in r :: s by rewrite in_cons spx orbT. *) (* rewrite (roots_on_root hr) //. *) (* rewrite (roots_on_in hr xrsp); move: hp => /=; case/andP=> _. *) (* by move/(order_path_min (@ltr_trans _)); move/allP; move/(_ _ spx)->. *) (* Qed. *) Lemma roots_on_rcons : forall p a b r s, sorted <%R (rcons s r) -> roots_on p `]a, b[ (rcons s r) -> roots_on p `]a, r[ s. Proof. move=> p a b r s; rewrite -{1}[s]revK -!rev_cons rev_sorted /=. move=> hrs /(@roots_on_same _ _ _ _ (r::s)) hr. have allrrs := order_path_min (rev_trans lt_trans) hrs. have allrs: all (< r) s. by apply/allP => x hx; apply: (allP allrrs); rewrite mem_rev. by case: (max_roots_on allrs (hr _))=> // x; rewrite mem_rcons. Qed. (* move=> p a b r s; rewrite -{1}[s]revK -!rev_cons rev_sorted. *) (* rewrite [r :: _]lock /=; unlock; move=> hp hr x; apply/andP/idP. *) (* have:= (order_path_min (rev_trans (@ltr_trans _)) hp) => /=. *) (* case/andP=> ar1 _; case; move/ooitvP=> axr rpx. *) (* move: (hr x); rewrite mem_rcons in_cons rpx andbT axr andTb. *) (* by rewrite ((rev_trans (@ltr_trans _) ar1)) ?ltr_eqF ?axr. *) (* move=> spx. *) (* have xrsp: x \in rcons s r by rewrite mem_rcons in_cons spx orbT. *) (* rewrite (roots_on_root hr) //. *) (* rewrite (roots_on_in hr xrsp); move: hp => /=; case/andP=> _. *) (* move/(order_path_min (rev_trans (@ltr_trans _))); move/allP. *) (* by move/(_ x)=> -> //; rewrite mem_rev. *) (* Qed. *) Lemma no_roots_on (p : {poly R}) a b : {in `]a, b[, noroot p} -> roots_on p `]a, b[ [::]. Proof. by move=> hr x; case: (boolP (x \in _)) => //= /hr /negPf. Qed. Lemma monotonic_rootN (p : {poly R}) (a b : R) : {in `]a, b[, noroot p^`()} -> ((roots_on p `]a, b[ [::]) + ({r : R | roots_on p `]a, b[ [:: r]}))%type. Proof. move=> hp'; case: (ltrP a b); last first => leab. by left => x; rewrite in_nil itv_ge // -leNgt. wlog {hp'} hp'sg: p / forall x, x \in `]a, b[ -> sgr (p^`()).[x] = 1. move=> hwlog; move: (mid_in_itvoo leab) (polyrN0_itv hp') => hm /(_ _ _ hm). case: (sgrP _.[mid a b])=> hpm. - by move: (hp' _ hm); rewrite rootE hpm eqxx. - by move/(hwlog p). - move=> hp'N; case: (hwlog (-p))=> [x|h|[r hr]]. * by rewrite derivE hornerN sgrN=> /hp'N->; rewrite opprK. * by left; apply: roots_on_opp. * by right; exists r; apply: roots_on_opp. have hp'pos x : x \in `]a, b[ -> (p^`()).[x] > 0. by move=> /hp'sg /eqP; rewrite sgr_cp0. case: (lerP 0 p.[a]) => ha. left; apply: no_roots_on => x axb; rewrite rootE gt_eqF //. by rewrite (le_lt_trans _ (derpr hp'pos _))// (subitvPr _ axb) /<=%O /=. case: (lerP p.[b] 0) => hb. left => x; case: (boolP (x \in _)) => //= axb; rewrite rootE lt_eqF //. by rewrite (lt_le_trans (derpl hp'pos _)) // (subitvPl _ axb) /<=%O /=. case: (derp_root hp'pos (ltW leab) _) => [|r [h1 h2 h3] h4]; first by rewrite pmulr_llt0. right; exists r => x; rewrite in_cons in_nil (itv_splitUeq h3). have [->|exr] := eqVneq; rewrite ?orbT ?orbF /=; first by apply/eqP. case: rootP => px0; rewrite (andbT, andbF) //; apply/negP; case/orP=> hx. by move: (h1 x); rewrite (subitvPl _ hx) /<=%O //= px0 ltxx; move/implyP. by move: (h4 x); rewrite (subitvPr _ hx) /<=%O //= px0 ltxx; move/implyP. Qed. (* Inductive polN0 : Type := PolN0 : forall p : {poly R}, p != 0 -> polN0. *) (* Coercion pol_of_polN0 i := let: PolN0 p _ := i in p. *) (* Canonical Structure polN0_subType := [subType for pol_of_polN0]. *) (* Definition polN0_eqMixin := Eval hnf in [eqMixin of polN0 by <:]. *) (* Canonical Structure polN0_eqType := *) (* Eval hnf in EqType polN0 polN0_eqMixin. *) (* Definition polN0_choiceMixin := [choiceMixin of polN0 by <:]. *) (* Canonical Structure polN0_choiceType := *) (* Eval hnf in ChoiceType polN0 polN0_choiceMixin. *) (* Todo : Lemmas about operations of intervall : itversection, restriction and splitting *) Lemma cat_roots_on (p : {poly R}) a b x : x \in `]a, b[ -> ~~ (root p x) -> forall s s', sorted <%R s -> sorted <%R s' -> roots_on p `]a, x[ s -> roots_on p `]x, b[ s' -> roots_on p `]a, b[ (s ++ s'). Proof. move=> hx /= npx0 s; elim: s a hx => [|y s ihs] a hx s' //= ss ss'. move/roots_on_nil=> hax hs' y; rewrite -hs' (itv_splitUeq hx). case: eqP => [->|_]; rewrite ?(negPf npx0) ?andbF //=. by case: (boolP (y \in `]a, x[)) => [/hax/negPf ->|]; rewrite ?andbF. move/min_roots_on; rewrite (order_path_min lt_trans) //. case=> // hy hay py0 hs hs' z. rewrite in_cons (@itv_splitUeq _ _ y); last first. by rewrite (subitvPr _ hy) /<=%O //= (itvP hx). have [->|ezy] := eqVneq; rewrite ?orbT //= -(ihs y) //. - by case: (z \in `]y, b[); rewrite ?orbF ?orbT //= (hay z). - by rewrite in_itv /= (itvP hx) (itvP hy). - exact: path_sorted ss. Qed. Variant roots_spec (p : {poly R}) (i : pred R) (s : seq R) : {poly R} -> bool -> seq R -> Type := | Roots0 of p = 0 :> {poly R} & s = [::] : roots_spec p i s 0 true [::] | Roots of p != 0 & roots_on p i s & sorted <%R s : roots_spec p i s p false s. (* still much too long *) Lemma itv_roots (p :{poly R}) (a b : R) : {s : seq R & roots_spec p (topred `]a, b[) s p (p == 0) s}. Proof. elim: (size p) {-2}p (leqnn (size p)) a b => {p} [|n ihn] p sp a b. by move/size_poly_leq0P: sp => ->; rewrite eqxx; exists [::]; constructor. case: eqVneq => [->|p0]; first by exists [::]; constructor. case: (boolP (p^`() == 0)) => [|p'0]. rewrite -derivn1 -derivn_poly0 => /size1_polyC pC; exists [::]. by constructor=> // x; rewrite pC rootC -polyC_eq0 -pC (negPf p0) andbF. have {}/ihn /(_ a b) [sp'] : (size p^`() <= n)%N. rewrite -ltnS; apply: leq_trans sp; rewrite size_deriv prednK // lt0n. by rewrite size_poly_eq0 p0. elim: sp' a => [|r1 sp' hsp'] a hp'. case: hp' p'0 => //= p'0 /roots_on_nil /monotonic_rootN [h| [r rh]] _ _. by exists [::]; constructor. by exists [:: r]; constructor; rewrite //= andbT. case: hp' p'0 => //= p'0 hroots' hpath' _. case: (min_roots_on _ hroots') => [|hr1 har1 p'r10 hr1b]. by rewrite order_path_min //; apply: lt_trans. case: (hsp' r1) p0 => [|s]. by rewrite (negPf p'0); constructor; rewrite // (path_sorted hpath'). case; rewrite ?eqxx // => p0 hroot hsort _. move/monotonic_rootN: (roots_on_nil har1). case pr1 : (root p r1); case => hrootsl; last 2 first. - exists s; constructor=> //. by rewrite -[s]cat0s; apply: (cat_roots_on hr1); rewrite // pr1. - case: hrootsl=> r hr; exists (r::s); constructor=> //=. by rewrite -cat1s; apply: (cat_roots_on hr1); rewrite // pr1. rewrite path_min_sorted //; apply/allP=> y; rewrite -hroot; case/andP=> hy _. rewrite (lt_trans (_ : _ < r1)) ?(itvP hy) //. by rewrite (itvP (roots_on_in hr (mem_head _ _))). - exists (r1::s); constructor=> //=; last first. rewrite path_min_sorted //; apply/allP => y; rewrite -hroot. by case/andP => /itvP->. move=> x; rewrite in_cons; have [->|exr1] /= := eqVneq; first by rewrite hr1. rewrite -hroot (itv_splitUeq hr1) (negPf exr1) /=. case: (_ \in `]r1, _[); rewrite (orbT, orbF); [by []|]. by apply: contraFF (hrootsl x) => ->. (* use // above and remove above line when requiring Coq >= 8.17 *) - case: hrootsl => r0 /min_roots_on [] // hr0 har0 pr0 hr0r1. exists [:: r0, r1 & s]; constructor=> //=; last first. rewrite (itvP hr0) /= path_min_sorted //; apply/allP=> y. by rewrite -hroot; case/andP => /itvP ->. move=> y; rewrite !in_cons (itv_splitUeq hr1) (itv_splitUeq hr0). have [->|eyr0] := eqVneq y r0; rewrite ?orbT ?pr0 //=. have [->|eyr1] := eqVneq y r1; rewrite ?orbT ?pr1 //=. move: (hr0r1 y) (har0 y); rewrite -!hroot. case: (_ \in `]r0, r1[) => /= [->|_]; rewrite ?andbF ?orbF //. by case: (_ \in `]a, r0[) => /= [->|_]; rewrite ?andbF. Qed. Definition roots (p : {poly R}) a b := projT1 (itv_roots p a b). Lemma rootsP p a b : roots_spec p (topred `]a, b[) (roots p a b) p (p == 0) (roots p a b). Proof. by rewrite /roots; case: itv_roots. Qed. Lemma roots0 a b : roots 0 a b = [::]. Proof. by case: rootsP=> //=; rewrite eqxx. Qed. Lemma roots_on_roots : forall p a b, p != 0 -> roots_on p `]a, b[ (roots p a b). Proof. by move=> a b p; case: rootsP. Qed. Hint Resolve roots_on_roots : core. Lemma sorted_roots a b p : sorted <%R (roots p a b). Proof. by case: rootsP. Qed. Hint Resolve sorted_roots : core. Lemma path_roots p a b : path <%R a (roots p a b). Proof. case: rootsP=> //= p0 hp sp; rewrite path_min_sorted //. by apply/allP=> y; rewrite -hp; case/andP => /itvP ->. Qed. Hint Resolve path_roots : core. Lemma root_is_roots (p : {poly R}) (a b : R) : p != 0 -> forall x, x \in `]a, b[ -> root p x = (x \in roots p a b). Proof. by case: rootsP=> // p0 hs ps _ y hy /=; rewrite -hs hy. Qed. Lemma root_in_roots (p : {poly R}) a b : p != 0 -> forall x, x \in `]a, b[ -> root p x -> x \in (roots p a b). Proof. by move=> p0 x axb rpx; rewrite -root_is_roots. Qed. Lemma root_roots p a b x : x \in roots p a b -> root p x. Proof. by case: rootsP=> // p0 <- _ /andP []. Qed. Lemma roots_nil p a b : p != 0 -> roots p a b = [::] -> {in `]a, b[, noroot p}. Proof. case: rootsP => // p0 hs ps _ s0 x axb. by move: (hs x); rewrite s0 in_nil !axb /= => ->. Qed. Lemma roots_in p a b x : x \in roots p a b -> x \in `]a, b[. Proof. by case: rootsP=> //= np0 ron_p *; apply: (roots_on_in ron_p). Qed. Lemma rootsEba p a b : b <= a -> roots p a b = [::]. Proof. case: rootsP=> // p0; case: (roots _ _ _) => [|x s] hs ps ba //; by move: (hs x); rewrite itv_ge -?leNgt //= mem_head. Qed. Lemma roots_on_uniq p a b s1 s2 : sorted <%R s1 -> sorted <%R s2 -> roots_on p `]a, b[ s1 -> roots_on p `]a, b[ s2 -> s1 = s2. Proof. wlog: s1 s2 / (size s1 <= size s2)%N => [hwlog ? ? ? ?|]. by case: (leqP (size s1) (size s2)) => [|/ltnW] /hwlog ->. elim: s1 p a b s2 => [| r1 s1 ih] p a b [| r2 s2] les12 ps1 ps2 rs1 rs2 //=. have rpr2 : root p r2 by apply: (roots_on_root rs2); rewrite mem_head. have abr2 : r2 \in `]a, b[ by apply: (roots_on_in rs2); rewrite mem_head. by have:= (rs1 r2); rewrite rpr2 !abr2 in_nil. have er1r2 : r1 = r2. move: (rs1 r2) (rs2 r1); rewrite rs2 rs1 !mem_head !in_cons //=. move=> /esym /predU1P [-> //|hr2] /esym /predU1P [-> //|hr1]. move/(order_path_min lt_trans)/allP/(_ r2 hr2): ps1 => h1. move/(order_path_min lt_trans)/allP/(_ r1 hr1)/(lt_trans h1): ps2. by rewrite ltxx. congr (_ :: _) => //; rewrite er1r2 in ps1 rs1. move: (roots_on_cons ps1 rs1) (roots_on_cons ps2 rs2). exact: ih (path_sorted ps1) (path_sorted ps2). Qed. Lemma roots_eq (p q : {poly R}) (a b : R) : p != 0 -> q != 0 -> ({in `]a, b[, root p =1 root q} <-> roots p a b = roots q a b). Proof. move=> p0 q0; split=> hpq; last first. by move=> x hx; rewrite !(root_is_roots _ hx) // hpq. apply: (@roots_on_uniq p a b); rewrite ?path_roots //. exact: roots_on_roots. move=> x; case hx: (_ \in _). by rewrite -hx hpq //; apply: roots_on_roots. by rewrite /= -(andFb (q.[x] == 0)) -hx; apply: roots_on_roots. Qed. Lemma roots_opp p : roots (- p) =2 roots p. Proof. move=> a b; have [->|p0] := eqVneq p 0; first by rewrite oppr0. by apply/roots_eq=> [||x]; rewrite ?oppr_eq0 ?p0 ?rootN. Qed. Lemma no_root_roots (p : {poly R}) a b : {in `]a, b[ , noroot p} -> roots p a b = [::]. Proof. move=> hr; case: rootsP => // p0 hs ps. apply: (@roots_on_uniq p a b)=> // x; rewrite in_nil. by apply/negP; case/andP => /hr/negPf->. Qed. Lemma head_roots_on_ge p a b s : a < b -> roots_on p `]a, b[ s -> a < head b s. Proof. case: s => [|x s] ab // /(_ x). by rewrite in_cons eqxx; case/andP; case/andP. Qed. Lemma head_roots_ge : forall p a b, a < b -> a < head b (roots p a b). Proof. by move=> p a b; case: rootsP=> // *; apply: head_roots_on_ge. Qed. Lemma last_roots_on_le p a b s : a < b -> roots_on p `]a, b[ s -> last a s < b. Proof. case: s => [|x s] ab rs //. by rewrite (itvP (roots_on_in rs _)) //= mem_last. Qed. Lemma last_roots_le p a b : a < b -> last a (roots p a b) < b. Proof. by case: rootsP=> // *; apply: last_roots_on_le. Qed. Lemma roots_uniq p a b s : p != 0 -> roots_on p `]a, b[ s -> sorted <%R s -> s = roots p a b. Proof. case: rootsP=> // p0 hs' ps' _ hs ss. exact: (@roots_on_uniq p a b)=> //. Qed. Lemma roots_cons p a b x s : (roots p a b == x :: s) = [&& p != 0, x \in `]a, b[, roots p a x == [::], root p x & roots p x b == s]. Proof. case: rootsP => //= p0 hs' ps'. apply/idP/idP. move/eqP=> es'; move: ps' hs'; rewrite es' /= => sxs. case/min_roots_on; first by apply: order_path_min=> //; apply: lt_trans. move=> -> rax px0 rxb. rewrite px0 (@roots_uniq p a x [::]) // (@roots_uniq p x b s) ?eqxx //=. by move/path_sorted:sxs. case: rootsP p0=> // p0 rax sax _. case/and3P=> hx hax; rewrite (eqP hax) in rax sax. case: rootsP p0=> // p0 rxb sxb _. case/andP=> px0 hxb; rewrite (eqP hxb) in rxb sxb. rewrite [_ :: _](@roots_uniq p a b) //; last first. rewrite /= path_min_sorted //; apply/allP => y. by rewrite -(eqP hxb); move/roots_in/itvP->. move=> y; rewrite (itv_splitUeq hx) !andb_orl in_cons. have [->|_] := eqVneq y x; first by rewrite px0 orbT. by rewrite andFb orFb rax rxb in_nil. Qed. Lemma roots_rcons p a b x s : (roots p a b == rcons s x) = [&& p != 0, x \in `]a , b[, roots p x b == [::], root p x & roots p a x == s]. Proof. case: rootsP; first by case: s. move=> // p0 hs' ps' /=. apply/idP/idP. move/eqP=> es'; move: ps' hs'; rewrite es' /= => sxs. have hsx: rcons s x =i x :: rev s. by move=> y; rewrite mem_rcons !in_cons mem_rev. move/(roots_on_same _ _ hsx). case/max_roots_on. move: sxs; rewrite -[rcons _ _]revK rev_sorted rev_rcons. by apply: order_path_min=> u v w /= /(lt_trans _); apply. move=> -> rax px0 /(@roots_on_same _ s); move/(_ (mem_rev _)) => rxb. rewrite px0 (@roots_uniq p x b [::]) // (@roots_uniq p a x s) ?eqxx //=. move: sxs; rewrite -[rcons _ _]revK rev_sorted rev_rcons. by move/path_sorted; rewrite -rev_sorted revK. case: rootsP p0=> // p0 rax sax _. case/and3P=> hx hax; rewrite (eqP hax) in rax sax. case: rootsP p0=> // p0 rxb sxb _. case/andP=> px0 hxb; rewrite (eqP hxb) in rxb sxb. rewrite [rcons _ _](@roots_uniq p a b) //; last first. rewrite -[rcons _ _]revK rev_sorted rev_rcons /= path_min_sorted. by rewrite -rev_sorted revK. apply/allP=> y; rewrite mem_rev; rewrite -(eqP hxb). by move/roots_in/itvP->. move=> y; rewrite (itv_splitUeq hx) mem_rcons in_cons !andb_orl. have [->|_] := eqVneq y x; first by rewrite px0 orbT. by rewrite rxb rax in_nil !orbF. Qed. Section NeighborHood. Implicit Types a b : R. Implicit Types p : {poly R}. Definition next_root (p : {poly R}) x b := if p == 0 then x else head (maxr b x) (roots p x b). Lemma next_root0 a b : next_root 0 a b = a. Proof. by rewrite /next_root eqxx. Qed. Variant next_root_spec (p : {poly R}) x b : bool -> R -> Type := | NextRootSpec0 of p = 0 : next_root_spec p x b true x | NextRootSpecRoot y of p != 0 & p.[y] = 0 & y \in `]x, b[ & {in `]x, y[, forall z, ~~(root p z)} : next_root_spec p x b true y | NextRootSpecNoRoot c of p != 0 & c = maxr b x & {in `]x, b[, forall z, ~~(root p z)} : next_root_spec p x b (p.[c] == 0) c. Lemma next_rootP (p : {poly R}) a b : next_root_spec p a b (p.[next_root p a b] == 0) (next_root p a b). Proof. rewrite /next_root /=; case hs: roots => [|x s] /=. case: (eqVneq p 0) hs => [->|p0] hs. by rewrite hornerC eqxx; constructor. by constructor=> // y hy; apply: (roots_nil p0 hs). move/eqP: hs; rewrite roots_cons; case/and5P=> p0 hx /eqP rap rpx rx. rewrite (negPf p0) (rootPt rpx); constructor=> //; first by apply/eqP. by move=> y hy; apply: (roots_nil p0 rap). Qed. Lemma next_root_in p a b : next_root p a b \in `[a, maxr b a]. Proof. case: next_rootP => [p0|y np0 py0 hy _|c np0 hc _]. * by rewrite bound_in_itv /<=%O /= le_max lexx orbT. * by apply: subitvP hy; rewrite /<=%O /= /<=%O /= le_max !lexx. * by rewrite hc bound_in_itv /<=%O /= le_max lexx orbT. Qed. Lemma next_root_gt p a b : a < b -> p != 0 -> next_root p a b > a. Proof. move=> ab np0; case: next_rootP=> [p0|y _ py0 hy _|c _ -> _]. * by rewrite p0 eqxx in np0. * by rewrite (itvP hy). * by rewrite lt_max ab. Qed. Lemma next_noroot p a b : {in `]a, (next_root p a b)[, noroot p}. Proof. move=> z; case: next_rootP; first by rewrite itv_xx. by move=> y np0 py0 hy hp hz; rewrite (negPf (hp _ _)). move=> c p0 -> hp hz; rewrite (negPf (hp _ _)) //. by case: leP hz; first rewrite itv_xx. Qed. Lemma is_next_root p a b x : next_root_spec p a b (root p x) x -> x = next_root p a b. Proof. case; first by move->; rewrite /next_root eqxx. move=> y; case: next_rootP; first by move->; rewrite eqxx. move=> y' np0 py'0 hy' hp' _ py0 hy hp. wlog: y y' hy' hy hp' hp py0 py'0 / y <= y'. by case/orP: (le_total y y')=> lyy' hw; [|symmetry]; apply: hw. case: ltrgtP=> // hyy' _; move: (hp' y). by rewrite in_itv /= (itvP hy) hyy' rootE py0 eqxx; move/(_ isT). move=> c p0 ->; case: leP => hba; first by rewrite itv_ge // -leNgt. by move=> hpz _ py0 /hpz; rewrite rootE py0 eqxx. case: next_rootP; first by move->; rewrite eqxx. by move=> y np0 py0 hy _ c _ _ /(_ _ hy); rewrite rootE py0 eqxx. by move=> c _ -> _ c' _ ->. Qed. Definition prev_root (p : {poly R}) a x := if p == 0 then x else last (minr a x) (roots p a x). Lemma prev_root0 a b : prev_root 0 a b = b. Proof. by rewrite /prev_root eqxx. Qed. Variant prev_root_spec (p : {poly R}) a x : bool -> R -> Type := | PrevRootSpec0 of p = 0 : prev_root_spec p a x true x | PrevRootSpecRoot y of p != 0 & p.[y] = 0 & y \in`]a, x[ & {in `]y, x[, forall z, ~~(root p z)} : prev_root_spec p a x true y | PrevRootSpecNoRoot c of p != 0 & c = minr a x & {in `]a, x[, forall z, ~~(root p z)} : prev_root_spec p a x (p.[c] == 0) c. Lemma prev_rootP (p : {poly R}) a b : prev_root_spec p a b (p.[prev_root p a b] == 0) (prev_root p a b). Proof. rewrite /prev_root /=; move hs: (roots _ _ _)=> s. case: (lastP s) hs=> {s} [|s x] hs /=. case: (eqVneq p 0) hs => [->|p0] hs. by rewrite hornerC eqxx; constructor. by constructor=> // y hy; apply: (roots_nil p0 hs). move/eqP: hs; rewrite last_rcons roots_rcons. case/and5P=> p0 hx /eqP rap rpx rx. rewrite (negPf p0) (rootPt rpx); constructor=> //; first by apply/eqP. by move=> y hy /=; move/(roots_nil p0): (rap); apply. Qed. Lemma prev_root_in p a b : prev_root p a b \in `[minr a b, b]. Proof. case: prev_rootP => [p0|y np0 py0 hy _|c np0 hc _]. * by rewrite bound_in_itv /<=%O /= ge_min lexx orbT. * by apply: subitvP hy; rewrite /<=%O /= /<=%O /= ge_min !lexx. * by rewrite hc bound_in_itv /<=%O /= ge_min lexx orbT. Qed. Lemma prev_noroot p a b : {in `](prev_root p a b), b[, noroot p}. Proof. move=> z; case: prev_rootP; first by rewrite itv_xx. by move=> y np0 py0 hy hp hz; rewrite (negPf (hp _ _)). move=> c np0 ->; case: leP=> hab; last by rewrite itv_xx. by move=> hp hz; rewrite (negPf (hp _ _)). Qed. Lemma prev_root_lt p a b : a < b -> p != 0 -> prev_root p a b < b. Proof. move=> ab np0; case: prev_rootP=> [p0|y _ py0 hy _|c _ -> _]. * by rewrite p0 eqxx in np0. * by rewrite (itvP hy). * by rewrite gt_min ab. Qed. Lemma is_prev_root p a b x : prev_root_spec p a b (root p x) x -> x = prev_root p a b. Proof. case; first by move->; rewrite /prev_root eqxx. move=> y; case: prev_rootP; first by move->; rewrite eqxx. move=> y' np0 py'0 hy' hp' _ py0 hy hp. wlog: y y' hy' hy hp' hp py0 py'0 / y <= y'. by case/orP: (le_total y y')=> lyy' hw; [|symmetry]; apply: hw. case: ltrgtP=> // hyy' _; move/implyP: (hp y'). by rewrite rootE py'0 eqxx in_itv /= (itvP hy') hyy'. by move=> c _ _ hpz _ py0 /hpz; rewrite rootE py0 eqxx. case: prev_rootP=> //; first by move->; rewrite eqxx. move=> y ? py0 hy _ c _ ->. case: ltP hy=> hab; last by rewrite itv_ge // -leNgt. by move=> hy /(_ _ hy); rewrite rootE py0 eqxx. by move=> c _ -> _ c' _ ->. Qed. Definition neighpr p a b := `]a, (next_root p a b)[. Definition neighpl p a b := `](prev_root p a b), b[. Lemma neighpl_root p a x : {in neighpl p a x, noroot p}. Proof. exact: prev_noroot. Qed. Lemma sgr_neighplN p a x : ~~ root p x -> {in neighpl p a x, forall y, (sgr p.[y] = sgr p.[x])}. Proof. rewrite /neighpl=> nrpx /= y hy. apply: (@polyrN0_itv `[y, x]); do ?by rewrite bound_in_itv /<=%O /= (itvP hy). move=> z; rewrite (@itv_splitU _ _ (BLeft x)) ?itv_xx /=; last first. (* Todo : Lemma itv_splitP *) by rewrite bound_lexx /<=%O /= (itvP hy). rewrite orbC => /predU1P[-> // | hz]. rewrite (@prev_noroot _ a x) //. by apply: subitvPl hz; rewrite /<=%O /= (itvP hy). Qed. Lemma sgr_neighpl_same p a x : {in neighpl p a x &, forall y z, (sgr p.[y] = sgr p.[z])}. Proof. by rewrite /neighpl=> y z *; apply: (polyrN0_itv (@prev_noroot p a x)). Qed. Lemma neighpr_root p x b : {in neighpr p x b, noroot p}. Proof. exact: next_noroot. Qed. Lemma sgr_neighprN p x b : p.[x] != 0 -> {in neighpr p x b, forall y, (sgr p.[y] = sgr p.[x])}. Proof. rewrite /neighpr=> nrpx /= y hy; symmetry. apply: (@polyrN0_itv `[x, y]); do ?by rewrite bound_in_itv /<=%O /= (itvP hy). move=> z; rewrite (@itv_splitU _ _ (BRight x)) ?itv_xx /=; last first. (* Todo : Lemma itv_splitP *) by rewrite bound_lexx /<=%O /= (itvP hy). case/predU1P => [-> //|hz]; rewrite (@next_noroot _ x b) //. by apply: subitvPr hz; rewrite /<=%O /= (itvP hy). Qed. Lemma sgr_neighpr_same p x b : {in neighpr p x b &, forall y z, (sgr p.[y] = sgr p.[z])}. Proof. by rewrite /neighpl=> y z *; apply: (polyrN0_itv (@next_noroot p x b)). Qed. Lemma uniq_roots a b p : uniq (roots p a b). Proof. have [->|p0] := eqVneq p 0; first by rewrite roots0. by apply: (@sorted_uniq _ <%R); [apply: lt_trans | apply: ltxx|]. Qed. Hint Resolve uniq_roots : core. Lemma in_roots p (a b x : R) : (x \in roots p a b) = [&& root p x, x \in `]a, b[ & p != 0]. Proof. case: rootsP=> //=; first by rewrite in_nil !andbF. by move=> p0 hr sr; rewrite andbT -hr andbC. Qed. (* Todo : move to polyorder => need char 0 *) Lemma gdcop_eq0 p q : (gdcop p q == 0) = (q == 0) && (p != 0). Proof. have [->|q0] := eqVneq q. by rewrite gdcop0 /=; case: (p == 0); rewrite ?eqxx ?oner_eq0. rewrite /gdcop; move: {-1}(size q) (leqnn (size q))=> k hk; apply: negPf. elim: k q q0 hk => [|k ihk] /= q q0 hk. by move: hk q0; rewrite leqn0 size_poly_eq0; move->. case: ifP=> cpq; first by rewrite (negPf q0). apply: ihk. rewrite divpN0; last by rewrite gcdp_eq0 negb_and q0. by rewrite dvdp_leq // dvdp_gcdl. rewrite -ltnS; apply: leq_trans hk; move: (dvdp_gcdl q p); rewrite dvdp_eq. move/eqP=> eqq; move/(f_equal (fun x : {poly R} => size x)): (eqq). rewrite size_scale; last exact: lc_expn_scalp_neq0. have gcdn0 : gcdp q p != 0 by rewrite gcdp_eq0 negb_and q0. have qqn0 : q %/ gcdp q p != 0. apply: contraNneq q0 => e. move: (scaler_eq0 (lead_coef (gcdp q p) ^+ scalp q (gcdp q p)) q). by rewrite (negPf (lc_expn_scalp_neq0 _ _)) /= eqq e mul0r eqxx. move->; rewrite size_mul //; case sgcd: (size (gcdp q p)) => [|n]. by move/eqP: sgcd gcdn0; rewrite size_poly_eq0; move->. case: n sgcd => [|n]; first by move/eqP; rewrite size_poly_eq1 gcdp_eqp1 cpq. by rewrite addnS /= -{1}[size (_ %/ _)]addn0 ltn_add2l. Qed. Lemma roots_mul a b : a < b -> forall p q, p != 0 -> q != 0 -> perm_eq (roots (p*q) a b) (roots p a b ++ roots ((gdcop p q)) a b). Proof. move=> hab p q np0 nq0. apply: uniq_perm; first exact: uniq_roots. rewrite cat_uniq ?uniq_roots andbT /=; apply/hasPn=> x /=. move/root_roots; rewrite root_gdco //; case/andP=> _. by rewrite in_roots !negb_and=> ->. move=> x; rewrite mem_cat !in_roots root_gdco //. rewrite rootM mulf_eq0 gdcop_eq0 negb_and. case: (x \in `]_, _[); last by rewrite !andbF. by rewrite negb_or !np0 !nq0 !andbT /=; do 2?case: root=> //=. Qed. Lemma roots_mul_coprime a b : a < b -> forall p q, p != 0 -> q != 0 -> coprimep p q -> perm_eq (roots (p * q) a b) (roots p a b ++ roots q a b). Proof. move=> hab p q np0 nq0 cpq. rewrite (perm_trans (roots_mul hab np0 nq0)) //. suff ->: roots (gdcop p q) a b = roots q a b by apply: perm_refl. case: gdcopP=> r rq hrp /(_ q (dvdpp _)). rewrite coprimep_sym; move/(_ cpq)=> qr. have erq : r %= q by rewrite /eqp rq qr. (* Todo : relate eqp with roots *) apply/roots_eq=> // [|x hx]; last exact: eqp_root. by rewrite -size_poly_eq0 (eqp_size erq) size_poly_eq0. Qed. Lemma next_rootM a b (p q : {poly R}) : next_root (p * q) a b = minr (next_root p a b) (next_root q a b). Proof. apply/esym/is_next_root. wlog: p q / next_root p a b <= next_root q a b. case: leP=> hpq; first by move/(_ _ _ hpq); case: leP hpq. by move/(_ _ _ (ltW hpq)); rewrite mulrC; case: ltP hpq. case: leP => //; case: next_rootP=> [|y np0 py0 hy|c np0 ->] hp hpq _. * by rewrite hp mul0r root0; constructor. * rewrite rootM; move/rootP:(py0)->; constructor=> //. - by rewrite mulf_neq0 //; case: next_rootP hpq; rewrite // (itvP hy). - by rewrite hornerM py0 mul0r. - move=> z hz /=; rewrite rootM negb_or ?hp //. by rewrite (@next_noroot _ a b) //; apply: subitvPr hz. * case: (eqVneq q 0) hpq => [->|q0 hpq]. rewrite mulr0 root0 next_root0 ge_max lexx andbT. by move/max_r->; constructor. constructor=> //; first by rewrite mulf_neq0. move=> z hz /=; rewrite rootM negb_or ?hp // (@next_noroot _ a b) //. by apply: subitvPr hz=> /=; move: hpq; rewrite ge_max; case/andP. Qed. Lemma neighpr_mul a b p q : (neighpr (p * q) a b) =i [predI (neighpr p a b) & (neighpr q a b)]. Proof. move=> x; rewrite !inE /<=%O /= /<=%O /= next_rootM. by case: (a < x); rewrite // lt_min. Qed. Lemma prev_rootM a b (p q : {poly R}) : prev_root (p * q) a b = maxr (prev_root p a b) (prev_root q a b). Proof. apply/esym/is_prev_root. wlog: p q / prev_root p a b >= prev_root q a b. case: leP=> hpq; last by move/(_ _ _ (ltW hpq)); case: leP hpq. by move/(_ _ _ hpq); case: ltP hpq; rewrite mulrC. case: ltP => //; case: (@prev_rootP p)=> [|y np0 py0 hy|c np0 ->] hp hpq _. * by rewrite hp mul0r root0; constructor. * rewrite rootM; move/rootP:(py0)->; constructor=> //. - by rewrite mulf_neq0 //; case: prev_rootP hpq; rewrite // (itvP hy). - by rewrite hornerM py0 mul0r. - move=> z hz /=; rewrite rootM negb_or ?hp //. by rewrite (@prev_noroot _ a b) //; apply: subitvPl hz. * case: (eqVneq q 0) hpq => [->|q0 hpq]. rewrite mulr0 root0 prev_root0 le_min lexx andbT. by move/min_r->; constructor. constructor=> //; first by rewrite mulf_neq0. move=> z hz /=; rewrite rootM negb_or ?hp // (@prev_noroot _ a b) //. by apply: subitvPl hz=> /=; move: hpq; rewrite le_min; case/andP. Qed. Lemma neighpl_mul a b p q : (neighpl (p * q) a b) =i [predI (neighpl p a b) & (neighpl q a b)]. Proof. move=> x; rewrite !inE /<=%O /= /<=%O /= prev_rootM. by case: (x < b); rewrite // gt_max !(andbT, andbF). Qed. Lemma neighpr_wit p x b : x < b -> p != 0 -> {y | y \in neighpr p x b}. Proof. move=> xb; exists (mid x (next_root p x b)). by rewrite mid_in_itv //= next_root_gt. Qed. Lemma neighpl_wit p a x : a < x -> p != 0 -> {y | y \in neighpl p a x}. Proof. move=> xb; exists (mid (prev_root p a x) x). by rewrite mid_in_itv //= prev_root_lt. Qed. End NeighborHood. Section SignRight. Definition sgp_right (p : {poly R}) x := let fix aux (p : {poly R}) n := if n is n'.+1 then if ~~ root p x then sgr p.[x] else aux p^`() n' else 0 in aux p (size p). Lemma sgp_right0 x : sgp_right 0 x = 0. Proof. by rewrite /sgp_right size_poly0. Qed. Lemma sgr_neighpr b p x : {in neighpr p x b, forall y, (sgr p.[y] = sgp_right p x)}. Proof. have [n] := ubnP (size p); elim: n => // -[_|n ihn] in p *; rewrite ltnS. by move=> /size_poly_leq0P-> y; rewrite /neighpr next_root0 itv_xx. rewrite leq_eqVlt ltnS; case/orP; last exact: ihn. move/eqP=> sp; rewrite /sgp_right sp /=. have pN0 : p != 0 by apply: contra_eq_neq sp => ->; rewrite size_poly0. case px0: root=> /=; last first. move=> y; rewrite /neighpr => hy /=; symmetry. apply: (@polyrN0_itv `[x, y]); do ?by rewrite bound_in_itv ?bnd_simp /= (itvP hy). move=> z; rewrite (@itv_splitU _ _ (BRight x)) ?bound_in_itv /= ?bnd_simp ?(itvP hy) //. rewrite itv_xx /=; case/predU1P=> hz; first by rewrite hz px0. rewrite (@next_noroot p x b) //. by apply: subitvPr hz=> /=; rewrite !bnd_simp (itvP hy). have <-: size p^`() = n by rewrite size_deriv sp. rewrite -/(sgp_right p^`() x). move=> y; rewrite /neighpr=> hy /=. case: (@neighpr_wit (p * p^`()) x b)=> [||m hm]. * case: next_rootP hy; first by rewrite itv_xx. by move=> ? ? ?; move/itvP->. by move=> c p0 -> _; case: lerP => _; rewrite ?itv_xx //; move/itvP->. * rewrite mulf_neq0 //. move: (size_deriv p); rewrite sp /=; move/eqP; apply: contraTneq=> ->. rewrite size_poly0; apply: contraTneq px0=> hn; rewrite -hn in sp. by move/eqP: sp; case/size_poly1P=> c nc0 ->; rewrite rootC. * move: hm; rewrite neighpr_mul /neighpr inE /=; case/andP=> hmp hmp'. have lt_xm : x < m by rewrite (itvP hmp). rewrite (polyrN0_itv _ hmp) //; last exact: next_noroot. have midxmxb : mid x m \in neighpr p^`() x b. rewrite (subitvP _ (@mid_in_itv _ false true _ _ _)) //=. by rewrite ?lerr le_itv !bnd_simp (itvP hmp'). rewrite (@root_dersr p x m) ?(eqP px0) ?mid_in_itv ?bound_in_itv //; rewrite ?bnd_simp /= ?(itvP hmp) //; last first. move=> u hu /=; rewrite (@next_noroot _ x b) //. by apply: subitvPr hu; rewrite /= ?bnd_simp (itvP hmp'). rewrite neqr0_sign// ?(@next_noroot _ x b)//. by rewrite ihn ?size_deriv ?sp /neighpr. Qed. Lemma sgr_neighpl a p x : {in neighpl p a x, forall y, (sgr p.[y] = (-1) ^+ (odd (\mu_x p)) * sgp_right p x) }. Proof. have [n] := ubnP (size p); elim: n => // -[_|n ihn] in p *; rewrite ltnS. by move=> /size_poly_leq0P-> y; rewrite /neighpl prev_root0 itv_xx. rewrite leq_eqVlt ltnS; case/orP; last exact: ihn. move/eqP=> sp; rewrite /sgp_right sp /=. have pN0 : p != 0 by apply: contra_eq_neq sp => ->; rewrite size_poly0. case px0: root=> /=; last first. move=> y; rewrite /neighpl => hy /=; symmetry. move: (negbT px0); rewrite -mu_gt0; last first. by apply: contraFN px0; move/eqP->; rewrite rootC. rewrite -leqNgt leqn0; move/eqP=> -> /=; rewrite expr0 mul1r. symmetry; apply: (@polyrN0_itv `[y, x]); do ?by rewrite bound_in_itv ?bnd_simp /= (itvP hy). move=> z; rewrite (@itv_splitU _ _ (BLeft x)) ?bound_in_itv ?bnd_simp /= ?(itvP hy) //. rewrite itv_xx /= orbC; case/predU1P=> hz; first by rewrite hz px0. rewrite (@prev_noroot p a x) //. by apply: subitvPl hz=> /=; rewrite bnd_simp (itvP hy). have <-: size p^`() = n by rewrite size_deriv sp. rewrite -/(sgp_right p^`() x). move=> y; rewrite /neighpl=> hy /=. case: (@neighpl_wit (p * p^`()) a x)=> [||m hm]. * case: prev_rootP hy; first by rewrite itv_xx. by move=> ? ? ?; move/itvP->. by move=> c p0 -> _; case: lerP => _; rewrite ?itv_xx //; move/itvP->. * rewrite mulf_neq0 //. move: (size_deriv p); rewrite sp /=; move/eqP; apply: contraTneq=> ->. rewrite size_poly0; apply: contraTneq px0=> hn; rewrite -hn in sp. by move/eqP: sp; case/size_poly1P=> c nc0 ->; rewrite rootC. * move: hm; rewrite neighpl_mul /neighpl inE /=; case/andP=> hmp hmp'. have lt_xm : m < x by rewrite (itvP hmp). have midxmxb : mid m x \in neighpl p^`() a x. rewrite (subitvP _ (@mid_in_itv _ false true _ _ _)) //= ?le_itv ?bnd_simp (itvP hmp')//. rewrite (polyrN0_itv _ hmp) //; last exact: prev_noroot. rewrite (@root_dersl p m x) ?(eqP px0) ?mid_in_itv ?bound_in_itv //; rewrite /= ?bnd_simp ?(itvP hmp) //; last first. move=> u hu /=; rewrite (@prev_noroot _ a x) //. by apply: subitvPl hu; rewrite /= ?bnd_simp (itvP hmp'). rewrite neqr0_sign ?(@prev_noroot _ a x)// ihn// ?size_deriv ?sp//. by rewrite mu_deriv// oddB ?mu_gt0//= signr_addb mulrN1 mulNr opprK. Qed. Lemma sgp_right_deriv (p : {poly R}) x : root p x -> sgp_right p x = sgp_right (p^`()) x. Proof. elim: (size p) {-2}p (erefl (size p)) x => {p} [p|sp hp p hsp x]. by move/eqP; rewrite size_poly_eq0; move/eqP=> -> x _; rewrite derivC. by rewrite /sgp_right size_deriv hsp /= => ->. Qed. Lemma sgp_rightNroot (p : {poly R}) x : ~~ root p x -> sgp_right p x = sgr p.[x]. Proof. move=> nrpx; rewrite /sgp_right; case hsp: (size _)=> [|sp]. by move/eqP:hsp; rewrite size_poly_eq0; move/eqP->; rewrite hornerC sgr0. by rewrite nrpx. Qed. Lemma sgp_right_mul p q x : sgp_right (p * q) x = sgp_right p x * sgp_right q x. Proof. have [->|q0] := eqVneq q 0; first by rewrite /sgp_right !(size_poly0,mulr0). have [->|p0] := eqVneq p 0; first by rewrite /sgp_right !(size_poly0,mul0r). case: (@neighpr_wit (p * q) x (1 + x))=> [||m hpq]; do ?by rewrite mulf_neq0. by rewrite ltr_pwDl ?ltr01. rewrite -(@sgr_neighpr (1 + x) _ _ m) //; move: hpq; rewrite neighpr_mul. by case/andP=> /= hp hq; rewrite hornerM sgrM !(@sgr_neighpr (1 + x) _ x). Qed. Lemma sgp_right_scale c p x : sgp_right (c *: p) x = sgr c * sgp_right p x. Proof. have [->|c0] := eqVneq c 0; first by rewrite scale0r sgr0 mul0r sgp_right0. by rewrite -mul_polyC sgp_right_mul sgp_rightNroot ?hornerC ?rootC ?c0. Qed. Lemma sgp_right_square p x : p != 0 -> sgp_right p x * sgp_right p x = 1. Proof. move=> np0; case: (@neighpr_wit p x (1 + x))=> [||m hpq] //. by rewrite ltr_pwDl ?ltr01. rewrite -(@sgr_neighpr (1 + x) _ _ m) //. by rewrite -expr2 sqr_sg (@next_noroot _ x (1 + x)). Qed. Lemma sgp_right_rec p x : sgp_right p x = (if p == 0 then 0 else if ~~ root p x then sgr p.[x] else sgp_right p^`() x). Proof. rewrite /sgp_right; case hs: size => [|s]; rewrite -size_poly_eq0 hs //=. by rewrite size_deriv hs. Qed. Lemma sgp_right_addp0 (p q : {poly R}) x : q != 0 -> (\mu_x p > \mu_x q)%N -> sgp_right (p + q) x = sgp_right q x. Proof. move=> nq0; move hm: (\mu_x q)=> m. elim: m p q nq0 hm => [|mq ihmq] p q nq0 hmq; case hmp: (\mu_x p)=> // [mp]; do[rewrite ltnS=> hm; rewrite sgp_right_rec {1}addrC addr_eq0]. case: (eqVneq q (- p)) nq0 hmq => [-> np0 hmq|hqp nq0 hmq]. rewrite sgp_right_rec (negPf np0) -mu_gt0 // hmq ltnn /=; apply/esym/eqP. by rewrite hornerN sgrN oppr_eq0 sgr_eq0 -[_ == _]mu_gt0 ?hmp // -oppr_eq0. rewrite rootE hornerD. have ->: p.[x] = 0. apply/eqP; rewrite -[_ == _]mu_gt0 ?hmp //. by apply: contra_eq_neq hmp => ->; rewrite mu0. by rewrite [RHS]sgp_right_rec (negPf nq0) add0r -/(root _ _) -mu_gt0 // hmq. case: eqVneq => hqp. by move: hm; rewrite -ltnS -hmq -hmp hqp mu_opp ltnn. have px0: p.[x] = 0. apply/rootP; rewrite -mu_gt0 ?hmp //. by apply: contra_eq_neq hmp => ->; rewrite mu0. have qx0: q.[x] = 0 by apply/rootP; rewrite -mu_gt0 ?hmq //. rewrite rootE hornerD px0 qx0 add0r eqxx /=; symmetry. rewrite sgp_right_rec rootE (negPf nq0) qx0 eqxx /=. rewrite derivD ihmq // ?mu_deriv ?rootE ?px0 ?qx0 ?hmp ?hmq ?subn1 //. apply: contra nq0; rewrite -size_poly_eq0 size_deriv. case hsq: size=> [|sq] /=. by move/eqP: hsq; rewrite size_poly_eq0. move/eqP=> sq0; move/eqP: hsq qx0; rewrite sq0; case/size_poly1P=> c c0 ->. by rewrite hornerC; move/eqP; rewrite (negPf c0). Qed. End SignRight. (* redistribute some of what follows with in the file *) Section PolyRCFPdiv. Import Pdiv.Ring Pdiv.ComRing. Lemma sgp_rightc (x c : R) : sgp_right c%:P x = sgr c. Proof. rewrite /sgp_right size_polyC. by have [->|cn0] /= := eqVneq; rewrite ?sgr0 // rootC hornerC cn0. Qed. Lemma sgp_right_eq0 (x : R) p : (sgp_right p x == 0) = (p == 0). Proof. have [->|p0] := eqVneq p; first by rewrite sgp_rightc sgr0 eqxx. rewrite /sgp_right. elim: (size p) {-2}p (erefl (size p)) p0=> {p} [|sp ihsp] p esp p0. by move/eqP: esp; rewrite size_poly_eq0 (negPf p0). rewrite esp /=; case px0: root=> //=; rewrite ?sgr_cp0 ?px0//. have hsp: sp = size p^`() by rewrite size_deriv esp. rewrite hsp ihsp // -size_poly_eq0 -hsp. move: px0; rewrite root_factor_theorem => /rdvdp_leq /(_ p0). by rewrite size_XsubC esp ltnS; case: posnP. Qed. (* :TODO: backport to polydiv *) Lemma lc_expn_rscalp_neq0 (p q : {poly R}): lead_coef q ^+ rscalp p q != 0. Proof. have [->|nzq] := eqVneq q 0; last by rewrite expf_neq0 ?lead_coef_eq0. by rewrite /rscalp unlock /= eqxx /= expr0 oner_neq0. Qed. Notation lcn_neq0 := lc_expn_rscalp_neq0. Lemma sgp_right_mod p q x : (\mu_x p < \mu_x q)%N -> sgp_right (rmodp p q) x = (sgr (lead_coef q)) ^+ (rscalp p q) * sgp_right p x. Proof. case: (eqVneq p 0) => [-> _|p0 mupq]; first by rewrite rmod0p !sgp_right0 mulr0. have qn0 : q != 0 by apply: contraTneq mupq => ->; rewrite -leqNgt mu0. move/(canLR (addKr _)): (rdivp_eq q p) => <-. have [->|qpq0] := eqVneq (rdivp p q) 0. by rewrite mul0r oppr0 add0r sgp_right_scale // sgrX. rewrite sgp_right_addp0 ?sgp_right_scale ?sgrX //. by rewrite scaler_eq0 negb_or p0 lcn_neq0. by rewrite mu_mulC ?lcn_neq0 // mu_opp mu_mul ?mulf_neq0 ?qpq0 // ltn_addl. Qed. Lemma rootsC (a b c : R) : roots c%:P a b = [::]. Proof. have [->|hc] := eqVneq c 0; first by rewrite roots0. by apply: no_root_roots=> x hx; rewrite rootC. Qed. Lemma rootsZ a b c p : c != 0 -> roots (c *: p) a b = roots p a b. Proof. case: (eqVneq p 0) => [->|p_neq0 c_neq0]; first by rewrite scaler0. by apply/roots_eq => [||x axb]; rewrite ?scaler_eq0 ?(negPf c_neq0) ?rootZ. Qed. Lemma root_bigrgcd (x : R) (ps : seq {poly R}) : root (\big[(@rgcdp _)/0]_(p <- ps) p) x = all (root^~ x) ps. Proof. elim: ps; first by rewrite big_nil root0. move=> p ps ihp; rewrite big_cons /=. by rewrite (eqp_root (eqp_rgcd_gcd _ _)) root_gcd ihp. Qed. Definition rootsR p := roots p (- cauchy_bound p) (cauchy_bound p). Lemma roots_on_rootsR p : p != 0 -> roots_on p `]-oo, +oo[ (rootsR p). Proof. rewrite /rootsR => p_neq0 x /=; rewrite -roots_on_roots // andbC. by have [/(cauchy_boundP p_neq0) /=|//] := rootP; rewrite ltr_norml. Qed. Lemma rootsR0 : rootsR 0 = [::]. Proof. exact: roots0. Qed. Lemma rootsRC c : rootsR c%:P = [::]. Proof. exact: rootsC. Qed. Lemma rootsRP p a b : {in `]-oo, a], noroot p} -> {in `[b , +oo[, noroot p} -> roots p a b = rootsR p. Proof. move=> rpa rpb. have [->|p_neq0] := eqVneq p 0; first by rewrite rootsR0 roots0. apply: (irr_sorted_eq lt_trans); rewrite ?sorted_roots // => x. rewrite -roots_on_rootsR -?roots_on_roots //=. case: (boolP (root _ _)); rewrite ?(andbT, andbF) //. apply: contraLR; rewrite in_itv negb_and -!leNgt. by move=> /orP[/rpa //|xb]; rewrite rpb // in_itv andbT. Qed. Lemma sgp_pinftyP x (p : {poly R}) : {in `[x , +oo[, noroot p} -> {in `[x, +oo[, forall y, sgr p.[y] = sgp_pinfty p}. Proof. rewrite /sgp_pinfty; wlog lp_gt0 : x p / lead_coef p > 0 => [hwlog|rpx y Hy]. have [|/(hwlog x p) //|/eqP] := ltrgtP (lead_coef p) 0; last first. by rewrite lead_coef_eq0 => /eqP -> ? ? ?; rewrite lead_coef0 horner0. rewrite -[p]opprK lead_coefN oppr_cp0 => /(hwlog x _) Hp HNp y Hy. by rewrite hornerN !sgrN Hp => // z /HNp; rewrite rootN. have [z Hz] := poly_pinfty_gt_lc lp_gt0. have {}Hz u : u \in `[z, +oo[ -> Num.sg p.[u] = 1. rewrite in_itv andbT => /Hz pu_ge1. by rewrite gtr0_sg // (lt_le_trans lp_gt0). rewrite (@polyrN0_itv _ _ rpx (maxr y z)) ?in_itv /= ?le_max ?(itvP Hy) //. by rewrite Hz ?gtr0_sg // in_itv /= le_max lexx orbT. Qed. Lemma sgp_minftyP x (p : {poly R}) : {in `]-oo, x], noroot p} -> {in `]-oo, x], forall y, sgr p.[y] = sgp_minfty p}. Proof. move=> rpx y Hy; rewrite -sgp_pinfty_sym. have ->: p.[y] = (p \Po -'X).[-y] by rewrite horner_comp !hornerE opprK. apply: (@sgp_pinftyP (- x)) => /= [z Hz|]. by rewrite root_comp !hornerE rpx // in_itv /= lerNl (itvP Hz). by rewrite in_itv /= lerN2 (itvP Hy). Qed. Lemma odd_poly_root (p : {poly R}) : ~~ odd (size p) -> {x | root p x}. Proof. move=> size_p_even. have [->|p_neq0] := eqVneq p 0; first by exists 0; rewrite root0. pose b := cauchy_bound p. have [] := @poly_ivtoo p (-b) b; last by move=> x _; exists x. by rewrite ge0_cp // ?cauchy_bound_ge0. rewrite -sgr_cp0 sgrM. rewrite (sgp_minftyP (le_cauchy_bound p_neq0)) ?bound_in_itv //. rewrite (sgp_pinftyP (ge_cauchy_bound p_neq0)) ?bound_in_itv //. move: size_p_even; rewrite polySpred //= negbK /sgp_minfty -signr_odd => ->. by rewrite expr1 mulN1r sgrN mulNr -expr2 sqr_sg lead_coef_eq0 p_neq0. Qed. End PolyRCFPdiv. End PolyRCF. #[deprecated(since="mathcomp-real-closed 2.1.0", note="Use `poly_rolle` instead")] Notation rolle := poly_rolle. #[deprecated(since="mathcomp-real-closed 2.1.0", note="Use `poly_mvt` instead")] Notation mvt := poly_mvt. #[deprecated(since="mathcomp-real-closed 1.1.0", note="Use `poly_ivtoo` instead.")] Notation ivt_sign := ivt_sign_deprecated. real-closed-2.0.2/theories/qe_rcf.v000066400000000000000000001030351472566273500172000ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq path. From mathcomp Require Import div choice fintype finfun bigop order ssralg zmodp. From mathcomp Require Import poly polydiv ssrnum ssrint interval matrix polyXY. From mathcomp Require Import polyorder polyrcf mxtens qe_rcf_th ordered_qelim. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import Order.TTheory GRing.Theory Num.Theory. Local Open Scope ring_scope. Definition grab (X Y : Type) (pattern : Y -> Prop) (P : Prop -> Prop) (y : X) (f : X -> Y) : (let F := f in P (forall x, y = x -> pattern (F x))) -> P (forall x : X, y = x -> pattern (f x)) := id. Definition grab_eq X Y u := @grab X Y (fun v => u = v :> Y). Tactic Notation "grab_eq" ident(f) open_constr(PAT1) := let Edef := fresh "Edef" in let E := fresh "E" in move Edef: PAT1 => E; move: E Edef; elim/grab_eq: _ => f _ <-. Import ord. Section QF. Variable R : Type. Inductive term : Type := | Var of nat | Const of R | NatConst of nat | Add of term & term | Opp of term | NatMul of term & nat | Mul of term & term | Exp of term & nat. Inductive formula : Type := | Bool of bool | Equal of term & term | Lt of term & term | Le of term & term | And of formula & formula | Or of formula & formula | Implies of formula & formula | Not of formula. Coercion rterm_to_term := fix loop (t : term) : GRing.term R := match t with | Var x => GRing.Var _ x | Const x => GRing.Const x | NatConst n => GRing.NatConst _ n | Add u v => GRing.Add (loop u) (loop v) | Opp u => GRing.Opp (loop u) | NatMul u n => GRing.NatMul (loop u) n | Mul u v => GRing.Mul (loop u) (loop v) | Exp u n => GRing.Exp (loop u) n end. Coercion qfr_to_formula := fix loop (f : formula) : ord.formula R := match f with | Bool b => ord.Bool b | Equal x y => ord.Equal x y | Lt x y => ord.Lt x y | Le x y => ord.Le x y | And f g => ord.And (loop f) (loop g) | Or f g => ord.Or (loop f) (loop g) | Implies f g => ord.Implies (loop f) (loop g) | Not f => ord.Not (loop f) end. Definition to_rterm := fix loop (t : GRing.term R) : term := match t with | GRing.Var x => Var x | GRing.Const x => Const x | GRing.NatConst n => NatConst n | GRing.Add u v => Add (loop u) (loop v) | GRing.Opp u => Opp (loop u) | GRing.NatMul u n => NatMul (loop u) n | GRing.Mul u v => Mul (loop u) (loop v) | GRing.Exp u n => Exp (loop u) n | _ => NatConst 0 end. End QF. Declare Scope qf_scope. Bind Scope qf_scope with term. Bind Scope qf_scope with formula. Delimit Scope qf_scope with qfT. Arguments Add _ _%qfT _%qfT. Arguments Opp _ _%qfT. Arguments NatMul _ _%qfT _%N. Arguments Mul _ _%qfT _%qfT. Arguments Mul _ _%qfT _%qfT. Arguments Exp _ _%qfT _%N. Arguments Equal _ _%qfT _%qfT. Arguments And _ _%qfT _%qfT. Arguments Or _ _%qfT _%qfT. Arguments Implies _ _%qfT _%qfT. Arguments Not _ _%qfT. Arguments Bool [R]. Prenex Implicits Const Add Opp NatMul Mul Exp Bool Unit And Or Implies Not Lt. Prenex Implicits to_rterm. Notation True := (Bool true). Notation False := (Bool false). Notation "''X_' i" := (Var _ i) : qf_scope. Notation "n %:R" := (NatConst _ n) : qf_scope. Notation "x %:T" := (Const x) : qf_scope. Notation "0" := 0%:R%qfT : qf_scope. Notation "1" := 1%:R%qfT : qf_scope. Infix "+" := Add : qf_scope. Notation "- t" := (Opp t) : qf_scope. Notation "t - u" := (Add t (- u)) : qf_scope. Infix "*" := Mul : qf_scope. Infix "*+" := NatMul : qf_scope. Infix "^+" := Exp : qf_scope. Notation "t ^- n" := (t^-1 ^+ n)%qfT : qf_scope. Infix "==" := Equal : qf_scope. Infix "<%" := Lt : qf_scope. Infix "<=%" := Le : qf_scope. Infix "/\" := And : qf_scope. Infix "\/" := Or : qf_scope. Infix "==>" := Implies : qf_scope. Notation "~ f" := (Not f) : qf_scope. Notation "x != y" := (Not (x == y)) : qf_scope. Section evaluation. Variable R : realDomainType. Fixpoint eval (e : seq R) (t : term R) {struct t} : R := match t with | ('X_i)%qfT => e`_i | (x%:T)%qfT => x | (n%:R)%qfT => n%:R | (t1 + t2)%qfT => eval e t1 + eval e t2 | (- t1)%qfT => - eval e t1 | (t1 *+ n)%qfT => eval e t1 *+ n | (t1 * t2)%qfT => eval e t1 * eval e t2 | (t1 ^+ n)%qfT => eval e t1 ^+ n end. Lemma evalE (e : seq R) (t : term R) : eval e t = GRing.eval e t. Proof. by elim: t=> /=; do ?[move->|move=> ?]. Qed. Definition qf_eval e := fix loop (f : formula R) : bool := match f with | Bool b => b | t1 == t2 => (eval e t1 == eval e t2)%bool | t1 <% t2 => (eval e t1 < eval e t2)%bool | t1 <=% t2 => (eval e t1 <= eval e t2)%bool | f1 /\ f2 => loop f1 && loop f2 | f1 \/ f2 => loop f1 || loop f2 | f1 ==> f2 => (loop f1 ==> loop f2)%bool | ~ f1 => ~~ loop f1 end%qfT. Lemma qf_evalE (e : seq R) (f : formula R) : qf_eval e f = ord.qf_eval e f. Proof. by elim: f=> /=; do ?[rewrite evalE|move->|move=> ?]. Qed. Lemma to_rtermE (t : GRing.term R) : GRing.rterm t -> to_rterm t = t :> GRing.term _. Proof. elim: t=> //=; do ? [ by move=> u hu v hv /andP[ru rv]; rewrite hu ?hv | by move=> u hu *; rewrite hu]. Qed. End evaluation. Import Pdiv.Ring. Definition bind_def T1 T2 T3 (f : (T1 -> T2) -> T3) (k : T1 -> T2) := f k. Notation "'bind' x <- y ; z" := (bind_def y (fun x => z)) (at level 99, x at level 0, y at level 0, format "'[hv' 'bind' x <- y ; '/' z ']'"). Section ProjDef. Variable F : realFieldType. Notation fF := (formula F). Notation tF := (term F). Definition polyF := seq tF. Lemma qf_formF (f : fF) : qf_form f. Proof. by elim: f=> // *; apply/andP; split. Qed. Lemma rtermF (t : tF) : GRing.rterm t. Proof. by elim: t=> //=; do ?[move->|move=> ?]. Qed. Lemma rformulaF (f : fF) : rformula f. Proof. by elim: f=> /=; do ?[rewrite rtermF|move->|move=> ?]. Qed. Section If. Implicit Types (pf tf ef : formula F). Definition If pf tf ef := (pf /\ tf \/ ~ pf /\ ef)%qfT. End If. Notation "'If' c1 'Then' c2 'Else' c3" := (If c1 c2 c3) (at level 200, right associativity, format "'[hv ' 'If' c1 '/' '[' 'Then' c2 ']' '/' '[' 'Else' c3 ']' ']'"). Notation cps T := ((T -> fF) -> fF). Section Pick. Variables (I : finType) (pred_f then_f : I -> fF) (else_f : fF). Definition Pick := \big[Or/False]_(p : {ffun pred I}) ((\big[And/True]_i (if p i then pred_f i else ~ pred_f i)) /\ (if pick p is Some i then then_f i else else_f))%qfT. Lemma eval_Pick e (qev := qf_eval e) : let P i := qev (pred_f i) in qev Pick = (if pick P is Some i then qev (then_f i) else qev else_f). Proof. move=> P; rewrite ((big_morph qev) false orb) //= big_orE /=. apply/existsP/idP=> [[p] | true_at_P]. rewrite ((big_morph qev) true andb) //= big_andE /=. case/andP=> /forallP eq_p_P. rewrite (@eq_pick _ _ P) => [|i]; first by case: pick. by move/(_ i): eq_p_P => /=; case: (p i) => //=; move/negbTE. exists [ffun i => P i] => /=; apply/andP; split. rewrite ((big_morph qev) true andb) //= big_andE /=. by apply/forallP=> i; rewrite /= ffunE; case Pi: (P i) => //=; apply: negbT. rewrite (@eq_pick _ _ P) => [|i]; first by case: pick true_at_P. by rewrite ffunE. Qed. End Pick. Fixpoint eval_poly (e : seq F) pf := if pf is c :: qf then (eval_poly e qf) * 'X + (eval e c)%:P else 0. Lemma eval_polyP e p : eval_poly e p = Poly (map (eval e) p). Proof. by elim: p=> // a p /= ->; rewrite cons_poly_def. Qed. Fixpoint Size (p : polyF) : cps nat := fun k => if p is c :: q then bind n <- Size q; if n is m.+1 then k m.+2 else If c == 0 Then k 0%N Else k 1%N else k 0%N. Definition Isnull (p : polyF) : cps bool := fun k => bind n <- Size p; k (n == 0%N). Definition LtSize (p q : polyF) : cps bool := fun k => bind n <- Size p; bind m <- Size q; k (n < m)%N. Fixpoint LeadCoef p : cps tF := fun k => if p is c :: q then bind l <- LeadCoef q; If l == 0 Then k c Else k l else k (Const 0). Fixpoint AmulXn (a : tF) (n : nat) : polyF:= if n is n'.+1 then (Const 0) :: (AmulXn a n') else [::a]. Fixpoint AddPoly (p q : polyF) := if p is a::p' then if q is b::q' then (a + b)%qfT :: (AddPoly p' q') else p else q. Local Infix "++" := AddPoly : qf_scope. Definition ScalPoly (c : tF) (p : polyF) : polyF := map (Mul c) p. Local Infix "*:" := ScalPoly : qf_scope. Fixpoint MulPoly (p q : polyF) := if p is a :: p' then (a *: q ++ (0 :: (MulPoly p' q)))%qfT else [::]. Local Infix "**" := MulPoly (at level 40) : qf_scope. Lemma map_poly0 (R R' : ringType) (f : R -> R') : map_poly f 0 = 0. Proof. by rewrite map_polyE polyseq0. Qed. Definition ExpPoly p n := iterop n MulPoly p [::1%qfT]. Local Infix "^^+" := ExpPoly (at level 29) : qf_scope. Definition OppPoly := ScalPoly (@Const F (-1)). Local Notation "-- p" := (OppPoly p) (at level 35) : qf_scope. Local Notation "p -- q" := (p ++ (-- q))%qfT (at level 50) : qf_scope. Definition NatMulPoly n := ScalPoly (NatConst F n). Local Infix "+**" := NatMulPoly (at level 40) : qf_scope. Fixpoint Horner (p : polyF) (x : tF) : tF := if p is a :: p then (Horner p x * x + a)%qfT else 0%qfT. Fixpoint Deriv (p : polyF) : polyF := if p is a :: q then (q ++ (0 :: Deriv q))%qfT else [::]. Fixpoint Rediv_rec_loop (q : polyF) sq cq (c : nat) (qq r : polyF) (n : nat) {struct n} : cps (nat * polyF * polyF) := fun k => bind sr <- Size r; if (sr < sq)%N then k (c, qq, r) else bind lr <- LeadCoef r; let m := AmulXn lr (sr - sq) in let qq1 := (qq ** [::cq] ++ m)%qfT in let r1 := (r ** [::cq] -- m ** q)%qfT in if n is n1.+1 then Rediv_rec_loop q sq cq c.+1 qq1 r1 n1 k else k (c.+1, qq1, r1). Definition Rediv (p : polyF) (q : polyF) : cps (nat * polyF * polyF) := fun k => bind b <- Isnull q; if b then k (0%N, [::Const 0], p) else bind sq <- Size q; bind sp <- Size p; bind lq <- LeadCoef q; Rediv_rec_loop q sq lq 0 [::Const 0] p sp k. Definition Rmod (p : polyF) (q : polyF) (k : polyF -> fF) : fF := Rediv p q (fun d => k d.2)%PAIR. Definition Rdiv (p : polyF) (q : polyF) (k : polyF -> fF) : fF := Rediv p q (fun d => k d.1.2)%PAIR. Definition Rscal (p : polyF) (q : polyF) (k : nat -> fF) : fF := Rediv p q (fun d => k d.1.1)%PAIR. Definition Rdvd (p : polyF) (q : polyF) (k : bool -> fF) : fF := bind r <- Rmod p q; bind r_null <- Isnull r; k r_null. Fixpoint rgcdp_loop n (pp qq : {poly F}) {struct n} := if rmodp pp qq == 0 then qq else if n is n1.+1 then rgcdp_loop n1 qq (rmodp pp qq) else rmodp pp qq. Fixpoint Rgcd_loop n pp qq k {struct n} := bind r <- Rmod pp qq; bind b <- Isnull r; if b then (k qq) else if n is n1.+1 then Rgcd_loop n1 qq r k else k r. Definition Rgcd (p : polyF) (q : polyF) : cps polyF := fun k => let aux p1 q1 k := (bind b <- Isnull p1; if b then k q1 else bind n <- Size p1; Rgcd_loop n p1 q1 k) in bind b <- LtSize p q; if b then aux q p k else aux p q k. Fixpoint BigRgcd (ps : seq polyF) : cps (seq tF) := fun k => if ps is p :: pr then bind r <- BigRgcd pr; Rgcd p r k else k [::Const 0]. Fixpoint Changes (s : seq tF) : cps nat := fun k => if s is a :: q then bind v <- Changes q; If (Lt (a * head 0 q) 0)%qfT Then k (1 + v)%N Else k v else k 0%N. Fixpoint SeqPInfty (ps : seq polyF) : cps (seq tF) := fun k => if ps is p :: ps then bind lp <- LeadCoef p; bind lps <- SeqPInfty ps; k (lp :: lps) else k [::]. Fixpoint SeqMInfty (ps : seq polyF) : cps (seq tF) := fun k => if ps is p :: ps then bind lp <- LeadCoef p; bind sp <- Size p; bind lps <- SeqMInfty ps; k ((-1)%:T ^+ (~~ odd sp) * lp :: lps)%qfT else k [::]. Definition ChangesPoly ps : cps int := fun k => bind mps <- SeqMInfty ps; bind pps <- SeqPInfty ps; bind vm <- Changes mps; bind vp <- Changes pps; k (vm%:Z - vp%:Z). Definition NextMod (p q : polyF) : cps polyF := fun k => bind lq <- LeadCoef q; bind spq <- Rscal p q; bind rpq <- Rmod p q; k (- lq ^+ spq *: rpq)%qfT. Fixpoint ModsAux (p q : polyF) n : cps (seq polyF) := fun k => if n is m.+1 then bind p_eq0 <- Isnull p; if p_eq0 then k [::] else bind npq <- NextMod p q; bind ps <- ModsAux q npq m; k (p :: ps) else k [::]. Definition Mods (p q : polyF) : cps (seq polyF) := fun k => bind sp <- Size p; bind sq <- Size q; ModsAux p q (maxn sp sq.+1) k. Definition PolyComb (sq : seq polyF) (sc : seq int) := reducebig [::1%qfT] (iota 0 (size sq)) (fun i => BigBody i MulPoly true (nth [::] sq i ^^+ comb_exp sc`_i)%qfT). Definition Pcq sq i := (nth [::] (map (PolyComb sq) (sg_tab (size sq))) i). Definition TaqR (p : polyF) (q : polyF) : cps int := fun k => bind r <- Mods p (Deriv p ** q)%qfT; ChangesPoly r k. Definition TaqsR (p : polyF) (sq : seq polyF) (i : nat) : cps tF := fun k => bind n <- TaqR p (Pcq sq i); k ((n%:~R) %:T)%qfT. Fixpoint ProdPoly T (s : seq T) (f : T -> cps polyF) : cps polyF := fun k => if s is a :: s then bind fa <- f a; bind fs <- ProdPoly s f; k (fa ** fs)%qfT else k [::1%qfT]. Definition BoundingPoly (sq : seq polyF) : polyF := Deriv (reducebig [::1%qfT] sq (fun i => BigBody i MulPoly true i)). Definition Coefs (n i : nat) : tF := Const (match n with | 0 => (i == 0%N)%:R | 1 => [:: 2%:R^-1; 2%:R^-1; 0]`_i | n => coefs _ n i end). Definition CcountWeak (p : polyF) (sq : seq polyF) : cps tF := fun k => let fix aux s (i : nat) k := if i is i'.+1 then bind x <- TaqsR p sq i'; aux (x * (Coefs (size sq) i') + s)%qfT i' k else k s in aux 0%qfT (3 ^ size sq)%N k. Definition CcountGt0 (sp sq : seq polyF) : fF := bind p <- BigRgcd sp; bind p0 <- Isnull p; if ~~ p0 then bind c <- CcountWeak p sq; Lt 0%qfT c else let bq := BoundingPoly sq in bind cw <- CcountWeak bq sq; ((reducebig True sq (fun q => BigBody q And true (LeadCoef q (fun lq => Lt 0 lq)))) \/ ((reducebig True sq (fun q => BigBody q And true (bind sq <- Size q; bind lq <- LeadCoef q; Lt 0 ((Opp 1) ^+ (sq).-1 * lq) ))) \/ Lt 0 cw))%qfT. Fixpoint abstrX (i : nat) (t : tF) : polyF := (match t with | 'X_n => if n == i then [::0; 1] else [::t] | - x => -- abstrX i x | x + y => abstrX i x ++ abstrX i y | x * y => abstrX i x ** abstrX i y | x *+ n => n +** abstrX i x | x ^+ n => abstrX i x ^^+ n | _ => [::t] end)%qfT. Definition wproj (n : nat) (s : seq (GRing.term F) * seq (GRing.term F)) : formula F := let sp := map (abstrX n \o to_rterm) s.1%PAIR in let sq := map (abstrX n \o to_rterm) s.2%PAIR in CcountGt0 sp sq. Definition rcf_sat := proj_sat wproj. End ProjDef. Section ProjCorrect. Variable F : rcfType. Implicit Types (e : seq F). Notation fF := (formula F). Notation tF := (term F). Notation polyF := (polyF F). Notation "'If' c1 'Then' c2 'Else' c3" := (If c1 c2 c3) (at level 200, right associativity, format "'[hv ' 'If' c1 '/' '[' 'Then' c2 ']' '/' '[' 'Else' c3 ']' ']'"). Notation cps T := ((T -> fF) -> fF). Local Infix "**" := MulPoly (at level 40) : qf_scope. Local Infix "+**" := NatMulPoly (at level 40) : qf_scope. Local Notation "-- p" := (OppPoly p) (at level 35) : qf_scope. Local Notation "p -- q" := (p ++ (-- q))%qfT (at level 50) : qf_scope. Local Infix "^^+" := ExpPoly (at level 29) : qf_scope. Local Infix "**" := MulPoly (at level 40) : qf_scope. Local Infix "*:" := ScalPoly : qf_scope. Local Infix "++" := AddPoly : qf_scope. Lemma eval_If e pf tf ef (ev := qf_eval e) : ev (If pf Then tf Else ef) = (if ev pf then ev tf else ev ef). Proof. by unlock (If _ Then _ Else _)=> /=; case: ifP => _; rewrite ?orbF. Qed. Lemma eval_Size k p e : qf_eval e (Size p k) = qf_eval e (k (size (eval_poly e p))). Proof. elim: p e k=> [|c p ihp] e k; first by rewrite size_poly0. rewrite ihp /= size_MXaddC -size_poly_eq0; case: size=> //. by rewrite eval_If /=; case: (_ == _). Qed. Lemma eval_Isnull k p e : qf_eval e (Isnull p k) = qf_eval e (k (eval_poly e p == 0)). Proof. by rewrite eval_Size size_poly_eq0. Qed. Lemma eval_LeadCoef e p k k' : (forall x, qf_eval e (k x) = (k' (eval e x))) -> qf_eval e (LeadCoef p k) = k' (lead_coef (eval_poly e p)). Proof. move=> Pk; elim: p k k' Pk=> [|a p ihp] k k' Pk //=. by rewrite lead_coef0 Pk. rewrite (ihp _ (fun l => if l == 0 then qf_eval e (k a) else (k' l))); last first. by move=> x; rewrite eval_If /= !Pk. rewrite lead_coef_eq0; have [->|p_neq0] := altP (_ =P 0). by rewrite mul0r add0r lead_coefC. rewrite lead_coefDl ?lead_coefMX ?size_mulX // ltnS size_polyC. by rewrite (leq_trans (leq_b1 _)) // size_poly_gt0. Qed. Arguments eval_LeadCoef [e p k]. Prenex Implicits eval_LeadCoef. Lemma eval_AmulXn a n e : eval_poly e (AmulXn a n) = (eval e a)%:P * 'X^n. Proof. elim: n=> [|n] /=; first by rewrite expr0 mulr1 mul0r add0r. by move->; rewrite addr0 -mulrA -exprSr. Qed. Lemma eval_AddPoly p q e : eval_poly e (p ++ q)%qfT = (eval_poly e p) + (eval_poly e q). Proof. elim: p q => [|a p Hp] q /=; first by rewrite add0r. case: q => [|b q] /=; first by rewrite addr0. by rewrite Hp mulrDl rmorphD /= !addrA [X in _ = X + _]addrAC. Qed. Lemma eval_ScalPoly e t p : eval_poly e (ScalPoly t p) = (eval e t) *: (eval_poly e p). Proof. elim: p=> [|a p ihp] /=; first by rewrite scaler0. by rewrite ihp scalerDr scalerAl -!mul_polyC rmorphM. Qed. Lemma eval_MulPoly e p q : eval_poly e (p ** q)%qfT = (eval_poly e p) * (eval_poly e q). Proof. elim: p q=> [|a p Hp] q /=; first by rewrite mul0r. rewrite eval_AddPoly /= eval_ScalPoly Hp. by rewrite addr0 mulrDl addrC mulrAC mul_polyC. Qed. Lemma eval_ExpPoly e p n : eval_poly e (p ^^+ n)%qfT = (eval_poly e p) ^+ n. Proof. case: n=> [|n]; first by rewrite /= expr0 mul0r add0r. rewrite /ExpPoly iteropS exprSr; elim: n=> [|n ihn] //=. by rewrite expr0 mul1r. by rewrite eval_MulPoly ihn exprS mulrA. Qed. Lemma eval_NatMulPoly p n e : eval_poly e (n +** p)%qfT = (eval_poly e p) *+ n. Proof. elim: p; rewrite //= ?mul0rn // => c p ->. rewrite mulrnDl mulr_natl polyCMn; congr (_+_). by rewrite -mulr_natl mulrAC -mulrA mulr_natl mulrC. Qed. Lemma eval_OppPoly p e : eval_poly e (-- p)%qfT = - eval_poly e p. Proof. elim: p; rewrite //= ?oppr0 // => t ts ->. by rewrite !mulNr !opprD polyCN mul1r. Qed. Lemma eval_Horner e p x : eval e (Horner p x) = (eval_poly e p).[eval e x]. Proof. by elim: p => /= [|a p ihp]; rewrite !(horner0, hornerE) // ihp. Qed. Lemma eval_ConstPoly e c : eval_poly e [::c] = (eval e c)%:P. Proof. by rewrite /= mul0r add0r. Qed. Lemma eval_Deriv e p : eval_poly e (Deriv p) = (eval_poly e p)^`(). Proof. elim: p=> [|a p ihp] /=; first by rewrite deriv0. by rewrite eval_AddPoly /= addr0 ihp !derivE. Qed. Definition eval_OpPoly := (eval_MulPoly, eval_AmulXn, eval_AddPoly, eval_OppPoly, eval_NatMulPoly, eval_ConstPoly, eval_Horner, eval_ExpPoly, eval_Deriv, eval_ScalPoly). Lemma eval_Changes e s k : qf_eval e (Changes s k) = qf_eval e (k (changes (map (eval e) s))). Proof. elim: s k=> //= a q ihq k; rewrite ihq eval_If /= -nth0. by case: q {ihq}=> /= [|b q]; [rewrite /= mulr0 ltxx add0n | case: ltrP]. Qed. Lemma eval_SeqPInfty e ps k k' : (forall xs, qf_eval e (k xs) = k' (map (eval e) xs)) -> qf_eval e (SeqPInfty ps k) = k' (map lead_coef (map (eval_poly e) ps)). Proof. elim: ps k k' => [|p ps ihps] k k' Pk /=; first by rewrite Pk. set X := lead_coef _; grab_eq k'' X; apply: (eval_LeadCoef k'') => lp {X}. rewrite (ihps _ (fun ps => k' (eval e lp :: ps))) => [//|lps]. by rewrite Pk. (* use //= above and remove line when using Coq >= 8.17 *) Qed. Arguments eval_SeqPInfty [e ps k]. Prenex Implicits eval_SeqPInfty. Lemma eval_SeqMInfty e ps k k' : (forall xs, qf_eval e (k xs) = k' (map (eval e) xs)) -> qf_eval e (SeqMInfty ps k) = k' (map (fun p : {poly F} => (-1) ^+ (~~ odd (size p)) * lead_coef p) (map (eval_poly e) ps)). Proof. elim: ps k k' => [|p ps ihps] k k' Pk /=; first by rewrite Pk. set X := lead_coef _; grab_eq k'' X; apply: eval_LeadCoef => lp {X}. rewrite eval_Size /= /k'' {k''}. by set X := map _ _; grab_eq k'' X; apply: ihps => {X} lps; rewrite Pk. Qed. Arguments eval_SeqMInfty [e ps k]. Prenex Implicits eval_SeqMInfty. Lemma eval_ChangesPoly e ps k : qf_eval e (ChangesPoly ps k) = qf_eval e (k (changes_poly (map (eval_poly e) ps))). Proof. rewrite (eval_SeqMInfty (fun mps => qf_eval e (k ((changes mps)%:Z - (changes_pinfty [seq eval_poly e i | i <- ps])%:Z)))) => // mps. rewrite (eval_SeqPInfty (fun pps => qf_eval e (k ((changes (map (eval e) mps))%:Z - (changes pps)%:Z)))) => // pps. by rewrite !eval_Changes. Qed. Fixpoint redivp_rec_loop (q : {poly F}) sq cq (k : nat) (qq r : {poly F})(n : nat) {struct n} := if (size r < sq)%N then (k, qq, r) else let m := (lead_coef r) *: 'X^(size r - sq) in let qq1 := qq * cq%:P + m in let r1 := r * cq%:P - m * q in if n is n1.+1 then redivp_rec_loop q sq cq k.+1 qq1 r1 n1 else (k.+1, qq1, r1). Lemma redivp_rec_loopP q c qq r n : redivp_rec q c qq r n = redivp_rec_loop q (size q) (lead_coef q) c qq r n. Proof. by elim: n c qq r => [| n Pn] c qq r //=; rewrite Pn. Qed. Lemma eval_Rediv_rec_loop e q sq cq c qq r n k k' (d := redivp_rec_loop (eval_poly e q) sq (eval e cq) c (eval_poly e qq) (eval_poly e r) n) : (forall c qq r, qf_eval e (k (c, qq, r)) = k' (c, eval_poly e qq, eval_poly e r)) -> qf_eval e (Rediv_rec_loop q sq cq c qq r n k) = k' d. Proof. move=> Pk; elim: n c qq r k Pk @d=> [|n ihn] c qq r k Pk /=. rewrite eval_Size /=; have [//=|gtq] := ltnP. set X := lead_coef _; grab_eq k'' X; apply: eval_LeadCoef => {X}. by move=> x /=; rewrite Pk /= !eval_OpPoly /= !mul_polyC. rewrite eval_Size /=; have [//=|gtq] := ltnP. set X := lead_coef _; grab_eq k'' X; apply: eval_LeadCoef => {X}. by move=> x; rewrite ihn // !eval_OpPoly /= !mul_polyC. Qed. Arguments eval_Rediv_rec_loop [e q sq cq c qq r n k]. Prenex Implicits eval_Rediv_rec_loop. Lemma eval_Rediv e p q k k' (d := (redivp (eval_poly e p) (eval_poly e q))) : (forall c qq r, qf_eval e (k (c, qq, r)) = k' (c, eval_poly e qq, eval_poly e r)) -> qf_eval e (Rediv p q k) = k' d. Proof. move=> Pk; rewrite eval_Isnull /d unlock. have [_|p_neq0] /= := boolP (_ == _); first by rewrite Pk /= mul0r add0r. rewrite !eval_Size; set p' := eval_poly e p; set q' := eval_poly e q. rewrite (eval_LeadCoef (fun lq => k' (redivp_rec_loop q' (size q') lq 0 0 p' (size p')))) /=; last first. by move=> x; rewrite (eval_Rediv_rec_loop k') //= mul0r add0r. by rewrite redivp_rec_loopP. Qed. Arguments eval_Rediv [e p q k]. Prenex Implicits eval_Rediv. Lemma eval_NextMod e p q k k' : (forall p, qf_eval e (k p) = k' (eval_poly e p)) -> qf_eval e (NextMod p q k) = k' (next_mod (eval_poly e p) (eval_poly e q)). Proof. move=> Pk; set p' := eval_poly e p; set q' := eval_poly e q. rewrite (eval_LeadCoef (fun lq => k' (- lq ^+ rscalp p' q' *: rmodp p' q'))) => // lq. rewrite (eval_Rediv (fun spq => k' (- eval e lq ^+ spq.1.1%PAIR *: rmodp p' q'))) => //= spq _ _. rewrite (eval_Rediv (fun mpq => k' (- eval e lq ^+ spq *: mpq.2%PAIR))) => //= _ _ mpq. by rewrite Pk !eval_OpPoly. Qed. Arguments eval_NextMod [e p q k]. Prenex Implicits eval_NextMod. Lemma eval_Rgcd_loop e n p q k k' : (forall p, qf_eval e (k p) = k' (eval_poly e p)) -> qf_eval e (Rgcd_loop n p q k) = k' (rgcdp_loop n (eval_poly e p) (eval_poly e q)). Proof. elim: n p q k k'=> [|n ihn] p q k k' Pk /=. rewrite (eval_Rediv (fun r => if r.2%PAIR == 0 then k' (eval_poly e q) else k' r.2%PAIR)) /=. by case: eqP. by move=> _ _ r; rewrite eval_Isnull; case: eqP. pose q' := eval_poly e q. rewrite (eval_Rediv (fun r => if r.2%PAIR == 0 then k' q' else k' (rgcdp_loop n q' r.2%PAIR))) /=. by case: eqP. move=> _ _ r; rewrite eval_Isnull; case: eqP; first by rewrite Pk. by rewrite (ihn _ _ _ k'). Qed. Lemma eval_Rgcd e p q k k' : (forall p, qf_eval e (k p) = k' (eval_poly e p)) -> qf_eval e (Rgcd p q k) = k' (rgcdp (eval_poly e p) (eval_poly e q)). Proof. move=> Pk; rewrite /Rgcd /LtSize !eval_Size /rgcdp. case: ltnP=> _; rewrite !eval_Isnull; case: eqP=> // _; by rewrite eval_Size; apply: eval_Rgcd_loop. Qed. Lemma eval_BigRgcd e ps k k' : (forall p, qf_eval e (k p) = k' (eval_poly e p)) -> qf_eval e (BigRgcd ps k) = k' (\big[@rgcdp _/0%:P]_(i <- ps) (eval_poly e i)). Proof. elim: ps k k'=> [|p sp ihsp] k k' Pk /=. by rewrite big_nil Pk /= mul0r add0r. rewrite big_cons (ihsp _ (fun r => k' (rgcdp (eval_poly e p) r))) //. by move=> r; apply: eval_Rgcd. Qed. Arguments eval_Rgcd [e p q k]. Prenex Implicits eval_Rgcd. Fixpoint mods_aux (p q : {poly F}) (n : nat) : seq {poly F} := if n is m.+1 then if p == 0 then [::] else p :: (mods_aux q (next_mod p q) m) else [::]. Lemma eval_ModsAux e p q n k k' : (forall sp, qf_eval e (k sp) = k' (map (eval_poly e) sp)) -> qf_eval e (ModsAux p q n k) = k' (mods_aux (eval_poly e p) (eval_poly e q) n). Proof. elim: n p q k k'=> [|n ihn] p q k k' Pk; first by rewrite /= Pk. rewrite /= eval_Isnull; have [|ep_neq0] := altP (_ =P _); first by rewrite Pk. set q' := eval_poly e q; set p' := eval_poly e p. rewrite (eval_NextMod (fun npq => k' (p' :: mods_aux q' npq n))) => // npq. by rewrite (ihn _ _ _ (fun ps => k' (p' :: ps))) => // ps; rewrite Pk. Qed. Arguments eval_ModsAux [e p q n k]. Prenex Implicits eval_ModsAux. Lemma eval_Mods e p q k k' : (forall sp, qf_eval e (k sp) = k' (map (eval_poly e) sp)) -> qf_eval e (Mods p q k) = k' (mods (eval_poly e p) (eval_poly e q)). Proof. by move=> Pk; rewrite !eval_Size; apply: eval_ModsAux. Qed. Arguments eval_Mods [e p q k]. Prenex Implicits eval_Mods. Lemma eval_TaqR e p q k : qf_eval e (TaqR p q k) = qf_eval e (k (taqR (eval_poly e p) (eval_poly e q))). Proof. rewrite (eval_Mods (fun r => qf_eval e (k (changes_poly r)))). by rewrite !eval_OpPoly. by move=> sp; rewrite !eval_ChangesPoly. Qed. Lemma eval_PolyComb e sq sc : eval_poly e (PolyComb sq sc) = poly_comb (map (eval_poly e) sq) sc. Proof. rewrite /PolyComb /poly_comb size_map -bigop.unlock -val_enum_ord/= big_map. rewrite (@big_morph _ _ _ 1%R *%R _ _ (eval_MulPoly _))/= ?mul0r ?add0r//. by rewrite big_enum; under eq_bigr do rewrite eval_ExpPoly/= -(nth_map _ 0)//. Qed. Definition pcq (sq : seq {poly F}) i := (map (poly_comb sq) (sg_tab (size sq)))`_i. Lemma eval_Pcq e sq i : eval_poly e (Pcq sq i) = pcq (map (eval_poly e) sq) i. Proof. rewrite /Pcq /pcq size_map; move: (sg_tab _)=> s. have [ge_is|lt_is] := leqP (size s) i. by rewrite !nth_default ?size_map // /=. rewrite -(nth_map _ 0) ?size_map //; congr _`_i; rewrite -map_comp. by apply: eq_map=> x /=; rewrite eval_PolyComb. Qed. Lemma eval_TaqsR e p sq i k k' : (forall x, qf_eval e (k x) = k' (eval e x)) -> qf_eval e (TaqsR p sq i k) = k' (taqsR (eval_poly e p) (map (eval_poly e) sq) i). Proof. by move=> Pk; rewrite /TaqsR /taqsR eval_TaqR Pk /= eval_Pcq. Qed. Arguments eval_TaqsR [e p sq i k]. Prenex Implicits eval_TaqsR. Fact invmx_ctmat1 : invmx (map_mx (intr : int -> F) ctmat1) = \matrix_(i, j) (nth [::] [:: [:: 2%:R^-1; - 2%:R^-1; 0]; [:: 2%:R^-1; 2%:R^-1; -1]; [:: 0; 0; 1]] i)`_j :> 'M[F]_3. Proof. rewrite -[lhs in lhs = _]mul1r; apply: (canLR (mulrK _)). exact: ctmat1_unit. symmetry; rewrite /ctmat1. apply/matrixP => i j; rewrite !(big_ord_recl, big_ord0, mxE) /=. have halfP (K : numFieldType) : 2%:R^-1 + 2%:R^-1 = 1 :> K. by rewrite -mulr2n -[_ *+ 2]mulr_natl mulfV // pnatr_eq0. move: i; do ?[case=> //=]; move: j; do ?[case=> //=] => _ _; rewrite !(mulr1, mul1r, mulrN1, mulN1r, mulr0, mul0r, opprK); by rewrite !(addr0, add0r, oppr0, subrr, addrA, halfP). Qed. Lemma eval_Coefs e n i : eval e (Coefs F n i) = coefs F n i. Proof. case: n => [|[|n]] //=; rewrite /coefs /=. case: i => [|i]; last first. by rewrite nth_default // size_map size_enum_ord expn0. rewrite (nth_map 0) ?size_enum_ord //. set O := _`_0; rewrite (_ : O = ord0). by rewrite ?castmxE ?cast_ord_id map_mx1 invmx1 mxE. by apply: val_inj => /=; rewrite nth_enum_ord. have [lt_i3|le_3i] := ltnP i 3; last first. by rewrite !nth_default // size_map size_enum_ord. rewrite /ctmat /= ?ntensmx1 invmx_ctmat1 /=. rewrite (nth_map 0) ?size_enum_ord // castmxE /=. rewrite !mxE !cast_ord_id //= nth_enum_ord //=. by move: i lt_i3; do 3?case. Qed. Lemma eval_CcountWeak e p sq k k' : (forall x, qf_eval e (k x) = k' (eval e x)) -> qf_eval e (CcountWeak p sq k) = k' (ccount_weak (eval_poly e p) (map (eval_poly e) sq)). Proof. move=> Pk; rewrite /CcountWeak /ccount_weak. set Aux := (fix Aux s i k := match i with 0 => _ | _ => _ end). set aux := (fix aux s i := match i with 0 => _ | _ => _ end). rewrite size_map -[0]/(eval e 0%qfT); move: 0%qfT=> x. elim: (_ ^ _)%N k k' Pk x=> /= [|n ihn] k k' Pk x. by rewrite Pk. rewrite (eval_TaqsR (fun y => k' (aux (y * (coefs F (size sq) n) + eval e x) n))). by rewrite size_map. by move=> y; rewrite (ihn _ k') // -(eval_Coefs e). Qed. Arguments eval_CcountWeak [e p sq k]. Prenex Implicits eval_CcountWeak. Lemma eval_ProdPoly e T s f k f' k' : (forall x k k', (forall p, (qf_eval e (k p) = k' (eval_poly e p))) -> qf_eval e (f x k) = k' (f' x)) -> (forall p, qf_eval e (k p) = k' (eval_poly e p)) -> qf_eval e (@ProdPoly _ T s f k) = k' (\prod_(x <- s) f' x). Proof. move=> Pf; elim: s k k'=> [|a s ihs] k k' Pk /=. by rewrite big_nil Pk /= !(mul0r, add0r). rewrite (Pf _ _ (fun fa => k' (fa * \prod_(x <- s) f' x))). by rewrite big_cons. move=> fa; rewrite (ihs _ (fun fs => k' (eval_poly e fa * fs))) //. by move=> fs; rewrite Pk eval_OpPoly. Qed. Arguments eval_ProdPoly [e T s f k]. Prenex Implicits eval_ProdPoly. Lemma eval_BoundingPoly e sq : eval_poly e (BoundingPoly sq) = bounding_poly (map (eval_poly e) sq). Proof. rewrite eval_Deriv -bigop.unlock; congr _^`(); rewrite big_map. by apply: big_morph => [p q | ]/=; rewrite ?eval_MulPoly // mul0r add0r. Qed. Lemma eval_CcountGt0 e sp sq : qf_eval e (CcountGt0 sp sq) = ccount_gt0 (map (eval_poly e) sp) (map (eval_poly e) sq). Proof. pose sq' := map (eval_poly e) sq; rewrite /ccount_gt0. rewrite (@eval_BigRgcd _ _ _ (fun p => if p != 0 then 0 < ccount_weak p sq' else let bq := bounding_poly sq' in [|| \big[andb/true]_(q <- sq') (0 < lead_coef q), \big[andb/true]_(q <- sq') (0 < (-1) ^+ (size q).-1 * lead_coef q) | 0 < ccount_weak bq sq'])). by rewrite !big_map. move=> p; rewrite eval_Isnull; case: eqP=> _ /=; last first. by rewrite (eval_CcountWeak (> 0)). rewrite (eval_CcountWeak (fun n => [|| \big[andb/true]_(q <- sq') (0 < lead_coef q), \big[andb/true]_(q <- sq') (0 < (-1) ^+ (size q).-1 * lead_coef q) | 0 < n ])). by rewrite eval_BoundingPoly. move=> n /=; rewrite -!bigop.unlock !big_map; congr [|| _, _| _]. apply: (big_ind2 (fun u v => qf_eval e u = v))=> //=. by move=> u v u' v' -> ->. by move=> i _; rewrite (eval_LeadCoef (> 0)). apply: (big_ind2 (fun u v => qf_eval e u = v))=> //=. by move=> u v u' v' -> ->. by move=> i _; rewrite eval_Size (eval_LeadCoef (fun lq => (0 < (-1) ^+ (size (eval_poly e i)).-1 * lq))). Qed. Lemma abstrXP e i t x : (eval_poly e (abstrX i t)).[x] = eval (set_nth 0 e i x) t. Proof. elim: t. - move=> n /=; case ni: (_ == _); rewrite //= ?(mul0r,add0r,addr0,polyC1,mul1r,hornerX,hornerC); by rewrite // nth_set_nth /= ni. - by move=> r; rewrite /= mul0r add0r hornerC. - by move=> r; rewrite /= mul0r add0r hornerC. - by move=> t tP s sP; rewrite /= eval_AddPoly hornerD tP ?sP. - by move=> t tP; rewrite /= eval_OppPoly hornerN tP. - by move=> t tP n; rewrite /= eval_NatMulPoly hornerMn tP. - by move=> t tP s sP; rewrite /= eval_MulPoly hornerM tP ?sP. - by move=> t tP n; rewrite /= eval_ExpPoly horner_exp tP. Qed. Lemma wf_QE_wproj i bc (bc_i := @wproj F i bc) : dnf_rterm (w_to_oclause bc) -> qf_form bc_i && rformula bc_i. Proof. case: bc @bc_i=> sp sq /=; rewrite /dnf_rterm /= /wproj andbT=> /andP[rsp rsq]. by rewrite qf_formF rformulaF. Qed. Lemma valid_QE_wproj i bc (bc' := w_to_oclause bc) (ex_i_bc := ('exists 'X_i, odnf_to_oform [:: bc'])%oT) e : dnf_rterm bc' -> reflect (holds e ex_i_bc) (ord.qf_eval e (wproj i bc)). Proof. case: bc @bc' @ex_i_bc=> sp sq /=; rewrite /dnf_rterm /wproj /= andbT. move=> /andP[rsp rsq]; rewrite -qf_evalE. rewrite eval_CcountGt0 /=; apply: (equivP (ccount_gt0P _ _)). set P1 := (fun x => _); set P2 := (fun x => _). suff: forall x, P1 x <-> P2 x. by move=> hP; split=> [] [x Px]; exists x; rewrite (hP, =^~ hP). move=> x; rewrite /P1 /P2 {P1 P2} !big_map !(big_seq_cond xpredT) /=. rewrite (eq_bigr (fun t => GRing.eval (set_nth 0 e i x) t == 0)); last first. by move=> t /andP[t_in_sp _]; rewrite abstrXP evalE to_rtermE ?(allP rsp). rewrite [X in _ && X](eq_bigr (fun t => 0 < GRing.eval (set_nth 0 e i x) t)); last by move=> t /andP[tsq _]; rewrite abstrXP evalE to_rtermE ?(allP rsq). rewrite -!big_seq_cond !(rwP (qf_evalP _ _)); first last. + elim: sp rsp => //= p sp ihsp /andP[rp rsp]; first by rewrite ihsp. + elim: sq rsq => //= q sq ihsq /andP[rq rsq]; first by rewrite ihsq. rewrite !(rwP andP) (rwP orP) orbF !andbT /=. have unfoldr P s : foldr (fun t => ord.And (P t)) ord.True s = \big[ord.And/ord.True]_(t <- s) P t by rewrite unlock /reducebig. rewrite !unfoldr; set e' := set_nth _ _ _ _. by rewrite !(@big_morph _ _ (ord.qf_eval _) true andb). Qed. Lemma rcf_satP e f : reflect (holds e f) (rcf_sat e f). Proof. exact: (proj_satP wf_QE_wproj valid_QE_wproj). Qed. End ProjCorrect. (* Section Example. *) (* no chances it computes *) (* From mathcomp Require Import rat. *) (* Eval vm_compute in (54%:R / 289%:R + 2%:R^-1 :rat). *) (* Local Open Scope qf_scope. *) (* Notation polyF := (polyF [realFieldType of rat]). *) (* Definition p : polyF := [::'X_2; 'X_1; 'X_0]. *) (* Definition q : polyF := [:: 0; 1]. *) (* Definition sq := [::q]. *) (* Eval vm_compute in MulPoly p q. *) (* Eval vm_compute in Rediv ([:: 1] : polyF) [::1]. *) (* Definition fpq := Eval vm_compute in (CcountWeak p [::q]). *) (* End Example. *) real-closed-2.0.2/theories/qe_rcf_th.v000066400000000000000000001477771472566273500177200ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From mathcomp Require Import all_ssreflect all_algebra. From mathcomp Require Import polyorder polyrcf mxtens. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import Order.TTheory GRing.Theory Num.Theory Pdiv.Ring Pdiv.ComRing. Local Open Scope ring_scope. Section extra. Variable R : rcfType. Implicit Types (p q : {poly R}). Lemma mul2n n : (2 * n = n + n)%N. Proof. by rewrite mulSn mul1n. Qed. Lemma mul3n n : (3 * n = n + (n + n))%N. Proof. by rewrite !mulSn addn0. Qed. Lemma exp3n n : (3 ^ n)%N = (3 ^ n).-1.+1. Proof. by elim: n => // n IHn; rewrite expnS IHn. Qed. Definition exp3S n : (3 ^ n.+1 = 3 ^ n + (3 ^ n + 3 ^ n))%N := etrans (expnS 3 n) (mul3n (3 ^ n)). Lemma tens_I3_mx (cR : comRingType) m n (M : 'M[cR]_(m,n)) : 1%:M *t M = castmx (esym (mul3n _ ), esym (mul3n _ )) (block_mx M 0 0 (block_mx M 0 0 M : 'M_(m+m,n+n)%N)). Proof. rewrite [1%:M : 'M_(1+2)%N]scalar_mx_block. rewrite [1%:M : 'M_(1+1)%N]scalar_mx_block. rewrite !tens_block_mx. apply/eqP; rewrite -(can2_eq (castmxKV _ _) (castmxK _ _)); apply/eqP. rewrite castmx_comp !tens_scalar_mx !tens0mx !scale1r. rewrite (castmx_block (mul1n _) (mul1n _) (mul2n _) (mul2n _)). rewrite !castmx_comp /= !castmx_id. rewrite (castmx_block (mul1n _) (mul1n _) (mul1n _) (mul1n _)). by rewrite !castmx_comp /= !castmx_id !castmx_const /=. Qed. Lemma mul_1tensmx (cR : comRingType) (m n p: nat) (e3n : (n + (n + n) = 3 * n)%N) (A B C : 'M[cR]_(m, n)) (M : 'M[cR]_(n, p)) : castmx (erefl _, e3n) (row_mx A (row_mx B C)) *m (1%:M *t M) = castmx (erefl _, esym (mul3n _)) (row_mx (A *m M) (row_mx (B *m M) (C *m M))). Proof. apply/eqP; rewrite -(can2_eq (castmxKV _ _) (castmxK _ _)); apply/eqP. rewrite tens_I3_mx mulmx_cast castmx_mul !castmx_comp /= !castmx_id /=. by rewrite !mul_row_block /= !mulmx0 !addr0 !add0r. Qed. (* :TODO: backport to polydiv *) Lemma coprimep_rdiv_gcd p q : (p != 0) || (q != 0) -> coprimep (rdivp p (gcdp p q)) (rdivp q (gcdp p q)). Proof. move=> hpq. have gpq0: gcdp p q != 0 by rewrite gcdp_eq0 negb_and. rewrite -gcdp_eqp1 -(@eqp_mul2r _ (gcdp p q)) // mul1r. have: gcdp p q %| p by rewrite dvdp_gcdl. have: gcdp p q %| q by rewrite dvdp_gcdr. rewrite !dvdpE !rdvdp_eq eq_sym; move/eqP=> hq; rewrite eq_sym; move/eqP=> hp. rewrite (eqp_ltrans (mulp_gcdl _ _ _)) hq hp. have lcn0 k : (lead_coef (gcdp p q)) ^+ k != 0. by rewrite expf_neq0 ?lead_coef_eq0. by apply: eqp_gcd; rewrite ?eqp_scale. Qed. (* :TODO: generalize to non idomainTypes and backport to polydiv *) Lemma rgcdp_eq0 p q : rgcdp p q == 0 = (p == 0) && (q == 0). Proof. by rewrite -eqp0 (eqp_ltrans (eqp_rgcd_gcd _ _)) eqp0 gcdp_eq0. Qed. (* :TODO: : move in polyorder *) Lemma mu_eq0 : forall p x, p != 0 -> (\mu_x p == 0%N) = (~~ root p x). Proof. by move=> p x p0; rewrite -mu_gt0 // -leqNgt leqn0. Qed. Notation lcn_neq0 := lc_expn_rscalp_neq0. (* :TODO: : move to polyorder *) Lemma mu_mod p q x : (\mu_x p < \mu_x q)%N -> \mu_x (rmodp p q) = \mu_x p. Proof. move=> mupq; have [->|p0] := eqVneq p 0; first by rewrite rmod0p. have qn0 : q != 0 by apply: contraTneq mupq => ->; rewrite mu0 ltn0. have /(canLR (addKr _)) <- := (rdivp_eq q p). have [->|divpq_eq0] := eqVneq (rdivp p q) 0. by rewrite mul0r oppr0 add0r mu_mulC ?lcn_neq0. rewrite mu_addl ?mu_mulC ?scaler_eq0 ?negb_or ?mulf_neq0 ?lcn_neq0 //. by rewrite mu_opp mu_mul ?ltn_addl // ?mulf_neq0. Qed. (* :TODO: : move to polyorder *) Lemma mu_add p q x : p + q != 0 -> (minn (\mu_x p) (\mu_x q) <= \mu_x (p + q)%R)%N . Proof. have [->|p0] := eqVneq p 0; first by rewrite mu0 min0n add0r. have [->|q0] := eqVneq q 0; first by rewrite mu0 minn0 addr0. have [Hpq|Hpq|Hpq] := (ltngtP (\mu_x p) (\mu_x q)). + by rewrite mu_addr ?geq_minl. + by rewrite mu_addl ?geq_minr. have [//|p' nrp'x hp] := (@mu_spec _ p x). have [//|q' nrq'x hq] := (@mu_spec _ q x). rewrite Hpq hp {1 3}hq Hpq -mulrDl => pq0. by rewrite mu_mul // mu_exp mu_XsubC mul1n leq_addl. Qed. (* :TODO: : move to polydiv *) Lemma mu_mod_leq : forall p q x, ~~ (q %| p) -> (\mu_x q <= \mu_x p)%N -> (\mu_x q <= \mu_x (rmodp p q)%R)%N. Proof. move=> p q x; rewrite dvdpE /rdvdp=> rn0 mupq. case q0: (q == 0); first by rewrite (eqP q0) mu0 leq0n. move/eqP: (rdivp_eq q p). rewrite eq_sym (can2_eq (addKr _ ) (addNKr _)); move/eqP=> hr. rewrite hr; case qpq0: (rdivp p q == 0). by rewrite (eqP qpq0) mul0r oppr0 add0r mu_mulC // lcn_neq0. rewrite (leq_trans _ (mu_add _ _)) // -?hr //. rewrite leq_min mu_opp mu_mul ?mulf_neq0 ?qpq0 ?q0 // leq_addl. by rewrite mu_mulC // lcn_neq0. Qed. End extra. Section ctmat. Variable R : numFieldType. Definition ctmat1 := \matrix_(i < 3, j < 3) (nth [::] [:: [:: 1%:Z ; 1 ; 1 ] ; [:: -1 ; 1 ; 1 ] ; [:: 0 ; 0 ; 1 ] ] i)`_j. Lemma det_ctmat1 : \det ctmat1 = 2. Proof. (* Developpement direct ? *) by do ?[rewrite (expand_det_row _ ord0) //=; rewrite ?(big_ord_recl,big_ord0) //= ?mxE //=; rewrite /cofactor /= ?(addn0, add0n, expr0, exprS); rewrite ?(mul1r,mulr1,mulN1r,mul0r,mul1r,addr0) /=; do ?rewrite [row' _ _]mx11_scalar det_scalar1 !mxE /=]. Qed. Notation zmxR := ((map_mx ((intmul 1) : int -> R))). Lemma ctmat1_unit : zmxR ctmat1 \in unitmx. Proof. rewrite /mem /in_mem /= /unitmx det_map_mx //. by rewrite det_ctmat1 unitfE intr_eq0. Qed. Definition ctmat n := (ctmat1 ^t n). Lemma ctmat_unit : forall n, zmxR (ctmat n) \in unitmx. Proof. case=> [|n] /=; first by rewrite map_mx1 ?unitmx1//; apply: zinjR_morph. elim: n=> [|n ihn] /=; first by apply: ctmat1_unit. rewrite map_mxT //. apply: tensmx_unit=> //; last exact: ctmat1_unit. by elim: n {ihn}=> // n ihn; rewrite muln_eq0. Qed. Lemma ctmat1_blocks : ctmat1 = (block_mx 1 (row_mx 1 1) (col_mx (-1) 0) (block_mx 1 1 0 1 : 'M_(1+1)%N)). Proof. apply/matrixP=> i j; rewrite !mxE. by do 4?[case: splitP => ?; rewrite !mxE ?ord1=> ->]. Qed. Lemma tvec_sub n : (3 * (3 ^ n).-1.+1 = 3 ^ (n.+1) )%N. Proof. by rewrite -exp3n expnS. Qed. Lemma tens_ctmat1_mx n (M : 'M_n) : ctmat1 *t M = castmx (esym (mul3n _ ), esym (mul3n _ )) (block_mx M (row_mx M M) (col_mx (-M) 0) (block_mx M M 0 M : 'M_(n+n)%N)). Proof. rewrite ctmat1_blocks !tens_block_mx !tens_row_mx !tens_col_mx. rewrite [-1]mx11_scalar !mxE /= !tens_scalar_mx !tens0mx scaleNr !scale1r. apply/eqP; rewrite -(can2_eq (castmxKV _ _) (castmxK _ _)); apply/eqP. rewrite !castmx_comp !esymK /=. rewrite !(castmx_block (mul1n _) (mul1n _) (mul2n _) (mul2n _)). rewrite !castmx_comp !castmx_id /=. rewrite !(castmx_row (mul1n _) (mul1n _)). rewrite !(castmx_block (mul1n _) (mul1n _) (mul1n _) (mul1n _)) /=. rewrite !(castmx_col (mul1n _) (mul1n _)) !castmx_comp !castmx_id /=. by rewrite !castmx_const. Qed. Definition coefs n i := [seq (castmx (erefl _, exp3n _) (invmx (zmxR (ctmat n)))) i ord0 | i <- enum 'I__]`_i. End ctmat. Section QeRcfTh. Variable R : rcfType. Implicit Types a b : R. Implicit Types p q : {poly R}. Notation zmxR := ((map_mx ((intmul 1) : int -> R))). Notation midf a b := ((a + b) / 2%:~R). (* Constraints and Tarski queries *) Local Notation sgp_is q s := (fun x => (Num.sg q.[x] == s)). Definition constraints (z : seq R) (sq : seq {poly R}) (sigma : seq int) := (\sum_(x <- z) \prod_(i < size sq) (sgz (sq`_i).[x] == (sigma`_i)%R))%N. Definition taq (z : seq R) (q : {poly R}) : int := \sum_(x <- z) (sgz q.[x]). Lemma taq_constraint1 z q : taq z q = (constraints z [::q] [::1])%:~R - (constraints z [::q] [::-1])%:~R. Proof. rewrite /constraints /taq !sumMz -sumrB /=; apply: congr_big=> // x _. by rewrite !big_ord_recl big_ord0 !muln1 /=; case: sgzP. Qed. Lemma taq_constraint0 z q : taq z 1 = (constraints z [::q] [:: 0])%:~R + (constraints z [::q] [:: 1])%:~R + (constraints z [::q] [::-1])%:~R. Proof. rewrite /constraints /taq !sumMz //= -!big_split /=; apply: congr_big=> // x _. by rewrite hornerC sgz1 !big_ord_recl big_ord0 !muln1 /=; case: sgzP. Qed. Lemma taq_no_constraint z : taq z 1 = (constraints z [::] [::])%:~R. Proof. rewrite /constraints /taq !sumMz; apply: congr_big=> // x _. by rewrite hornerC sgz1 big_ord0. Qed. Lemma taq_constraint2 z q : taq z (q ^+ 2) = (constraints z [::q] [:: 1])%:~R + (constraints z [::q] [::-1])%:~R. Proof. rewrite /constraints /taq !sumMz -big_split /=; apply: congr_big=> // x _. rewrite !big_ord_recl big_ord0 !muln1 /= horner_exp sgzX. by case: (sgzP q.[x])=> _. Qed. Fixpoint sg_tab n : seq (seq int) := if n is m.+1 then flatten (map (fun x => map (fun l => x :: l) (sg_tab m)) [::1; -1; 0]) else [::[::]]. Lemma sg_tab_nil n : (sg_tab n == [::]) = false. Proof. by elim: n => //= n; case: sg_tab. Qed. Lemma size_sg_tab n : size (sg_tab n) = (3 ^ n)%N. Proof. by elim: n => [|n] // ihn; rewrite !size_cat !size_map ihn addn0 exp3S. Qed. Lemma size_sg_tab_neq0 n : size (sg_tab n) != 0%N. Proof. by rewrite size_sg_tab exp3n. Qed. Definition comb_exp (R : realDomainType) (s : R) := match sgz s with Posz 1 => 1%N | Negz 0 => 2%N | _ => 0%N end. Definition poly_comb (sq : seq {poly R}) (sc : seq int) : {poly R} := \prod_(i < size sq) ((sq`_i) ^+ (comb_exp sc`_i)). (* Eval compute in sg_tab 4. *) Definition cvec z sq := let sg_tab := sg_tab (size sq) in \row_(i < 3 ^ size sq) ((constraints z sq (nth [::] sg_tab i))%:~R : int). Definition tvec z sq := let sg_tab := sg_tab (size sq) in \row_(i < 3 ^ size sq) (taq z (map (poly_comb sq) sg_tab)`_i). Lemma tvec_cvec1 z q : tvec z [::q] = (cvec z [::q]) *m ctmat1. Proof. apply/rowP => j. rewrite /tvec !mxE /poly_comb /= !big_ord_recl !big_ord0 //=. rewrite !(expr0,expr1,mulr1) /=. case: j=> [] [|[|[|j]]] hj //. * by rewrite !mxE /= mulr0 add0r mulr1 mulrN1 addr0 taq_constraint1. * by rewrite !mxE /= mulr0 !mulr1 add0r addr0 taq_constraint2. * rewrite !mxE /= addrA (@taq_constraint0 _ q) !mulr1 addr0 -[LHS]addrA. exact/addrC. Qed. Lemma cvec_rec z q sq : cvec z (q :: sq) = castmx (erefl _, esym (exp3S _)) (row_mx (cvec (filter (sgp_is q 1) z) (sq)) (row_mx (cvec (filter (sgp_is q (-1)) z) (sq)) (cvec (filter (sgp_is q 0) z) (sq)))). Proof. apply/eqP; rewrite -(can2_eq (castmxKV _ _) (castmxK _ _)); apply/eqP. apply/rowP=> [] i; rewrite !(mxE, castmxE, esymK, cast_ord_id) /=. symmetry; case: splitP=> j hj /=; rewrite !mxE hj. case hst: sg_tab (sg_tab_nil (size sq))=> [|l st] // _. have sst: (size st).+1 = (3 ^ size sq)%N. transitivity (size (sg_tab (size sq))); first by rewrite hst //. by rewrite size_sg_tab. rewrite /constraints big_filter big_mkcond !sumMz; apply: congr_big=> // x _. rewrite nth_cat size_map ![size (_::_)]/= sst ltn_ord. rewrite (nth_map [::]) /= ?sst ?ltn_ord // big_ord_recl /=. by rewrite sgr_cp0 sgz_cp0; case: (_ < _); first by rewrite mul1n. case: splitP=> k hk; rewrite !mxE /= hk. case hst: sg_tab (sg_tab_nil (size sq))=> [|l st] // _. have sst: (size st).+1 = (3 ^ size sq)%N. transitivity (size (sg_tab (size sq))); first by rewrite hst //. by rewrite size_sg_tab. rewrite /constraints big_filter big_mkcond !sumMz; apply: congr_big=> // x _. rewrite nth_cat nth_cat !size_map ![size (_ :: _)]/= sst ltnNge leq_addr. rewrite (@nth_map _ [::] _ _ [eta cons (-1)] _ (l::st)) /= ?sst addKn ltn_ord //. rewrite big_ord_recl /= sgr_cp0 sgz_cp0. by case: (_ < _); first by rewrite mul1n. case hst: sg_tab (sg_tab_nil (size sq))=> [|l st] // _. have sst: (size st).+1 = (3 ^ size sq)%N. transitivity (size (sg_tab (size sq))); first by rewrite hst //. by rewrite size_sg_tab. rewrite /constraints big_filter big_mkcond !sumMz; apply: congr_big=> // x _. rewrite nth_cat nth_cat nth_cat !size_map ![size (_ :: _)]/= sst. rewrite (@nth_map _ [::] _ _ [eta cons 0] _ (l::st)) /=; last first. by rewrite !addKn sst ltn_ord. rewrite ltnNge leq_addr /= !addKn ltnNge leq_addr /= ltn_ord. rewrite big_ord_recl /= sgr_cp0 sgz_cp0. by case: (_ == _); first by rewrite mul1n. Qed. Lemma poly_comb_cons q sq s ss : poly_comb (q :: sq) (s :: ss) = (q ^ (comb_exp s)) * poly_comb sq ss. Proof. by rewrite /poly_comb /= big_ord_recl /=. Qed. Lemma comb_expE (rR : realDomainType): (comb_exp (1 : rR) = 1%N) * (comb_exp (-1 : rR) = 2%N) * (comb_exp (0 : rR) = 0%N). Proof. by rewrite /comb_exp sgzN sgz1 sgz0. Qed. Lemma tvec_rec z q sq : tvec z (q :: sq) = castmx (erefl _, esym (exp3S _)) ( (row_mx (tvec (filter (sgp_is q 1) z) (sq)) (row_mx (tvec (filter (sgp_is q (-1)) z) (sq)) (tvec (filter (sgp_is q 0) z) (sq)))) *m (castmx (mul3n _, mul3n _) (ctmat1 *t 1%:M))). Proof. rewrite tens_ctmat1_mx !castmx_comp !castmx_id /=. rewrite !(mul_row_block, mul_row_col, mul_mx_row) !(mulmx1, mulmx0, mulmxN, addr0) /=. apply/eqP; rewrite -(can2_eq (castmxKV _ _) (castmxK _ _)); apply/eqP. apply/matrixP=> i j; rewrite !(castmxE, mxE) /=. symmetry; case: splitP=> l hl; rewrite !mxE hl. case hst: sg_tab (sg_tab_nil (size sq))=> [|s st] // _. have sst: (size st).+1 = (3 ^ size sq)%N. transitivity (size (sg_tab (size sq))); first by rewrite hst //. by rewrite size_sg_tab. rewrite /taq !big_filter !(big_mkcond (sgp_is _ _)) -sumrB. apply: congr_big=> // x _. rewrite cats0 !map_cat nth_cat !size_map /= sst ltn_ord /=. rewrite !poly_comb_cons /= !comb_expE expr1z. rewrite -!(nth_map _ 0 (fun p => p.[_])) /= ?size_map ?sst ?ltn_ord //. rewrite -!map_comp /= hornerM. set f := _ \o _; set g := _ \o _. set h := fun sc => q.[x] * (poly_comb sq sc).[x]. have hg : g =1 h. by move=> sx; rewrite /g /h /= poly_comb_cons comb_expE expr1z hornerM. rewrite -/(h _) -hg -[g _ :: _]/(map g (_ ::_)). rewrite (nth_map [::]) /= ?sst ?ltn_ord // hg /h sgzM. rewrite -![(poly_comb _ _).[_]]/(f _) -[f _ :: _]/(map f (_ ::_)). rewrite (nth_map [::]) /= ?sst ?ltn_ord // !sgr_cp0. by case: (sgzP q.[x]); rewrite ?(mul0r, mul1r, mulN1r, subr0, sub0r). case: splitP=> k hk /=; rewrite !mxE hk. case hst: sg_tab (sg_tab_nil (size sq))=> [|s st] // _. have sst: (size st).+1 = (3 ^ size sq)%N. transitivity (size (sg_tab (size sq))); first by rewrite hst //. by rewrite size_sg_tab. rewrite /taq !big_filter !(big_mkcond (sgp_is _ _)) -big_split. apply: congr_big=> // x _. rewrite cats0 !map_cat !nth_cat !size_map /= sst. rewrite ltnNge leq_addr /= addKn ltn_ord /=. rewrite !poly_comb_cons /= !comb_expE. rewrite -!(nth_map _ 0 (fun p => p.[_])) /= ?size_map ?sst ?ltn_ord //. rewrite -!map_comp /= hornerM. set f := _ \o _; set g := _ \o _. set h := fun sc => (q ^ 2).[x] * (poly_comb sq sc).[x]. have hg : g =1 h. by move=> sx; rewrite /g /h /= poly_comb_cons comb_expE hornerM. rewrite -/(h _) -hg -[g _ :: _]/(map g (_ ::_)). rewrite (nth_map [::]) /= ?sst ?ltn_ord // hg /h sgzM. rewrite -![(poly_comb _ _).[_]]/(f _) -[f _ :: _]/(map f (_ ::_)). rewrite (nth_map [::]) /= ?sst ?ltn_ord //. rewrite hornerM sgzM !sgr_cp0. by case: (sgzP q.[x]); rewrite ?(mul0r, mul1r, mulN1r, addr0, add0r). case hst: sg_tab (sg_tab_nil (size sq))=> [|s st] // _. have sst: (size st).+1 = (3 ^ size sq)%N. transitivity (size (sg_tab (size sq))); first by rewrite hst //. by rewrite size_sg_tab. rewrite /taq !big_filter !(big_mkcond (sgp_is _ _)) -!big_split. apply: congr_big=> // x _. rewrite cats0 !map_cat !nth_cat !size_map /= sst. rewrite !addKn 2!ltnNge !leq_addr /=. rewrite !poly_comb_cons /= !comb_expE expr0z mul1r. rewrite -!(nth_map _ 0 (fun p => p.[_])) /= ?size_map ?sst ?ltn_ord //. rewrite -!map_comp /=. set f := _ \o _; set g := _ \o _. have hg : g =1 f. by move=> sx; rewrite /g /f /= poly_comb_cons comb_expE expr0z mul1r. rewrite -[(poly_comb _ _).[_]]/(f _) -{4}hg. rewrite -[g s :: _]/(map _ (_ ::_)) (eq_map hg) !sgr_cp0. by case: (sgzP q.[x])=> _; rewrite ?(addr0, add0r). Qed. Lemma tvec_cvec z sq : tvec z sq = (cvec z sq) *m (ctmat (size sq)). Proof. elim: sq z => [|q sq ihsq] z /=. rewrite mulmx1; apply/rowP=> [] [i hi] /=; rewrite !mxE /=. move: hi; rewrite expn0 ltnS leqn0; move/eqP=> -> /=. rewrite /poly_comb big_ord0 /taq /constraints /=. rewrite sumMz; apply: (congr_big)=> //= x _. by rewrite hornerC sgz1 big_ord0. rewrite /ctmat /ntensmx /=. (* simpl in trunk is "weaker" here *) case: sq ihsq=> /= [|q' sq] ihsq; first by apply: tvec_cvec1. rewrite cvec_rec tensmx_decl mulmxA tvec_rec. apply/eqP; rewrite (can2_eq (castmxK _ _) (castmxKV _ _)); apply/eqP. rewrite !castmx_mul !castmx_id [row_mx _ _ *m _]mulmx_cast. congr (_ *m _); last by congr (castmx (_, _) _); apply: nat_irrelevance. rewrite /=; have->: forall n, exp3S n.+1 = mul3n (3^n.+1)%N. by move=> n; apply: nat_irrelevance. by rewrite mul_1tensmx !ihsq. Qed. Lemma cvec_tvec z sq : zmxR (cvec z (sq)) = (zmxR (tvec z (sq))) *m (invmx (zmxR (ctmat (size (sq))))). Proof. apply/eqP; set A := zmxR (ctmat _). rewrite -(@can2_eq _ _ (fun (x : 'rV_(_)) => x *m A) (fun x => x *m (invmx A))). * by rewrite /A -map_mxM ?tvec_cvec//; apply: zinjR_morph. * by apply: mulmxK; rewrite /A ctmat_unit. * by apply: mulmxKV; rewrite /A ctmat_unit. Qed. Lemma constraints1_tvec : forall z sq, (constraints z (sq) (nseq (size (sq)) 1))%:~R = (castmx (erefl _, exp3n _) (zmxR (tvec z (sq)) *m (invmx (zmxR (ctmat (size (sq))))))) ord0 ord0. Proof. move=> z sq. rewrite -cvec_tvec castmxE /= cast_ord_id /= /cvec !mxE //= intz. congr ((constraints _ _ _)%:~R); elim: sq=> //= _ s -> /=. set l := sg_tab _; suff: size l != 0%N by case: l. exact: size_sg_tab_neq0. Qed. (* Cauchy Index, relation with Tarski query*) Local Notation seq_mids a s b := (pairmap (fun x y => midf x y) a (rcons s b)). Local Notation noroot p := (forall x, ~~ root p x). Notation lcn_neq0 := lc_expn_rscalp_neq0. Definition jump q p x: int := let non_null := (q != 0) && odd (\mu_x p - \mu_x q) in let sign := (sgp_right (q * p) x < 0)%R in (-1) ^+ sign *+ non_null. Definition cindex (a b : R) (q p : {poly R}) : int := \sum_(x <- roots p a b) jump q p x. Definition cindexR q p := \sum_(x <- rootsR p) jump q p x. Definition sjump p x : int := ((-1) ^+ (sgp_right p x < 0)%R) *+ odd (\mu_x p). Definition variation (x y : R) : int := (sgz y) * (x * y < 0). Definition cross p a b := variation p.[a] p.[b]. Definition crossR p := variation (sgp_minfty p) (sgp_pinfty p). Definition sum_var (s : seq R) := \sum_(n <- pairmap variation 0 s) n. Lemma cindexEba a b : b <= a -> forall p q, cindex a b p q = 0. Proof. by move=> le_ba p q; rewrite /cindex rootsEba ?big_nil. Qed. Lemma jump0p q x : jump 0 q x = 0. Proof. by rewrite /jump eqxx mulr0n. Qed. Lemma taq_cindex a b p q : taq (roots p a b) q = cindex a b (p^`() * q) p. Proof. have [lt_ab|?] := ltrP a b; last by rewrite rootsEba ?cindexEba /taq ?big_nil. rewrite /taq /cindex !big_seq; apply: eq_bigr => x. have [->|p_neq0 /root_roots rpx] := eqVneq p 0; first by rewrite roots0 in_nil. have [->|q_neq0] := eqVneq q 0; first by rewrite mulr0 jump0p horner0 sgz0. have [p'0|p'_neq0] := eqVneq p^`() 0. move/(root_size_gt1 p_neq0): rpx. by rewrite -subn_gt0 subn1 -size_deriv p'0 size_poly0. have p'q0: p^`() * q != 0 by rewrite mulf_neq0. move: (p'q0); rewrite mulf_eq0 negb_or; case/andP=> p'0 q0. have p0: p != 0 by move: p'0; apply: contra; move/eqP->; rewrite derivC. rewrite /jump mu_mul// {1}(@mu_deriv_root _ _ p)// addn1 p'q0 /=. case emq: (\mu_(_) q)=> [|m]. move/eqP: emq; rewrite -leqn0 leqNgt mu_gt0// => qxn0. rewrite addn0 subSnn mulr1n. rewrite !sgp_right_mul// (sgp_right_deriv rpx) mulrAC. rewrite sgp_right_square// mul1r sgp_rightNroot//. rewrite sgr_lt0 -sgz_cp0. by move: qxn0; rewrite -[root q x]sgz_cp0; case: sgzP. rewrite addnS subSS -{1}[\mu_(_) _]addn0 subnDl sub0n mulr0n. by apply/eqP; rewrite sgz_cp0 -[_ == 0]mu_gt0// emq. Qed. Lemma sum_varP s : 0 \notin s -> sum_var s = variation (head 0 s) (last 0 s). Proof. rewrite /sum_var /variation. case: s => /= [_|a s]; first by rewrite big_nil sgz0 mul0r. rewrite in_cons big_cons mul0r ltxx mulr0 add0r. elim: s a => [|b s IHs] a; first by rewrite big_nil le_gtF ?mulr0 ?sqr_ge0. move=> /norP [neq_0a Hbs]; move: (Hbs); rewrite in_cons => /norP[neq_0b Hs]. rewrite /= big_cons IHs ?negb_or ?neq_0b // -!sgz_cp0 !sgzM. have: (last b s) != 0 by apply: contra Hbs => /eqP <-; rewrite mem_last. by move: neq_0a neq_0b; do 3?case: sgzP => ? //. Qed. Lemma jump_coprime p q : p != 0 -> coprimep p q -> forall x, root p x -> jump q p x = sjump (q * p) x. Proof. move=> pn0 cpq x rpx; rewrite /jump /sjump. have q_neq0 : q != 0; last rewrite q_neq0 /=. apply: contraTneq cpq => ->; rewrite coprimep0. by apply: contraL rpx => /eqp_root ->; rewrite rootC oner_eq0. have := coprimep_root cpq rpx; rewrite -rootE -mu_eq0 => // /eqP muxq_eq0. by rewrite mu_mul ?mulf_neq0 ?muxq_eq0 ?subn0 ?add0n. Qed. Lemma sjump_neigh a b p x : p != 0 -> {in neighpl p a x & neighpr p x b, forall yl yr, sjump p x = cross p yl yr}. Proof. move=> pn0 yl yr yln yrn; rewrite /cross /variation. rewrite -sgr_cp0 sgrM /sjump (sgr_neighpl yln) -!(sgr_neighpr yrn). rewrite -mulrA -expr2 sqr_sg (rootPf (neighpr_root yrn)) mulr1. rewrite sgrEz ltrz0 -[in rhs in _ = rhs]intr_sign -[X in _ == X]mulrN1z eqr_int. by have /rootPf := neighpr_root yrn; case: sgzP; case: odd. Qed. Lemma jump_neigh a b p q x : q * p != 0 -> {in neighpl (q * p) a x & neighpr (q * p) x b, forall yl yr, jump q p x = cross (q * p) yl yr *+ ((q != 0) && (\mu_x p > \mu_x q)%N)}. Proof. move=> pqn0 yl yr hyl hyr; rewrite -(sjump_neigh pqn0 hyl hyr). rewrite /jump /sjump -mulrnA mulnb andbCA. have [muqp|/eqnP ->] := ltnP; rewrite (andbF, andbT) //. by rewrite mu_mul // oddD addbC oddB // ltnW. Qed. Lemma jump_mul2l (p q r : {poly R}) : p != 0 -> jump (p * q) (p * r) =1 jump q r. Proof. move=> p0 x; rewrite /jump. case q0: (q == 0); first by rewrite (eqP q0) mulr0 eqxx. have ->: p * q != 0 by rewrite mulf_neq0 ?p0 ?q0. case r0: (r == 0); first by rewrite (eqP r0) !mulr0 mu0 !sub0n. rewrite !mu_mul ?mulf_neq0 ?andbT ?q0 ?r0 //; rewrite subnDl. rewrite mulrAC mulrA -mulrA. rewrite (@sgp_right_mul _ (p * p)) // sgp_right_mul // sgp_right_square //. by rewrite mul1r mulrC /=. Qed. Lemma jump_mul2r (p q r : {poly R}) : p != 0 -> jump (q * p) (r * p) =1 jump q r. Proof. by move=> p0 x; rewrite ![_ * p]mulrC jump_mul2l. Qed. Lemma jumppc p c x : jump p c%:P x = 0. Proof. by rewrite /jump mu_polyC sub0n !andbF. Qed. Lemma noroot_jump q p x : ~~ root p x -> jump q p x = 0. Proof. have [->|p_neq0] := eqVneq p 0; first by rewrite jumppc. by rewrite -mu_gt0 // lt0n negbK /jump => /eqP ->; rewrite andbF mulr0n. Qed. Lemma jump_mulCp c p q x : jump (c *: p) q x = (sgz c) * jump p q x. Proof. have [->|c0] := eqVneq c 0; first by rewrite sgz0 scale0r jump0p mul0r. have [->|p0] := eqVneq p 0; first by rewrite scaler0 jump0p mulr0. have [->|q0] := eqVneq q 0; first by rewrite !jumppc mulr0. (* :TODO: : rename mu_mulC *) rewrite /jump scale_poly_eq0 mu_mulC ?negb_or ?c0 ?p0 ?andTb //. rewrite -scalerAl sgp_right_scale //. case: sgzP c0 => // _ _; rewrite !(mul1r, mulN1r, =^~ mulNrn) //. by rewrite ?oppr_cp0 lt0r sgp_right_eq0 ?mulf_neq0 // andTb leNgt signrN. Qed. Lemma jump_pmulC c p q x : jump p (c *: q) x = (sgz c) * jump p q x. Proof. have [->|c0] := eqVneq c 0; first by rewrite sgz0 scale0r mul0r jumppc. have [->|p0] := eqVneq p 0; first by rewrite !jump0p mulr0. have [->|q0] := eqVneq q 0; first by rewrite scaler0 !jumppc mulr0. rewrite /jump mu_mulC // -scalerAr sgp_right_scale //. case: sgzP c0 => // _ _; rewrite !(mul1r, mulN1r, =^~ mulNrn) //. by rewrite ?oppr_cp0 lt0r sgp_right_eq0 ?mulf_neq0 // andTb leNgt signrN. Qed. Lemma jump_mod p q x : jump p q x = sgz (lead_coef q) ^+ (rscalp p q) * jump (rmodp p q) q x. Proof. case p0: (p == 0); first by rewrite (eqP p0) rmod0p jump0p mulr0. case q0: (q == 0); first by rewrite (eqP q0) rmodp0 jumppc mulr0. rewrite -sgzX; set s := sgz _. apply: (@mulfI _ s); first by rewrite /s sgz_eq0 lcn_neq0. rewrite mulrA mulz_sg lcn_neq0 mul1r -jump_mulCp rdivp_eq. have [->|rpq_eq0] := altP (rmodp p q =P 0). by rewrite addr0 jump0p -[X in jump _ X]mul1r jump_mul2r ?q0 // jumppc. rewrite /jump. set r := _ * q + _. have muxp : \mu_x p = \mu_x r by rewrite /r -rdivp_eq mu_mulC ?lcn_neq0. have r_neq0 : r != 0 by rewrite /r -rdivp_eq scaler_eq0 p0 orbF lcn_neq0. have [hpq|hpq] := leqP (\mu_x q) (\mu_x r). rewrite 2!(_ : _ - _ = 0)%N ?andbF //; apply/eqP; rewrite -/(_ <= _)%N //. by rewrite mu_mod_leq ?dvdpE // muxp. rewrite mu_mod ?muxp // rpq_eq0 (negPf r_neq0); congr (_ ^+ _ *+ _). rewrite !sgp_right_mul sgp_right_mod ?muxp // /r -rdivp_eq. by rewrite -mul_polyC sgp_right_mul sgp_rightc sgrX. Qed. Lemma cindexRP q p a b : {in `]-oo, a], noroot p} -> {in `[b , +oo[, noroot p} -> cindex a b q p = cindexR q p. Proof. by rewrite /cindex => rpa rpb; rewrite rootsRP. Qed. Lemma cindex0p a b q : cindex a b 0 q = 0. Proof. have [lt_ab|le_ba] := ltrP a b; last by rewrite cindexEba. by apply: big1_seq=> x; rewrite /jump eqxx mulr0n. Qed. Lemma cindexR0p p : cindexR 0 p = 0. Proof. by rewrite /cindexR big1 // => q _; rewrite jump0p. Qed. Lemma cindexpC a b p c : cindex a b p (c%:P) = 0. Proof. have [lt_ab|le_ba] := ltrP a b; last by rewrite cindexEba. by rewrite /cindex /jump rootsC big_nil. Qed. Lemma cindexRpC q c : cindexR q c%:P = 0. Proof. by rewrite /cindexR rootsRC big_nil. Qed. Lemma cindex_mul2r a b p q r : r != 0 -> cindex a b (p * r) (q * r) = cindex a b p q. Proof. have [lt_ab r0|le_ba] := ltrP a b; last by rewrite !cindexEba. have [->|p0] := eqVneq p 0; first by rewrite mul0r !cindex0p. have [->|q0] := eqVneq q 0; first by rewrite mul0r !cindexpC. rewrite /cindex (perm_big _ (roots_mul _ _ _))//= big_cat/=. rewrite -[\sum_(x <- _) jump p _ _]addr0; congr (_+_). by rewrite !big_seq; apply: congr_big => // x hx; rewrite jump_mul2r. rewrite big1_seq//= => x hx; rewrite jump_mul2r // /jump. suff ->: \mu_x q = 0%N by rewrite andbF. apply/eqP; rewrite -leqn0 leqNgt mu_gt0 //. apply/negP; rewrite root_factor_theorem => rqx; move/root_roots:hx. case: gdcopP=> g hg; rewrite (negPf r0) orbF => cgq hdg. rewrite root_factor_theorem=> rgx. move/coprimepP:cgq rqx rgx=> cgq; rewrite -!dvdpE=> /cgq hgq /hgq. by rewrite -size_poly_eq1 size_XsubC. Qed. Lemma cindex_mulCp a b p q c : cindex a b (c *: p) q = (sgz c) * cindex a b p q. Proof. have [lt_ab|le_ba] := ltrP a b; last by rewrite !cindexEba ?mulr0. have [->|p0] := eqVneq p 0; first by rewrite !(cindex0p, scaler0, mulr0). have [->|q0] := eqVneq q 0; first by rewrite !(cindexpC, scaler0, mulr0). by rewrite /cindex big_distrr; apply: congr_big => //= x; rewrite jump_mulCp. Qed. Lemma cindex_pmulC a b p q c : cindex a b p (c *: q) = (sgz c) * cindex a b p q. Proof. have [lt_ab|le_ba] := ltrP a b; last by rewrite !cindexEba ?mulr0. have [->|p0] := eqVneq p 0; first by rewrite !(cindex0p, scaler0, mulr0). have [->|q0] := eqVneq q 0; first by rewrite !(cindexpC, scaler0, mulr0). have [->|c0] := eqVneq c 0; first by rewrite scale0r sgz0 mul0r cindexpC. rewrite /cindex big_distrr rootsZ //. by apply: congr_big => // x _; rewrite jump_pmulC. Qed. Lemma cindex_mod a b p q : cindex a b p q = (sgz (lead_coef q) ^+ rscalp p q) * cindex a b (rmodp p q) q. Proof. have [lt_ab|le_ba] := ltrP a b; last by rewrite !cindexEba ?mulr0. by rewrite /cindex big_distrr; apply: congr_big => // x; rewrite jump_mod. Qed. Lemma variation0r b : variation 0 b = 0. Proof. by rewrite /variation mul0r ltxx mulr0. Qed. Lemma variationC a b : variation a b = - variation b a. Proof. by rewrite /variation -!sgz_cp0 !sgzM; do 2?case: sgzP => _ //. Qed. Lemma variationr0 a : variation a 0 = 0. Proof. by rewrite variationC variation0r oppr0. Qed. Lemma variation_pmull a b c : c > 0 -> variation (a * c) (b) = variation a b. Proof. by move=> c_gt0; rewrite /variation mulrAC pmulr_llt0. Qed. Lemma variation_pmulr a b c : c > 0 -> variation a (b * c) = variation a b. Proof. by move=> c_gt0; rewrite variationC variation_pmull // -variationC. Qed. Lemma congr_variation a b a' b' : sgz a = sgz a' -> sgz b = sgz b' -> variation a b = variation a' b'. Proof. by rewrite /variation -!sgz_cp0 !sgzM => -> ->. Qed. Lemma crossRP p a b : {in `]-oo, a], noroot p} -> {in `[b , +oo[, noroot p} -> cross p a b = crossR p. Proof. move=> rpa rpb; rewrite /crossR /cross. rewrite -(@sgp_minftyP _ _ _ rpa a) ?boundr_in_itv //. rewrite -(@sgp_pinftyP _ _ _ rpb b) ?boundl_in_itv //. by rewrite /variation -sgrM sgr_lt0 sgz_sgr. Qed. Lemma noroot_cross p a b : a <= b -> {in `]a, b[, noroot p} -> cross p a b = 0. Proof. move=> le_ab noroot_ab; rewrite /cross /variation. have [] := ltrP; last by rewrite mulr0. by move=> /(poly_ivtoo le_ab) [x /noroot_ab /negPf->]. Qed. Lemma cross_pmul p q a b : q.[a] > 0 -> q.[b] > 0 -> cross (p * q) a b = cross p a b. Proof. by move=> qa0 qb0; rewrite /cross !hornerM variation_pmull ?variation_pmulr. Qed. Lemma cross0 a b : cross 0 a b = 0. Proof. by rewrite /cross !horner0 variation0r. Qed. Lemma crossR0 : crossR 0 = 0. Proof. by rewrite /crossR /sgp_minfty /sgp_pinfty lead_coef0 mulr0 sgr0 variationr0. Qed. Lemma cindex_seq_mids a b : a < b -> forall p q, p != 0 -> q != 0 -> coprimep p q -> cindex a b q p + cindex a b p q = sum_var (map (horner (p * q)) (seq_mids a (roots (p * q) a b) b)). Proof. move=> hab p q p0 q0 cpq; rewrite /cindex /sum_var 2!big_seq. have pq_neq0 : p * q != 0 by rewrite mulf_neq0. have pq_eq0 := negPf pq_neq0. have jumpP : forall (p q : {poly R}), p != 0 -> coprimep p q -> forall x, x \in roots p a b -> jump q p x = sjump (q * p) x. by move=> ? ? ? ? ?; move/root_roots=> ?; rewrite jump_coprime. rewrite !(eq_bigr _ (jumpP _ _ _ _))// 1?coprimep_sym// => {jumpP}. have sjumpC x : sjump (q * p) x = sjump (p * q) x by rewrite mulrC. rewrite -!big_seq (eq_bigr _ (fun x _ => sjumpC x)). rewrite -big_cat /= -(perm_big _ (roots_mul_coprime _ _ _ _)) //=. move: {1 2 5}a hab (erefl (roots (p * q) a b)) => //=. elim: roots => {a} [|x s /= ihs] a hab /eqP. by rewrite big_cons !big_nil variation0r. rewrite roots_cons; case/and5P => _ xab /eqP hax hx /eqP hs. rewrite !big_cons variation0r add0r (ihs _ _ hs) ?(itvP xab) // => {ihs}. pose y := (head b s); pose ax := midf a x; pose xy := midf x y. rewrite (@sjump_neigh a b _ _ _ ax xy) ?in_itv ?midf_lte//=; last 2 first. + by rewrite /prev_root pq_eq0 hax min_l ?(itvP xab, midf_lte). + have hy: y \in `]x, b]. rewrite /y; case: s hs {y xy} => /= [|u s] hu. by rewrite in_itv /= lexx ?(itvP xab). have /roots_in: u \in roots (p * q) x b by rewrite hu mem_head. by apply: subitvP; rewrite /<=%O /= /<=%O /= !lexx. by rewrite /next_root pq_eq0 hs max_l ?(itvP hy, midf_lte). move: @y @xy {hs}; rewrite /cross. by case: s => /= [|y l]; rewrite ?(big_cons, big_nil, variation0r, add0r). Qed. Lemma cindex_inv a b : a < b -> forall p q, ~~ root (p * q) a -> ~~ root (p * q) b -> cindex a b q p + cindex a b p q = cross (p * q) a b. Proof. move=> hab p q hpqa hpqb. have hlab: a <= b by apply: ltW. wlog cpq: p q hpqa hpqb / coprimep p q => [hwlog|]. have p0: p != 0 by apply: contraNneq hpqa => ->; rewrite mul0r rootC. have q0: q != 0 by apply: contraNneq hpqa => ->; rewrite mulr0 rootC. set p' := p; rewrite -(divpK (dvdp_gcdr p q)) -[p'](divpK (dvdp_gcdl p q)). rewrite !cindex_mul2r ?gcdp_eq0 ?(negPf p0) //. have ga0 : (gcdp p q).[a] != 0. apply: contra hpqa; rewrite -rootE -!dvdp_XsubCl => /dvdp_trans -> //. by rewrite dvdp_mulr ?dvdp_gcdl. have gb0 : (gcdp p q).[b] != 0. apply: contra hpqb; rewrite -rootE -!dvdp_XsubCl => /dvdp_trans -> //. by rewrite dvdp_mulr ?dvdp_gcdl. rewrite mulrACA -expr2 cross_pmul ?horner_exp ?exprn_even_gt0 ?ga0 ?gb0 //. apply: hwlog; rewrite ?coprimep_div_gcd ?p0 // rootM. + apply: contra hpqa; rewrite -!dvdp_XsubCl => /orP. case=> /dvdp_trans-> //; rewrite (dvdp_trans (divp_dvd _)); by rewrite ?(dvdp_gcdl, dvdp_gcdr) ?(dvdp_mulIl, dvdp_mulIr). + apply: contra hpqb; rewrite -!dvdp_XsubCl => /orP. case=> /dvdp_trans-> //; rewrite (dvdp_trans (divp_dvd _)); by rewrite ?(dvdp_gcdl, dvdp_gcdr) ?(dvdp_mulIl, dvdp_mulIr). have p0: p != 0 by apply: contraNneq hpqa => ->; rewrite mul0r rootC. have q0: q != 0 by apply: contraNneq hpqa => ->; rewrite mulr0 rootC. have pq0 : p * q != 0 by rewrite mulf_neq0. rewrite cindex_seq_mids // sum_varP /cross. apply: congr_variation; apply: (mulrIz (oner_neq0 R)); rewrite -!sgrEz. case hr: roots => [|c s] /=; apply: (@sgr_neighprN _ _ a b) => //; rewrite /neighpr /next_root ?(negPf pq0) max_l // hr mid_in_itv //=. by move/eqP: hr; rewrite roots_cons => /and5P [_ /itvP ->]. rewrite -cats1 pairmap_cat /= cats1 map_rcons last_rcons. apply: (@sgr_neighplN _ _ a b) => //. rewrite /neighpl /prev_root (negPf pq0) min_l //. by rewrite mid_in_itv //= last_roots_le. elim: roots {-2 6}a (erefl (roots (p * q) a b)) {hpqa hpqb} hab hlab => {a} [|c s IHs] a Hs hab hlab /=. rewrite in_cons orbF eq_sym. (* ; set x := (X in _.[X]). *) by rewrite -rootE (@roots_nil _ _ a b) // mid_in_itv. move/eqP: Hs; rewrite roots_cons => /and5P [_ cab /eqP rac rc /eqP rcb]. rewrite in_cons eq_sym -rootE negb_or (roots_nil _ rac) //=; last first. by rewrite mid_in_itv //= (itvP cab). by rewrite IHs // (itvP cab). Qed. Definition next_mod p q := - (lead_coef q ^+ rscalp p q) *: rmodp p q. Lemma next_mod0p q : next_mod 0 q = 0. Proof. by rewrite /next_mod rmod0p scaler0. Qed. Lemma cindex_rec a b : a < b -> forall p q, ~~ root (p * q) a -> ~~ root (p * q) b -> cindex a b q p = cross (p * q) a b + cindex a b (next_mod p q) q. Proof. move=> lt_ab p q rpqa rpqb; have [->|p0] := eqVneq p 0. by rewrite cindexpC next_mod0p cindex0p mul0r cross0 add0r. have [->|q0] := eqVneq q 0. by rewrite cindex0p cindexpC mulr0 cross0 add0r. have /(canRL (addrK _)) -> := cindex_inv lt_ab rpqa rpqb. by rewrite cindex_mulCp cindex_mod sgzN mulNr sgzX. Qed. Lemma cindexR_rec p q : cindexR q p = crossR (p * q) + cindexR (next_mod p q) q. Proof. have [->|p_neq0] := eqVneq p 0. by rewrite cindexRpC mul0r next_mod0p cindexR0p crossR0. have [->|q_neq0] := eqVneq q 0. by rewrite cindexR0p mulr0 crossR0 cindexRpC. have pq_neq0 : p * q != 0 by rewrite mulf_neq0. pose b := cauchy_bound (p * q). have [lecb gecb] := pair (le_cauchy_bound pq_neq0) (ge_cauchy_bound pq_neq0). rewrite -?(@cindexRP _ _ (-b) b); do ? by [move=> x Hx /=; have: ~~ root (p * q) x by [apply: lecb|apply: gecb]; rewrite rootM => /norP []]. rewrite -(@crossRP _ (-b) b) 1?cindex_rec ?gt0_cp ?cauchy_bound_gt0 //. by rewrite lecb // boundr_in_itv. by rewrite gecb // boundl_in_itv. Qed. (* Computation of cindex through changes_mods *) Definition mods p q := let fix aux p q n := if n is m.+1 then if p == 0 then [::] else p :: (aux q (next_mod p q) m) else [::] in aux p q (maxn (size p) (size q).+1). Lemma mods_rec p q : mods p q = if p == 0 then [::] else p :: (mods q (next_mod p q)). Proof. rewrite /mods; set aux := fix aux _ _ n := if n is _.+1 then _ else _. have aux0 u n : aux 0 u n = [::] by case: n => [//|n] /=; rewrite eqxx. pose m p q := maxn (size p) (size q).+1; rewrite -!/(m _ _). suff {p q} Hnext p q : q != 0 -> (m q (next_mod p q) < m p q)%N; last first. rewrite /m -maxnSS leq_max !geq_max !ltnS leqnn /= /next_mod. rewrite size_scale ?oppr_eq0 ?lcn_neq0 //=. by move=> q_neq0; rewrite ltn_rmodp ?q_neq0 ?orbT. suff {p q} m_gt0 p q : (0 < m p q)%N; last by rewrite leq_max orbT. rewrite -[m p q]prednK //=; have [//|p_neq0] := altP (p =P 0). have [->|q_neq0] := altP (q =P 0); first by rewrite !aux0. congr (_ :: _); suff {p q p_neq0 q_neq0} Haux p q n n' : (m p q <= n)%N -> (m p q <= n')%N -> aux p q n = aux p q n'. by apply: Haux => //; rewrite -ltnS prednK // Hnext. elim: n p q n' => [p q|n IHn p q n' Hn]; first by rewrite geq_max ltn0 andbF. case: n' => [|n' Hn' /=]; first by rewrite geq_max ltn0 andbF. have [//|p_neq0] := altP eqP; congr (_ :: _). have [->|q_neq0] := altP (q =P 0); first by rewrite !aux0. by apply: IHn; rewrite -ltnS (leq_trans _ Hn, leq_trans _ Hn') ?Hnext. Qed. Lemma mods_eq0 p q : (mods p q == [::]) = (p == 0). Proof. by rewrite mods_rec; have [] := altP (p =P 0). Qed. Lemma neq0_mods_rec p q : p != 0 -> mods p q = p :: mods q (next_mod p q). Proof. by rewrite mods_rec => /negPf ->. Qed. Lemma mods0p q : mods 0 q = [::]. Proof. by apply/eqP; rewrite mods_eq0. Qed. Lemma modsp0 p : mods p 0 = if p == 0 then [::] else [::p]. Proof. by rewrite mods_rec mods0p. Qed. Fixpoint changes (s : seq R) : nat := (if s is a :: q then (a * (head 0 q) < 0)%R + changes q else 0)%N. Definition changes_pinfty (p : seq {poly R}) := changes (map lead_coef p). Definition changes_minfty (p : seq {poly R}) := changes (map (fun p : {poly _} => (-1) ^+ (~~ odd (size p)) * lead_coef p) p). Definition changes_poly (p : seq {poly R}) := (changes_minfty p)%:Z - (changes_pinfty p)%:Z. Definition changes_mods p q := changes_poly (mods p q). Lemma changes_mods0p q : changes_mods 0 q = 0. Proof. by rewrite /changes_mods /changes_poly mods0p. Qed. Lemma changes_modsp0 p : changes_mods p 0 = 0. Proof. rewrite /changes_mods /changes_poly modsp0; have [//|p_neq0] := altP eqP. by rewrite /changes_minfty /changes_pinfty /= !mulr0 ltxx. Qed. Lemma changes_mods_rec p q : changes_mods p q = crossR (p * q) + changes_mods q (next_mod p q). Proof. have [->|p0] := eqVneq p 0. by rewrite changes_mods0p mul0r crossR0 next_mod0p changes_modsp0. have [->|q0] := eqVneq q 0. by rewrite changes_modsp0 mulr0 crossR0 changes_mods0p. rewrite /changes_mods /changes_poly neq0_mods_rec //=. rewrite !PoszD opprD addrACA; congr (_ + _); rewrite neq0_mods_rec //=. rewrite /crossR /variation /sgp_pinfty /sgp_minfty. rewrite mulr_signM size_mul // !lead_coefM. rewrite polySpred // addSn [size q]polySpred // addnS /= !negbK. rewrite -oddD signr_odd; set s := _ ^+ _. rewrite -!sgz_cp0 !(sgz_sgr, sgzM). have: s != 0 by rewrite signr_eq0. by move: p0 q0; rewrite -!lead_coef_eq0; do 3!case: sgzP=> _. Qed. Lemma changes_mods_cindex p q : changes_mods p q = cindexR q p. Proof. elim: mods {-2}p {-2}q (erefl (mods p q)) => [|r s IHs] {}p {}q hrpq. move/eqP: hrpq; rewrite mods_eq0 => /eqP ->. by rewrite changes_mods0p cindexRpC. rewrite changes_mods_rec cindexR_rec IHs //. by move: hrpq IHs; rewrite mods_rec; case: (p == 0) => // [] []. Qed. Definition taqR p q := changes_mods p (p^`() * q). Lemma taq_taqR p q : taq (rootsR p) q = taqR p q. Proof. by rewrite /taqR changes_mods_cindex taq_cindex. Qed. Section ChangesItvMod_USELESS. (* Not used anymore, but the content of this section is *) (* used in the LMCS 2012 paper and in Cyril's thesis *) Definition changes_horner (p : seq {poly R}) x := changes (map (fun p => p.[x]) p). Definition changes_itv_poly a b (p : seq {poly R}) := (changes_horner p a)%:Z - (changes_horner p b)%:Z. Definition changes_itv_mods a b p q := changes_itv_poly a b (mods p q). Lemma changes_itv_mods0p a b q : changes_itv_mods a b 0 q = 0. Proof. by rewrite /changes_itv_mods /changes_itv_poly mods0p /changes_horner /= subrr. Qed. Lemma changes_itv_modsp0 a b p : changes_itv_mods a b p 0 = 0. Proof. rewrite /changes_itv_mods /changes_itv_poly modsp0 /changes_horner /=. by have [//|p_neq0 /=] := altP eqP; rewrite !mulr0 ltxx. Qed. Lemma changes_itv_mods_rec a b : a < b -> forall p q, ~~ root (p * q) a -> ~~ root (p * q) b -> changes_itv_mods a b p q = cross (p * q) a b + changes_itv_mods a b q (next_mod p q). Proof. move=> lt_ab p q rpqa rpqb. have [->|p0] := eqVneq p 0. by rewrite changes_itv_mods0p mul0r next_mod0p changes_itv_modsp0 cross0. have [->|q0] := eqVneq q 0. by rewrite changes_itv_modsp0 mulr0 cross0 changes_itv_mods0p. rewrite /changes_itv_mods /changes_itv_poly /changes_horner neq0_mods_rec //=. rewrite !PoszD opprD addrACA; congr (_ + _); rewrite neq0_mods_rec //=. move: rpqa rpqb; rewrite -!hornerM !rootE; move: (p * q) => r {p q p0 q0}. by rewrite /cross /variation -![_ < _]sgz_cp0 sgzM; do 2!case: sgzP => _. Qed. Lemma changes_itv_mods_cindex a b : a < b -> forall p q, all (fun p => ~~ root p a) (mods p q) -> all (fun p => ~~ root p b) (mods p q) -> changes_itv_mods a b p q = cindex a b q p. Proof. move=> hab p q. elim: mods {-2}p {-2}q (erefl (mods p q)) => [|r s IHs] {}p {}q hrpq. move/eqP: hrpq; rewrite mods_eq0 => /eqP ->. by rewrite changes_itv_mods0p cindexpC. have p_neq0 : p != 0 by rewrite -(mods_eq0 p q) hrpq. move: hrpq IHs; rewrite neq0_mods_rec //. move=> [_ <-] IHs /= /andP[rpa Ha] /andP[rpb Hb]. move=> /(_ _ _ (erefl _) Ha Hb) in IHs. have [->|q_neq0] := eqVneq q 0; first by rewrite changes_itv_modsp0 cindex0p. move: Ha Hb; rewrite neq0_mods_rec //= => /andP[rqa _] /andP[rqb _]. rewrite cindex_rec 1?changes_itv_mods_rec; by rewrite ?rootM ?negb_or ?rpa ?rpb ?rqa ?rqb // IHs. Qed. Definition taq_itv a b p q := changes_itv_mods a b p (p^`() * q). Lemma taq_taq_itv a b : a < b -> forall p q, all (fun p => p.[a] != 0) (mods p (p^`() * q)) -> all (fun p => p.[b] != 0) (mods p (p^`() * q)) -> taq (roots p a b) q = taq_itv a b p q. Proof. by move=> *; rewrite /taq_itv changes_itv_mods_cindex // taq_cindex. Qed. End ChangesItvMod_USELESS. Definition tvecR p sq := let sg_tab := sg_tab (size sq) in \row_(i < 3^size sq) (taqR p (map (poly_comb sq) sg_tab)`_i). Lemma tvec_tvecR sq p : tvec (rootsR p) sq = tvecR p sq. Proof. by rewrite /tvec /tvecR; apply/matrixP=> i j; rewrite !mxE taq_taqR. Qed. Lemma all_prodn_gt0 : forall (I : finType) r (P : pred I) (F : I -> nat), (\prod_(i <- r | P i) F i > 0)%N -> forall i, i \in r -> P i -> (F i > 0)%N. Proof. move=> I r P F; elim: r => [_|a r hr] //. rewrite big_cons; case hPa: (P a). rewrite muln_gt0; case/andP=> Fa0; move/hr=> hF x. by rewrite in_cons; case/orP; [move/eqP-> | move/hF]. move/hr=> hF x; rewrite in_cons; case/orP; last by move/hF. by move/eqP->; rewrite hPa. Qed. Definition taqsR p sq i : R := (taqR p (map (poly_comb sq) (sg_tab (size sq)))`_i)%:~R. Definition ccount_weak p sq : R := let fix aux s (i : nat) := if i is i'.+1 then aux (taqsR p sq i' * coefs R (size sq) i' + s) i' else s in aux 0 (3 ^ size sq)%N. Lemma constraints1P (p : {poly R}) (sq : seq {poly R}) : (constraints (rootsR p) (sq) (nseq (size (sq)) 1))%:~R = ccount_weak p sq. Proof. rewrite constraints1_tvec; symmetry. rewrite castmxE mxE /= /ccount_weak. transitivity (\sum_(0 <= i < 3 ^ size sq) taqsR p sq i * coefs R (size sq) i). rewrite unlock /reducebig /= -foldr_map /= /index_iota subn0 foldr_map. elim: (3 ^ size sq)%N 0%R => [|n ihn] u //. by rewrite -[X in iota _ X]addn1 iotaD add0n /= foldr_cat ihn. rewrite big_mkord; apply: congr_big=> // i _. rewrite /taqsR /coefs /tvecR /=. have o : 'I_(3 ^ size sq) by rewrite exp3n; apply: ord0. rewrite (@nth_map _ o); last by rewrite size_enum_ord. by rewrite !castmxE !cast_ord_id !mxE /= nth_ord_enum taq_taqR. Qed. Lemma ccount_weakP p sq : p != 0 -> reflect (exists x, (p.[x] == 0) && \big[andb/true]_(q <- sq) (q.[x] > 0)) (ccount_weak p sq > 0). Proof. move=> p_neq0; rewrite -constraints1P /constraints ltr0n lt0n. rewrite -(@pnatr_eq0 int) natr_sum psumr_eq0 //. rewrite -has_predC /=. apply: (iffP hasP) => [[x rpx /= prod_neq0]|[x /andP[rpx]]]. exists x; rewrite -rootE [root _ _]roots_on_rootsR // rpx /=. rewrite big_seq big1 => // q Hq. move: prod_neq0; rewrite pnatr_eq0 -lt0n => /all_prodn_gt0. have := index_mem q sq; rewrite Hq => Hoq. pose oq := Ordinal Hoq => /(_ oq). rewrite mem_index_enum => /(_ isT isT) /=. by rewrite nth_nseq index_mem Hq nth_index // lt0b sgz_cp0. rewrite big_all => /allP Hsq. exists x => /=; first by rewrite -roots_on_rootsR. rewrite pnatr_eq0 -lt0n prodn_gt0 => // i; rewrite nth_nseq ltn_ord lt0b. by rewrite sgz_cp0 Hsq // mem_nth. Qed. Lemma myprodf_eq0 (S : idomainType)(I : eqType) (r : seq I) P (F : I -> S) : reflect (exists2 i, ((i \in r) && (P i)) & (F i == 0)) (\prod_(i <- r| P i) F i == 0). Proof. apply: (iffP idP) => [|[i Pi /eqP Fi0]]; last first. by case/andP: Pi => ri Pi; rewrite (big_rem _ ri) /= Pi Fi0 mul0r. elim: r => [|i r IHr]; first by rewrite big_nil oner_eq0. rewrite big_cons /=; have [Pi | ?] := ifP. rewrite mulf_eq0; case/orP=> [Fi0|]; first by exists i => //; rewrite mem_head. by case/IHr=> j /andP [rj Pj] Fj; exists j; rewrite // in_cons rj orbT. by case/IHr=> j /andP [rj Pj] Fj; exists j; rewrite // in_cons rj orbT. Qed. Definition bounding_poly (sq : seq {poly R}) := (\prod_(q <- sq) q)^`(). Lemma bounding_polyP (sq : seq {poly R}) : [\/ \big[andb/true]_(q <- sq) (lead_coef q > 0), \big[andb/true]_(q <- sq) ((-1)^+(size q).-1 * (lead_coef q) > 0) | exists x, ((bounding_poly sq).[x] == 0) && \big[andb/true]_(q <- sq) (q.[x] > 0)] <-> exists x, \big[andb/true]_(q <- sq) (q.[x] > 0). Proof. split=> [|[x]]. case; last by move=> [x /andP [? h]]; exists x; rewrite h. rewrite big_all => /allP hsq. have sqn0 : {in sq, forall q, q != 0}. by move=> q' /= /hsq; apply: contraL=> /eqP->; rewrite lead_coef0 ltxx. pose qq := \prod_(q <- sq) q. have pn0 : qq != 0. by apply/negP=> /myprodf_eq0 [] q; rewrite andbT => /sqn0 /negPf ->. pose b := cauchy_bound qq; exists b. rewrite big_all; apply/allP=> r hr; have:= hsq r hr. rewrite -!sgr_cp0=> /eqP <-; apply/eqP. apply: (@sgp_pinftyP _ b); last by rewrite boundl_in_itv. move=> z Hz /=; have: ~~ root qq z by rewrite ge_cauchy_bound. by rewrite /root /qq horner_prod prodf_seq_neq0 => /allP /(_ _ hr). rewrite big_all => /allP hsq. have sqn0 : {in sq, forall q, q != 0}. move=> q' /= /hsq; apply: contraL=> /eqP->. by rewrite lead_coef0 mulr0 ltxx. pose qq := \prod_(q <- sq) q. have pn0 : qq != 0. by apply/negP=> /myprodf_eq0 [] q; rewrite andbT => /sqn0 /negPf ->. pose b := - cauchy_bound qq; exists b. rewrite big_all; apply/allP=> r hr; have:= hsq r hr. rewrite -!sgr_cp0=> /eqP <-; apply/eqP. apply: (@sgp_minftyP _ b); last by rewrite boundr_in_itv. move=> z Hz /=; have: ~~ root qq z by rewrite le_cauchy_bound. by rewrite /root /qq horner_prod prodf_seq_neq0 => /allP /(_ _ hr). rewrite /bounding_poly; set q := \prod_(q <- _) _. rewrite big_all => /allP hsq; set bnd := cauchy_bound q. have sqn0 : {in sq, forall q, q != 0}. by move=> q' /= /hsq; apply: contraL=> /eqP->; rewrite horner0 ltxx. have [/eqP|q_neq0] := eqVneq q 0. by rewrite prodf_seq_eq0=> /hasP [q' /= /sqn0 /negPf->]. have genroot y : {in sq, forall r, ~~ root q y -> ~~ root r y}. rewrite /root /q => r r_sq. by rewrite horner_prod prodf_seq_neq0 => /allP /(_ _ r_sq). case: (next_rootP q x bnd) q_neq0; [by move->; rewrite eqxx| |]; last first. move=> _ q_neq0 _ Hq _. suff -> : \big[andb/true]_(q1 <- sq) (0 < lead_coef q1) by constructor. rewrite big_all; apply/allP=> r hr; have rxp := hsq r hr. rewrite -sgr_cp0 -/(sgp_pinfty _). rewrite -(@sgp_pinftyP _ x _ _ x) ?boundl_in_itv ?sgr_cp0 //. move=> z; rewrite (@itv_splitU _ _ (BRight x)) /<=%O /= ?lexx //. rewrite itv_xx /= => /orP [/eqP->|]; first by rewrite /root gt_eqF. have [x_b|b_x] := ltrP x bnd. rewrite (@itv_splitU _ _ (BLeft bnd)) /<=%O /= ?x_b //. move=> /orP [] Hz; rewrite genroot //; by [rewrite Hq|rewrite ge_cauchy_bound]. move=> Hz. by rewrite genroot ?ge_cauchy_bound // (subitvP _ Hz) /<=%O /= /<=%O //= b_x. move=> y1 _ rqy1 hy1xb hy1. case: (prev_rootP q (- bnd) x); [by move->; rewrite eqxx| |]; last first. move=> _ q_neq0 _ Hq _. (* assia : what is the use of c ? *) suff -> : \big[andb/true]_(q1 <- sq) (0 < (-1) ^+ (size q1).-1 * lead_coef q1). by constructor 2. rewrite big_all; apply/allP=> r hr; have rxp := hsq r hr. rewrite -sgr_cp0 -/(sgp_minfty _). rewrite -(@sgp_minftyP _ x _ _ x) ?boundr_in_itv ?sgr_cp0 //. move=> z; rewrite (@itv_splitU _ _ (BLeft x)) /<=%O /= ?lexx //. rewrite itv_xx => /orP [/=|/eqP->]; last by rewrite /root gt_eqF. have [b_x|x_b] := ltrP (- bnd) x. rewrite (@itv_splitU _ _ (BRight (- bnd))) /<=%O /= ?b_x //. move=> /orP [] Hz; rewrite genroot //; by [rewrite Hq|rewrite le_cauchy_bound]. by move=> Hz; rewrite genroot // le_cauchy_bound // (subitvP _ Hz) //= x_b. move=> y2 _ rqy2 hy2xb hy2 q_neq0. have lty12 : y2 < y1. by apply: lt_trans (_ : x < _); rewrite 1?(itvP hy1xb) 1?(itvP hy2xb). have : q.[y2] = q.[y1] by rewrite rqy1 rqy2. case/(poly_rolle lty12) => z hz rz; constructor 3; exists z. rewrite rz eqxx /= big_all; apply/allP => r r_sq. have xy : x \in `]y2, y1[ by rewrite in_itv /= 1?(itvP hy1xb) 1?(itvP hy2xb). rewrite -sgr_cp0 (@polyrN0_itv _ `]y2, y1[ _ _ x) ?sgr_cp0 ?hsq // => t. rewrite (@itv_splitUeq _ _ x) // => /or3P [/hy2|/eqP->|/hy1]; do ?exact: genroot. by rewrite rootE gt_eqF ?hsq. Qed. Lemma size_prod_eq1 (sq : seq {poly R}) : reflect (forall q, q \in sq -> size q = 1%N) (size (\prod_(q0 <- sq) q0) == 1%N). Proof. apply: (iffP idP). elim: sq => [| q sq ih]; first by move=> _ q; rewrite in_nil. rewrite big_cons; case: (altP (q =P 0)) => [-> | qn0]. by rewrite mul0r size_poly0. case: (altP ((\prod_(j <- sq) j) =P 0)) => [-> | pn0]. by rewrite mulr0 size_poly0. rewrite size_mul //; case: (ltngtP (size q) 1). - by rewrite ltnS leqn0 size_poly_eq0 (negPf qn0). - case: (size q) => [|n] //; case: n => [|n] // _; rewrite !addSn /= eqSS. by rewrite addn_eq0 size_poly_eq0 (negPf pn0) andbF. - move=> sq1; case: (ltngtP (size (\prod_(j <- sq) j)) 1). + by rewrite ltnS leqn0 size_poly_eq0 (negPf pn0). + case: (size (\prod_(j <- sq) j)) => [|n] //; case: n => [|n] // _. by rewrite !addnS /= eqSS addn_eq0 size_poly_eq0 (negPf qn0). move=> sp1 _ p; rewrite in_cons; case/orP => [/eqP -> |] //; apply: ih. by apply/eqP. elim: sq => [| q sq ih] hs; first by rewrite big_nil size_poly1 eqxx. case: (altP (q =P 0)) => [ | qn0]. by move/eqP; rewrite -size_poly_eq0 hs ?mem_head. case: (altP ((\prod_(q0 <- sq) q0) =P 0)) => [ | pn0]. move/eqP; rewrite -size_poly_eq0 (eqP (ih _)) // => t ht; apply: hs. by rewrite in_cons ht orbT. rewrite big_cons size_mul // (eqP (ih _)) //; last first. by move=> t ht; apply: hs; rewrite in_cons ht orbT. by rewrite addnS addn0; apply/eqP; apply: hs; apply: mem_head. Qed. Definition ccount_gt0 (sp sq : seq {poly R}) := let p := \big[@rgcdp _/0%R]_(p <- sp) p in if p != 0 then 0 < ccount_weak p sq else let bq := bounding_poly sq in [|| \big[andb/true]_(q <- sq)(lead_coef q > 0) , \big[andb/true]_(q <- sq)((-1)^+(size q).-1 *(lead_coef q) > 0) | 0 < ccount_weak bq sq]. Lemma ccount_gt0P (sp sq : seq {poly R}) : reflect (exists x, \big[andb/true]_(p <- sp) (p.[x] == 0) && \big[andb/true]_(q <- sq) (q.[x] > 0)) (ccount_gt0 sp sq). Proof. rewrite /ccount_gt0; case: (boolP (_ == 0))=> hsp /=; last first. apply: (iffP (ccount_weakP _ _)) => // [] [x Hx]; exists x; by move: Hx; rewrite -rootE root_bigrgcd -big_all. apply: (@equivP (exists x, \big[andb/true]_(q <- sq) (0 < q.[x]))); last first. split=> [] [x Hx]; exists x; rewrite ?Hx ?andbT; do ?by case/andP: Hx. move: hsp; rewrite (big_morph _ (@rgcdp_eq0 _) (eqxx _)) !big_all. by move=> /allP Hsp; apply/allP => p /Hsp /eqP ->; rewrite horner0. have [|bq_neq0] := boolP (bounding_poly sq == 0). rewrite /bounding_poly -derivn1 -derivn_poly0 => ssq_le1. rewrite -constraints1P (size1_polyC ssq_le1) derivnC /= rootsRC. rewrite /constraints big_nil ltxx orbF. move: ssq_le1; rewrite leq_eqVlt ltnS leqn0 orbC. have [|_ /=] := boolP (_ == _). rewrite size_poly_eq0 => /eqP sq_eq0; move/eqP: (sq_eq0). rewrite prodf_seq_eq0 => /hasP /sig2W [q /= q_sq] /eqP q_eq0. move: q_sq; rewrite q_eq0 => sq0 _ {q q_eq0}. set f := _ || _; suff -> : f = false; move: @f => /=. constructor => [] [x]; rewrite big_all. by move=> /allP /(_ _ sq0); rewrite horner0 ltxx. apply: negbTE; rewrite !negb_or !big_all -!has_predC. apply/andP; split; apply/hasP; by exists 0; rewrite //= ?lead_coef0 ?mulr0 ltxx. move=> /size_prod_eq1 Hsq. have {}Hsq q : q \in sq -> q = (lead_coef q)%:P. by move=> /Hsq sq1; rewrite [q]size1_polyC ?sq1 // lead_coefC. apply: (@equivP (\big[andb/true]_(q <- sq) (0 < lead_coef q))); last first. split; [move=> sq0; exists 0; move: sq0|move=> [x]]; rewrite !big_all => /allP H; apply/allP => q q_sq; have:= H _ q_sq; by rewrite [q]Hsq ?lead_coefC ?hornerC. have [] := boolP (\big[andb/true]_(q <- _) (0 < lead_coef q)). by constructor. rewrite !big_all -has_predC => /hasP sq0; apply: (iffP allP) => //=. move: sq0 => [q q_sq /= lq_gt0 /(_ _ q_sq)]. rewrite [q]Hsq ?size_polyC ?lead_coefC //. by case: (_ != 0); rewrite /= expr0 mul1r ?(negPf lq_gt0). apply: (iffP or3P); rewrite -bounding_polyP; case; do ?by [constructor 1|constructor 2]; by move/(ccount_weakP _ bq_neq0); constructor 3. Qed. End QeRcfTh. real-closed-2.0.2/theories/realalg.v000066400000000000000000001500531472566273500173520ustar00rootroot00000000000000(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra all_field bigenough. From mathcomp Require Import polyorder cauchyreals. (*************************************************************************) (* This files constructs the real closure of an archimedian field in the *) (* way described in Cyril Cohen. Construction of real algebraic numbers *) (* in Coq. In Lennart Beringer and Amy Felty, editors, ITP - 3rd *) (* International Conference on Interactive Theorem Proving - 2012, *) (* Princeton, United States, August 2012. Springer *) (* *) (* The only definition one may want to use in this file is the operator *) (* {realclosure R} which constructs the real closure of the archimedian *) (* field R (for which rat is a prefect candidate) *) (*************************************************************************) Import Order.TTheory GRing.Theory Num.Theory BigEnough. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Reserved Notation "{ 'realclosure' T }" (at level 0, format "{ 'realclosure' T }"). Reserved Notation "{ 'alg' T }" (at level 0, format "{ 'alg' T }"). Section extras. Local Open Scope ring_scope. Local Notation "p ^ f" := (map_poly f p) : ring_scope. Lemma map_comp_poly (aR : fieldType) (rR : idomainType) (f : {rmorphism aR -> rR}) (p q : {poly aR}) : (p \Po q) ^ f = (p ^ f) \Po (q ^ f). Proof. rewrite !comp_polyE size_map_poly; apply: (big_ind2 (fun x y => x ^ f = y)). + by rewrite rmorph0. + by move=> u u' v v' /=; rewrite rmorphD /= => -> ->. move=> /= i _; rewrite -mul_polyC rmorphM /= map_polyC mul_polyC. by rewrite coef_map rmorphXn. Qed. End extras. Module RealAlg. Local Open Scope ring_scope. Local Notation eval := horner_eval. Section RealAlg. Variable F : archiFieldType. Local Notation m0 := (fun _ => 0%N). (*********************************************************************) (* Construction of algebraic Cauchy reals : Cauchy real + polynomial *) (*********************************************************************) Record algcreal := AlgCReal { creal_of_alg :> creal F; annul_creal : {poly F}; _ : annul_creal \is monic; _ : (annul_creal.[creal_of_alg] == 0)%CR }. Lemma monic_annul_creal x : annul_creal x \is monic. Proof. by case: x. Qed. Hint Resolve monic_annul_creal : core. Lemma annul_creal_eq0 x : (annul_creal x == 0) = false. Proof. by rewrite (negPf (monic_neq0 _)). Qed. Lemma root_annul_creal x : ((annul_creal x).[x] == 0)%CR. Proof. by case: x. Qed. Hint Resolve root_annul_creal : core. Definition cst_algcreal (x : F) := AlgCReal (monicXsubC _) (@root_cst_creal _ x). Local Notation zero_algcreal := (cst_algcreal 0). Local Notation one_algcreal := (cst_algcreal 1). Lemma size_annul_creal_gt1 (x : algcreal) : (1 < size (annul_creal x))%N. Proof. apply: (@has_root_creal_size_gt1 _ x). by rewrite monic_neq0 // monic_annul_creal. exact: root_annul_creal. Qed. Lemma is_root_annul_creal (x : algcreal) (y : creal F) : (x == y)%CR -> ((annul_creal x).[y] == 0)%CR. Proof. by move <-. Qed. Definition AlgCRealOf (p : {poly F}) (x : creal F) (p_neq0 : p != 0) (px_eq0 : (p.[x] == 0)%CR) := AlgCReal (monic_monic_from_neq0 p_neq0) (root_monic_from_neq0 px_eq0). Lemma sub_annihilant_algcreal_neq0 (x y : algcreal) : sub_annihilant (annul_creal x) (annul_creal y) != 0. Proof. by rewrite sub_annihilant_neq0 ?monic_neq0. Qed. Lemma root_sub_algcreal (x y : algcreal) : ((sub_annihilant (annul_creal x) (annul_creal y)).[x - y] == 0)%CR. Proof. by rewrite root_sub_annihilant_creal ?root_annul_creal ?monic_neq0. Qed. Definition sub_algcreal (x y : algcreal) : algcreal := AlgCRealOf (sub_annihilant_algcreal_neq0 x y) (@root_sub_algcreal x y). Lemma root_opp_algcreal (x : algcreal) : ((annul_creal (sub_algcreal (cst_algcreal 0) x)).[- x] == 0)%CR. Proof. by apply: is_root_annul_creal; rewrite /= add_0creal. Qed. Definition opp_algcreal (x : algcreal) : algcreal := AlgCReal (@monic_annul_creal _) (@root_opp_algcreal x). Lemma root_add_algcreal (x y : algcreal) : ((annul_creal (sub_algcreal x (opp_algcreal y))).[x + y] == 0)%CR. Proof. apply: is_root_annul_creal; apply: eq_crealP. by exists m0=> * /=; rewrite opprK subrr normr0. Qed. Definition add_algcreal (x y : algcreal) : algcreal := AlgCReal (@monic_annul_creal _) (@root_add_algcreal x y). Lemma div_annihilant_algcreal_neq0 (x y : algcreal) : (annul_creal y).[0] != 0 -> div_annihilant (annul_creal x) (annul_creal y) != 0. Proof. by move=> ?; rewrite div_annihilant_neq0 ?monic_neq0. Qed. Hint Resolve eq_creal_refl le_creal_refl : core. Lemma simplify_algcreal (x : algcreal) (x_neq0 : (x != 0)%CR) : {y | ((annul_creal y).[0] != 0) & ((y != 0)%CR * (x == y)%CR)%type}. Proof. elim: size {-3}x x_neq0 (leqnn (size (annul_creal x))) => {x} [|n ihn] x x_neq0 hx. by move: hx; rewrite leqn0 size_poly_eq0 annul_creal_eq0. have [dvdX|ndvdX] := boolP ('X %| annul_creal x); last first. by exists x=> //; rewrite -rootE -dvdp_XsubCl subr0. have monic_p: @annul_creal x %/ 'X \is monic. by rewrite -(monicMr _ (@monicX _)) divpK //. have root_p: ((@annul_creal x %/ 'X).[x] == 0)%CR. have := @eq_creal_refl _ ((annul_creal x).[x])%CR. rewrite -{1}(divpK dvdX) horner_crealM // root_annul_creal. by case/poly_mul_creal_eq0=> //; rewrite horner_crealX. have [//|/=|y *] := ihn (AlgCReal monic_p root_p); last by exists y. by rewrite size_divp ?size_polyX ?polyX_eq0 ?leq_subLR ?add1n. Qed. (* Decidability of equality to 0 *) Lemma algcreal_eq0_dec (x : algcreal) : {(x == 0)%CR} + {(x != 0)%CR}. Proof. pose p := annul_creal x; move: {2}(size _)%N (leqnn (size p))=> n. elim: n x @p => [x p|n ihn x p le_sp_Sn]. by rewrite leqn0 size_poly_eq0 /p annul_creal_eq0. move: le_sp_Sn; rewrite leq_eqVlt; have [|//|eq_sp_Sn _] := ltngtP. by rewrite ltnS=> /ihn ihnp _; apply: ihnp. have px0 : (p.[x] == 0)%CR by apply: root_annul_creal. have [cpX|ncpX] := boolP (coprimep p 'X). by right; move: (cpX)=> /coprimep_root /(_ px0); rewrite horner_crealX. have [eq_pX|] := altP (p =P 'X). by left; move: px0; rewrite eq_pX horner_crealX. rewrite -eqp_monic /p ?monicX // negb_and orbC. have:= ncpX; rewrite coprimepX -dvdp_XsubCl subr0 => /negPf-> /= ndiv_pX. have [r] := smaller_factor (monic_annul_creal _) px0 ndiv_pX ncpX. rewrite eq_sp_Sn ltnS => /andP[le_r_n monic_r] rx_eq0. exact: (ihn (AlgCReal monic_r rx_eq0)). Qed. Lemma eq_algcreal_dec (x y : algcreal) : {(x == y)%CR} + {(x != y)%CR}. Proof. have /= [d_eq0|d_neq0] := algcreal_eq0_dec (sub_algcreal x y); [left|right]. apply: eq_crealP; exists_big_modulus m F. by move=> e i e_gt0 hi; rewrite (@eq0_modP _ _ d_eq0). by close. pose_big_enough i. apply: (@neq_crealP _ (lbound d_neq0) i i); do ?by rewrite ?lbound_gt0. by rewrite (@lbound0P _ _ d_neq0). by close. Qed. Definition eq_algcreal : rel algcreal := eq_algcreal_dec. Lemma eq_algcrealP (x y : algcreal) : reflect (x == y)%CR (eq_algcreal x y). Proof. by rewrite /eq_algcreal; case: eq_algcreal_dec=> /=; constructor. Qed. Arguments eq_algcrealP {x y}. Lemma neq_algcrealP (x y : algcreal) : reflect (x != y)%CR (~~ eq_algcreal x y). Proof. by rewrite /eq_algcreal; case: eq_algcreal_dec=> /=; constructor. Qed. Arguments neq_algcrealP {x y}. Prenex Implicits eq_algcrealP neq_algcrealP. Fact eq_algcreal_is_equiv : equiv_class_of eq_algcreal. Proof. split=> [x|x y|y x z]; first by apply/eq_algcrealP. by apply/eq_algcrealP/eq_algcrealP; symmetry. by move=> /eq_algcrealP /eq_creal_trans h /eq_algcrealP /h /eq_algcrealP. Qed. Canonical eq_algcreal_rel := EquivRelPack eq_algcreal_is_equiv. Lemma root_div_algcreal (x y : algcreal) (y_neq0 : (y != 0)%CR) : (annul_creal y).[0] != 0 -> ((div_annihilant (annul_creal x) (annul_creal y)).[x / y_neq0] == 0)%CR. Proof. by move=> hx; rewrite root_div_annihilant_creal ?monic_neq0. Qed. Definition div_algcreal (x y : algcreal) := match eq_algcreal_dec y (cst_algcreal 0) with | left y_eq0 => cst_algcreal 0 | right y_neq0 => let: exist2 y' py'0_neq0 (y'_neq0, _) := simplify_algcreal y_neq0 in AlgCRealOf (div_annihilant_algcreal_neq0 x py'0_neq0) (@root_div_algcreal x y' y'_neq0 py'0_neq0) end. Lemma root_inv_algcreal (x : algcreal) (x_neq0 : (x != 0)%CR) : ((annul_creal (div_algcreal (cst_algcreal 1) x)).[x_neq0^-1] == 0)%CR. Proof. rewrite /div_algcreal; case: eq_algcreal_dec=> [/(_ x_neq0)|x_neq0'] //=. case: simplify_algcreal=> x' px'0_neq0 [x'_neq0 eq_xx']. apply: is_root_annul_creal; rewrite /= -(@eq_creal_inv _ _ _ x_neq0) //. by apply: eq_crealP; exists m0=> * /=; rewrite div1r subrr normr0. Qed. Definition inv_algcreal (x : algcreal) := match eq_algcreal_dec x (cst_algcreal 0) with | left x_eq0 => cst_algcreal 0 | right x_neq0 => AlgCReal (@monic_annul_creal _) (@root_inv_algcreal _ x_neq0) end. Lemma div_creal_creal (y : creal F) (y_neq0 : (y != 0)%CR) : (y / y_neq0 == 1%:CR)%CR. Proof. apply: eq_crealP; exists_big_modulus m F. move=> e i e_gt0 hi; rewrite /= divff ?subrr ?normr0 //. by rewrite (@creal_neq_always _ _ 0%CR). by close. Qed. Lemma root_mul_algcreal (x y : algcreal) : ((annul_creal (div_algcreal x (inv_algcreal y))).[x * y] == 0)%CR. Proof. rewrite /div_algcreal /inv_algcreal. case: (eq_algcreal_dec y)=> [->|y_neq0]; apply: is_root_annul_creal. rewrite mul_creal0; case: eq_algcreal_dec=> // neq_00. by move: (eq_creal_refl neq_00). case: eq_algcreal_dec=> /= [yV_eq0|yV_neq0]. have: (y * y_neq0^-1 == 0)%CR by rewrite yV_eq0 mul_creal0. by rewrite div_creal_creal=> /eq_creal_cst; rewrite oner_eq0. case: simplify_algcreal=> y' py'0_neq0 [y'_neq0 /= eq_yy']. rewrite -(@eq_creal_inv _ _ _ yV_neq0) //. by apply: eq_crealP; exists m0=> * /=; rewrite invrK subrr normr0. Qed. Definition mul_algcreal (x y : algcreal) := AlgCReal (@monic_annul_creal _) (@root_mul_algcreal x y). Lemma le_creal_neqVlt (x y : algcreal) : (x <= y)%CR -> {(x == y)%CR} + {(x < y)%CR}. Proof. case: (eq_algcreal_dec x y); first by left. by move=> /neq_creal_ltVgt [|h /(_ h) //]; right. Qed. Lemma ltVge_algcreal_dec (x y : algcreal) : {(x < y)%CR} + {(y <= x)%CR}. Proof. have [eq_xy|/neq_creal_ltVgt [lt_xy|lt_yx]] := eq_algcreal_dec x y; by [right; rewrite eq_xy | left | right; apply: lt_crealW]. Qed. Definition lt_algcreal : rel algcreal := ltVge_algcreal_dec. Definition le_algcreal : rel algcreal := fun x y => ~~ ltVge_algcreal_dec y x. Lemma lt_algcrealP (x y : algcreal) : reflect (x < y)%CR (lt_algcreal x y). Proof. by rewrite /lt_algcreal; case: ltVge_algcreal_dec; constructor. Qed. Arguments lt_algcrealP {x y}. Lemma le_algcrealP (x y : algcreal) : reflect (x <= y)%CR (le_algcreal x y). Proof. by rewrite /le_algcreal; case: ltVge_algcreal_dec; constructor. Qed. Arguments le_algcrealP {x y}. Prenex Implicits lt_algcrealP le_algcrealP. Definition exp_algcreal x n := iterop n mul_algcreal x one_algcreal. Lemma exp_algcrealE x n : (exp_algcreal x n == x ^+ n)%CR. Proof. case: n=> // n; rewrite /exp_algcreal /exp_creal !iteropS. by elim: n=> //= n ->. Qed. Definition horner_algcreal (p : {poly F}) x : algcreal := \big[add_algcreal/zero_algcreal]_(i < size p) mul_algcreal (cst_algcreal p`_i) (exp_algcreal x i). Lemma horner_algcrealE p x : (horner_algcreal p x == p.[x])%CR. Proof. rewrite horner_coef_creal. apply: (big_ind2 (fun (u : algcreal) v => u == v)%CR)=> //. by move=> u u' v v' /= -> ->. by move=> i _ /=; rewrite exp_algcrealE. Qed. Definition norm_algcreal (x : algcreal) := if le_algcreal zero_algcreal x then x else opp_algcreal x. Lemma norm_algcrealE (x : algcreal) : (norm_algcreal x == `| x |)%CR. Proof. rewrite /norm_algcreal /le_algcreal; case: ltVge_algcreal_dec => /=. move=> x_lt0; apply: eq_crealP; exists_big_modulus m F. move=> e i e_gt0 hi /=; rewrite [`|x i|]ler0_norm ?subrr ?normr0 //. by rewrite ltW // [_ < 0%CR i]creal_lt_always. by close. move=> /(@le_creal_neqVlt zero_algcreal) /= []. by move<-; apply: eq_crealP; exists m0=> * /=; rewrite !(normr0, subrr). move=> x_gt0; apply: eq_crealP; exists_big_modulus m F. move=> e i e_gt0 hi /=; rewrite [`|x i|]ger0_norm ?subrr ?normr0 //. by rewrite ltW // creal_gt0_always. by close. Qed. (**********************************************************************) (* Theory of the "domain" of algebraic numbers: polynomial + interval *) (**********************************************************************) Record algdom := AlgDom { annul_algdom : {poly F}; center_alg : F; radius_alg : F; _ : annul_algdom \is monic; _ : radius_alg >= 0; _ : annul_algdom.[center_alg - radius_alg] * annul_algdom.[center_alg + radius_alg] <= 0 }. Lemma radius_alg_ge0 x : 0 <= radius_alg x. Proof. by case: x. Qed. Lemma monic_annul_algdom x : annul_algdom x \is monic. Proof. by case: x. Qed. Hint Resolve monic_annul_algdom : core. Lemma annul_algdom_eq0 x : (annul_algdom x == 0) = false. Proof. by rewrite (negPf (monic_neq0 _)). Qed. Lemma algdomP x : (annul_algdom x).[center_alg x - radius_alg x] * (annul_algdom x).[center_alg x + radius_alg x] <= 0. Proof. by case: x. Qed. Definition algdom' := seq F. Definition encode_algdom (x : algdom) : algdom' := [:: center_alg x, radius_alg x & (annul_algdom x)]. Definition decode_algdom (x : algdom') : option algdom := if x is [::c, r & p'] then let p := Poly p' in if ((p \is monic) =P true, (r >= 0) =P true, (p.[c - r] * p.[c + r] <= 0) =P true) is (ReflectT monic_p, ReflectT r_gt0, ReflectT hp) then Some (AlgDom monic_p r_gt0 hp) else None else None. Lemma encode_algdomK : pcancel encode_algdom decode_algdom. Proof. case=> p c r monic_p r_ge0 hp /=; rewrite polyseqK. do 3?[case: eqP; rewrite ?monic_p ?r_ge0 ?monic_p //] => monic_p' r_ge0' hp'. by congr (Some (AlgDom _ _ _)); apply: bool_irrelevance. Qed. HB.instance Definition _ := Choice.copy algdom (pcan_type encode_algdomK). Fixpoint to_algcreal_of (p : {poly F}) (c r : F) (i : nat) : F := match i with | 0 => c | i.+1 => let c' := to_algcreal_of p c r i in if p.[c' - r / 2%:R ^+ i] * p.[c'] <= 0 then c' - r / 2%:R ^+ i.+1 else c' + r / 2%:R ^+ i.+1 end. Lemma to_algcreal_of_recP p c r i : 0 <= r -> `|to_algcreal_of p c r i.+1 - to_algcreal_of p c r i| <= r * 2%:R ^- i.+1. Proof. move=> r_ge0 /=; case: ifP=> _; rewrite addrAC subrr add0r ?normrN ger0_norm //; by rewrite mulr_ge0 ?invr_ge0 ?exprn_ge0 ?ler0n. Qed. Lemma to_algcreal_ofP p c r i j : 0 <= r -> (i <= j)%N -> `|to_algcreal_of p c r j - to_algcreal_of p c r i| <= r * 2%:R ^- i. Proof. move=> r_ge0 leij; pose r' := r * 2%:R ^- j * (2%:R ^+ (j - i) - 1). apply: le_trans (_ : r' <= _); last first. rewrite /r' -mulrA ler_wpM2l // ler_pdivrMl ?exprn_gt0 ?ltr0n //. rewrite -{2}(subnK leij) exprD mulfK ?gt_eqF ?exprn_gt0 ?ltr0n //. by rewrite gerDl lerN10. rewrite /r' subrX1 addrK mul1r -{1 2}(subnK leij); set f := _ c r. elim: (_ - _)%N=> [|k ihk]; first by rewrite subrr normr0 big_ord0 mulr0 lexx. rewrite addSn big_ord_recl /= mulrDr. rewrite (le_trans (ler_distD (f (k + i)%N) _ _)) //. rewrite lerD ?expr0 ?mulr1 ?to_algcreal_of_recP // (le_trans ihk) //. rewrite exprSr invfM -!mulrA !ler_wpM2l ?invr_ge0 ?exprn_ge0 ?ler0n //. by rewrite mulr_sumr ler_sum // => l _ /=; rewrite exprS mulKf ?pnatr_eq0. Qed. Lemma alg_to_crealP (x : algdom) : creal_axiom (to_algcreal_of (annul_algdom x) (center_alg x) (radius_alg x)). Proof. pose_big_modulus m F. exists m=> e i j e_gt0 hi hj. wlog leij : i j {hi} hj / (j <= i)%N. move=> hwlog; case/orP: (leq_total i j)=> /hwlog; last exact. by rewrite distrC; apply. rewrite (le_lt_trans (to_algcreal_ofP _ _ _ _)) ?radius_alg_ge0 //. rewrite ltr_pdivrMr ?gtr0E // -ltr_pdivrMl //. by rewrite upper_nthrootP. by close. Qed. Definition alg_to_creal x := CReal (alg_to_crealP x). Lemma exp2k_crealP : @creal_axiom F (fun i => 2%:R ^- i). Proof. pose_big_modulus m F. exists m=> e i j e_gt0 hi hj. wlog leij : i j {hj} hi / (i <= j)%N. move=> hwlog; case/orP: (leq_total i j)=> /hwlog; first exact. by rewrite distrC; apply. rewrite ger0_norm ?subr_ge0; last first. by rewrite ?lef_pV2 -?topredE /= ?gtr0E // ler_eXn2l ?ltr1n. rewrite -(@ltr_pM2l _ (2%:R ^+ i )) ?gtr0E //. rewrite mulrBr mulfV ?gt_eqF ?gtr0E //. rewrite (le_lt_trans (_ : _ <= 1)) // ?gerDl ?oppr_le0 ?mulr_ge0 ?ger0E //. by rewrite -ltr_pdivrMr // mul1r upper_nthrootP. by close. Qed. Definition exp2k_creal := CReal exp2k_crealP. Lemma exp2k_creal_eq0 : (exp2k_creal == 0)%CR. Proof. apply: eq_crealP; exists_big_modulus m F. move=> e i e_gt0 hi /=. rewrite subr0 gtr0_norm ?gtr0E // -ltf_pV2 -?topredE /= ?gtr0E //. by rewrite invrK upper_nthrootP. by close. Qed. Notation lbound0_of p := (@lbound0P _ _ p _ _ _). Lemma to_algcrealP (x : algdom) : ((annul_algdom x).[alg_to_creal x] == 0)%CR. Proof. set u := alg_to_creal _; set p := annul_algdom _. pose r := radius_alg x; pose cr := cst_creal r. have: ((p).[u - cr * exp2k_creal] * (p).[u + cr * exp2k_creal] <= 0)%CR. apply: (@le_crealP _ 0%N)=> i _ /=. rewrite -/p -/r; set c := center_alg _. elim: i=> /= [|i]. by rewrite !expr0 divr1 algdomP. set c' := to_algcreal_of _ _ _=> ihi. have [] := lerP (_ * p.[c' i]). rewrite addrNK -addrA -opprD -mulr2n -[_ / _ *+ _]mulr_natr. by rewrite -mulrA exprSr invfM mulfVK ?pnatr_eq0. rewrite addrK -addrA -mulr2n -[_ / _ *+ _]mulr_natr. rewrite -mulrA exprSr invfM mulfVK ?pnatr_eq0 // => /ler_pM2l<-. rewrite mulr0 mulrCA !mulrA [X in X * _]mulrAC -mulrA. by rewrite mulr_ge0_le0 // -expr2 exprn_even_ge0. rewrite exp2k_creal_eq0 mul_creal0 opp_creal0 add_creal0. move=> hu pu0; apply: hu; pose e := (lbound pu0). pose_big_enough i. apply: (@lt_crealP _ (e * e) i i) => //. by rewrite !pmulr_rgt0 ?invr_gt0 ?ltr0n ?lbound_gt0. rewrite add0r [u]lock /= -!expr2. rewrite -[_.[_] ^+ _]ger0_norm ?exprn_even_ge0 // normrX. rewrite ler_pXn2r -?topredE /= ?lbound_ge0 ?normr_ge0 //. by rewrite -lock (le_trans _ (lbound0_of pu0)). by close. Qed. Definition to_algcreal_rec (x : algdom) := AlgCReal (monic_annul_algdom x) (@to_algcrealP x). (* "Encoding" function from algdom to algcreal *) Definition to_algcreal := locked to_algcreal_rec. (* "Decoding" function, constructed interactively *) Lemma to_algdom_exists (x : algcreal) : { y : algdom | (to_algcreal y == x)%CR }. Proof. pose p := annul_creal x. move: {2}(size p) (leqnn (size p))=> n. elim: n x @p=> [x p|n ihn x p le_sp_Sn]. by rewrite leqn0 size_poly_eq0 /p annul_creal_eq0. move: le_sp_Sn; rewrite leq_eqVlt. have [|//|eq_sp_Sn _] := ltngtP. by rewrite ltnS=> /ihn ihnp _; apply: ihnp. have px0 := @root_annul_creal x; rewrite -/p -/root in px0. have [|ncop] := boolP (coprimep p p^`()). move/coprimep_root => /(_ _ px0) /deriv_neq0_mono [r r_gt0 [i ir sm]]. have p_chg_sign : p.[x i - r] * p.[x i + r] <= 0. have [/accr_pos_incr hp|/accr_neg_decr hp] := sm. have hpxj : forall j, (i <= j)%N -> (p.[x i - r] <= p.[x j]) * (p.[x j] <= p.[x i + r]). move=> j hj. suff: p.[x i - r] <= p.[x j] <= p.[x i + r] by case/andP=> -> ->. rewrite !hp 1?addrAC ?subrr ?add0r ?normrN; rewrite ?(gtr0_norm r_gt0) //; do ?by rewrite ltW ?cauchymodP ?(leq_trans _ hj). by rewrite -ler_distl ltW ?cauchymodP ?(leq_trans _ hj). rewrite mulr_le0_ge0 //; apply/le_creal_cst; rewrite -px0; by apply: (@le_crealP _ i)=> h hj /=; rewrite hpxj. have hpxj : forall j, (i <= j)%N -> (p.[x i + r] <= p.[x j]) * (p.[x j] <= p.[x i - r]). move=> j hj. suff: p.[x i + r] <= p.[x j] <= p.[x i - r] by case/andP=> -> ->. rewrite !hp 1?addrAC ?subrr ?add0r ?normrN; rewrite ?(gtr0_norm r_gt0) //; do ?by rewrite ltW ?cauchymodP ?(leq_trans _ hj). by rewrite andbC -ler_distl ltW ?cauchymodP ?(leq_trans _ hj). rewrite mulr_ge0_le0 //; apply/le_creal_cst; rewrite -px0; by apply: (@le_crealP _ i)=> h hj /=; rewrite hpxj. pose y := (AlgDom (monic_annul_creal x) (ltW r_gt0) p_chg_sign). have eq_py_px: (p.[to_algcreal y] == p.[x])%CR. rewrite /to_algcreal -lock. by have := @to_algcrealP y; rewrite /= -/p=> ->; apply: eq_creal_sym. exists y. move: sm=> /strong_mono_bound [k k_gt0 hk]. rewrite -/p; apply: eq_crealP. exists_big_modulus m F. move=> e j e_gt0 hj; rewrite (le_lt_trans (hk _ _ _ _)) //. + rewrite /to_algcreal -lock. rewrite (le_trans (to_algcreal_ofP _ _ _ (leq0n _))) ?(ltW r_gt0) //. by rewrite expr0 divr1. + by rewrite ltW // cauchymodP. rewrite -ltr_pdivlMl //. by rewrite (@eq_modP _ _ _ eq_py_px) // ?pmulr_rgt0 ?invr_gt0. by close. case: (@smaller_factor _ p p^`() x); rewrite ?monic_annul_creal //. rewrite gtNdvdp // -?size_poly_eq0 size_deriv eq_sp_Sn //=. apply: contra ncop=> /eqP n_eq0; move: eq_sp_Sn; rewrite n_eq0. by move=> /eqP /size_poly1P [c c_neq0 ->]; rewrite derivC coprimep0 polyC_eqp1. move=> r /andP [hsr monic_r rx_eq0]. apply: (ihn (AlgCReal monic_r rx_eq0))=> /=. by rewrite -ltnS -eq_sp_Sn. Qed. Definition to_algdom x := projT1 (to_algdom_exists x). Lemma to_algdomK x : (to_algcreal (to_algdom x) == x)%CR. Proof. by rewrite /to_algdom; case: to_algdom_exists. Qed. Lemma eq_algcreal_to_algdom x : eq_algcreal (to_algcreal (to_algdom x)) x. Proof. by apply/eq_algcrealP; apply: to_algdomK. Qed. (* Explicit encoding to a choice type *) Canonical eq_algcreal_encModRel := EncModRel eq_algcreal eq_algcreal_to_algdom. Local Open Scope quotient_scope. Local Notation "\pi ( x )" := (\pi x) : quotient_scope. (***************************************************************************) (* Algebraic numbers are the quotient of algcreal by their setoid equality *) (***************************************************************************) Definition alg := {eq_quot eq_algcreal}. HB.instance Definition _ := Choice.on alg. HB.instance Definition _ := EqQuotient.on alg. Definition to_alg_def (phF : phant F) : F -> alg := lift_embed alg cst_algcreal. Notation to_alg := (@to_alg_def (Phant F)). Notation "x %:RA" := (to_alg x) (at level 2, left associativity, format "x %:RA"). Local Notation "p ^ f" := (map_poly f p) : ring_scope. Canonical to_alg_pi_morph := PiEmbed to_alg. Local Notation zero_alg := 0%:RA. Local Notation one_alg := 1%:RA. Lemma equiv_alg (x y : algcreal) : (x == y)%CR <-> (x = y %[mod alg]). Proof. split; first by move=> /eq_algcrealP /eqquotP ->. by move=> /eqquotP /eq_algcrealP. Qed. Lemma nequiv_alg (x y : algcreal) : reflect (x != y)%CR (x != y %[mod alg]). Proof. by rewrite eqquotE; apply: neq_algcrealP. Qed. Arguments nequiv_alg {x y}. Prenex Implicits nequiv_alg. Lemma pi_algK (x : algcreal) : (repr (\pi_alg x) == x)%CR. Proof. by apply/equiv_alg; rewrite reprK. Qed. Definition add_alg := lift_op2 alg add_algcreal. Lemma pi_add : {morph \pi_alg : x y / add_algcreal x y >-> add_alg x y}. Proof. by unlock add_alg=> x y; rewrite -equiv_alg /= !pi_algK. Qed. Canonical add_pi_morph := PiMorph2 pi_add. Definition opp_alg := lift_op1 alg opp_algcreal. Lemma pi_opp : {morph \pi_alg : x / opp_algcreal x >-> opp_alg x}. Proof. by unlock opp_alg=> x; rewrite -equiv_alg /= !pi_algK. Qed. Canonical opp_pi_morph := PiMorph1 pi_opp. Definition mul_alg := lift_op2 alg mul_algcreal. Lemma pi_mul : {morph \pi_alg : x y / mul_algcreal x y >-> mul_alg x y}. Proof. by unlock mul_alg=> x y; rewrite -equiv_alg /= !pi_algK. Qed. Canonical mul_pi_morph := PiMorph2 pi_mul. Definition inv_alg := lift_op1 alg inv_algcreal. Lemma pi_inv : {morph \pi_alg : x / inv_algcreal x >-> inv_alg x}. Proof. unlock inv_alg=> x; symmetry; rewrite -equiv_alg /= /inv_algcreal. case: eq_algcreal_dec=> /= [|x'_neq0]. by rewrite pi_algK; case: eq_algcreal_dec. move: x'_neq0 (x'_neq0); rewrite {1}pi_algK. case: eq_algcreal_dec=> // x'_neq0' x_neq0 x'_neq0 /=. by apply: eq_creal_inv; rewrite pi_algK. Qed. Canonical inv_pi_morph := PiMorph1 pi_inv. Lemma add_algA : associative add_alg. Proof. elim/quotW=> x; elim/quotW=> y; elim/quotW=> z; rewrite !piE -equiv_alg. by apply: eq_crealP; exists m0=> * /=; rewrite addrA subrr normr0. Qed. Lemma add_algC : commutative add_alg. Proof. elim/quotW=> x; elim/quotW=> y; rewrite !piE -equiv_alg /=. by apply: eq_crealP; exists m0=> * /=; rewrite [X in _ - X]addrC subrr normr0. Qed. Lemma add_0alg : left_id zero_alg add_alg. Proof. by elim/quotW=> x; rewrite !piE -equiv_alg /= add_0creal. Qed. Lemma add_Nalg : left_inverse zero_alg opp_alg add_alg. Proof. elim/quotW=> x; rewrite !piE -equiv_alg /=. by apply: eq_crealP; exists m0=> *; rewrite /= addNr subr0 normr0. Qed. HB.instance Definition _ := GRing.isZmodule.Build alg add_algA add_algC add_0alg add_Nalg. Lemma add_pi x y : \pi_alg x + \pi_alg y = \pi_alg (add_algcreal x y). Proof. by rewrite [_ + _]piE. Qed. Lemma opp_pi x : - \pi_alg x = \pi_alg (opp_algcreal x). Proof. by rewrite [- _]piE. Qed. Lemma zeroE : 0 = \pi_alg zero_algcreal. Proof. by rewrite [0]piE. Qed. Lemma sub_pi x y : \pi_alg x - \pi_alg y = \pi_alg (add_algcreal x (opp_algcreal y)). Proof. by rewrite [_ - _]piE. Qed. Lemma mul_algC : commutative mul_alg. Proof. elim/quotW=> x; elim/quotW=> y; rewrite !piE -equiv_alg /=. by apply: eq_crealP; exists m0=> * /=; rewrite mulrC subrr normr0. Qed. Lemma mul_algA : associative mul_alg. Proof. elim/quotW=> x; elim/quotW=> y; elim/quotW=> z; rewrite !piE -equiv_alg /=. by apply: eq_crealP; exists m0=> * /=; rewrite mulrA subrr normr0. Qed. Lemma mul_1alg : left_id one_alg mul_alg. Proof. by elim/quotW=> x; rewrite piE -equiv_alg /= mul_1creal. Qed. Lemma mul_alg_addl : left_distributive mul_alg add_alg. Proof. elim/quotW=> x; elim/quotW=> y; elim/quotW=> z; rewrite !piE -equiv_alg /=. by apply: eq_crealP; exists m0=> * /=; rewrite mulrDl subrr normr0. Qed. Arguments neq_creal_cst {F x y}. Prenex Implicits neq_creal_cst. Lemma nonzero1_alg : one_alg != zero_alg. Proof. by rewrite piE -(rwP neq_algcrealP) (rwP neq_creal_cst) oner_eq0. Qed. HB.instance Definition _ := GRing.Zmodule_isComRing.Build alg mul_algA mul_algC mul_1alg mul_alg_addl nonzero1_alg. HB.instance Definition _ := GRing.ComRing.on alg. Lemma mul_pi x y : \pi_alg x * \pi_alg y = \pi_alg (mul_algcreal x y). Proof. by rewrite [_ * _]piE. Qed. Lemma oneE : 1 = \pi_alg one_algcreal. Proof. by rewrite [1]piE. Qed. Lemma mul_Valg (x : alg) : x != zero_alg -> mul_alg (inv_alg x) x = one_alg. Proof. elim/quotW: x=> x; rewrite piE -(rwP neq_algcrealP) /= => x_neq0. apply/eqP; rewrite piE; apply/eq_algcrealP; rewrite /= /inv_algcreal. case: eq_algcreal_dec=> [/(_ x_neq0) //|/= x_neq0']. apply: eq_crealP; exists_big_modulus m F. by move=> * /=; rewrite mulVf ?subrr ?normr0 ?creal_neq0_always. by close. Qed. Lemma inv_alg0 : inv_alg zero_alg = zero_alg. Proof. rewrite !piE -equiv_alg /= /inv_algcreal. by case: eq_algcreal_dec=> //= zero_neq0; move: (eq_creal_refl zero_neq0). Qed. Lemma to_alg_additive : additive to_alg. Proof. move=> x y /=; rewrite !piE/= -equiv_alg /=. by apply: eq_crealP; exists m0=> * /=; rewrite subrr normr0. Qed. HB.instance Definition _ := GRing.isAdditive.Build F alg to_alg to_alg_additive. Lemma to_alg_multiplicative : multiplicative to_alg. Proof. split=> [x y |] //; rewrite !piE -equiv_alg. by apply: eq_crealP; exists m0=> * /=; rewrite subrr normr0. Qed. HB.instance Definition _ := GRing.isMultiplicative.Build F alg to_alg to_alg_multiplicative. Lemma expn_pi (x : algcreal) (n : nat) : (\pi_alg x) ^+ n = \pi_alg (exp_algcreal x n). Proof. rewrite /exp_algcreal; case: n=> [|n]; first by rewrite expr0 oneE. rewrite exprS iteropS; elim: n=> /= [|n ihn]; rewrite ?expr0 ?mulr1 //. by rewrite exprS ihn mul_pi. Qed. Lemma horner_pi (p : {poly F}) (x : algcreal) : (p ^ to_alg).[\pi_alg x] = \pi_alg (horner_algcreal p x). Proof. rewrite horner_coef /horner_algcreal size_map_poly. apply: (big_ind2 (fun x y => x = \pi_alg y)). + by rewrite zeroE. + by move=> u u' v v' -> ->; rewrite [_ + _]piE. by move=> i /= _; rewrite expn_pi coef_map /= [_ * _]piE. Qed. (* Defining annihilating polynomials for algebraics *) Definition annul_alg : alg -> {poly F} := locked (annul_creal \o repr). Lemma root_annul_algcreal (x : algcreal) : ((annul_alg (\pi x)).[x] == 0)%CR. Proof. by unlock annul_alg; rewrite /= -pi_algK root_annul_creal. Qed. Lemma root_annul_alg (x : alg) : root ((annul_alg x) ^ to_alg) x. Proof. apply/rootP; rewrite -[x]reprK horner_pi /= zeroE -equiv_alg. by rewrite horner_algcrealE root_annul_algcreal. Qed. Lemma monic_annul_alg (x : alg) : annul_alg x \is monic. Proof. by unlock annul_alg; rewrite monic_annul_creal. Qed. Lemma annul_alg_neq0 (x : alg) : annul_alg x != 0. Proof. by rewrite monic_neq0 ?monic_annul_alg. Qed. HB.instance Definition _ := GRing.ComRing_isField.Build alg mul_Valg inv_alg0. Lemma inv_pi x : (\pi_alg x)^-1 = \pi_alg (inv_algcreal x). Proof. by rewrite [_^-1]piE. Qed. Lemma div_pi x y : \pi_alg x / \pi_alg y = \pi_alg (mul_algcreal x (inv_algcreal y)). Proof. by rewrite [_ / _]piE. Qed. Definition lt_alg := lift_fun2 alg lt_algcreal. Definition le_alg := lift_fun2 alg le_algcreal. Lemma lt_alg_pi : {mono \pi_alg : x y / lt_algcreal x y >-> lt_alg x y}. Proof. move=> x y; unlock lt_alg; rewrite /lt_algcreal. by do 2!case: ltVge_algcreal_dec=> //=; rewrite !pi_algK. Qed. Canonical lt_alg_pi_mono := PiMono2 lt_alg_pi. Lemma le_alg_pi : {mono \pi_alg : x y / le_algcreal x y >-> le_alg x y}. Proof. move=> x y; unlock le_alg; rewrite /le_algcreal. by do 2!case: ltVge_algcreal_dec=> //=; rewrite !pi_algK. Qed. Canonical le_alg_pi_mono := PiMono2 le_alg_pi. Definition norm_alg := lift_op1 alg norm_algcreal. Lemma norm_alg_pi : {morph \pi_alg : x / norm_algcreal x >-> norm_alg x}. Proof. move=> x; unlock norm_alg; rewrite /norm_algcreal /le_algcreal. by do 2!case: ltVge_algcreal_dec=> //=; rewrite !(pi_opp, pi_algK, reprK). Qed. Canonical norm_alg_pi_morph := PiMorph1 norm_alg_pi. Lemma add_alg_gt0 x y : lt_alg zero_alg x -> lt_alg zero_alg y -> lt_alg zero_alg (x + y). Proof. rewrite -[x]reprK -[y]reprK !piE -!(rwP lt_algcrealP). move=> x_gt0 y_gt0; pose_big_enough i. apply: (@lt_crealP _ (diff x_gt0 + diff y_gt0) i i) => //. by rewrite addr_gt0 ?diff_gt0. by rewrite /= add0r lerD // ?diff0P. by close. Qed. Lemma mul_alg_gt0 x y : lt_alg zero_alg x -> lt_alg zero_alg y -> lt_alg zero_alg (x * y). Proof. rewrite -[x]reprK -[y]reprK !piE -!(rwP lt_algcrealP). move=> x_gt0 y_gt0; pose_big_enough i. apply: (@lt_crealP _ (diff x_gt0 * diff y_gt0) i i) => //. by rewrite pmulr_rgt0 ?diff_gt0. rewrite /= add0r (le_trans (_ : _ <= diff x_gt0 * (repr y) i)) //. by rewrite ler_wpM2l ?(ltW (diff_gt0 _)) // diff0P. by rewrite ler_wpM2r ?diff0P ?ltW ?creal_gt0_always. by close. Qed. Lemma gt0_alg_nlt0 x : lt_alg zero_alg x -> ~~ lt_alg x zero_alg. Proof. rewrite -[x]reprK !piE -!(rwP lt_algcrealP, rwP le_algcrealP). move=> hx; pose_big_enough i. apply: (@le_crealP _ i)=> j /= hj. by rewrite ltW // creal_gt0_always. by close. Qed. Lemma sub_alg_gt0 x y : lt_alg zero_alg (y - x) = lt_alg x y. Proof. rewrite -[x]reprK -[y]reprK !piE; apply/lt_algcrealP/lt_algcrealP=> /= hxy. pose_big_enough i. apply: (@lt_crealP _ (diff hxy) i i); rewrite ?diff_gt0 //. by rewrite (monoLR (addNKr _) (lerD2l _)) addrC diff0P. by close. pose_big_enough i. apply: (@lt_crealP _ (diff hxy) i i); rewrite ?diff_gt0 //. by rewrite (monoRL (addrK _) (lerD2r _)) add0r addrC diffP. by close. Qed. Lemma lt0_alg_total (x : alg) : x != zero_alg -> lt_alg zero_alg x || lt_alg x zero_alg. Proof. rewrite -[x]reprK !piE => /neq_algcrealP /= x_neq0. apply/orP; rewrite -!(rwP lt_algcrealP). case/neq_creal_ltVgt: x_neq0=> /= [lt_x0|lt_0x]; [right|by left]. pose_big_enough i. by apply: (@lt_crealP _ (diff lt_x0) i i); rewrite ?diff_gt0 ?diffP. by close. Qed. Lemma norm_algN x : norm_alg (- x) = norm_alg x. Proof. rewrite -[x]reprK !piE /= -equiv_alg !norm_algcrealE; apply: eq_crealP. exists_big_modulus m F=> [e i e_gt0 hi /=|]. by rewrite normrN subrr normr0. by close. Qed. Lemma ge0_norm_alg x : le_alg 0 x -> norm_alg x = x. Proof. by rewrite -[x]reprK !piE /= /norm_algcreal => ->. Qed. Lemma lt_alg0N (x : alg) : lt_alg 0 (- x) = lt_alg x 0. Proof. by rewrite -sub0r sub_alg_gt0. Qed. Lemma lt_alg00 : lt_alg zero_alg zero_alg = false. Proof. by have /implyP := @gt0_alg_nlt0 0; case: lt_alg. Qed. Lemma le_alg_def x y : le_alg x y = (x == y) || lt_alg x y. Proof. rewrite -[x]reprK -[y]reprK piE [lt_alg _ _]piE; apply/le_algcrealP/orP. move=> /le_creal_neqVlt [/eq_algcrealP/eqquotP/eqP-> //|lt_xy]; first by left. by right; apply/lt_algcrealP. by move=> [/eqP/eqquotP/eq_algcrealP-> //| /lt_algcrealP /lt_crealW]. Qed. HB.instance Definition _ := Num.IntegralDomain_isLtReal.Build alg add_alg_gt0 mul_alg_gt0 gt0_alg_nlt0 sub_alg_gt0 lt0_alg_total norm_algN ge0_norm_alg le_alg_def. Lemma lt_pi x y : \pi_alg x < \pi y = lt_algcreal x y. Proof. by rewrite [_ < _]lt_alg_pi. Qed. Lemma le_pi x y : \pi_alg x <= \pi y = le_algcreal x y. Proof. by rewrite [_ <= _]le_alg_pi. Qed. Lemma norm_pi (x : algcreal) : `|\pi_alg x| = \pi (norm_algcreal x). Proof. by rewrite [`|_|]piE. Qed. Lemma lt_algP (x y : algcreal) : reflect (x < y)%CR (\pi_alg x < \pi y). Proof. by rewrite lt_pi; apply: lt_algcrealP. Qed. Arguments lt_algP {x y}. Lemma le_algP (x y : algcreal) : reflect (x <= y)%CR (\pi_alg x <= \pi y). Proof. by rewrite le_pi; apply: le_algcrealP. Qed. Arguments le_algP {x y}. Prenex Implicits lt_algP le_algP. Lemma ler_to_alg : {mono to_alg : x y / x <= y}. Proof. apply: le_mono=> x y lt_xy; rewrite !piE -(rwP lt_algP). by apply/lt_creal_cst; rewrite lt_xy. Qed. Lemma ltr_to_alg : {mono to_alg : x y / x < y}. Proof. by apply: leW_mono; apply: ler_to_alg. Qed. Lemma normr_to_alg : { morph to_alg : x / `|x| }. Proof. move=> x /=; have [] := ger0P; have [] := ger0P x%:RA; rewrite ?rmorph0 ?rmorphN ?oppr0 //=. by rewrite ltr_to_alg leNgt => ->. by rewrite ler_to_alg ltNge => ->. Qed. Lemma inf_alg_proof x : {d | 0 < d & 0 < x -> (d%:RA < x)}. Proof. have [|] := lerP; first by exists 1. elim/quotW: x=> x; rewrite zeroE=> /lt_algP /= x_gt0. exists (diff x_gt0 / 2%:R); first by rewrite pmulr_rgt0 ?gtr0E ?diff_gt0. rewrite piE -(rwP lt_algP) /= => _; pose_big_enough i. apply: (@lt_crealP _ (diff x_gt0 / 2%:R) i i) => //. by rewrite pmulr_rgt0 ?gtr0E ?diff_gt0. by rewrite -[_ + _](splitf 2) diff0P. by close. Qed. Definition inf_alg (x : alg) : F := let: exist2 d _ _ := inf_alg_proof x in d. Lemma inf_alg_gt0 x : 0 < inf_alg x. Proof. by rewrite /inf_alg; case: inf_alg_proof. Qed. Lemma inf_lt_alg x : 0 < x -> (inf_alg x)%:RA < x. Proof. by rewrite /inf_alg=> x_gt0; case: inf_alg_proof=> d _ /(_ x_gt0). Qed. Lemma approx_proof x e : {y | 0 < e -> `|x - y%:RA| < e}. Proof. elim/quotW:x => x; pose_big_enough i. exists (x i)=> e_gt0; rewrite (lt_trans _ (inf_lt_alg _)) //. rewrite !piE norm_pi -(rwP lt_algP) /= norm_algcrealE /=. pose_big_enough j. apply: (@lt_crealP _ (inf_alg e / 2%:R) j j) => //. by rewrite pmulr_rgt0 ?gtr0E ?inf_alg_gt0. rewrite /= {2}[inf_alg e](splitf 2) /= lerD2r. by rewrite ltW // cauchymodP ?pmulr_rgt0 ?gtr0E ?inf_alg_gt0. by close. by close. Qed. Definition approx := locked (fun (x : alg) (e : alg) => projT1 (approx_proof x e) : F). Lemma approxP (x e e': alg) : 0 < e -> e <= e' -> `|x - (approx x e)%:RA| < e'. Proof. by unlock approx; case: approx_proof=> /= y hy /hy /lt_le_trans hy' /hy'. Qed. Lemma alg_archi : Num.archimedean_axiom alg. Proof. move=> x; move: {x}`|x| (normr_ge0 x) => x x_ge0. pose a := approx x 1%:RA; exists (Num.bound (a + 1)). have := @archi_boundP _ (a + 1); rewrite -ltr_to_alg rmorph_nat. have := @approxP x _ _ ltr01 (lexx _); rewrite ltr_distl -/a => /andP [_ hxa]. rewrite -ler_to_alg rmorphD /= (le_trans _ (ltW hxa)) //. by move=> /(_ isT) /(lt_trans _)->. Qed. HB.instance Definition _ := Num.NumDomain_bounded_isArchimedean.Build alg alg_archi. (**************************************************************************) (* At this stage, algebraics form an archimedian field. We now build the *) (* material to prove the intermediate value theorem. We first prove a *) (* "weak version", which expresses that the extension {alg F} indeed *) (* contains solutions of the intermediate value probelem in F *) (**************************************************************************) Notation "'Y" := 'X%:P. Lemma weak_ivt (p : {poly F}) (a b : F) : a <= b -> p.[a] <= 0 <= p.[b] -> { x : alg | a%:RA <= x <= b%:RA & root (p ^ to_alg) x }. Proof. move=> le_ab; have [-> _|p_neq0] := eqVneq p 0. by exists a%:RA; rewrite ?lexx ?ler_to_alg // rmorph0 root0. move=> /andP[pa_le0 pb_ge0]; apply/sig2W. have hpab: p.[a] * p.[b] <= 0 by rewrite mulr_le0_ge0. move=> {pa_le0 pb_ge0}; wlog monic_p : p hpab p_neq0 / p \is monic. set q := (lead_coef p) ^-1 *: p => /(_ q). rewrite !hornerZ mulrCA !mulrA -mulrA mulr_ge0_le0 //; last first. by rewrite (@exprn_even_ge0 _ 2). have mq: q \is monic by rewrite monicE lead_coefZ mulVf ?lead_coef_eq0. rewrite monic_neq0 ?mq=> // [] [] // x hx hqx; exists x=> //. move: hqx; rewrite /q -mul_polyC rmorphM /= rootM map_polyC rootC. by rewrite fmorph_eq0 invr_eq0 lead_coef_eq0 (negPf p_neq0). pose c := (a + b) / 2%:R; pose r := (b - a) / 2%:R. have r_ge0 : 0 <= r by rewrite mulr_ge0 ?ger0E // subr_ge0. have hab: ((c - r = a)%R * (c + r = b)%R)%type. rewrite -mulrDl -mulrBl opprD addrA addrK opprK. rewrite addrAC addrA [a + _ + _]addrAC subrr add0r. by rewrite !mulrDl -![_ + _](splitf 2). have hp: p.[c - r] * p.[c + r] <= 0 by rewrite !hab. pose x := AlgDom monic_p r_ge0 hp; exists (\pi_alg (to_algcreal x)). rewrite !piE; apply/andP; rewrite -!(rwP le_algP) /=. split; by do [ unlock to_algcreal=> /=; apply: (@le_crealP _ 0%N)=> /= j _; have := @to_algcreal_ofP p c r 0%N j r_ge0 isT; rewrite ler_distl /= expr0 divr1 !hab=> /andP []]. apply/rootP; rewrite horner_pi zeroE -equiv_alg horner_algcrealE /=. by rewrite -(@to_algcrealP x); unlock to_algcreal. Qed. (* any sequence of algebraic can be expressed as a sequence of polynomials in a unique algebraic *) Lemma pet_alg_proof (s : seq alg) : { ap : alg * seq {poly F} | [forall i : 'I_(size s), (ap.2`_i ^ to_alg).[ap.1] == s`_i] & size ap.2 = size s }. Proof. apply: sig2_eqW; elim: s; first by exists (0,[::])=> //; apply/forallP=> [] []. move=> x s [[a sp] /forallP /= hs hsize]. have:= char0_PET _ (root_annul_alg a) _ (root_annul_alg x). rewrite !annul_alg_neq0 => /(_ isT isT (char_num _)) /= [n [[p hp] [q hq]]]. exists (x *+ n - a, q :: [seq r \Po p | r <- sp]); last first. by rewrite /= size_map hsize. apply/forallP=> /=; rewrite -add1n=> i; apply/eqP. have [k->|l->] := splitP i; first by rewrite !ord1. rewrite add1n /= (nth_map 0) ?hsize // map_comp_poly /=. by rewrite horner_comp hp; apply/eqP. Qed. (****************************************************************************) (* Given a sequence s of algebraics (seq {alg F}) *) (* pet_alg == primitive algebraic *) (* pet_alg_poly == sequence of polynomials such that when instanciated in *) (* pet_alg gives back the sequence s (cf. pet_algK) *) (* *) (* Given a polynomial p on algebraic {poly {alg F}} *) (* pet_ground == bivariate polynomial such that when the inner *) (* variable ('Y) is instanciated in pet_alg gives back *) (* the polynomial p. *) (****************************************************************************) Definition pet_alg s : alg := let: exist2 (a, _) _ _ := pet_alg_proof s in a. Definition pet_alg_poly s : seq {poly F}:= let: exist2 (_, sp) _ _ := pet_alg_proof s in sp. Lemma size_pet_alg_poly s : size (pet_alg_poly s) = size s. Proof. by unlock pet_alg_poly; case: pet_alg_proof. Qed. Lemma pet_algK s i : ((pet_alg_poly s)`_i ^ to_alg).[pet_alg s] = s`_i. Proof. rewrite /pet_alg /pet_alg_poly; case: pet_alg_proof. move=> [a sp] /= /forallP hs hsize; have [lt_is|le_si] := ltnP i (size s). by rewrite -[i]/(val (Ordinal lt_is)); apply/eqP; apply: hs. by rewrite !nth_default ?hsize // rmorph0 horner0. Qed. Definition poly_ground := locked (fun (p : {poly alg}) => swapXY (Poly (pet_alg_poly p)) : {poly {poly F}}). Lemma sizeY_poly_ground p : sizeY (poly_ground p) = size p. Proof. unlock poly_ground; rewrite sizeYE swapXYK; have [->|p_neq0] := eqVneq p 0. apply/eqP; rewrite size_poly0 eqn_leq leq0n (leq_trans (size_Poly _)) //. by rewrite size_pet_alg_poly size_poly0. rewrite (@PolyK _ 0) -?nth_last ?size_pet_alg_poly //. have /eqP := (pet_algK p (size p).-1); apply: contraL=> /eqP->. by rewrite rmorph0 horner0 -lead_coefE eq_sym lead_coef_eq0. Qed. Lemma poly_ground_eq0 p : (poly_ground p == 0) = (p == 0). Proof. by rewrite -sizeY_eq0 sizeY_poly_ground size_poly_eq0. Qed. Lemma poly_ground0 : poly_ground 0 = 0. Proof. by apply/eqP; rewrite poly_ground_eq0. Qed. Lemma poly_groundK p : ((poly_ground p) ^ (map_poly to_alg)).[(pet_alg p)%:P] = p. Proof. have [->|p_neq0] := eqVneq p 0; first by rewrite poly_ground0 rmorph0 horner0. unlock poly_ground; rewrite horner_polyC /eval /= swapXY_map swapXYK. apply/polyP=> i /=; rewrite coef_map_id0 ?horner0 // coef_map /=. by rewrite coef_Poly pet_algK. Qed. Lemma annul_from_alg_proof (p : {poly alg}) (q : {poly F}) : p != 0 -> q != 0 -> root (q ^ to_alg) (pet_alg p) -> {r | resultant (poly_ground p) (r ^ polyC) != 0 & (r != 0) && (root (r ^ to_alg) (pet_alg p))}. Proof. move=> p_neq0; elim: (size q) {-2}q (leqnn (size q))=> {q} [|n ihn] q. by rewrite size_poly_leq0=> ->. move=> size_q q_neq0 hq; apply/sig2_eqW. have [|apq_neq0] := eqVneq (resultant (poly_ground p) (q ^ polyC)) 0; last first. by exists q=> //; rewrite q_neq0. move/eqP; rewrite resultant_eq0 ltn_neqAle eq_sym -coprimep_def. move=> /andP[] /(Bezout_coprimepPn _ _) []. + by rewrite poly_ground_eq0. + by rewrite map_polyC_eq0. move=> [u v] /and3P [] /andP [u_neq0 ltn_uq] v_neq0 ltn_vp hpq. rewrite ?size_map_polyC in ltn_uq ltn_vp. rewrite ?size_poly_gt0 in u_neq0 v_neq0. pose a := pet_alg p. have := erefl (size ((u * poly_ground p) ^ (map_poly to_alg)).[a%:P]). rewrite {2}hpq !{1}rmorphM /= !{1}hornerM poly_groundK -map_poly_comp /=. have /eq_map_poly-> : (map_poly to_alg) \o polyC =1 polyC \o to_alg. by move=> r /=; rewrite map_polyC. rewrite map_poly_comp horner_map (rootP hq) mulr0 size_poly0. move/eqP; rewrite size_poly_eq0 mulf_eq0 (negPf p_neq0) orbF. pose u' : {poly F} := lead_coef (swapXY u). have [/rootP u'a_eq0|u'a_neq0] := eqVneq (u' ^ to_alg).[a] 0; last first. rewrite horner_polyC -lead_coef_eq0 lead_coef_map_eq /=; by do ?rewrite swapXY_map /= lead_coef_map_eq /= ?map_poly_eq0 ?lead_coef_eq0 ?swapXY_eq0 ?(negPf u'a_neq0). have u'_neq0 : u' != 0 by rewrite lead_coef_eq0 swapXY_eq0. have size_u' : (size u' < size q)%N. by rewrite /u' (leq_ltn_trans (max_size_lead_coefXY _)) // sizeYE swapXYK. move: u'a_eq0=> /ihn [] //; first by rewrite -ltnS (leq_trans size_u'). by move=> r; exists r. Qed. Definition annul_pet_alg (p : {poly alg}) : {poly F} := if (p != 0) =P true is ReflectT p_neq0 then let: exist2 r _ _ := annul_from_alg_proof p_neq0 (annul_alg_neq0 _) (root_annul_alg _) in r else 0. Lemma root_annul_pet_alg p : root (annul_pet_alg p ^ to_alg) (pet_alg p). Proof. rewrite /annul_pet_alg; case: eqP=> /=; last by rewrite ?rmorph0 ?root0. by move=> p_neq0; case: annul_from_alg_proof=> ? ? /andP[]. Qed. Definition annul_from_alg p := if (size (poly_ground p) == 1)%N then lead_coef (poly_ground p) else resultant (poly_ground p) (annul_pet_alg p ^ polyC). Lemma annul_from_alg_neq0 p : p != 0 -> annul_from_alg p != 0. Proof. move=> p_neq0; rewrite /annul_from_alg. case: ifP; first by rewrite lead_coef_eq0 poly_ground_eq0. rewrite /annul_pet_alg; case: eqP p_neq0=> //= p_neq0 _. by case: annul_from_alg_proof. Qed. Lemma annul_pet_alg_neq0 p : p != 0 -> annul_pet_alg p != 0. Proof. rewrite /annul_pet_alg; case: eqP=> /=; last by rewrite ?rmorph0 ?root0. by move=> p_neq0; case: annul_from_alg_proof=> ? ? /andP[]. Qed. End RealAlg. Notation to_alg F := (@to_alg_def _ (Phant F)). Notation "x %:RA" := (to_alg _ x) (at level 2, left associativity, format "x %:RA"). Lemma upper_nthrootVP (F : archiFieldType) (x : F) (i : nat) : 0 < x -> (Num.bound (x ^-1) <= i)%N -> 2%:R ^- i < x. Proof. move=> x_gt0 hx; rewrite -ltf_pV2 -?topredE //= ?gtr0E //. by rewrite invrK upper_nthrootP. Qed. Notation "{ 'alg' F }" := (alg F). Section AlgAlg. Variable F : archiFieldType. Local Open Scope ring_scope. Local Notation "p ^ f" := (map_poly f p) : ring_scope. Local Notation "'Y" := 'X%:P. Local Notation m0 := (fun _ => 0%N). Definition approx2 (x : {alg {alg F}}) i := approx (approx x (2%:R ^- i)) (2%:R ^- i). Lemma asympt_approx2 x : { asympt e : i / `|(approx2 x i)%:RA%:RA - x| < e }. Proof. exists_big_modulus m {alg {alg F}}. move=> e i e_gt0 hi; rewrite distrC /approx2. rewrite (@split_dist_add _ (approx x (2%:R ^- i))%:RA) //. rewrite approxP ?gtr0E // ltW //. by rewrite upper_nthrootVP ?divrn_gt0 ?ltr_to_alg. rewrite (lt_trans _ (inf_lt_alg _)) ?divrn_gt0 //. rewrite -rmorphB -normr_to_alg ltr_to_alg approxP ?gtr0E // ltW //. by rewrite upper_nthrootVP ?divrn_gt0 ?inf_alg_gt0 ?ltr_to_alg. by close. Qed. Lemma from_alg_crealP (x : {alg {alg F}}) : creal_axiom (approx2 x). Proof. exists_big_modulus m F. move=> e i j e_gt0 hi hj; rewrite -2!ltr_to_alg !normr_to_alg !rmorphB /=. rewrite (@split_dist_add _ x) // ?[`|_ - _%:RA|]distrC; by rewrite (@asympt1modP _ _ (asympt_approx2 x)) ?divrn_gt0 ?ltr_to_alg. by close. Qed. Definition from_alg_creal := locked (fun x => CReal (from_alg_crealP x)). Lemma to_alg_crealP (x : creal F) : creal_axiom (fun i => to_alg F (x i)). Proof. exists_big_modulus m (alg F). move=> e i j e_gt0 hi hj. rewrite -rmorphB -normr_to_alg (lt_trans _ (inf_lt_alg _)) //. by rewrite ltr_to_alg cauchymodP ?inf_alg_gt0. by close. Qed. Definition to_alg_creal x := CReal (to_alg_crealP x). Lemma horner_to_alg_creal p x : ((p ^ to_alg F).[to_alg_creal x] == to_alg_creal p.[x])%CR. Proof. by apply: eq_crealP; exists m0=> * /=; rewrite horner_map subrr normr0. Qed. Lemma neq_to_alg_creal x y : (to_alg_creal x != to_alg_creal y)%CR <-> (x != y)%CR. Proof. split=> neq_xy. pose_big_enough i. apply: (@neq_crealP _ (inf_alg (lbound neq_xy)) i i) => //. by rewrite inf_alg_gt0. rewrite -ler_to_alg normr_to_alg rmorphB /= ltW //. by rewrite (lt_le_trans (inf_lt_alg _)) ?lbound_gt0 ?lboundP. by close. pose_big_enough i. apply: (@neq_crealP _ (lbound neq_xy)%:RA i i) => //. by rewrite ltr_to_alg lbound_gt0. by rewrite -rmorphB -normr_to_alg ler_to_alg lboundP. by close. Qed. Lemma eq_to_alg_creal x y : (to_alg_creal x == to_alg_creal y)%CR -> (x == y)%CR. Proof. by move=> hxy /neq_to_alg_creal. Qed. Lemma to_alg_creal0 : (to_alg_creal 0 == 0)%CR. Proof. by apply: eq_crealP; exists m0=> * /=; rewrite subrr normr0. Qed. Import Setoid. Add Morphism to_alg_creal with signature (@eq_creal _) ==> (@eq_creal _) as to_alg_creal_morph. Proof. by move=> x y hxy /neq_to_alg_creal. Qed. Global Existing Instance to_alg_creal_morph_Proper. Lemma to_alg_creal_repr (x : {alg F}) : (to_alg_creal (repr x) == x%:CR)%CR. Proof. apply: eq_crealP; exists_big_modulus m {alg F}. move=> e i e_gt0 hi /=; rewrite (le_lt_trans _ (inf_lt_alg _)) //. rewrite -{2}[x]reprK !piE norm_pi. rewrite -(rwP (le_algP _ _)) norm_algcrealE /=; pose_big_enough j. apply: (@le_crealP _ j)=> k hk /=. by rewrite ltW // cauchymodP ?inf_alg_gt0. by close. by close. Qed. Local Open Scope quotient_scope. Lemma cst_pi (x : algcreal F) : ((\pi_{alg F} x)%:CR == to_alg_creal x)%CR. Proof. apply: eq_crealP; exists_big_modulus m {alg F}. move=> e i e_gt0 hi /=; rewrite (lt_trans _ (inf_lt_alg _)) //. rewrite !piE norm_pi /= -(rwP (lt_algP _ _)) norm_algcrealE /=. pose_big_enough j. apply: (@lt_crealP _ (inf_alg e / 2%:R) j j) => //. by rewrite ?divrn_gt0 ?inf_alg_gt0. rewrite /= {2}[inf_alg _](splitf 2) lerD2r ltW // distrC. by rewrite cauchymodP ?divrn_gt0 ?inf_alg_gt0. by close. by close. Qed. End AlgAlg. Section AlgAlgAlg. Variable F : archiFieldType. Local Open Scope ring_scope. Local Notation "p ^ f" := (map_poly f p) : ring_scope. Local Notation "'Y" := 'X%:P. Lemma from_alg_crealK (x : {alg {alg F}}) : (to_alg_creal (to_alg_creal (from_alg_creal x)) == x%:CR)%CR. Proof. apply: eq_crealP; exists_big_modulus m {alg {alg F}}. move=> e i e_gt0 hi; unlock from_alg_creal=> /=. by rewrite (@asympt1modP _ _ (asympt_approx2 x)). by close. Qed. Lemma root_annul_from_alg_creal (x : {alg {alg F}}) : ((annul_from_alg (annul_alg x)).[from_alg_creal x] == 0)%CR. Proof. do 2!apply: eq_to_alg_creal. rewrite -!horner_to_alg_creal from_alg_crealK !to_alg_creal0. rewrite horner_creal_cst; apply/eq_creal_cst; rewrite -rootE. rewrite /annul_from_alg; have [/size_poly1P [c c_neq0 hc]|sp_neq1] := boolP (_ == _). set p := _ ^ _; suff ->: p = (annul_alg x) ^ to_alg _ by apply: root_annul_alg. congr (_ ^ _); rewrite -{2}[annul_alg x]poly_groundK /=. by rewrite !hc lead_coefC map_polyC /= hornerC. have [||[u v] /= [hu hv] hpq] := @resultant_in_ideal _ (poly_ground (annul_alg x)) (annul_pet_alg (annul_alg x) ^ polyC). + rewrite ltn_neqAle eq_sym sp_neq1 //= lt0n size_poly_eq0. by rewrite poly_ground_eq0 annul_alg_neq0. + rewrite size_map_polyC -(size_map_poly (to_alg _)) /=. rewrite (root_size_gt1 _ (root_annul_pet_alg _)) //. by rewrite map_poly_eq0 annul_pet_alg_neq0 ?annul_alg_neq0. move: hpq=> /(f_equal (map_poly (map_poly (to_alg _)))). rewrite map_polyC /= => /(f_equal (eval (pet_alg (annul_alg x))%:P)). rewrite {1}/eval hornerC !rmorphD !{1}rmorphM /= /eval /= => ->. rewrite -map_poly_comp /=. have /eq_map_poly->: (map_poly (@to_alg F)) \o polyC =1 polyC \o (@to_alg F). by move=> r /=; rewrite map_polyC. rewrite map_poly_comp horner_map /= (rootP (root_annul_pet_alg _)) mulr0 addr0. by rewrite rmorphM /= rootM orbC poly_groundK root_annul_alg. Qed. Lemma annul_alg_from_alg_creal_neq0 (x : {alg {alg F}}) : annul_from_alg (annul_alg x) != 0. Proof. by rewrite annul_from_alg_neq0 ?annul_alg_neq0. Qed. Definition from_alg_algcreal x := AlgCRealOf (@annul_alg_from_alg_creal_neq0 x) (@root_annul_from_alg_creal x). Definition from_alg : {alg {alg F}} -> {alg F} := locked (\pi%qT \o from_alg_algcreal). Lemma from_algK : cancel from_alg (to_alg _). Proof. move=> x; unlock from_alg; rewrite -{2}[x]reprK piE -equiv_alg /= cst_pi. by apply: eq_to_alg_creal; rewrite from_alg_crealK to_alg_creal_repr. Qed. Lemma ivt (p : {poly (alg F)}) (a b : alg F) : a <= b -> p.[a] <= 0 <= p.[b] -> exists2 x : alg F, a <= x <= b & root p x. Proof. move=> le_ab hp; have [x /andP [hax hxb]] := @weak_ivt _ _ _ _ le_ab hp. rewrite -[x]from_algK fmorph_root=> rpx; exists (from_alg x)=> //. by rewrite -ler_to_alg from_algK hax -ler_to_alg from_algK. Qed. HB.instance Definition _ := Num.RealField_isClosed.Build (alg F) ivt. End AlgAlgAlg. End RealAlg. HB.export RealAlg. Notation "{ 'realclosure' F }" := (RealAlg.alg F). Notation annul_realalg := RealAlg.annul_alg. Notation realalg_of F := (@RealAlg.to_alg_def _ (Phant F)). Notation "x %:RA" := (realalg_of x) (at level 2, left associativity, format "x %:RA"). HB.instance Definition _ (F : archiFieldType) := GRing.RMorphism.on (to_alg F). Section RealClosureTheory. Variable F : archiFieldType. Notation R := {realclosure F}. Local Notation "p ^ f" := (map_poly f p) : ring_scope. Lemma root_annul_realalg (x : R) : root ((annul_realalg x) ^ realalg_of _) x. Proof. exact: RealAlg.root_annul_alg. Qed. Hint Resolve root_annul_realalg : core. Lemma monic_annul_realalg (x : R) : annul_realalg x \is monic. Proof. exact: RealAlg.monic_annul_alg. Qed. Hint Resolve monic_annul_realalg : core. Lemma annul_realalg_neq0 (x : R) : annul_realalg x != 0%R. Proof. exact: RealAlg.annul_alg_neq0. Qed. Hint Resolve annul_realalg_neq0 : core. Lemma realalg_algebraic : integralRange (realalg_of F). Proof. by move=> x; exists (annul_realalg x). Qed. End RealClosureTheory. Definition realalg := {realclosure rat}. HB.instance Definition _ := Num.RealClosedField.on realalg. Module RatRealAlg. HB.instance Definition _ := Countable.copy (RealAlg.algdom rat) (pcan_type (@RealAlg.encode_algdomK rat)). #[export] HB.instance Definition _ := Countable.on realalg. End RatRealAlg. HB.export RatRealAlg.