diff --git a/.github/workflows/nix-action-8.16.yml b/.github/workflows/nix-action-8.16.yml index c43bafa..4c193d1 100644 --- a/.github/workflows/nix-action-8.16.yml +++ b/.github/workflows/nix-action-8.16.yml @@ -8,7 +8,7 @@ jobs: \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ \ }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.target_commit }} @@ -22,16 +22,16 @@ jobs: \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install - uses: cachix/install-nix-action@v20 + uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp - uses: cachix/cachix-action@v12 + uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community @@ -56,7 +56,7 @@ jobs: \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ \ }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.target_commit }} @@ -70,16 +70,16 @@ jobs: \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install - uses: cachix/install-nix-action@v20 + uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp - uses: cachix/cachix-action@v12 + uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community @@ -136,7 +136,7 @@ jobs: \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ \ }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.target_commit }} @@ -150,16 +150,16 @@ jobs: \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install - uses: cachix/install-nix-action@v20 + uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp - uses: cachix/cachix-action@v12 + uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community @@ -206,6 +206,18 @@ jobs: name: 'Building/fetching previous CI target: mathcomp-real-closed' run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr job "mathcomp-real-closed" + - 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.16" --argstr + job "multinomials" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-classical' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr + job "mathcomp-classical" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-analysis' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr + job "mathcomp-analysis" - if: steps.stepCheck.outputs.status == 'built' name: Building/fetching current CI target run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.16" --argstr diff --git a/.github/workflows/nix-action-8.17.yml b/.github/workflows/nix-action-8.17.yml index c5a7599..ac6b64c 100644 --- a/.github/workflows/nix-action-8.17.yml +++ b/.github/workflows/nix-action-8.17.yml @@ -8,7 +8,7 @@ jobs: \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ \ }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.target_commit }} @@ -22,16 +22,16 @@ jobs: \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install - uses: cachix/install-nix-action@v20 + uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp - uses: cachix/cachix-action@v12 + uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community @@ -56,7 +56,7 @@ jobs: \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ \ }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.target_commit }} @@ -70,16 +70,16 @@ jobs: \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install - uses: cachix/install-nix-action@v20 + uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp - uses: cachix/cachix-action@v12 + uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community @@ -136,7 +136,7 @@ jobs: \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ \ }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.target_commit }} @@ -150,16 +150,16 @@ jobs: \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install - uses: cachix/install-nix-action@v20 + uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp - uses: cachix/cachix-action@v12 + uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community @@ -206,6 +206,18 @@ jobs: 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: 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-classical' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "mathcomp-classical" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-analysis' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.17" --argstr + job "mathcomp-analysis" - 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 diff --git a/.github/workflows/nix-action-8.18.yml b/.github/workflows/nix-action-8.18.yml index 3f677cb..0f70c76 100644 --- a/.github/workflows/nix-action-8.18.yml +++ b/.github/workflows/nix-action-8.18.yml @@ -8,7 +8,7 @@ jobs: \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ \ }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.target_commit }} @@ -22,16 +22,16 @@ jobs: \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install - uses: cachix/install-nix-action@v20 + uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp - uses: cachix/cachix-action@v12 + uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community @@ -56,7 +56,7 @@ jobs: \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ \ }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.target_commit }} @@ -70,16 +70,16 @@ jobs: \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install - uses: cachix/install-nix-action@v20 + uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp - uses: cachix/cachix-action@v12 + uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community @@ -136,7 +136,7 @@ jobs: \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ \ }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.target_commit }} @@ -150,16 +150,16 @@ jobs: \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install - uses: cachix/install-nix-action@v20 + uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp - uses: cachix/cachix-action@v12 + uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community @@ -206,6 +206,18 @@ jobs: 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: 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-classical' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "mathcomp-classical" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-analysis' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.18" --argstr + job "mathcomp-analysis" - 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 diff --git a/.github/workflows/nix-action-8.19.yml b/.github/workflows/nix-action-8.19.yml index 111bf3c..92098d7 100644 --- a/.github/workflows/nix-action-8.19.yml +++ b/.github/workflows/nix-action-8.19.yml @@ -8,7 +8,7 @@ jobs: \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ \ }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.target_commit }} @@ -22,16 +22,16 @@ jobs: \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install - uses: cachix/install-nix-action@v20 + uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp - uses: cachix/cachix-action@v12 + uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community @@ -56,7 +56,7 @@ jobs: \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ \ }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.target_commit }} @@ -70,16 +70,16 @@ jobs: \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install - uses: cachix/install-nix-action@v20 + uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp - uses: cachix/cachix-action@v12 + uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community @@ -136,7 +136,7 @@ jobs: \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ \ }}\" >> $GITHUB_ENV\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.target_commit }} @@ -150,16 +150,16 @@ jobs: \ \"tested_commit=${{ github.event.pull_request.head.sha }}\" >> $GITHUB_ENV\n\ \ else\n echo \"tested_commit=$merge_commit\" >> $GITHUB_ENV\n fi\nfi\n" - name: Git checkout - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 ref: ${{ env.tested_commit }} - name: Cachix install - uses: cachix/install-nix-action@v20 + uses: cachix/install-nix-action@v27 with: nix_path: nixpkgs=channel:nixpkgs-unstable - name: Cachix setup math-comp - uses: cachix/cachix-action@v12 + uses: cachix/cachix-action@v15 with: authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} extraPullNames: coq, coq-community @@ -206,6 +206,18 @@ jobs: 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: 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-classical' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr + job "mathcomp-classical" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-analysis' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.19" --argstr + job "mathcomp-analysis" - 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 diff --git a/.github/workflows/nix-action-8.20.yml b/.github/workflows/nix-action-8.20.yml new file mode 100644 index 0000000..873f390 --- /dev/null +++ b/.github/workflows/nix-action-8.20.yml @@ -0,0 +1,239 @@ +jobs: + coq: + needs: [] + runs-on: ubuntu-latest + steps: + - name: Determine which commit to initially checkout + run: "if [ ${{ github.event_name }} = \"push\" ]; then\n echo \"target_commit=${{\ + \ github.sha }}\" >> $GITHUB_ENV\nelse\n echo \"target_commit=${{ github.event.pull_request.head.sha\ + \ }}\" >> $GITHUB_ENV\nfi\n" + - name: Git checkout + uses: actions/checkout@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" + 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-cad: + 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-cad + run: "nb_dry_run=$(NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link \\\n --argstr\ + \ bundle \"8.20\" --argstr job \"mathcomp-cad\" \\\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-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 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-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: 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-classical' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr + job "mathcomp-classical" + - if: steps.stepCheck.outputs.status == 'built' + name: 'Building/fetching previous CI target: mathcomp-analysis' + run: NIXPKGS_ALLOW_UNFREE=1 nix-build --no-out-link --argstr bundle "8.20" --argstr + job "mathcomp-analysis" + - 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-cad" +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 diff --git a/.gitignore b/.gitignore index d3083b3..198c468 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,5 @@ -*.vo +*.vo* *.glob *.v.d +*~ +*.aux diff --git a/.nix/config.nix b/.nix/config.nix index f46f5f6..86625e1 100644 --- a/.nix/config.nix +++ b/.nix/config.nix @@ -38,14 +38,6 @@ ## When generating GitHub Action CI, one workflow file ## will be created per bundle bundles = { - "8.16" = { - coqPackages.coq.override.version = "8.16"; - coqPackages.mathcomp.override.version = "2.2.0"; - }; - "8.17" = { - coqPackages.coq.override.version = "8.17"; - coqPackages.mathcomp.override.version = "2.2.0"; - }; "8.18" = { coqPackages.coq.override.version = "8.18"; coqPackages.mathcomp.override.version = "2.2.0"; @@ -54,6 +46,10 @@ coqPackages.coq.override.version = "8.19"; coqPackages.mathcomp.override.version = "2.2.0"; }; + "8.20" = { + coqPackages.coq.override.version = "8.20"; + coqPackages.mathcomp.override.version = "2.2.0"; + }; }; ## Cachix caches to use in CI diff --git a/.nix/coq-nix-toolbox.nix b/.nix/coq-nix-toolbox.nix index cdda838..95cb895 100644 --- a/.nix/coq-nix-toolbox.nix +++ b/.nix/coq-nix-toolbox.nix @@ -1 +1 @@ -"e37bb6e0802afb4c94b33c08d72200adc921c527" +"a996cd700733fdd54c96ef3a1147cd844fb12cf1" diff --git a/.nix/coq-overlays/mathcomp-cad/default.nix b/.nix/coq-overlays/mathcomp-cad/default.nix index f70a3b7..adbcf34 100644 --- a/.nix/coq-overlays/mathcomp-cad/default.nix +++ b/.nix/coq-overlays/mathcomp-cad/default.nix @@ -1,5 +1,6 @@ { coq, mkCoqDerivation, mathcomp, mathcomp-bigenough -, mathcomp-finmap, mathcomp-real-closed +, mathcomp-finmap, mathcomp-real-closed, multinomials +, mathcomp-classical, mathcomp-analysis , lib, version ? null }: mkCoqDerivation { @@ -20,6 +21,9 @@ mkCoqDerivation { mathcomp-bigenough mathcomp-finmap mathcomp-real-closed + multinomials + mathcomp-classical + mathcomp-analysis ]; meta = { diff --git a/Make b/Make deleted file mode 100644 index 25653f3..0000000 --- a/Make +++ /dev/null @@ -1,8 +0,0 @@ -extra_ssr.v -subresultant.v -auxresults.v -semialgebraic.v - --R "." SemiAlgebraic - - diff --git a/Makefile b/Makefile index 15ecd47..d5aa0bf 100644 --- a/Makefile +++ b/Makefile @@ -1,309 +1,4 @@ -############################################################################# -## v # The Coq Proof Assistant ## -## $@ - printf 'cd "$${DSTROOT}"$(COQLIBINSTALL)/SemiAlgebraic && rm -f $(VOFILES) $(VFILES) $(GLOBFILES) $(NATIVEFILES) $(CMOFILES) $(CMIFILES) $(CMAFILES) && find . -type d -and -empty -delete\ncd "$${DSTROOT}"$(COQLIBINSTALL) && find "SemiAlgebraic" -maxdepth 0 -and -empty -exec rmdir -p \{\} \;\n' >> "$@" - printf 'cd "$${DSTROOT}"$(COQDOCINSTALL)/SemiAlgebraic \\\n' >> "$@" - printf '&& rm -f $(shell find "html" -maxdepth 1 -and -type f -print)\n' >> "$@" - printf 'cd "$${DSTROOT}"$(COQDOCINSTALL) && find SemiAlgebraic/html -maxdepth 0 -and -empty -exec rmdir -p \{\} \;\n' >> "$@" - chmod +x $@ - -uninstall: uninstall_me.sh - sh $< - -.merlin: - @echo 'FLG -rectypes' > .merlin - @echo "B $(COQLIB)kernel" >> .merlin - @echo "B $(COQLIB)lib" >> .merlin - @echo "B $(COQLIB)library" >> .merlin - @echo "B $(COQLIB)parsing" >> .merlin - @echo "B $(COQLIB)pretyping" >> .merlin - @echo "B $(COQLIB)interp" >> .merlin - @echo "B $(COQLIB)printing" >> .merlin - @echo "B $(COQLIB)intf" >> .merlin - @echo "B $(COQLIB)proofs" >> .merlin - @echo "B $(COQLIB)tactics" >> .merlin - @echo "B $(COQLIB)tools" >> .merlin - @echo "B $(COQLIB)ltacprof" >> .merlin - @echo "B $(COQLIB)toplevel" >> .merlin - @echo "B $(COQLIB)stm" >> .merlin - @echo "B $(COQLIB)grammar" >> .merlin - @echo "B $(COQLIB)config" >> .merlin - @echo "B $(COQLIB)ltac" >> .merlin - @echo "B $(COQLIB)engine" >> .merlin - -clean:: - rm -f $(OBJFILES) $(OBJFILES:.o=.native) $(NATIVEFILES) - find . -name .coq-native -type d -empty -delete - rm -f $(VOFILES) $(VOFILES:.vo=.vio) $(GFILES) $(VFILES:.v=.v.d) $(VFILES:=.beautified) $(VFILES:=.old) - rm -f all.ps all-gal.ps all.pdf all-gal.pdf all.glob $(VFILES:.v=.glob) $(VFILES:.v=.tex) $(VFILES:.v=.g.tex) all-mli.tex - - rm -rf html mlihtml uninstall_me.sh - -cleanall:: clean - rm -f $(patsubst %.v,.%.aux,$(VFILES)) - -archclean:: - rm -f *.cmx *.o - -printenv: - @"$(COQBIN)coqtop" -config - @echo 'OCAMLFIND = $(OCAMLFIND)' - @echo 'PP = $(PP)' - @echo 'COQFLAGS = $(COQFLAGS)' - @echo 'COQLIBINSTALL = $(COQLIBINSTALL)' - @echo 'COQDOCINSTALL = $(COQDOCINSTALL)' - -Makefile: Make - mv -f $@ $@.bak - "$(COQBIN)coq_makefile" -f $< -o $@ - - -################### -# # -# Implicit rules. # -# # -################### - -$(VOFILES): %.vo: %.v - $(SHOW)COQC $< - $(HIDE)$(COQC) $(COQDEBUG) $(COQFLAGS) $< - -$(GLOBFILES): %.glob: %.v - $(COQC) $(COQDEBUG) $(COQFLAGS) $< - -$(VFILES:.v=.vio): %.vio: %.v - $(COQC) -quick $(COQDEBUG) $(COQFLAGS) $< - -$(GFILES): %.g: %.v - $(GALLINA) $< - -$(VFILES:.v=.tex): %.tex: %.v - $(COQDOC) $(COQDOCFLAGS) -latex $< -o $@ - -$(HTMLFILES): %.html: %.v %.glob - $(COQDOC) $(COQDOCFLAGS) -html $< -o $@ - -$(VFILES:.v=.g.tex): %.g.tex: %.v - $(COQDOC) $(COQDOCFLAGS) -latex -g $< -o $@ - -$(GHTMLFILES): %.g.html: %.v %.glob - $(COQDOC) $(COQDOCFLAGS) -html -g $< -o $@ - -$(addsuffix .d,$(VFILES)): %.v.d: %.v - $(SHOW)'COQDEP $<' - $(HIDE)$(COQDEP) $(COQLIBS) "$<" > "$@" || ( RV=$$?; rm -f "$@"; exit $${RV} ) - -$(addsuffix .beautified,$(VFILES)): %.v.beautified: - $(COQC) $(COQDEBUG) $(COQFLAGS) -beautify $*.v - -# WARNING -# -# This Makefile has been automagically generated -# Edit at your own risks ! -# -# END OF WARNING +# -*- Makefile -*- +# -------------------------------------------------------------------- +include Makefile.common diff --git a/Makefile.common b/Makefile.common new file mode 100644 index 0000000..9d4b257 --- /dev/null +++ b/Makefile.common @@ -0,0 +1,142 @@ +# -*- Makefile -*- + +###################################################################### +# USAGE: # +# The rules this-config::, this-build::, this-distclean::, # +# pre-makefile::, this-clean:: and __always__:: may be extended # +# Additionally, the following variables may be customized: # +SUBDIRS?= +COQBIN?=$(dir $(shell which coqtop)) +COQMAKEFILE?=$(COQBIN)coq_makefile +COQDEP?=$(COQBIN)coqdep +COQPROJECT?=_CoqProject +COQMAKEOPTIONS?= +COQMAKEFILEOPTIONS?= +V?= +VERBOSE?=V +###################################################################### + +# local context: ----------------------------------------------------- +.PHONY: all config build clean distclean __always__ +.SUFFIXES: + +H:= $(if $(VERBOSE),,@) # not used yet +TOP = $(dir $(lastword $(MAKEFILE_LIST))) +COQMAKE = $(MAKE) -f Makefile.coq $(COQMAKEOPTIONS) +BRANCH_coq:= $(shell $(COQBIN)coqtop -v | head -1 | grep -E '(trunk|master)' \ + | wc -l | sed 's/ *//g') + +# coq version: +ifneq "$(BRANCH_coq)" "0" +COQVVV:= dev +else +COQVVV:=$(shell $(COQBIN)coqtop --print-version | cut -d" " -f1) +endif + +COQV:= $(shell echo $(COQVVV) | cut -d"." -f1) +COQVV:= $(shell echo $(COQVVV) | cut -d"." -f1-2) + +# all: --------------------------------------------------------------- +all: config build + +# Makefile.coq: ------------------------------------------------------ +.PHONY: pre-makefile + +Makefile.coq: pre-makefile $(COQPROJECT) Makefile + $(COQMAKEFILE) $(COQMAKEFILEOPTIONS) -f $(COQPROJECT) -o Makefile.coq + +# Global config, build, clean and distclean -------------------------- +config: sub-config this-config + +build: sub-build this-build + +clean: sub-clean this-clean + +distclean: sub-distclean this-distclean + +# Local config, build, clean and distclean --------------------------- +.PHONY: this-config this-build this-distclean this-clean + +this-config:: __always__ + +this-build:: this-config Makefile.coq + +$(COQMAKE) + +this-distclean:: this-clean + rm -f Makefile.coq Makefile.coq.conf Makefile.coq + +this-clean:: __always__ + @if [ -f Makefile.coq ]; then $(COQMAKE) cleanall; fi + +# Install target ----------------------------------------------------- +.PHONY: install + +install: __always__ Makefile.coq + $(COQMAKE) install +# counting lines of Coq code ----------------------------------------- +.PHONY: count + +COQFILES = $(shell grep '.v$$' $(COQPROJECT)) + +count: + @coqwc $(COQFILES) | tail -1 | \ + awk '{printf ("%d (spec=%d+proof=%d)\n", $$1+$$2, $$1, $$2)}' +# Additionally cleaning backup (*~) files ---------------------------- +this-distclean:: + rm -f $(shell find . -name '*~') + +# Make in SUBDIRS ---------------------------------------------------- +ifdef SUBDIRS +sub-%: __always__ + @set -e; for d in $(SUBDIRS); do +$(MAKE) -C $$d $(@:sub-%=%); done +else +sub-%: __always__ + @true +endif + +# Make of individual .vo --------------------------------------------- +%.vo: __always__ Makefile.coq + +$(COQMAKE) $@ + +# the doc targets doc and doc-clean are essentially copied from the Mathematical +# Components repository +# we reuse the scripts from the math-comp git repo (which is hard wired) +# modulo one fix: we change builddoc_lib.sh:l.18 to s/\(\*{5,}+\)//g; + +MATHCOMP = ../math-comp/ + +doc: __always__ Makefile.coq + mkdir -p _build_doc/ + cp -r $(COQFILES) -t _build_doc/ --parents + cp _CoqProject Makefile* _build_doc + mkdir -p _build_doc/htmldoc + . $(MATHCOMP)etc/utils/builddoc_lib.sh; \ + cd _build_doc && mangle_sources $(COQFILES) + +cd _build_doc && $(COQMAKE) +# let's forget about the dependency graph for the time being... +# cd _build_doc && grep -v vio: .Makefile.coq.d > depend +# cd _build_doc && cat depend | $(MATHCOMP)etc/buildlibgraph $(COQFILES) > htmldoc/depend.js + cd _build_doc && $(COQBIN)coqdoc -t "MathComp Analysis" \ + -g --utf8 -R classical mathcomp.classical -R theories mathcomp.analysis \ + --parse-comments \ + --multi-index $(COQFILES) -d htmldoc + . $(MATHCOMP)etc/utils/builddoc_lib.sh; \ + cd _build_doc && postprocess_html + cp $(MATHCOMP)etc/artwork/coqdoc.css _build_doc/htmldoc + +doc-clean: + rm -rf _build_doc/ + +coq2html: + ../coq2html/coq2html \ + -fragile-mathcomp-break \ + -title "Mathcomp Analysis" \ + -d html/ -base mathcomp -Q theories analysis \ + -coqlib https://coq.inria.fr/doc/V8.18.0/stdlib/ \ + -external https://math-comp.github.io/htmldoc/ mathcomp.ssreflect \ + -external https://math-comp.github.io/htmldoc/ mathcomp.algebra \ + classical/*.v classical/*.glob \ + theories/*.v theories/*.glob + +coq2html-clean: + rm -f */*.glob diff --git a/_CoqProject b/_CoqProject index 505d428..2d9eae3 100644 --- a/_CoqProject +++ b/_CoqProject @@ -1 +1,12 @@ --R . SemiAlgebraic +extra_ssr.v +subresultant.v +auxresults.v +formula.v +continuity_roots.v +semialgebraic.v +topology.v +cylinder.v + +-R "." SemiAlgebraic + + diff --git a/auxresults.v b/auxresults.v index e78dbc7..89240fb 100644 --- a/auxresults.v +++ b/auxresults.v @@ -1,13 +1,22 @@ (* (c) Copyright Microsoft Corporation and Inria. All rights reserved. *) +From HB Require Import structures. From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq choice. -From mathcomp Require Import fintype generic_quotient. -From mathcomp Require Import div tuple bigop ssralg poly polydiv finmap. +From mathcomp Require Import order fintype generic_quotient path ssrint. +From mathcomp Require Import div tuple bigop ssralg ssrnum matrix poly polydiv. +From mathcomp Require Import interval finmap mpoly polyorder polyrcf normedtype. +From mathcomp Require Import complex classical_sets topology qe_rcf_th. +Import numFieldTopology.Exports. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GRing.Theory. +Import GRing.Theory Order.TotalTheory Order.POrderTheory Num.Theory. + +Ltac mp := + match goal with + | |- (?x -> _) -> _ => have /[swap]/[apply]: x + end. Section MoreLogic. @@ -22,6 +31,43 @@ Proof. by move=> h; split => h1 h2; apply/h/h1. Qed. Lemma if_iff_compat_r : B <-> C -> (B -> A) <-> (C -> A). Proof. by move=> h; split => h1 h2; apply/h1/h. Qed. +Lemma bool_eq_arrow {b b' : bool} : b = b' -> b -> b'. +Proof. by case: b' => // /negP. Qed. + +Lemma forallb_all [n : nat] (a : pred 'I_n) : + [forall i, a i] = all a (enum 'I_n). +Proof. +apply/forallP/allP => /= aT i //. +by apply/aT; rewrite mem_enum. +Qed. + +Lemma forall_ord0 (P : pred 'I_0) : [forall i, P i] = true. +Proof. by apply/forallP; case. Qed. + +Lemma forall_ord1 (p : pred 'I_1) : + [forall i : 'I_1, p i] = p ord0. +Proof. by rewrite forallb_all enum_ordSl enum_ord0/= andbT. Qed. +(* Alternative proof: +apply/forallP/idP => [/(_ ord0) //|p0]. +by case; case=> // ilt; move: p0; congr p; apply/val_inj. + *) + +Lemma forall_ord2 (P : 'I_2 -> bool) : + [forall i, P i] = (P ord0 && P ord_max). +Proof. +rewrite forallb_all !enum_ordSl enum_ord0/= andbT. +by congr (_ && P _); apply/val_inj. +Qed. +(* Alternative proof: +apply/forallP/andP => [p //|[] p0 p1 /=]. +case; case=> [ilt|[ilt|//]]. + by move: p0; congr P; apply/val_inj. +by move: p1; congr P; apply/val_inj. + *) + +Lemma eq_mem_sym (T : Type) (p1 p2 :mem_pred T) : p1 =i p2 -> p2 =i p1. +Proof. by move=> h x; rewrite h. Qed. + End MoreLogic. Section MoreNatTheory. @@ -29,12 +75,21 @@ Section MoreNatTheory. Lemma lt_predn n : (n.-1 < n) = (n != 0). Proof. by case: n => [//|n]; rewrite ltnSn. Qed. +Lemma ltn_neq (n m : nat) : (n < m)%N -> n != m. +Proof. by rewrite ltn_neqAle => /andP[]. Qed. + Fact n_eq1 n : n != 0 -> n < 2 -> n = 1. Proof. by case: n => [?|[?|[]]]. Qed. Fact leq_npred m n : m > 0 -> (m <= n.-1) = (m < n). Proof. by move: m n => [|m] [|n]. Qed. +Lemma leq_predn n m : (n <= m)%N -> (n.-1 <= m.-1)%N. +Proof. +case: n => [//|n]; case: m => [//|m]. +by rewrite !succnK ltnS. +Qed. + Fact predn_sub m n : (m - n).-1 = (m.-1 - n). Proof. by case: m => //= m; rewrite subSKn. Qed. @@ -87,6 +142,16 @@ move=> leq_mn; rewrite addnC -leq_subLR => h. by rewrite (leq_trans _ h) // -addnBA // leq_addr. Qed. +Lemma lift_inord (n : nat) (i : 'I_n) : + lift ord0 i = inord i.+1. +Proof. by apply/val_inj; rewrite /= inordK ?ltnS. Qed. + +Lemma subn_prednn n m : (0 < m)%N -> (n.-1 - m.-1)%N = (n - m)%N. +Proof. by case: m => [//|m _]; rewrite succnK -predn_sub subnS. Qed. + +Lemma subn_pred n m : (0 < m)%N -> (m <= n)%N -> (n - m.-1)%N = (n - m).+1. +Proof. by move=> m0 mn; rewrite -{1}[n]succnK subn_prednn// subSn. Qed. + End MoreNatTheory. Section MoreSeq. @@ -132,7 +197,17 @@ Lemma rev_ncons (n : nat) (x : T) (s : seq T) : rev (ncons n x s) = rev s ++ nseq n x. Proof. by rewrite -cat_nseq rev_cat rev_nseq. Qed. -Lemma rcons_set_nth (x y : T) (s : seq T) : (set_nth y s (size s) x) = rcons s x. +Lemma set_nth_rcons (d : T) (i : nat) (e : seq T) (x y : T) : + (i < size e)%N -> set_nth d (rcons e y) i x = rcons (set_nth d e i x) y. +Proof. +move: i x y; elim: e => //. +move=> a e ihe i; elim: i => //. +move=> i ihi x y /=. +by rewrite ltnS => lt_ie; rewrite ihe. +Qed. + +Lemma rcons_set_nth (x y : T) (s : seq T) : + (set_nth y s (size s) x) = rcons s x. Proof. by elim: s => //= a s <-. Qed. Fact set_nthS (e : seq T) (i : nat) (x y : T) : @@ -184,23 +259,14 @@ Proof. by move=> h; rewrite set_nth_nrcons //; congr rcons; rewrite nseq_cat. Qed. -Lemma set_nth_nseq (i j : nat) (x y z : T) : - (i <= j)%N -> set_nth x (nseq j y) i z = (rcons (nseq i y) z) ++ (nseq (j - i).-1 y). +Lemma set_nth_nseq (i j : nat) (x y z : T) : (i <= j)%N -> + set_nth x (nseq j y) i z = (rcons (nseq i y) z) ++ (nseq (j - i).-1 y). Proof. move: i x y z; elim: j => [|j ih] i x y z; first by rewrite leqn0 => /eqP ->. case: i => [_|i leq_ij] //=. by rewrite ih. Qed. -Lemma set_nth_rcons (i : nat) (e : seq T) (a x y : T) : - (i < size e)%N -> set_nth a (rcons e y) i x = rcons (set_nth a e i x) y. -Proof. -move: i x y; elim: e => //. -move=> b e ih i; elim: i => //. -move=> i ih2 x y /=. -by rewrite ltnS => lt_ie ; rewrite ih. -Qed. - (* Fact fv_nquantify (m n i : nat) (f : formula F) : *) (* (m <= i < m+n)%N -> i \notin formula_fv (nquantify m n Exists f). *) (* Proof. *) @@ -212,7 +278,8 @@ Lemma set_nth_catr (i : nat) (e1 e2 : seq T) (x y : T) : (size e1 <= i)%N -> set_nth x (e1 ++ e2) i y = e1 ++ (set_nth x e2 (i - (size e1)) y). Proof. -move: i e2 y; elim/last_ind: e1 => [i e2 y _ |e1 b ih i e2 y]; rewrite ?subn0 //. +move: i e2 y; elim/last_ind: e1 => [i e2 y _ |e1 b ih i e2 y]. + by rewrite subn0. rewrite size_rcons=> h; rewrite cat_rcons. rewrite ih; last by rewrite ltnW. by rewrite cat_rcons -[(i - size e1)%N]prednK ?subn_gt0 // subnS. @@ -222,7 +289,7 @@ Lemma set_nth_catl (i : nat) (e1 e2 : seq T) (x y : T) : (i < size e1)%N -> set_nth x (e1 ++ e2) i y = set_nth x e1 i y ++ e2. Proof. move: i e1 y; elim/last_ind : e2 => [i e1| e2 z ih i e1] y h; rewrite ?cats0 //. -rewrite -rcons_cat set_nth_rcons ?size_cat ?(leq_trans h) // ?leq_addr //. +rewrite -rcons_cat set_nth_rcons ?size_cat ?(leq_trans h) // ?leq_addr //. by rewrite ih // rcons_cat //. Qed. @@ -262,9 +329,9 @@ rewrite ltnS => lt_ji. by rewrite /= ltnS => lt_ie; rewrite ihe. Qed. -Lemma set_nth_take (i : nat) (e : seq T) (j : nat) (x y : T) :(i <= j)%N -> -set_nth x (take i e) j y - = rcons ((take i (set_nth x e j y)) ++ (nseq (j - i) x)) y. +Lemma set_nth_take (i : nat) (e : seq T) (j : nat) (x y : T) : (i <= j)%N -> + set_nth x (take i e) j y + = rcons ((take i (set_nth x e j y)) ++ (nseq (j - i) x)) y. Proof. move: i j; elim: e => // [i j leq_ij | a e ihe i]. - rewrite //= !set_nth_nil -cat_nseq take_cat size_nseq. @@ -280,12 +347,141 @@ move: i j; elim: e => // [i j leq_ij | a e ihe i]. by rewrite ltnS => lt_iSj /=; rewrite ihe. Qed. +Lemma eq_iotar (a c b d : nat) : iota a b =i iota c d -> b = d. +Proof. +move=> eq_ab_cd; rewrite -(size_iota a b) -(size_iota c d). +by apply/eqP; rewrite -uniq_size_uniq ?iota_uniq. +Qed. + +Lemma eq_mem_nil (U : eqType) (s : seq U) : reflect (s =i [::]) (s == [::]). +Proof. +apply: (iffP idP); first by move/eqP ->. +move=> h; apply/eqP/nilP; rewrite /nilp -all_pred0. +by apply/allP => /= x; rewrite h. +Qed. + +Lemma eq_iotal (b d a c : nat) : b != O -> iota a b =i iota c d -> a = c. +Proof. +case: b => // b _; case: d => [/eq_mem_nil//|d eq_ab_cd]. +wlog suff hwlog : b d a c eq_ab_cd / (a <= c)%N. + by apply/eqP; rewrite eqn_leq (hwlog b d) ?(hwlog d b). +have := eq_ab_cd c; rewrite !in_cons eqxx /= mem_iota. +by case: ltngtP => [| /ltnW leq_ac|->]. +Qed. + +Arguments eq_iotal {_} _ {_ _} _ _. + +Lemma iotanS (n m : nat) : + iota n m.+1 = rcons (iota n m) (n + m)%N. +Proof. +elim: m n => /= [|m IHm] n; first by rewrite addn0. +by rewrite IHm addSn addnS. +Qed. + +Lemma nth_enum_ord (n : nat) (i j : 'I_n) : nth i (enum 'I_n) j = j. +Proof. by apply/val_inj => /=; rewrite nth_enum_ord. Qed. + +Lemma enum_ordD (n m : nat) : + enum 'I_(n+m) = + map (@lshift n m) (enum 'I_n) ++ map (@rshift n m) (enum 'I_m). +Proof. +elim: n => [|n IHn]. + rewrite enum_ord0/=. + elim: m => [|m IHm]; first by rewrite enum_ord0. + rewrite enum_ordSl IHm/=; congr (_ :: _); first exact/val_inj. + rewrite -[LHS]map_id. + by apply/eq_map => i; apply/val_inj. +rewrite !enum_ordSl IHn/=; congr (_ :: _); first exact/val_inj. +by rewrite map_cat -!map_comp; congr (_ ++ _); apply/eq_map => i; apply/val_inj. +Qed. + +Lemma iotaE0 (i n : nat) : iota i n = [seq i+j | j <- iota 0 n]. +Proof. by elim: n => // n IHn; rewrite -addn1 !iotaD/= map_cat IHn/= add0n. Qed. + +Lemma map_ord_iota (f : nat -> T) (n : nat) : + [seq f i | i : 'I_n] = [seq f i | i <- iota 0 n]. +Proof. +by rewrite [LHS](eq_map (g:=f \o (val : 'I_n -> nat)))// map_comp val_enum_ord. +Qed. + +Lemma nth_map_ord (x : T) n (f : 'I_n -> T) (i : 'I_n) : + nth x [seq f i | i <- enum 'I_n] i = f i. +Proof. by rewrite (nth_map i) ?nth_enum_ord// size_enum_ord. Qed. + +Lemma index_iota n m i : + index i (iota n m) = if (i < n)%N then m else minn (i - n)%N m. +Proof. +elim: m i n => /= [|m IHm] i n; first by rewrite minn0 if_same. +have [->|/negPf ni] := eqVneq n i; first by rewrite ltnn subnn min0n. +rewrite IHm ltnS leq_eqVlt eq_sym ni/=. +case: (ltnP i n) => [//|] ni'. +by rewrite -minnSS subnS prednK// subn_gt0 ltn_neqAle ni. +Qed. + +Lemma nth_catr (x0 : T) (s1 s2 : seq T) (p n : nat) : + p = size s1 -> + nth x0 (s1 ++ s2) (p + n) = nth x0 s2 n. +Proof. +move=> ->. +by rewrite nth_cat -[X in (_ < X)%N]addn0 ltn_add2l ltn0 subDnCA// subnn addn0. +Qed. + +(* Why does size_take not use minn? *) +Lemma size_take (n0 : nat) (s : seq T) : + size (take n0 s) = minn n0 (size s). +Proof. by rewrite size_take. Qed. + +Lemma mktupleE (n : nat) (T' : Type) (f : 'I_n -> T') : + tval (mktuple f) = [seq f i | i <- enum 'I_n]. +Proof. +case: n f => [|n] f. + by rewrite enum_ord0/=; apply/size0nil; rewrite size_tuple card_ord. +by apply/(@eq_from_nth _ (f ord0)) => [|i]; rewrite size_tuple. +Qed. + +Definition resize (x : T) (u : seq T) (n : nat) := + take n (u ++ [seq x | i <- iota 0 (n - size u)]). + +Lemma size_resize (x : T) (u : seq T) (n : nat) : + size (resize x u n) = n. +Proof. +rewrite size_take size_cat size_map size_iota. +case: (ltnP n (size u)) => [/ltnW|] nu. + by rewrite geq_subn// addn0; apply/minn_idPl. +by rewrite -subDnCA// subDnAC// subnn minnn. +Qed. + +Lemma nth_resize (x : T) (u : seq T) (n i : nat) : + (i < n)%N -> nth x (resize x u n) i = nth x u i. +Proof. +rewrite /resize => ilt. +rewrite nth_take// nth_cat. +case: ifP => [//|] /negP/negP; rewrite -leqNgt => ui. +rewrite [RHS]nth_default//. +rewrite nth_map// size_iota; apply/ltn_sub2r => //. +exact/(leq_ltn_trans ui ilt). +Qed. + +Lemma resize_id (x : T) (u : seq T) : resize x u (size u) = u. +Proof. +apply/(@eq_from_nth _ x); first exact/size_resize. +move=> i; rewrite size_resize => iu. +by rewrite nth_resize. +Qed. + End GeneralBaseType. Section WithEqType. Variables (T : eqType) (a1 a2 : pred T) (s : seq T). +Lemma resize_idE (x : T) (u : seq T) n : + (resize x u n == u) = (n == size u). +Proof. +have [->|/eqP nu] := eqVneq n (size u); first exact/eqP/resize_id. +by apply/negP => /eqP/(congr1 size); rewrite size_resize. +Qed. + Lemma sub_filter : subpred a1 a2 -> {subset [seq x <- s | a1 x] <= [seq x <- s | a2 x]}. Proof. @@ -293,16 +489,74 @@ move=> sub_a1_a2 x ; rewrite !mem_filter. by move/andP => [a1x ->] ; rewrite andbT sub_a1_a2. Qed. -Lemma sub_map_filter (U : eqType) (f : T -> U) : -subpred a1 a2 -> {subset [seq f x | x <- s & a1 x] <= [seq f x | x <- s & a2 x]}. +Lemma sub_map_filter (U : eqType) (f : T -> U) : subpred a1 a2 -> + {subset [seq f x | x <- s & a1 x] <= [seq f x | x <- s & a2 x]}. Proof. move=> sub_a1_a2 x. move/mapP => [y hy] eq_x_fy ; apply/mapP ; exists y => //. exact: sub_filter. Qed. +Lemma eq_map_seq [U : Type] [f g : T -> U] (r : seq T) : + {in r, forall x, f x = g x} -> map f r = map g r. +Proof. +elim: r => //= x r IHr fg; congr cons; first exact/fg/mem_head. +by apply/IHr => y yr; apply/fg; rewrite in_cons yr orbT. +Qed. + +Lemma subseq_drop_index (x : T) (s1 s2 : seq T) : + subseq (x :: s1) s2 = subseq (x :: s1) (drop (index x s2) s2). +Proof. +move nE: (index _ _) => n. +elim: n s2 nE => [|n IHn] s2 nE; first by rewrite drop0. +case: s2 nE => [//|y s2]. +have [->|/negPf /=] := eqVneq y x; first by rewrite /= eqxx. +by rewrite eq_sym => -> /succn_inj; apply/IHn. +Qed. + End WithEqType. +Lemma subseq_nth_iota (T : eqType) (x : T) (s1 s2 : seq T) : + reflect + (exists t, subseq t (iota 0 (size s2)) /\ s1 = [seq nth x s2 i | i <- t]) + (subseq s1 s2). +Proof. +elim: s1 s2 => [|x1 s1 IHs1] s2/=. + rewrite sub0seq; apply/Bool.ReflectT. + by exists [::]; split=> //; apply/sub0seq. +apply/(iffP idP) => [|[]]. + move=> /[dup] /mem_subseq/(_ x1 (mem_head _ _)) x12. + rewrite subseq_drop_index drop_index//= eqxx => /IHs1[/=] t []. + rewrite size_drop => tsub ->. + exists ((index x1 s2) :: [seq (index x1 s2).+1 + i | i <- t]); split=> /=. + rewrite -[size s2](@subnKC (index x1 s2).+1) ?index_mem// -cat1s iotaD. + apply/cat_subseq; first by rewrite sub1seq mem_iota/=. + by rewrite iotaE0; apply/map_subseq. + rewrite nth_index//; congr cons. + rewrite -map_comp; apply/eq_map => k. + by rewrite nth_drop/=. +case=> [[] //|i t] [] /[dup] /mem_subseq/(_ i (mem_head _ _)). +rewrite mem_iota/= => /[dup] ilt /ltnW/minn_idPl is2. +rewrite [subseq (i :: t) _]subseq_drop_index index_iota/= subn0. +rewrite is2 drop_iota. +case jE: (size s2 - i)%N => [//|j] /=. +rewrite eqxx => tsub [] -> s12. +rewrite -[s2](cat_take_drop i) nth_cat size_take is2 ltnn subnn. +apply/(subseq_trans _ (suffix_subseq _ _)). +case s2E: (drop i s2) => /= [|y s3]. + by move: ilt; rewrite -[s2](cat_take_drop i) s2E cats0 size_take is2 ltnn. +rewrite eqxx; apply/IHs1; exists [seq (j - i.+1)%N | j <- t]. +move: jE; rewrite -size_drop s2E/= => /succn_inj jE. +rewrite jE; split. +move: tsub; rewrite iotaE0 => /(map_subseq (fun x => x - i.+1)%N). +congr subseq; rewrite -map_comp -[RHS]map_id; apply/eq_map => k /=. + by rewrite subDnCA// subnn addn0. +rewrite s12 -map_comp; apply/eq_in_map => k /= /(mem_subseq tsub). +rewrite mem_iota => /andP[] ik _. +rewrite -[s2](cat_take_drop i) nth_cat size_take is2 ltnNge (ltnW ik)/=. +by rewrite s2E -[(k - i)%N]prednK ?subn_gt0//= subnS. +Qed. + End MoreSeq. Section MoreSeqEqType. @@ -322,10 +576,12 @@ Proof. by rewrite /= eqxx. Qed. Lemma rcons_nil (a : T) : rcons [::] a = [:: a]. Proof. by rewrite -cats1 cat0s. Qed. -Fact cat_nil (s1 s2 : seq T) : s1 ++ s2 == [::] = ((s1 == [::]) && (s2 == [::])). +Fact cat_nil (s1 s2 : seq T) : + s1 ++ s2 == [::] = ((s1 == [::]) && (s2 == [::])). Proof. by case: s1 => //= ->. Qed. -Lemma rem_is_nil (x : T) (s : seq T) : rem x s == [::] -> ((s == [::]) || (s == [:: x])). +Lemma rem_is_nil (x : T) (s : seq T) : rem x s == [::] -> + ((s == [::]) || (s == [:: x])). Proof. by case: s => //= y s; rewrite eqseq_cons; case: (y == x). Qed. Lemma undup_catl (s1 s2 : seq T) : @@ -403,7 +659,7 @@ by rewrite !mem_cat orbACA orbb !orbA. Qed. Lemma rem_undup (x : T) (s : seq T) : - rem x (undup s) = undup (filter (predC1 x) s). + rem x (undup s) = undup (seq.filter (predC1 x) s). Proof. by rewrite rem_filter ?undup_uniq// filter_undup. Qed. @@ -421,12 +677,21 @@ Lemma set_nth_nth (e : seq T) (i : nat) (a : T) : set_nth a e i (nth a e i) = e ++ (nseq (i.+1 - (size e) ) a). Proof. have [lt_ie|leq_ei] := ltnP i (size e). -by rewrite set_nth_id //; move: lt_ie; rewrite -subn_eq0=> /eqP->; rewrite cats0. + rewrite set_nth_id //; move: lt_ie; rewrite -subn_eq0=> /eqP ->. + by rewrite cats0. by rewrite set_nth_over // rcons_cat subSn // nseqS nth_default //. Qed. End MoreSeqEqType. +Lemma in_itv' (disp : unit) (T : porderType disp) (x : T) (i : interval T) : + (x \in i) = let 'Interval l u := i in + ((l <= (BLeft x)) && ((BRight x) <= u))%O. +Proof. +case: i => l u; rewrite in_itv; congr andb. +by case: l => //=; case. +Qed. + Section MoreFinmap. Local Open Scope fset_scope. @@ -450,6 +715,75 @@ apply/negbTE; rewrite -fproper0 fproperEcard cardfs0 cardfs1 andbT. by apply/fsubsetP => j; rewrite in_fset0. Qed. +Lemma imfset1 (T U : choiceType) (f : T -> U) (x : T) : + [fset f x | x in [fset x]] = [fset f x]. +Proof. +apply/fsetP => y; rewrite inE; apply/imfsetP/eqP => [[z]|yE]. + by rewrite inE => /eqP ->. +by exists x; rewrite // inE. +Qed. + +Lemma imfset0 [T U : choiceType] (f : T -> U) : + [fset f x | x in fset0] = fset0. +Proof. +have [-> //|[x]] := fset_0Vmem [fset f x | x in fset0]. +by move=> /imfsetP[y] /=; rewrite inE. +Qed. + +Lemma imfsetU [T U : choiceType] (f : T -> U) (s t : {fset T}) : + [fset f x | x in s `|` t] = [fset f x | x in s] `|` [fset f x | x in t]. +Proof. +apply/fsetP => x; rewrite in_fsetU; apply/imfsetP/orP => [[y] /= + ->|]. + by rewrite in_fsetU => /orP [ys|yt]; [left|right]; apply/imfsetP; exists y. +by case=> /imfsetP [y] /= ys ->; exists y => //; rewrite in_fsetU ys// orbT. +Qed. + +Lemma imfset_bigfcup [I T U : choiceType] (r : seq I) (P : pred I) + (F : I -> {fset T}) (f : T -> U) : + [fset f x | x in \bigcup_(i <- r | P i) F i] = + \bigcup_(i <- r | P i) [fset f x | x in F i]. +Proof. +elim: r => [|i r IHr]; first by rewrite !big_nil imfset0. +by rewrite !big_cons; case: (P i) => //; rewrite imfsetU IHr. +Qed. + +Lemma fsubset_trans (T : choiceType) (B A C : {fset T}) : + A `<=` B -> B `<=` C -> A `<=` C. +Proof. by move=> /fsubsetP AB /fsubsetP BC; apply/fsubsetP => x /AB /BC. Qed. + +Lemma seq_fset_sub (d : unit) (T : choiceType) (s1 s2 : seq T) : + reflect {subset s1 <= s2} (seq_fset d s1 `<=` seq_fset d s2). +Proof. +apply: (@equivP _ _ _ (@fsubsetP _ _ _)). +by split => h x; move/(_ x) : h; rewrite !seq_fsetE. +Qed. + +Lemma seq_fset_nil (K : choiceType) (k : unit) : seq_fset k [::] = (@fset0 K). +Proof. by apply/eqP; rewrite -cardfs_eq0 size_seq_fset. Qed. + +Lemma seq_fset_cons (K : choiceType) (k : unit) (a : K) (s : seq K) : + seq_fset k (a :: s) = a |` (seq_fset k s). +Proof. by apply/fsetP => x; rewrite !in_fsetE !seq_fsetE inE. Qed. + +Lemma seq_fset_cat (K : choiceType) (k : unit) (s1 s2 : seq K) : + seq_fset k (s1 ++ s2) = (seq_fset k s1) `|` (seq_fset k s2). +Proof. +elim: s1 s2 => [s1|a s1 ih s2]; first by rewrite seq_fset_nil fset0U. +by rewrite /= !seq_fset_cons ih fsetUA. +Qed. + +Lemma eq_fsetD (K : choiceType) (A B C : finSet K) : + (A `\` B == C) = fdisjoint C B && ((C `<=` A) && (A `<=` B `|` C)). +Proof. by rewrite eqEfsubset fsubDset fsubsetD andbCA andbA andbC. Qed. + +Lemma fset1D1 (K : choiceType) (a' a : K) : + [fset a] `\ a' = if (a' == a) then fset0 else [fset a]. +Proof. +apply/fsetP=> b; rewrite 2!fun_if !in_fsetE; have [->|] := altP (a' =P a). + exact/andNb. +by have [//->|]// := altP (b =P a); rewrite ?andbF // eq_sym => ->. +Qed. + End MoreFinmap. Section MoreRelation. @@ -461,7 +795,7 @@ Definition sub_r (x y : sT) := r (val x) (val y). Lemma sub_r_refl : reflexive sub_r. Proof. by rewrite /sub_r. Qed. -Lemma sub_r_sym : symmetric sub_r. +Lemma sub_r_sym : ssrbool.symmetric sub_r. Proof. by move=> x y; rewrite /sub_r equiv_sym. Qed. Lemma sub_r_trans : transitive sub_r. @@ -553,6 +887,189 @@ rewrite -(big_mkord (fun i => a <= i) F). by rewrite -(big_nat_widen_l _ _ predT) ?leq0n. Qed. +Lemma sum1_ord (n : nat) : + (\sum_(i < n) 1)%N = n. +Proof. by rewrite big_const_ord iter_addn_0 mul1n. Qed. + +Lemma big_ord_iota (op : Monoid.law idx) (n : nat) + (P : pred nat) (F : nat -> R) : + \big[op/idx]_(i < n | P i) F i = \big[op/idx]_(i <- iota 0 n | P i) F i. +Proof. +elim: n P F => [|n IHn] P F; first by rewrite big_ord0 big_nil. +rewrite [LHS]big_mkcond big_ord_recr iotanS. +rewrite -cats1 big_cat big_cons big_nil add0n Monoid.mulm1/=; congr (op _ _). +by rewrite -big_mkcond IHn. +Qed. + +Lemma prodr_const_seq (F : semiRingType) (I : Type) (r : seq I) (x : F) : + (\prod_(i <- r) x = x ^+ (size r))%R. +Proof. +elim: r => [|y r IHr]. + by rewrite big_nil expr0. +by rewrite big_cons IHr/= exprS. +Qed. + +Lemma bigmin_le {disp : unit} {T : orderType disp} (I : Type) (r : seq I) + (x : T) (P : pred I) (F : I -> T) (y : T) : + (\big[Order.min/x]_(i <- r | P i) F i <= y)%O = + (x <= y)%O || has (fun i => P i && (F i <= y)%O) r. +Proof. +elim: r => [|i r IHr]; first by rewrite big_nil orbF. +rewrite big_cons/=; case: (P i) => //=. +by rewrite ge_min IHr !orbA; congr (_ || _); apply/orbC. +Qed. + +Lemma bigmin_lt {disp : unit} {T : orderType disp} (I : Type) (r : seq I) + (x : T) (P : pred I) (F : I -> T) (y : T) : + (\big[Order.min/x]_(i <- r | P i) F i < y)%O = + (x < y)%O || has (fun i => P i && (F i < y)%O) r. +Proof. +elim: r => [|i r IHr]; first by rewrite big_nil orbF. +rewrite big_cons/=; case: (P i) => //=. +by rewrite gt_min IHr !orbA; congr (_ || _); apply/orbC. +Qed. + +Lemma le_bigmin {disp : unit} {T : orderType disp} (I : Type) (r : seq I) + (x : T) (P : pred I) (F : I -> T) (y : T) : + (y <= \big[Order.min/x]_(i <- r | P i) F i)%O = + (y <= x)%O && all (fun i => P i ==> (y <= F i)%O) r. +Proof. +elim: r => [|i r IHr]; first by rewrite big_nil andbT. +rewrite big_cons/=; case: (P i) => //=. +by rewrite le_min IHr !andbA; congr (_ && _); apply/andbC. +Qed. + +Lemma lt_bigmin {disp : unit} {T : orderType disp} (I : Type) (r : seq I) + (x : T) (P : pred I) (F : I -> T) (y : T) : + (y < \big[Order.min/x]_(i <- r | P i) F i)%O = + (y < x)%O && all (fun i => P i ==> (y < F i)%O) r. +Proof. +elim: r => [|i r IHr]; first by rewrite big_nil andbT. +rewrite big_cons/=; case: (P i) => //=. +by rewrite lt_min IHr !andbA; congr (_ && _); apply/andbC. +Qed. + +Lemma le_bigmax {disp : unit} {T : orderType disp} (I : Type) (r : seq I) + (x : T) (P : pred I) (F : I -> T) (y : T) : + (y <= \big[Order.max/x]_(i <- r | P i) F i)%O = + (y <= x)%O || has (fun i => P i && (y <= F i)%O) r. +Proof. +elim: r => [|i r IHr]; first by rewrite big_nil orbF. +rewrite big_cons/=; case: (P i) => //=. +rewrite le_max IHr !orbA; congr (_ || _); exact/orbC. +Qed. + +Lemma big_hasE (I J : Type) (op : Monoid.com_law idx) + (r : seq I) (P : pred I) (F : I -> R) (s : seq J) (a : I -> pred J) : + (forall i, P i -> (count (a i) s <= 1)%N) -> + \big[op/idx]_(i <- r | P i && has (a i) s) F i = + \big[op/idx]_(j <- s) \big[op/idx]_(i <- r | P i && a i j) F i. +Proof. +move=> s1. +elim: r => [|i r IHr]. + under [in RHS]eq_bigr do rewrite big_nil. + rewrite big_nil big_const_idem//. + exact/Monoid.mulm1. +under [in RHS]eq_bigr do rewrite big_cons. +rewrite big_cons; case /boolP: (P i) => //= Pi. +case/boolP: (has (a i) s) => [si|]; last first. + rewrite -all_predC. + rewrite {}IHr; elim: s s1 => /= [|j s IHs] s1 si; first by rewrite !big_nil. + rewrite !big_cons. + move/andP: si => [] /negPf -> /IHs -> // k /s1. + by case: (a k j) => //=; rewrite add1n ltnS leqn0 => /eqP ->. +rewrite {}IHr; elim: s s1 si => /= [//|] j s IHs s1. +rewrite !big_cons Monoid.mulmA. +case: (a i j) (s1 i Pi) => /= [|_]. + rewrite add1n ltnS leqNgt -has_count => ais _; congr (op _ _). + elim: s ais {IHs s1} => [_|k s IHs] /=. + by rewrite !big_nil. + by rewrite negb_or !big_cons => /andP[] /negPf -> /IHs ->. +move=> /IHs <-. + by rewrite Monoid.mulmCA Monoid.mulmA. +move=> k /s1. +by case: (a k j) => //=; rewrite add1n ltnS leqn0 => /eqP ->. +Qed. + +Lemma big_pred1_seq (op : Monoid.law idx) + [I : eqType] (r : seq I) (i : I) (F : I -> R) : + uniq r -> + \big[op/idx]_(j <- r | j == i) F j = if i \in r then F i else idx. +Proof. +elim: r => [_|j r IHr /= /andP[] jr runiq]; first by rewrite big_nil. +rewrite big_cons in_cons eq_sym. +move: jr; have [<- /= /negP jr|ij _ /=] := eqVneq i j; last exact/IHr. +rewrite big_seq_cond big_mkcond big1_idem; first exact/Monoid.mulm1. + exact/Monoid.mulm1. +by move=> k _; case: ifP => [/andP[] /[swap] /eqP ->|//]. +Qed. + +Lemma ltn_sum (I : Type) (r : seq I) (P : pred I) (E1 E2 : I -> nat) : + (forall i : I, P i -> (E1 i <= E2 i)%N) -> + has (fun i => P i && (E1 i < E2 i)%N) r -> + (\sum_(i <- r | P i) E1 i < \sum_(i <- r | P i) E2 i)%N. +Proof. +elim: r => [//|i r IHr] E12 /=. +rewrite !big_cons; case /boolP: (P i) => /= [Pi /orP|_ /(IHr E12)//]. +case=> [E12i|/(IHr E12) {}IHr]. + by rewrite -addSn; apply/leq_add => //; apply/leq_sum. +by rewrite -addnS; apply/leq_add => //; apply/E12. +Qed. + +Lemma big_ordD (op : Monoid.law idx) (n m : nat) + (P : pred 'I_(n + m)) (F : 'I_(n + m) -> R) : + \big[op/idx]_(i < n + m | P i) F i = + op (\big[op/idx]_(i < n | P (lshift m i)) F (lshift m i)) + (\big[op/idx]_(i < m | P (rshift n i)) F (rshift n i)). +Proof. +pose G i := + match ltnP i (n + m) with + | LtnNotGeq inm => F (Ordinal inm) + | _ => idx + end. +pose Q i := + match ltnP i (n + m) with + | LtnNotGeq inm => P (Ordinal inm) + | _ => false + end. +have FG i : F i = G i. + rewrite /G; move: (ltn_ord i); case: ltnP => // j _. + by congr F; apply/val_inj. +have PQ i : P i = Q i. + rewrite /Q; move: (ltn_ord i); case: ltnP => // j _. + by congr P; apply/val_inj. +under eq_bigr do rewrite FG. +under eq_bigl do rewrite PQ. +rewrite big_ord_iota iotaD big_cat add0n -big_ord_iota. +congr (op _ _); first exact/eq_big. +rewrite iotaE0 big_map -big_ord_iota. +by apply/eq_big => /= i; rewrite ?PQ ?HQ. +Qed. + +(* TODO: find a suitable name *) +Lemma big_neq_0 [S : Type] [idx' : S] [op : Monoid.law idx'] + [I : eqType] (r : seq I) [P : pred I] [F : I -> S] (i : I): + uniq r -> + (forall j, P j -> j != i -> F j = idx') -> + \big[op/idx']_(j <- r | P j) F j = if P i && (i \in r) then F i else idx'. +Proof. +move=> + iP; elim: r => [|j r IHr]. + by rewrite in_nil big_nil andbF. +rewrite big_cons; move: (iP j). +have [-> _ /= /andP[] ir ru {j}|ji] := eqVneq j i. + rewrite mem_head andbT big_mkcond big_seq -big_mkcondl. + under eq_bigr => j /andP[] Pj jr. + have ->: F j = idx'. + move: jr; have [->|/(iP j Pj) -> _ //] := eqVneq j i. + by rewrite (negPf ir). + over. + rewrite big_const_idem ?Monoid.mulm1//. + exact/Monoid.mulm1. +rewrite in_cons eq_sym (negPf ji)/= => /[swap] /andP[_] /IHr ->. +case: (P j) => [/(_ isT isT) ->|_ //]. +by rewrite Monoid.mul1m. +Qed. + End MoreBigop. Section MoreCoef. @@ -560,7 +1077,7 @@ Section MoreCoef. Open Scope ring_scope. Lemma coefMD_wid (R : ringType) (p q : {poly R}) (m n i : nat) : - i < m -> i < n -> + (i < m)%N -> (i < n)%N -> (p * q)`_i = \sum_(j1 < m) \sum_(j2 < n | (j1 + j2)%N == i) p`_j1 * q`_j2. Proof. move=> m_big n_big; rewrite pair_big_dep. @@ -580,7 +1097,7 @@ Lemma coefMD (R : ringType) (p q : {poly R}) (i : nat) : \sum_(j2 < size q | (j1 + j2)%N == i) p`_j1 * q`_j2. Proof. rewrite (@coefMD_wid _ _ _ i.+1 i.+1) //=. -rewrite (bigID (fun j1 :'I__ => j1 < size p)) /=. +rewrite (bigID (fun j1 :'I__ => j1 < size p)%N) /=. rewrite [X in _ + X]big1 ?addr0; last first. move=> j1; rewrite -ltnNge => j1_big. by rewrite big1 // => j2 _; rewrite nth_default ?mul0r. @@ -590,7 +1107,7 @@ rewrite big_mkcond /=; apply: eq_bigr => j1 _; rewrite ltnS. have [j1_small|j1_big] := leqP; last first. rewrite big1 // => j2; rewrite eq_sym => /eqP i_def. by rewrite i_def -ltn_subRL subnn ltn0 in j1_big. -rewrite (bigID (fun j2 :'I__ => j2 < size q)) /=. +rewrite (bigID (fun j2 :'I__ => j2 < size q)%N) /=. rewrite [X in _ + X]big1 ?addr0; last first. move=> j2; rewrite -ltnNge => /andP[_ j2_big]. by rewrite [q`__]nth_default ?mulr0. @@ -601,10 +1118,252 @@ have [//|j2_big] := leqP; rewrite eq_sym=> /eqP i_def. by rewrite i_def addnC -ltn_subRL subnn ltn0 in j2_big. Qed. +Lemma lead_coef_prod (R : idomainType) (I : Type) (r : seq I) + (P : pred I) (F : I -> {poly R}) : + lead_coef (\prod_(i <- r | P i) F i) = \prod_(i <- r | P i) lead_coef (F i). +Proof. +elim: r => [|i r IHr]; first by rewrite !big_nil lead_coef1. +rewrite !big_cons; case: (P i) => //. +by rewrite lead_coefM IHr. +Qed. + +Lemma gt_size (R : semiRingType) (p : {poly R}) (n : nat) : + p`_n != 0 -> (n < size p)%N. +Proof. +by rewrite ltnNge => /eqP pn; apply/negP => /leq_sizeP/(_ n (leqnn _)). +Qed. + +Lemma size_deriv [F : idomainType] (p : {poly F}) : + [char F] =i pred0 -> size p^`() = (size p).-1. +Proof. +move=> /charf0P F0. +have [->|p0] := eqVneq p 0; first by rewrite deriv0 size_poly0. +apply/le_anti/andP; split. + by rewrite -[X in (X <= _)%O]succnK; apply/leq_predn/lt_size_deriv. +case: (posnP (size p).-1) => [-> //|] p0'. +rewrite -(prednK p0'); apply/gt_size; rewrite coef_poly. +rewrite (prednK p0') leqnn -mulr_natr mulf_eq0 negb_or. +by rewrite -lead_coefE lead_coef_eq0 p0 F0 -lt0n. +Qed. + +Lemma lead_coef_deriv (R : idomainType) (p : {poly R}) : + [char R] =i pred0 -> + lead_coef p^`() = lead_coef p *+ (size p).-1. +Proof. +move=> R0. +rewrite !lead_coefE coef_deriv (size_deriv p R0). +case: (ltnP 1 (size p)) => [|p1]; first by case: (size p) => [//|]; case. +move/leq_predn: (p1); rewrite leqn0 => /eqP ->. +by rewrite mulr0n/= nth_default. +Qed. + End MoreCoef. +Section MorePolyDvd. + +Lemma dvdp_prod (A : idomainType) (I : Type) (r : seq I) + (P : pred I) (F G : I -> {poly A}) : + (forall i, P i -> F i %| G i)%R -> + (\prod_(i <- r | P i) F i %| \prod_(i <- r | P i) G i)%R. +Proof. +move=> FG; elim: r => [|i r IHr]; first by rewrite !big_nil dvd1p. +rewrite !big_cons; case/boolP: (P i) => [Pi|//]. +by apply/dvdp_mul => //; apply/FG. +Qed. + +Lemma divp_prod_dvdp (A : fieldType) (I : Type) (r : seq I) + (P : pred I) (F G : I -> {poly A}) : + (forall i, P i -> G i %| F i)%R -> + (\prod_(i <- r | P i) F i %/ \prod_(i <- r | P i) G i = + \prod_(i <- r | P i) (F i %/ G i))%R. +Proof. +move=> FG; elim: r => [|i r IHr]; first by rewrite !big_nil divp1. +rewrite !big_cons; case/boolP: (P i) => [Pi|//]. +rewrite -divp_divl mulrC -divp_mulA ?FG// mulrC -divp_mulA ?IHr//. +exact/dvdp_prod. +Qed. + +End MorePolyDvd. + +Section MoreRoot. + Local Open Scope ring_scope. +Lemma mu_XsubC (R : idomainType) (x y : R) : + \mu_x ('X - y%:P) = (x == y). +Proof. +have [->|xy] := eqVneq x y; first exact: mu_XsubC. +by rewrite muNroot// root_XsubC. +Qed. + +Lemma mu_prod [R : idomainType] (I : Type) (s : seq I) + (P : pred I) (F : I -> {poly R}) (x : R) : + \prod_(i <- s | P i) F i != 0 -> + \mu_x (\prod_(i <- s | P i) F i) = \sum_(i <- s | P i) \mu_x (F i). +Proof. +elim: s => [|p s IHs]. + rewrite !big_nil => _; apply/muNroot/root1. +rewrite !big_cons; case: (P p) => // ps0. +rewrite mu_mul//; move: ps0; rewrite mulf_eq0 negb_or => /andP[] p0 s0. +by rewrite IHs. +Qed. + +(* N.B. `multiplicity` should be generalized to `ringType`. *) +Lemma multiplicity_map (aR : fieldType) (rR : idomainType) + (f : {rmorphism aR -> rR}) (p : {poly aR}) (x : aR) : + \mu_(f x) (map_poly f p) = \mu_x p. +Proof. +have [->|p0] := eqVneq p 0; first by rewrite map_poly0 !mu0. +rewrite {2}/multiplicity. +case: (multiplicity_XsubC p x) => /= n [] q /implyP/(_ p0) qx pE. +rewrite (negPf p0) pE rmorphM/= mu_mul; last first. + by rewrite -rmorphM/= -pE map_poly_eq0. +rewrite rmorphXn/= rmorphB/= map_polyX map_polyC mu_exp mu_XsubC eqxx mul1n. +rewrite muNroot//; move: qx; apply/contraNN; rewrite rootE. +by rewrite horner_map fmorph_eq0. +Qed. + + +(* What is the root_bigmul in mathcomp??? *) +Lemma root_bigmul [R : idomainType] [I : Type] (x : R) (s : seq I) + (P : pred I) (F : I -> {poly R}) : + root (\prod_(i <- s | P i) F i) x = has (fun i : I => P i && root (F i) x) s. +Proof. +elim: s => [|y s IHs]; first by rewrite big_nil (negPf (root1 _)). +by rewrite big_cons/=; case: (P y) => //; rewrite rootM IHs. +Qed. + +Lemma in_rootsR (R : rcfType) + (P : {poly R}) (x : R) : + x \in rootsR P = (P != 0) && (root P x). +Proof. +rewrite andbC /rootsR in_roots; case/boolP: (root P x) => [|//] /= /rootP Px. +rewrite andbC; have [//|/= P0] := eqVneq P 0. +by rewrite interval.itv_boundlr/= !interval.leBSide/= -ltr_norml cauchy_boundP. +Qed. + +Lemma rootsRPE (R : rcfType) d (p : {poly R}) (z : d.-tuple R) : + (forall i, root p (tnth z i)) + -> (forall x, root p x -> x \in z) + -> sorted <%R z + -> (z : seq R) = rootsR p. +Proof. +have [-> _ z0P _|p0] := eqVneq p 0. + rewrite rootsR0. + move: z0P => /(_ (1 + \big[Order.max/0]_(x <- z) x) (root0 _)). + move=> /tnthP-[] i ziE. + suff: (tnth z i <= tnth z i - 1). + by rewrite -subr_ge0 addrAC subrr add0r oppr_ge0 ler10. + rewrite -{2}ziE addrAC subrr add0r le_bigmax; apply/orP; right. + apply/hasP; exists (tnth z i); first exact/mem_tnth. + exact/lexx. +move=> z0 z0P zsort. +apply/(irr_sorted_eq_in (leT:=<%R : rel R)) => //. +- move=> a b c _ _ _; exact/lt_trans. +- exact/sorted_roots. +move=> u; rewrite in_rootsR p0/=. +by apply/idP/idP => [|/z0P//] /tnthP -[] i ->. +Qed. + +Definition dec_roots (F : decFieldType) (p : {poly F}) : seq F := + if p == 0 then [::] else + [seq x <- undup (projT1 (dec_factor_theorem p)) | root p x]. + +Lemma uniq_dec_roots (F : decFieldType) (p : {poly F}) : + uniq (dec_roots p). +Proof. +by rewrite /dec_roots; case: (p == 0) => //; apply/filter_uniq/undup_uniq. +Qed. + +Lemma mem_dec_roots (F : decFieldType) (p : {poly F}) x : + x \in dec_roots p = (p != 0) && (root p x). +Proof. +rewrite /dec_roots. +have [->|p0]/= := eqVneq p 0 => //. +rewrite /dec_roots mem_filter; apply/andP/idP => [[]//|px]. +split=> //; rewrite mem_undup. +case: (dec_factor_theorem p) => s [q]/= [pE] qroot. +move: p0 px; rewrite pE rootM root_bigmul. +have [->|/qroot {}qroot _] := eqVneq q 0; first by rewrite mul0r eqxx. +rewrite (negPf (qroot _)) => /= /hasP [y] ys. +by rewrite root_XsubC => /eqP ->. +Qed. + +Lemma dec_rootsP (F : decFieldType) (p : {poly F}) : + exists q : {poly F}, + p = (q * \prod_(x <- dec_roots p) ('X - x%:P) ^+ (\mu_x p)) /\ + (q != 0 -> forall x : F, ~~ root q x). +Proof. +rewrite /dec_roots. +have [->|p0] := eqVneq p 0. + by exists 0; rewrite mul0r eqxx. +case: (dec_factor_theorem p) => s [q]/= [pE] qroot. +exists q; move: pE p0; have [->|/[dup] q0 /qroot {}qroot pE p0] := eqVneq q 0. + by rewrite !mul0r => ->. +split=> //. +rewrite big_filter big_mkcond/= {1}pE -prodr_undup_exp_count; congr (_ * _). +apply/eq_big_seq => x; rewrite mem_undup => xs. +have ->: root p x. + rewrite pE rootM (negPf (qroot x)) root_bigmul; apply/hasP; exists x => //=. + by rewrite root_XsubC. +congr (_ ^+ _). +rewrite pE mu_mul; last first. + rewrite mulf_eq0 negb_or (negPf q0)/= prodf_seq_neq0; apply/allP => y _ /=. + by rewrite polyXsubC_eq0. +rewrite muNroot// add0n mu_prod; last first. + rewrite prodf_seq_neq0; apply/allP => y _ /=. + by rewrite polyXsubC_eq0. +rewrite -sum1_count big_mkcond/=; apply/eq_bigr => y _. +by rewrite mu_XsubC eq_sym; case: (x == y). +Qed. + +Lemma dec_roots_closedP (F : closedFieldType) (p : {poly F}) : + (p = p`_(size p).-1 *: \prod_(x <- dec_roots p) ('X - x%:P) ^+ (\mu_x p)). +Proof. +have [->|p0] := eqVneq p 0; first by rewrite coef0 scale0r. +move: (dec_rootsP p) => [q]. +have [->|q0 [pE]/(_ isT) qr] := eqVneq q 0. + by rewrite mul0r => [][p0']; move/eqP: p0. +have [sq|/closed_rootP [x]] := eqVneq (size q) 1; last by move/negP: (qr x). +have /size1_polyC qE : (size q <= 1)%N by rewrite sq. +rewrite {1}pE qE mul_polyC; congr (_ *: _). +move/(congr1 lead_coef): pE. +rewrite lead_coefM lead_coef_prod. +under eq_bigr do rewrite lead_coef_exp lead_coefXsubC expr1n. +by rewrite big_const_idem/= ?mulr1// qE lead_coefC lead_coefE coefC/=. +Qed. + +Lemma dec_roots0 (F : decFieldType) : (@dec_roots F 0) = [::]. +Proof. +case rE: (dec_roots 0) => [//|x r]. +by move: (mem_head x r); rewrite -rE mem_dec_roots eqxx. +Qed. + + +End MoreRoot. + +Local Open Scope ring_scope. + +Lemma subrBB (S : zmodType) (a b c : S) : + (b - a) - (c - a) = b - c. +Proof. by rewrite opprB addrC addrCA addrAC subrr add0r. Qed. + +Lemma rowPE (R : eqType) (n : nat) (u v : 'rV[R]_n) : + (u == v) = [forall i, u ord0 i == v ord0 i]. +Proof. +apply/eqP/forallP => [/rowP uv i| uv]; first by apply/eqP. +by apply/rowP => i; apply/eqP. +Qed. + +Lemma cat_ffun_id (T : Type) (n m : nat) (f : 'rV[T]_(n + m)) : + row_mx (\row_(i < n) (f ord0 (lshift _ i))) + (\row_(j < m) (f ord0 (rshift _ j))) = f. +Proof. +apply/rowP => i; rewrite mxE. +case: fintype.splitP=> [] j /esym eq_i; rewrite mxE; +by congr (f _); apply/val_inj/eq_i. +Qed. + Section MoreComUnitRingTheory. Variable (R : comUnitRingType). @@ -630,6 +1389,10 @@ Qed. End MoreComUnitRingTheory. +Lemma sgz_invr (F : numFieldType) (x : F) : + sgz x^-1 = sgz x. +Proof. by rewrite /sgz invr_eq0 invr_lt0. Qed. + Section MoreFieldTheory. Variable (K : fieldType). @@ -671,8 +1434,8 @@ Proof. by rewrite lead_coef_Mmonic ?monicXn //. Qed. Lemma size_polyMXn p (n : nat) : p != 0 -> size (p * 'X^n) = (size p + n)%N. Proof. by move=> ?; rewrite size_Mmonic ?monicXn // size_polyXn addnS. Qed. -Lemma widen_poly (E : nat -> R) (a b : nat) : a <= b -> - (forall j, a <= j < b -> E j = 0) -> +Lemma widen_poly (E : nat -> R) (a b : nat) : (a <= b)%N -> + (forall j, (a <= j < b)%N -> E j = 0) -> \poly_(i < a) E i = \poly_(i < b) E i. Proof. move=> leq_a_b E_eq0; apply/polyP => k; rewrite !coef_poly. @@ -715,11 +1478,768 @@ Proof. by rewrite mulrC modp_mul mulrC. Qed. End AuxiliaryResults. -Section InjectiveTheory. - Lemma raddf_inj (R S : zmodType) (f : {additive R -> S}) : (forall x, f x = 0 -> x = 0) -> injective f. Proof. move=> f_inj x y /eqP; rewrite -subr_eq0 -raddfB => /eqP /f_inj /eqP. by rewrite subr_eq0 => /eqP. Qed. + +(* Section InjectiveTheory. + +Variable (R S : ringType) (f : {injmorphism R -> S}). + +Lemma rmorph_inj : injective f. Proof. by case: f => [? []]. Qed. + +Lemma rmorph_eq (x y : R) : (f x == f y) = (x == y). +Proof. by rewrite (inj_eq (rmorph_inj)). Qed. + +Lemma rmorph_eq0 (x : R) : (f x == 0) = (x == 0). +Proof. by rewrite -(rmorph0 f) (inj_eq (rmorph_inj)). Qed. + +Definition map_poly_injective : injective (map_poly f). +Proof. +move=> p q /polyP eq_pq; apply/polyP=> i; have := eq_pq i. +by rewrite !coef_map => /rmorph_inj. +Qed. + +Canonical map_poly_is_injective := InjMorphism map_poly_injective. + +End InjectiveTheory. +Hint Resolve rmorph_inj. + +Canonical polyC_is_injective (R : ringType) := InjMorphism (@polyC_inj R). + +Canonical comp_is_injmorphism (R S T : ringType) + (f : {injmorphism R -> S}) (g : {injmorphism S -> T}) := + InjMorphism (inj_comp (@rmorph_inj _ _ g) (@rmorph_inj _ _ f)). + +(* Hack to go around a bug in canonical structure resolution *) +Definition fmorph (F R : Type) (f : F -> R) := f. +Canonical fmorph_is_injmorphism (F : fieldType) (R : ringType) + (f : {rmorphism F -> R}) := + InjMorphism (fmorph_inj f : injective (fmorph f)). *) + +Section MoreNumDomainTheory. + +Lemma ler_p1X (R : numDomainType) (x y : R) (n m : nat) : + 1 <= x -> x <= y -> (n <= m)%N -> x ^+ n <= y ^+ m. +Proof. +move=> x1 xy nm; apply/(le_trans (y:=x ^+ m)). + rewrite -(subnK nm) exprD ler_peMl// ?exprn_ege1//. + by rewrite exprn_ge0// (le_trans ler01 x1). +elim: m {n nm} => [|n IHn]; first by rewrite !expr0. +by rewrite !exprS ler_pM// (le_trans ler01)// exprn_ege1. +Qed. + +Lemma sumr_gt0 (R : numDomainType) (I : Type) (r : seq I) + (P : pred I) (F : I -> R): + (forall i : I, P i -> 0 <= F i) + -> has (fun i => P i && (0 < F i)) r + -> 0 < \sum_(i <- r | P i) F i. +Proof. +move=> F0; elim: r => [//|] i r IHr /= /orP; case=> [/andP[Pi Fi]|/IHr {}IHr]. + by rewrite big_cons Pi; apply/(lt_le_trans Fi); rewrite lerDl sumr_ge0. +rewrite big_cons; case/boolP: (P i) => // Pi; apply/(lt_le_trans IHr). +by rewrite lerDr F0. +Qed. + +Lemma psumr_gt0 (R : numDomainType) (I : Type) (r : seq I) + (P : pred I) (F : I -> R): + (forall i : I, P i -> 0 < F i) + -> has P r + -> 0 < \sum_(i <- r | P i) F i. +Proof. +move=> F0 Pr; apply/sumr_gt0 => [i /F0 /ltW //|]. +elim: r Pr => [//|] i r IHr /= /orP; case=> [Pi|/IHr -> //]. + by rewrite Pi F0. +by rewrite orbT. +Qed. + +End MoreNumDomainTheory. + +Lemma sgz_prod (R : realDomainType) (I : Type) + (r : seq I) (P : pred I) (F : I -> R) : + sgz (\prod_(x <- r | P x) F x) = \prod_(x <- r | P x) sgz (F x). +Proof. +elim: r => [|x r IHr]; first by rewrite !big_nil sgz1. +rewrite !big_cons; case: (P x) => //. +by rewrite sgzM IHr. +Qed. + +Lemma sgz_horner (F : rcfType) (p : {poly F}) (x : F) : + sgz p.[x] = + sgz (lead_coef p) * (x \notin rootsR p) * + (-1) ^+ \sum_(y <- rootsR p | x < y) (\mu_y p)%R. +Proof. +have [->|p0] := eqVneq p 0; first by rewrite horner0 lead_coef0 !sgz0 mul0r. +move: (dec_roots_closedP (map_poly (real_complex _) p)). +move=> /(congr1 (fun p => p.[x%:C%C])). +rewrite -lead_coefE lead_coef_map/= hornerZ horner_prod horner_map/=. +rewrite (bigID (fun x => complex.Im x == 0))/=. +rewrite -big_filter; move rE: (seq.filter _ _) => r. +have {}rE: perm_eq r [seq x%:C%C | x <- rootsR p]. + apply/uniq_perm. + - by rewrite -rE; apply/filter_uniq/uniq_dec_roots. + - by rewrite map_inj_uniq ?uniq_roots//; apply/complexI. + move=> y. + rewrite -rE mem_filter mem_dec_roots/= map_poly_eq0 p0/=. + apply/idP/mapP; last first. + move=> [] z; rewrite in_rootsR rootE => /andP[] _ pz0 ->. + by rewrite eqxx rootE horner_map/= (inj_eq (@complexI _)). + move=> /andP[] /eqP y0. + rewrite [y]complexE y0 mulr0 addr0 rootE horner_map/=. + rewrite (inj_eq (@complexI _)) => py0. + by exists (complex.Re y) => //; rewrite in_rootsR p0. +rewrite (perm_big _ rE)/= big_map. +under eq_bigr => y _. + rewrite -(map_polyX (real_complex F)) -map_polyC -rmorphB -rmorphXn. + rewrite horner_map multiplicity_map !hornerE. + over. +rewrite -rmorph_prod. +rewrite [\prod_(_ <- dec_roots _ | _) _](bigID (fun x => 0 < complex.Im x))/=. +have im_conj: forall (z : F[i]), complex.Im z^* = - complex.Im z by case. +have pE: map_poly Num.conj_op (map_poly (real_complex F) p) + = (map_poly (real_complex F) p). + by rewrite -map_poly_comp; apply/eq_map_poly => z/=; rewrite oppr0. +rewrite -[\prod_(_ <- _ | _ && ~~ _) _]big_filter. +have iE: perm_eq + [seq i <- dec_roots (map_poly (real_complex F) p) | + complex.Im i != 0 & ~~ (0 < complex.Im i)] + [seq x^* | + x <- [seq i <- dec_roots (map_poly (real_complex F) p) | + complex.Im i != 0 & (0 < complex.Im i)]]. + apply/uniq_perm. + - exact/filter_uniq/uniq_dec_roots. + - rewrite map_inj_uniq; last exact/(inv_inj conjCK). + exact/filter_uniq/uniq_dec_roots. + move=> y. + rewrite -{2}[y]conjCK mem_map; last exact/(inv_inj conjCK). + rewrite !mem_filter/= im_conj oppr_eq0 oppr_gt0 -leNgt. + case/boolP: (_ == _) => [//|] /negPf yi0 /=. + rewrite le_eqVlt yi0/= !mem_dec_roots. + by rewrite -(fmorph_root Num.conj_op) pE. +rewrite (perm_big _ iE) big_map big_filter/= -big_split/=. +under [\prod_(_ <- _ | _ && _) _]eq_bigr => y _. + rewrite -hornerM -{2}pE multiplicity_map -exprMn horner_exp !hornerE. + rewrite -{2}conjc_real -rmorphB/= -normCK -exprM -(RRe_real (normr_real _)). + rewrite -rmorphXn/=. + over. +rewrite -rmorph_prod/= -!rmorphM/= => /complexI ->; rewrite !sgzM. +rewrite mulrA -[RHS]mulrA -[RHS]mulr1; congr (_ * _ * _); last first. + apply/gtr0_sgz/prodr_gt0 => y /andP[] y0 _. + apply/exprn_gt0; rewrite -ltcR (@normr_gt0 _ F[i]) subr_eq0. + apply/eqP => /(congr1 (@complex.Im _))/=. + by move: y0 => /[swap] <-; rewrite eqxx. +case /boolP: (x \in rootsR p) => xr /=. + apply/eqP; rewrite mul0r sgz_eq0 prodf_seq_eq0. + apply/hasP; exists x => //=. + rewrite subrr expr0n mu_eq0//. + by move: xr; rewrite in_rootsR => /andP[_] ->. +rewrite mul1r sgz_prod. +under eq_bigr do rewrite sgzX. +rewrite (bigID (fun y => x < y))/=. +under eq_bigr => y xy. + have ->: sgz (x - y) = -1 by apply/ltr0_sgz; rewrite subr_lt0. + over. +rewrite prodrXr -[RHS]mulr1; congr (_ * _). +rewrite big_mkcond big_seq -big_mkcondl/=. +under eq_bigr => y /andP[] yx yr. + have ->: sgz (x - y) = 1. + move: yx; rewrite -leNgt le_eqVlt => /orP[/eqP|] yx. + by move/negP: xr; rewrite -yx. + by apply/gtr0_sgz; rewrite subr_gt0. + rewrite expr1n. + over. +by rewrite big_const_seq iter_mulr_1 expr1n. +Qed. + +Section MoreAnalysis. + +Lemma mem_preimage (T U : Type) (f : T -> U) (s : set U) (x : T) : + x \in (f @^-1` s)%classic = (f x \in s). +Proof. by []. Qed. + +Lemma open_subspace_setT (T : topologicalType) (A : set T) : + open (A : set (subspace setT)) = open A. +Proof. +rewrite !openE/=; congr (A `<=` _)%classic. +by apply/seteqP; split; apply/subsetP => x; + rewrite /interior !inE nbhs_subspaceT. +Qed. + +Lemma open_bigcap (T : topologicalType) (I : Type) (r : seq I) (P : pred I) + (F : I -> set T) : + (forall i, P i -> open (F i)) -> open (\big[setI/setT]_(i <- r | P i) F i). +Proof. +move=> Fopen; elim: r => [|i r IHr]. + rewrite big_nil; exact/openT. +rewrite big_cons; case/boolP: (P i) => // Pi; apply/openI => //. +exact/Fopen. +Qed. + +Lemma eq_continuous_at {T S : topologicalType} (f g : T -> S) (x : T) : + f =1 g -> continuous_at x f -> continuous_at x g. +Proof. by move=> fg; rewrite /continuous_at fg (eq_cvg _ _ fg). Qed. + +Lemma eq_continuous {T S : topologicalType} (f g : T -> S) : + f =1 g -> continuous f -> continuous g. +Proof. by move=> fg f_cont x; exact/(eq_continuous_at fg). Qed. + +Lemma expn_continuous {K : numFieldType} (n : nat) : + continuous (fun x : K => x ^+ n). +Proof. +elim: n => [|n IHn]; first exact/cst_continuous. +apply/(eq_continuous (f:=fun x : K => x * x ^+ n)) => x. + by rewrite exprS. +by apply/(@continuousM _ _ _ _ x) => //; apply/IHn. +Qed. + +Lemma cvgX {K : numFieldType} {T : Type} [F : set_system T] : + Filter F -> + forall (f : T -> K) (n : nat) (a : K), + cvg_to (nbhs (fmap f (nbhs F))) (nbhs a) -> + cvg_to (nbhs (fmap ((fun x => x ^+ n) \o f) (nbhs F))) (nbhs (a ^+ n)). +Proof. +move=> FF f n a fa. +by apply: continuous_cvg => //; apply/expn_continuous. +Qed. + +Lemma continuousX [K : numFieldType] [T : topologicalType] + (s : T -> K) (n : nat) (x : T) : + {for x, continuous s} -> {for x, continuous (fun x => s x ^+ n)}. +Proof. by move=> f_cont; apply: cvgX. Qed. + +(* N.B. I do not need a numFieldType. *) +Lemma cvg_big {K : topologicalType} {T : Type} [F : set_system T] [I : Type] + (r : seq I) (P : pred I) (Ff : I -> T -> K) (Fa : I -> K) + (op : K -> K -> K) (x0 : K): + Filter F -> + (forall (f g : T -> K) (a b : K), + cvg_to (nbhs (fmap f (nbhs F))) (nbhs a) -> + cvg_to (nbhs (fmap g (nbhs F))) (nbhs b) -> + cvg_to (nbhs (fmap (fun x => op (f x) (g x)) (nbhs F))) (nbhs (op a b))) -> + (forall i, P i -> cvg_to (nbhs (fmap (Ff i) (nbhs F))) (nbhs (Fa i))) -> + cvg_to (nbhs (fmap ((fun x => \big[op/x0]_(i <- r | P i) (Ff i x))) (nbhs F))) + (nbhs (\big[op/x0]_(i <- r | P i) Fa i)). +Proof. +move=> FF cvg_op cvg_f. +elim: r => [|x r IHr]. + rewrite big_nil (eq_cvg _ _ (fun x => big_nil _ _ _ _)). + exact: cvg_cst. +rewrite big_cons (eq_cvg _ _ (fun x => big_cons _ _ _ _ _ _)). +case/boolP: (P x) => // Px. +apply/cvg_op => //. +exact/cvg_f. +Qed. + +Lemma continuous_big [K T : topologicalType] [I : Type] (r : seq I) + (P : pred I) (F : I -> T -> K) (op : K -> K -> K) (x0 : K) (x : T) : + continuous (fun x : K * K => op x.1 x.2) -> + (forall i, P i -> {for x, continuous (F i)}) -> + {for x, continuous (fun x => \big[op/x0]_(i <- r | P i) F i x)}. +Proof. +move=> op_cont f_cont. +apply: cvg_big => // f g a b fa gb. +rewrite (eq_cvg _ (g:=(fun x => op x.1 x.2) \o (fun x => (f x, g x))))//. +apply: (cvg_comp (G:=nbhs (a, b))); first exact: cvg_pair. +exact: (op_cont (a, b)). +Qed. + +Lemma cvg_sum {K : numFieldType} {V : pseudoMetricNormedZmodType K} {T : Type} + [F : set_system T] [I : Type] (r : seq I) (P : pred I) + (Ff : I -> T -> V) (Fa : I -> V): + Filter F -> + (forall i, P i -> cvg_to (nbhs (fmap (Ff i) (nbhs F))) (nbhs (Fa i))) -> + cvg_to (nbhs (fmap ((fun x => \sum_(i <- r | P i) (Ff i x))) (nbhs F))) + (nbhs (\sum_(i <- r | P i) Fa i)). +Proof. +move=> FF fa. +apply/(cvg_big FF) => // f g a b {}fa gb. +exact: cvgD. +Qed. + +Lemma continuous_sum {K : numFieldType} {V : pseudoMetricNormedZmodType K} + [T : topologicalType] [I : Type] (r : seq I) + (P : pred I) (F : I -> T -> V) (x : T) : + (forall i, P i -> {for x, continuous (F i)}) -> + {for x, continuous (fun x => \sum_(i <- r | P i) F i x)}. +Proof. +move=> f_cont. +apply: continuous_big => //=. +exact: add_continuous. +Qed. + +Lemma cvg_prod {K : numFieldType} {T : Type} [F : set_system T] [I : Type] + (r : seq I) (P : pred I) (Ff : I -> T -> K) (Fa : I -> K): + Filter F -> + (forall i, P i -> cvg_to (nbhs (fmap (Ff i) (nbhs F))) (nbhs (Fa i))) -> + cvg_to (nbhs (fmap ((fun x => \prod_(i <- r | P i) (Ff i x))) (nbhs F))) + (nbhs (\prod_(i <- r | P i) Fa i)). +Proof. +move=> FF fa. +apply/(cvg_big FF) => // f g a b {}fa gb. +exact: cvgM. +Qed. + +Lemma continuous_prod {K : numFieldType} [T : topologicalType] [I : Type] + (r : seq I) (P : pred I) (F : I -> T -> K) (x : T) : + (forall i, P i -> {for x, continuous (F i)}) -> + {for x, continuous (fun x => \prod_(i <- r | P i) F i x)}. +Proof. +move=> f_cont. +apply: continuous_big => //=. +exact: mul_continuous. +Qed. + +Lemma id_continuous {T : topologicalType} : continuous (@id T). +Proof. by apply/continuousP => A; rewrite preimage_id. Qed. + +Lemma horner_continuous {K : numFieldType} (p : {poly K}) : + continuous (horner p)%R. +Proof. +apply/(eq_continuous (f:=fun x : K => \sum_(i < size p) p`_i * x ^+ i)) => x. + by rewrite -[p in RHS]coefK horner_poly. +apply/(@continuous_sum _ K^o). +move=> /= i _. +apply/continuousM; first exact/cst_continuous. +exact/continuousX/id_continuous. +Qed. + +Lemma meval_continuous n {K : numFieldType} (p : {mpoly K[n]}) : + continuous (fun x : 'rV[K]_n => p.@[x ord0])%R. +Proof. +apply/(eq_continuous + (f:=fun x : 'rV[K]_n => + \sum_(m <- msupp p) p@_m * \prod_i x ord0 i ^+ m i)) => x. + exact/mevalE. +apply/(@continuous_sum K K^o). +move=> /= i _. +apply/continuousM; first exact/cst_continuous. +apply/continuous_prod => j _. +exact/continuousX/coord_continuous. +Qed. + +Lemma mx_continuous (T : topologicalType) (K : realFieldType) m n + (f : T -> 'M[K]_(m.+1, n.+1)) : + (forall i j, continuous (fun x => f x i j)) -> + continuous f. +Proof. +move=> fc x; apply/cvg_ballP => e e0. +near=> y. +rewrite -[X in X (f x)]ball_normE/= [X in X < _]mx_normrE bigmax_lt//=. +move=> -[] i j _; rewrite !mxE/=. +suff: ball (f x i j) e (f y i j). + by rewrite -(@ball_normE _ K^o). +move: i j. +near: y. +apply: filter_forall => i. +apply: filter_forall => j. +move: (fc i j x) => /cvg_ballP-/(_ e e0). +exact/filterS. +Unshelve. all: end_near. +Qed. + +End MoreAnalysis. + +Section MoreMultinomials. +Variable (n : nat) (R : comRingType). + +Lemma mevalXn (k : nat) (x : 'I_n -> R) (p : {mpoly R[n]}) : + (p ^+ k).@[x] = p.@[x] ^+ k. +Proof. +elim: k => [|k IHk]; first by rewrite !expr0 meval1. +by rewrite !exprS mevalM IHk. +Qed. + +Lemma meval_mwiden (v : 'I_n.+1 -> R) (P : {mpoly R[n]}) : + (mwiden P).@[v] = P.@[fun i => v (widen_ord (leqnSn n) i)]. +Proof. +rewrite (mpolyE P) !rmorph_sum/= -mpolyE. +apply/eq_bigr => i _; rewrite rmorphM/= mevalZ mevalC mevalX; congr (_ * _)%R. +rewrite /mmap1 rmorph_prod/=; apply/eq_bigr => j _. +by rewrite rmorphXn/= mevalXU. +Qed. + +Lemma meval_mmulti (v : 'I_n.+1 -> R) (P : {poly {mpoly R[n]}}) : + (mmulti P).@[v] = + P.[(v ord_max)%:MP_[n]].@[fun i => v (widen_ord (leqnSn n) i)]. +Proof. +rewrite -[in RHS](coefK P) horner_poly !rmorph_sum/=. +apply/eq_bigr => i _. +by rewrite !rmorphM/= !rmorphXn/= mevalXU mevalC meval_mwiden. +Qed. + +Lemma meval_sum [I : Type] {K : ringType} (v : 'I_n -> K) (r : seq I) + (F : I -> {mpoly K[n]}) (P : pred I) : + (\sum_(i <- r | P i) F i).@[v] = \sum_(i <- r | P i) (F i).@[v]. +Proof. by rewrite raddf_sum. Qed. + +Lemma mnmwidenE (m : 'X_{1.. n}) (i : 'I_n.+1) : + mnmwiden m i = + match ltnP i n with + | LtnNotGeq ilt => m (Ordinal ilt) + | _ => 0%N + end. +Proof. +case: (ltnP i n) => ilt. + by rewrite -[RHS]mnmwiden_widen; congr (mnmwiden _ _); apply/val_inj. +rewrite -[RHS](mnmwiden_ordmax m); congr (mnmwiden _ _); apply/val_inj. +apply/anti_leq/andP; split=> //. +by move: (ltn_ord i); rewrite ltnS. +Qed. + +Lemma mmulti_is_additive [S : ringType] : + additive (@mmulti n S). +Proof. +move=> /= p q; rewrite /mmulti. +rewrite (big_ord_widen + (maxn (size p) (size q)) + (fun i => mwiden (p - q)`_i * 'X_ord_max ^+ i)%R); last first. + by apply/(leq_trans (size_add _ _)); rewrite size_opp. +rewrite (big_ord_widen + (maxn (size p) (size q)) + (fun i => mwiden p`_i * 'X_ord_max ^+ i)%R); last first. + exact/leq_maxl. +rewrite (big_ord_widen + (maxn (size p) (size q)) + (fun i => mwiden q`_i * 'X_ord_max ^+ i)%R); last first. + exact/leq_maxr. +rewrite big_mkcond/= [in RHS]big_mkcond/= [X in _ = _ - X]big_mkcond/=. +rewrite -sumrB; apply/eq_bigr => i _. +have <-: (mwiden 0 * 'X_ord_max ^+ i)%R = 0 :> {mpoly S[n.+1]}. + by rewrite mwiden0 mul0r. +rewrite -3!(fun_if (fun x => mwiden x * 'X_ord_max ^+ i)%R). +have ifE (x : {poly {mpoly S[n]}}): (if (i < size x)%N then x`_i else 0) = x`_i. + by case: (ltnP i (size x)) => // ix; rewrite nth_default. +by rewrite 3!ifE coefB mwidenB mulrBl. +Qed. + +HB.instance Definition _ (S : ringType) := + GRing.isAdditive.Build _ _ (@mmulti n S) (@mmulti_is_additive S). + +Lemma mnmPE m (u v : 'X_{1.. m}) : (u == v) = [forall i : 'I_m, u i == v i]. +Proof. +apply/eqP/forallP => /= [-> i|uv]; first exact: eqxx. +apply/val_inj/eq_from_tnth => i. +by move: (uv i) => /eqP; rewrite !mnm_tnth. +Qed. + +Lemma forall_ordS (m : nat) (p : pred 'I_m.+1) : + [forall i, p i] = (p ord_max && [forall i : 'I_m, p (widen_ord (leqnSn m) i)]). +Proof. +apply/forallP/andP => /= [pP|[] pm /forallP pP i]. + split; first exact/pP. + by apply/forallP => i; apply/pP. +case: (ltnP i m) => im. + by move: (pP (Ordinal im)); congr p; apply/val_inj. +move: pm; congr p; apply/val_inj/le_anti/andP; split; first exact im. +by move: (ltn_ord i); rewrite ltnS. +Qed. + +Lemma mcoeff_muni (A : ringType) (p : {mpoly A[n.+1]}) + (i : nat) (m : 'X_{1.. n}) : + (muni p)`_i@_m = p@_(Multinom (rcons_tuple m i)). +Proof. +rewrite (mpolyE p) !raddf_sum/= coef_sum raddf_sum/=. +apply/eq_bigr => u _. +rewrite muniZ coefZ mul_mpolyC !mcoeffZ; congr (_ * _). +rewrite muniE msuppX big_seq1 !mcoeffX eqxx scale1r coefZ coefXn. +rewrite mulr_natr raddfMn/= mcoeffX -[LHS]mulr_natr -natrM mulnb; congr ((_ _)%:R). +rewrite !mnmPE forall_ordS multinomE /tnth/= nth_rcons size_tuple ltnn eqxx. +rewrite eq_sym andbC; congr (_ && _). +apply/eq_forallb => /= j. +rewrite !multinomE tnth_map /tnth/= nth_rcons size_tuple ltn_ord nth_enum_ord. +rewrite [X in _ == X]mnm_tnth /tnth/=; congr (_ == _). +by apply/set_nth_default; rewrite size_tuple. +Qed. + +Lemma mcoeff_mwiden (A : ringType) (p : {mpoly A[n]}) (m : 'X_{1.. n.+1}) : + (mwiden p)@_m + = p@_(Multinom (mktuple (fun i => m (widen_ord (leqnSn n) i)))) + *+ (m ord_max == 0). +Proof. +rewrite (mpolyE p). +rewrite !raddf_sum/= -(mpolyE p) -sumrMnl. +apply/eq_bigr => u _. +rewrite mul_mpolyC !mcoeffZ -mulrnAr; congr (_ * _). +set x := mmap1 _ _. +have ->: x = 'X_[Multinom (rcons_tuple u 0)]. + rewrite [RHS]mpolyXE_id big_ord_recr/= multinomE (tnth_nth 0)/= -cats1. + rewrite nth_cat size_tuple ltnn subnn/= expr0 mulr1. + apply/eq_bigr => i _. + rewrite multinomE (tnth_nth 0)/= -cats1 nth_cat size_tuple. + by rewrite (ltn_ord i) mnm_tnth (tnth_nth 0). +rewrite !mcoeffX -[RHS]mulr_natr -natrM mulnb; congr ((_ _)%:R). +rewrite !mnmPE forall_ordS multinomE /tnth/= nth_rcons size_tuple ltnn eqxx. +rewrite eq_sym andbC; congr (_ && _). +apply/eq_forallb => /= i. +rewrite !multinomE tnth_map tnth_ord_tuple /tnth/= nth_rcons size_tuple. +rewrite (ltn_ord i) [u i]mnm_tnth /tnth/=; congr (_ == _). +by apply/set_nth_default; rewrite size_tuple. +Qed. + +Lemma mcoeff_mmulti (A : ringType) (p : {poly {mpoly A[n]}}) + (m : 'X_{1.. n.+1}) : + (mmulti p)@_m + = p`_(m ord_max)@_(Multinom (mktuple (fun i => m (widen_ord (leqnSn n) i)))). +Proof. +rewrite -(coefK p) poly_def coef_sum !raddf_sum/= -poly_def (coefK p). +apply/eq_bigr => i _. +rewrite coefZ coefXn mpolyXn mulr_natr raddfMn/=. +case: (ltnP (m ord_max) i) => [mi|im]. + rewrite (negPf (ltn_neq mi)) mulr0n. + move xE: _@_m => x; rewrite -[RHS](mulr0 x) -xE mcoeffM mulr_suml => {x xE}. + apply/eq_bigr => -[] /= u v /eqP mE. + rewrite mulr0 mcoeffX mcoeff_mwiden. + move: mi; rewrite {1}mE mnmDE. + have [-> vi|_ _] := eqVneq (u ord_max) 0; last by rewrite mulr0n mul0r. + rewrite mnmPE forall_ordS mulmnE mnm1E eqxx eq_sym mul1n (negPf (ltn_neq vi)). + exact/mulr0. +move uE: (Multinom _) => u. +have /eqP ->: + m == (U_(ord_max) *+ i + [multinom (rcons_tuple u (m ord_max - i)%N)])%MM. + rewrite mnmPE; apply/forallP => /= j; apply/eqP. + rewrite mnmDE mulmnE mnm1E multinomE /tnth/= nth_rcons size_tuple. + case: (ltnP j n) => jn. + rewrite -(inj_eq val_inj)/= [n == j]eq_sym (negPf (ltn_neq jn)) -uE. + rewrite -(tnth_nth _ _ (Ordinal jn)) -mnm_tnth multinomE tnth_mktuple. + by congr (_ _); apply/val_inj. + rewrite eq_sym/= -(inj_eq val_inj); suff ->: j = ord_max. + by rewrite eqxx/= mul1n subnKC. + apply/val_inj/le_anti/andP; split=> //. + by move: (ltn_ord j); rewrite ltnS. +rewrite mcoeffMX mcoeff_mwiden mnmDE mulmnE mnm1E eqxx mul1n. +rewrite -[X in (_ + _)%N == X]addn0 eqn_add2l. +under eq_mktuple => j. + rewrite multinomE /tnth/= nth_rcons size_tuple ltn_ord -tnth_nth -uE. + rewrite -mnm_tnth multinomE. + over. +under eq_mktuple do rewrite tnth_mktuple. +by rewrite uE. +Qed. + +Lemma muniK (A : ringType) : cancel (@muni n A) (@mmulti n A). +Proof. +move=> p; apply/mpolyP => m. +rewrite mcoeff_mmulti mcoeff_muni; congr mcoeff. +apply/mnmP => i. +rewrite multinomE (tnth_nth 0)/= -cats1 nth_cat size_map size_enum_ord. +case: (ltnP i n) => ilt. + rewrite -/(nat_of_ord (Ordinal ilt)) nth_map_ord. + by congr (m _); apply/val_inj. +suff ->: i = ord_max by rewrite subnn. +apply/val_inj/anti_leq/andP; split=> //. +by move: (ltn_ord i); rewrite ltnS. +Qed. + +Lemma mmultiK (A : ringType) : cancel (@mmulti n A) (@muni n A). +Proof. +move=> p; apply/polyP => i; apply/mpolyP => m. +rewrite mcoeff_muni mcoeff_mmulti. +rewrite multinomE (tnth_nth 0)/= -cats1 nth_cat size_tuple ltnn subnn/=. +congr mcoeff; apply/mnmP => j. +rewrite mnmE multinomE (tnth_nth 0)/= -cats1 nth_cat size_tuple (ltn_ord j). +by rewrite -mnm_nth. +Qed. + +End MoreMultinomials. + +Section MoreRealClosed. +Variables (R : rcfType). + +Lemma normcR (z : R) : `|z%:C%C| = `|z|%:C%C. +Proof. by rewrite normc_def/= expr0n/= addr0 sqrtr_sqr. Qed. + +Lemma jump_derivp (p : {poly R}) (x : R) : + jump p^`() p x = (root p x && (p != 0))%:R. +Proof. +rewrite /jump. +have [->|p0] := eqVneq p 0. + by rewrite deriv0 mulr0 sgp_right0 ltxx expr0 eqxx andbF. +rewrite andbT; move: (size_deriv p (char_num R)). +have [-> /eqP|p'0 _] := eqVneq p^`() 0. + rewrite size_poly0 -eqSS prednK ?size_poly_gt0// => /eqP p1. + move: p0; have/size1_polyC -> : (size p <= 1)%N by rewrite -p1. + by rewrite polyC_eq0 mul0r sgp_right0 ltxx expr0 rootC => /negPf ->. +case/boolP: (root p x) => px; last by rewrite muNroot. +rewrite (mu_deriv px) subn1 -subSS prednK ?mu_gt0// subSnn mulr1n. +by rewrite sgp_right_mul -sgp_right_deriv// -expr2 ltNge sqr_ge0 expr0. +Qed. + +Lemma cindexR_derivp (p : {poly R}) : cindexR p^`() p = size (rootsR p). +Proof. +rewrite -sum1_size /cindexR rmorph_sum big_seq [RHS]big_seq. +by apply/eq_bigr => i; rewrite in_rootsR jump_derivp => /andP[] -> ->. +Qed. + +(* mu_eq0 is stated with rcfType in real_closed.qe_rcf_th *) +Lemma mu_eq0 (F : idomainType) (p : {poly F}) (x : F) : + p != 0 -> (\mu_x p == 0%N) = ~~ root p x. +Proof. by move=> /mu_gt0 <-; rewrite lt0n negbK. Qed. + +Lemma dvdp_mu (F : closedFieldType) (p q : {poly F}) : + p != 0 -> q != 0 -> + (p %| q) = all (fun x => \mu_x p <= \mu_x q)%N (dec_roots p). +Proof. +move: (dec_roots p) (uniq_dec_roots p) (dec_roots_closedP p) + (dec_roots_closedP q) => r. +rewrite -!lead_coefE -lead_coef_eq0. +elim: r p => [p _ pE _ p0 _|x r IHr p /= /andP[] xr runiq pE qE p0 q0]. + by rewrite pE/= big_nil alg_polyC /dvdp modpC ?eqxx// lead_coef_eq0. +rewrite {1}pE big_cons dvdpZl// Gauss_dvdp; last first. + rewrite /coprimep (eqp_size (gcdpC _ _)) -/(coprimep _ _). + apply/coprimep_expr; rewrite coprimep_XsubC root_bigmul -all_predC. + apply/allP => y yr/=. + case: (\mu_y p) => [|n]; first by rewrite expr0 root1. + rewrite root_exp_XsubC; apply/eqP => xy. + by move/negP: xr; rewrite xy. +rewrite root_le_mu//; congr andb. +rewrite -(dvdpZl _ _ p0) IHr//. +- apply/eq_in_all => y yr; congr (_ <= _)%N. + rewrite mu_mulC// mu_prod; last first. + rewrite prodf_seq_neq0; apply/allP => z _ /=. + by rewrite expf_eq0 polyXsubC_eq0 andbF. + under eq_bigr do rewrite mu_exp mu_XsubC mulnbl eq_sym. + by rewrite -big_mkcond/= big_pred1_seq// yr. +- rewrite lead_coefZ lead_coef_prod. + under [in RHS]eq_bigr do rewrite lead_coef_exp lead_coefXsubC expr1n. + rewrite [in RHS]big1_idem//= ?mulr1//; congr (_ *: _). + apply/eq_big_seq => y yr. + rewrite mu_mulC// mu_prod; last first. + rewrite prodf_seq_neq0; apply/allP => z _ /=. + by rewrite expf_eq0 polyXsubC_eq0 andbF. + under eq_bigr do rewrite mu_exp mu_XsubC mulnbl eq_sym. + by rewrite -big_mkcond/= big_pred1_seq// yr. +- rewrite lead_coef_eq0 scaler_eq0 (negPf p0)/= prodf_seq_neq0. + by apply/allP => y _ /=; rewrite expf_eq0 polyXsubC_eq0 andbF. +Qed. + +Lemma mu_eqp (F : closedFieldType) (p q : {poly F}) (x : F) : + p %= q -> \mu_x p = \mu_x q. +Proof. +have [->|p0] := eqVneq p 0; first by rewrite eqp_sym eqp0 => /eqP ->. +have [->|q0] := eqVneq q 0; first by rewrite eqp0 => /eqP <-. +move=> /andP[]; rewrite !dvdp_mu// => /allP/(_ x) pq /allP/(_ x) qp. +apply/le_anti/andP; split. + case/boolP: (x \in dec_roots p) pq => [_ //|+ _]; first by apply. + by rewrite mem_dec_roots p0/= => /muNroot ->. +case/boolP: (x \in dec_roots q) qp => [_ //|+ _]; first by apply. +by rewrite mem_dec_roots q0/= => /muNroot ->. +Qed. + +Lemma mu_gcdp (F : closedFieldType) (p q : {poly F}) (x : F) : + p != 0 -> q != 0 -> + \mu_x (gcdp p q) = minn (\mu_x p) (\mu_x q). +Proof. +wlog: p q / (\mu_x p <= \mu_x q)%N => pq. + case/orP: (leq_total (\mu_x p) (\mu_x q)). + exact/pq. + by rewrite minnC (mu_eqp _ (gcdpC _ _)) => + /[swap]; apply/pq. +rewrite (minn_idPl pq) => p0 q0. +apply/esym/eqP; rewrite -muP//; last first. + by rewrite gcdp_eq0 (negPf p0). +by rewrite !dvdp_gcd root_mu root_muN// root_le_mu// pq. +Qed. + +Lemma mu_deriv (F : idomainType) x (p : {poly F}) : + (((\mu_x p)%:R : F) != 0)%R -> \mu_x (p^`()) = (\mu_x p).-1. +Proof. +move=> 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 Dm eqxx in px0. +rewrite Dp Dm !derivCE exprS mul1r mulrnAr -mulrnAl mulrA -mulrDl. +rewrite cofactor_XsubC_mu // rootE !(hornerE, hornerMn) subrr mulr0 add0r. +by rewrite -mulr_natr mulf_neq0// -Dm. +Qed. + +Lemma cindexR_mulCp (c : R) (p q : {poly R}) : + cindexR (c *: p) q = sgz c * cindexR p q. +Proof. +rewrite /cindexR mulr_sumr. +by under eq_bigr do rewrite jump_mulCp. +Qed. + +Lemma changes_rcons (x : R) (s : seq R) : + changes (rcons s x) = ((last 0 s * x < 0)%R + changes s)%N. +Proof. +elim: s => [|y s IHs]; first by rewrite /= mulrC. +rewrite /= {}IHs; case: s => [|z s] /=; first by rewrite mul0r mulr0. +by rewrite !addnA [((y * z < 0)%R + _)%N]addnC. +Qed. + +Lemma changes_rev (s : seq R) : changes (rev s) = changes s. +Proof. +move nE: (size s) => n. +elim: n s nE => [|n IHn] s nE; first by rewrite (size0nil nE). +case: s nE => [//|] x s/= /eqP; rewrite eqSS => /eqP sn. +by rewrite rev_cons changes_rcons last_rev mulrC IHn. +Qed. + +Lemma changesE (s : seq R) : + changes s = \sum_(i < (size s).-1) ((s`_i * s`_i.+1 < 0)%R : nat). +Proof. +elim: s => /= [|x + ->]; first by rewrite big_ord0. +case=> /= [|y s]; first by rewrite !big_ord0 mulr0 ltxx. +by rewrite big_ord_recl/=. +Qed. + +Lemma gcdp_mul (F : closedFieldType) (p q : {poly F}) : + p != 0 -> q != 0 -> + gcdp p q %= + \prod_(x <- dec_roots p) ('X - x%:P) ^+ (minn (\mu_x p) (\mu_x q)). +Proof. +move=> p0 q0. +have pq0 : gcdp p q != 0 by rewrite gcdp_eq0 (negPf p0). +have pq0' : + \prod_(x <- dec_roots p) ('X - x%:P) ^+ minn (\mu_x p) (\mu_x q) != 0. + rewrite prodf_seq_neq0; apply/allP => x _ /=. + by rewrite expf_eq0 polyXsubC_eq0 andbF. +by apply/andP; split; rewrite dvdp_mu//; apply/allP => x _; + rewrite mu_gcdp// mu_prod//; + under eq_bigr do rewrite mu_exp mu_XsubC mulnbl eq_sym; + rewrite -big_mkcond/= big_pred1_seq// ?uniq_dec_roots//; + case: ifP => //; rewrite mem_dec_roots p0 => /= /negP/negP /muNroot ->; + rewrite min0n. +Qed. + +Lemma size_dec_roots (F : closedFieldType) (p : {poly F}) : + [char F] =i pred0 -> + size (dec_roots p) = (size (p %/ gcdp p p^`())).-1. +Proof. +move=> F0. +have /= [->|p0] := eqVneq p 0. + rewrite div0p size_poly0/=. + case rE : (dec_roots 0) => [//|x r]. + have: x \in (dec_roots 0) by rewrite rE mem_head. + by rewrite mem_dec_roots eqxx. +have [p'0|p'0] := eqVneq p^`() 0. + rewrite p'0 gcdp0 divpp// size_polyC oner_neq0/=. + have /size1_polyC ->: (size p <= 1)%N. + move: (size_deriv p F0); rewrite p'0 size_poly0. + by case: (size p) => [//|]; case. + case rE: (dec_roots _) => [//|x r]. + by move: (mem_head x r); rewrite -rE mem_dec_roots rootC polyC_eq0 andNb. +rewrite (eqp_size (eqp_divr p (gcdp_mul p0 p'0))). +move: (dec_roots_closedP p) => pE. +rewrite {2}pE -lead_coefE divpZl size_scale ?lead_coef_eq0//. +rewrite divp_prod_dvdp; last first. + move=> x _. + rewrite root_le_mu; last by rewrite expf_eq0 polyXsubC_eq0 andbF. + by rewrite mu_exp mu_XsubC eqxx mul1n geq_minl. +rewrite big_seq_cond. +under eq_bigr => x. + rewrite andbT mem_dec_roots => /andP[_] px. + rewrite -expp_sub ?polyXsubC_eq0// ?geq_minl//. + rewrite mu_deriv; last first. + rewrite (proj1 (charf0P _) F0) mu_eq0// px//. + rewrite (minn_idPr (leq_pred _)) subn_pred// ?mu_gt0// subnn expr1. +over. +rewrite -big_seq_cond size_prod_seq; last first. + by move=> x _; rewrite polyXsubC_eq0. +under eq_bigr do rewrite size_XsubC. +rewrite big_const_seq count_predT iter_addn_0 subSKn. +by rewrite mul2n subDnAC// subnn. +Qed. + +End MoreRealClosed. diff --git a/continuity_roots.v b/continuity_roots.v new file mode 100644 index 0000000..3704d7c --- /dev/null +++ b/continuity_roots.v @@ -0,0 +1,488 @@ +From HB Require Import structures. +From mathcomp Require Import ssreflect ssrfun ssrbool eqtype choice seq ssrnat. +From mathcomp Require Import bigop fintype tuple order ssralg ssrnum poly. +From mathcomp Require Import polydiv complex polyorder matrix topology. +From mathcomp Require Import normedtype signed classical_sets. + +Import Order.POrderTheory Order.TotalTheory GRing.Theory Num.Theory Num.Def. +Import complex numFieldTopology.Exports. + +Require Import auxresults. + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Local Open Scope ring_scope. +Local Open Scope complex_scope. +Local Open Scope classical_set_scope. + +Section ContinuityRoots. +Variable (R : rcfType). + +Definition alignp eps (p q : {poly R[i]}) := + {in root p, forall u, + (\sum_(v <- dec_roots q | (`|v - u| < eps)%R) \mu_v q >= \mu_u p)%N}. + +Definition deformp eps (p q : {poly R[i]}) := + (size q <= size p)%N /\ forall i : 'I_(size p), `|p`_i - q`_i| < eps. + +Lemma close_root_deformp (eps : R[i]) (p : {poly R[i]}) : 0 < eps -> + exists delta : R[i], 0 < delta /\ + forall q, deformp delta p q -> + forall x, root p x -> exists y, root q y /\ `|x - y| < eps. +Proof. +wlog : eps / eps <= 1 => [H|eps1 eps0]. + case: eps => eR eI. + rewrite ltcE/= => /andP[/eqP ->] e0. + case: (H (minr (eR)%:C 1)) => [||delta [d0]dP] {H}. + - rewrite lecE /minr -(fun_if (fun x => x%:C))/= ltcE/= eqxx/=. + by rewrite ge_min lexx orbT. + - rewrite ltcE /minr -(fun_if (fun x => x%:C))/= ltcE/= eqxx/= . + by rewrite lt_min e0 ltr01. + exists delta; split=> [//|] q /dP {}dP x /dP [y] [qy] xy. + exists y; split=> //; apply/(lt_le_trans xy). + by rewrite lecE /minr -(fun_if (fun x => x%:C))/= ltcE/= eqxx/= ge_min lexx. +case sp: (size p) => [|n]. + exists 1; split=> [//|] q [sq] _ x _; exists x; split; last first. + by rewrite subrr normr0. + by move: sq; rewrite sp size_poly_leq0 => /eqP ->; apply/root0. +pose M := (\big[maxr/1]_(x <- dec_roots p) Re `|x|)%:C. +have M1 : 1 <= M. + rewrite /M lecE/= eqxx/=. + exact/Order.TotalTheory.bigmax_ge_id. +exists ((`|p`_(ord_max : 'I_n.+1)|) * ((eps / M) ^+ n / (n.+1%:R *+ 4))). +split=> [|q [sq]]. + apply/mulr_gt0; last first. + by rewrite divr_gt0// exprn_gt0// divr_gt0// (lt_le_trans (ltr01)). + rewrite normr_gt0; apply/eqP => p0. + suff: (size p <= n)%N by rewrite sp ltnn. + apply/leq_sizeP => i; rewrite leq_eqVlt => /orP; case=> [/eqP <- //|ni]. + have/leq_sizeP: (size p <= n.+1)%N by rewrite sp. + exact. +rewrite sp => qcoef; move: (qcoef ord_max) => /(le_lt_trans (lerB_dist _ _)). +rewrite ltrBlDl -ltrBlDr -[X in X - _]mulr1 -mulrBr. +have: 1 / 2 <= (1 - (eps / M) ^+ n / (n.+1%:R *+ 4)). + rewrite ler_pdivrMr ?ltr0n// mulrBl lerBrDr -lerBrDl [1 * 2]mulr_natr. + rewrite -{2}[2]natr1 -addrA subrr addr0 -[2]divr1 mulf_div mulr1. + rewrite -[4%N]/(2 * 2)%N mulrnA -[X in _ / X]mulr_natr -mulf_div. + rewrite divff ?pnatr_eq0// mulr1 -mulr_natr -natrM. + rewrite ler_pdivrMr ?ltr0n ?muln_gt0// mul1r. + have le1: (eps / M) ^+ n <= 1. + apply/exprn_ile1. + apply/divr_ge0; first exact/ltW. + exact/(le_trans ler01). + rewrite ler_pdivrMr ?mul1r; last exact/(lt_le_trans ltr01). + exact/(le_trans eps1). + by apply/(le_trans le1); rewrite ler1n muln_gt0. +move=> /(ler_pM _ _ (lexx (normr p`_ord_max))) => /(_ n (normr_ge0 _)). +rewrite div1r invr_ge0 => /(_ (ler0n _ _)). +move=> le2 /(le_lt_trans le2) {le2} /= pqn x px. +have n0: (0 < n)%N. + rewrite lt0n; apply/eqP => n0; move: sp; rewrite n0 => ps. + have /size1_polyC pE : (size p <= 1)%N by rewrite ps. + by move: px ps; rewrite pE rootC => /eqP ->; rewrite size_polyC eqxx. +have qn0: q`_n != 0. + apply/eqP => qn. + move: pqn; rewrite qn normr0 ltr_pdivrMr ?ltr0n// mul0r. + by move=> /(le_lt_trans (normr_ge0 _)); rewrite ltxx. +have {}sq : size q = n.+1. + apply/eqP; rewrite eqn_leq; apply/andP; split; first by rewrite -sp. + exact/gt_size. +case: (closed_field_poly_normal q) => /= r; rewrite lead_coefE sq -pred_Sn => qE. +move: (sq); rewrite qE size_scale// size_prod_seq; last first. + by move=> i _; rewrite polyXsubC_eq0. +under eq_bigr do rewrite size_XsubC. +rewrite big_const_seq count_predT iter_addn_0 subSn ?leq_pmull// mul2n -addnn. +rewrite subDnCA// subnn addn0 => /eqP. +rewrite eqSS => /eqP sr. +pose m := (\big[Order.min/Re `|x - head 0 r|]_(z <- r) Re `|x - z|)%:C. +have m0: 0 <= m. + rewrite /m lecE/= eqxx/=. + rewrite le_bigmin -lecR (normr_ge0 (x - _)); apply/allP => y _ /=. + by rewrite -lecR (normr_ge0 (x - y)). +have: `|p`_n| / 2 * m ^+ n <= `|q.[x]|. + rewrite qE hornerE horner_prod normrM normr_prod; apply/ler_pM. + - apply/divr_ge0; [apply/normr_ge0|apply/ler0n]. + - exact/exprn_ge0. + - exact/ltW. + rewrite -sr -prodr_const_seq big_seq [X in _ <= X]big_seq. + apply/ler_prod => y yr; apply/andP; split=> //. + rewrite !hornerE -[`|x - y|]RRe_real ?normr_real// /m lecR. + rewrite bigmin_le; apply/orP; right; apply/hasP; exists y => //=. +rewrite -[q.[x]]subr0 -{2}(rootP px) distrC -hornerN -hornerD. +rewrite -[p - q]coefK horner_poly => mle. +move: (le_trans mle (ler_norm_sum _ _ _)). +under eq_bigr do rewrite normrM normrX coefD coefN; move=> {}mle. +have: normr (p`_n) / 2 * m ^+ n <= + \sum_(i < size (p - q)) + normr p`_n * ((eps / M) ^+ n / (n.+1%:R *+ 4)) * M ^+ n. + apply/(le_trans mle)/ler_sum; case=> i/= ipq _. + have ilt : (i < n.+1)%N. + rewrite -[n.+1]maxnn -{1}sp -sq -[size q]size_opp. + exact/(leq_trans ipq)/size_add. + apply/ler_pM. + - exact/normr_ge0. + - exact/exprn_ge0/normr_ge0. + - exact/ltW/(qcoef (Ordinal ilt)). + rewrite ltnS in ilt; rewrite -(subnKC ilt) exprD -[X in X <= _]mulr1. + apply/ler_pM. + - exact/exprn_ge0/normr_ge0. + - exact/ler01. + - rewrite -[M ^+ i]mul1r -ler_pdivrMr; last first. + exact/exprn_gt0/(lt_le_trans ltr01). + rewrite -expr_div_n; apply/exprn_ile1. + by apply/divr_ge0; [apply/normr_ge0|apply/(le_trans ler01)]. + rewrite ler_pdivrMr ?mul1r /M; last exact/(lt_le_trans ltr01). + rewrite -[X in X <= _]RRe_real ?normr_real// lecR. + rewrite le_bigmax; apply/orP; right; apply/hasP; exists x => //=. + by rewrite mem_dec_roots -size_poly_leq0 sp. + - exact/exprn_ege1. +rewrite sumr_const card_ord -[(_ * _) *+ _]mulr_natr -!mulrA -subr_ge0 -mulrBr. +rewrite pmulr_rge0; last first. + rewrite normr_gt0; apply/eqP => pn. + suff: (size p <= n)%N by rewrite sp ltnn. + apply/leq_sizeP => i; rewrite leq_eqVlt => /orP[/eqP <- //|]. + by rewrite -sp => /leq_sizeP/(_ i (leqnn i)). +rewrite subr_ge0 mulrC expr_div_n -[_ *+ 4]mulr_natr [_^-1 * _]mulrC. +rewrite [_ * 4]mulrC -mulf_div [X in _ <= X]mulrA mulf_div [_ * 4]mulrC. +rewrite -mulf_div divff; last exact/expf_neq0/lt0r_neq0/(lt_le_trans ltr01). +rewrite mulr1 => {}mle. +have /(le_trans mle) {}mle: + eps ^+ n / 4 * ((size (p - q))%:R / n.+1%:R) <= eps ^+ n / 4. + rewrite -[X in _ <= X]mulr1; apply/ler_pM. + - apply/mulr_ge0; first exact/exprn_ge0/ltW. + by rewrite invr_ge0. + - exact/divr_ge0. + - exact/lexx. + rewrite mulrC ler_pdivrMl ?ltr0n// mulr1 ler_nat -(maxnn n.+1) -{1}sp -sq. + by rewrite -(size_opp q) size_add. +have /(le_lt_trans mle) : eps ^+ n / 4 < eps ^+ n / 2. + rewrite mulrC ltr_pdivrMl ?ltr0n// -[4%N]/((2 * 2)%N) natrM mulrACA. + rewrite divff ?pnatr_eq0// mulr1 mulrC mulr_natr mulr2n -subr_gt0 -addrA. + by rewrite subrr addr0 exprn_gt0. +rewrite -subr_gt0 -(@pmulr_rgt0 _ 2%:R)// mulrBr subr_gt0 mulrCA. +rewrite divff ?pnatr_eq0// mulr1 mulrCA divff ?pnatr_eq0//. +rewrite -ltr_pdivrMl ?exprn_gt0// mulrC -expr_div_n expr_lt1//; last first. + by apply/mulr_ge0 => //; rewrite invr_ge0 ltW. +rewrite mulrC ltr_pdivrMl// mulr1 /m -[eps]RRe_real ?gtr0_real// ltcR. +rewrite bigmin_lt; case: r {qE m m0 mle} sr n0 => [<- //|] y r sr n0/=. +rewrite orbA orbb -/(has _ (y :: r)) => /hasP [z] zr zx. +exists z; split; last by rewrite -[`|x - z|]RRe_real ?normr_real// ltcR. +rewrite rootZ// root_bigmul; apply/hasP; exists z => //=. +by rewrite root_XsubC. +Qed. + +Lemma rm_root_poly (p : {poly R[i]}) (x : R[i]) : + x != 0 -> + root p x -> + p %/ ('X - x%:P) + = \poly_(i < (size p).-1) (- x ^- (i.+1) * \sum_(j < i.+1) p`_j * x ^+ j). +Proof. +move=> x0 /factor_theorem [q] ->. +have X0 : ('X - x%:P != 0) by rewrite polyXsubC_eq0. +rewrite mulpK//. +have [->|q0] := eqVneq q 0. + by rewrite mul0r size_poly0 poly_def big_ord0. +rewrite size_mul// size_XsubC addn2 -!pred_Sn. +apply/polyP => i; rewrite coef_poly. +case: (ltnP i (size q)) => [|/leq_sizeP/(_ i (leqnn i))//] iq. +rewrite mulNr -mulrN -sumrN. +under eq_bigr do rewrite mulrBr coefD coefN mulrBl coefMC -mulrA -exprS opprB. +under eq_bigr do rewrite coefMX {1}[X in q`_X]pred_Sn. +pose f i := (if i == 0%N then 0 else q`_i.-1) * x ^+ i. +rewrite -(big_mkord xpredT (fun i => f (i.+1) - f i)) telescope_sumr// /f/=. +rewrite mul0r subr0 mulrCA [X in _ * X]mulrC divff ?mulr1//. +exact/expf_neq0. +Qed. + +Lemma close_rm_root (eps : R[i]) (p : {poly R[i]}) (xp : R[i]) : + 0 < eps -> xp != 0 -> root p xp -> + exists delta, 0 < delta /\ + forall (q : {poly R[i]}) (xq : R[i]), + root q xq -> deformp delta p q -> `|xp - xq| < delta -> + deformp eps (p %/ ('X - xp%:P)) (q %/ ('X - xq%:P)). +Proof. +move=> e0 xp0 pxp /=. +have [->|] := poly0Vpos p. + exists 1; split=> [//|] q xq qxq []; rewrite size_poly0 => /size_poly_leq0P. + by move=> -> _ _; rewrite !div0p; split=> //; case; rewrite size_poly0. +move sp: (size p) => n; case: n sp => // n sp _. +pose f := fun i (x : 'rV[R[i]^o]_n.+1 * (R[i]^o)) => + - (x.2 ^- i.+1) * \sum_(j < n.+1 | (j <= i)%N) x.1 ord0 j * x.2 ^+ j. +have cont : forall i, {for (\row_(i < n.+1) p`_i, xp), continuous (f i)}. + move=> i /=. + apply/(@continuousM R[i] ('rV[R[i]^o]_n.+1 * (R[i]^o))%type). + apply/(@continuousN R[i] R[i]^o ('rV[R[i]^o]_n.+1 * (R[i]^o))%type). + apply/continuousV; first by rewrite expf_eq0. + apply/continuousX. + apply/cvg_snd. + apply/(@continuous_sum R[i] R[i]^o ('rV[R[i]^o]_n.+1 * (R[i]^o))%type). + move=> j ji. + apply/(@continuousM R[i] ('rV[R[i]^o]_n.+1 * (R[i]^o))%type); last first. + exact/continuousX/cvg_snd. + apply/(@eq_continuous_at ('rV[R[i]^o]_n.+1 * (R[i]^o))%type _ + ((fun x : 'rV[R[i]^o]_n.+1 => x ord0 j) \o fst)) => //. + apply/continuous_comp; first exact/cvg_fst. + exact/coord_continuous. +have /fin_all_exists /=: forall i : 'I_n.+1, + exists delta, 0 < delta /\ + forall (q : {poly R[i]}) (xq : R[i]), + deformp delta p q -> normr (xp - xq) < delta -> + `|f i (\row_(i < n.+1) p`_i, xp) - f i (\row_(i < n.+1) q`_i, xq)| < eps. + move=> i. + move/(_ i): cont => /= /cvgr_dist_lt /(_ eps e0) [][]/= Vp Vx []/=. + move=> /nbhs_ballP [dp/= +] dVp /nbhs_ballP [dx/= +] dVx Vpx. + rewrite !ltcE/= => /andP[/eqP dpi dp0] /andP[/eqP dxi dx0]. + exists (minr (Re dp) (Re dx))%:C. + split=> [|q xq [] _ dpq xpq]; first by rewrite ltcR lt_min dp0. + apply/Vpx; split=> /=; last first. + apply/dVx/(lt_le_trans xpq). + by rewrite lecE/= dxi eqxx/= ge_min lexx orbT. + apply/dVp; case; case=> // ltn01 j. + move: dpq; rewrite sp !mxE => /(_ j) dpq. + apply/(lt_le_trans dpq). + by rewrite lecE/= dpi eqxx/= ge_min lexx. +move=> [delta] deltaP. +exists (\big[minr/minr (Re `|xp|) (Re `|p`_n|)]_(i < n.+1) Re (delta i))%:C. +split=> [|q xq qxq [] spq]. + rewrite ltcR lt_bigmin lt_min -!ltcR RRe_real ?normr_real// normr_gt0 xp0/=. + apply/andP; split; last first. + by apply/allP => /= i _; case/(_ i): deltaP; rewrite ltcE/= => /andP[_ +] _. + rewrite (normr_gt0 (p`_n)); apply/eqP => pn0. + suff: (size p <= n)%N by rewrite sp ltnn. + apply/leq_sizeP => j; rewrite leq_eqVlt => /orP[/eqP <- //|nj]. + by have/leq_sizeP/(_ j nj): (size p <= n.+1)%N by rewrite sp. +rewrite sp => dpq. +rewrite -(RRe_real (normr_real _)) ltcR lt_bigmin lt_min -!ltcR. +rewrite !(RRe_real (normr_real _)) => /andP[] /andP[xpq] xqpn /allP xdelta. +rewrite /deformp !size_divp ?polyXsubC_eq0// !size_XsubC/= !subn1. +split. + move: spq; rewrite sp succnK -[(_ <= n)%N]ltnS. + by case: (size q). +rewrite sp succnK => i. +rewrite rm_root_poly// coef_poly sp ltn_ord rm_root_poly//; last first. + by apply/eqP => xq0; move: xpq; rewrite xq0 subr0 ltxx. +rewrite coef_poly. +have sq: size q = size p. + apply/anti_leq; rewrite spq/= sp; apply/gt_size/eqP => qn0. + move/(_ ord_max): dpq; rewrite -(RRe_real (normr_real _)) ltcR lt_bigmin. + by rewrite lt_min qn0 subr0 ltxx andbF. +rewrite sq sp ltn_ord. +move/(_ (lift ord_max i)): deltaP => [d0] /(_ q xq) /=. +have /[swap]/[apply]: deformp (delta (lift ord_max i)) p q. + split; first by rewrite sq. + rewrite sp => j; apply/(lt_le_trans (dpq j)). + rewrite -(RRe_real (gtr0_real d0)) lecR bigmin_le; apply/orP; right. + apply/hasP; exists (lift ord_max i); first exact/mem_index_enum. + exact/lexx. +have /[swap]/[apply]: normr (xp - xq) < delta (lift ord_max i). + rewrite -(RRe_real (gtr0_real d0)) ltcR. + exact/xdelta/mem_index_enum. +rewrite /lift /= /bump leqNgt ltn_ord add0n /f/=. +congr (`|_ * _ - _ * _| < _); + under eq_bigr do rewrite mxE. + rewrite (big_ord_iota _ n.+1 (fun i0 => (i0 <= i)%N) + (fun i => p`_i * xp ^+ i)). + rewrite -big_filter -{1}[i : nat]add0n filter_iota_leq. + by rewrite -big_ord_iota. + by rewrite ltnS; apply/ltnW. +rewrite (big_ord_iota _ n.+1 (fun i0 => (i0 <= i)%N) (fun i => q`_i * xq ^+ i)). +rewrite -big_filter -{1}[i : nat]add0n filter_iota_leq. + by rewrite -big_ord_iota. +by rewrite ltnS; apply/ltnW. +Qed. + +Lemma deformpW (e e' : R[i]) (p q : {poly R[i]}) : + e <= e' -> deformp e p q -> deformp e' p q. +Proof. by move=> ee [spq pqe]; split=> // i; apply/(lt_le_trans (pqe i)). Qed. + +Lemma aligned_deformed (eps : R[i]) (p : {poly R[i]}) : + 0 < eps -> + exists delta, 0 < delta /\ forall q, deformp delta p q -> alignp eps p q. +Proof. +wlog : eps / eps < 1 => [H|e1 e0]. + case: eps => eR eI. + rewrite ltcE/= => /andP[/eqP ->] e0. + case: (H (minr eR (1 / 2))%:C) => /= [||delta [d0 dP]] {H}. + - by rewrite ltcR gt_min ltr_pdivrMr// mul1r -[1]/(1%:R) ltr_nat leqnn orbT. + - rewrite ltcR lt_min e0/=; apply/mulr_gt0; first exact: ltr01. + by rewrite invr_gt0 ltr0n. + exists delta; split=> // q /dP pq i /pq ple. + apply/(leq_trans ple). + rewrite complexr0 big_mkcond [X in (_ <= X)%N]big_mkcond/=. + apply/leq_sum => x _; rewrite -(RRe_real (normr_real _)) !ltcR lt_min andbC. + by case: (Re `|x - i| < 1 / 2)%R. +have [->|sp] := poly0Vpos p. + by exists 1; split=> [//|q _] x _; rewrite mu0. +move: sp; move sp: (size p) => n; case: n sp => // n. +elim: n p => /= [|n IHn] p sp _. + have p0: p != 0 by apply/eqP => p0; move: sp; rewrite p0 size_poly0. + by exists 1; split=> [//|q _ x /root_size_gt1] => /(_ p0); rewrite sp. +have p0: p != 0 by apply/eqP => p0; move: sp; rewrite p0 size_poly0. +case/boolP: (all (fun x => x == 0) (dec_roots p)) => [root0|/allPn[x]]. + have r0: dec_roots p = [:: 0]. + case: (dec_roots p) (uniq_dec_roots p) (mem_dec_roots p) root0 + => [|x r] ru memr /allP r0. + have /closed_rootP [x]: size p != 1 by rewrite sp. + by move: memr; rewrite p0/= => <-. + move: (r0 x); rewrite in_cons eqxx/= => /(_ isT) /eqP x0; rewrite x0. + case: r ru {memr} r0 => // y r /= /andP[+ _] /(_ y). + rewrite !in_cons negb_or eqxx orbT/= x0 eq_sym. + by move=> /andP[/negP y0 _] /(_ isT). + move: (dec_roots_closedP p). + rewrite r0 big_seq1 subr0 => pE. + have pn: p`_(size p).-1 != 0 by rewrite -lead_coefE lead_coef_eq0. + rewrite pE; have -> : \mu_0 p = n.+1. + move: pE => /(congr1 (fun p : {poly R[i]} => size p)). + by rewrite size_scale// size_polyXn sp => /eqP; rewrite eqSS => /eqP. + move: {p p0 sp root0 r0 pE} (p`_(size p).-1) pn => a a0. + pose d := eps ^+ n.+1 * `|a| / n.+1.*2%:R. + exists d; split=> [|q []]. + apply/mulr_gt0; last by rewrite invr_gt0 ltr0n double_gt0. + apply/mulr_gt0; first exact/exprn_gt0. + by rewrite normr_gt0. + rewrite size_scale// size_polyXn => sq qnth. + move: (qnth ord_max); rewrite coefZ coefXn eqxx mulr1/= => qn. + have {}qnth (i : 'I_n.+1): `|q`_i| < d. + move/(_ (lift ord_max i)): qnth. + rewrite coefZ coefXn /lift/= /bump ltnNge -ltnS ltn_ord add0n. + move: (ltn_ord i); rewrite ltn_neqAle => /andP[] /negPf -> _. + by rewrite mulr0 add0r normrN. + move=> x; rewrite rootE -rootE rootZ// rootE !hornerE expf_eq0/= => /eqP ->. + rewrite mu_mulC// mu_exp -['X]subr0 mu_XsubC eqxx mul1n big_mkcond big_seq. + rewrite big_mkcond/=. + have da2 : d < `|a| / 2. + rewrite /d -muln2 natrM -mulf_div -[X in _ < X]mul1r -subr_gt0 -mulrBl. + apply/mulr_gt0; last by apply/mulr_gt0 => //; rewrite normr_gt0. + rewrite subr_gt0 ltr_pdivrMr ?ltr0n// mul1r. + apply/(lt_le_trans (y:=1)); last by rewrite ler1n. + by rewrite exprn_ilt1// ltW. + have da : d < `|a|. + apply/(lt_le_trans da2); rewrite ler_pdivrMr// ler_peMr// -[1]/(1%:R). + by rewrite ler_nat. + have aqn : `|a| / 2 < `|q`_n.+1|. + move: da2 => /(lt_trans qn)/(le_lt_trans (lerB_dist _ _)). + rewrite -[_ - _ < _]subr_gt0 opprD opprK addrA -{2}[`|a|]mulr1. + rewrite -{2}(divff (x:=2))// mulrCA mulr_natl [_ / _ *+ _]mulr2n opprD. + by rewrite addrA subrr add0r addrC subr_gt0. + have {sq} : size q = n.+2. + apply/anti_leq/andP; split=> //; rewrite ltnNge; apply/negP. + move=> /leq_sizeP /( _ n.+1 (leqnn _)) q0. + by move: qn; rewrite q0 subr0 => /(lt_trans da); rewrite ltxx. + have [->|q0 sq] := eqVneq q 0; first by rewrite size_poly0. + have qn0 : q`_(size q).-1 != 0 by rewrite -lead_coefE lead_coef_eq0. + move: (dec_roots_closedP q) => /(congr1 (fun p : {poly R[i]} => size p)). + rewrite size_scale// size_prod_seq => [|i _]; last first. + by apply/expf_neq0; rewrite polyXsubC_eq0. + under eq_bigr do rewrite size_exp_XsubC -addn1. + rewrite big_split/= sum1_size -addSn -subnBA// subnn subn0 sq => /eq_add_S ->. + move: qn0; rewrite sq -pred_Sn => qn0. + rewrite big_seq big_mkcond/=. + apply/leq_sum => y _; rewrite subr0. + case/boolP: (y \in dec_roots q) => // yq. + suff ->: (`|y| < eps)%O by []. + have [->|y0] := eqVneq y 0; first by rewrite normr0. + move: yq; rewrite mem_dec_roots q0/= => /rootP. + rewrite -{1}[q]coefK horner_poly sq big_ord_recr/= addrC => /addr0_eq => yq. + have y1: `|y| < 1. + rewrite -(RRe_real (normr_real _)) ltcR ltNge; apply/negP. + rewrite -lecR RRe_real ?normr_real// => y1. + have: `|a| / 2 * `|y| ^+ n.+1 < d * n.+1%:R * `|y| ^+ n. + apply/(lt_le_trans (y:=`|- q`_n.+1 * y ^+ n.+1|)). + rewrite normrM normrN normrX -subr_gt0 -mulrBl pmulr_rgt0. + by apply/exprn_gt0; rewrite normr_gt0. + by rewrite subr_gt0. + rewrite mulNr yq; apply/(le_trans (ler_norm_sum _ _ _)). + rewrite -[X in _ * X%:R * _]sum1_ord natr_sum mulr_sumr mulr_suml. + apply/ler_sum => i _. + rewrite normrM mulr1; apply/ler_pM. + - exact/normr_ge0. + - exact/normr_ge0. + - exact/ltW. + by rewrite normrX ler_p1X// -ltnS. + rewrite exprS mulrA -subr_gt0 -mulrBl pmulr_lgt0; last first. + exact/(lt_le_trans ltr01)/exprn_ege1. + rewrite subr_gt0 /d -mul2n natrM invrM ?unitfE// [_ / 2]mulrC -!mulrA. + rewrite mulVf// mulr1 mulrA mulrC -subr_gt0 -mulrBl. + rewrite pmulr_lgt0 ?subr_gt0; last by rewrite divr_gt0// normr_gt0. + move=> /(le_lt_trans y1); rewrite expr_gt1// ?ltW// => /(lt_trans e1). + by rewrite ltxx. + have: 1 < n.+1.*2%:R * d / `|a| / `|y| ^+ n.+1. + rewrite -muln2 natrM -[X in X%:R * _]sum1_ord natr_sum !mulr_suml. + move/(congr1 (fun x => `|x / (q`_n.+1 * y ^+ n.+1)|)): yq. + rewrite mulNr normrN divff; last first. + by rewrite mulf_eq0 negb_or expf_eq0 qn0. + rewrite normr1 mulr_suml => {1}->. + apply/(le_lt_trans (ler_norm_sum _ _ _)). + rewrite -subr_gt0 -sumrB; apply/psumr_gt0 => [i _|]; last first. + by apply/hasP; exists ord0. + rewrite subr_gt0 mul1r !normrM normrV; last first. + by rewrite unitfE mulf_eq0 negb_or expf_eq0 qn0. + rewrite normrM !normrX [2 * _]mulrC -mulf_div mulrA -subr_gt0 -mulrBl. + rewrite pmulr_lgt0; last by rewrite invr_gt0 exprn_gt0// normr_gt0. + rewrite subr_gt0 -2!mulrA ltr_pM//. + move: aqn; rewrite ltr_pdivrMr// -ltr_pdivrMl ?normr_gt0//. + rewrite -ltr_pdivlMr ?normr_gt0// => aqn. + have [->|i0] := (posnP i); first by rewrite expr0 mulr1. + by rewrite -[X in _ < X]mulr1 ltr_pM// expr_lt1. + rewrite /d mulrCA divff// mulr1 mulrC -!mulrA divff ?normr_eq0// mulr1 mulrC. + rewrite -expr_div_n expr_gt1//. + by rewrite ltr_pdivlMr ?normr_gt0// mul1r. + exact/divr_ge0/normr_ge0/ltW. +rewrite mem_dec_roots => /andP[_] px x0. +have /IHn {IHn} /(_ isT) [d [d0] dP]: size (p %/ ('X - x%:P)) = n.+1. + by rewrite size_divp ?polyXsubC_eq0// sp size_XsubC/= subn1 -pred_Sn. +move: (close_rm_root d0 x0 px) => /= [d'][d'0] d'P. +have de0 : 0 < (minr (Re eps) (Re d'))%:C. + by rewrite ltcR lt_min -!ltcR !(RRe_real (gtr0_real _))// e0. +move: (close_root_deformp p de0) => [d''][d''0]d''P. +exists (minr (Re d') (minr (Re `|lead_coef p|) (Re d'')))%:C; split=> [|q]. + rewrite ltcR !lt_min -!ltcR (RRe_real (gtr0_real d'0)) d'0. + rewrite (RRe_real (gtr0_real d''0)) (RRe_real (normr_real _)) normr_gt0. + by rewrite lead_coef_eq0 p0. +have [-> [_]|q0 pq] := eqVneq q 0. + rewrite sp => /(_ ord_max); rewrite coef0 subr0 -(RRe_real (normr_real _)). + by rewrite ltcR !lt_min lead_coefE sp -pred_Sn ltxx andbF. +have /d''P/(_ _ px) [y [qy]] : deformp d'' p q. + apply/(deformpW _ pq). + by rewrite -{2}(RRe_real (gtr0_real d''0)) lecR !ge_min lexx !orbT. +rewrite -(RRe_real (normr_real _)) ltcR lt_min -!ltcR (RRe_real (normr_real _)). +rewrite !(RRe_real (gtr0_real _))// => /andP[] xye xyd. +have /(d'P _ _ qy)/(_ xyd)/dP pqe : deformp d' p q. + apply/(deformpW _ pq). + by rewrite -{2}(RRe_real (gtr0_real d'0)) lecR ge_min lexx. +move=> u pu. +have /divpK pxE: 'X - x%:P %| p by rewrite -root_factor_theorem. +case/boolP: (u \in root (p %/ ('X - x%:P))). + move=>/pqe. + rewrite -{2}pxE mu_mul; last by rewrite pxE. + move=> le. + have /divpK qyE: 'X - y%:P %| q by rewrite -root_factor_theorem. + move: (q0); rewrite -{1 3}qyE => q0'. + under eq_bigr do rewrite mu_mul//. + rewrite big_split/=; apply/leq_add. + apply/(leq_trans le)/(uniq_sub_le_big leqnn). + - move=> a b /=; exact/leq_addr. + - exact/uniq_dec_roots. + - exact/uniq_dec_roots. + - by move=> a; rewrite 2!mem_dec_roots q0 -{3}qyE rootM => /andP[_] ->. + rewrite mu_XsubC; have [->|//] := eqVneq u x. + rewrite big_mkcond/= (bigD1_seq y)/=. + - by rewrite -normrN opprB xye mu_XsubC eqxx add1n. + - by rewrite mem_dec_roots q0. + - exact/uniq_dec_roots. +move: pu; rewrite -{1}pxE mem_root => /rootP /rootP. +rewrite rootM root_XsubC => /orP[pu|/eqP ->]. + by rewrite mem_root => /rootP /rootP /negP. +rewrite mem_root => /rootP /rootP px0. +have ->: \mu_x p = 1. + by rewrite -pxE mu_mul ?pxE// muNroot// mu_XsubC eqxx. +rewrite big_mkcond/= (bigD1_seq y)/=. +- rewrite -normrN opprB xye -[X in (X <= _)%N]/(1 + 0)%N; apply/leq_add => //. + by rewrite mu_gt0. +- by rewrite mem_dec_roots q0. +- exact/uniq_dec_roots. +Qed. + +End ContinuityRoots. diff --git a/cylinder.v b/cylinder.v new file mode 100644 index 0000000..796bacb --- /dev/null +++ b/cylinder.v @@ -0,0 +1,2426 @@ +From mathcomp Require Import freeg ssreflect ssrfun ssrbool eqtype choice seq. +From mathcomp Require Import ssrnat prime binomial bigop tuple order fintype. +From mathcomp Require Import finfun path ssralg ssrnum ssrint poly matrix. +From mathcomp Require Import finmap mpoly complex interval. +From mathcomp Require Import polydiv polyrcf polyorder qe_rcf qe_rcf_th. + +(* TODO: the following imports should not be needed after cleanup. *) +From mathcomp Require Import generic_quotient classical_sets topology normedtype. + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Import Order.POrderTheory Order.TotalTheory. +Import GRing.Theory Num.Theory Num.Def. +Import GRing. +Import numFieldTopology.Exports. +Import ordered_qelim.ord. + +Require Import auxresults formula subresultant semialgebraic topology. +Require Import continuity_roots. + +Local Open Scope type_scope. +Local Open Scope classical_set_scope. +Local Open Scope fset_scope. +Local Open Scope fmap_scope. +Local Open Scope ring_scope. +Local Open Scope sa_scope. + +Section CylindricalDecomposition. +Variables (R : rcfType). + +Fixpoint isCylindricalDecomposition n (S : {fset {SAset R^n}}) := + SAset_partition S + /\ match n with | 0 => Logic.True | n.+1 => + let S' := [fset SAset_cast n s | s in S] in + isCylindricalDecomposition S' + /\ forall (s' : S'), + exists m, exists xi : m.-tuple {SAfun R^n -> R^1}, + (forall i, {within [set` val s'], continuous (tnth xi i)}) + /\ sorted (@SAfun_lt _ _) xi + /\ [fset s in S | SAset_cast n s == val s'] + = [fset SAset_cast _ x | x in partition_of_graphs_above (val s') xi] + end. + +Local Notation isCD := isCylindricalDecomposition. + +Lemma isCylindricalDecomposition_restrict n m S (mn : (m <= n)%N) : + @isCD n S -> isCD [fset SAset_cast m s | s in S]. +Proof. +move: (n - m)%N mn (subnKC mn) S => + _ <-; elim=> [|d IHd]. + rewrite addn0 => S. + congr isCD; apply/fsetP => s; apply/idP/imfsetP => [sS|[x]/= xS ->]. + by exists s => //; rewrite SAset_cast_id. + by rewrite SAset_cast_id. +rewrite addnS => S /= [_] [/IHd] + _; congr isCD. +have md: (m <= m + d)%N by rewrite -{1}[m]addn0 leq_add2l. +apply/fsetP => s; rewrite -imfset_comp. +by apply/imfsetP/imfsetP => -[x]/= xS ->; + exists x => //; rewrite SAset_cast_trans// geq_min md orbT. +Qed. + +Definition poly_invariant n (p : {mpoly R[n]}) (s : {SAset R^n}) := + {in s &, + forall x y, + (sgz (meval (tnth (ngraph x)) p) = sgz (meval (tnth (ngraph y)) p))%R}. + +Definition poly_adapted n p (S : {fset {SAset R^n}}) := + forall s : S, poly_invariant p (val s). + +Definition evalpmp {n} (x : 'rV[R]_n) (P : {poly {mpoly R[n]}}) := + map_poly (meval (tnth (ngraph x))) P. + +Definition SAevalpmp_graph n + (p : {poly {mpoly R[n]}}) : {SAset R^(n + (size p))} := + [set| \big[And/True]_(i < size p) + subst_formula (rcons (iota 0 n) (n + i)%N) (SAmpoly p`_i)]. + +Lemma SAevalpmp_graphP n (p : {poly {mpoly R[n]}}) (u : 'rV[R]_n) + (v : 'rV[R]_(size p)) : + (row_mx u v \in SAevalpmp_graph p) = (v == \row_i (evalpmp u p)`_i). +Proof. +apply/SAin_setP/eqP => [/holdsAnd /= vE|->]. + apply/rowP => i; rewrite mxE coef_map/=. + move: vE => /(_ i (mem_index_enum _) isT) /holds_subst. + rewrite enum_ordD map_cat -2!map_comp -cats1 subst_env_cat. + rewrite subst_env_iota_catl/=; last by rewrite size_map size_enum_ord. + rewrite nth_cat size_map size_enum_ord ltnNge leq_addr/=. + rewrite subDnCA// subnn addn0 nth_map_ord mxE (unsplitK (inr _)) => vE. + suff: SAmpoly p`_i u = \row__ v ord0 i. + rewrite SAmpolyE => /eqP; rewrite rowPE forall_ord1 !mxE => /eqP /esym ->. + by apply/meval_eq => j; rewrite tnth_mktuple. + apply/eqP; rewrite inSAfun; apply/rcf_satP; move: vE; congr holds. + rewrite ngraph_cat/= enum_ordSl enum_ord0/= mxE; congr cat. + by apply/eq_map => j /=; rewrite mxE (unsplitK (inl _)). +apply/holdsAnd => /= i _ _; apply/holds_subst. +rewrite enum_ordD map_cat -2!map_comp -cats1 subst_env_cat. +rewrite subst_env_iota_catl/=; last by rewrite size_map size_enum_ord. +rewrite nth_cat size_map size_enum_ord ltnNge leq_addr/=. +rewrite subDnCA// subnn addn0 nth_map_ord mxE (unsplitK (inr _)) mxE coef_map/=. +move: (SAmpolyE p`_i u) => /eqP; rewrite inSAfun => /rcf_satP; congr holds. +rewrite ngraph_cat/= enum_ordSl enum_ord0/= mxE; congr (_ ++ [:: _]). + by apply/eq_map => j /=; rewrite mxE (unsplitK (inl _)). +by apply/meval_eq => j; rewrite tnth_mktuple. +Qed. + +Fact SAfun_SAevalpmp n (p : {poly {mpoly R[n]}}) : + (SAevalpmp_graph p \in @SAfunc _ n (size p)) + && (SAevalpmp_graph p \in @SAtot _ n (size p)). +Proof. +apply/andP; split. + by apply/inSAfunc => u y1 y2; rewrite !SAevalpmp_graphP => /eqP -> /eqP. +apply/inSAtot => u; exists (\row_i (evalpmp u p)`_i)%R. +by rewrite SAevalpmp_graphP eqxx. +Qed. + +Definition SAevalpmp n (p : {poly {mpoly R[n]}}) := MkSAfun (SAfun_SAevalpmp p). + +Lemma SAevalpmpE n (p : {poly {mpoly R[n]}}) (u : 'rV[R]_n) : + SAevalpmp p u = (\row_i (evalpmp u p)`_i)%R. +Proof. by apply/eqP; rewrite inSAfun SAevalpmp_graphP. Qed. + +Lemma evalpmpM n (p q : {poly {mpoly R[n]}}) (x : 'rV_n) : + (evalpmp x (p * q) = (evalpmp x p) * (evalpmp x q))%R. +Proof. +apply/polyP => i. +rewrite !coef_map/= !coefM meval_sum. +apply/eq_bigr => /= j _. +by rewrite mevalM !coef_map. +Qed. + +(* TODO: subsumed by `rmorph_prod` (with occurence) *) +Lemma evalpmp_prod [I : Type] n (x : 'rV_n) (r : seq I) + (F : I -> {poly {mpoly R[n]}}) (P : pred I) : + evalpmp x (\prod_(i <- r | P i) F i) = \prod_(i <- r | P i) evalpmp x (F i). +Proof. +elim: r => [|i r IHr]. + by apply/polyP => i; rewrite !big_nil/= coef_map/= !coef1 mevalMn meval1. +rewrite !big_cons; case: (P i) => [|//]. +by rewrite evalpmpM IHr. +Qed. + +Definition truncate (T : ringType) (p : {poly T}) (d : nat) := + (\poly_(i < minn d (size p)) p`_i)%R. + +Definition truncations n + (p : {poly {mpoly R[n]}}) : {fset {poly {mpoly R[n]}}} := + (fix F p n := + match n with + | 0 => [fset p] + | n.+1 => if (0 < mdeg (mlead (lead_coef p)))%N then + p |` F (truncate p (size p).-1) n + else [fset p] + end) p (size p). + +Lemma coef_truncate (T : ringType) (p : {poly T}) d n : + (truncate p d)`_n = p`_n *+ (n < d). +Proof. +rewrite -{2}[p]coefK !coef_poly ltn_min. +by case: (n < d)%N; rewrite ?mulr0n// mulr1n. +Qed. + +Lemma truncate_trans (T : ringType) (p : {poly T}) (d e : nat) : + truncate (truncate p d) e = truncate p (minn d e). +Proof. by apply/polyP => i; rewrite !coef_truncate ltn_min -mulnb mulrnA. Qed. + +Lemma truncate_size (T : ringType) (p : {poly T}) : + truncate p (size p) = p. +Proof. by rewrite /truncate minnn coefK. Qed. + +Lemma truncate_ge_sizeP (T : ringType) (p : {poly T}) (d : nat) : + (truncate p d == p) = (size p <= d)%N. +Proof. +apply/eqP/idP => [<-|/minn_idPl pd]. + exact/(leq_trans (size_poly _ _) (geq_minl _ _)). +by rewrite -[p]truncate_size truncate_trans pd. +Qed. + +Lemma truncationsE n (p : {poly {mpoly R[n]}}) : + truncations p = + [fset truncate p d | + d in [seq d <- iota 0 (size p).+1 | + all (fun i => msize p`_i != 1) (iota d ((size p).+1 - d))]]. +Proof. +have t00 k: truncate 0 k = 0 :> {poly {mpoly R[n]}}. + by apply/eqP; rewrite truncate_ge_sizeP size_poly0. +rewrite /truncations. +move dE: (size p) => d. +have {dE}: (size p <= d)%N by rewrite dE leqnn. +elim: d p => [|d IHd] p. + move=> /= /size_poly_leq0P ->. + apply/fsetP => x; rewrite coef0 msize0/= inE. + apply/eqP/imfsetP => [->|[y]]; first by exists 0. + by rewrite inE t00. +move=> sp; rewrite {}IHd; last first. + apply/(leq_trans (size_poly _ _))/(leq_trans (geq_minl _ _)). + by rewrite [d]pred_Sn -!subn1 leq_sub2r. +rewrite !iotanS. +have [->|p0] := eqVneq p 0. + rewrite lead_coef0 mlead0 mdeg0/=; apply/fsetP => x. + rewrite in_fset1; apply/eqP/imfsetP => /= [->|[k] _]; last by rewrite t00. + exists 0; last by rewrite t00. + rewrite mem_filter -iotanS in_cons eqxx andbT. + by apply/allP => i _; rewrite coef0 msize0. +case: (ltnP 0 _); last first. + rewrite leqn0 -eqSS mlead_deg ?lead_coef_eq0// lead_coefE => pn. + apply/fsetP => x; rewrite in_fset1. + apply/eqP/imfsetP => [->|[k]] /=. + exists d.+1; last by apply/esym/eqP; rewrite truncate_ge_sizeP. + rewrite mem_filter mem_rcons add0n in_cons eqxx andbT /= subSnn/= andbT. + move/leq_sizeP: sp => /(_ d.+1 (leqnn _)) ->. + by rewrite msize0. + rewrite mem_filter => /andP[] /allP sk _ ->. + apply/eqP; rewrite truncate_ge_sizeP leqNgt; apply/negP => kp. + move/(_ (size p).-1): sk. + rewrite pn mem_iota -ltnS (ltn_predK kp) kp/= subnKC. + by rewrite (leq_trans sp)// => /(_ isT). + by rewrite -ltnS; apply/(leq_trans kp)/(leq_trans sp)/(leq_trans (leqnSn _)). +rewrite -ltnS mlead_deg ?lead_coef_eq0// => pn. +apply/fsetP => x; rewrite in_fset1U. +apply/orP/imfsetP => /= [[/eqP ->|/imfsetP]|]. +- exists d.+1; last by apply/esym/eqP; rewrite truncate_ge_sizeP. + rewrite mem_filter subSnn/= mem_rcons add0n mem_head. + move/leq_sizeP: sp => /(_ d.+1 (leqnn _)) ->. + by rewrite msize0. +- move=> /= [k]. + rewrite mem_filter truncate_trans -iotanS mem_iota iotanS/= add0n. + move=> /andP[] /allP ks kd ->. + exists (minn (size p).-1 k) => //. + rewrite mem_filter -!iotanS mem_iota/= add0n ltnS geq_min (ltnW kd) orbT. + rewrite andbT. + apply/allP => i; rewrite mem_iota subnKC geq_min; last first. + by rewrite (leq_trans (ltnW kd))// orbT. + case: (ltnP i (size p).-1) => /= [ip /andP[] ki id|+ _]; last first. + rewrite leq_eqVlt => /orP[/eqP <-|]. + by rewrite -lead_coefE eq_sym (ltn_eqF pn). + rewrite prednK; last by rewrite ltnNge leqn0 size_poly_eq0. + move=> /leq_sizeP => /(_ i (leqnn _)) ->. + by rewrite msize0. + move/(_ i): ks; rewrite mem_iota ki/= subnKC ?(ltnW kd)//. + move: id; rewrite leq_eqVlt ltnS eqSS => /orP [/eqP -> _|/[swap]/[apply]]. + by move/leq_sizeP: sp => /(_ _ (leqnn _)) ->; rewrite msize0. + by rewrite coef_truncate ip mulr1n. +move=> [k]; rewrite mem_filter -!iotanS mem_iota iotanS/= add0n ltnS. +move=> /andP[] /allP sk kd ->. +case: (ltnP k (size p)) => [kp|pk]; last by left; rewrite truncate_ge_sizeP. +right; apply/imfsetP; exists k => /=; last first. + rewrite truncate_trans; congr truncate. + by apply/esym/minn_idPr; rewrite -ltnS (leq_trans kp)// leqSpred. +rewrite mem_filter -iotanS mem_iota/= add0n (leq_trans kp sp) andbT. +apply/allP => i; rewrite mem_iota subnKC// => /andP[] ki id. +rewrite coef_truncate; case: (i < _)%N; last by rewrite mulr0n msize0. +rewrite mulr1n; apply/sk; rewrite mem_iota ki/= subnKC. + exact/(leq_trans id). +exact/(leq_trans kd). +Qed. + +Lemma truncations_witness n d (p : {poly {mpoly R[n]}}) (x : 'rV[R]_n) : + (size (evalpmp x p) <= d)%N -> truncate p d \in truncations p. +Proof. +rewrite truncationsE => sd; apply/imfsetP; exists (minn d (size p)); last first. + case: (ltnP d (size p)) => //; rewrite -truncate_ge_sizeP => /eqP ->. + by rewrite truncate_size. +rewrite mem_filter mem_iota/= add0n ltnS geq_minr andbT. +apply/allP => i; rewrite mem_iota geq_min. +case: (ltnP i (size p)) => [ip|+ _]; last first. + by move=> /leq_sizeP -> //; rewrite msize0. +rewrite orbF => /andP[] di _. +move/leq_sizeP: sd => /(_ _ di); rewrite coefE ip => pi0. +apply/negP => /msize_poly1P [c] /eqP c0 pE. +by rewrite pE mevalC in pi0. +Qed. + +Theorem roots2_on n (P : {poly {mpoly R[n]}}) (d : nat) (s : {SAset R^n}) : + {in s, forall x, size (rootsR (evalpmp x P)) = d} -> + {xi : d.-tuple {SAfun R^n -> R^1} | + sorted (@SAfun_lt R n) xi + /\ {in s, forall x, + [seq (xi : {SAfun R^n -> R^1}) x ord0 ord0 | xi <- xi] + = (rootsR (evalpmp x P))}}. +Proof. +move=> dE. +pose G_graph (i : 'I_d) : {SAset R^(n+1)} := [set | + (Not s /\ 'X_n == NatConst _ i) + \/ (s /\ + nquantify n.+1 (size P) Exists ( + subst_formula (iota 0 n ++ iota n.+1 (size P)) (SAevalpmp P) /\ + subst_formula (iota n.+1 (size P) ++ [:: n]) + (SAnthroot_graph R (size P) i)))]. +have GP i (x0 : 'rV[R]_n) (y : 'rV[R]_1) : + row_mx x0 y \in G_graph i + = (y == if x0 \in s + then \row__ (rootsR (evalpmp x0 P))`_i + else \row__ i%:R). + rewrite pi_form /cut rcf_sat_subst. + rewrite -[X in subst_env _ X]cats0 subst_env_iota_catl ?size_ngraph//. + rewrite !simp_rcf_sat -rcf_sat_take ngraph_cat take_size_cat ?size_ngraph//. + rewrite -[rcf_sat _ _]/(x0 \in s); case: (x0 \in s) => /=; last first. + rewrite nth_cat size_map size_enum_ord ltnn subnn (nth_map_ord _ _ ord0). + by rewrite orbF rowPE forall_ord1 mxE. + have nE: n.+1 = size (ngraph x0 ++ ngraph y). + by rewrite size_cat !size_ngraph addn1. + rewrite {1}nE. + have y0E: [:: y ord0 ord0] = ngraph y. + apply/(@eq_from_nth _ 0); first exact/esym/size_ngraph. + move=> j; rewrite ltnS leqn0 => /eqP -> /=. + by rewrite (nth_map_ord _ _ ord0). + apply/rcf_satP/eqP => [/nexistsP[z] /rcf_satP|yE]. + rewrite !simp_rcf_sat !rcf_sat_subst !subst_env_cat. + rewrite -catA subst_env_iota_catl ?size_ngraph//. + rewrite catA subst_env_iota_catr//=; last exact/size_tuple. + rewrite nth_cat -nE leqnn nth_cat size_map size_enum_ord ltnn subnn/=. + rewrite -(ngraph_tnth z) -!ngraph_cat [rcf_sat _ _]SAevalpmp_graphP. + rewrite enum_ordSl enum_ord0/= y0E. + rewrite -ngraph_cat [rcf_sat _ _]SAnthroot_graphP => /andP[] /eqP zE /eqP. + congr (_ = _); apply/rowP => j; rewrite !mxE. + congr ((rootsR _)`_i); apply/polyP => {}j. + rewrite coef_poly; case: (ltnP j (size P)) => jP; last first. + by rewrite nth_default//; apply/(leq_trans (size_poly _ _)). + rewrite (nth_ngraph _ _ (Ordinal jP)) mxE. + move: zE => /(congr1 (fun x : 'rV_(size P) => x ord0 (Ordinal jP))). + by rewrite !mxE. + apply/nexistsP; exists (ngraph (SAevalpmp P x0)); apply/rcf_satP. + rewrite !simp_rcf_sat !rcf_sat_subst !subst_env_cat. + rewrite -catA subst_env_iota_catl ?size_ngraph//. + rewrite catA subst_env_iota_catr//=; last first. + by rewrite size_map size_enum_ord. + rewrite nth_cat -nE leqnn nth_cat size_map size_enum_ord ltnn subnn/=. + rewrite -!ngraph_cat [rcf_sat _ _]SAevalpmp_graphP SAevalpmpE eqxx/=. + rewrite enum_ordSl enum_ord0/= y0E. + rewrite -ngraph_cat [rcf_sat _ _]SAnthroot_graphP. + move/eqP: yE; congr (_ == _); apply/rowP => j; rewrite !mxE. + congr ((rootsR _)`_i); apply/polyP => {}j. + rewrite coef_poly; case: (ltnP j (size P)) => jP; last first. + by rewrite nth_default//; apply/(leq_trans (size_poly _ _)). + by rewrite (nth_ngraph _ _ (Ordinal jP)) mxE. +have SAfun_G (i : 'I_d) : + (G_graph i \in @SAfunc _ n 1) && (G_graph i \in @SAtot _ n 1). + apply/andP; split. + apply/inSAfunc => x0 y1 y2; rewrite !GP. + by move=> /eqP <- /eqP/esym. + apply/inSAtot => x0; case/boolP: (x0 \in s) => [|/negPf] x0s. + by exists (\row__ (rootsR (evalpmp x0 P))`_i); rewrite GP x0s. + by exists (\row__ i%:R); rewrite GP x0s. +pose G i := MkSAfun (SAfun_G i). +have GE (i : 'I_d) (x0 : 'rV_n) : + G i x0 = \row__ (if x0 \in s then (rootsR (evalpmp x0 P))`_i else i%:R). + by apply/eqP; rewrite inSAfun GP; case: (x0 \in s) => //; rewrite mxE. +exists (mktuple G). +split. + apply/(sortedP (@SAfun_const R n 1 0)) => i; rewrite size_tuple => id. + apply/SAfun_ltP => y; rewrite (nth_mktuple _ _ (Ordinal id)). + rewrite (nth_mktuple _ _ (Ordinal (ltnW id))) !GE !mxE. + case/boolP: (y \in s) => /= ys; last by rewrite ltr_nat. + move/(sortedP 0): (let c := cauchy_bound (evalpmp y P) in + sorted_roots (- c) c (evalpmp y P)) => /(_ i). + by rewrite dE// => /(_ id). +move=> y ys; apply/(eq_from_nth (x0:=0)); first by rewrite size_tuple dE. +rewrite size_tuple => i id. +rewrite (nth_map (@SAfun_const R n 1 0)) ?size_tuple//. +by rewrite -[ i ]/(nat_of_ord (Ordinal id)) nth_mktuple GE mxE ys. +Qed. + +Lemma rootsR_continuous n (p : {poly {mpoly R[n]}}) (s : {SAset R^n}) + (x : 'rV[R]_n) i : + x \in s -> + {in s, forall y, size (evalpmp y p) = size (evalpmp x p)} -> + {in s, forall y, + size (gcdp (evalpmp y p) (evalpmp y p)^`()) + = size (gcdp (evalpmp x p) (evalpmp x p)^`())} -> + {in s, forall y, + size (rootsR (evalpmp y p)) = size (rootsR (evalpmp x p))} -> + {within [set` s], continuous (fun y => (rootsR (evalpmp y p))`_i)}. +Proof. +case: (ltnP i (size (rootsR (evalpmp x p)))) => ir; last first. + move=> _ _ _ r_const. + apply(@subspace_eq_continuous _ _ R (fun=> 0)); last exact/cst_continuous. + move=> /= u; rewrite mem_setE => us. + by apply/esym/nth_default; rewrite (r_const u us). +case: n p s x ir => [|n] p s x ir xs s_const s'_const r_const/=; + apply/continuousP => /= A; + rewrite openE/= => /subsetP Aopen; + apply/open_subspace_ballP => /= y; + rewrite in_setI mem_setE => /andP[] {}/Aopen; + rewrite /interior inE => /nbhs_ballP[] e/= e0 yeA ys. + exists 1; split=> // z _; apply/yeA. + suff ->: z = y by apply/ballxx. + by apply/rowP => -[]. +have [p0|px0] := eqVneq (size (evalpmp x p)) 0. + exists 1; split=> // z [_] zs /=; apply/yeA. + have {}p0 u : u \in s -> evalpmp u p = 0. + by move=> us; apply/eqP; rewrite -size_poly_eq0 s_const// p0. + by rewrite p0// p0//; apply/ballxx. +pose q z := map_poly (real_complex R) (evalpmp z p). +have q0 z : z \in s -> q z != 0. + by move=> zs; rewrite map_poly_eq0 -size_poly_eq0 s_const. +set e' := \big[Order.min/e]_(u <- dec_roots (q y)) + \big[Order.min/e]_(v <- dec_roots (q y) | u != v) (complex.Re `|u - v| / 2). +have e'0: 0 < e'%:C%C. + rewrite ltcR lt_bigmin e0/=; apply/allP => u _. + rewrite lt_bigmin e0/=; apply/allP => v _. + apply/implyP => uv; apply/divr_gt0; last exact/ltr0Sn. + by rewrite -ltcR (normr_gt0 (u - v)) subr_eq0. +have: exists d : R, 0 < d /\ + forall z, z \in s -> `|z - y| < d -> alignp e'%:C%C (q y) (q z). + case: (aligned_deformed (q y) e'0) => /= [[]] a aI []. + rewrite ltcE/= => /andP[/eqP ->] a0; rewrite complexr0 => ad. + have /fin_all_exists /= : forall (i : 'I_(size (val p)).+1), + exists delta, 0 < delta /\ + forall (z : 'rV[R]_n.+1), y \in s -> `|y - z| < delta -> + `|(q y)`_i - (q z)`_i| < a%:C%C. + move=> j. + move: (@meval_continuous _ _ (val p)`_j y). + rewrite /= /continuous_at. + move=> /(@cvgr_dist_lt _ R^o). + move=> /(_ _ a0) /nbhs_ballP[] d'/= d'0 /subsetP xd'. + exists d'; split=> // z zs yz. + move: xd' => /(_ z); mp; first by rewrite -ball_normE inE/=. + rewrite inE/= !coef_map/= -rmorphB/= normc_def/= expr0n/= addr0 sqrtr_sqr. + rewrite ltcR. + by congr (normr (_ - _) < a); apply/meval_eq => k; rewrite tnth_mktuple. + move=> [d'] d'P; exists (\big[minr/1]_i d' i). + split; first by rewrite lt_bigmin ltr01; apply/allP => j _ /=; case: (d'P j). + move=> z zs; rewrite lt_bigmin => /andP[_] /allP xz; apply/ad. + split=> [|j]; first by rewrite !size_map_poly s_const// (s_const _ ys). + move: (ltn_ord j); rewrite [X in (j < X)%N]size_map_poly => jlt. + have {}jlt := leq_trans (leq_trans jlt (size_poly _ _)) (leqnSn _). + case: (d'P (Ordinal jlt)) => _ /=; apply=> //. + by rewrite -opprB normrN; apply/xz/mem_index_enum. +move=> [] d [] d0 dP. +exists d; split=> // z/=. +rewrite -ball_normE/= -opprB normrN => -[] yz zs; apply/yeA. +move: dP => /(_ z zs yz) yze. +rewrite -(@ball_normE R R^o)/=. +have: exists (fyz : [fset x in dec_roots (q y)] -> [fset x in dec_roots (q z)]), + forall u, `|val u - val (fyz u)| < e'%:C%C. + apply/(fin_all_exists (P:=fun u v => `|val u - val v| < e'%:C%C)). + case=> /= u; rewrite mem_imfset//= mem_dec_roots => /andP[_] pu. + move: yze => /(_ u pu). + rewrite -big_filter; case rsy: (seq.filter _ _) => [|v l]. + by rewrite big_nil leqn0 mu_eq0 ?pu// map_poly_eq0 -size_poly_eq0 s_const. + move: (mem_head v l). + rewrite -rsy mem_filter -normrN opprB => /andP[] uv pv _. + suff vP: v \in [fset x in dec_roots (q z)]. + by exists [` vP]. + by rewrite mem_imfset. +move=> [/=] fyz fyze. +have eP (u v : [fset x | x in dec_roots (q y)]) : + `|val u - val v| < 2 * e'%:C%C -> u = v. + move=> uve; apply/eqP/negP => /negP uv; move: uve. + rewrite -(RRe_real (normr_real _)) mulrC mulr_natr -rmorphMn/= ltcR. + rewrite -mulr_natr. + rewrite -ltr_pdivrMr; last exact/ltr0Sn. + rewrite lt_bigmin => /andP[_] /allP-/(_ (val u))/=. + move: (fsvalP u); rewrite (mem_imfset _ _ (@inj_id _))/= => /[swap]/[apply]. + rewrite lt_bigmin => /andP[_] /allP-/(_ (val v))/=. + move: (fsvalP v); rewrite (mem_imfset _ _ (@inj_id _))/= => /[swap]/[apply]. + by rewrite (inj_eq val_inj) ltxx => /implyP-/(_ uv). +have R0: [char R[i]] =i pred0 by exact/char_num. +have fyzb: bijective fyz. + apply/inj_card_bij. + move=> u v fuv; apply/eP. + rewrite -(subrBB (val (fyz u))); apply/(le_lt_trans (ler_normB _ _)). + rewrite mulr2n mulrDl mul1r; apply/ltrD; first exact/fyze. + by rewrite fuv; apply/fyze. + rewrite -2!cardfE card_imfset//= card_imfset//=. + do 2 rewrite undup_id ?uniq_dec_roots//. + rewrite (size_dec_roots (q z) R0) (size_dec_roots (q y) R0). + rewrite size_divp; last by rewrite gcdp_eq0 negb_and q0. + rewrite size_divp; last by rewrite gcdp_eq0 negb_and q0. + rewrite ![(q _)^`()]deriv_map -!gcdp_map !size_map_poly -!/(evalpmp _ _). + by rewrite s_const// s_const// s'_const// s'_const. +have pyrP j: (j < size (rootsR (evalpmp y p)))%N -> + ((rootsR (evalpmp y p))`_j)%:C%C \in [fset x | x in dec_roots (q y)]. + rewrite (mem_imfset _ _ (@inj_id _))/= mem_dec_roots q0//=. + move=> /(mem_nth 0); rewrite in_rootsR => /andP[_] jr. + exact/rmorph_root. +rewrite -ltcR. +apply/(le_lt_trans (normc_ge_Re (_%:C%C))) => /=. +rewrite rmorphB/=. +rewrite -(r_const y ys) in ir. +suff ->: ((rootsR (evalpmp z p))`_i)%:C%C = val (fyz [` pyrP i ir]). + move: (fyze [` pyrP i ir]) => /= pye. + apply/(lt_le_trans pye). + by rewrite lecR; apply/bigmin_le_id. +have perm_eqC a: perm_eq + [seq u <- dec_roots (q a) | u \is Num.real] + [seq x%:C%C | x <- rootsR (evalpmp a p)]. + apply/uniq_perm. + - exact/filter_uniq/uniq_dec_roots. + - by rewrite map_inj_uniq ?uniq_roots//; apply/complexI. + move=> u; rewrite mem_filter mem_dec_roots map_poly_eq0 . + apply/andP/mapP => [[] uR /andP[] pa0 qu|[] v + ->]. + exists (complex.Re u); last by rewrite (RRe_real uR). + rewrite in_rootsR pa0. + by rewrite -(RRe_real uR) fmorph_root in qu. + rewrite in_rootsR => /andP[] pa0 pv; split. + by apply/complex_realP; exists v. + by rewrite pa0/=; apply/rmorph_root. +have ne20: 2 != 0 :> R[i] by rewrite pnatr_eq0. +have fyzr (u : [fset x | x in dec_roots (q y)]) : + ((val (fyz u)) \is Num.real) -> (val u) \is Num.real. + move=> fur. + suff ->: \val u = 'Re (\val u) by apply/Creal_Re. + apply/(mulfI ne20). + rewrite -complexRe -addcJ mulr2n mulrDl mul1r; congr (_ + _)%R. + have uP: ((\val u)^* )%C \in [fset x | x in dec_roots (q y)]. + rewrite (mem_imfset _ _ (@inj_id _))/= mem_dec_roots q0//=. + rewrite -complex_root_conj/= map_poly_id => [|a]. + move: (fsvalP u); rewrite (mem_imfset _ _ (@inj_id _))/=. + by rewrite mem_dec_roots => /andP[_]. + move=> /[dup] /(nth_index 0)/=. + rewrite -index_mem size_map_poly => + alt. + by rewrite coef_poly alt => <-; rewrite conjc_real. + rewrite -[((val u)^* )%C]/(val [` uP]). + rewrite [in LHS](eP u [` uP])//. + rewrite -(subrBB (val (fyz u))). + apply/(le_lt_trans (ler_normB _ _)). + rewrite mulr2n mulrDl mul1r; apply/ltrD; first exact/fyze. + rewrite /= -(RRe_real fur) -conjc_real -rmorphB/= norm_conjC (RRe_real fur). + exact/fyze. +have {}fyzr (u : [fset x | x in dec_roots (q y)]) : + (val u) \is Num.real = ((val (fyz u)) \is Num.real). + apply/idP/idP; last exact/fyzr. + move=> ur; apply/negP => /negP fur. + pose sr y := [fset x : [fset x in dec_roots (q y)] | val x \is Num.real]. + have srE a: + [fset val x | x in sr a] + = [fset x | x in dec_roots (q a) & x \is Num.real]. + apply/eqP; rewrite eqEfsubset; apply/andP; split; apply/fsubsetP => b; + rewrite (mem_imfset _ _ (@inj_id _))/=. + move=> /imfsetP[/=] c /imfsetP[/=] c' cr -> ->. + apply/andP; split=> //=. + by move: (fsvalP c'); rewrite (mem_imfset _ _ (@inj_id _))/=. + move=> /andP[] qb br; apply/imfsetP => /=. + have bP: b \in [fset x0 | x0 in dec_roots (q a)]. + by rewrite mem_imfset. + exists [` bP] => //. + by rewrite (mem_imfset _ _ (@inj_id _))/=. + suff: (#|` [fset x | x in dec_roots (q z) & x \is Num.real]| + < #|` [fset x | x in dec_roots (q y) & x \is Num.real]|)%N. + rewrite [X in (X < _)%N]card_imfset//= [X in (_ < X)%N]card_imfset//=. + do 2 rewrite undup_id ?uniq_dec_roots//. + rewrite (@perm_size _ _ [seq x%:C%C | x <- rootsR (evalpmp z p)]); + last exact/perm_eqC. + rewrite [X in (_ < X)%N](@perm_size _ _ + [seq x%:C%C | x <- rootsR (evalpmp y p)]); last exact/perm_eqC. + by rewrite !size_map r_const// r_const// ltnn. + rewrite -2!srE [X in (X < _)%N](card_imfset _ _ val_inj)/=. + rewrite [X in (_ < X)%N](card_imfset _ _ val_inj)/=. + suff /fsubset_leq_card zy: sr z `<=` [fset fyz x | x in (sr y `\ u)]. + apply/(leq_ltn_trans zy). + rewrite [X in (X < _)%N]card_imfset/=; last exact/bij_inj. + rewrite -add1n. + have/(congr1 nat_of_bool) /= <-: u \in sr y by rewrite mem_imfset. + by rewrite -cardfsD1 leqnn. + apply/fsubsetP => /= a. + rewrite [X in _ X -> _](mem_imfset _ _ (@inj_id _))/= => ar. + case: (fyzb) => fzy fyzK fzyK. + apply/imfsetP; exists (fzy a) => /=; last by rewrite [RHS]fzyK. + rewrite in_fsetD1 -(bij_eq fyzb) fzyK; apply/andP; split. + apply/eqP; move: ar => /[swap] ->. + by move/negP: fur. + rewrite (mem_imfset _ _ (@inj_id _))/=. + by apply/fyzr; rewrite fzyK. +have fir: val (fyz.[pyrP i ir])%fmap \is Num.real. + by rewrite -fyzr/=; apply/complex_realP; exists (rootsR (evalpmp y p))`_i. +have fiR: complex.Re (val (fyz [` pyrP i ir])) \in rootsR (evalpmp z p). + rewrite in_rootsR. + move: (q0 z zs); rewrite map_poly_eq0 => -> /=. + move: (fsvalP (fyz [` pyrP i ir])). + rewrite (mem_imfset _ _ (@inj_id _))/= mem_dec_roots => /andP[_]. + by rewrite -{1}[val _]RRe_real// fmorph_root. +rewrite -(RRe_real fir); congr (_%:C%C). +rewrite -(nth_index 0 fiR); congr (_`__). +rewrite -[LHS](count_lt_nth 0 (sorted_roots _ _ _) ir). +move: (fiR); rewrite -index_mem => fiRs. +rewrite -[RHS](count_lt_nth 0 (sorted_roots _ _ _) fiRs) -!/(rootsR _). +rewrite (nth_index 0 fiR). +pose sr y z := [fset x : [fset x in dec_roots (q y)] | val x < z]. +have srE a b: + [fset val x | x in sr a b] + = [fset x | x in dec_roots (q a) & x < b]. + apply/eqP; rewrite eqEfsubset; apply/andP; split; apply/fsubsetP => b'; + rewrite (mem_imfset _ _ (@inj_id _))/=. + move=> /imfsetP[/=] c /imfsetP[/=] c' cr -> ->. + apply/andP; split=> //=. + by move: (fsvalP c'); rewrite (mem_imfset _ _ (@inj_id _))/=. + move=> /andP[] qb br; apply/imfsetP => /=. + have bP: b' \in [fset x0 | x0 in dec_roots (q a)]. + by rewrite mem_imfset. + exists [` bP] => //. + by rewrite (mem_imfset _ _ (@inj_id _))/=. +have {}perm_eqC a b: perm_eq + [seq x0 <- dec_roots (q a) | (x0 < b%:C%C)%R] + [seq x%:C%C | x <- [seq x <- rootsR (evalpmp a p) | (x < b)%R]]. + apply/uniq_perm. + - exact/filter_uniq/uniq_dec_roots. + - rewrite map_inj_uniq; last exact/complexI. + exact/filter_uniq/uniq_roots. + move=> u; rewrite mem_filter mem_dec_roots map_poly_eq0. + apply/andP/mapP => [[] ub /andP[] pa0|[] v + ->]. + move: ub; rewrite ltcE/= => /andP[] /eqP u0 ub. + rewrite (complexE u) -u0 mulr0 addr0 fmorph_root => pu. + exists (complex.Re u) => //. + by rewrite mem_filter ub/= in_rootsR pa0. + rewrite mem_filter in_rootsR => /andP[] vb /andP[] pa0 pv; split. + by rewrite ltcR. + by rewrite pa0/=; apply/rmorph_root. +suff: (#|` [fset x | x in dec_roots (q y) + & (x < ((rootsR (evalpmp y p))`_i)%:C%C)%R]| + = #|` [fset x | x in dec_roots (q z) + & (x < val (fyz [` pyrP i ir]))%R]|)%N. + rewrite [LHS]card_imfset//= [RHS]card_imfset//=. + do 2 rewrite undup_id ?uniq_dec_roots//. + rewrite (@perm_size _ _ [seq x%:C%C | x <- + [seq x <- rootsR (evalpmp y p) | (x < (rootsR (evalpmp y p))`_i)%R]]); + last exact/perm_eqC. + rewrite -{1}(RRe_real fir). + rewrite [RHS](@perm_size _ _ [seq x%:C%C | x <- + [seq x <- rootsR (evalpmp z p) | + (x < complex.Re (val (fyz [` pyrP i ir])))%R]]); last exact/perm_eqC. + by rewrite !size_map !size_filter. +rewrite -2!srE [LHS](card_imfset _ _ val_inj)/=. +rewrite [RHS](card_imfset _ _ val_inj)/=. +suff ->: sr z (val (fyz [` pyrP i ir])) + = [fset fyz x | x in sr y (((rootsR (evalpmp y p))`_i)%:C)%C]. + by rewrite [RHS](card_imfset _ _ (bij_inj fyzb)). +apply/eqP; rewrite eqEfsubset; apply/andP; split; apply/fsubsetP => /= u. + rewrite [X in _ X -> _](mem_imfset _ _ (@inj_id _))/= => ui. + case: (fyzb) => fzy fyzK fzyK. + apply/imfsetP; exists (fzy u) => /=; last by rewrite fzyK. + rewrite (mem_imfset _ _ (@inj_id _))/=. + have {}ui: val u < val (fyz [` pyrP i ir]) by []. + have ur: val u \is Num.real by apply/negP => /negP/(Nreal_ltF fir)/negP. + have fur: val (fzy u) \is Num.real by rewrite fyzr fzyK. + suff: val (fzy u) < ((rootsR (evalpmp y p))`_i)%:C%C by []. + rewrite -(RRe_real fur) ltcR ltNge; apply/negP => iu. + suff: [` pyrP i ir] = fzy u by move=> iuE; move: ui; rewrite iuE fzyK ltxx. + apply/eP. + rewrite /= -(RRe_real fur) -rmorphB/= normcR mulrC mulr_natr -rmorphMn/= ltcR. + apply/ltr_normlP; split; last first. + rewrite -subr_le0 in iu; apply/(le_lt_trans iu). + by rewrite pmulrn_lgt0// -ltcR. + rewrite opprB -(subrBB (complex.Re (val u))) opprB mulr2n; apply/ltrD. + apply/ltr_normlW. + rewrite -ltcR -normcR rmorphB/= (RRe_real fur) (RRe_real ur). + by rewrite -{2}(fzyK u); apply/fyze. + rewrite -(subrBB (complex.Re (val (fyz [` pyrP i ir])))) opprB -(add0r e'). + apply/ltrD; first by rewrite subr_lt0; move: ui; rewrite ltcE => /andP[_]. + apply/ltr_normlW; rewrite -ltcR -normcR rmorphB/= [X in X - _]RRe_real. + by rewrite -normrN opprB; apply/(fyze [` pyrP i ir]). + by rewrite -fyzr/=; apply/complex_realP; exists (rootsR (evalpmp y p))`_i. +move=> /imfsetP[/=] v + ->. +rewrite (mem_imfset _ _ (@inj_id _))/= => vi. +have {}vi: val v < ((rootsR (evalpmp y p))`_i)%:C%C by []. +have vr: val v \is Num.real. + apply/negP => /negP vr; move: vi; rewrite Nreal_ltF//. + by apply/complex_realP; exists (rootsR (evalpmp y p))`_i. +rewrite (mem_imfset _ _ (@inj_id _))/=. +suff: val (fyz v) < val (fyz [` pyrP i ir]) by []. +have fvr: val (fyz v) \is Num.real by rewrite -fyzr. +rewrite -(RRe_real fvr) -(RRe_real fir) ltcR ltNge; apply/negP => iv. +suff vE: v = [` pyrP i ir] by rewrite vE/= ltxx in vi. +apply/eP. +rewrite /= -(RRe_real vr) -rmorphB/= normcR mulrC mulr_natr -rmorphMn/= ltcR. +apply/ltr_normlP; split; last first. + rewrite -(RRe_real vr) ltcR -subr_lt0 in vi; apply/(lt_trans vi). + by rewrite pmulrn_lgt0// -ltcR. +rewrite opprB -(subrBB (complex.Re (val (fyz [`pyrP i ir])))) opprB mulr2n. +apply/ltrD. + apply/ltr_normlW; rewrite -ltcR -normcR rmorphB/= (RRe_real fir). + exact/(fyze [` pyrP i ir]). +rewrite -(subrBB (complex.Re (val (fyz v)))) opprB -(add0r e'). +apply/ler_ltD; first by rewrite subr_le0. +apply/ltr_normlW; rewrite -ltcR -normcR rmorphB/= (RRe_real fvr) (RRe_real vr). +rewrite -normrN opprB; apply/fyze. +Qed. + +Lemma evalpmp_prod_const n (P : {fset {poly {mpoly R[n]}}}) (s : {SAset R^n}) : + SAconnected s -> + {in P, forall p, + {in s &, forall x y, size (evalpmp x p) = size (evalpmp y p)}} -> + {in P, forall p, {in s &, forall x y, + size (gcdp (evalpmp x p) (evalpmp x p)^`()) + = size (gcdp (evalpmp y p) (evalpmp y p)^`())}} -> + {in P &, forall p q, {in s &, forall x y, + size (gcdp (evalpmp x p) (evalpmp x q)) + = size (gcdp (evalpmp y p) (evalpmp y q))}} -> + {in s &, forall x y, + size (gcdp (evalpmp x (\prod_(p : P) (val p))) + (evalpmp x (\prod_(p : P) (val p)))^`()) + = size (gcdp (evalpmp y (\prod_(p : P) (val p))) + (evalpmp y (\prod_(p : P) (val p)))^`())} /\ + {in s &, forall x y, + size (rootsR (evalpmp x (\prod_(p : P) (val p)))) + = size (rootsR (evalpmp y (\prod_(p : P) (val p))))}. +Proof. +admit. Admitted. (* +move=> Scon psize proots pqsize. +apply/all_and2 => x; apply/all_and2 => y; apply/all_and2 => xs; apply/all_and2. +case: n P s Scon psize proots pqsize x y xs + => [|n] P s Scon psize proots pqsize x y xS yS. + by have ->: x = y by apply/rowP => -[]. +case: (eqVneq (evalpmp x (\prod_(p : P) val p)) 0) => px0. + rewrite px0. + move: px0; rewrite !evalpmp_prod => /eqP/prodf_eq0/= [p] _. + rewrite -size_poly_eq0 (psize (val p) (fsvalP p) x y xS yS) size_poly_eq0. + move=> py0. + suff ->: \prod_(p : P) evalpmp y (val p) = 0 by []. + by apply/eqP/prodf_eq0; exists p. +have p0: {in P, forall p, {in s, forall x, size (evalpmp x p) != 0}}. + move=> p pP z zS; rewrite (psize _ pP z x zS xS) size_poly_eq0. + by move: px0; rewrite evalpmp_prod => /prodf_neq0/(_ [` pP] isT). +have R0: [char R[i]] =i pred0 by apply/char_num. +have pmsize: {in s &, forall x y, + size (evalpmp x (\prod_(p : P) \val p)) + = size (evalpmp y (\prod_(p : P) \val p))}. + move=> {px0} {}x {}y {}xS {}yS. + rewrite !evalpmp_prod size_prod; last first. + by move=> /= p _; rewrite -size_poly_eq0 (p0 _ (fsvalP p) x xS). + rewrite size_prod; last first. + by move=> /= p _; rewrite -size_poly_eq0 (p0 _ (fsvalP p) y yS). + under eq_bigr => /= p _. + rewrite (psize _ (fsvalP p) x y xS yS). + over. + by []. +have rE (u : 'rV[R]_n.+1) : + (size (rootsR (evalpmp u (\prod_(p : P) \val p))))%:R + = SAcomp (SAnbroots _ _) (SAevalpmp (\prod_(p : P) \val p)) u ord0 ord0. + rewrite SAcompE/= SAevalpmpE SAnbrootsE mxE. + congr (size (rootsR _))%:R. + apply/polyP => i; rewrite coef_poly. + case: ltnP => ilt; last first. + exact/nth_default/(leq_trans (size_poly _ _) ilt). + by rewrite -/(nat_of_ord (Ordinal ilt)) nth_map_ord mxE. +have cE (u : 'rV[R]_n.+1) : + (size (dec_roots + (map_poly (real_complex R) (evalpmp u (\prod_(p : P) \val p)))))%:R + = SAcomp (SAnbrootsC _ _) (SAevalpmp (\prod_(p : P) \val p)) u ord0 ord0. + rewrite SAcompE/= SAevalpmpE SAnbrootsCE mxE. + congr (size (dec_roots _))%:R. + apply/polyP => i; rewrite !coef_poly. + case: ltnP => ilt; last first. + case: ltnP => [|//] ilt'. + by rewrite (nth_mktuple _ _ (Ordinal ilt')) mxE nth_default. + case: ltnP => [|//] ilt'. + by rewrite (nth_mktuple _ _ (Ordinal ilt')) mxE coef_map/=. +suff: locally_constant (SAcomp (SAnbroots _ _) + (SAevalpmp (\prod_(p : P) \val p))) [set` s] + /\ locally_constant (SAcomp (SAnbrootsC _ _) + (SAevalpmp (\prod_(p : P) \val p))) [set` s]. + move=> [] rc cc; split; last first. + apply/(mulrIn (@oner_neq0 R)). + rewrite !rE; congr (_ _ ord0 ord0). + by move: {px0} x y xS yS; apply/SAconnected_locally_constant_constant. + move: cc => /(SAconnected_locally_constant_constant Scon)-/(_ x y xS yS). + move=> /(congr1 (fun x : 'rV_1 => x ord0 ord0)). + rewrite -!cE => /(mulrIn (@oner_neq0 R)). + rewrite size_dec_roots// [in RHS]size_dec_roots//. + rewrite size_divp; last by rewrite gcdp_eq0 map_poly_eq0 negb_and px0. + rewrite size_divp; last first. + rewrite gcdp_eq0 map_poly_eq0 -size_poly_eq0 (pmsize y x yS xS) negb_and. + by rewrite size_poly_eq0 px0. + rewrite !deriv_map/= -!gcdp_map !size_map_poly. + rewrite subn_pred ?leq_gcdpl//; last first. + by rewrite lt0n size_poly_eq0 gcdp_eq0 negb_and px0. + rewrite subn_pred ?leq_gcdpl//; last first. + - by rewrite -size_poly_eq0 (pmsize y x yS xS) size_poly_eq0 px0. + - rewrite lt0n size_poly_eq0 gcdp_eq0 negb_and. + by rewrite -size_poly_eq0 (pmsize y x yS xS) size_poly_eq0 px0. + rewrite !succnK (pmsize x y xS yS) => /eqP. + rewrite eqn_sub2lE; first by move=> /eqP. + by rewrite (pmsize y x yS xS) leq_gcdpl. + by rewrite leq_gcdpl// -size_poly_eq0 (pmsize y x yS xS) size_poly_eq0 px0. +move=> {x y xS yS px0}. +apply/all_and2 => x; apply/all_and2; rewrite inE/= => xs. +have ex_and: forall T (P Q : T -> Prop), + (exists x, P x /\ Q x) -> (exists x, P x) /\ (exists x, Q x). + move=> T P0 Q [] a [] Pa Qa. + by split; exists a. +apply/ex_and. +pose pc := fun (p : P) (x : 'rV[R]_n.+1) => + map_poly (real_complex R) (evalpmp x (\val p)). +pose rx := dec_roots (\prod_(p : P) pc p x). +pose d := (\big[Order.min/1]_(x <- rx) \big[Order.min/1]_(y <- rx | y != x) + (complex.Re `|x - y| / 2))%:C%C. +have d0 : 0 < d. + rewrite ltcE/= eqxx/= lt_bigmin ltr01/=; apply/allP => u _. + rewrite -big_filter lt_bigmin ltr01/=; apply/allP => v. + rewrite mem_filter => /andP[] vu _. + apply/divr_gt0; last exact/ltr0Sn. + by rewrite -ltcR (normr_gt0 (u - v)) subr_eq0 eq_sym. +have /= dP: {in rx &, forall u v, (`|u - v| < 2*d)%R -> u = v}. + move=> u v ux vx uvd; apply/eqP; rewrite -[_ == _]negbK; apply/negP => uv. + move: uvd. + rewrite mulrC mulr_natr -rmorphMn/= -(RRe_real (normr_real _)) ltcR. + rewrite -mulr_natr. + rewrite -ltr_pdivrMr ?ltr0Sn// lt_bigmin => /andP[_] /allP-/(_ u ux) /=. + rewrite lt_bigmin => /andP[_] /allP-/(_ v vx) /implyP. + by rewrite eq_sym ltxx => /(_ uv). +have /fin_all_exists /=: + forall p : P, exists delta, 0 < delta + /\ forall (y : 'rV[R]_n.+1), y \in s -> `|x - y| < delta -> + alignp d (pc p x) (pc p y). + move=> p. + case: (aligned_deformed (pc p x) d0) => /= [[]] e eI []. + rewrite ltcE/= => /andP[/eqP ->] e0; rewrite complexr0 => ed. + have /fin_all_exists /=: + forall i : 'I_(size (val p)).+1, exists delta, 0 < delta + /\ forall (y : 'rV[R]_n.+1), y \in s -> `|x - y| < delta -> + `|(pc p x)`_i - (pc p y)`_i| < e%:C%C. + move=> i. + move: (@meval_continuous _ _ (val p)`_i x). + rewrite /= /continuous_at. + move=> /(@cvgr_dist_lt _ R^o). + move=> /(_ _ e0) /nbhs_ballP[] d'/= d'0 /subsetP xd'. + exists d'; split=> // y ys xy. + move: xd' => /(_ y); mp; first by rewrite -ball_normE inE/=. + rewrite inE/= !coef_map/= -rmorphB/= normc_def/= expr0n/= addr0 sqrtr_sqr. + rewrite ltcR. + by congr (normr (_ - _) < e); apply/meval_eq => j; rewrite tnth_mktuple. + move=> [d'] d'P; exists (\big[minr/1]_i d' i). + split; first by rewrite lt_bigmin ltr01; apply/allP => i _ /=; case: (d'P i). + move=> y ys; rewrite lt_bigmin => /andP[_] /allP xy; apply/ed. + split=> [|i]. + suff ->: size (pc p y) = size (pc p x) by []. + by rewrite !size_map_poly; apply/psize => //; apply/fsvalP. + move: (ltn_ord i); rewrite [X in (i < X)%N]size_map_poly => ilt. + have {}ilt := leq_trans (leq_trans ilt (size_poly _ _)) (leqnSn _). + case: (d'P (Ordinal ilt)) => _ /=; apply=> //. + exact/xy/mem_index_enum. +move=> [d'] xd'. +have d'0: 0 < \big[minr/1]_(p : P) d' p. + rewrite lt_bigmin ltr01; apply/allP => p _ /=. + by case: (xd' p). +exists (ball x (\big[Order.min/1]_(p : P) d' p)). +have andxx (a b c : Prop) : a /\ b /\ c -> (a /\ b) /\ (a /\ c). + by move=> [] ? [] ? ?. +apply/andxx; split; first exact/open_subspaceW/ball_open. +apply/andxx; split; first by rewrite inE; apply ballxx. +apply/all_and2 => y; rewrite in_setI. +apply/all_and2 => /andP[]; rewrite inE/= => ys. +rewrite -ball_normE inE/= lt_bigmin => /andP[_] /allP/= xy. +pose rs := fun x => [fset x in (rootsR (evalpmp x (\prod_(p : P) \val p)))]. +have card_rs z : + #|` rs z | = size (rootsR (evalpmp z (\prod_(p : P) \val p))). + by rewrite /rs card_imfset//= undup_id// uniq_roots. +have pc0 p z: z \in s -> pc p z != 0. + by rewrite map_poly_eq0 -size_poly_eq0; apply/p0 => //; apply/fsvalP. +have pcM0 z: z \in s -> \prod_(p : P) pc p z != 0. + by move=> zs; apply/prodf_neq0 => /= p _; apply/pc0. +have: exists (fxy : forall p, + [fset x in dec_roots (pc p x)] -> [fset x in dec_roots (pc p y)]), + forall p u, `|val u - val (fxy p u)| < d. + apply/(fin_all_exists (P:=fun p f => forall u, `|val u - val (f u)| < d)). + move=> /= p; apply/(fin_all_exists (P:=fun u v => `|val u - val v| < d)). + case=> /= u; rewrite mem_imfset//= mem_dec_roots => /andP[_] pu. + move: xy => /(_ p (mem_index_enum _)). + move: xd' => /(_ p)[_] /(_ y ys) /[apply] /(_ u pu). + rewrite -big_filter; case rsy: (seq.filter _ _) => [|v l]. + by rewrite big_nil leqn0 mu_eq0 ?pu// pc0. + move: (mem_head v l). + rewrite -rsy mem_filter -normrN opprB => /andP[] uv pv _. + suff vP: v \in [fset x in dec_roots (pc p y)]. + by exists [` vP]. + by rewrite mem_imfset//= mem_dec_roots pc0. +move=> [/=] fxy fxyd. +have fxy_bij: forall p, bijective (fxy p). + move=> p; apply/inj_card_bij; last first. + rewrite -2!cardfE card_imfset//= card_imfset//=. + do 2 rewrite undup_id ?uniq_dec_roots//. + rewrite (size_dec_roots (pc p x) R0) (size_dec_roots (pc p y) R0). + rewrite size_divp; last by rewrite gcdp_eq0 negb_and pc0. + rewrite size_divp; last by rewrite gcdp_eq0 negb_and pc0. + rewrite ![(pc _ _)^`()]deriv_map -!gcdp_map !size_map_poly -!/(evalpmp _ _). + rewrite (psize (val p) (fsvalP p) x y xs ys). + by rewrite (proots (val p) (fsvalP p) x y xs ys). + move=> /= u v => uv; apply/val_inj/dP. + - move: (fsvalP u); rewrite (mem_imfset _ _ (@inj_id _))/=. + rewrite mem_dec_roots => /andP[_] pu. + rewrite /rx mem_dec_roots pcM0//= root_bigmul/=. + by apply/hasP; exists p => //; apply/mem_index_enum. + - move: (fsvalP v); rewrite (mem_imfset _ _ (@inj_id _))/=. + rewrite mem_dec_roots => /andP[_] pv. + rewrite /rx mem_dec_roots pcM0//= root_bigmul/=. + by apply/hasP; exists p => //; apply/mem_index_enum. + - rewrite -(subrBB (val (fxy p u))) {2}uv. + apply/(le_lt_trans (ler_normB _ _)). + by rewrite mulr2n mulrDl mul1r; apply/ltrD; apply/fxyd. +have: exists (fyx : forall p, + [fset x in dec_roots (pc p y)] -> [fset x in dec_roots (pc p x)]), + forall p, cancel (fxy p) (fyx p) /\ cancel (fyx p) (fxy p). + apply/(fin_all_exists (P:=fun p f => cancel (fxy p) f /\ cancel f (fxy p))). + move=> /= p. + by case: (fxy_bij p) => g; exists g. +move=> [] fyx fK. +have fxyK p : cancel (fxy p) (fyx p) by case: (fK p). +have {fK} fyxK p : cancel (fyx p) (fxy p) by case: (fK p). +have fyxd p (u : [fset x in dec_roots (pc p y)]) : + `|val u - val (fyx p u)| < d. + move: (fyxK p u) => /(congr1 val)/= uE. + by rewrite -{1}uE -normrN opprB; apply/fxyd. +have lift p z (u : [fset x in dec_roots (pc p z)]) : + z \in s -> + val u \in [fset x in dec_roots (\prod_(p : P) pc p z)]. + case: u => /= u; rewrite mem_imfset//= mem_dec_roots => /andP[_] pu zs. + rewrite mem_imfset//= mem_dec_roots pcM0//= root_bigmul. + by apply/hasP; exists p => //; apply/mem_index_enum. +have unlift z (u : [fset x in dec_roots (\prod_(p : P) pc p z)]) : + {p : P | val u \in [fset x in dec_roots (pc p z)]}. + case: u => /= u. + rewrite mem_imfset//= mem_dec_roots root_bigmul prodf_seq_neq0. + move=> /andP[+] /hasP/sig2W[/=] p _ pu. + move=> /allP/(_ p (mem_index_enum _)) /= pz0. + by exists p; rewrite mem_imfset//= mem_dec_roots pz0. +have /fin_all_exists/=: + forall (u : [fset x in dec_roots (\prod_(p : P) pc p x)]), + exists (v : [fset x in dec_roots (\prod_(p : P) pc p y)]), + `|val u - val v| < d. + move=> u; case: (unlift x u) => p pu. + by exists [` (lift p y (fxy p [` pu]) ys)] => /=; apply/fxyd. +move=> []gxy gxyd. +have /fin_all_exists/=: + forall (u : [fset x in dec_roots (\prod_(p : P) pc p y)]), + exists (v : [fset x in dec_roots (\prod_(p : P) pc p x)]), + `|val u - val v| < d. + move=> u; case: (unlift y u) => p pu. + by exists [` (lift p x (fyx p [` pu]) xs)] => /=; apply/fyxd. +move=> []gyx gyxd. +have gyxE p (u : [fset x in dec_roots (pc p y)]) : + gyx [` lift p y u ys] = [` lift p x (fyx p u) xs]. + apply/val_inj/dP => /=. + - move: (fsvalP (gyx [`lift p y u ys])). + by rewrite (mem_imfset _ _ (@inj_id _))/=. + - by move: (lift p x (fyx p u) xs); rewrite (mem_imfset _ _ (@inj_id _))/=. + rewrite -(subrBB (val u)) opprB -normrN opprD opprB. + apply/(le_lt_trans (ler_normB _ _)). + rewrite mulr2n mulrDl mul1r; apply/ltrD; first exact/gyxd. + exact/fyxd. +have size_pc (p : {poly R[i]}) : + size p = ((\sum_(u <- dec_roots p) \mu_u p) + (p != 0%R))%N. + have [->|{}p0] := eqVneq p 0; first by rewrite size_poly0 dec_roots0 big_nil. + move: (dec_roots_closedP p) => /(congr1 (fun p : {poly _} => size p)). + rewrite size_scale; last by rewrite -lead_coefE lead_coef_eq0 p0. + rewrite size_prod_seq => /= [| w _]; last first. + by rewrite expf_eq0 polyXsubC_eq0 andbF. + under eq_bigr do rewrite my_size_exp ?polyXsubC_eq0// size_XsubC/= mul1n. + under eq_bigr do rewrite -addn1. + by rewrite big_split/= sum1_size -addSn subDnAC// subnn -addn1. +have dP' p u: (count (fun v => (`|u - v| < d)%R) (dec_roots (pc p x)) <= 1)%N. + rewrite -size_filter. + move: (filter_uniq (fun v => `|u - v| < d) (uniq_dec_roots (pc p x))). + case rsdE: (seq.filter _ _) => [//|a rsd]. + case: rsd rsdE => [//|b rsd] rsdE /= /andP[] + _. + rewrite in_cons negb_or => /andP[] /eqP + _. + have: a \in [:: a, b & rsd] by exact/mem_head. + have: b \in [:: a, b & rsd] by rewrite in_cons mem_head orbT. + rewrite -rsdE !mem_filter !mem_dec_roots. + move=> /andP[] wbd /andP[_] bx /andP[] wba /andP[_] ax. + elim; apply/dP. + - rewrite mem_dec_roots pcM0//= root_bigmul. + apply/hasP; exists p => //; apply/mem_index_enum. + - rewrite mem_dec_roots pcM0//= root_bigmul. + by apply/hasP; exists p => //; apply/mem_index_enum. + rewrite -(subrBB u) opprB -normrN opprD opprB. + apply/(le_lt_trans (ler_normB _ _)). + by rewrite mulr2n mulrDl mul1r; apply/ltrD. +have ball_root1 (p : P) (u : [fset x | x in dec_roots (\prod_p pc p y)]) : + root (pc p y) (val u) -> + [seq v <- dec_roots (pc p y) | `|v - val (gyx u)| < d] = [:: val u]. + move=> pu. + have: all (fun v => v == val u) + [seq v <- dec_roots (pc p y) | `|v - val (gyx u)| < d]. + apply/allP => v; rewrite mem_filter => /andP[] vu vp. + have uP: val u \in [fset x | x in dec_roots (pc p y)]. + by rewrite (mem_imfset _ _ (@inj_id _))/= mem_dec_roots pc0. + have vP: v \in [fset x | x in dec_roots (pc p y)] by rewrite mem_imfset. + apply/eqP; rewrite -[val u]/(val [` uP]) -[v]/(val [` vP]) ; congr val. + apply/(can_inj (fyxK p))/val_inj/dP. + - move: (fsvalP [` lift p x (fyx p [` vP]) xs]). + by rewrite (mem_imfset _ _ (@inj_id _))/=. + - move: (fsvalP [` lift p x (fyx p [` uP]) xs]). + by rewrite (mem_imfset _ _ (@inj_id _))/=. + rewrite -(subrBB v) opprB -normrN opprD opprB. + apply/(le_lt_trans (ler_normB _ _)). + rewrite mulr2n mulrDl mul1r; apply/ltrD; first exact/fyxd. + move: vu; congr (`|_ - _| < d). + rewrite -[RHS]/(val [` lift p x (fyx p [` uP]) xs]) -gyxE. + by congr (val (gyx _)); apply/val_inj. + have: uniq [seq v <- dec_roots (pc p y) | `|v - val (gyx u)| < d]. + exact/filter_uniq/uniq_dec_roots. + have: val u \in [seq v <- dec_roots (pc p y) | `|v - val (gyx u)| < d]. + by rewrite mem_filter gyxd mem_dec_roots pc0. + case: (seq.filter _ _) => [|/= a l]; first by rewrite in_nil. + move=> _ /[swap] /andP[] /eqP ->. + by case: l => [//|b l] /= /andP[] /eqP -> _; rewrite mem_head. +have gxyK: cancel gxy gyx. + move=> u; apply/val_inj/dP. + - by move: (fsvalP (gyx (gxy u))); rewrite (mem_imfset _ _ (@inj_id _))//. + - by move: (fsvalP u); rewrite (mem_imfset _ _ (@inj_id _))//. + rewrite -(subrBB (val (gxy u))) -normrN [X in `|X|]opprB opprB. + apply/(le_lt_trans (ler_normD _ _)). + rewrite mulr2n mulrDl mul1r; apply/ltrD; first exact/gxyd. + exact/gyxd. +have gyx_root p (u : [fset x | x in dec_roots (\prod_p pc p y)]) : + root (pc p y) (val u) -> root (pc p x) (val (gyx u)). + move=> pu. + have uP: val u \in [fset x | x in dec_roots (pc p y)]. + by rewrite (mem_imfset _ _ (@inj_id _))/= mem_dec_roots pc0. + move: (fsvalP (fyx p [` uP])); rewrite (mem_imfset _ _ (@inj_id _))/=. + rewrite mem_dec_roots pc0 //=; congr root. + rewrite -[LHS]/(val [` lift p x (fyx p [` uP]) xs]) -gyxE. + by congr (val (gyx _)); apply/val_inj. +have ltnn_ne (a b : nat) : (a < b)%N -> a <> b. + by move=> /[swap] ->; rewrite ltnn. +have mu_gyx p (u : [fset x | x in dec_roots (\prod_p pc p y)]) : + root (pc p y) (val u) -> + \mu_(val (gyx u)) (pc p x) = \mu_(val u) (pc p y). + move=> pu. + apply/le_anti/andP; split. + case: (xd' p) => _ /(_ y ys (xy p (mem_index_enum _)))/(_ (val (gyx u))). + move=> /(_ (gyx_root p u pu)). + by rewrite -[X in (_ <= X)%N]big_filter ball_root1 ?big_seq1. + rewrite /Order.le/= leqNgt; apply/negP => mpu. + move: (psize (val p) (fsvalP p) x y xs ys). + move: (size_pc (pc p x)) (size_pc (pc p y)). + rewrite !size_map_poly => -> -> /eqP. + rewrite !pc0// !addn1 eqSS => /eqP. + rewrite -[RHS](big_rmcond_in (fun u => + has (fun v => `|u - v| < d) (dec_roots (pc p x))))/=; last first. + move=> v pv. + have vP : v \in [fset x | x in dec_roots (pc p y)] by rewrite mem_imfset//=. + rewrite -all_predC => /allP. + move: (fsvalP (fyx p [` vP])); rewrite (mem_imfset _ _ (@inj_id _))/=. + by move=> /[swap]/[apply]; rewrite fyxd. + rewrite (@big_hasE _ _ _ _ _ _ xpredT)/= => [|v _]; last exact/dP'. + apply/ltnn_ne; rewrite big_seq_cond [X in (_ < X)%N]big_seq_cond. + rewrite ltn_sum//= => [v|]. + rewrite andbT mem_dec_roots => /andP[_] pv. + by case: (xd' p) => _ /(_ y ys (xy p (mem_index_enum _)))/(_ v pv). + apply/hasP; exists (val (gyx u)). + by rewrite mem_dec_roots pc0//=; apply/gyx_root. + rewrite mem_dec_roots pc0//= gyx_root//=. + apply/(leq_trans mpu). + rewrite [X in (_ <= X)%N]big_mkcond (bigD1_seq (val u))/=; first last. + - exact/uniq_dec_roots. + - by rewrite mem_dec_roots pc0. + by rewrite gyxd leq_addr. +have gyxK: cancel gyx gxy. + move=> v; apply/val_inj; move: (gyx v) (gyxd v) => u vud. + case: (unlift y v) (gxy u) (gxyd u) => p pv w uw. + case: (unlift y w) => q qw. + apply/eqP; rewrite -[_ == _]negbK; apply/negP => /eqP wv. + move: (pqsize (val p) (val q) (fsvalP p) (fsvalP q) x y xs ys). + move: (size_pc (gcdp (pc p x) (pc q x))) (size_pc (gcdp (pc p y) (pc q y))). + rewrite !gcdp_eq0 !negb_and !pc0//= !addn1 -!gcdp_map !size_map_poly. + move=> -> -> /eqP. + rewrite eqSS !gcdp_map -!/(pc _ _) => /eqP/esym. + under eq_bigr do rewrite mu_gcdp ?pc0//. + under [in RHS]eq_bigr do rewrite mu_gcdp ?pc0//. + apply/ltnn_ne. + rewrite -(big_rmcond_in (fun u => has (fun v => `|u - v| < d) + (dec_roots (gcdp (pc p x) (pc q x)))))/=; last first. + move=> a; rewrite mem_dec_roots root_gcd => /andP[_] /andP[] pa qa. + rewrite -all_predC => /allP/=. + have aP: a \in [fset x in dec_roots (\prod_(p : P) pc p y)]. + rewrite mem_imfset//= mem_dec_roots pcM0//= root_bigmul. + by apply/hasP; exists p => //; apply/mem_index_enum. + suff /[swap]/[apply]: + val (gyx [` aP]) \in dec_roots (gcdp (pc p x) (pc q x)). + by rewrite gyxd. + by rewrite mem_dec_roots gcdp_eq0 negb_and !pc0//= root_gcd !gyx_root//. + rewrite (@big_hasE _ _ _ _ _ _ xpredT)/=; last first. + move=> a _; rewrite -size_filter. + move: (filter_uniq (fun v => + `|a - v| < d) (uniq_dec_roots (gcdp (pc p x) (pc q x)))). + case rsdE: (seq.filter _ _) => [//|b rsd]. + case: rsd rsdE => [//|c rsd] rsdE /= /andP[] + _. + rewrite in_cons negb_or => /andP[] /eqP + _. + have: b \in [:: b, c & rsd] by exact/mem_head. + have: c \in [:: b, c & rsd] by rewrite in_cons mem_head orbT. + rewrite -rsdE !mem_filter !mem_dec_roots !root_gcd. + move=> /andP[] wcd /andP[_] /andP[_] cx /andP[] wcb /andP[_] /andP[_] bx. + elim; apply/dP. + - rewrite mem_dec_roots pcM0//= root_bigmul. + apply/hasP; exists q => //; apply/mem_index_enum. + - rewrite mem_dec_roots pcM0//= root_bigmul. + apply/hasP; exists q => //; apply/mem_index_enum. + rewrite -(subrBB a) opprB -normrN opprD opprB. + apply/(le_lt_trans (ler_normB _ _)). + by rewrite mulr2n mulrDl mul1r; apply/ltrD. + rewrite big_seq_cond [X in (_ < X)%N]big_seq_cond. + apply/ltn_sum => [a|]. + rewrite andbT mem_dec_roots root_gcd => /andP[_] /andP[] pa qa. + rewrite -big_filter. + have aP: a \in [fset x | x in dec_roots (pc p x)]. + by rewrite mem_imfset//= mem_dec_roots pc0. + have aQ: a \in [fset x | x in dec_roots (pc q x)]. + by rewrite mem_imfset//= mem_dec_roots pc0. + have: + uniq [seq i <- dec_roots (gcdp (pc p y) (pc q y)) | normr (i - a) < d]. + exact/filter_uniq/uniq_dec_roots. + have: all (fun b => b == val (fxy p [` aP])) + [seq i <- dec_roots (gcdp (pc p y) (pc q y)) | (normr (i - a) < d)%R]. + apply/allP => b; rewrite mem_filter mem_dec_roots root_gcd. + move=> /andP[] ba /andP[_] /andP[] pb _. + have bP: b \in [fset x | x in dec_roots (pc p y)]. + by rewrite mem_imfset//= mem_dec_roots pc0. + rewrite -[b]/(val [` bP]); apply/eqP; congr fsval. + apply/(can_inj (fyxK p)); rewrite (fxyK p); apply/val_inj/dP. + - move: (fsvalP (fyx p [` bP])); rewrite (mem_imfset _ _ (@inj_id _))/=. + rewrite !mem_dec_roots pcM0//= root_bigmul => /andP[_] pbx. + apply/hasP; exists p => //; apply/mem_index_enum. + - move: (fsvalP [` aP]); rewrite (mem_imfset _ _ (@inj_id _))/=. + rewrite !mem_dec_roots pcM0//= root_bigmul => /andP[_] pax. + apply/hasP; exists p => //; apply/mem_index_enum. + rewrite -(subrBB b)/= opprB -normrN opprD opprB. + apply/(le_lt_trans (ler_normB _ _)). + by rewrite mulr2n mulrDl mul1r; apply/ltrD; first exact/fyxd. + case: (seq.filter _ _) => /= [_ _|b + /andP[] /eqP ->]. + by rewrite big_nil. + case=> /= [_ _|c l /andP[] /eqP -> _]; last by rewrite mem_head. + rewrite big_seq1/=. + have aE: a = val (gyx [` lift p y (fxy p [` aP]) ys]). + by rewrite gyxE/= (fxyK p). + rewrite [in X in (_ <= X)%N]aE mu_gyx/=; last first. + move: (fsvalP (fxy p [` aP])); rewrite (mem_imfset _ _ (@inj_id _))/=. + by rewrite mem_dec_roots => /andP[_]. + rewrite leq_min [ X in X && _]geq_minl/= geq_min; apply/orP; right. + case/boolP: (root (pc q y) (val (fxy p [` aP]))) => [qfa|/muNroot -> //]. + by rewrite mu_gyx. + have upE: u = gyx v. + apply/val_inj/dP. + - by move: (fsvalP u); rewrite (mem_imfset _ _ (@inj_id _))/=. + - by move: (fsvalP (gyx v)); rewrite (mem_imfset _ _ (@inj_id _))/=. + rewrite -(subrBB (val v)) opprB -normrN opprD opprB. + apply/(le_lt_trans (ler_normB _ _)). + by rewrite mulr2n mulrDl mul1r; apply/ltrD; last exact/gyxd. + have uqE: u = gyx w. + apply/val_inj/dP. + - by move: (fsvalP u); rewrite (mem_imfset _ _ (@inj_id _))/=. + - by move: (fsvalP (gyx w)); rewrite (mem_imfset _ _ (@inj_id _))/=. + rewrite -(subrBB (val w)) opprB. + apply/(le_lt_trans (ler_normD _ _)). + by rewrite mulr2n mulrDl mul1r; apply/ltrD; last exact/gyxd. + have pv': root (pc p y) (val v). + move: pv; rewrite (mem_imfset _ _ (@inj_id _))/=. + by rewrite mem_dec_roots => /andP[_]. + have qw': root (pc q y) (val w). + move: qw; rewrite (mem_imfset _ _ (@inj_id _))/=. + by rewrite mem_dec_roots => /andP[_]. + have pqu: \val u \in dec_roots (gcdp (pc p x) (pc q x)). + rewrite mem_dec_roots gcdp_eq0 negb_and !pc0//= root_gcd. + rewrite {1}upE gyx_root// uqE gyx_root//. + apply/hasP; exists (val u) => //=. + rewrite pqu/= -big_filter. + suff ->: [seq i <- dec_roots (gcdp (pc p y) (pc q y)) + | (normr (i - fsval u) < d)%R] = [::]. + rewrite big_nil {1}upE uqE (mu_gyx p v pv') (mu_gyx q w qw') leq_min. + by apply/andP; split; rewrite mu_gt0// pc0. + apply/eqP/eq_mem_nil => a; rewrite in_nil mem_filter mem_dec_roots. + rewrite gcdp_eq0 negb_and !pc0//= root_gcd. + apply/negP => /andP[] au /andP[] pa qa. + have aP: a \in [fset x | x in dec_roots (pc p y)]. + by rewrite mem_imfset//= mem_dec_roots pc0. + have aQ: a \in [fset x | x in dec_roots (pc q y)]. + by rewrite mem_imfset//= mem_dec_roots pc0. + apply/wv; transitivity a. + rewrite -[a]/(val [` aQ]) -[LHS]/(val [` qw]); congr fsval. + apply/(can_inj (fyxK q)); apply/val_inj/dP. + - move: (fsvalP (fyx q [` qw])); rewrite (mem_imfset _ _ (@inj_id _))/=. + rewrite !mem_dec_roots pcM0//= root_bigmul => /andP[_] pbx. + apply/hasP; exists q => //; apply/mem_index_enum. + - move: (fsvalP (fyx q [` aQ])); rewrite (mem_imfset _ _ (@inj_id _))/=. + rewrite !mem_dec_roots pcM0//= root_bigmul => /andP[_] pax. + apply/hasP; exists q => //; apply/mem_index_enum. + rewrite -(subrBB a)/= opprB -normrN opprD opprB. + apply/(le_lt_trans (ler_normB _ _)). + rewrite mulr2n mulrDl mul1r; apply/ltrD; last exact/fyxd. + rewrite -[X in _ - X]/(val [` lift q x (fyx q [` qw]) xs]) -gyxE/=. + move: au; congr (`|_ - _| < d). + by rewrite uqE; congr (val (gyx _)); apply/val_inj. + rewrite -[a]/(val [` aP]) -[RHS]/(val [` pv]); congr fsval. + apply/(can_inj (fyxK p)); apply/val_inj/dP. + - move: (fsvalP (fyx p [` aP])); rewrite (mem_imfset _ _ (@inj_id _))/=. + rewrite !mem_dec_roots pcM0//= root_bigmul => /andP[_] pax. + apply/hasP; exists p => //; apply/mem_index_enum. + - move: (fsvalP (fyx p [` pv])); rewrite (mem_imfset _ _ (@inj_id _))/=. + rewrite !mem_dec_roots pcM0//= root_bigmul => /andP[_] pbx. + apply/hasP; exists p => //; apply/mem_index_enum. + rewrite -(subrBB a)/= opprB -normrN opprD opprB. + apply/(le_lt_trans (ler_normB _ _)). + rewrite mulr2n mulrDl mul1r; apply/ltrD; first exact/fyxd. + rewrite -[X in _ - X]/(val [` lift p x (fyx p [` pv]) xs]) -gyxE/=. + move: au; congr (`|_ - _| < d). + by rewrite upE; congr (val (gyx _)); apply/val_inj. +have gR (u : [fset x | x in dec_roots (\prod_p pc p x)]) : + (val u \is Num.real) = (val (gxy u) \is Num.real). + have ucP z (v : [fset x | x in dec_roots (\prod_(p : P) pc p z)]) : + z \in s -> + ((val v)^* )%C \in [fset x | x in dec_roots (\prod_(p : P) pc p z)]. + move=> zs; move: (unlift z v) => [] p pv. + rewrite (mem_imfset _ _ (@inj_id _))/= mem_dec_roots pcM0//= root_bigmul. + apply/hasP; exists p; first exact/mem_index_enum. + rewrite -complex_root_conj/= map_poly_id => [|a]. + move: pv; rewrite (mem_imfset _ _ (@inj_id _))/=. + by rewrite mem_dec_roots => /andP[_]. + move=> /[dup] /(nth_index 0)/=. + rewrite -index_mem size_map_poly => + alt. + by rewrite coef_poly alt => <-; rewrite conjc_real. + have ne20: 2 != 0 :> R[i] by rewrite pnatr_eq0. + apply/idP/idP => uR. + suff ->: \val (gxy u) = 'Re (\val (gxy u)) by apply/Creal_Re. + apply/(mulfI ne20). + rewrite -complexRe -addcJ mulr2n mulrDl mul1r; congr (_ + _)%R. + rewrite -[RHS]/(val [` ucP y (gxy u) ys]); congr val. + apply/(can_inj gyxK); rewrite gxyK; apply/val_inj/dP. + - by move: (fsvalP u); rewrite (mem_imfset _ _ (@inj_id _)). + - move: (fsvalP (gyx [` ucP y (gxy u) ys])). + by rewrite (mem_imfset _ _ (@inj_id _)). + rewrite -(subrBB (val [` ucP y (gxy u) ys])) opprB. + apply/(le_lt_trans (ler_normD _ _)). + rewrite mulr2n mulrDl mul1r; apply/ltrD; last exact/gyxd. + rewrite /= -(RRe_real uR) -conjc_real -rmorphB/= norm_conjC (RRe_real uR). + exact/gxyd. + suff ->: \val u = 'Re (\val u) by apply/Creal_Re. + apply/(mulfI ne20). + rewrite -complexRe -addcJ mulr2n mulrDl mul1r; congr (_ + _)%R. + apply/dP. + - by move: (fsvalP u); rewrite (mem_imfset _ _ (@inj_id _)). + - by move: (fsvalP ([` ucP x u xs])); rewrite (mem_imfset _ _ (@inj_id _)). + rewrite -(subrBB (val (gxy u))). + apply/(le_lt_trans (ler_normB _ _)). + rewrite mulr2n mulrDl mul1r; apply/ltrD; first exact/gxyd. + rewrite /= -(RRe_real uR) -conjc_real -rmorphB/= norm_conjC (RRe_real uR). + exact/gxyd. +split; last first; apply/eqP; rewrite rowPE forall_ord1. + rewrite -!cE eqr_nat; apply/eqP. + pose cs (z : 'rV[R]_n.+1) := + dec_roots (map_poly (real_complex R) (evalpmp z (\prod_(p : P) val p))). + have card_cs z: #|` [fset x in cs z]| = size (cs z). + by rewrite /rs card_imfset//= undup_id// uniq_dec_roots. + rewrite -(card_cs x) -(card_cs y). + have /bij_eq_card: bijective gxy by exists gyx. + by rewrite /cs /= !cardfE !evalpmp_prod !rmorph_prod. +rewrite -!rE eqr_nat -(card_rs x) -(card_rs y); apply/eqP. +have liftRP: forall z, z \in s -> + forall (u : [fset x | x in rootsR (\prod_(p : P) (evalpmp z (val p)))]), + exists (v : [fset x | x in dec_roots (\prod_p pc p z)]), + val v = (val u)%:C%C. + move=> z zs; case=> /= u; rewrite mem_imfset//= in_rootsR => /andP[_] pu. + suff uP: u%:C%C \in [fset x0 | x0 in dec_roots (\prod_p pc p z)]. + by exists [` uP]. + rewrite (mem_imfset _ _ (@inj_id _))/= mem_dec_roots pcM0//=. + by rewrite -rmorph_prod/= fmorph_root. +move: (fun z zs => fin_all_exists (liftRP z zs)) => {}liftRP. +case: (liftRP x xs) => liftxR liftxRE. +case: (liftRP y ys) => liftyR liftyRE {liftRP}. +have /fin_all_exists: + forall (u : [fset x | x in rootsR (\prod_(p : P) (evalpmp x (val p)))]), + exists (v : [fset x | x in rootsR (\prod_(p : P) (evalpmp y (val p)))]), + (val v)%:C%C = val (gxy (liftxR u)). + move=> u. + have: val (liftxR u) \is Num.real. + by apply/complex_realP; exists (val u); apply/liftxRE. + rewrite gR => /Creal_ReP; rewrite -complexRe => uE. + suff uP: complex.Re (val (gxy (liftxR u))) + \in [fset x0 | x0 in rootsR (\prod_(p : P) evalpmp y (\val p))]. + by exists [` uP] => /=; apply/uE. + rewrite (mem_imfset _ _ (@inj_id _))/= in_rootsR. + move: (fsvalP (gxy (liftxR u))). + rewrite -uE (mem_imfset _ _ (@inj_id _))/= mem_dec_roots. + by rewrite -{1 2}rmorph_prod/= fmorph_root map_poly_eq0. +move=> [] hxy hxyE. +have /fin_all_exists: + forall (u : [fset x | x in rootsR (\prod_(p : P) (evalpmp y (val p)))]), + exists (v : [fset x | x in rootsR (\prod_(p : P) (evalpmp x (val p)))]), + (val v)%:C%C = val (gyx (liftyR u)). + move=> u. + have: val (liftyR u) \is Num.real. + by apply/complex_realP; exists (val u); apply/liftyRE. + rewrite -{1}[liftyR u]gyxK -gR => /Creal_ReP; rewrite -complexRe => uE. + suff uP: complex.Re (val (gyx (liftyR u))) + \in [fset x0 | x0 in rootsR (\prod_(p : P) evalpmp x (\val p))]. + by exists [` uP] => /=; apply/uE. + rewrite (mem_imfset _ _ (@inj_id _))/= in_rootsR. + move: (fsvalP (gyx (liftyR u))). + rewrite -uE (mem_imfset _ _ (@inj_id _))/= mem_dec_roots. + by rewrite -{1 2}rmorph_prod/= fmorph_root map_poly_eq0. +move=> [] hyx hyxE. +suff /bij_eq_card: bijective hxy by rewrite /rs /= !evalpmp_prod !cardfE. +exists hyx => u; apply/val_inj/complexI. + rewrite hyxE. + have ->: liftyR (hxy u) = gxy (liftxR u). + by apply/val_inj; rewrite liftyRE hxyE. + by rewrite gxyK liftxRE. +rewrite hxyE. +have ->: liftxR (hyx u) = gyx (liftyR u). + by apply/val_inj; rewrite liftxRE hyxE. +by rewrite gyxK liftyRE. +Qed.*) + +Definition elimp_subdef1 n (P : {fset {mpoly R[n.+1]}}) := + \big[fsetU/fset0]_(p : P) truncations (muni (val p)). + +Definition elimp_subdef2 n (P : {fset {mpoly R[n.+1]}}) : {fset {mpoly R[n]}} := + \big[fsetU/fset0]_(p : elimp_subdef1 P | (3 <= size (val p))%N) + [fset subresultant (val j) (val p) (val p)^`() | + j : 'I_(size (val p)).-2]. + +Definition elimp_subdef3 n (P : {fset {mpoly R[n.+1]}}) := + \big[fsetU/fset0]_(p : elimp_subdef1 P) + \big[fsetU/fset0]_(q : elimp_subdef1 P | (size (val q) <= size (val p))%N) + [fset subresultant (val j) (val p) (val q) | j : 'I_(size (val q)).-1]. + +(* Is that an optimization? +Definition elimp_subdef4 n (P : {fset {mpoly R[n.+1]}}) := + \big[fsetU/fset0]_(p : elimp_subdef1 P) + \big[fsetU/fset0]_(q : elimp_subdef1 P | (size (val q) == size (val p))%N) + let q := lead_coef (val p) *: (val q) - lead_coef (val q) *: (val p) in + [fset subresultant (val j) (val p) (val q) | j : 'I_(size (val q)).-1]. + *) + +Definition elimp_subdef5 n (P : {fset {mpoly R[n.+1]}}) := + [fset lead_coef (val p) | p : elimp_subdef1 P]. + +Definition elimp n (P : {fset {mpoly R[n.+1]}}) := + [fset p in elimp_subdef2 P `|` elimp_subdef3 P + (* `|` elimp_subdef4 P *) `|` elimp_subdef5 P | (1 < msize p)%N]. + +Lemma map_poly_truncate (A B : ringType) (f : {rmorphism A -> B}) d + (p : {poly A}) : + map_poly f (truncate p d) = truncate (map_poly f p) d. +Proof. +apply/polyP => i. +rewrite coef_map !coef_poly [LHS]fun_if [in RHS]ltn_min andbC. +case: (ltnP i (size (map_poly f p))) => ifp /=. + by rewrite -if_and ltn_min rmorph0. +case: ifP => _; last exact/rmorph0. +rewrite -coef_map. +by move/leq_sizeP: ifp; apply. +Qed. + +Lemma SAconnected_CD_cell n (S : {fset {SAset R ^ n}}) (s : S) : + isCD S -> SAconnected (val s). +Proof. +elim: n S s => [|n IHn] S s/= [] Spart. + move=> _ u v _ _. + case: (set0Vmem (val s :&: u)) => [-> + _|[] x]; first by rewrite eqxx. + rewrite inSAsetI => /andP[] xs xu _. + case: (set0Vmem (val s :&: v)) => [->|[] y]; first by rewrite eqxx. + rewrite inSAsetI => /andP[] _ xv _ _. + apply/negP => /SAsetP/(_ x). + rewrite !inSAsetI xs xu inSAset0. + suff ->: x = y by rewrite xv. + by apply/rowP; case. +move=> [] SCD. +have sP: SAset_cast n (val s) \in [fset SAset_cast n s0 | s0 in S]. + apply/imfsetP; exists (val s) => //. + exact/fsvalP. +move=> /(_ [` sP])[] m [] xi [] xicont [] xisort SE. +have: val s \in [fset s + | s in [pred s0 in S | + SAset_cast n s0 == + ((fsval (A:=[fset SAset_cast n s | s in S])).[sP])%fmap]]. + by rewrite !inE/= eqxx andbT; apply/fsvalP. +rewrite SE => /imfsetP[/=] t txi ->. +apply/SAcast_connected. +apply/(@SAconnected_partition_of_graphs_above _ _ + (SAset_cast n (val s)) (val xi)). +- exact/(IHn _ [` sP] SCD). +- exact/xisort. +- move=> /= i; rewrite size_tuple => im; move: (xicont (Ordinal im)). + by rewrite (tnth_nth 0). +- by []. +Qed. + +Lemma horner_evalpmp n (x : 'rV[R]_n) p y : + (evalpmp x p).[y] = p.[y%:MP_[n]].@[tnth (ngraph x)]. +Proof. by rewrite -{1}(mevalC (tnth (ngraph x)) y) horner_map/=. Qed. + +Section Cylindrical_decomposition_lift. +Context n (P : {fset {mpoly R[n.+1]}}) (S' : {fset {SAset R^n}}). +Hypothesis (S'CD : isCD S') (S'p : forall p : elimp P, poly_adapted (val p) S'). + +Local Lemma S'part : SAset_partition S'. +Proof. by case: (n) S' S'CD => [|m] ? []. Qed. + +Local Lemma pick (s' : S') : {x | x \in val s'}. +Proof. +case: (set0Vmem (val s')) => [s'0|//]. +move: S'part => /andP[] /andP[] /negP S'0 _ _. +by exfalso; apply/S'0; rewrite -s'0 -in_fsub fsubT finset.in_setT. +Qed. + +Local Lemma nth_const (s' : S') (p : P) x y : + x \in val s' -> y \in val s' -> + forall i, ((size (evalpmp x (muni (val p)))).-1 <= i)%N -> + sgz (evalpmp x (muni (val p)))`_i = sgz (evalpmp y (muni (val p)))`_i. +Proof. +move=> xs ys i xi. +have iE z: (evalpmp z (muni (\val p)))`_i + = (truncate (evalpmp z (muni (\val p))) i.+1)`_i. + rewrite [RHS]coef_poly ltn_min leqnn/=. + case: ifP => [//|] /negP/negP; rewrite -leqNgt => {}zi. + by rewrite nth_default. +rewrite !iE -!map_poly_truncate/= !coef_map/=. +case: (ltnP 1 (msize ((truncate (muni (val p)) i.+1)`_i))) + => [pi1|]; last first. + by move=> /msize1_polyC ->; rewrite !mevalC. +move: xi; rewrite -ltnS => /(leq_trans (leqSpred _)) xi. +suff iP: (truncate (muni (fsval p)) i.+1)`_i \in elimp P. + exact: (S'p [` iP] xs ys). +have si: size (truncate (muni (val p)) i.+1) = i.+1. + apply/anti_leq/andP; split. + exact/(leq_trans (size_poly _ _))/geq_minl. + by apply/gt_size/eqP => pi0; rewrite pi0 msize0 in pi1. +rewrite inE/= inE/=; apply/andP; split=> //. +rewrite in_fsetU; apply/orP; right. +move: si => /(congr1 predn); rewrite succnK => si. +rewrite -[X in _`_X]si -lead_coefE. +suff iP: truncate (muni (fsval p)) i.+1 \in elimp_subdef1 P. + by apply/imfsetP; exists [` iP]. +apply/bigfcupP; exists p; first by rewrite mem_index_enum. +exact/(truncations_witness xi). +Qed. + +Local Lemma S'size (s' : S') (p : P) : + {in val s', forall x, + size (evalpmp x (muni (val p))) + = size (evalpmp (proj1_sig (pick s')) (muni (val p)))}. +Proof. +suff: {in val s' &, forall x y, + (size (evalpmp x (muni (val p))) <= size (evalpmp y (muni (val p))))%N}. + move=> S'size x xS; apply/anti_leq/andP. + split; apply/S'size => //; exact/(proj2_sig (pick s')). +move=> x y xs ys; apply/leq_sizeP => i yi. +apply/eqP; rewrite -sgz_eq0 -(nth_const ys xs). + by rewrite sgz_eq0 nth_default. +exact/(leq_trans (leq_pred _) yi). +Qed. + +Local Lemma R0: [char R] =i pred0. +Proof. exact/char_num. Qed. + +Local Lemma Rn_char: + [char mpoly_mpoly__canonical__GRing_IntegralDomain n R] =i pred0. +Proof. +move=> a; rewrite !inE; apply/negP => /andP[] /prime_gt0. +by rewrite -mpolyC_nat mpolyC_eq0 pnatr_eq0 lt0n => /negP. +Qed. + +Local Lemma res_const (s' : S') (p q : P) (x y : 'rV_n): + x \in \val s' -> + y \in \val s' -> + forall i, + (i <= (size (evalpmp (val (pick s')) (muni (val p)))).-1)%N -> + (i <= (size (evalpmp (val (pick s')) (muni (val q)))).-1)%N -> + sgz (subresultant i (evalpmp x (muni (\val p))) + (evalpmp x (muni (\val q)))) = + sgz (subresultant i (evalpmp y (muni (\val p))) + (evalpmp y (muni (\val q)))). +Proof. +move=> xs ys i; rewrite {1}leq_eqVlt => /orP[/eqP -> _|ip]. + rewrite -{1}(S'size p xs) -(S'size p ys). + rewrite !subresultant_last !sgzX. + congr (_ ^+ (_.-1 - _.-1 + (_ < _))); last first. + - by rewrite (S'size p xs) (S'size p ys). + - by rewrite (S'size q xs) (S'size q ys). + - by rewrite (S'size p xs) (S'size p ys). + - by rewrite (S'size q xs) (S'size q ys). + rewrite !lead_coefE (S'size p ys) -(S'size p xs). + by apply/(@nth_const s'); last exact/leqnn. +rewrite leq_eqVlt => /orP[/eqP ->|iq]. + rewrite subresultantC [in RHS]subresultantC sgzM [in RHS]sgzM. + congr (_ * _). + congr (sgz ((-1) ^+ _)); congr 'C(_, 2). + congr ((_.-1 - _) + (_.-1 - _))%N. + by rewrite (S'size p xs) (S'size p ys). + by rewrite (S'size q xs) (S'size q ys). + rewrite -{1}(S'size q xs) -(S'size q ys). + rewrite !subresultant_last !sgzX; congr (_ ^+ (_.-1 - _.-1 + (_ < _))); + last first. + - by rewrite (S'size q xs) (S'size q ys). + - by rewrite (S'size p xs) (S'size p ys). + - by rewrite (S'size q xs) (S'size q ys). + - by rewrite (S'size p xs) (S'size p ys). + rewrite !lead_coefE (S'size q ys) -(S'size q xs). + by apply/(@nth_const s'); last exact/leqnn. +pose Q (r : P) := + truncate (muni (\val r)) (size (evalpmp (val (pick s')) (muni (\val r)))). +wlog: p q ip iq / (size (Q q) <= size (Q p))%N => qp. + move/orP: (leq_total (size (Q q)) (size (Q p))). + case=> [/(qp p q ip iq)//|] /(qp q p iq ip) {}qp. + rewrite subresultantC [in RHS]subresultantC sgzM [in RHS]sgzM. + congr (_ * _); last exact: qp. + congr (sgz ((-1) ^+ _)); congr 'C(_, 2). + congr ((_.-1 - _) + (_.-1 - _))%N. + by rewrite (S'size p xs) (S'size p ys). + by rewrite (S'size q xs) (S'size q ys). +have QE r z : z \in val s' -> (evalpmp z (muni (val r))) = evalpmp z (Q r). + move=> zs. + by rewrite [RHS]map_poly_truncate/= -(S'size r zs) truncate_size. +have Qsize r z : z \in val s' -> size (evalpmp z (Q r)) = size (Q r). + move=> zs; rewrite -(QE r z zs) (S'size r zs). + apply/le_anti/andP; split; last first. + exact/(leq_trans (size_poly _ _))/geq_minl. + case: (posnP (size (evalpmp (sval (pick s')) (muni (\val r))))). + by move=> ->; apply/leq0n. + move=> s0; rewrite -(prednK s0); apply/gt_size. + rewrite coef_poly (prednK s0) leq_min leqnn/= size_poly. + apply/eqP => r0. + have/eqP {}r0 : evalpmp (sval (pick s')) (muni (fsval r)) == 0. + by rewrite -lead_coef_eq0 lead_coefE coef_map/= r0 meval0. + by move: s0; rewrite r0 size_poly0 ltnn. +(* N.B. Why does Coq stop responding if I do not give the location? *) +rewrite [X in subresultant i X](QE p x xs). +rewrite [X in _ = sgz (subresultant i X _)](QE p y ys). +rewrite [X in subresultant i _ X](QE q x xs). +rewrite [X in _ = sgz (subresultant i _ X)](QE q y ys). +have Q0 (r : P) z : z \in val s' -> + (i < (size (evalpmp (\val (pick s')) (muni (\val r)))).-1)%N -> + (lead_coef (Q r)).@[tnth (ngraph z)] != 0. + move=> zs ir. + rewrite lead_coefE -coef_map -(Qsize r z zs) -lead_coefE lead_coef_eq0. + rewrite -size_poly_eq0 (Qsize r z zs) -(Qsize r _ (proj2_sig (pick s'))). + rewrite -(QE _ _ (proj2_sig (pick s'))). + by apply/eqP => s0; rewrite s0 in ir. +rewrite !subresultant_map_poly/=; first last. +- exact/Q0. +- exact/Q0. +- exact/Q0. +- exact/Q0. +case: (ltnP 1 (msize (subresultant i (Q p) (Q q)))) => [pq1|]; last first. + by move=> /msize1_polyC ->; rewrite !mevalC. +suff pqP: subresultant i (Q p) (Q q) \in elimp P. + exact: (S'p [` pqP] xs ys). +rewrite inE/= inE; apply/andP; split=> //. +rewrite 2!inE orbAC; apply/orP; right. +have pP: Q p \in elimp_subdef1 P. + apply/bigfcupP; exists p; first by rewrite mem_index_enum. + exact/truncations_witness. +apply/bigfcupP; exists [` pP]; first by rewrite mem_index_enum/=. +have qP: Q q \in elimp_subdef1 P. + apply/bigfcupP; exists q; first by rewrite mem_index_enum. + exact/truncations_witness. +apply/bigfcupP; exists [` qP]; first by rewrite mem_index_enum/=. +move: iq; rewrite -(S'size q xs) (QE q x xs) (Qsize q x xs) => iq. +by apply/imfsetP => /=; exists (Ordinal iq). +Qed. + +Local Lemma res'_const (s' : S') (p : P) (x y : 'rV_n): + x \in \val s' -> + y \in \val s' -> + forall i, + (i <= (size (evalpmp (val (pick s')) (muni (val p)))).-1)%N -> + sgz (subresultant i (evalpmp x (muni (\val p))) + (evalpmp x (muni (\val p)))^`()) = + sgz (subresultant i (evalpmp y (muni (\val p))) + (evalpmp y (muni (\val p)))^`()). +Proof. +move=> xs ys i. +rewrite leq_eqVlt => /orP[/eqP ->|/leq_predn]. + rewrite -{1}(S'size p xs) -(S'size p ys). + rewrite !subresultant_last !(size_deriv _ R0) -predn_sub subnn. + rewrite -predn_sub subnn. + rewrite (S'size p xs) (S'size p ys). + case: ltnP => _; last by rewrite !expr0. + rewrite !expr1 !lead_coefE (S'size p xs) (S'size p ys). + apply/(@nth_const s') => //. + by rewrite (S'size p xs). +rewrite succnK leq_eqVlt => /orP[/eqP ->|ilt]. + rewrite -{1}(S'size p xs) -(S'size p ys) -(size_deriv _ R0). + rewrite -[in RHS](size_deriv _ R0). + rewrite subresultantC subresultant_last (size_deriv _ R0). + rewrite (S'size p xs). + rewrite subresultantC subresultant_last (size_deriv _ R0). + rewrite (S'size p ys) !sgzM; congr (_ * _). + case: (_.-1) => [|j]; first by rewrite !expr0. + rewrite succnK subSn; last by []. + rewrite subnn ltnNge leqnSn !expr1 !(lead_coef_deriv _ R0). + rewrite -mulr_natr -[in RHS]mulr_natr !lead_coefE !sgzM. + rewrite (S'size p ys) -(S'size p xs); congr (_ * _). + exact/(@nth_const s'). +set q := + truncate (muni (\val p)) (size (evalpmp (val (pick s')) (muni (\val p)))). +rewrite -!/(evalpmp _ _). +have qE z : z \in val s' -> (evalpmp z (muni (val p))) = evalpmp z q. + move=> zs. + by rewrite [RHS]map_poly_truncate/= -(S'size p zs) truncate_size. +have qsize z : z \in val s' -> size (evalpmp z q) = size q. + move=> zs; rewrite -(qE z zs) (S'size p zs). + apply/le_anti/andP; split; last first. + exact/(leq_trans (size_poly _ _))/geq_minl. + case: (posnP (size (evalpmp (sval (pick s')) (muni (\val p))))) => [-> //|]. + move=> s0; rewrite -(prednK s0); apply/gt_size. + rewrite coef_poly (prednK s0) leq_min leqnn/= size_poly. + apply/eqP => p0. + have/eqP {}p0 : evalpmp (sval (pick s')) (muni (fsval p)) == 0. + by rewrite -lead_coef_eq0 lead_coefE coef_map/= p0 meval0. + by move: s0; rewrite p0 size_poly0 ltnn. +rewrite (qE x xs) (qE y ys). +have iq: (i < (size q).-2)%N. + apply/(leq_trans ilt); rewrite (qE _ (proj2_sig (pick s'))). + exact/leq_predn/leq_predn/size_poly. +have sq: (2 < size q)%N by rewrite -2!ltn_predRL (leq_trans _ iq). +have q0 z : z \in val s' -> (lead_coef q).@[tnth (ngraph z)] != 0. + move=> zs; rewrite lead_coefE -coef_map. + rewrite -(qsize z zs) -lead_coefE lead_coef_eq0 -size_poly_eq0 qsize//. + by rewrite -leqn0 leqNgt (leq_trans _ sq). +rewrite !deriv_map !subresultant_map_poly/=; first last. +- rewrite lead_coef_deriv; last exact/Rn_char. + rewrite mevalMn mulrn_eq0 -leqn0 leqNgt ltn_predRL. + by rewrite (leq_trans (leqnSn _) sq)/= q0. +- exact/q0. +- rewrite lead_coef_deriv; last exact/Rn_char. + rewrite mevalMn mulrn_eq0 -leqn0 leqNgt ltn_predRL. + by rewrite (leq_trans (leqnSn _) sq)/= q0. +- exact/q0. +case: (ltnP 1 (msize (subresultant i q q^`()))) => [q1|]; last first. + by move=>/msize1_polyC ->; rewrite !mevalC. +suff qP: (subresultant i q q^`()) \in elimp P. + by move: (S'p [` qP] xs ys) => /=. +rewrite inE/= inE; apply/andP; split=> //. +rewrite 2!inE -orbA; apply/orP; left. +have qP: q \in elimp_subdef1 P. + apply/bigfcupP; exists p; first by rewrite mem_index_enum. + exact/truncations_witness. +apply/bigfcupP; exists [` qP]; first by rewrite mem_index_enum/=. +by apply/imfsetP => /=; exists (Ordinal iq). +Qed. + +Local Lemma S'constR (s' : S') (p : P) : + {in val s', forall x, + size (rootsR (evalpmp x (muni (val p)))) + = size (rootsR (evalpmp (proj1_sig (pick s')) (muni (val p))))}. +Proof. +move=> x xs; move: (proj2_sig (pick s')). +set x' := proj1_sig (pick s') => x's. +have [p0|x'0] := eqVneq (evalpmp x' (muni (val p))) 0. + rewrite p0; suff ->: evalpmp x (muni (val p)) = 0 by []. + by apply/eqP; rewrite -size_poly_eq0 (@S'size s')// size_poly_eq0; apply/eqP. +have x0: (evalpmp x (muni (val p))) != 0. + by rewrite -size_poly_eq0 (@S'size s')// size_poly_eq0. +apply/eqP; rewrite -eqz_nat -!cindexR_derivp; apply/eqP. +rewrite -!pmv_subresultant; first last. +- exact/lt_size_deriv. +- exact/lt_size_deriv. +rewrite (S'size p xs) (S'size p x's). +apply/PMV.eq_pmv; rewrite all2E [X in X == _]size_map [X in _ == X]size_map. +rewrite eqxx/= !zip_map !all_map !all_rev. +apply/allP => i; rewrite mem_iota => /=. +rewrite add0n => /leq_predn; rewrite succnK => ilt; apply/eqP. +exact/(@res'_const s'). +Qed. + +Let P' (s : S') := + [fset muni (val p) | p : P & evalpmp (val (pick s)) (muni (val p)) != 0]. + +Local Lemma size_gcd_const (s' : S') (p : P) : + {in \val s' &, + forall x y : 'rV_n, + size (gcdp (evalpmp x (muni (val p))) (evalpmp x (muni (val p)))^`()) = + size (gcdp (evalpmp y (muni (val p))) (evalpmp y (muni (val p)))^`())}. +Proof. +move=> x y xs ys. +have [px0|px0] := eqVneq (evalpmp x (muni (val p)))^`() 0. + rewrite px0; move/eqP: px0. + rewrite -size_poly_eq0 (size_deriv _ R0) (S'size p xs). + rewrite -(S'size p ys) -(size_deriv _ R0) size_poly_eq0 => /eqP ->. + by rewrite !gcdp0 (S'size p xs) (S'size p ys). +move: (px0); rewrite -size_poly_eq0 (size_deriv _ R0) (S'size p xs). +rewrite -(S'size p ys) -(size_deriv _ R0) size_poly_eq0 => py0. +rewrite -[LHS]prednK; last first. + rewrite ltnNge leqn0 size_poly_eq0 gcdp_eq0; apply/andP => -[_ p0]. + by rewrite p0 in px0. +rewrite -[RHS]prednK; last first. + rewrite ltnNge leqn0 size_poly_eq0 gcdp_eq0; apply/andP => -[_ p0]. + by rewrite p0 in py0. +apply/esym/eqP; rewrite eqSS. +move: (eqxx + (size (gcdp (evalpmp x (muni (val p))) (evalpmp x (muni (val p)))^`())).-1). +rewrite gcdp_subresultant; first last. +- apply/leq_predn/leq_gcdpr/negP => p0. + by rewrite p0 in px0. +- apply/leq_predn/leq_gcdpl/eqP => p0. + by rewrite p0 deriv0 eqxx in px0. +- by []. +- by apply/eqP => p0; rewrite p0 deriv0 eqxx in px0. +rewrite gcdp_subresultant; first last. +- rewrite (size_deriv _ R0) (S'size p ys) -(S'size p xs). + rewrite -[X in (_ <= X.-1)%N](size_deriv _ R0). + apply/leq_predn/leq_gcdpr/negP => p0. + by rewrite p0 in px0. +- rewrite (S'size p ys) -(S'size p xs). + apply/leq_predn/leq_gcdpl/eqP => p0. + by rewrite p0 deriv0 eqxx in px0. +- rewrite -size_poly_eq0 (size_deriv _ R0) (S'size p ys). + by rewrite -(S'size p xs) -(size_deriv _ R0) size_poly_eq0. +- rewrite -size_poly_eq0 (S'size p ys) -(S'size p xs) size_poly_eq0. + by apply/eqP => p0; rewrite p0 deriv0 eqxx in px0. +move=> /andP[] /forallP si sl; apply/andP; split. + apply/forallP => /= i. + rewrite -sgz_eq0 (res'_const ys xs). + by rewrite sgz_eq0; apply/si. + apply/(leq_trans (ltnW (ltn_ord i)))/leq_predn. + rewrite -(S'size p xs); apply/leq_gcdpl/eqP => px0'. + by rewrite px0' deriv0 eqxx in px0. +rewrite -sgz_eq0 (res'_const ys xs) ?sgz_eq0//. +apply/leq_predn; rewrite -(S'size p xs). +apply/leq_gcdpl/eqP => x0. +by rewrite x0 deriv0 eqxx in px0. +Qed. + +Local Lemma S'con (s' : S') : SAconnected (val s'). +Proof. by apply/SAconnected_CD_cell. Qed. + +Local Lemma size_gcdpq_const (s' : S') : {in P' s' &, + forall p q : {poly {mpoly R[n]}}, + {in \val s' &, + forall x y : 'rV_n, + size (gcdp (evalpmp x p) (evalpmp x q)) = + size (gcdp (evalpmp y p) (evalpmp y q))}}. +Proof. +move=> q r /imfsetP[/=] p _ -> {q} /imfsetP[/=] q _ -> {r} x y xs ys. +have [p0|/negP p0] := eqVneq (evalpmp x (muni (val p))) 0. + rewrite {1}p0; move/eqP: p0. + rewrite -size_poly_eq0 (S'size p xs) -(S'size p ys). + rewrite size_poly_eq0 => /eqP {1}->. + by rewrite !gcd0p (S'size q xs) (S'size q ys). +have [q0|/negP q0] := eqVneq (evalpmp x (muni (val q))) 0. + rewrite [X in gcdp _ X]q0; move/eqP: q0. + rewrite -size_poly_eq0 (S'size q xs) -(S'size q ys). + rewrite size_poly_eq0 => /eqP {}q0. + rewrite [X in _ = (size (gcdp _ X))]q0. + by rewrite !gcdp0 (S'size p xs) (S'size p ys). +rewrite -[LHS]prednK; last first. + by rewrite ltnNge leqn0 size_poly_eq0 gcdp_eq0; apply/andP => -[_]. +rewrite -[RHS]prednK; last first. + rewrite ltnNge leqn0 size_poly_eq0 gcdp_eq0; apply/andP => -[_]. + rewrite -size_poly_eq0 (S'size q ys) -(S'size q xs). + by rewrite size_poly_eq0. +apply/esym/eqP; rewrite eqSS. +move: (eqxx + (size (gcdp (evalpmp x (muni (val p))) (evalpmp x (muni (val q))))).-1). +rewrite gcdp_subresultant; first last. +- exact/leq_predn/leq_gcdpr/negP. +- exact/leq_predn/leq_gcdpl/negP/p0. +- exact/negP. +- exact/negP/p0. +rewrite gcdp_subresultant; first last. +- rewrite (S'size q ys) -(S'size q xs). + by apply/leq_predn/leq_gcdpr/negP. +- rewrite (S'size p ys) -(S'size p xs). + exact/leq_predn/leq_gcdpl/negP/p0. +- rewrite -size_poly_eq0 (S'size q ys) -(S'size q xs). + by rewrite size_poly_eq0; apply/negP. +- rewrite -size_poly_eq0 (S'size p ys) -(S'size p xs). + by rewrite size_poly_eq0; apply/negP/p0. +congr (_ && _). + apply/eq_forallb => /= i. + rewrite -sgz_eq0 -[RHS]sgz_eq0 (res_const xs ys)//. + rewrite -[_ i]succnK -(S'size p xs). + apply/leq_predn/(leq_trans (ltn_ord i))/(leq_trans (leq_pred _)). + exact/leq_gcdpl/negP/p0. + rewrite -[_ i]succnK -(S'size q xs). + apply/leq_predn/(leq_trans (ltn_ord i))/(leq_trans (leq_pred _))/leq_gcdpr. + exact/negP. +rewrite -sgz_eq0 -[in RHS]sgz_eq0 (res_const xs ys)//. + by apply/leq_predn; rewrite -(S'size p xs); apply/leq_gcdpl/negP/p0. +by apply/leq_predn; rewrite -(S'size q xs); apply/leq_gcdpr/negP. +Qed. + +Local Lemma S'const (s' : S') : + {in \val s', + forall x : 'rV_n, + size (rootsR (evalpmp x (\prod_(p : P' s') (val p)))) = + size (rootsR (evalpmp (sval (pick s')) (\prod_(p : P' s') (val p))))}. +Proof. +case: (@evalpmp_prod_const _ (P' s') (val s')). +- exact/S'con. +- move=> q /imfsetP[/=] p _ -> {q} x y xs ys. + by rewrite !(@S'size s'). +- move=> _ /imfsetP[] p _ ->. + exact/size_gcd_const. +- exact/size_gcdpq_const. +- move=> _ rc x xs; exact/(rc x _ xs (proj2_sig (pick s'))). +Qed. + +Local Lemma size_gcdpm_const (s' : S') : + {in \val s', + forall x : 'rV_n, + size (gcdp (evalpmp x (\prod_(p : P' s') \val p)) + (evalpmp x (\prod_(p : P' s') \val p))^`()) = + size (gcdp (evalpmp (val (pick s')) (\prod_(p : P' s') \val p)) + (evalpmp (val (pick s')) (\prod_(p : P' s') \val p))^`())}. +Proof. +case: (@evalpmp_prod_const _ (P' s') (val s')). +- exact/S'con. +- move=> q /imfsetP[/=] p _ -> {q} x y xs ys. + by rewrite !(@S'size s'). +- move=> _ /imfsetP[] p _ ->. + exact/size_gcd_const. +- exact/size_gcdpq_const. +- move=> cc _ x xs; exact/(cc x _ xs (proj2_sig (pick s'))). +Qed. + +Definition elimp_lift := [fset SAset_cast n.+1 s' | + s' in \big[fsetU/fset0]_(s' : S') + partition_of_graphs_above (val s') (proj1_sig (roots2_on (@S'const s')))]. + +Local Lemma elimp_lift_cast : [fset SAset_cast n s | s in elimp_lift] = S'. +Proof. +rewrite /elimp_lift 2!imfset_bigfcup. +apply/fsetP => x; apply/bigfcupP/idP => [[] /= s _| xS]. + case: (roots2_on (@S'const s)) => /= r [] rsort _. + move=> /imfsetP[] /= y /imfsetP[] /= z zs -> ->. + rewrite SAset_cast_trans; last by rewrite geq_min addn1 leqnn. + by rewrite (SAset_cast_partition_of_graphs_above rsort zs). +exists [` xS]; first by rewrite mem_index_enum. +apply/imfsetP => /=. +case: (roots2_on (@S'const [` xS])) => /= r [] rsort _. +exists (SAset_cast n.+1 + ((nth (SAset0 R _) (partition_of_graphs r) 0) :&: (x :*: SAsetT R 1))). + apply/imfsetP. + exists ((nth (SAset0 R _) (partition_of_graphs r) 0) + :&: (x :*: SAsetT R 1)) => //=. + apply/imfsetP => /=. + exists (nth (SAset0 R _) (partition_of_graphs r) 0) => //. + exact/mem_nth. +rewrite SAset_cast_trans; last by rewrite geq_min addn1 leqnn. +apply/esym/(SAset_cast_partition_of_graphs_above rsort). +apply/imfsetP => /=. +exists (nth (SAset0 R _) (partition_of_graphs r) 0) => //. +exact/mem_nth. +Qed. + +Local Lemma elimp_lift_castE (s : S') y : + y \in partition_of_graphs_above (fsval s) (sval (roots2_on (@S'const s))) -> + SAset_cast n (SAset_cast n.+1 y) = fsval s. +Proof. +rewrite SAset_cast_trans; last by rewrite geq_min addn1 leqnn. +case: (roots2_on (@S'const s)) => /= r [] + _. +exact: SAset_cast_partition_of_graphs_above. +Qed. + +Local Lemma elimp_lift_CD: isCD elimp_lift. +Proof. +split. + rewrite SAset_partition_cast; last exact/addn1. + apply/SAset_partition_of_graphs_above => // [|s]; first exact/S'part. + by case: (roots2_on (@S'const s)) => /= r []. +rewrite elimp_lift_cast/=; split=> // s. +move rE: (roots2_on (@S'const s)) => rR. +case: rR rE => /= r [] rsort rroot rE. +exists (size r), (in_tuple r); split. + move=> i. + apply/(@subspace_eq_continuous _ _ 'M[R]_(1, 1) + (fun x => \row__ (rootsR (evalpmp x (\prod_(p : P' s) val p)))`_i)). + move=> x; rewrite inE/= => xs. + apply/eqP; rewrite rowPE forall_ord1 mxE (tnth_nth 0)/=. + by rewrite -(rroot x xs) (nth_map 0). + apply/mx_continuous => j k. + apply(@subspace_eq_continuous _ _ R + (fun x => (rootsR (evalpmp x (\prod_(p : P' s) val p)))`_i)). + by move=> x; rewrite inE/= => xs; rewrite mxE. + apply/(rootsR_continuous (proj2_sig (pick s))); first last. + - exact/S'const. + - move=> x xs; exact/(@size_gcdpm_const s). + move=> x xs; rewrite ![evalpmp _ _]rmorph_prod/= !size_prod/=. + + congr (_.+1 - _)%N; apply/eq_bigr; case=> /= q /imfsetP[/=] p _ -> _. + exact/S'size. + + by case=> /= q /imfsetP[/=] p p0 -> _. + + case=> /= q /imfsetP[/=] p p0 -> _. + by rewrite -size_poly_eq0 (S'size p xs) size_poly_eq0. +split=> //. +apply/fsetP => /= x; rewrite 2!inE/=. +apply/andP/imfsetP. + move=> [] /imfsetP /= [y] /bigfcupP/= [t] _ yt ->. + rewrite (elimp_lift_castE yt) => /eqP ts. + exists y => //. + move: yt; have ->: t = s by apply/val_inj. + by rewrite rE. +move=> [] /= y yr ->; split; last by rewrite (@elimp_lift_castE s) ?rE. +apply/imfsetP; exists y => //=. +apply/bigfcupP; exists s; first by rewrite mem_index_enum. +by rewrite rE. +Qed. + +Local Lemma elimp_lift_adapted (p : P) : poly_adapted (val p) elimp_lift. +Proof. +case=> /= s /imfsetP [/=] t /bigfcupP [] {}s _ ts ->. +have tS: SAset_cast n.+1 t \in elimp_lift. + apply/imfsetP; exists t => //=. + apply/bigfcupP; exists s => //. + by rewrite mem_index_enum. +move: ts. +case: (roots2_on (@S'const s)) => /= [] r [] rsort rroot tpart. +have mevalE q x : + q.@[tnth (ngraph x)] + = (evalpmp (\row_i (x ord0 (widen_ord (leqnSn n) i))) (muni q)) + .[x ord0 ord_max]. + rewrite horner_evalpmp -{1}(muniK q) meval_mmulti (tnth_nth 0) nth_ngraph. + by apply/meval_eq => i; rewrite !tnth_mktuple mxE. +have ts x: x \in SAset_cast n.+1 t -> + \row_i x ord0 (widen_ord (leqnSn n) i) \in \val s. + move=> xt /=. + rewrite -(SAset_cast_partition_of_graphs_above rsort tpart). + apply/inSAset_castDn; exists (castmx (erefl, esym (@addn1 n)) x); split. + by rewrite -inSAset_cast. + by apply/rowP => i; rewrite !mxE castmxE; congr (x _ _); apply/val_inj. +have [p0|p0] := eqVneq (evalpmp (\val (pick s)) (muni (\val p))) 0. + move=> x y xt yt. + suff pz0 z : z \in SAset_cast n.+1 t -> (val p).@[tnth (ngraph z)] = 0. + by rewrite !pz0. + move=> zt; rewrite mevalE. + set q := (evalpmp _ _); suff ->: q = 0 by apply/horner0. + apply/eqP; rewrite -size_poly_eq0 /q (@S'size s); last exact/ts. + by apply/eqP; rewrite p0 size_poly0. +case: (set0Vmem + (SAimset (SAmpoly (val p)) (SAset_cast n.+1 t) :&: SAset_seq [:: 0])). + move=> t0. + have {}p0 x : x \in SAset_cast n.+1 t -> (val p).@[tnth (ngraph x)] != 0. + move=> xt; apply/eqP => {}p0. + suff: \row__ 0 \in SAset0 R 1 by rewrite inSAset0. + rewrite -t0 inSAsetI inSAset_seq mem_seq1 rowPE forall_ord1 !mxE eqxx andbT. + apply/SAimsetP; exists x => //. + rewrite SAmpolyE -p0; apply/rowP => i. + rewrite !mxE; apply/meval_eq => j. + by rewrite (tnth_nth 0) nth_map_ord. + move=> x y xt yt. + rewrite !sgz_def p0// p0// !mulr1n; congr (_ ^+ _). + apply/eqP; rewrite -[_ == _]negbK; apply/negP. + wlog: x y xt yt / (fsval p).@[tnth (ngraph x)] < 0 => px0. + case: (ltP (val p).@[tnth (ngraph x)] 0) => x0. + by move: (px0 x y xt yt x0); rewrite x0. + move: (px0 y x yt xt); rewrite [X in _ != _ X]ltNge x0 eq_sym => yy0 y0. + by apply/(yy0 _ y0); case: (ltP (val p).@[tnth (ngraph y)] 0) y0. + rewrite px0; case: (ltP (val p).@[tnth (ngraph y)]) => // + _. + rewrite le_eqVlt eq_sym (negPf (p0 y yt))/= => y0. + have: SAconnected (SAimset (SAmpoly (val p)) (SAset_cast n.+1 t)). + apply/SAimset_connected. + exact/(@SAconnected_CD_cell _ _ [` tS] elimp_lift_CD). + apply/(@eq_continuous (subspace [set` SAset_cast n.+1 t]) _ + (fun x : 'rV[R]_n.+1 => \row_(_ < 1) (val p).@[x ord0])). + by move=> z; rewrite SAmpolyE. + apply/mx_continuous => i j. + apply/(@eq_continuous (subspace [set` SAset_cast n.+1 t]) _ + (fun x : 'rV[R]_n.+1 => (val p).@[x ord0])). + by move=> z; rewrite mxE. + exact/continuous_subspaceT/meval_continuous. + move=> /(_ (SAset_itv `]-oo, 0[%R) (SAset_itv `]0, +oo[)) /(_ _)/wrap[]. + (* N.B. This takes forever. *) + apply/open_subspace_ballP => /= z. + rewrite in_setI mem_setE inSAset_itv in_itv/= => /andP[z0] zs. + exists (- z ord0 ord0); split; first by rewrite oppr_gt0. + apply/subsetP => a; rewrite in_setI => /andP[+] _. + rewrite -ball_normE inE/= [normr _]mx_normrE => /bigmax_ltP[_]. + move=> /(_ (ord0, ord0) isT)/=; rewrite !mxE -opprB normrN => /ltr_normlW. + by rewrite -subr_lt0 -addrA subrr addr0 mem_setE inSAset_itv in_itv/=. + move=> /(_ _)/wrap[]. + apply/open_subspace_ballP => /= z. + rewrite in_setI mem_setE inSAset_itv in_itv/= andbT => /andP[z0] zs. + exists (z ord0 ord0); split; first by []. + apply/subsetP => a; rewrite in_setI => /andP[+] _. + rewrite -ball_normE inE/= [normr _]mx_normrE => /bigmax_ltP[_]. + move=> /(_ (ord0, ord0) isT)/=; rewrite !mxE => /ltr_normlW. + rewrite -subr_gt0 opprB addrCA subrr addr0 mem_setE inSAset_itv in_itv/=. + by move=> ->. + move=> /(_ _)/wrap[]. + apply/eqP => s0; suff: \row__ (fsval p).@[tnth (ngraph x)] \in SAset0 R 1. + by rewrite inSAset0. + rewrite -s0 inSAsetI; apply/andP; split; last first. + by rewrite inSAset_itv in_itv/= mxE. + apply/SAimsetP; exists x => //. + apply/eqP; rewrite SAmpolyE rowPE forall_ord1 !mxE; apply/eqP/meval_eq. + by move=> i; rewrite (tnth_nth 0) nth_map_ord. + move=> /(_ _)/wrap[]. + apply/eqP => s0; suff: \row__ (fsval p).@[tnth (ngraph y)] \in SAset0 R 1. + by rewrite inSAset0. + rewrite -s0 inSAsetI; apply/andP; split; last first. + by rewrite inSAset_itv in_itv/= mxE y0. + apply/SAimsetP; exists y => //. + apply/eqP; rewrite SAmpolyE rowPE forall_ord1 !mxE; apply/eqP/meval_eq. + by move=> i; rewrite (tnth_nth 0) nth_map_ord. + move=> /(_ _)/wrap[]. + apply/SAset_subP => _ /SAimsetP[] z /p0 z0 ->. + rewrite inSAsetU !inSAset_itv !in_itv/= andbT; apply/lt_total. + rewrite SAmpolyE mxE; move: z0; congr (_ != 0); apply/meval_eq. + by move=> i; rewrite (tnth_nth 0) nth_map_ord. + move=> /negP; apply; rewrite -subset0; apply/SAset_subP => z. + rewrite 2!inSAsetI !inSAset_itv/= !in_itv/= andbT => /andP[]/andP[_] z0. + by move=> /(lt_trans z0); rewrite ltxx. +move=> [px]. +rewrite inSAsetI inSAset_seq mem_seq1 => /andP[] /SAimsetP[x] xt -> {px}. +rewrite SAmpolyE rowPE forall_ord1 !mxE => /eqP px0. +case: (roots2_on (@S'constR s p)) => rp [] rpsort rproot. +have f1_inj : injective (fun x : 'rV[R]_1 => x ord0 ord0). + by move=> a b ab; apply/eqP; rewrite rowPE forall_ord1; apply/eqP. +have runiq: forall (r : seq (SAfunltType R n)), sorted (SAfun_lt (n:=n)) r -> + {in \val s, forall x0 : 'rV_n, + uniq [seq (f : {SAfun R^n -> R^1}) x0 | f <- r]}. + move=> r' r'sort y ys; rewrite -(map_inj_uniq f1_inj). + apply/lt_sorted_uniq/(sortedP 0) => i. + rewrite !size_map => ilt. + move: r'sort => /(sortedP 0)/(_ i ilt)/SAfun_ltP/(_ y) rpi. + rewrite -map_comp (nth_map 0) ?(nth_map 0)//. + by apply/(ltn_trans _ ilt). +move: (@subseq_sorted_continuous_SAfun _ _ rp r (val s)). +move=> /(_ _)/wrap[]; first exact/runiq. +move=> /(_ _)/wrap[]; first exact/runiq. +move=> /(_ _)/wrap[]. + move=> i. + apply/(@subspace_eq_continuous _ _ _ (fun x : 'rV[R]_n => + \row_(_ < 1) (rootsR (evalpmp x (muni (\val p))))`_i)). + move=> y; rewrite mem_setE => ys. + apply/eqP; rewrite rowPE forall_ord1 mxE. + by rewrite -rproot// (nth_map 0). + apply/mx_continuous => j k. + apply/(@eq_continuous (subspace [set` val s]) _ + (fun x => (rootsR (evalpmp x (muni (\val p))))`_i)). + by move=> y; rewrite mxE. + apply/(rootsR_continuous (valP (pick s))). + - by move=> y ys; apply/S'size. + - move=> y ys; apply/(@size_gcd_const s) => //; last exact/valP. + by move=> y ys; apply/S'constR. +move=> /(_ _)/wrap[]. + move=> i. + apply/(@subspace_eq_continuous _ _ _ (fun x : 'rV[R]_n => + \row_(_ < 1) (rootsR (evalpmp x (\prod_(p : P' s) fsval p)))`_i)). + move=> y; rewrite mem_setE => ys. + apply/eqP; rewrite rowPE forall_ord1 mxE. + move: (rroot y ys) => /(congr1 (fun x => x`_i)). + by rewrite (nth_map 0)// => ->; apply/eqP. + apply/mx_continuous => j k. + apply/(@eq_continuous (subspace [set` val s]) _ + (fun x => (rootsR (evalpmp x (\prod_(p : P' s) fsval p)))`_i)). + by move=> y; rewrite mxE. + apply/(rootsR_continuous (valP (pick s))). + - move=> y ys. + rewrite !evalpmp_prod size_prod; last first. + move=> /=; case=> /= _ /imfsetP[/=] q q0 -> _. + by rewrite -size_poly_eq0 (S'size q ys) size_poly_eq0. + rewrite size_prod; last first. + by move=> /=; case=> /= _ /imfsetP[/=] q q0 -> _. + congr (_.+1 - _)%N; apply/eq_bigr => /=. + case=> /= _ /imfsetP[/=] q q0 -> _. + by apply/S'size. + - by move=> y ys; apply/(@size_gcdpm_const s). + by move=> y ys; apply/S'const. +move=> /(_ _)/wrap[]; first exact/SAconnected_CD_cell. +move=> /(_ _)/wrap[]. + move=> y ys; apply/subseq_uniqP; first exact/runiq. + apply/(inj_map f1_inj)/lt_sorted_eq. + - apply/(sortedP 0) => i; rewrite 2!size_map => ilt. + rewrite -map_comp (nth_map 0); last by apply/(ltn_trans _ ilt). + rewrite (nth_map 0)//=. + by move: rpsort => /(sortedP 0)/(_ i ilt)/SAfun_ltP/(_ y). + - + apply/(@subseq_lt_sorted _ _ _ + [seq (x0 : 'rV_1) ord0 ord0 | x0 <- + [seq (f : {SAfun R^n -> R^1}) y | f <- r]]). + exact/map_subseq/filter_subseq. + apply/(sortedP 0) => i; rewrite 2!size_map => ilt. + rewrite -map_comp (nth_map 0); last by apply/(ltn_trans _ ilt). + rewrite (nth_map 0)//=. + by move: rsort => /(sortedP 0)/(_ i ilt)/SAfun_ltP/(_ y). + move=> z; rewrite -map_comp; apply/mapP/mapP => -[/=]; last first. + move=> a; rewrite mem_filter => /andP[] /mapP[]/= f frp -> _ ->. + by exists f. + move=> _ /(nthP 0)[] i irp <- ->. + exists (rp`_i y) => //; rewrite mem_filter; apply/andP; split. + by apply/mapP; exists (rp`_i) => //; apply/mem_nth. + rewrite -(mem_map f1_inj) -map_comp/= rroot// in_rootsR evalpmp_prod. + apply/andP; split. + apply/prodf_neq0; case=> /= _ /imfsetP[/=] q q0 -> _. + by rewrite -size_poly_eq0 (@S'size s)// size_poly_eq0. + have: rp`_i y ord0 ord0 \in + [seq (xi : {SAfun R^n -> R^1}) y ord0 ord0 | xi <- rp]. + by apply/mapP; exists (rp`_i) => //; apply/mem_nth. + rewrite rproot// in_rootsR => /andP[_] i0. + rewrite root_bigmul; apply/hasP. + have pP: muni (val p) \in P' s by apply/imfsetP; exists p. + exists [` pP]; first exact/mem_index_enum. + exact: i0. +move=> [rpr] [/mem_subseq rprr] rpE. +have: \row__ x ord0 ord_max \in + [seq (f : {SAfun R^n -> R^1}) (\row_i (x ord0 (widen_ord (leqnSn n) i))) | + f <- rp]. + rewrite -(mem_map f1_inj) -map_comp/= rproot; last exact/ts. + rewrite mxE in_rootsR; apply/andP; split. + by rewrite -size_poly_eq0 (@S'size s) ?size_poly_eq0//; apply/ts. + rewrite /root -mevalE; apply/eqP; move: px0; congr (_ = 0). + by apply/meval_eq => i; rewrite (tnth_nth 0) nth_map_ord. +move=> /(nthP 0)[] i; rewrite size_map => ilt. +have ir: ((rpr`_i)%R < size r)%N. + suff: rpr`_i \in iota 0 (size r) by rewrite mem_iota. + apply/rprr/mem_nth. + by move: (rpE _ (ts _ xt)) => /(congr1 size); rewrite !size_map => <-. +move: (rpE _ (ts _ xt)) => /(congr1 (fun s => s`_i)). +rewrite [RHS](nth_map 0)//; last first. + by move: (rpE _ (ts _ xt)) => /(congr1 size); rewrite !size_map => <-. +move=> -> /esym/eqP; rewrite rowPE forall_ord1 !mxE => /eqP xE. +move: tpart => /imfsetP[/=] u /(nthP (SAset0 _ _))[j]. +rewrite size_map size_iota => jlt <-. +rewrite (nth_map 0) ?size_iota// nth_iota//. +have [_ tE|j0] := eqVneq j 0. + move: xt; rewrite tE (inSAset_cast _ _ (esym (addn1 n))) inSAsetI. + rewrite inSAset_bigcap => /andP[] /allP-/(_ (r`_(nth 0 rpr i)))/=. + mp; first exact/mem_nth. + rewrite inSAhypograph !mxE castmxE => xlt. + suff: x ord0 ord_max < x ord0 ord_max by rewrite ltxx. + move: xlt; congr (x _ _ < _). + - exact/val_inj. + - exact/val_inj/addn0. + rewrite xE; congr (r`_(rpr`_i)%R _ _ _). + by apply/rowP => k; rewrite !mxE castmxE; congr (x _ _); apply/val_inj. +have [_ tE|jr] := eqVneq j (size r).*2. + move: xt; rewrite tE (inSAset_cast _ _ (esym (addn1 n))) inSAsetI. + rewrite inSAset_bigcap => /andP[] /allP-/(_ (r`_(nth 0 rpr i)))/=. + mp; first exact/mem_nth. + rewrite inSAepigraph !mxE castmxE => xlt. + suff: x ord0 ord_max < x ord0 ord_max by rewrite ltxx. + move: xlt; congr (_ < x _ _); first last. + - exact/val_inj/addn0. + - exact/val_inj. + rewrite xE; congr (r`_(rpr`_i)%R _ _ _). + by apply/rowP => k; rewrite !mxE castmxE; congr (x _ _); apply/val_inj. +have xlE a: lsubmx (castmx (erefl 1%N, esym (addn1 n)) a) + = \row_i a ord0 (widen_ord (leqnSn n) i). + by apply/rowP => k; rewrite !mxE castmxE; congr (a _ _); apply/val_inj. +have xrE (a : 'rV[R]_n.+1): + a (cast_ord (esym ((erefl 1%N, esym (addn1 n)).1)%PAIR) ord0) + (cast_ord (esym ((erefl 1%N, esym (addn1 n)).2)%PAIR) (rshift n ord0)) + = a ord0 ord_max. + by congr (a _ _); apply/val_inj => //; apply/addn0. +move: jlt; rewrite ltnS leq_eqVlt (negPf jr)/= => jlt. +case: ifP => jodd tE; last first. + move: xt; rewrite tE (inSAset_cast _ _ (esym (addn1 n))) !inSAsetI. + rewrite inSAepigraph inSAhypograph !mxE castmxE xlE xrE. + rewrite xE => /andP[]/andP[] rji rij _. + have {}rsort: {in gtn (size r) &, + {homo nth 0 r : i j / (i <= j)%N >-> SAfun_le i j}}. + move=> b c br cr bc. + have: sorted (SAfun_le (n:=n)) r. + move: rsort; apply/sub_sorted => f g /SAfun_ltP fg. + by apply/SAfun_leP => y; apply/ltW/fg. + rewrite sorted_pairwise; last exact/SAfun_le_trans. + move=> -/(pairwiseP 0)/(_ b c br cr). + move: bc; rewrite leq_eqVlt => /orP[/eqP -> _|/[swap]/[apply] //]. + exact/SAfun_le_refl. + case: (ltnP (rpr`_i)%R j./2) => [/leq_predn|ji]. + rewrite succnK => ij. + move: (rsort (rpr`_i)%R j./2.-1); rewrite !inE prednK; last first. + by case: j j0 jodd {jlt jr tE rji rij ij} => [//|]; case. + rewrite leq_half_double. + move=> /(_ ir (ltnW (leq_trans jlt (leqnSn _))) ij) /SAfun_leP. + move=> /(_ (\row_i x ord0 (widen_ord (leqnSn n) i)))/(lt_le_trans rji). + by rewrite ltxx. + move: (rsort j./2 (rpr`_i)%R); rewrite !inE ltn_half_double. + move=> /(_ jlt ir ji) /SAfun_leP/(_ (\row_i x ord0 (widen_ord (leqnSn n) i))). + move=> /(lt_le_trans rij). + by rewrite ltxx. +move: rsort; rewrite sorted_pairwise; last exact/SAfun_lt_trans. +move=> /(pairwiseP 0) rsort. +case: (ltnP j./2 (rpr`_i)%R) => [ji|]. + move: (rsort j./2 (rpr`_i)%R); rewrite !inE ltn_half_double. + move=> /(_ jlt ir ji) /SAfun_ltP/(_ (\row_i x ord0 (widen_ord (leqnSn n) i))). + move: xt; rewrite tE (inSAset_cast _ _ (esym (addn1 n))) inSAsetI. + move=> /andP[+] _; rewrite -[castmx _ _]hsubmxK xlE -inSAfun => /eqP ->. + by rewrite mxE castmxE xrE -xE ltxx. +rewrite leq_eqVlt => /orP[/eqP jE|ij]; last first. + move: (rsort (rpr`_i)%R j./2); rewrite !inE ltn_half_double. + move=> /(_ ir jlt ij) /SAfun_ltP/(_ (\row_i x ord0 (widen_ord (leqnSn n) i))). + move: xt; rewrite tE (inSAset_cast _ _ (esym (addn1 n))) inSAsetI. + move=> /andP[+] _; rewrite -[castmx _ _]hsubmxK xlE -inSAfun => /eqP ->. + by rewrite mxE castmxE xrE -xE ltxx. +move: tE; rewrite -jE => {j j0 jr jlt jodd rsort jE} ->. +move=> y z yr zr. +suff r0 a: a \in SAset_cast n.+1 (r`_(rpr`_i)%R :&: fsval s :*: SAsetT R 1) -> + (fsval p).@[tnth (ngraph a)] = 0. + by rewrite !r0//. +move=> {y z yr zr}; rewrite (inSAset_cast _ _ (esym (addn1 n))) inSAsetI. +rewrite -[castmx _ _]hsubmxK -inSAfun mevalE xlE inSAsetX row_mxKl. +move=> /andP[] /eqP aE /andP[] las _. +have: rsubmx (castmx (erefl 1%N, esym (addn1 n)) a) \in + [seq r`_i (\row_i a ord0 (widen_ord (leqnSn n) i)) | i <- rpr]. + rewrite -aE; apply/map_f/mem_nth. + by move: (rpE _ (ts _ xt)) => /(congr1 size); rewrite !size_map => <-. +rewrite -rpE// => /(nthP 0)[] j; rewrite size_map => jlt. +rewrite (nth_map 0)// => /(congr1 (fun x : 'rV_1 => x ord0 ord0)). +rewrite !mxE castmxE xrE => {}aE. +have: a ord0 ord_max \in + rootsR (evalpmp (\row_i0 a ord0 (widen_ord (leqnSn n) i0)) + (muni (fsval p))). + by rewrite -rproot// -aE; apply/map_f/mem_nth. +by rewrite in_rootsR => /andP[_] /eqP. +Qed. + +End Cylindrical_decomposition_lift. + +Theorem cylindrical_decomposition n (P : {fset {mpoly R[n]}}) : + { S | isCD S /\ forall p : P, poly_adapted (val p) S}. +Proof. +elim: n P => [|n IHn] P. + exists [fset SAsetT R 0]; split=> [|[] p /= _]; last first. + case=> _ /= /fset1P -> x y _ _. + suff ->: x = y by []. + by apply/matrixP => i; case. + split=> [|//]. + apply/andP; split; last by rewrite big_fset1/= eqxx. + apply/andP; split. + apply/negP; move=> /fset1P/eqP/SAsetP /(_ (\row_i 0)%R). + by rewrite inSAset0 inSAsetT. + do 2 (apply/forallP; case => i /= /fset1P -> {i}). + by rewrite eqxx. +move: IHn => /(_ (elimp P)) [S'][S'CD] S'p. +exists (elimp_lift S'CD S'p); split. + exact/elimp_lift_CD. +exact/elimp_lift_adapted. +Qed. + +Definition lift_sample_cylindrical_decomposition n (P : {fset {mpoly R[n.+1]}}) + (s : 'rV[R]_n) := + [fset castmx (erefl, (@addn1 n)) (row_mx s (\row__ x)) | x in + let r := rootsR + (\prod_(p : P | evalpmp s (muni (val p)) != 0) + evalpmp s (muni (val p))) in + (head 0 r - 1) :: (last 0 r + 1) :: r + ++ [seq (r`_i.+1 + r`_i) / 2 | i <- iota 0 (size r).-1] + ]. + +Fixpoint sample_cylindrical_decomposition n : + {fset {mpoly R[n]}} -> {fset 'rV[R]_n} := + match n with + | 0 => fun=> [fset \row__ 0] + | S n => fun P => + let S := sample_cylindrical_decomposition (elimp P) in + \big[fsetU/fset0]_(s : S) lift_sample_cylindrical_decomposition P (val s) + end. + +Lemma sample_cylindrical_decompositionP n (P : {fset {mpoly R[n]}}) : + exists S, isCD S /\ (forall p : P, poly_adapted (val p) S) /\ + forall s : S, exists x : sample_cylindrical_decomposition P, + (val x) \in (val s). +Proof. +elim: n P => [|n IHn] P. + exists [fset SAsetT R 0]; split. + split=> [|//]. + apply/andP; split; last by rewrite big_fset1/= eqxx. + apply/andP; split. + apply/negP; move=> /fset1P/eqP/SAsetP /(_ (\row_i 0)%R). + by rewrite inSAset0 inSAsetT. + do 2 (apply/forallP; case => i /= /fset1P -> {i}). + by rewrite eqxx. + split=> [[] p /= _|[]/= s]. + case=> _ /= /fset1P -> x y _ _. + suff ->: x = y by []. + by apply/matrixP => i; case. + rewrite in_fset1 => /eqP ->. + have inP: \row_(_ < 0) (0 : R) \in [fset \row_(_ < 0) 0] by rewrite in_fset1. + by exists [` inP]; rewrite inSAsetT. +move: IHn => /(_ (elimp P)) [S'][S'CD][S'p] S'x. +exists (elimp_lift S'CD S'p); split; first exact/elimp_lift_CD. +split; first exact/elimp_lift_adapted. +move=> [/=] s'; rewrite /elimp_lift/=. +move=> /imfsetP[/=] t' /bigfcupP[/=] s _ /imfsetP[/=] t. +have SAfun_ltW: subrel (@SAfun_lt R n) (SAfun_le (n:=n)). + by move=> f g /SAfun_ltP fg; apply/SAfun_leP => y; apply/ltW. +move: (roots2_on _) => [/=] xi [] /[dup] + /(sub_sorted SAfun_ltW). +move=> /(@lt_sorted_ltn_nth _ (@SAfunltType R n)) xilt. +move=> /(@le_sorted_leq_nth _ (@SAfunleType R n)) xile xi_root. +move=> /(nthP (SAset0 R _))[] i. +rewrite [X in (i < X)%N]size_tuple => ilt <- -> ->. +case: (S'x s) => x xs. +suff: exists x : lift_sample_cylindrical_decomposition P (val x), + val x \in SAset_cast n.+1 + (nth (SAset0 R (n + 1)) (partition_of_graphs xi) i + :&: fsval s :*: SAsetT R 1). + move=> [y] yP. + suff yU: (val y) \in \big[fsetU/fset0]_( + s0 : sample_cylindrical_decomposition (elimp P)) + lift_sample_cylindrical_decomposition P (fsval s0). + by exists [` yU]. + apply/bigfcupP; exists x; first by rewrite mem_index_enum. + exact/fsvalP. +rewrite /lift_sample_cylindrical_decomposition. +set r := rootsR _. +have ->: r = [seq (xi : {SAfun _ -> _}) (val x) ord0 ord0 | xi <- xi]. + rewrite xi_root// /r evalpmp_prod. + apply/le_sorted_eq. + - exact/(sub_sorted _ (sorted_roots _ _ _))/ltW. + - exact/(sub_sorted _ (sorted_roots _ _ _))/ltW. + apply/uniq_perm. + - exact/uniq_roots. + - exact/uniq_roots. + have p0 (p : P) : evalpmp (\val x) (muni (\val p)) == 0 + = (evalpmp (val (pick S'CD s)) (muni (val p)) == 0). + suff p0 a b : a \in (val s) -> b \in (val s) -> + evalpmp a (muni (\val p)) == 0 -> (evalpmp b (muni (val p)) == 0). + by apply/idP/idP; apply/p0 => //; apply/(proj2_sig (pick S'CD s)). + move=> aP bP /eqP p0. + set c := evalpmp _ _. + apply/negP => /negP c0. + have cP: (muni (val p))`_(size c).-1 \in elimp P. + rewrite (mem_imfset _ _ (@inj_id _)) inE/=; apply/andP; split; last first. + rewrite ltnNge; apply/negP => /msize1_polyC pE. + move: p0 => /(congr1 (fun p : {poly R} => p`_(size c).-1)). + rewrite coef0 coef_map/= [X in X.@[_]]pE mevalC => p0. + move: c0 => /negP; apply. + rewrite -lead_coef_eq0 lead_coefE coef_map/= [X in X.@[_]]pE mevalC p0. + exact/eqxx. + rewrite in_fsetU; apply/orP; right. + apply/imfsetP => /=. + set d := truncate (muni (val p)) (size c). + have dP: d \in elimp_subdef1 P. + apply/bigfcupP; exists p; first by rewrite mem_index_enum. + apply/(truncations_witness (x:=a)). + by rewrite p0 size_poly0. + exists [` dP] => //. + rewrite lead_coefE/= coef_truncate. + suff ->: size d = size c. + rewrite prednK; first by rewrite leqnn mulr1n. + by rewrite ltnNge leqn0 size_poly_eq0. + apply/anti_leq/andP; split. + exact/(leq_trans (size_poly _ _))/geq_minl. + rewrite -[X in (X <= _)%N]prednK; last first. + by rewrite ltnNge leqn0 size_poly_eq0. + apply/gt_size; rewrite coef_truncate prednK; last first. + by rewrite ltnNge leqn0 size_poly_eq0. + rewrite leqnn mulr1n; apply/eqP => {}p0. + move: c0 => /negP; apply; rewrite -lead_coef_eq0 lead_coefE coef_map/=. + by rewrite p0 meval0 eqxx. + move: (S'p [` cP] s _ _ aP bP) => /=. + move: p0 => /(congr1 (fun p : {poly R} => p`_(size c).-1)). + rewrite coef_map/= => -> /esym/eqP; rewrite coef0 sgz0 sgz_eq0 => /eqP c0'. + move: c0 => /negP; apply; rewrite -lead_coef_eq0 lead_coefE coef_map/=. + by rewrite c0' eqxx. + move=> y; rewrite !in_rootsR; congr andb. + transitivity true. + exact/prodf_neq0. + apply/esym/prodf_neq0 => -[/=] _ /imfsetP[q] /= + -> _. + by rewrite inE p0. + rewrite /root !horner_prod; apply/idP/idP => /prodf_eq0[]. + move=> p px0 py0; apply/prodf_eq0. + simple refine (ex_intro2 _ _ _ _ _) => //=. + exists (muni (val p)); apply/imfsetP. + by exists p => //=; rewrite inE -p0. + by []. + move=> [/=] _ /imfsetP[/=] p + ->; rewrite inE => px0 _ py0. + by apply/prodf_eq0; exists p => //; rewrite p0. +set X := [fset _ | _ in _]. +rewrite (nth_map 0%N); last by rewrite size_iota. +rewrite nth_iota; last by []. +case: (posnP i) => i0. + set y := head 0 [seq (xi : {SAfun _ -> _}) (\val x) ord0 ord0 | xi <- xi] - 1. + have yP: (castmx (erefl, addn1 n) (row_mx (val x) (\row__ y))) \in X. + by apply/imfsetP; exists y => //=; apply/mem_head. + exists [` yP] => /=; rewrite -inSAset_cast SAset_cast_trans; last first. + by rewrite minnn addn1. + rewrite SAset_cast_id inSAsetI inSAsetX row_mxKl xs inSAsetT !andbT. + rewrite inSAset_bigcap; apply/allP => _ /(nthP 0)[j] jxi <- /=. + rewrite inSAhypograph !mxE (unsplitK (inr _)) !mxE row_mxKl. + move: (xile 0 0 j); rewrite !inE. + move=> /(_ (leq_ltn_trans (leq0n _) jxi) jxi (leq0n _)). + move=> /SAfun_leP/(_ (val x)) xi0j. + apply/(lt_le_trans _ xi0j); rewrite /y -nth0 (nth_map 0); last first. + exact/(leq_ltn_trans (leq0n _) jxi). + by rewrite -subr_lt0 addrAC subrr add0r oppr_lt0. +case/boolP: (i == _) => [/eqP|] ixi. + set y := last 0 [seq (xi : {SAfun _ -> _}) (\val x) ord0 ord0 | xi <- xi] + 1. + have yP: (castmx (erefl, addn1 n) (row_mx (val x) (\row__ y))) \in X. + by apply/imfsetP; exists y => //=; rewrite in_cons mem_head orbT. + exists [` yP] => /=; rewrite -inSAset_cast SAset_cast_trans; last first. + by rewrite minnn addn1. + rewrite SAset_cast_id inSAsetI inSAsetX row_mxKl xs inSAsetT !andbT. + rewrite inSAset_bigcap; apply/allP => _ /(nthP 0)[j] jxi <- /=. + rewrite inSAepigraph !mxE (unsplitK (inr _)) !mxE row_mxKl. + move: (xile 0 j (size xi).-1); rewrite !inE prednK; last first. + exact/(leq_ltn_trans (leq0n _) jxi). + move=> /(_ jxi (leqnn _)); rewrite -ltnS prednK; last first. + exact/(leq_ltn_trans (leq0n _) jxi). + move=> /(_ jxi) /SAfun_leP/(_ (val x)) xijl. + apply/(le_lt_trans xijl); rewrite /y -nth_last size_map. + rewrite (nth_map 0); last first. + by rewrite prednK//; apply/(leq_ltn_trans (leq0n _) jxi). + by rewrite -subr_gt0 addrAC subrr add0r. +rewrite ltnS leq_eqVlt (negPf ixi)/= -ltn_half_double in ilt. +case/boolP: (odd i) => iodd. + set y := xi`_i./2 (\val x) ord0 ord0. + have yP: (castmx (erefl, addn1 n) (row_mx (val x) (\row__ y))) \in X. + apply/imfsetP; exists y => //=; rewrite 2!in_cons mem_cat orbA. + apply/orP; right; apply/orP; left. + apply/mapP; exists xi`_i./2 => //. + apply/(nthP 0); exists i./2 => //. + exists [` yP] => /=; rewrite -inSAset_cast SAset_cast_trans; last first. + by rewrite minnn addn1. + rewrite SAset_cast_id inSAsetI inSAsetX row_mxKl xs inSAsetT !andbT. + by rewrite -inSAfun rowPE forall_ord1 !mxE eqxx. +move: i0 iodd; rewrite leq_eqVlt => /orP[/eqP <- //|]. +rewrite -half_gt0 => i0 _. +set y := (xi`_i./2 (\val x) ord0 ord0 + xi`_i./2.-1 (val x) ord0 ord0) / 2. +have yP: (castmx (erefl, addn1 n) (row_mx (val x) (\row__ y))) \in X. + apply/imfsetP; exists y => //=; rewrite 2!in_cons mem_cat !orbA. + apply/orP; right. + apply/mapP; exists i./2.-1. + by rewrite mem_iota/= ltn_predRL prednK// size_map. + rewrite prednK// (nth_map 0)// (nth_map 0)//. + by apply/(leq_trans _ ilt); rewrite ltnS leq_pred. +exists [` yP] => /=; rewrite -inSAset_cast SAset_cast_trans; last first. + by rewrite minnn addn1. +rewrite SAset_cast_id inSAsetI inSAsetX row_mxKl xs inSAsetT !andbT. +rewrite inSAsetI inSAepigraph inSAhypograph !mxE (unsplitK (inr _)) !mxE. +rewrite row_mxKl. +move: (xilt 0 i./2.-1 i./2); rewrite !inE => /(_ _)/wrap[]. + by apply/(leq_trans _ ilt); rewrite ltnS leq_pred. +rewrite prednK// leqnn => /(_ ilt) /SAfun_ltP/(_ (val x)) {}xilt. +apply/andP; split. + rewrite ltr_pdivlMr// mulr_natr mulr2n -subr_gt0 opprD addrACA subrr addr0. + by rewrite subr_gt0. +rewrite ltr_pdivrMr// mulr_natr mulr2n -subr_gt0 opprD addrACA subrr add0r. +by rewrite subr_gt0. +Qed. + +End CylindricalDecomposition. diff --git a/formula.v b/formula.v new file mode 100644 index 0000000..50a4466 --- /dev/null +++ b/formula.v @@ -0,0 +1,1616 @@ +Require Import ZArith Init. + +From HB Require Import structures. +Require Import mathcomp.ssreflect.ssreflect. +From mathcomp Require Import ssrfun ssrbool eqtype ssrnat seq choice fintype. +From mathcomp Require Import div tuple finfun generic_quotient bigop finset. +From mathcomp Require Import perm ssralg poly polydiv ssrnum mxpoly binomial. +From mathcomp Require Import finalg zmodp mxpoly mxtens qe_rcf ordered_qelim. +From mathcomp Require Import realalg matrix finmap order finset mpoly. + +From SemiAlgebraic Require Import auxresults. + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Import GRing.Theory Num.Theory Num.Def. +Import ord. +Import Order.Theory Order.Syntax. + +Local Open Scope nat_scope. +Local Open Scope ring_scope. +Local Open Scope fset_scope. +Local Open Scope fmap_scope. +Local Open Scope quotient_scope. +Local Open Scope type_scope. + +Reserved Notation "'{formula_' n F }" + (n at level 0, format "'{formula_' n F }"). + +Fact mnfset_key : unit. Proof. exact tt. Qed. +Notation mnfset i j := (seq_fset mnfset_key (iota i j)). +Notation "f <==> g" := ((f ==> g) /\ (g ==> f))%oT (at level 0) : oterm_scope. + +Section SeqFset. + +Lemma nfsetE (i j : nat) : (i \in mnfset O j) = (i < j)%N. +Proof. +move: i; elim: j => [|j ih] i; first by rewrite ltn0 seq_fsetE. +case: i => [|i]; first by rewrite ltnS seq_fsetE inE leq0n. +by rewrite seq_fsetE inE mem_iota. +Qed. + +Lemma mnfsetE (k i j : nat) : (k \in mnfset i j) = (i <= k < i + j)%N. +Proof. by rewrite seq_fsetE mem_iota. Qed. + +Lemma card_mnfset (i j : nat) : #|` (mnfset i j)| = j. +Proof. by rewrite size_seq_fset undup_id ?iota_uniq // size_iota. Qed. + +Lemma mnfset_triangle (i j k : nat) : + mnfset i (j + k) = mnfset i j `|` mnfset (i + j) k. +Proof. +by apply/eqP/fset_eqP => x; rewrite in_fsetU !seq_fsetE iotaD mem_cat. +Qed. + +Lemma mnfset_nSn (i j : nat) : mnfset i j.+1 = mnfset i j `|` [fset (i + j)%N]. +Proof. +apply/eqP/fset_eqP => x; rewrite in_fsetU !seq_fsetE -addn1 iotaD mem_cat. +by rewrite in_fset1 mem_seq1. +Qed. + +Lemma mnfsetU (i j k l : nat) : + let a := minn i k in + (i <= k + l + -> k <= i + j + -> mnfset i j `|` mnfset k l = mnfset a ((maxn (i + j) (k + l)) - a))%N. +Proof. +move=> a h1 h2. +apply/eqP/fset_eqP => x. +rewrite in_fsetU !seq_fsetE !mem_iota subnKC; last first. + by rewrite leq_max (leq_trans (geq_minr _ _)). +rewrite geq_min leq_max orb_andl. +have [lt_xi|leq_ix] := ltnP x i => //=. + by rewrite (leq_trans lt_xi) //; case (_ <= _)%N. +have [small_x|big_x] := ltnP x (i+j) => //=. +by rewrite (leq_trans h2). +Qed. + +Lemma mnfset_bigop (a b : nat) : + \bigcup_(i in 'I_b) ([fset (a + (nat_of_ord i))%N]) = mnfset a b. +Proof. +apply/eqP/fset_eqP => i; rewrite seq_fsetE /= mem_iota; apply/bigfcupP/idP. + move=> [j hj]; rewrite in_fset1 => /eqP ->. + by rewrite leq_addr /= ltn_add2l. +rewrite addnC; move/andP => [leq_ai]. +rewrite -{1}(@subnK a i) // ltn_add2r => h; exists (Ordinal h). + by rewrite mem_index_enum. +by rewrite in_fset1 addnC subnK. +Qed. + +Lemma eq_mnfsetr (a c b d : nat) : mnfset a b = mnfset c d -> b = d. +Proof. +move=> eq_ab_cd; apply: (@eq_iotar a c) => i. +by have /fsetP /(_ i) := eq_ab_cd; rewrite !seq_fsetE. +Qed. + +Lemma eq_mnfsetl (b d a c: nat) : b != O -> mnfset a b = mnfset c d -> a = c. +Proof. +move=> b_neq0 eq_ab_cd; apply: (@eq_iotal b d) => // i. +by have /fsetP /(_ i) := eq_ab_cd; rewrite !seq_fsetE. +Qed. + +Lemma mnfset_sub (a b c d : nat) : + b != O -> (mnfset a b `<=` mnfset c d) = ((c <= a) && (a + b <= c + d))%N. +Proof. +case: b => // b _; case: d. + rewrite addn0; apply/idP/idP. + by move/fsubsetP/(_ a); rewrite !seq_fsetE in_fset0 inE eqxx; move/implyP. + move=> /andP [leq_ca leq__c]. + by move: (leq_trans leq__c leq_ca); rewrite leqNgt addnS ltnS /= leq_addr. +move=> d; apply/fsubsetP/idP; last first. + move/andP => [leq_ca leq_bd] x; rewrite !mnfsetE; move/andP => [leq_ax lt_xb]. + rewrite (leq_trans leq_ca) // (leq_trans lt_xb)//. +move=> h. +apply/andP; split; [move/(_ a) : h | move/(_ (a + b)%N) : h]; rewrite !mnfsetE. + rewrite leqnn addnS ltnS leq_addr; move/implyP. + by rewrite implyTb => /andP []. +rewrite /= addnS ltnS leq_addr leqnn. +by move/implyP; rewrite andbT => /andP []. +Qed. + +Lemma m0fset (m : nat) : mnfset m 0 = fset0. +Proof. by apply/fsetP=> i; rewrite seq_fsetE in_fset0. Qed. + +Lemma mnfset0_sub (a b : nat) : + (mnfset 0 a `<=` mnfset 0 b) = (a <= b)%N. +Proof. +case: a => [|a]; first by rewrite m0fset fsub0set. +by rewrite mnfset_sub. +Qed. + +Lemma mnfset_eq (a b c d : nat) : + b != O -> (mnfset a b == mnfset c d) = ((a == c) && (b == d)). +Proof. +move: b d => [|b] [|d] // _. + by rewrite andbF; apply/eqP=>/fsetP/(_ a); rewrite !seq_fsetE !inE eqxx. +rewrite eqEfsubset !mnfset_sub // andbACA -!eqn_leq eq_sym. +by have [->|//] := altP (a =P c); rewrite eqn_add2l. +Qed. + +Local Lemma set_nth_size (T : Type) (d : T) (n : nat) + (x : n.-tuple T) (i : 'I_n) (y : T) : + size (set_nth d x i y) == n. +Proof. by rewrite size_set_nth size_tuple; apply/eqP/maxn_idPr. Qed. + +Canonical set_nth_tuple (T : Type) (d : T) (n : nat) + (x : n.-tuple T) (i : 'I_n) (y : T) := + Tuple (set_nth_size d x i y). + +End SeqFset. + +Section TermPoly. +Variable (R S : unitRingType). + +Import GRing. + +Definition term_poly (P : {poly R}) (t : term R) : term R := + \big[Add/Const 0]_(i < size P) Mul (Const P`_i) (Exp t i). + +Lemma eval_big (op : term R -> term R -> term R) (x : term R) (I : Type) + (r : seq I) (P : pred I) (F : I -> term R) (e : seq R) (eop : R -> R -> R) : + (forall t u, eval e (op t u) = eop (eval e t) (eval e u)) + -> eval e (\big[op/x]_(i <- r | P i) F i) + = \big[eop/eval e x]_(i <- r | P i) eval e (F i). +Proof. +move=> opE. +elim: r => [|i r IHr]; first by rewrite !big_nil. +rewrite !big_cons; case: (P i) => //. +by rewrite opE IHr. +Qed. + +Lemma eval_term_poly (e : seq R) (P : {poly R}) (t : term R) : + eval e (term_poly P t) = (P.[eval e t])%R. +Proof. by rewrite -{2}[P]coefK horner_poly (eval_big _ _ _ _ (eop:=+%R)). Qed. + +Definition term_mpoly n (P : {mpoly R[n]}) (t : 'I_n -> term R) : term R := + \big[Add/Const 0]_(m <- msupp P) Mul (Const P@_m) + (\big[Mul/Const 1]_i Exp (t i) (m i)). + +Definition eval_term_mpoly n (P : {mpoly R[n]}) + (t : 'I_n -> term R) (e : seq R) : + eval e (term_mpoly P t) = (P.@[fun i => eval e (t i)])%R. +Proof. +rewrite mevalE (eval_big _ _ _ _ (eop:=+%R))//. +apply/eq_bigr => i _ /=. +by rewrite (eval_big _ _ _ _ (eop:=*%R)). +Qed. + +Fixpoint map_term (f : R -> S) (t : term R) : term S := + match t with + | Var n => Var S n + | Const x => Const (f x) + | NatConst n => NatConst S n + | Add t u => Add (map_term f t) (map_term f u) + | Opp t => Opp (map_term f t) + | NatMul t n => NatMul (map_term f t) n + | Mul t u => Mul (map_term f t) (map_term f u) + | Inv t => Inv (map_term f t) + | Exp t n => Exp (map_term f t) n + end. + +(* N.B. This is a symptom that the terms and formulas over rings are ill-defined + because e.g. inversion should not be an admissible term. + For instance, we can not turn a term over Z into a term over Q. *) +Lemma eval_map_term (f : {rmorphism R -> S}) (t : term R) (e : seq R) : + (forall x, (f x)^-1 = f x^-1) + -> eval [seq f x | x <- e] (map_term f t) = f (eval e t). +Proof. +move=> finv. +elim: t => /= [n|x|n|t -> u ->|t ->|t -> n|t -> u ->|t ->|t -> n]//. +- case: (ltnP n (size e)) => ne; first by rewrite (nth_map 0). + by rewrite nth_default ?size_map// nth_default// rmorph0. +- by rewrite rmorph_nat. +- by rewrite rmorphD. +- by rewrite rmorphN. +- by rewrite rmorphMn. +- by rewrite rmorphM. +- by rewrite rmorphXn. +Qed. + +End TermPoly. + +Fixpoint mpoly_rterm (R : unitRingType) (n : nat) (t : term R) : {mpoly R[n]} := + match t with + | Var i => + match ltnP i n with + | LtnNotGeq ilt => 'X_(Ordinal ilt) + | _ => 0 + end + | Const c => mpolyC n c + | NatConst i => mpolyC n i%:R + | Add t u => (mpoly_rterm n t) + (mpoly_rterm n u) + | Opp t => - (mpoly_rterm n t) + | NatMul t i => (mpoly_rterm n t) *+ i + | Mul t u => (mpoly_rterm n t) * (mpoly_rterm n u) + | Exp t i => (mpoly_rterm n t) ^+ i + end. + +Lemma meval_mpoly_rterm (R : realDomainType) (n : nat) + (x : 'I_n -> R) (t : term R) : + (mpoly_rterm n t).@[x] = eval [seq x i | i <- enum 'I_n] t. +Proof. +elim: t => /=. +- move=> i; case: (ltnP i n) => [ilt|ige]. + rewrite mevalXU (nth_map (Ordinal ilt)) ?size_enum_ord//. + by rewrite -[X in nth _ _ X]/(nat_of_ord (Ordinal ilt)) nth_ord_enum. + by rewrite meval0 nth_default// size_map size_enum_ord. +- exact/mevalC. +- move=> i; exact/mevalC. +- by move=> t IHt u IHu; rewrite mevalD IHt IHu. +- by move=> t IHt; rewrite mevalN IHt. +- by move=> t IHt i; rewrite mevalMn IHt. +- by move=> t IHt u IHu; rewrite mevalM IHt IHu. +- by move=> t IHt i; rewrite mevalXn IHt. +Qed. + +Lemma eval_rterm (R : unitRingType) (e : seq R) (t : GRing.term R) : + GRing.rterm t -> GRing.eval e (to_rterm t) = GRing.eval e t. +Proof. +elim: t => //=. +- by move=> t IHt u IHu /andP[] {}/IHt -> {}/IHu ->. +- by move=> t /[apply] ->. +- by move=> t /[swap] n /[apply] ->. +- by move=> t IHt u IHu /andP[] {}/IHt -> {}/IHu ->. +- by move=> t /[swap] n /[apply] ->. +Qed. + +Section EquivFormula. + +Variable T : Type. + +Definition eq_vec (v1 v2 : seq nat) : formula T := + if size v1 == size v2 then + (\big[And/True]_(i < size v1) ('X_(nth 0%N v1 i) == 'X_(nth 0%N v2 i)))%oT + else False%oT. + +Fixpoint term_fv (t : GRing.term T) : {fset nat} := + match t with + | 'X_i => [fset i] + | t1 + t2 | t1 * t2 => term_fv t1 `|` term_fv t2 + | - t1 | t1 *+ _ | t1 ^+ _ | t1^-1 => term_fv t1 + | _ => fset0 + end%T. + +Fixpoint formula_fv (f : formula T) : {fset nat} := + match f with + | Bool _ => fset0 + | t1 == t2 | t1 <% t2 | t1 <=% t2 => term_fv t1 `|` term_fv t2 + | Unit t1 => term_fv t1 + | f1 /\ f2 | f1 \/ f2 | f1 ==> f2 => formula_fv f1 `|` formula_fv f2 + | ~ f1 => formula_fv f1 + | ('exists 'X_i, g) | ('forall 'X_i, g) => formula_fv g `\ i +end%oT. + +Fixpoint gen_var_seq (s : seq nat) (f : formula T) := match s with + | [::] => f + | i::l => ('forall 'X_i, gen_var_seq l f) +end%oT. + +Definition equiv_formula (f g : formula T) := + gen_var_seq (enum_fset ((formula_fv f) `|` (formula_fv g))) (f <==> g)%oT. + +Definition nvar n := fun f : + formula T => (formula_fv f `<=` mnfset O n). + +Record formulan n := MkFormulan +{ + underlying_formula :> formula T; + underlying_formula_fv : nvar n underlying_formula +}. + +HB.instance Definition formulan_subType n := + [isSub for @underlying_formula n]. + +Lemma fsubset_formulan_fv n (f : formulan n) : + formula_fv f `<=` mnfset O n. +Proof. by move: f => [f hf]. Qed. + +Lemma formula_fv0 (f : formulan 0) : formula_fv f = fset0. +Proof. +by apply/eqP; move: (fsubset_formulan_fv f); rewrite -fsubset0 seq_fset_nil. +Qed. + +Lemma in_fv_formulan (n : nat) (f : formulan n) (i : nat) : + i \in formula_fv f -> (i < n)%N. +Proof. +by rewrite -nfsetE; move/fsubsetP => -> //; rewrite fsubset_formulan_fv. +Qed. + +Lemma nvar_formulan (n : nat) (f : formulan n) : nvar n f. +Proof. by move: f => [f hf]. Qed. + +End EquivFormula. + +Notation "'{formula_' n T }" := (formulan T n). + +Section Nquantify. +Variable (R : Type). + +Fact nquantify_key : unit. Proof. exact: tt. Qed. +Definition nquantify (n k : nat) (Q : nat -> formula R -> formula R) + (f : formula R) := + locked_with nquantify_key (iteri k (fun i f => (Q (n + k - i.+1)%N f)) f). + +Lemma nquantSout (n k : nat) Q (f : formula R) : + nquantify n k.+1 Q f = Q n (nquantify n.+1 k Q f). +Proof. +rewrite /nquantify !unlock /= addnK; congr (Q _ _); apply: eq_iteri => i g. +by rewrite addnS addSn. +Qed. + +Lemma nquantify0 (n : nat) Q (f : formula R) : nquantify n 0 Q f = f. +Proof. by rewrite /nquantify !unlock. Qed. + +Lemma nquantify1 (n : nat) Q (f : formula R) : nquantify n 1 Q f = Q n f. +Proof. by rewrite nquantSout nquantify0. Qed. + +Lemma nquantify_add (m n k : nat) Q (f : formula R) : + nquantify m (n + k) Q f = nquantify m n Q (nquantify (m + n) k Q f). +Proof. +elim: n => [|n IHn] in k m *; + rewrite ?(nquantify0, nquantSout, addn0, addSn) //=. +by rewrite IHn addnS addSn. +Qed. + +Lemma nquantSin (n k : nat) Q (f : formula R) : + nquantify n k.+1 Q f = (nquantify n k Q (Q (n + k)%N f)). +Proof. by rewrite -addn1 nquantify_add nquantify1. Qed. + +Lemma formula_fv_nforall (n k : nat) (f : formula R) : + (formula_fv (nquantify n k Forall f)) = (formula_fv f) `\` (mnfset n k). +Proof. +elim: k => [|k h] in f *. +by rewrite nquantify0 seq_fset_nil fsetD0. +rewrite nquantSin h fsetDDl fsetUC -addn1 iotaD seq_fset_cat. +by rewrite seq_fset_cons seq_fset_nil fsetU0. +Qed. + +Lemma formula_fv_nexists (n k : nat) (f : formula R) : + (formula_fv (nquantify n k Exists f)) = (formula_fv f) `\` (mnfset n k). +Proof. +elim: k => [|k h] in f *. +by rewrite nquantify0 seq_fset_nil fsetD0. +rewrite nquantSin h fsetDDl fsetUC -addn1 iotaD seq_fset_cat. +by rewrite seq_fset_cons seq_fset_nil fsetU0. +Qed. + +Fact fv_nforall (m n i : nat) (f : formula R) : + (m <= i < m+n)%N -> i \notin formula_fv (nquantify m n Forall f). +Proof. +move=> Hi. +rewrite formula_fv_nforall in_fsetD negb_and negbK mnfsetE. +by apply/orP; left. +Qed. + +Fact fv_nexists (m n i : nat) (f : formula R) : + (m <= i < m+n)%N -> i \notin formula_fv (nquantify m n Exists f). +Proof. +move=> Hi. +rewrite formula_fv_nexists in_fsetD negb_and negbK mnfsetE. +by apply/orP; left. +Qed. + +End Nquantify. + +Section EncodeFormula. + +Variable T : Type. + +Fixpoint encode_term (t : GRing.term T) := match t with + | 'X_i => GenTree.Node (2 * i) [::] + | x %:T => GenTree.Leaf x + | i%:R => GenTree.Node ((2 * i).+1) [::] + | t1 + t2 => GenTree.Node O ((encode_term t1)::(encode_term t2)::nil) + | - t => GenTree.Node O ((encode_term t)::nil) + | x *+ i => GenTree.Node ((2 * i).+2) ((encode_term x)::nil) + | t1 * t2 => GenTree.Node 1 ((encode_term t1)::(encode_term t2)::nil) + | t ^-1 => GenTree.Node 1 ((encode_term t)::nil) + | x ^+ i => GenTree.Node ((2 * i).+3) ((encode_term x)::nil) +end%T. + +Fixpoint decode_term (t : GenTree.tree T) := match t with + | GenTree.Leaf x => x%:T + | GenTree.Node i s => match s with + | [::] => if (i %% 2)%N == O then GRing.Var T (i %/ 2) else ((i.-1) %/ 2)%:R + | e1::e2::l => if i == O then (decode_term e1) + (decode_term e2) + else (decode_term e1) * (decode_term e2) + | e::l => if i == O then - (decode_term e) else + if i == 1%N then (decode_term e)^-1 else + if (i %% 2)%N == O then (decode_term e) *+ ((i.-2) %/ 2) + else (decode_term e) ^+ ((i - 3) %/ 2) + end +end%T. + +Lemma encode_termK : cancel encode_term decode_term. +Proof. +move=> t; elim: t. ++ by move=> n /=; rewrite modnMr eqxx mulKn. ++ by move=> r. ++ by move=> n /=; rewrite {1}mulnC -addn1 modnMDl mulKn. ++ by move=> t1 h1 t2 h2 /=; rewrite h1 h2. ++ by move=> t h /=; rewrite h. ++ by move=> t h n /=; rewrite -addn2 {1}mulnC modnMDl h mulKn. ++ by move=> t1 h1 t2 h2 /=; rewrite h1 h2. ++ by move=> t h /=; rewrite h. ++ by move=> t h n /=; rewrite -addn3 {1}mulnC modnMDl h addnK mulKn. +Qed. + + +Fixpoint encode_formula (f : formula T) := match f with + | Bool b => GenTree.Node b [::] + | t1 == t2 => GenTree.Node O [:: encode_term t1; encode_term t2] + | t1 <% t2 => GenTree.Node 1 ((encode_term t1)::(encode_term t2)::nil) + | t1 <=% t2 => GenTree.Node 2 ((encode_term t1)::(encode_term t2)::nil) + | Unit t => GenTree.Node O ((encode_term t)::nil) + | f1 /\ f2 => GenTree.Node 3 ((encode_formula f1)::(encode_formula f2)::nil) + | f1 \/ f2 => GenTree.Node 4 ((encode_formula f1)::(encode_formula f2)::nil) + | f1 ==> f2 => GenTree.Node 5 ((encode_formula f1)::(encode_formula f2)::nil) + | ~ f => GenTree.Node 1 ((encode_formula f)::nil) + | ('exists 'X_i, f) => GenTree.Node (2 * i).+2 ((encode_formula f)::nil) + | ('forall 'X_i, f) => GenTree.Node (2 * i).+3 ((encode_formula f)::nil) +end%oT. + +Fixpoint decode_formula (t : GenTree.tree T) := match t with + | GenTree.Leaf x => Unit (Const x) + | GenTree.Node i s => match s with + | [::] => if i == O then Bool false else Bool true + | e1::e2::l => match i with + | O => (decode_term e1) == (decode_term e2) + | 1%N => (decode_term e1) <% (decode_term e2) + | 2 => (decode_term e1) <=% (decode_term e2) + | 3 => (decode_formula e1) /\ (decode_formula e2) + | 4 => (decode_formula e1) \/ (decode_formula e2) + | _ => (decode_formula e1) ==> (decode_formula e2) + end + | e::l => if i == O then Unit (decode_term e) else + if i == 1%N then Not (decode_formula e) else + if (i %% 2)%N == O + then ('exists 'X_((i.-2) %/ 2), decode_formula e) + else ('forall 'X_((i - 3) %/ 2), decode_formula e) + end +end%oT. + +Lemma encode_formulaK : cancel encode_formula decode_formula. +Proof. +move=> f; elim: f. ++ by move=> b /=; case: b. ++ by move=> t1 t2 /=; rewrite !encode_termK. ++ by move=> t1 t2 /=; rewrite !encode_termK. ++ by move=> t1 t2 /=; rewrite !encode_termK. ++ by move=> t /=; rewrite !encode_termK. ++ by move=> f1 h1 f2 h2 /=; rewrite h1 h2. ++ by move=> f1 h1 f2 h2 /=; rewrite h1 h2. ++ by move=> f1 h1 f2 h2 /=; rewrite h1 h2. ++ by move=> f /= ->. ++ by move=> i f hf /=; rewrite hf -addn2 {1}mulnC modnMDl mulKn /=. ++ by move=> i f hf /=; rewrite hf -addn3 {1}mulnC modnMDl /= addnK mulKn. +Qed. + +End EncodeFormula. + +HB.instance Definition formula_eqType (T : eqType) := + Equality.copy (formula T) (can_type (@encode_formulaK T)). +HB.instance Definition formulan_eqType (T : eqType) n := + [Equality of {formula_n T} by <:]. + +HB.instance Definition formula_choiceMixin (T : choiceType) := + Choice.copy (formula T) (can_type (@encode_formulaK T)). +HB.instance Definition formulan_choiceType (T : choiceType) n := + [Choice of {formula_n T} by <:]. + +Section TermSubst. +Variable F : nmodType. + +Definition subst_term s := + let fix sterm (t : GRing.term F) := match t with + | 'X_i => if (i < size s)%N then 'X_(nth O s i) else 0 + | t1 + t2 => (sterm t1) + (sterm t2) + | - t => - (sterm t) + | t *+ i => (sterm t) *+ i + | t1 * t2 => (sterm t1) * (sterm t2) + | t ^-1 => (sterm t) ^-1 + | t ^+ i => (sterm t) ^+ i + | _ => t +end%T in sterm. + +Fact fv_tsubst_nil (t : GRing.term F) : term_fv (subst_term [::] t) = fset0. +Proof. by elim: t => //= t1 -> t2 ->; rewrite fsetU0. Qed. + +Fact fv_tsubst (k : unit) (s : seq nat) (t : GRing.term F) : + term_fv (subst_term s t) `<=` seq_fset k s. +Proof. +elim: t => //. +- move=> i /=. + have [lt_is|leq_si] := ltnP i (size s); rewrite ?fsub0set //. + by rewrite fsub1set seq_fsetE; apply/(nthP _); exists i. +- by move=> t1 h1 t2 h2 /=; rewrite fsubUset; apply/andP; split. +- by move=> t1 h1 t2 h2 /=; rewrite fsubUset; apply/andP; split. +Qed. + +Fact fv_tsubst_map (k : unit) (s : seq nat) (t : GRing.term F) : + term_fv (subst_term s t) `<=` + seq_fset k [seq nth O s i | i <- (iota O (size s)) & (i \in term_fv t)]. +Proof. +elim: t => //. +- move=> i /=. + have [lt_is|leq_si] := ltnP i (size s); rewrite ?fsub0set //. + rewrite fsub1set seq_fsetE; apply: map_f. + by rewrite mem_filter in_fset1 eqxx mem_iota leq0n add0n. +- move=> t1 h1 t2 h2 /=; rewrite fsubUset; apply/andP; split. + + rewrite (fsubset_trans h1) //. + apply/seq_fset_sub; apply: sub_map_filter => x. + by rewrite in_fsetU => ->. + + rewrite (fsubset_trans h2) //. + apply/seq_fset_sub; apply: sub_map_filter => x. + by rewrite in_fsetU => ->; rewrite orbT. +- move=> t1 h1 t2 h2 /=; rewrite fsubUset; apply/andP; split. + + rewrite (fsubset_trans h1) //. + apply/seq_fset_sub; apply: sub_map_filter => x. + by rewrite in_fsetU => ->. + + rewrite (fsubset_trans h2) //. + apply/seq_fset_sub; apply: sub_map_filter => x. + by rewrite in_fsetU => ->; rewrite orbT. +Qed. + +End TermSubst. + +Section FormulaSubst. + +Variable T : Type. + +Lemma tsubst_id (t1 t2 : GRing.term T) (i : nat) : + i \notin (term_fv t1) -> GRing.tsubst t1 (i, t2)%oT = t1. +Proof. +move: t2; elim: t1. +- by move=> j t2 /=; rewrite in_fset1 eq_sym => /negbTE ->. +- by move=> x t2. +- by move=> j t2 h. +- move=> t1 h1 t2 h2 t3 /=. + rewrite in_fsetU negb_or => /andP [hi1 hi2]. + by rewrite h1 // h2. +- by move=> t1 h1 t2 /= hi; rewrite h1. +- by move=> t1 h1 j hj /= hi; rewrite h1. +- move=> t1 h1 t2 h2 t3 /=. + rewrite in_fsetU negb_or => /andP [hi1 hi2]. + by rewrite h1 // h2. +- by move=> t1 h1 t2 /= h2; rewrite h1. +- by move=> t1 h1 j t2 /= hi; rewrite h1. +Qed. + +Lemma fsubst_id (f : formula T) (t : GRing.term T) (i : nat) : + i \notin (formula_fv f) -> fsubst f (i, t)%oT = f. +Proof. +move: t; elim: f. +- by move=> b t. +- move=> t1 t2 t3 /=. + rewrite in_fsetU negb_or => /andP [hi1 hi2]. + by rewrite !tsubst_id. +- move=> t1 t2 t3 /=. + rewrite in_fsetU negb_or => /andP [hi1 hi2]. + by rewrite !tsubst_id. +- move=> t1 t2 t3 /=. + rewrite in_fsetU negb_or => /andP [hi1 hi2]. + by rewrite !tsubst_id. +- by move=> t1 t2 hi /=; rewrite tsubst_id. +- move=> f1 h1 f2 h2 t. + rewrite in_fsetU negb_or => /andP [hi1 hi2] /=. + by rewrite h1 // h2. +- move=> f1 h1 f2 h2 t. + rewrite in_fsetU negb_or => /andP [hi1 hi2] /=. + by rewrite h1 // h2. +- move=> f1 h1 f2 h2 t. + rewrite in_fsetU negb_or => /andP [hi1 hi2] /=. + by rewrite h1 // h2. +- by move=> f hf t /= hi; rewrite hf. +- move=> j f hf t /=. + have [<- | /negbTE neq_ij h] := eqVneq i j; rewrite ?eqxx //. + rewrite hf//; move: h; apply: contra. + by rewrite in_fsetD1 neq_ij. +- move=> j f hf t /=. + have [<- | /negbTE neq_ij h] := eqVneq i j; rewrite ?eqxx //. + rewrite hf//; move: h; apply: contra. + by rewrite in_fsetD1 neq_ij. +Qed. + +Lemma term_fv_tsubst (i : nat) (x : T) (t : GRing.term T) : + term_fv (GRing.tsubst t (i, (x%:T)%oT)) = (term_fv t) `\ i. +Proof. +elim: t => //=; rewrite ?fset0D //; + do ?by move=> t1 h1 t2 h2; rewrite fsetDUl ![in LHS](h1, h2). +move=> j; have [->| /negbTE neq_ij] := eqVneq j i. + by rewrite fsetDv. +by rewrite fset1D1 eq_sym neq_ij. +Qed. + +Lemma formula_fv_fsubst (i : nat) (x : T) (f : formula T) : + formula_fv (fsubst f (i, (x%:T)%oT)) = (formula_fv f) `\ i. +Proof. +elim: f. ++ by move=> b; rewrite fset0D. ++ by move=> t1 t2 /=; rewrite !term_fv_tsubst fsetDUl. ++ by move=> t1 t2 /=; rewrite !term_fv_tsubst fsetDUl. ++ by move=> t1 t2 /=; rewrite !term_fv_tsubst fsetDUl. ++ by move=> t /=; rewrite !term_fv_tsubst. ++ by move=> f1 h1 f2 h2 /=; rewrite fsetDUl h1 h2. ++ by move=> f1 h1 f2 h2 /=; rewrite fsetDUl h1 h2. ++ by move=> f1 h1 f2 h2 /=; rewrite fsetDUl h1 h2. ++ by move=> f hf. ++ move=> j f /= hf; rewrite fun_if hf. + have [->| /negbTE neq_ij] := eqVneq j i. + by rewrite fsetDDl //= fsetUid. + by rewrite !fsetDDl fsetUC. ++ move=> j f h /=. + rewrite fun_if h. + have [->| /negbTE neq_ij] := eqVneq j i. + by rewrite fsetDDl //= fsetUid. + by rewrite !fsetDDl fsetUC. +Qed. + +End FormulaSubst. + +Section RealDomainFormula. + +Variable R : realDomainType. + +Lemma eval_fv (t : GRing.term R) (e : seq R): + term_fv t = fset0 -> GRing.eval e t = GRing.eval [::] t. +Proof. +move/eqP; move=> h; elim/last_ind: e => //. +move=> s x <-; move: h; elim: t => //=. +- by move=> i; rewrite neq_fset10. +- move=> t1 h1 t2 h2. + rewrite /= fsetU_eq0 => /andP [ht1 ht2]. + by rewrite h1 // h2. +- by move=> t /= ih h; rewrite ih. +- by move=> t1 h1 t2 h2; rewrite h1. +- move=> t1 h1 t2 h2. + rewrite fsetU_eq0 => /andP [ht1 ht2]. + by rewrite h1 // h2. +- by move=> t ih h; rewrite ih. +- by move=> t ih i h; rewrite ih. +Qed. + +Lemma nn_formula (e : seq R) (f : formula R) : holds e (~ f) <-> ~ (holds e f). +Proof. by case: f. Qed. + +Lemma holds_take (n : nat) (f : {formula_n R}) (e : seq R) : + holds (take n e) f <-> holds e f. +Proof. +move: n f; elim/last_ind : e => // e x iHe n' f. +rewrite -{2}(@rcons_set_nth _ _ 0) take_rcons. +have [lt_en'|leq_n'e] := ltnP (size e) n'. + by rewrite take_oversize ?rcons_set_nth // ltnW. +apply: (iff_trans _ (@holds_fsubst _ _ _ _ _)). +apply: (iff_trans (@iHe _ _)) => /=. +by rewrite fsubst_id // (contra (@in_fv_formulan _ _ _ _)) // -leqNgt . +Qed. + +Lemma eqn_holds (n : nat) (e1 e2 : seq R) (f : {formula_n R}) : + (\row_(i < n) (e1`_(val i)) =2 (\row_(i < n) e2`_(val i))) + -> holds e1 f -> holds e2 f. +Proof. +move=> h; move/holds_take => h'. +apply/holds_take; apply: (eq_holds _ h') => i. +have [lt_in | leq_ni] := ltnP i n; last first. + by rewrite ? nth_default ?size_take // ?(leq_trans (geq_minl _ _)). +rewrite !nth_take //. +by move/(_ ord0 (Ordinal lt_in)) : h; rewrite !mxE. +Qed. + +Definition is_equiv (f g : formula R) := holds [::] (equiv_formula f g). + +Lemma holds_rcons_zero (e : seq R) (f : formula R) : + holds (rcons e 0%:R) f <-> holds e f. +Proof. +split; apply: eq_holds=> // i; rewrite nth_rcons; +by have [| /ltnW h|->] := ltngtP _ (size _)=> //; rewrite ?nth_default. +Qed. + +Lemma holds_cat_nseq (i : nat) (e : seq R) (f : formula R) : + holds (e ++ (nseq i 0)) f <-> holds e f. +Proof. +rewrite nseq_cat; move: e f; elim: i => // i ih e f. +by apply: (iff_trans _ (ih e f)); apply: holds_rcons_zero. +Qed. + +Lemma holdsAnd (I : eqType) (r : seq I) (P : pred I) + (e : seq R) (f : I -> formula R) : + holds e (\big[And/True%oT]_(i <- r | P i) f i) + <-> forall i, i \in r -> P i -> holds e (f i). +Proof. +elim: r => [|i r IHr]; first by rewrite big_nil. +rewrite big_cons; case/boolP: (P i) => [|/negP] Pi; last first. + apply (iff_trans IHr); split=> hr j. + by rewrite in_cons => /orP; case=> [/eqP -> //|]; apply: hr. + by move=> jr; apply: hr; rewrite in_cons jr orbT. +split=> /= [[hi /IHr hr j]|hr]. + by rewrite in_cons => /orP; case=> [/eqP -> //|]; apply: hr. +split; first by apply: hr => //; rewrite in_cons eq_refl. +by apply/IHr => j jr; apply: hr; rewrite in_cons jr orbT. +Qed. + +Lemma holdsOr (I : eqType) (r : seq I) (P : pred I) + (e : seq R) (f : I -> formula R) : + holds e (\big[Or/False%oT]_(i <- r | P i) f i) + <-> exists i, i \in r /\ P i /\ holds e (f i). +Proof. +elim: r => [|i r IHr]. + by rewrite big_nil; split=> // [[?]][]. +rewrite big_cons; case/boolP: (P i) => [|/negP] Pi; last first. + apply (iff_trans IHr); split=> -[j][+][hj]. + by move=> jr; exists j; rewrite in_cons jr orbT; split=> //; split. + rewrite in_cons => /orP; case=> [/eqP ji|jr]; first by move: Pi; rewrite -ji. + by exists j; split=> //; split. +split=> /= [[hi|/IHr [j][jr hj]]|[j][+][Pj]hj]. +- by exists i; rewrite in_cons eqxx; split=> //; split. +- by exists j; rewrite in_cons jr orbT; split. +rewrite in_cons => /orP[/eqP <-|jr]; first by left. +by right; apply/IHr; exists j; split=> //; split. +Qed. + +Lemma holds_Nfv_ex (e : seq R) (i : nat) (f : formula R) : + i \notin formula_fv f -> (holds e ('exists 'X_i, f) <-> holds e f). +Proof. +move=> hi; split => [[x /holds_fsubst holds_ef]| h]. + by move: holds_ef; rewrite fsubst_id. +by exists 0; apply/holds_fsubst; rewrite fsubst_id. +Qed. + +Lemma holds_Nfv_all (e : seq R) (i : nat) (f : formula R) : + i \notin formula_fv f -> (holds e ('forall 'X_i, f) <-> holds e f). +Proof. +move=> hi; split => [|holds_ef x]. + by move/(_ 0)/holds_fsubst; rewrite fsubst_id. +by apply/holds_fsubst; rewrite fsubst_id. +Qed. + +Fact holds_Exists (e : seq R) (i : nat) (f : formula R) : + holds e f -> holds e ('exists 'X_i, f). +Proof. +move => holds_ef. +have [lt_ie|le_ei] := ltnP i (size e); first by exists e`_i; rewrite set_nth_id. +by exists 0; rewrite set_nth_over //; apply/holds_rcons_zero/holds_cat_nseq. +Qed. + +Lemma fv0_holds (e : seq R) f : + formula_fv f = fset0 -> (holds e f <-> holds [::] f). +Proof. +move/eqP; move=> h; elim/last_ind: e => //. +move=> e x <-; move: h; elim: f => //. +- move=> t1 t2 /=; rewrite fsetU_eq0 => /andP [/eqP ht1 /eqP ht2]. + by rewrite !eval_fv. +- move=> t1 t2 /=; rewrite fsetU_eq0 => /andP [/eqP ht1 /eqP ht2]. + by rewrite !eval_fv. +- move=> t1 t2 /=; rewrite fsetU_eq0 => /andP [/eqP ht1 /eqP ht2]. + by rewrite !eval_fv. +- by move=> t /eqP h /=; rewrite !eval_fv. +- move=> f1 h1 f2 h2. + rewrite fsetU_eq0 => /andP [ht1 ht2]. + move: (h1 ht1) => {}h1; move: (h2 ht2) => {}h2. + by apply: (iff_trans (and_iff_compat_r _ _) (and_iff_compat_l _ _)). +- move=> f1 h1 f2 h2. + rewrite fsetU_eq0 => /andP [ht1 ht2]. + move: (h1 ht1) => {}h1; move: (h2 ht2) => {}h2. + by apply: (iff_trans (or_iff_compat_r _ _) (or_iff_compat_l _ _)). +- move=> f1 h1 f2 h2 /=. + rewrite fsetU_eq0 => /andP [ht1 ht2]. + move: (h1 ht1) => {}h1; move: (h2 ht2) => {}h2. + by apply: (iff_trans (if_iff_compat_r _ _) (if_iff_compat_l _ _)). +- by move=> f holds_ex_f fv_f; split => ?; apply/(holds_ex_f fv_f). +- move=> i f h. + (* the following line causes a problem in PB if I remove /= *) + rewrite [X in X -> _]/= fsetD_eq0 fsubset1 => /orP [h1 | fv0]; last first. + + move/(_ fv0) : h => h. + have hi : i \notin formula_fv f by move/eqP : fv0 ->. (* PB problem here *) + split; move/holds_Nfv_ex => h';apply/holds_Nfv_ex => //; + by apply/h; apply: h'. + + rewrite -(rcons_set_nth x 0); split => [|h']. + - move/holds_fsubst. + by rewrite fsubst_id //=; move/eqP : h1 ->; rewrite fsetDv in_fset0. + - apply/holds_fsubst. + by rewrite fsubst_id //=; move/eqP : h1 ->; rewrite fsetDv in_fset0. +- move=> i f h. + rewrite [X in X -> _]/= fsetD_eq0 fsubset1 => /orP [h1 | fv0]; last first. + + move/(_ fv0) : h => h. + have hi : i \notin formula_fv f by move/eqP : fv0 ->. + split; move/holds_Nfv_all=> h'; apply/holds_Nfv_all =>//; + by apply/h; apply: h'. + + rewrite -(rcons_set_nth x 0); split => [|h']. + - move/holds_fsubst. + by rewrite fsubst_id //=; move/eqP : h1 ->; rewrite fsetDv in_fset0. + - apply/holds_fsubst. + by rewrite fsubst_id //=; move/eqP : h1 ->; rewrite fsetDv in_fset0. +Qed. + +Lemma nforallP (k : nat) (e : seq R) (f : formula R) : + (forall v : k.-tuple R, holds (e ++ v) f) + <-> (holds e (nquantify (size e) k Forall f)). +Proof. +elim: k => [|k IHk] /= in e *. + rewrite nquantify0; split. + by move=> /(_ [tuple of [::]]); rewrite cats0. + by move=> hef v; rewrite tuple0 cats0. +rewrite nquantSout /=; split => holdsf; last first. + move=> v; case: (tupleP v) => x {}v /=. + rewrite -cat_rcons -(rcons_set_nth _ 0%:R). + by move: v; apply/IHk; rewrite ?size_set_nth (maxn_idPl _). +move=> x; set e' := set_nth _ _ _ _. +have -> : (size e).+1 = size e' by rewrite size_set_nth (maxn_idPl _). +apply/IHk => v; suff -> : e' ++ v = e ++ [tuple of x :: v] by apply: holdsf. +by rewrite /e' /= rcons_set_nth cat_rcons. +Qed. + +Lemma nexistsP (k : nat) (e : seq R) (f : formula R) : + (exists v : k.-tuple R, holds (e ++ v) f) + <-> (holds e (nquantify (size e) k Exists f)). +Proof. +elim: k => [|k IHk] /= in e *. +- rewrite nquantify0; split; first by move=> [v]; rewrite tuple0 cats0. + by exists [tuple of [::]]; rewrite cats0. +- rewrite nquantSout /=; split => [[v holdsf]|[x holdsf]]. + + case: (tupleP v) => x {}v /= in holdsf *. + exists x; set e' := set_nth _ _ _ _. + have -> : (size e).+1 = size e' by rewrite size_set_nth (maxn_idPl _). + by apply/IHk; exists v; rewrite /e' /= rcons_set_nth cat_rcons. + + move: holdsf; set e' := set_nth _ _ _ _. + have -> : (size e).+1 = size e' by rewrite size_set_nth (maxn_idPl _). + move/IHk => [v]; rewrite /e' /= rcons_set_nth cat_rcons. + by exists [tuple of x :: v]. +Qed. + +Lemma nforall_is_true (f : formula R) : + (forall (e : seq R), holds e f) -> + forall (n i : nat) (e : seq R), holds e (nquantify n i Forall f). +Proof. +move=> h n i; elim: i => [|i IHi] in n *; +by rewrite ?(nquantify0, nquantSout) /=. +Qed. + +Lemma monotonic_forall_if (i : nat) (e : seq R) (f g : formula R) : + (forall (e' : seq R), holds e' f -> holds e' g) -> + holds e ('forall 'X_i, f) -> holds e ('forall 'X_i, g). +Proof. by move=> h /= fholds x; apply/h. Qed. + +Lemma monotonic_exists_if (i : nat) (e : seq R) (f g : formula R) : + (forall (e' : seq R), holds e' f -> holds e' g) -> + holds e ('exists 'X_i, f) -> holds e ('exists 'X_i, g). +Proof. by move=> h /= [x fx]; exists x; apply/h. Qed. + +Lemma monotonic_nforall (n k : nat) (e : seq R) (f g : formula R) : + (forall (e' : seq R), holds e' f -> holds e' g) -> + holds e (nquantify n k Forall f) -> holds e (nquantify n k Forall g). +Proof. +move: n e f g; elim: k => [k e f g | k ih n e f g h]. + by rewrite !nquantify0; move/(_ e). +rewrite !nquantSin => hf. +apply: (ih n e ('forall 'X_(n + k), f)%oT) => // e'. +exact/monotonic_forall_if. +Qed. + +Lemma monotonic_nexist (n k : nat) (e : seq R) (f g : formula R) : + (forall (e' : seq R), holds e' f -> holds e' g) -> + holds e (nquantify n k Exists f) -> holds e (nquantify n k Exists g). +Proof. +move: n e f g; elim: k => [k e f g | k ih n e f g h]. + by rewrite !nquantify0; move/(_ e). +rewrite !nquantSin => hf. +apply: (ih n e ('exists 'X_(n + k), f)%oT) => // e'. +exact/monotonic_exists_if. +Qed. + +Fact monotonic_forall_iff (i : nat) (e : seq R) (f g : formula R) : + (forall (e' : seq R), holds e' f <-> holds e' g) -> + holds e ('forall 'X_i, f) <-> holds e ('forall 'X_i, g). +Proof. by move=> h; split; apply: monotonic_forall_if=> e'; move/(h e'). Qed. + +Fact holds_forall (i : nat) (e : seq R) (f : formula R) : + holds e ('forall 'X_i, f) -> holds e f. +Proof. by move=> /= /(_ e`_i); rewrite set_nth_nth; move/holds_cat_nseq. Qed. + +Lemma holds_nforall (n k : nat) (e : seq R) (f : formula R) : + holds e (nquantify n k Forall f) -> holds e f. +Proof. +move: e f; elim: k => [e f|k iHk e f h]; first by rewrite nquantify0. +apply: iHk; move: h; rewrite nquantSin; apply/monotonic_nforall => e'. +exact/holds_forall. +Qed. + +Fact closed_nforall_formulan (n : nat) (f : {formula_n R}) : + formula_fv (nquantify O n Forall f) == fset0. +Proof. by rewrite formula_fv_nforall fsetD_eq0 fsubset_formulan_fv. Qed. + +Fact closed_nexists_formulan (n : nat) (f : {formula_n R}) : + formula_fv (nquantify O n Exists f) == fset0. +Proof. by rewrite formula_fv_nexists fsetD_eq0 fsubset_formulan_fv. Qed. + +End RealDomainFormula. + +Section RealClosedFieldFormula. +Variable F : rcfType. (* is also a realDomainType *) + +Fact qf_form_elim (f : formula F) : + rformula f -> qf_form (@quantifier_elim _ (@wproj _) f). +Proof. +by move=> h; move/andP: (quantifier_elim_wf (@wf_QE_wproj _) h) => [qf_f _]. +Qed. + +Fact rform_elim (f : formula F) : + rformula f -> rformula (@quantifier_elim _ (@wproj _) f). +Proof. +by move=> h; move/andP: (quantifier_elim_wf (@wf_QE_wproj _) h) => [_ rform_f]. +Qed. + +Fact elim_rformP (f : formula F) (e : seq F) : + rformula f + -> reflect (holds e f) (qf_eval e (@quantifier_elim _ (@wproj _) f)). +Proof. +move=> rform_f; apply: quantifier_elim_rformP => //. +- move=> i bc /= h. + by apply: wf_QE_wproj. +- move=> i bc /= e' h. + by apply: valid_QE_wproj. +Qed. + +Lemma rcf_sat_True (e : seq F) : rcf_sat e True. +Proof. exact/rcf_satP. Qed. + +Fact rcf_sat_Bool (e : seq F) (b : bool) : rcf_sat e (Bool b) = b. +Proof. by []. Qed. + +Fact rcf_sat_Equal (e : seq F) (t1 t2 : GRing.term F) : + rcf_sat e (t1 == t2) = (GRing.eval e t1 == GRing.eval e t2). +Proof. by apply/rcf_satP/idP => h; apply/eqP. Qed. + +Fact rcf_sat_Lt (e : seq F) (t1 t2 : GRing.term F) : + rcf_sat e (t1 <% t2) = (GRing.eval e t1 < GRing.eval e t2). +Proof. by apply/rcf_satP/idP. Qed. + +Fact rcf_sat_Le (e : seq F) (t1 t2 : GRing.term F) : + rcf_sat e (t1 <=% t2) = (GRing.eval e t1 <= GRing.eval e t2). +Proof. by apply/rcf_satP/idP. Qed. + +Fact rcf_sat_Unit (e : seq F) (t : GRing.term F) : + rcf_sat e (Unit t) = (GRing.eval e t \is a GRing.unit). +Proof. by apply/rcf_satP/idP. Qed. + +Fact rcf_sat_And (e : seq F) (f g : formula F) : + rcf_sat e (f /\ g) = (rcf_sat e f) && (rcf_sat e g). +Proof. by []. Qed. + +Fact rcf_sat_Or (e : seq F) (f g : formula F) : + rcf_sat e (f \/ g) = (rcf_sat e f) || (rcf_sat e g). +Proof. by []. Qed. + +Fact rcf_sat_Implies (e : seq F) (f g : formula F) : + rcf_sat e (f ==> g) = ((rcf_sat e f) ==> (rcf_sat e g)). +Proof. +by apply/rcf_satP/implyP => /= hfg; move/rcf_satP => h; apply/rcf_satP/hfg. +Qed. + +Fact rcf_sat_Not (e : seq F) (f : formula F) : + rcf_sat e (~ f) = ~~ (rcf_sat e f). +Proof. by []. Qed. + +(* TODO: generalize to sequences with `has`? *) +Lemma rcf_sat_exists [k : nat] (l : seq F) (E : 'I_k -> formula F) : + rcf_sat l (\big[Or/False]_(i < k) E i) = [exists i, rcf_sat l (E i)]. +Proof. +apply/rcf_satP/existsP => [/holdsOr|] /= [] x. + by move=> [_][_] /rcf_satP Ex; exists x. +move=> /rcf_satP Ex; apply/holdsOr; exists x. +by split; first exact/mem_index_enum. +Qed. + +Lemma rcf_sat_nexists (e : seq F) (P : formula F) (u : seq F) : + (forall v : seq F, size v = size u -> rcf_sat (e ++ v) P -> v = u) -> + rcf_sat e (nquantify (size e) (size u) Exists P) = rcf_sat (e ++ u) P. +Proof. +move=> u_uniq. +apply/rcf_satP/rcf_satP; last by move=> up; apply/nexistsP; exists (in_tuple u). +by move=> /nexistsP[v] /[dup] /rcf_satP/(u_uniq _ (size_tuple v)) ->. +Qed. + +Lemma n_forall_formula (e : seq F) (f : formula F) (i : nat) : + holds e (~ ('forall 'X_i, f)) <-> holds e ('exists 'X_i, ~ f). +Proof. +split; last by move=> [x hx] h2; apply/hx/h2. +move=> /nn_formula/rcf_satP Nallf. +apply/rcf_satP; apply: contraNT Nallf => /rcf_satP NexNf. +apply/rcf_satP => /= x; apply/rcf_satP. +rewrite -[rcf_sat _ _]negbK -!rcf_sat_Not. +by apply/rcf_satP => /= Nf_holds; apply: NexNf; exists x. +Qed. + +Lemma n_nforall_formula (e : seq F) (f : formula F) (a b : nat) : + holds e (~ (nquantify a b Forall f)) <-> holds e (nquantify a b Exists (~ f)). +Proof. +move: f; elim: b => [f|b ih f]; first by rewrite !nquantify0. +rewrite !nquantSin; split. ++ move/ih; apply: monotonic_nexist => e'. + exact: (iffLR (n_forall_formula _ _ _)). ++ move=> h; apply/ih; move: h. + apply: monotonic_nexist=> e'. + exact: (iffRL (n_forall_formula _ _ _)). +Qed. + +Definition simp_rcf_sat := + (rcf_sat_Bool, rcf_sat_Equal, rcf_sat_Lt, rcf_sat_Le, rcf_sat_Unit, + rcf_sat_And, rcf_sat_Or, rcf_sat_Implies, rcf_sat_Not). + +Lemma rcf_sat_cat_nseq (i : nat) (e : seq F) (f : formula F) : + rcf_sat (e ++ nseq i 0) f = rcf_sat e f. +Proof. +apply/rcf_satP/rcf_satP; first by move/holds_cat_nseq. +by move=> h; apply/holds_cat_nseq. +Qed. + +Lemma rcf_sat_take [n : nat] (f : {formula_n F}) (e : seq F) : + rcf_sat (take n e) f = rcf_sat e f. +Proof. by apply/rcf_satP/rcf_satP => /holds_take. Qed. + +Lemma rcf_sat_forall k l (E : 'I_k -> formula F) : + rcf_sat l (\big[And/True%oT]_(i < k) E i) = [forall i, rcf_sat l (E i)]. +Proof. +elim: k=> [|k Ihk] in E *. + by rewrite big_ord0 simp_rcf_sat; symmetry; apply/forallP => -[]. +rewrite -(big_andE xpredT) /= !big_ord_recl !simp_rcf_sat. +by rewrite -![qf_eval _ _]/(rcf_sat _ _) Ihk -(big_andE xpredT). +Qed. + +Lemma rcf_sat_forallP k l (E : 'I_k -> formula F) : + rcf_sat l (\big[And/True%oT]_(i < k) E i) = [forall i, rcf_sat l (E i)]. +Proof. +elim: k=> [|k Ihk] in E *. + by rewrite big_ord0; apply/rcf_satP/forallP; move=> _ // [[ ]]. +rewrite big_ord_recl /=; apply/rcf_satP/forallP => + [[/rcf_satP E0 /rcf_satP Er] i|Eall]. + have [j->|->//] := unliftP ord0 i. + by move: Er; rewrite Ihk; move/forallP/(_ j). +apply/rcf_satP; rewrite simp_rcf_sat Eall Ihk. +by apply/forallP=> x; apply: Eall. +Qed. + +Lemma formula_fv_bigAnd (I : Type) (r : seq I) + (P : pred I) (E : I -> formula F) : + formula_fv (\big[And/True%oT]_(i <- r | P i) (E i)) = + \bigcup_(i <- r | P i) (formula_fv (E i)). +Proof. exact: big_morph. Qed. + +Lemma formula_fv_bigOr (I : Type) (r : seq I) + (P : pred I) (E : I -> formula F) : + formula_fv (\big[Or/False%oT]_(i <- r | P i) (E i)) = + \bigcup_(i <- r | P i) (formula_fv (E i)). +Proof. exact: big_morph. Qed. + +Lemma formula_fv_bigU (a : nat) (E : 'I_a -> formula F) : + formula_fv (\big[And/True%oT]_(i < a) (E i)) = + \bigcup_(i in 'I_a) (formula_fv (E i)). +Proof. exact: big_morph. Qed. + +Definition is_independent (i : nat) (f : formula F) := + forall (e : seq F), holds e ('forall 'X_i, f) <-> holds e f. + +Lemma independent (f : formula F) (i : nat) : + i \notin (formula_fv f) -> is_independent i f. +Proof. by rewrite /is_independent; case: f => *; apply: holds_Nfv_all. Qed. + +Lemma fsubst_indep (i : nat) (f : formula F) (x : F) (e : seq F) : + is_independent i f -> (holds e f) -> holds e (fsubst f (i, GRing.Const x)). +Proof. by move=> h1 h2; apply/holds_fsubst; move/h1/(_ x): h2. Qed. + +Lemma is_independentP (i : nat) (f : formula F) : + is_independent i f <-> + (forall (e : seq F) (x y : F), + (holds (set_nth 0 e i x) f) <-> (holds (set_nth 0 e i y) f)). +Proof. +split => h e; [|split => [|h2 z]]. ++ move=> x y. + apply: (iff_trans _ (h (set_nth 0 e i y))); apply: iff_sym. + apply: (iff_trans _ (h (set_nth 0 e i x))). + split=> h2 u; rewrite set_set_nth eqxx; + by move/(_ u) : h2; rewrite set_set_nth eqxx. ++ by move/(_ e`_i); rewrite set_nth_nth; move/holds_cat_nseq. ++ by apply/(h e e`_i _); rewrite set_nth_nth; apply/holds_cat_nseq. +Qed. + +Lemma foldr_fsubst_indep (s : seq nat) (f : formula F) (x : F) (e : seq F) : + (forall i : nat, i \in s -> is_independent i f) -> + holds e (foldr (fun i : nat => (fsubst (T:=F))^~ (i, (x%R%:T)%oT)) f s) <-> + holds e f. +Proof. +move: f x e; elim: s => // a s. +move => ih f x e h. +apply: (iff_trans (holds_fsubst _ _ _ _)). +apply: (iff_trans (ih _ _ _ _)) => [j j_in_s|]. + by apply: h; rewrite inE j_in_s orbT. +have /is_independentP ha : is_independent a f by apply: h; rewrite inE eqxx. +by apply: (iff_trans (ha _ _ e`_a)); rewrite set_nth_nth; apply/holds_cat_nseq. +Qed. + +Lemma indep_to_rform (f : formula F) (i : nat) : + is_independent i (to_rform f) <-> is_independent i f. +Proof. +split=> h e. ++ apply: (iff_trans _ (to_rformP _ _)). + apply: (iff_trans _ (h _)). + by split; apply: monotonic_forall_if=> e2; move/to_rformP. ++ apply: iff_sym; apply: (iff_trans (to_rformP _ _)). + apply: iff_sym; apply: (iff_trans _ (h _)). + by split; apply: monotonic_forall_if=> e2; move/to_rformP. +Qed. + +End RealClosedFieldFormula. + +Section Closure. + +Variable (F : Type) (n : nat). + +Lemma and_formulan (f1 f2 : {formula_n F}) : nvar n (f1 /\ f2)%oT. +Proof. by rewrite /nvar fsubUset !fsubset_formulan_fv. Qed. + +Canonical Structure formulan_and (f1 f2 : {formula_n F}) := + MkFormulan (and_formulan f1 f2). + +Lemma implies_formulan (f1 f2 : {formula_n F}) : nvar n (f1 ==> f2)%oT. +Proof. by rewrite /nvar fsubUset !fsubset_formulan_fv. Qed. + +Canonical Structure formulan_implies (f1 f2 : {formula_n F}) := + MkFormulan (implies_formulan f1 f2). + +Lemma bool_formulan (b : bool) : @nvar F n (Bool b). +Proof. by rewrite /nvar fsub0set. Qed. + +Canonical Structure formulan_bool (b : bool) := MkFormulan (bool_formulan b). + +Lemma or_formulan (f1 f2 : {formula_n F}) : nvar n (f1 \/ f2)%oT. +Proof. by rewrite /nvar fsubUset !fsubset_formulan_fv. Qed. + +Canonical Structure formulan_or (f1 f2 : {formula_n F}) := + MkFormulan (or_formulan f1 f2). + +Lemma not_formulan (f : {formula_n F}) : nvar n (~ f)%oT. +Proof. by rewrite /nvar fsubset_formulan_fv. Qed. + +Canonical Structure formulan_not (f : {formula_n F}) := + MkFormulan (not_formulan f). + +Lemma exists_formulan (i : nat) (f : {formula_n F}) : + nvar n ('exists 'X_i, f)%oT. +Proof. +by rewrite /nvar (fsubset_trans (@fsubD1set _ _ _)) // fsubset_formulan_fv. +Qed. + +Canonical Structure formulan_exists (i : nat) (f : {formula_n F}) := + MkFormulan (exists_formulan i f). + +Lemma forall_formulan (i : nat) (f : {formula_n F}) : + nvar n ('forall 'X_i, f)%oT. +Proof. +by rewrite /nvar (fsubset_trans (@fsubD1set _ _ _)) // fsubset_formulan_fv. +Qed. + +Canonical Structure formulan_forall (i : nat) (f : {formula_n F}) := + MkFormulan (forall_formulan i f). + +Lemma fsubst_formulan (i : nat) (x : F) (f : {formula_n F}) : + nvar n (fsubst f (i, (x%:T)%oT))%oT. +Proof. +rewrite /nvar formula_fv_fsubst. +by rewrite (fsubset_trans (@fsubD1set _ _ _)) // fsubset_formulan_fv. +Qed. + +Canonical Structure formulan_fsubst (i : nat) (x : F) (f : {formula_n F}) := + MkFormulan (fsubst_formulan i x f). + +Lemma And_formulan (I : finType) (x : {formula_n F}) (r : seq I) + (P : pred I) (f : I -> {formula_n F}) : + nvar n (\big[And/x : formula F]_(i <- r | P i) f i). +Proof. +elim: r => [|i r IHr]. + rewrite big_nil; apply/fsubset_formulan_fv. +rewrite big_cons; case: (P i) => //. +exact: and_formulan (f i) (MkFormulan IHr). +Qed. + +Canonical Structure formulan_And (I : finType) (x : {formula_n F}) + (r : seq I) (P : pred I) (f : I -> {formula_n F}) := + MkFormulan (And_formulan x r P f). + +Lemma Or_formulan (I : finType) (x : {formula_n F}) (r : seq I) + (P : pred I) (f : I -> {formula_n F}) : + nvar n (\big[Or/x : formula F]_(i <- r | P i) f i). +Proof. +elim: r => [|i r IHr]. + rewrite big_nil; apply/fsubset_formulan_fv. +rewrite big_cons; case: (P i) => //. +exact: or_formulan (f i) (MkFormulan IHr). +Qed. + +Canonical Structure formulan_Or (I : finType) (x : {formula_n F}) + (r : seq I) (P : pred I) (f : I -> {formula_n F}) := + MkFormulan (Or_formulan x r P f). + +Lemma existsn_formulaSn (m : nat) (f : {formula_(m.+1) F}) : + nvar m ('exists 'X_m, f)%oT. +Proof. +rewrite /nvar fsubDset (fsubset_trans (fsubset_formulan_fv _)) // => {f}. +rewrite -add1n addnC iotaD add0n seq_fset_cat fsetUC. +by rewrite seq_fset_cons seq_fset_nil fsetU0 fsubset_refl. +Qed. + +Lemma existsPn_formulan (m : nat) (f : {formula_m F}) : + nvar m.-1 ('exists 'X_m.-1, f)%oT. +Proof. +move: f; case: m => [f|k f] //=; last exact: existsn_formulaSn. +by rewrite /nvar fsubDset (fsubset_trans (fsubset_formulan_fv _)) // fsubsetUr. +Qed. + +Lemma nexists_formulan m (f : {formula_m F}) : + nvar n (nquantify n (m - n) Exists (f : formula F)). +Proof. +rewrite /nvar formula_fv_nexists fsubDset fsetUC -seq_fset_cat -iotaD. +have [/ltnW lt_mn| leq_nm] := ltnP m n; last first. + by rewrite subnKC // fsubset_formulan_fv. +rewrite (fsubset_trans (fsubset_formulan_fv _)) //. +apply/fsubsetP=> x; rewrite !seq_fsetE !mem_iota !add0n => /andP [_ lt_xm]. +by rewrite leq0n (leq_trans lt_xm) // (leq_trans lt_mn) // leq_addr. +Qed. + +Canonical Structure formulan_nexists m (f : {formula_m F}) := + MkFormulan (nexists_formulan f). + +Lemma formulaSn_proof (f : {formula_n F}) : nvar n.+1 f. +Proof. +rewrite /nvar; apply/(fsubset_trans (fsubset_formulan_fv f))/seq_fset_sub => x. +by rewrite !mem_iota => /andP[-> /=] /ltnW; rewrite !add0n ltnS. +Qed. + +Definition lift_formulan (f : {formula_n F}) := MkFormulan (formulaSn_proof f). + +Lemma lift_formulan_inj : injective lift_formulan. +Proof. by move=> f1 f2 /(congr1 val) h; apply: val_inj. Qed. + +Lemma formuladd (p m : nat) (f : {formula_p F}) : nvar (p + m) f. +Proof. +rewrite /nvar (fsubset_trans (fsubset_formulan_fv _)) //. +apply/fsubsetP=> x; rewrite !seq_fsetE !mem_iota !add0n !leq0n. +exact: ltn_addr. +Qed. + +Canonical Structure formulan_add (m p : nat) (f : {formula_m F}) := + MkFormulan (formuladd p f). + +End Closure. + +Section QuantifierElimination. +Variable (F : rcfType). + +(* quantifier elim + evaluation of invariant variables to 0 *) +Definition qf_elim (f : formula F) : formula F := + let g := (quantifier_elim (@wproj _) (to_rform f)) in + foldr (fun i h => fsubst h (i, GRing.Const 0)) g + (enum_fset (formula_fv g `\` formula_fv f)). + +Lemma fv_foldr_fsubst (f : formula F) (s : seq nat) : + formula_fv (foldr (fun i h => fsubst h (i, GRing.Const 0)) f s) = + (formula_fv f) `\` (seq_fset mnfset_key s). +Proof. +elim: s => [|i s ih]; first by rewrite seq_fset_nil fsetD0 // fsubset_refl. +by rewrite formula_fv_fsubst ih seq_fset_cons fsetDDl fsetUC. +Qed. + +Fact qf_form_fsubst (f : formula F) (i : nat) (t : GRing.term F) : + qf_form (fsubst f (i, t)) = (qf_form f). +Proof. by elim: f=> //=; move=> f1 -> f2 ->. Qed. + +Fact qf_form_fsubstn (f : formula F) (s : seq nat) (t : GRing.term F) : + qf_form (foldr (fun i h => fsubst h (i, t)) f s) = (qf_form f). +Proof. by elim: s => // x s ih; rewrite qf_form_fsubst ih. Qed. + +Lemma qf_elim_qf (f : formula F) : qf_form (qf_elim f). +Proof. by rewrite qf_form_fsubstn qf_form_elim // to_rform_rformula. Qed. + +Lemma qf_elim_fv (f : formula F) : formula_fv (qf_elim f) `<=` formula_fv f. +Proof. +rewrite fv_foldr_fsubst fsubDset; apply/fsubsetP => i. +by rewrite in_fsetU seq_fsetE in_fsetD /= => ->; rewrite andbT orNb. +Qed. + +(* How to factorize both goals? *) +Lemma indep_elim (i : nat) (f : formula F) : + rformula f -> + (is_independent i (quantifier_elim (@wproj _) f) <-> is_independent i f). +Proof. +move=> rform_f; rewrite /is_independent. +split => h e; (split; first exact: holds_forall). + move/(rwP (elim_rformP _ rform_f))/(rwP (qf_evalP _ (qf_form_elim rform_f))). + move/h; apply: monotonic_forall_if => e2 h2. + exact/(rwP (elim_rformP _ rform_f))/(rwP (qf_evalP _ (qf_form_elim rform_f))). +move/(rwP (qf_evalP _ (qf_form_elim rform_f)))/(rwP (elim_rformP _ rform_f)). +move/h; apply: monotonic_forall_if => e2 h2. +exact/(rwP (qf_evalP _ (qf_form_elim rform_f)))/(rwP (elim_rformP _ rform_f)). +Qed. + +Lemma qf_elim_holdsP (f : formula F) (e : seq F) : + reflect (holds e f) (rcf_sat e (qf_elim f)). +Proof. +apply: (equivP _ (to_rformP _ _)); apply: (equivP (rcf_satP _ _)). +apply: (iff_trans (foldr_fsubst_indep _ _ _)) => [i | ]; last first. + apply: (iff_trans (rwP (qf_evalP _ (qf_form_elim (to_rform_rformula _))))). + apply: iff_sym. + by apply: (iff_trans _ (rwP (elim_rformP _ (to_rform_rformula _)))). +rewrite in_fsetD => /andP [not_fv _] e2. +apply: iff_sym. +apply: (iff_trans (rwP (qf_evalP _ (qf_form_elim (to_rform_rformula _))))). +apply: iff_sym. +apply: (iff_trans _ (rwP (elim_rformP _ (to_rform_rformula _)))). +move/(_ e2) : (independent not_fv) => h. +move: (independent not_fv) => /(indep_to_rform _ _) /(_ e2) indep. +apply: (iff_trans _ indep). +apply: monotonic_forall_iff => e3. +apply: (iff_trans (rwP (qf_evalP _ (qf_form_elim (to_rform_rformula _))))). +apply: iff_sym. +by apply: (iff_trans _ (rwP (elim_rformP _ (to_rform_rformula _)))). +Qed. + +Fixpoint qf_subst_formula s (f : formula F) := let sterm := subst_term s in + match f with + | (t1 == t2) => (sterm t1) == (sterm t2) + | t1 <% t2 => (sterm t1) <% (sterm t2) + | t1 <=% t2 => (sterm t1) <=% (sterm t2) + | Unit t => Unit (sterm t) + | f1 /\ f2 => (qf_subst_formula s f1) /\ (qf_subst_formula s f2) + | f1 \/ f2 => (qf_subst_formula s f1) \/ (qf_subst_formula s f2) + | f1 ==> f2 => (qf_subst_formula s f1) ==> (qf_subst_formula s f2) + | ~ f => ~ (qf_subst_formula s f) + | ('forall 'X_i, _) | ('exists 'X_i, _) => False + | _ => f + end%oT. + +Definition subst_formula s (f : formula F) := qf_subst_formula s (qf_elim f). + +Fact fv_subst_formula (k : unit) (s : seq nat) f : + formula_fv (subst_formula s f) `<=` seq_fset k s. +Proof. +rewrite /subst_formula. +move: s; elim: (qf_elim f) => // {f}. +- by move=> t1 t2 s; rewrite fsubUset !fv_tsubst. +- by move=> t1 t2 s; rewrite fsubUset !fv_tsubst. +- by move=> t1 t2 s; rewrite fsubUset !fv_tsubst. +- by move=> t s; rewrite fv_tsubst. +- by move=> f1 h1 f2 h2 s; rewrite fsubUset h1 h2. +- by move=> f1 h1 f2 h2 s; rewrite fsubUset h1 h2. +- by move=> f1 h1 f2 h2 s; rewrite fsubUset h1 h2. +Qed. + +Fact fv_qf_subst_formula (k : unit) (s : seq nat) f : + formula_fv (qf_subst_formula s f) `<=` + seq_fset k [seq nth O s i | i <- (iota O (size s)) & (i \in formula_fv f)]. +Proof. +move: s; elim: f => //. +- move=> t1 t2 s; rewrite fsubUset /=. + apply/andP; split; rewrite (fsubset_trans (fv_tsubst_map k _ _)) //; + apply/seq_fset_sub/sub_map_filter => i; rewrite in_fsetU => -> //. + by rewrite orbT. +- move=> t1 t2 s; rewrite fsubUset /=. + apply/andP; split; rewrite (fsubset_trans (fv_tsubst_map k _ _)) //; + apply/seq_fset_sub/sub_map_filter => i; rewrite in_fsetU => -> //. + by rewrite orbT. +- move=> t1 t2 s; rewrite fsubUset /=. + apply/andP; split; rewrite (fsubset_trans (fv_tsubst_map k _ _)) //; + apply/seq_fset_sub/sub_map_filter => i; rewrite in_fsetU => -> //. + by rewrite orbT. +- by move=> t s; apply: fv_tsubst_map. +- move=> f1 h1 f2 h2 s /=; rewrite fsubUset. + apply/andP; split. + + rewrite (fsubset_trans (h1 _)) //. + apply/seq_fset_sub. + apply: sub_map_filter. + move=> i. + by rewrite in_fsetU => ->. + + rewrite (fsubset_trans (h2 _)) //. + apply/seq_fset_sub. + apply: sub_map_filter. + move=> i. + by rewrite in_fsetU => ->; rewrite orbT. +- move=> f1 h1 f2 h2 s /=. + rewrite fsubUset. + apply/andP; split. + + rewrite (fsubset_trans (h1 _)) //. + apply/seq_fset_sub. + apply: sub_map_filter. + move=> i. + by rewrite in_fsetU => ->. + + rewrite (fsubset_trans (h2 _)) //. + apply/seq_fset_sub. + apply: sub_map_filter. + move=> i. + by rewrite in_fsetU => ->; rewrite orbT. +- move=> f1 h1 f2 h2 s /=. + rewrite fsubUset. + apply/andP; split. + + rewrite (fsubset_trans (h1 _)) //. + apply/seq_fset_sub. + apply: sub_map_filter. + move=> i. + by rewrite in_fsetU => ->. + + rewrite (fsubset_trans (h2 _)) //. + apply/seq_fset_sub. + apply: sub_map_filter. + move=> i. + by rewrite in_fsetU => ->; rewrite orbT. +Qed. + +Fact fv_subst_formula_map (k : unit) (s : seq nat) f : + formula_fv (subst_formula s f) `<=` + seq_fset k [seq nth O s i | i <- (iota O (size s)) & (i \in formula_fv f)]. +Proof. +rewrite /subst_formula (fsubset_trans (fv_qf_subst_formula k _ _)) //. +apply/seq_fset_sub/sub_map_filter => i. +by move/fsubsetP/(_ i): (qf_elim_fv f). +Qed. + +Fact fv_subst_nil f : formula_fv (subst_formula [::] f) = fset0. +Proof. +by apply/eqP; rewrite -fsubset0 -(seq_fset_nil _ tt) fv_subst_formula. +Qed. + +Definition cut (n : nat) (f : formula F) := subst_formula (iota 0 n) f. + +Fact nvar_cut n f : nvar n (cut n f). +Proof. +apply/(fsubset_trans (fv_subst_formula_map mnfset_key _ _))/seq_fset_sub => x. +move=> /mapP[i]; rewrite mem_filter !mem_iota /= !add0n. +by rewrite size_iota => /andP[_] ilt ->; rewrite nth_iota. +Qed. + +Canonical Structure cut_formulan n f := MkFormulan (nvar_cut n f). + +Lemma rterm_tsubst (R : unitRingType) (t : GRing.term R) + (s : nat * GRing.term R) : + GRing.rterm t -> GRing.rterm (snd s) -> GRing.rterm (GRing.tsubst t s). +Proof. +move=> + sr; elim: t => //=. +- by move=> n _; case: (n == fst s). +- by move=> t IHt u IHu /andP[] /IHt {}IHt /IHu {}IHu; apply/andP; split. +- by move=> t IHt u IHu /andP[] /IHt {}IHt /IHu {}IHu; apply/andP; split. +Qed. + +Lemma rform_fsubst (R : realDomainType) (f : formula R) + (s : nat * GRing.term R) : + rformula f -> GRing.rterm (snd s) -> rformula (fsubst f s). +Proof. +move=> + sr; elim: f => //=. +- by move=> t u /andP[] tr ur; apply/andP; split; apply/rterm_tsubst. +- by move=> t u /andP[] tr ur; apply/andP; split; apply/rterm_tsubst. +- by move=> t u /andP[] tr ur; apply/andP; split; apply/rterm_tsubst. +- by move=> f IHf g IHg /andP[] /IHf {}IHf /IHg {}IHg; apply/andP; split. +- by move=> f IHf g IHg /andP[] /IHf {}IHf /IHg {}IHg; apply/andP; split. +- by move=> f IHf g IHg /andP[] /IHf {}IHf /IHg {}IHg; apply/andP; split. +- by move=> n f IHf fr; case: (n == fst s); last apply/IHf. +- by move=> n f IHf fr; case: (n == fst s); last apply/IHf. +Qed. + +Lemma rform_qf_elim (f : formula F) : rformula (qf_elim f). +Proof. +rewrite /qf_elim. +elim: (enum_fset _) => /= [|x r IHr]; last exact/rform_fsubst. +exact/rform_elim/to_rform_rformula. +Qed. + +End QuantifierElimination. + +Section SubstEnv. +Variable (F : rcfType). + +Definition subst_env (s : seq nat) (e : seq F) := [seq nth 0 e i | i <- s]. + +Lemma subst_env_cat s1 s2 e : + subst_env (s1 ++ s2) e = subst_env s1 e ++ subst_env s2 e. +Proof. by rewrite /subst_env map_cat. Qed. + +Lemma subst_env_iota k1 k2 e1 e2 e3 : size e1 = k1 -> size e2 = k2 -> + subst_env (iota k1 k2) (e1 ++ e2 ++ e3) = e2. +Proof. +move=> h1 h2; rewrite /subst_env; apply: (@eq_from_nth _ 0) => [ | i]. + by rewrite size_map size_iota; symmetry. +rewrite size_map size_iota => lt_ik2. +rewrite (nth_map O); last by rewrite size_iota. +by rewrite !nth_cat nth_iota // ltnNge h1 leq_addr addnC addnK h2 lt_ik2. +Qed. + +Lemma subst_env_iota_catl k e1 e2 : size e1 = k -> + subst_env (iota 0 k) (e1 ++ e2) = e1. +Proof. by move=> ?; rewrite -[e1 ++ e2]cat0s (@subst_env_iota 0). Qed. + +Lemma subst_env_iota_catr k1 k2 e1 e2 : size e1 = k1 -> size e2 = k2 -> + subst_env (iota k1 k2) (e1 ++ e2) = e2. +Proof. by move=> h1 h2; rewrite -[e1 ++ e2]cats0 -catA subst_env_iota. Qed. + +Lemma subst_env_nil s : subst_env s [::] = nseq (size s) 0. +Proof. +apply: (@eq_from_nth _ 0); rewrite ?size_map ?size_nseq // => i lt_is. +by rewrite (nth_map O) // nth_nil nth_nseq if_same. +Qed. + +Lemma eval_subst (e : seq F) (s : seq nat) (t : GRing.term F) : + GRing.eval e (subst_term s t) = GRing.eval (subst_env s e) t. +Proof. +elim: t. +- move=> i //=. + have [lt_is| leq_si] := ltnP i (size s); last first. + + by rewrite [RHS]nth_default ?size_map // !nth_default. + + by rewrite (nth_map i) //=; congr nth; apply: set_nth_default. +- by move=> x. +- by move=> i. +- by move=> /= t1 -> t2 ->. +- by move=> /= t ->. +- by move=> /= t -> i. +- by move=> /= t1 -> t2 ->. +- by move=> /= t ->. +- by move=> /= t -> i. +Qed. + +Lemma holds_subst e s f : + holds e (subst_formula s f) <-> holds (subst_env s e) f. +Proof. +rewrite (rwP (@qf_elim_holdsP F f _)) -(rwP (@rcf_satP _ _ _)) /subst_formula. +move: e s; elim: (qf_elim f) (qf_elim_qf f) => // {f}. +- by move=> t1 t2 ? e s /=; rewrite !eval_subst. +- by move=> t1 t2 ? e s /=; rewrite !eval_subst. +- by move=> t1 t2 ? e s /=; rewrite !eval_subst. +- by move=> t ? e s /=; rewrite eval_subst. +- by move=> f1 h1 f2 h2 /andP[??] e s /=; rewrite h1 // h2. +- by move=> f1 h1 f2 h2 /andP[??] e s /=; rewrite h1 // h2. +- by move=> f1 h1 f2 h2 /andP[??] e s /=; rewrite h1 // h2. +- by move=> f1 h1 ? e s /=; rewrite h1. +Qed. + +Lemma rcf_sat_subst (e : seq F) (s : seq nat) (f : formula F) : + rcf_sat e (subst_formula s f) = rcf_sat (subst_env s e) f. +Proof. by apply/rcf_satP/rcf_satP => /holds_subst. Qed. + +Lemma holds_eq_vec e v1 v2 : + holds e (eq_vec F v1 v2) <-> (subst_env v1 e) = (subst_env v2 e). +Proof. +move: v2; elim: v1 => [v2|] /=. + by case: v2 => /=; rewrite /eq_vec ?big_ord0. +move=> a v1 ih v2 /=. +case: v2 => //= b v2. +rewrite /=. +apply: iff_sym; apply: (iff_trans (rwP (eqP ))). +rewrite eqseq_cons. +rewrite /eq_vec /= eqSS big_ord_recl /=. +split. +move=> /andP [/eqP eq_ab /eqP eq_v2]. +rewrite fun_if /=; move/(ih v2) : eq_v2. +by rewrite /eq_vec; case: (_ == _). +rewrite fun_if /= => h. +apply/andP; split; first by move: h; case: (_ == _) => //; move=> [] ->. +by apply/eqP/(ih v2); move: h;rewrite /eq_vec;case: (_ == _) => //; move=> [] _. +Qed. + +Lemma size_subst_env (i : nat) (t : i.-tuple nat) (e : seq F) : + size (subst_env t e) = i. +Proof. by rewrite size_map size_tuple. Qed. + +Fact subst_env_tuple_subproof (i : nat) (t : i.-tuple nat) (e : seq F) : + size (subst_env t e) == i. +Proof. by apply/eqP/size_subst_env. Qed. + +Canonical subst_env_tuple (i : nat) (t : i.-tuple nat) (e : seq F) := + Tuple (subst_env_tuple_subproof t e). + +End SubstEnv. + diff --git a/semialgebraic.v b/semialgebraic.v index 93e4e10..018b4c6 100644 --- a/semialgebraic.v +++ b/semialgebraic.v @@ -1,10 +1,27 @@ (* (c) Copyright Microsoft Corporation and Inria. All rights reserved. *) (*****************************************************************************) -(* This file formalises semi-algebraic sets and semi-algebraic functions. *) -(* Semi-algebraic sets are constructed by a quotient of formulae. *) -(* The main construction is the implementation of the abstract set interface *) -(* for semi-algebraic sets and functions. *) +(* This file defines types {SAset F^n} for semi-algebraic sets and *) +(* {SAfun F^n -> F^m} for semi-algebraic functions, where F has a structure *) +(* of real closed field and n and m are natural numbers. *) +(* {SAset F^n} is constructed as a quotient of formulae and is equipped with *) +(* a structure of predType 'rV_n and choiceType. *) +(* Given F : rcfType and n : nat, we define: *) +(* SAset0 == the empty set *) +(* SAset1 x == the singleton containing x *) +(* SAsub s1 s2 == s1 is included in s2 *) +(* SAset_meet s1 s2 == the intersection of s1 and s2 *) +(* SAset_join s1 s2 == the union of s1 and s2 *) +(* SAset_top == the full set *) +(* SAset_sub s1 s2 == the difference s1 minus s2 *) +(* These operations equip {SAset F^n} with a structure of distributive *) +(* lattice with top, bottom and complement. *) +(* Given F : rcfType and n, m : nat, we define: *) +(* SAgraph f == the graph of f *) +(* SAimset f s == the image of s by f *) +(* SAabs == the absolute value as a semi-algebraic function *) +(* SAid == the identity of F^n as a semi-algebraic function *) +(* SAcomp f g == the composite of f and g *) (* *) (*****************************************************************************) @@ -12,13 +29,13 @@ Require Import ZArith Init. From HB Require Import structures. Require Import mathcomp.ssreflect.ssreflect. -From mathcomp Require Import ssrfun ssrbool eqtype ssrnat seq choice fintype div. -From mathcomp Require Import tuple finfun generic_quotient bigop finset perm. -From mathcomp Require Import ssralg poly polydiv ssrnum mxpoly binomial finalg. -From mathcomp Require Import zmodp mxpoly mxtens qe_rcf ordered_qelim realalg. -From mathcomp Require Import matrix finmap order finset. - -From SemiAlgebraic Require Import auxresults. +From mathcomp Require Import ssrfun ssrbool eqtype ssrnat seq choice path. +From mathcomp Require Import fintype div tuple finfun generic_quotient bigop. +From mathcomp Require Import finset perm ssralg ssrint poly polydiv ssrnum. +From mathcomp Require Import mxpoly binomial interval finalg complex zmodp. +From mathcomp Require Import mxpoly mpoly mxtens qe_rcf ordered_qelim realalg. +From mathcomp Require Import matrix finmap order finset classical_sets topology. +From mathcomp Require Import normedtype polyrcf polyorder. Set Implicit Arguments. Unset Strict Implicit. @@ -27,689 +44,112 @@ Unset Printing Implicit Defensive. Import GRing.Theory Num.Theory Num.Def. Import ord. Import Order.Theory Order.Syntax. +Import numFieldTopology.Exports. -Local Open Scope nat_scope. -Local Open Scope ring_scope. +From SemiAlgebraic Require Import auxresults formula. + +Local Open Scope type_scope. Local Open Scope fset_scope. Local Open Scope fmap_scope. Local Open Scope quotient_scope. -Local Open Scope type_scope. +Local Open Scope classical_set_scope. +Local Open Scope nat_scope. +Local Open Scope ring_scope. + +Declare Scope sa_scope. +Delimit Scope sa_scope with SA. +Local Open Scope sa_scope. -Reserved Notation "'{formula_' n F }" - (n at level 0, format "'{formula_' n F }"). Reserved Notation "{ 'SAset' F }" (format "{ 'SAset' F }"). Reserved Notation "{ 'SAfun' T }" (format "{ 'SAfun' T }"). -Fact mnfset_key : unit. Proof. exact tt. Qed. -Notation mnfset i j := (seq_fset mnfset_key (iota i j)). -Notation "f <==> g" := ((f ==> g) /\ (g ==> f))%oT (at level 0) : oterm_scope. - -Section EquivFormula. - -Variable T : Type. - -Fixpoint term_fv (t : GRing.term T) : {fset nat} := - match t with - | 'X_i => [fset i] - | t1 + t2 | t1 * t2 => term_fv t1 `|` term_fv t2 - | - t1 | t1 *+ _ | t1 ^+ _ | t1^-1 => term_fv t1 - | _ => fset0 - end%T. - -Fixpoint formula_fv (f : formula T) : {fset nat} := - match f with - | Bool _ => fset0 - | t1 == t2 | t1 <% t2 | t1 <=% t2 => term_fv t1 `|` term_fv t2 - | Unit t1 => term_fv t1 - | f1 /\ f2 | f1 \/ f2 | f1 ==> f2 => formula_fv f1 `|` formula_fv f2 - | ~ f1 => formula_fv f1 - | ('exists 'X_i, g) | ('forall 'X_i, g) => formula_fv g `\ i -end%oT. - -Fixpoint gen_var_seq (s : seq nat) (f : formula T) := match s with - | [::] => f - | i::l => ('forall 'X_i, gen_var_seq l f) -end%oT. - -Definition equiv_formula (f g : formula T) := - gen_var_seq (enum_fset ((formula_fv f) `|` (formula_fv g))) (f <==> g)%oT. - -Definition nvar n := fun f : - formula T => (formula_fv f `<=` mnfset O n). - -Record formulan n := MkFormulan -{ - underlying_formula :> formula T; - underlying_formula_fv : nvar n underlying_formula -}. - -HB.instance Definition formulan_subType n := - [isSub for @underlying_formula n]. - -End EquivFormula. - -Notation "'{formula_' n T }" := (formulan T n). - -Section EncodeFormula. - -Variable T : Type. - -Fixpoint encode_term (t : GRing.term T) := match t with - | 'X_i => GenTree.Node (2 * i) [::] - | x %:T => GenTree.Leaf x - | i%:R => GenTree.Node ((2 * i).+1) [::] - | t1 + t2 => GenTree.Node O ((encode_term t1)::(encode_term t2)::nil) - | - t => GenTree.Node O ((encode_term t)::nil) - | x *+ i => GenTree.Node ((2 * i).+2) ((encode_term x)::nil) - | t1 * t2 => GenTree.Node 1 ((encode_term t1)::(encode_term t2)::nil) - | t ^-1 => GenTree.Node 1 ((encode_term t)::nil) - | x ^+ i => GenTree.Node ((2 * i).+3) ((encode_term x)::nil) -end%T. - -Fixpoint decode_term (t : GenTree.tree T) := match t with - | GenTree.Leaf x => x%:T - | GenTree.Node i s => match s with - | [::] => if (i %% 2)%N == O then GRing.Var T (i %/ 2) else ((i.-1) %/ 2)%:R - | e1::e2::l => if i == O then (decode_term e1) + (decode_term e2) - else (decode_term e1) * (decode_term e2) - | e::l => if i == O then - (decode_term e) else - if i == 1%N then (decode_term e)^-1 else - if (i %% 2)%N == O then (decode_term e) *+ ((i.-2) %/ 2) - else (decode_term e) ^+ ((i - 3) %/ 2) - end -end%T. - -Lemma encode_termK : cancel encode_term decode_term. -Proof. -move=> t; elim: t. -+ by move=> n /=; rewrite modnMr eqxx mulKn. -+ by move=> r. -+ by move=> n /=; rewrite {1}mulnC -addn1 modnMDl mulKn. -+ by move=> t1 h1 t2 h2 /=; rewrite h1 h2. -+ by move=> t h /=; rewrite h. -+ by move=> t h n /=; rewrite -addn2 {1}mulnC modnMDl h mulKn. -+ by move=> t1 h1 t2 h2 /=; rewrite h1 h2. -+ by move=> t h /=; rewrite h. -+ by move=> t h n /=; rewrite -addn3 {1}mulnC modnMDl h addnK mulKn. -Qed. - - -Fixpoint encode_formula (f : formula T) := match f with - | Bool b => GenTree.Node b [::] - | t1 == t2 => GenTree.Node O [:: encode_term t1; encode_term t2] - | t1 <% t2 => GenTree.Node 1 ((encode_term t1)::(encode_term t2)::nil) - | t1 <=% t2 => GenTree.Node 2 ((encode_term t1)::(encode_term t2)::nil) - | Unit t => GenTree.Node O ((encode_term t)::nil) - | f1 /\ f2 => GenTree.Node 3 ((encode_formula f1)::(encode_formula f2)::nil) - | f1 \/ f2 => GenTree.Node 4 ((encode_formula f1)::(encode_formula f2)::nil) - | f1 ==> f2 => GenTree.Node 5 ((encode_formula f1)::(encode_formula f2)::nil) - | ~ f => GenTree.Node 1 ((encode_formula f)::nil) - | ('exists 'X_i, f) => GenTree.Node (2 * i).+2 ((encode_formula f)::nil) - | ('forall 'X_i, f) => GenTree.Node (2 * i).+3 ((encode_formula f)::nil) -end%oT. - -Fixpoint decode_formula (t : GenTree.tree T) := match t with - | GenTree.Leaf x => Unit (Const x) - | GenTree.Node i s => match s with - | [::] => if i == O then Bool false else Bool true - | e1::e2::l => match i with - | O => (decode_term e1) == (decode_term e2) - | 1%N => (decode_term e1) <% (decode_term e2) - | 2 => (decode_term e1) <=% (decode_term e2) - | 3 => (decode_formula e1) /\ (decode_formula e2) - | 4 => (decode_formula e1) \/ (decode_formula e2) - | _ => (decode_formula e1) ==> (decode_formula e2) - end - | e::l => if i == O then Unit (decode_term e) else - if i == 1%N then Not (decode_formula e) else - if (i %% 2)%N == O - then ('exists 'X_((i.-2) %/ 2), decode_formula e) - else ('forall 'X_((i - 3) %/ 2), decode_formula e) - end -end%oT. - -Lemma encode_formulaK : cancel encode_formula decode_formula. -Proof. -move=> f; elim: f. -+ by move=> b /=; case: b. -+ by move=> t1 t2 /=; rewrite !encode_termK. -+ by move=> t1 t2 /=; rewrite !encode_termK. -+ by move=> t1 t2 /=; rewrite !encode_termK. -+ by move=> t /=; rewrite !encode_termK. -+ by move=> f1 h1 f2 h2 /=; rewrite h1 h2. -+ by move=> f1 h1 f2 h2 /=; rewrite h1 h2. -+ by move=> f1 h1 f2 h2 /=; rewrite h1 h2. -+ by move=> f hf /=; rewrite hf. -+ by move=> i f hf /=; rewrite hf -addn2 {1}mulnC modnMDl mulKn /=. -+ by move=> i f hf /=; rewrite hf -addn3 {1}mulnC modnMDl /= addnK mulKn. -Qed. - -End EncodeFormula. - -HB.instance Definition formula_eqType (T : eqType) := - Equality.copy (formula T) (can_type (@encode_formulaK T)). -HB.instance Definition formulan_eqType (T : eqType) n := - [Equality of {formula_n T} by <:]. - -HB.instance Definition formula_choiceMixin (T : choiceType) := - Choice.copy (formula T) (can_type (@encode_formulaK T)). -HB.instance Definition formulan_choiceType (T : choiceType) n := - [Choice of {formula_n T} by <:]. - -Section FormulaSubst. - -Variable T : Type. - -Lemma tsubst_id (t1 t2 : GRing.term T) (i : nat) : - i \notin (term_fv t1) -> GRing.tsubst t1 (i, t2)%oT = t1. -Proof. -move: t2; elim: t1. -- by move=> j t2 /=; rewrite in_fset1 eq_sym => /negbTE ->. -- by move=> x t2. -- by move=> j t2 h. -- move=> t1 h1 t2 h2 t3 /=. - rewrite in_fsetU negb_or => /andP [hi1 hi2]. - by rewrite h1 // h2. -- by move=> t1 h1 t2 /= hi; rewrite h1. -- by move=> t1 h1 j hj /= hi; rewrite h1. -- move=> t1 h1 t2 h2 t3 /=. - rewrite in_fsetU negb_or => /andP [hi1 hi2]. - by rewrite h1 // h2. -- by move=> t1 h1 t2 /= h2; rewrite h1. -- by move=> t1 h1 j t2 /= hi; rewrite h1. -Qed. - -Lemma fsubst_id (f : formula T) (t : GRing.term T) (i : nat) : - i \notin (formula_fv f) -> fsubst f (i, t)%oT = f. -Proof. -move: t; elim: f. -- by move=> b t. -- move=> t1 t2 t3 /=. - rewrite in_fsetU negb_or => /andP [hi1 hi2]. - by rewrite !tsubst_id. -- move=> t1 t2 t3 /=. - rewrite in_fsetU negb_or => /andP [hi1 hi2]. - by rewrite !tsubst_id. -- move=> t1 t2 t3 /=. - rewrite in_fsetU negb_or => /andP [hi1 hi2]. - by rewrite !tsubst_id. -- by move=> t1 t2 hi /=; rewrite tsubst_id. -- move=> f1 h1 f2 h2 t. - rewrite in_fsetU negb_or => /andP [hi1 hi2] /=. - by rewrite h1 // h2. -- move=> f1 h1 f2 h2 t. - rewrite in_fsetU negb_or => /andP [hi1 hi2] /=. - by rewrite h1 // h2. -- move=> f1 h1 f2 h2 t. - rewrite in_fsetU negb_or => /andP [hi1 hi2] /=. - by rewrite h1 // h2. -- by move=> f hf t /= hi; rewrite hf. -- move=> j f hf t /=. - have [<- | /negbTE neq_ij h] := eqVneq i j; rewrite ?eqxx //. - rewrite hf//; move: h; apply: contra. - by rewrite in_fsetD1 neq_ij. -- move=> j f hf t /=. - have [<- | /negbTE neq_ij h] := eqVneq i j; rewrite ?eqxx //. - rewrite hf//; move: h; apply: contra. - by rewrite in_fsetD1 neq_ij. -Qed. - -End FormulaSubst. - -Section RealDomainFormula. - -Variable R : realDomainType. - -Definition is_equiv (f g : formula R) := holds [::] (equiv_formula f g). - -Fact nquantify_key : unit. Proof. exact: tt. Qed. -Definition nquantify (n k : nat) (Q : nat -> formula R -> formula R) - (f : formula R) := - locked_with nquantify_key (iteri k (fun i f => (Q (n + k - i.+1)%N f)) f). - -Lemma nquantSout (n k : nat) Q (f : formula R) : - nquantify n k.+1 Q f = Q n (nquantify n.+1 k Q f). -Proof. -rewrite /nquantify !unlock /= addnK; congr (Q _ _); apply: eq_iteri => i g. -by rewrite addnS addSn. -Qed. - -Lemma nquantify0 (n : nat) Q (f : formula R) : nquantify n 0 Q f = f. -Proof. by rewrite /nquantify !unlock. Qed. - -Lemma nquantify1 (n : nat) Q (f : formula R) : nquantify n 1 Q f = Q n f. -Proof. by rewrite nquantSout nquantify0. Qed. - -Lemma nquantify_add (m n k : nat) Q (f : formula R) : - nquantify m (n + k) Q f = nquantify m n Q (nquantify (m + n) k Q f). -Proof. -elim: n => [|n IHn] in k m *; - rewrite ?(nquantify0, nquantSout, addn0, addSn) //=. -by rewrite IHn addnS addSn. -Qed. - -Lemma nquantSin (n k : nat) Q (f : formula R) : - nquantify n k.+1 Q f = (nquantify n k Q (Q (n + k)%N f)). -Proof. by rewrite -addn1 nquantify_add nquantify1. Qed. - -Lemma nforallP (k : nat) (e : seq R) (f : formula R) : - (forall v : k.-tuple R, holds (e ++ v) f) - <-> (holds e (nquantify (size e) k Forall f)). -Proof. -elim: k => [|k IHk] /= in e *. - rewrite nquantify0; split. - by move=> /(_ [tuple of [::]]); rewrite cats0. - by move=> hef v; rewrite tuple0 cats0. -rewrite nquantSout /=; split => holdsf; last first. - move=> v; case: (tupleP v) => x {v} v /=. - rewrite -cat_rcons -(rcons_set_nth _ 0%:R). - by move: v; apply/IHk; rewrite ?size_set_nth (maxn_idPl _). -move=> x; set e' := set_nth _ _ _ _. -have -> : (size e).+1 = size e' by rewrite size_set_nth (maxn_idPl _). -apply/IHk => v; suff -> : e' ++ v = e ++ [tuple of x :: v] by apply: holdsf. -by rewrite /e' /= rcons_set_nth cat_rcons. -Qed. - -Lemma nexistsP (k : nat) (e : seq R) (f : formula R) : - (exists v : k.-tuple R, holds (e ++ v) f) - <-> (holds e (nquantify (size e) k Exists f)). -Proof. -elim: k => [|k IHk] /= in e *. -- rewrite nquantify0; split; first by move=> [v]; rewrite tuple0 cats0. - by exists [tuple of [::]]; rewrite cats0. -- rewrite nquantSout /=; split => [[v holdsf]|[x holdsf]]. - + case: (tupleP v) => x {v} v /= in holdsf *. - exists x; set e' := set_nth _ _ _ _. - have -> : (size e).+1 = size e' by rewrite size_set_nth (maxn_idPl _). - by apply/IHk; exists v; rewrite /e' /= rcons_set_nth cat_rcons. - + move: holdsf; set e' := set_nth _ _ _ _. - have -> : (size e).+1 = size e' by rewrite size_set_nth (maxn_idPl _). - move/IHk => [v]; rewrite /e' /= rcons_set_nth cat_rcons. - by exists [tuple of x :: v]. -Qed. - -Lemma nforall_is_true (f : formula R) : - (forall (e : seq R), holds e f) -> - forall (n i : nat) (e : seq R), holds e (nquantify n i Forall f). -Proof. -move=> h n i; elim: i => [|i IHi] in n *; -by rewrite ?(nquantify0, nquantSout) /=. -Qed. - -Lemma holds_rcons_zero (e : seq R) (f : formula R) : - holds (rcons e 0%:R) f <-> holds e f. -Proof. -split; apply: eq_holds=> // i; rewrite nth_rcons; -by have [| /ltnW h|->] := ltngtP _ (size _)=> //; rewrite ?nth_default. -Qed. - -Lemma holds_cat_nseq (i : nat) (e : seq R) (f : formula R) : - holds (e ++ (nseq i 0)) f <-> holds e f. -Proof. -rewrite nseq_cat; move: e f; elim: i => // i ih e f. -by apply: (iff_trans _ (ih e f)); apply: holds_rcons_zero. -Qed. - -Lemma monotonic_nforall (n k : nat) (e : seq R) (f g : formula R) : - (forall (e' : seq R), holds e' f -> holds e' g) -> - holds e (nquantify n k Forall f) -> holds e (nquantify n k Forall g). -Proof. -move: n e f g; elim: k => [k e f g | k ih n e f g h hf]. - by rewrite !nquantify0; move/(_ e). -rewrite nquantSin. -apply: (ih n e ('forall 'X_(n + k), f)%oT);last by move: hf;rewrite nquantSin. -move=> e' nk_f x. -by apply: h; apply: nk_f. -Qed. - -Lemma monotonic_nexist (n k : nat) (e : seq R) (f g : formula R) : - (forall (e' : seq R), holds e' f -> holds e' g) -> - holds e (nquantify n k Exists f) -> holds e (nquantify n k Exists g). -Proof. -move: n e f g; elim: k => [k e f g|k iH n e f g h hf]. - by rewrite !nquantify0; move/(_ e). -rewrite nquantSin. -apply: (iH n e ('exists 'X_(n + k), f)%oT); last by move: hf; rewrite nquantSin. -move=> e' /= [x nk_f]. -by exists x; apply: h; apply: nk_f. -Qed. - -Lemma monotonic_forall_if (i : nat) (e : seq R) (f g : formula R) : -(forall (e' : seq R), holds e' f -> holds e' g) -> -holds e ('forall 'X_i, f) -> holds e ('forall 'X_i, g). -Proof. -move=> h; move: (@monotonic_nforall i 1 e f g). -by rewrite /nquantify [X in X -> _]/= !addnK !unlock => h'; apply: h'. -Qed. - -Fact monotonic_forall_iff (i : nat) (e : seq R) (f g : formula R) : -(forall (e' : seq R), holds e' f <-> holds e' g) -> -holds e ('forall 'X_i, f) <-> holds e ('forall 'X_i, g). -Proof. by move=> h; split; apply: monotonic_forall_if=> e'; move/(h e'). Qed. - -Lemma holds_nforall (n k : nat) (e : seq R) (f : formula R) : - holds e (nquantify n k Forall f) -> holds e f. -Proof. -move: e f; elim: k => [e f|k iHk e f h]; first by rewrite nquantify0. -apply: iHk; move: h; rewrite nquantSin. apply: monotonic_nforall. -by move=> e'; move/(_ e'`_(n + k)); rewrite set_nth_nth; move/holds_cat_nseq. -Qed. - -Fact holds_forall (i : nat) (e : seq R) (f : formula R) : - holds e ('forall 'X_i, f) -> holds e f. -Proof. -by move=> h; apply: (@holds_nforall i 1); rewrite /nquantify /= addnK unlock. -Qed. - -End RealDomainFormula. - -Section RealClosedFieldFormula. -Variable F : rcfType. (* is also a realDomainType *) - -Fact qf_form_elim (f : formula F) : - rformula f -> qf_form (@quantifier_elim _ (@wproj _) f). -Proof. -by move=> h; move/andP: (quantifier_elim_wf (@wf_QE_wproj _) h) => [qf_f _]. -Qed. - -Fact rform_elim (f : formula F) : - rformula f -> rformula (@quantifier_elim _ (@wproj _) f). -Proof. -by move=> h; move/andP: (quantifier_elim_wf (@wf_QE_wproj _) h) => [_ rform_f]. -Qed. - -Fact elim_rformP (f : formula F) (e : seq F) : -rformula f -> reflect (holds e f) (qf_eval e (@quantifier_elim _ (@wproj _) f)). -Proof. -move=> rform_f; apply: quantifier_elim_rformP => //. -- move=> i bc /= h. - by apply: wf_QE_wproj. -- move=> i bc /= e' h. - by apply: valid_QE_wproj. -Qed. - -Fact rcf_sat_Bool (e : seq F) (b : bool) : rcf_sat e (Bool b) = b. -Proof. by []. Qed. - -Fact rcf_sat_Equal (e : seq F) (t1 t2 : GRing.term F) : - rcf_sat e (t1 == t2) = (GRing.eval e t1 == GRing.eval e t2). -Proof. by apply/rcf_satP/idP => h; apply/eqP. Qed. - -Fact rcf_sat_Lt (e : seq F) (t1 t2 : GRing.term F) : - rcf_sat e (t1 <% t2) = (GRing.eval e t1 < GRing.eval e t2). -Proof. by apply/rcf_satP/idP. Qed. - -Fact rcf_sat_Le (e : seq F) (t1 t2 : GRing.term F) : - rcf_sat e (t1 <=% t2) = (GRing.eval e t1 <= GRing.eval e t2). -Proof. by apply/rcf_satP/idP. Qed. - -Fact rcf_sat_Unit (e : seq F) (t : GRing.term F) : - rcf_sat e (Unit t) = (GRing.eval e t \is a GRing.unit). -Proof. by apply/rcf_satP/idP. Qed. - -Fact rcf_sat_And (e : seq F) (f g : formula F) : - rcf_sat e (f /\ g) = (rcf_sat e f) && (rcf_sat e g). -Proof. by []. Qed. - -Fact rcf_sat_Or (e : seq F) (f g : formula F) : - rcf_sat e (f \/ g) = (rcf_sat e f) || (rcf_sat e g). -Proof. by []. Qed. - -Fact rcf_sat_Implies (e : seq F) (f g : formula F) : - rcf_sat e (f ==> g) = ((rcf_sat e f) ==> (rcf_sat e g)). -Proof. -by apply/rcf_satP/implyP=> /= hfg; move/rcf_satP=> h; apply/rcf_satP; apply: hfg. -Qed. - -Fact rcf_sat_Not (e : seq F) (f : formula F): rcf_sat e (~ f) = ~~ (rcf_sat e f). -Proof. by []. Qed. - -Lemma holds_Nfv_ex (e : seq F) (i : nat) (f : formula F) : - i \notin formula_fv f -> (holds e ('exists 'X_i, f) <-> holds e f). -Proof. -move=> hi; split => [[x /holds_fsubst holds_ef]| h]. - by move: holds_ef; rewrite fsubst_id. -by exists 0; apply/holds_fsubst; rewrite fsubst_id. -Qed. - -Lemma holds_Nfv_all (e : seq F) (i : nat) (f : formula F) : - i \notin formula_fv f -> (holds e ('forall 'X_i, f) <-> holds e f). -Proof. -move=> hi; split => [|holds_ef x]. - by move/(_ 0)/holds_fsubst; rewrite fsubst_id. -by apply/holds_fsubst; rewrite fsubst_id. -Qed. - -Fact holds_Exists (e : seq F) (i : nat) (f : formula F) : - holds e f -> holds e ('exists 'X_i, f). -Proof. -move => holds_ef. -have [lt_ie|le_ei] := ltnP i (size e); first by exists e`_i; rewrite set_nth_id. -by exists 0; rewrite set_nth_over //; apply/holds_rcons_zero/holds_cat_nseq. -Qed. - -Definition simp_rcf_sat := (rcf_sat_Bool, rcf_sat_Equal, rcf_sat_Lt, rcf_sat_Le, - rcf_sat_Unit, rcf_sat_And, rcf_sat_Or, - rcf_sat_Implies, rcf_sat_Not). - -Lemma rcf_sat_cat_nseq (i : nat) (e : seq F) (f : formula F) : - rcf_sat (e ++ nseq i 0) f = rcf_sat e f. -Proof. -apply/rcf_satP/rcf_satP; first by move/holds_cat_nseq. -by move=> h; apply/holds_cat_nseq. -Qed. - -Lemma eval_fv (t : GRing.term F) (e : seq F): - term_fv t = fset0 -> GRing.eval e t = GRing.eval [::] t. -Proof. -move/eqP; move=> h; elim/last_ind: e => //. -move=> s x <-; move: h; elim: t => //=. -- by move=> i; rewrite neq_fset10. -- move=> t1 h1 t2 h2. - rewrite /= fsetU_eq0 => /andP [ht1 ht2]. - by rewrite h1 // h2. -- by move=> t /= ih h; rewrite ih. -- by move=> t1 h1 t2 h2; rewrite h1. -- move=> t1 h1 t2 h2. - rewrite fsetU_eq0 => /andP [ht1 ht2]. - by rewrite h1 // h2. -- by move=> t ih h; rewrite ih. -- by move=> t ih i h; rewrite ih. -Qed. - -Lemma nfsetE (i j : nat) : (i \in mnfset O j) = (i < j)%N. -Proof. -move: i; elim: j => [|j ih] i; first by rewrite ltn0 seq_fsetE. -case: i => [|i]; first by rewrite ltnS seq_fsetE inE leq0n. -by rewrite seq_fsetE inE mem_iota. -Qed. - -Lemma mnfsetE (k i j : nat) : (k \in mnfset i j) = (i <= k < i + j)%N. -Proof. by rewrite seq_fsetE mem_iota. Qed. - -Lemma card_mnfset (i j : nat) : #|` (mnfset i j)| = j. -Proof. by rewrite size_seq_fset undup_id ?iota_uniq // size_iota. Qed. - -Lemma mnfset_triangle (i j k : nat) : - mnfset i (j + k) = mnfset i j `|` mnfset (i + j) k. -Proof. -by apply/eqP/fset_eqP => x; rewrite in_fsetU !seq_fsetE iotaD mem_cat. -Qed. - -Lemma mnfset_nSn (i j : nat) : mnfset i j.+1 = mnfset i j `|` [fset (i + j)%N]. -Proof. -apply/eqP/fset_eqP => x; rewrite in_fsetU !seq_fsetE -addn1 iotaD mem_cat. -by rewrite in_fset1 mem_seq1. -Qed. - -Lemma mnfsetU (i j k l : nat) : -let a := minn i k in -(i <= k + l -> k <= i + j -> - mnfset i j `|` mnfset k l = mnfset a ((maxn (i + j) (k + l)) - a))%N. -Proof. -move=> a h1 h2. -apply/eqP/fset_eqP => x. -rewrite in_fsetU !seq_fsetE !mem_iota subnKC; last first. - by rewrite leq_max (leq_trans (geq_minr _ _)). -rewrite geq_min leq_max orb_andl. -have [lt_xi|leq_ix] := ltnP x i => //=. - by rewrite (leq_trans lt_xi) //; case (_ <= _)%N. -have [small_x|big_x] := ltnP x (i+j) => //=. -by rewrite (leq_trans h2). -Qed. - -Lemma mnfset_bigop (a b : nat) : - \bigcup_(i in 'I_b) ([fset (a + (nat_of_ord i))%N]) = mnfset a b. -Proof. -apply/eqP/fset_eqP => i; rewrite seq_fsetE /= mem_iota; apply/bigfcupP/idP. - move=> [j hj]; rewrite in_fset1 => /eqP ->. - by rewrite leq_addr /= ltn_add2l. -rewrite addnC; move/andP => [leq_ai]. -rewrite -{1}(@subnK a i) // ltn_add2r => h; exists (Ordinal h). - by rewrite mem_index_enum. -by rewrite in_fset1 addnC subnK. -Qed. - -Lemma eq_mem_nil (T : eqType) (s : seq T) : reflect (s =i [::]) (s == [::]). -Proof. -apply: (iffP idP); first by move/eqP ->. -move=> h; apply/eqP/nilP; rewrite /nilp -all_pred0. -by apply/allP => /= x; rewrite h. -Qed. +Section Ngraph. +Variable (n : nat) (F : Type). -Lemma eq_mem_sym (T : Type) (p1 p2 :mem_pred T) : p1 =i p2 -> p2 =i p1. -Proof. by move=> h x; rewrite h. Qed. +Definition ngraph (m : nat) (x : 'rV[F]_m) := [tuple x ord0 i | i < m]. -Lemma eq_iotar (a c b d : nat) : iota a b =i iota c d -> b = d. +Definition ngraph_tnth k (t : k.-tuple F) : + ngraph (\row_(i < k) (tnth t i)) = t. Proof. -move=> eq_ab_cd; rewrite -(size_iota a b) -(size_iota c d). -by apply/eqP; rewrite -uniq_size_uniq ?iota_uniq. +apply/val_inj; rewrite /= -map_tnth_enum; apply/eq_map => i. +by rewrite mxE. Qed. -Lemma eq_iotal (b d a c : nat) : b != O -> iota a b =i iota c d -> a = c. +Definition ngraph_nth k (x : F) (t : k.-tuple F) : + ngraph (\row_(i < k) (nth x t i)) = t. Proof. -case: b => // b _; case: d => [/eq_mem_nil//|d eq_ab_cd]. -wlog suff hwlog : b d a c eq_ab_cd / (a <= c)%N. - by apply/eqP; rewrite eqn_leq (hwlog b d) ?(hwlog d b). -have := eq_ab_cd c; rewrite !in_cons eqxx /= mem_iota. -by case: ltngtP => [| /ltnW leq_ac|->]. +rewrite -{2}[t]ngraph_tnth; congr ngraph; apply/rowP => i. +by rewrite !mxE -tnth_nth. Qed. -Arguments eq_iotal {_} _ {_ _} _ _. +Lemma nth_ngraph k x0 (t : 'rV[F]_k) (i : 'I_k) : + nth x0 (ngraph t) i = t ord0 i. +Proof. by rewrite -tnth_nth tnth_map tnth_ord_tuple. Qed. -Lemma eq_mnfsetr (a c b d : nat) : mnfset a b = mnfset c d -> b = d. -Proof. -move=> eq_ab_cd; apply: (@eq_iotar a c) => i. -by have /fsetP /(_ i) := eq_ab_cd; rewrite !seq_fsetE. -Qed. +Lemma ngraph_nil (t : 'rV[F]_0) : ngraph t = [tuple of nil]. +Proof. by apply/eq_from_tnth => - []. Qed. -Lemma eq_mnfsetl (b d a c: nat) : b != O -> mnfset a b = mnfset c d -> a = c. -Proof. -move=> b_neq0 eq_ab_cd; apply: (@eq_iotal b d) => // i. -by have /fsetP /(_ i) := eq_ab_cd; rewrite !seq_fsetE. -Qed. +Fact size_ngraph (m : nat) (t : 'rV[F]_m) : size (ngraph t) = m. +Proof. by rewrite size_tuple. Qed. -Lemma mnfset_sub (a b c d : nat) : - b != O -> (mnfset a b `<=` mnfset c d) = ((c <= a) && (a + b <= c + d))%N. +Fact cat_ffunE (x0 : F) (m : nat) (t : 'rV[F]_m) (p : nat) + (u : 'rV[F]_p) (i : 'I_(m + p)) : + (row_mx t u) ord0 i + = if (i < m)%N then nth x0 (ngraph t) i else nth x0 (ngraph u) (i - m). Proof. -case: b => // b _; case: d. -- rewrite addn0; apply/idP/idP. - + by move/fsubsetP/(_ a); rewrite !seq_fsetE in_fset0 inE eqxx; move/implyP. - + move=> /andP [leq_ca leq__c]. - by move: (leq_trans leq__c leq_ca); rewrite leqNgt addnS ltnS /= leq_addr. -- move=> d; apply/fsubsetP/idP; last first. - + move/andP=> [leq_ca leq_bd] x; rewrite !mnfsetE; move/andP => [leq_ax lt_xb]. - by rewrite (leq_trans leq_ca) // (leq_trans lt_xb). - + move=> h. - apply/andP; split; - [move/(_ a) : h | move/(_ (a + b)%N) : h]; rewrite !mnfsetE. - - rewrite leqnn addnS ltnS leq_addr; move/implyP. - by rewrite implyTb => /andP []. - - rewrite /= addnS ltnS leq_addr leqnn. - by move/implyP; rewrite andbT => /andP []. +by rewrite mxE; case: splitP => j ->; rewrite ?(addnC, addnK) nth_ngraph. Qed. -Lemma m0fset (m : nat) : mnfset m 0 = fset0. -Proof. by apply/fsetP=> i; rewrite seq_fsetE in_fset0. Qed. - -Lemma mnfset_eq (a b c d : nat) : - b != O -> (mnfset a b == mnfset c d) = ((a == c) && (b == d)). +Fact ngraph_cat (m : nat) (t : 'rV[F]_m) (p : nat) (u : 'rV[F]_p) : + ngraph (row_mx t u) = ngraph t ++ ngraph u :> seq F. Proof. -move: b d => [|b] [|d] // _. - by rewrite andbF; apply/eqP=>/fsetP/(_ a); rewrite !seq_fsetE !inE eqxx. -rewrite eqEfsubset !mnfset_sub // andbACA -!eqn_leq eq_sym. -by have [->|//] := altP (a =P c); rewrite eqn_add2l. +case: m t => [|m] t. + by rewrite row_thin_mx ngraph_nil. +apply: (@eq_from_nth _ (t ord0 ord0)) => [|i]. + by rewrite size_cat ?size_ngraph. +rewrite size_ngraph=> lt_i_mp; rewrite nth_cat. +have -> : i = nat_of_ord (Ordinal lt_i_mp) by []. +by rewrite nth_ngraph (cat_ffunE (t ord0 ord0)) size_ngraph. Qed. -Lemma seq_fset_nil (K : choiceType) (k : unit) : seq_fset k [::] = (@fset0 K). -Proof. by apply/eqP; rewrite -cardfs_eq0 size_seq_fset. Qed. - -Lemma seq_fset_cons (K : choiceType) (k : unit) (a : K) (s : seq K) : - seq_fset k (a :: s) = a |` (seq_fset k s). -Proof. by apply/fsetP => x; rewrite !in_fsetE !seq_fsetE inE. Qed. - -Lemma seq_fset_cat (K : choiceType) (k : unit) (s1 s2 : seq K) : - seq_fset k (s1 ++ s2) = (seq_fset k s1) `|` (seq_fset k s2). +Lemma ngraph_bij k : bijective (@ngraph k). Proof. -elim: s1 s2 => [s1|a s1 ih s2]; first by rewrite seq_fset_nil fset0U. -by rewrite /= !seq_fset_cons ih fsetUA. +exists (fun (x : k.-tuple F) => (\row_(i < k) (tnth x i))) => x. + by apply/rowP => i; rewrite mxE tnth_mktuple. +by rewrite ngraph_tnth. Qed. -Lemma formula_fv_nforall (n k : nat) (f : formula F) : - (formula_fv (nquantify n k Forall f)) = (formula_fv f) `\` (mnfset n k). +Lemma take_ngraph m (x : 'rV[F]_(n + m)) : + take n (ngraph x) = ngraph (lsubmx x). Proof. -elim: k => [|k h] in f *. -by rewrite nquantify0 seq_fset_nil fsetD0. -rewrite nquantSin h fsetDDl fsetUC -addn1 iotaD seq_fset_cat. -by rewrite seq_fset_cons seq_fset_nil fsetU0. +move: (lsubmx x) (rsubmx x) (hsubmxK x) => l r <- {x}. +by rewrite ngraph_cat take_cat size_ngraph ltnn subnn take0 cats0. Qed. -Lemma formula_fv_nexists (n k : nat) (f : formula F) : - (formula_fv (nquantify n k Exists f)) = (formula_fv f) `\` (mnfset n k). +Lemma drop_ngraph m (x : 'rV[F]_(n + m)) : + drop n (ngraph x) = ngraph (rsubmx x). Proof. -elim: k => [|k h] in f *. -by rewrite nquantify0 seq_fset_nil fsetD0. -rewrite nquantSin h fsetDDl fsetUC -addn1 iotaD seq_fset_cat. -by rewrite seq_fset_cons seq_fset_nil fsetU0. +move: (lsubmx x) (rsubmx x) (hsubmxK x) => l r <- {x}. +by rewrite ngraph_cat drop_cat size_ngraph ltnn subnn drop0. Qed. -Lemma formula_fv_bigAnd (I : Type) (r : seq I) (P : pred I) - (E : I -> formula F) : -formula_fv (\big[And/True%oT]_(i <- r | P i) (E i)) = -\bigcup_(i <- r | P i) (formula_fv (E i)). -Proof. exact: big_morph. Qed. - -Lemma formula_fv_bigOr (I : Type) (r : seq I) (P : pred I) (E : I -> formula F) : -formula_fv (\big[Or/False%oT]_(i <- r | P i) (E i)) = -\bigcup_(i <- r | P i) (formula_fv (E i)). -Proof. exact: big_morph. Qed. - -Lemma formula_fv_bigU (a : nat) (E : 'I_a -> formula F) : -formula_fv (\big[And/True%oT]_(i < a) (E i)) = -\bigcup_(i in 'I_a) (formula_fv (E i)). -Proof. exact: big_morph. Qed. - -Definition is_independent (i : nat) (f : formula F) := -forall (e : seq F), holds e ('forall 'X_i, f) <-> holds e f. - -Lemma independent (f : formula F) (i : nat) : - i \notin (formula_fv f) -> is_independent i f. -Proof. by rewrite /is_independent; case: f => *; apply: holds_Nfv_all. Qed. +End Ngraph. Section Var_n. +Variable F : rcfType. Variable n : nat. (* We define a relation in formulae *) Definition equivf (f g : formula F) := -rcf_sat [::] (nquantify O n Forall ((f ==> g) /\ (g ==> f))). + rcf_sat [::] (nquantify O n Forall ((f ==> g) /\ (g ==> f))). Lemma equivf_refl : reflexive equivf. Proof. by move=> f; apply/rcf_satP; apply: nforall_is_true => e /=. Qed. -Lemma equivf_sym : symmetric equivf. +Lemma equivf_sym : ssrbool.symmetric equivf. Proof. move=> f g; rewrite /equivf; move: [::] => e. move: O => i; move: (f ==> g)%oT (g ==> f)%oT => f' g' {f} {g}. @@ -717,7 +157,7 @@ move: i e; elim: n=> [i e | n' iHn' i e]. by rewrite !nquantify0; apply/rcf_satP/rcf_satP => [[fg gf] | [gf fg]]; split. rewrite !nquantSout /=. apply/rcf_satP/rcf_satP => /= [h x | h x]; - move/(_ x)/rcf_satP : h => h; apply/rcf_satP. + move/(_ x)/rcf_satP : h => h; apply/rcf_satP. + by rewrite -iHn'. + by rewrite iHn'. Qed. @@ -762,258 +202,37 @@ HB.instance Definition Aset_of_eqType := Equality.on {SAset}. HB.instance Definition Aset_of_choiceType := Choice.on {SAset}. HB.instance Definition Aset_of_eqQuotType := EqQuotient.on {SAset}. -Lemma fsubset_formulan_fv (f : {formula_n F}) : formula_fv f `<=` mnfset O n. -Proof. by move: f => [f hf]. Qed. - End Var_n. -End RealClosedFieldFormula. Notation "{ 'SAset' F }" := (SAtype_of (Phant F)) : type_scope. -Section SemiAlgebraicSet. - -Variable F : rcfType. (* is also a realDomainType *) - -Lemma formula_fv0 (f : {formula_0 F}) : formula_fv f = fset0. -Proof. -by apply/eqP; move: (fsubset_formulan_fv f); rewrite -fsubset0 seq_fset_nil. -Qed. - -Lemma in_fv_formulan (n : nat) (f : {formula_n F}) (i : nat) : - i \in formula_fv f -> (i < n)%N. -Proof. -by rewrite -nfsetE; move/fsubsetP => -> //; rewrite fsubset_formulan_fv. -Qed. - -Lemma nvar_formulan (n : nat) (f : {formula_n F}) : nvar n f. -Proof. by move: f => [f hf]. Qed. - Section Interpretation. -Lemma set_nth_rcons (i : nat) (e : seq F) (x y : F) : - (i < size e)%N -> set_nth 0 (rcons e y) i x = rcons (set_nth 0 e i x) y. -Proof. -move: i x y; elim: e => //. -move=> a e ihe i; elim: i => //. -move=> i ihi x y /=. -by rewrite ltnS => lt_ie; rewrite ihe. -Qed. - -Fact fv_nforall (m n i : nat) (f : formula F) : - (m <= i < m+n)%N -> i \notin formula_fv (nquantify m n Forall f). -Proof. -move=> Hi. -rewrite formula_fv_nforall in_fsetD negb_and negbK mnfsetE. -by apply/orP; left. -Qed. - -Fact fv_nexists (m n i : nat) (f : formula F) : - (m <= i < m+n)%N -> i \notin formula_fv (nquantify m n Exists f). -Proof. -move=> Hi. -rewrite formula_fv_nexists in_fsetD negb_and negbK mnfsetE. -by apply/orP; left. -Qed. +Variable F : rcfType. (* is also a realDomainType *) Variable n : nat. -Definition ngraph (x : 'rV[F]_n) := [tuple x ord0 i | i < n]. - Definition interp := fun (f : {formula_n F}) => - [pred v : 'rV[F]_n | rcf_sat (ngraph v) f]. + [pred v : 'rV[F]_n | rcf_sat (ngraph v) f]. Definition pred_of_SAset (s : {SAset F^n}) : - pred ('rV[F]_n) := interp (repr s). + pred ('rV[F]_n) := interp (repr s). Canonical SAsetPredType := PredType pred_of_SAset. End Interpretation. -End SemiAlgebraicSet. -Section SemiAlgebraicSet2. +Section SemiAlgebraicSet. Variable F : rcfType. - -Lemma cat_ffun_id (n m : nat) (f : 'rV[F]_(n + m)) : - row_mx (\row_(i < n) (f ord0 (lshift _ i))) - (\row_(j < m) (f ord0 (rshift _ j))) = f. -Proof. -apply/rowP => i; rewrite mxE. -case: splitP=> [] j /esym eq_i; rewrite mxE; -by congr (f _); apply/val_inj/eq_i. -Qed. - -Section Interpretation2. - -Variable n : nat. - -(* recover {formulan} structure on formula *) - -Lemma and_formulan (f1 f2 : {formula_n F}) : nvar n (f1 /\ f2)%oT. -Proof. by rewrite /nvar fsubUset !fsubset_formulan_fv. Qed. - -Canonical Structure formulan_and (f1 f2 : {formula_n F}) - := MkFormulan (and_formulan f1 f2). - -Lemma implies_formulan (f1 f2 : {formula_n F}) : nvar n (f1 ==> f2)%oT. -Proof. by rewrite /nvar fsubUset !fsubset_formulan_fv. Qed. - -Canonical Structure formulan_implies (f1 f2 : {formula_n F}) := - MkFormulan (implies_formulan f1 f2). - -Lemma bool_formulan (b : bool) : @nvar F n (Bool b). -Proof. by rewrite /nvar fsub0set. Qed. - -Canonical Structure formulan_bool (b : bool) := MkFormulan (bool_formulan b). - -Lemma or_formulan (f1 f2 : {formula_n F}) : nvar n (f1 \/ f2)%oT. -Proof. by rewrite /nvar fsubUset !fsubset_formulan_fv. Qed. - -Canonical Structure formulan_or (f1 f2 : {formula_n F}) := - MkFormulan (or_formulan f1 f2). - -Lemma not_formulan (f : {formula_n F}) : nvar n (~ f)%oT. -Proof. by rewrite /nvar fsubset_formulan_fv. Qed. - -Canonical Structure formulan_not (f : {formula_n F}) := - MkFormulan (not_formulan f). - -Lemma exists_formulan (i : nat) (f : {formula_n F}) : - nvar n ('exists 'X_i, f)%oT. -Proof. -by rewrite /nvar (fsubset_trans (@fsubD1set _ _ _)) // fsubset_formulan_fv. -Qed. - -Canonical Structure formulan_exists (i : nat) (f : {formula_n F}) - := MkFormulan (exists_formulan i f). - -Lemma forall_formulan (i : nat) (f : {formula_n F}) : nvar n ('forall 'X_i, f)%oT. -Proof. -by rewrite /nvar (fsubset_trans (@fsubD1set _ _ _)) // fsubset_formulan_fv. -Qed. - -Canonical Structure formulan_forall (i : nat) (f : {formula_n F}) - := MkFormulan (forall_formulan i f). - -Lemma eq_fsetD (K : choiceType) (A B C : finSet K) : - (A `\` B == C) = fdisjoint C B && ((C `<=` A) && (A `<=` B `|` C)). -Proof. by rewrite eqEfsubset fsubDset fsubsetD andbCA andbA andbC. Qed. - -Lemma fset1D1 (K : choiceType) (a' a : K) : - [fset a] `\ a' = if (a' == a) then fset0 else [fset a]. -Proof. -apply/fsetP=> b; rewrite 2!fun_if !in_fsetE; have [->|] := altP (a' =P a). - exact/andNb. -by have [//->|]// := altP (b =P a); rewrite ?andbF // eq_sym => ->. -Qed. - -Lemma term_fv_tsubst (i : nat) (x : F) (t : GRing.term F) : - term_fv (GRing.tsubst t (i, (x%:T)%oT)) = (term_fv t) `\ i. -Proof. -elim: t => //=; rewrite ?fset0D //; - do ?by move=> t1 h1 t2 h2; rewrite fsetDUl ![in LHS](h1, h2). -move=> j; have [->| /negbTE neq_ij] := eqVneq j i. - by rewrite fsetDv. -by rewrite fset1D1 eq_sym neq_ij. -Qed. - -Lemma formula_fv_fsubst (i : nat) (x : F) (f : formula F) : - formula_fv (fsubst f (i, (x%:T)%oT)) = (formula_fv f) `\ i. -Proof. -elim: f. -+ by move=> b; rewrite fset0D. -+ by move=> t1 t2 /=; rewrite !term_fv_tsubst fsetDUl. -+ by move=> t1 t2 /=; rewrite !term_fv_tsubst fsetDUl. -+ by move=> t1 t2 /=; rewrite !term_fv_tsubst fsetDUl. -+ by move=> t /=; rewrite !term_fv_tsubst. -+ by move=> f1 h1 f2 h2 /=; rewrite fsetDUl h1 h2. -+ by move=> f1 h1 f2 h2 /=; rewrite fsetDUl h1 h2. -+ by move=> f1 h1 f2 h2 /=; rewrite fsetDUl h1 h2. -+ by move=> f hf. -+ move=> j f /= hf; rewrite fun_if hf. - have [->| /negbTE neq_ij] := eqVneq j i. - by rewrite fsetDDl //= fsetUid. - by rewrite !fsetDDl fsetUC. -+ move=> j f h /=. - rewrite fun_if h. - have [->| /negbTE neq_ij] := eqVneq j i. - by rewrite fsetDDl //= fsetUid. - by rewrite !fsetDDl fsetUC. -Qed. - -Lemma fsubst_formulan (i : nat) (x : F) (f : {formula_n F}) : - nvar n (fsubst f (i, (x%:T)%oT))%oT. -Proof. -rewrite /nvar formula_fv_fsubst. -by rewrite (fsubset_trans (@fsubD1set _ _ _)) // fsubset_formulan_fv. -Qed. - -Canonical Structure formulan_fsubst (i : nat) (x : F) (f : {formula_n F}) := - MkFormulan (fsubst_formulan i x f). - -End Interpretation2. - -Lemma holds_take (n : nat) (f : {formula_n F}) (e : seq F) : - holds (take n e) f <-> holds e f. -Proof. -move: n f; elim/last_ind : e => // e x iHe n' f. -rewrite -{2}(@rcons_set_nth _ _ 0) take_rcons. -have [lt_en'|leq_n'e] := ltnP (size e) n'. - by rewrite take_oversize ?rcons_set_nth // ltnW. -apply: (iff_trans _ (@holds_fsubst _ _ _ _ _)). -apply: (iff_trans _ (@iHe _ _ )) => /=. -by rewrite fsubst_id // (contra (@in_fv_formulan _ _ _ _)) // -leqNgt . -Qed. - Variable n : nat. -Definition same_row_env (e1 e2 : seq F) := - \row_(i < n) e1`_(val i) =2 (\row_(i < n) e2`_(val i) : 'rV[F]_n). - -Lemma eqn_holds e1 e2 (f : {formula_n F}) : - same_row_env e1 e2 -> holds e1 f -> holds e2 f. -Proof. -rewrite /same_row_env => h; move/holds_take => h'. -apply/holds_take; apply: (eq_holds _ h') => i. -have [lt_in | leq_ni] := ltnP i n; last first. - by rewrite ? nth_default ?size_take // ?(leq_trans (geq_minl _ _)). -rewrite !nth_take //. -by move/(_ ord0 (Ordinal lt_in)) : h; rewrite !mxE. -Qed. - -Fact closed_nforall_formulan (f : {formula_n F}) : - formula_fv (nquantify O n Forall f) == fset0. -Proof. by rewrite formula_fv_nforall fsetD_eq0 fsubset_formulan_fv. Qed. - -Fact closed_nexists_formulan (f : {formula_n F}) : - formula_fv (nquantify O n Exists f) == fset0. -Proof. by rewrite formula_fv_nexists fsetD_eq0 fsubset_formulan_fv. Qed. - -Lemma set_nthP (x : n.-tuple F) (i : 'I_n) (y : F) : - size (set_nth 0 x i y) == n. -Proof. by rewrite size_set_nth size_tuple; apply/eqP/maxn_idPr. Qed. - -Canonical set_nth_tuple (x : n.-tuple F) (i : 'I_n) (y : F) := - Tuple (set_nthP x i y). - -Definition ngraph_tnth k (t : k.-tuple F) : - ngraph (\row_(i < k) (nth 0 t i)) = t. -Proof. -apply/val_inj; rewrite /= -map_tnth_enum; apply/eq_map => i. -rewrite mxE (tnth_nth 0) /=. -move: t i; case: k => [| k t i]; first by move=> [t h [i hi]]. -rewrite (@nth_map 'I_k.+1 ord0 F 0 - (fun (j : 'I_k.+1) => (tnth t j)) i (enum 'I_k.+1)); last first. - by rewrite size_enum_ord. -by rewrite (tnth_nth 0) (@nth_enum_ord k.+1 ord0 i). -Qed. - Fact rcf_sat_tuple (t : n.-tuple F) (f : {formula_n F}) : - rcf_sat t f = ((\row_(i < n) (nth 0 t i)) \in - [pred y : 'rV[F]_n | rcf_sat (ngraph (\row_(i < n) (nth 0 t i))) f]). + rcf_sat t f = ((\row_(i < n) (tnth t i)) \in + [pred y : 'rV[F]_n | rcf_sat (ngraph (\row_(i < n) (tnth t i))) f]). Proof. by rewrite inE ngraph_tnth. Qed. Fact holds_tuple (t : n.-tuple F) (s : {SAset F^n}) : - reflect (holds t s) ((\row_(i < n) (nth 0 t i)) \in s). + reflect (holds t s) ((\row_(i < n) (tnth t i)) \in s). Proof. apply: (iffP idP) => [h | ]. by apply/rcf_satP; rewrite rcf_sat_tuple. @@ -1021,51 +240,51 @@ by move/rcf_satP; rewrite rcf_sat_tuple. Qed. Lemma holds_equivf (t : n.-tuple F) (f g : {formula_n F}) : - sub_equivf f g -> holds t f -> holds t g. + sub_equivf f g -> holds t f -> holds t g. Proof. by move/rcf_satP/nforallP; move/(_ t) => [h _]. Qed. Lemma rcf_sat_equivf (t : n.-tuple F) (f g : {formula_n F}) : - sub_equivf f g -> rcf_sat t f = rcf_sat t g. + sub_equivf f g -> rcf_sat t f = rcf_sat t g. Proof. move=> h; apply/rcf_satP/rcf_satP; apply: holds_equivf => //. by rewrite /sub_equivf /= equivf_sym. Qed. Fact rcf_sat_repr_pi (t : n.-tuple F) (f : {formula_n F}) : - rcf_sat t (repr (\pi_{SAset F^n} f)) = rcf_sat t f. + rcf_sat t (repr (\pi_{SAset F^n} f)) = rcf_sat t f. Proof. by case: piP => ? /eqmodP /rcf_sat_equivf ->. Qed. Fact holds_repr_pi (t : n.-tuple F) (f : {formula_n F}) : - holds t (repr (\pi_{SAset F^n} f)) <-> holds t f. + holds t (repr (\pi_{SAset F^n} f)) <-> holds t f. Proof. by split; apply: holds_equivf; rewrite /sub_equivf -eqmodE reprK. Qed. Lemma equivf_exists (f g : {formula_n F}) (i : nat) : - equivf n f g -> (equivf n ('exists 'X_i, f) ('exists 'X_i, g))%oT. + equivf n f g -> (equivf n ('exists 'X_i, f) ('exists 'X_i, g))%oT. Proof. rewrite /equivf; move/rcf_satP/nforallP => h. apply/rcf_satP/nforallP => u /=. -have [lt_in|leq_ni] := ltnP i n; last first. -+ split=> [[x]|]. - - move/holds_fsubst. - rewrite fsubst_id; last - by rewrite (contra (@in_fv_formulan _ _ _ _)) // -leqNgt. - move=> holds_uf; exists x; apply/holds_fsubst. - rewrite fsubst_id; last - by rewrite (contra (@in_fv_formulan _ _ _ _)) // -leqNgt. - by move: holds_uf; move/(_ u) : h; rewrite cat0s /=; move => []. - - move=> [x]; rewrite set_nth_over ?size_tuple // rcons_cat /=. - move/holds_take; rewrite take_size_cat ?size_tuple // => holds_ug. - exists 0; rewrite set_nth_nrcons ?size_tuple // rcons_nrcons -nseq_cat. - by apply/holds_cat_nseq; move: holds_ug; move/(_ u) : h => []. -+ split. - - move=> [x hxf]; exists x; move: hxf. - move/(_ [tuple of (set_nth 0 u (Ordinal lt_in) x)]) : h. - by rewrite cat0s /=; move=> []. - - move=> [x hxf]; exists x; move: hxf. - move/(_ [tuple of (set_nth 0 u (Ordinal lt_in) x)]) : h. - by rewrite cat0s /=; move=> []. +have [lt_in|leq_ni] := ltnP i n. + by split=> -[x hxf]; exists x; move: hxf; + move/(_ [tuple of (set_nth 0 u (Ordinal lt_in) x)]) : h; + rewrite cat0s /= => -[]. +split=> -[x]. + rewrite set_nth_over ?size_tuple // rcons_cat /=. + move/holds_take; rewrite take_size_cat ?size_tuple // => holds_ug. + exists 0; rewrite set_nth_nrcons ?size_tuple // rcons_nrcons -nseq_cat. + by apply/holds_cat_nseq; move: holds_ug; move/(_ u) : h => []. +move/holds_fsubst. +rewrite fsubst_id; last + by rewrite (contra (@in_fv_formulan _ _ _ _)) // -leqNgt. +move=> holds_uf; exists x; apply/holds_fsubst. +rewrite fsubst_id; last + by rewrite (contra (@in_fv_formulan _ _ _ _)) // -leqNgt. +by move: holds_uf; move/(_ u) : h; rewrite cat0s /=; move => []. Qed. +Lemma pi_form (f : {formula_n F}) (x : 'rV[F]_n) : + (x \in \pi_{SAset F^n} f) = rcf_sat (ngraph x) f. +Proof. by rewrite inE; apply/rcf_satP/rcf_satP => ?; apply/holds_repr_pi. Qed. + Lemma SAsetP (s1 s2 : {SAset F^n}) : reflect (s1 =i s2) (s1 == s2). Proof. move: s1 s2; apply: quotW => f1; apply: quotW => f2. @@ -1075,987 +294,787 @@ split; move/holds_repr_pi/holds_tuple; [rewrite h | rewrite -h]; by move/holds_tuple/holds_repr_pi. Qed. -End SemiAlgebraicSet2. +End SemiAlgebraicSet. + +Section Comprehension. -Section Projection. +Variables (F : rcfType) (n : nat) (f : formula F). -Variables (F : rcfType) (n : nat) (i : 'I_n). +(* TODO: remove the useless cut. *) +Definition SAset_comprehension := \pi_({SAset F^n}) (cut n f). -Fact ex_proj_proof (f : {formula_n F}) : nvar n ('exists 'X_i, f)%oT. +Lemma SAin_setP x : reflect (holds (ngraph x) f) (x \in SAset_comprehension). Proof. -by rewrite /nvar (fsubset_trans (@fsubD1set _ _ _)) // fsubset_formulan_fv. +apply/(iffP (rcf_satP _ _)) => [/holds_repr_pi/holds_subst|hf]. + by rewrite -{1}[ngraph x : seq _]cats0 subst_env_iota_catl ?size_ngraph. +apply/holds_repr_pi/holds_subst. +by rewrite -[ngraph x : seq _]cats0 subst_env_iota_catl ?size_ngraph. Qed. -Definition ex_proj (f : {formula_n F}) := MkFormulan (ex_proj_proof f). +End Comprehension. -Definition SA_ex_proj := (lift_op1 {SAset F^n} ex_proj). +Notation "[ 'set' : T | f ]" := ((@SAset_comprehension _ _ (f)%oT) : T) + (at level 0, only parsing) : sa_scope. +Notation "[ 'set' | f ]" := (@SAset_comprehension _ _ (f)%oT) + (at level 0, f at level 99, format "[ 'set' | f ]") : sa_scope. -Lemma ex_proj_idem (s : {SAset F^n}) : - SA_ex_proj (SA_ex_proj s) = SA_ex_proj s. -Proof. -move: s; apply: quotP => f eq_repr_pi_f. -rewrite /SA_ex_proj; unlock. -apply/eqP; rewrite eqmodE eq_repr_pi_f. -apply/rcf_satP/nforallP => u. -rewrite cat0s; split. -+ move=> [y hxy]; move/holds_repr_pi : hxy => [x hxy]. - by exists x; move: hxy; rewrite set_set_nth eqxx. -+ move=> [y hxy]; exists y; apply/holds_repr_pi. - by exists y; rewrite set_set_nth eqxx. -Qed. - -Fact all_proj_proof (f : {formula_n F}) : nvar n ('forall 'X_i, f)%oT. -Proof. -by rewrite /nvar (fsubset_trans (@fsubD1set _ _ _)) // fsubset_formulan_fv. -Qed. +Section Ops. -Definition all_proj (f : {formula_n F}) := MkFormulan (all_proj_proof f). +Variables (F : rcfType) (n : nat). -Definition SA_all_proj := (lift_op1 {SAset F^n} all_proj). +Definition SAset_seq (r : seq 'rV[F]_n) : {SAset F^n} := + [set | \big[Or/False]_(x <- r) + \big[And/True]_(i < n) ('X_i == (x ord0 i)%:T)%oT ]. -Lemma all_proj_idem (s : {SAset F^n}) : - SA_all_proj (SA_all_proj s) = (SA_all_proj s). +Lemma inSAset_seq r x : x \in SAset_seq r = (x \in r). Proof. -move : s; apply : quotP => f hf. -rewrite /SA_all_proj; unlock. -apply/eqP; rewrite eqmodE hf. -apply/rcf_satP/nforallP => u; rewrite cat0s. -split=> h x. -+ by move/(_ x)/holds_repr_pi/(_ x) : h; rewrite set_set_nth eqxx. -+ apply/holds_repr_pi => y; rewrite set_set_nth eqxx. - by move/(_ y) : h. +apply/SAin_setP/idP => [/holdsOr [y][+][_] /holdsAnd hy|xr]. + congr in_mem; apply/rowP => i. + move: hy => /(_ i); rewrite mem_index_enum /= (nth_map i) ?size_enum_ord//. + by rewrite nth_ord_enum => ->. +apply/holdsOr; exists x; split=> //; split=> //. +apply/holdsAnd => i _ _ /=. +by rewrite (nth_map i) ?size_enum_ord// nth_ord_enum. Qed. -Fact test_can_and (f g : {formula_n F}) : - formula_fv (nquantify O n Forall (f /\ g)%oT) == fset0. -Proof. exact: closed_nforall_formulan. Qed. - -Fact test_can_imply (f g : {formula_n F}) : - formula_fv (nquantify O n Forall (f ==> g)%oT) == fset0. -Proof. exact: closed_nforall_formulan. Qed. - -Fact test_can_imply_and (f g h : {formula_n F}) : - formula_fv (nquantify O n Forall (f ==> (g /\ h))%oT) == fset0. -Proof. exact: closed_nforall_formulan. Qed. +Definition SAset0 : {SAset F^n} := SAset_seq [::]. -End Projection. +Lemma inSAset0 (x : 'rV[F]_n) : x \in SAset0 = false. +Proof. by rewrite inSAset_seq. Qed. -Section Next. +Lemma inSAset1 (x y : 'rV[F]_n) : x \in SAset_seq [:: y] = (x == y). +Proof. by rewrite inSAset_seq in_cons in_nil orbF. Qed. -Variables (F : rcfType) (n : nat). - -Lemma formulaSn_proof (f : {formula_n F}) : nvar n f. -Proof. by rewrite /nvar fsubset_formulan_fv. Qed. +Definition SAsetT : {SAset F^n} := [set | True%oT ]. -Definition lift_formulan (f : {formula_n F}) := MkFormulan (formulaSn_proof f). +Lemma inSAsetT (x : 'rV[F]_n) : x \in SAsetT. +Proof. exact/SAin_setP. Qed. -Lemma lift_formulan_inj : injective lift_formulan. -Proof. by move=> f1 f2 /(congr1 val) h; apply: val_inj. Qed. +Definition SAsetU (f g : {SAset F^n}) := + \pi_({SAset F^n}) (formulan_or f g). -Lemma SAset0_proof : @nvar F n (Bool false). -Proof. by rewrite /nvar fsub0set. Qed. - -Check MkFormulan SAset0_proof. +Lemma inSAsetU f g x : x \in SAsetU f g = (x \in f) || (x \in g). +Proof. +rewrite /SAsetU pi_form !inE. +by apply/rcf_satP/orP; (case=> [l|r]; [left|right]; apply/rcf_satP). +Qed. -Definition SAset0 := \pi_{SAset F^n} (MkFormulan SAset0_proof). +Definition SAsetU1 x f := SAsetU (SAset_seq [:: x]) f. -Lemma pi_form (f : {formula_n F}) (x : 'rV[F]_n) : - (x \in \pi_{SAset F^n} f) = rcf_sat (ngraph x) f. -Proof. by rewrite inE; apply/rcf_satP/rcf_satP => ?; apply/holds_repr_pi. Qed. +Lemma inSAsetU1 x f y : y \in SAsetU1 x f = (y == x) || (y \in f). +Proof. by rewrite inSAsetU inSAset1. Qed. -Lemma inSAset0 (x : 'rV[F]_n) : (x \in SAset0) = false. -Proof. by rewrite pi_form. Qed. +Definition SAsetI (f g : {SAset F^n}) := + \pi_({SAset F^n}) (formulan_and f g). -Lemma rcf_sat_forall k l (E : 'I_k -> formula F) : - rcf_sat l (\big[And/True%oT]_(i < k) E i) = [forall i, rcf_sat l (E i)]. +Lemma inSAsetI f g x : x \in SAsetI f g = (x \in f) && (x \in g). Proof. -elim: k=> [|k Ihk] in E *. - by rewrite big_ord0 simp_rcf_sat; symmetry; apply/forallP => -[]. -rewrite -(big_andE xpredT) /= !big_ord_recl !simp_rcf_sat. -by rewrite -![qf_eval _ _]/(rcf_sat _ _) Ihk -(big_andE xpredT). +rewrite /SAsetI pi_form !inE. +by apply/rcf_satP/andP => [/=|] [l r]; split; apply/rcf_satP. Qed. -Lemma rcf_sat_forallP k l (E : 'I_k -> formula F) : - rcf_sat l (\big[And/True%oT]_(i < k) E i) = [forall i, rcf_sat l (E i)]. +Definition SAsetC (s : {SAset F^n}) := \pi_{SAset F^n} (formulan_not s). + +Lemma inSAsetC f x : x \in SAsetC f = ~~ (x \in f). Proof. -elim: k=> [|k Ihk] in E *. - by rewrite big_ord0; apply/rcf_satP/forallP; move=> _ // [[ ]]. -rewrite big_ord_recl /=; apply/rcf_satP/forallP => - [[/rcf_satP E0 /rcf_satP Er] i|Eall]. - have [j->|->//] := unliftP ord0 i. - by move: Er; rewrite Ihk; move/forallP/(_ j). -apply/rcf_satP; rewrite simp_rcf_sat Eall Ihk. -by apply/forallP=> x; apply: Eall. +rewrite /SAsetC pi_form !inE. +apply/rcf_satP/negP => /= [hn /rcf_satP//|hn h]. +by apply/hn/rcf_satP. Qed. -Fact nvar_True : @nvar F n True. -Proof. by rewrite /nvar fsub0set. Qed. +Definition SAsetD (s1 s2 : {SAset F^n}) : {SAset F^n} := + SAsetI s1 (SAsetC s2). -Lemma nvar_And (k : nat) (E : 'I_k -> formula F) : - nvar n (\big[And/True%oT]_(i < k) (E i)) = - (\big[andb/true%oT]_(i < k) (nvar n (E i))). -Proof. -rewrite /nvar formula_fv_bigAnd big_andE; apply/bigfcupsP/forallP => //= h i. -by rewrite h // mem_index_enum. -Qed. +Lemma inSAsetD s1 s2 x : x \in SAsetD s1 s2 = (x \in s1) && ~~ (x \in s2). +Proof. by rewrite inSAsetI inSAsetC. Qed. -Definition SAset1_formula (x : 'rV[F]_n) := - \big[And/True%oT]_(i < n) ('X_i == (x ord0 i)%:T)%oT. +Definition SAsetD1 s x := SAsetD s (SAset_seq [:: x]). -Lemma nth_ngraph k x0 (t : 'rV[F]_k) (i : 'I_k) : - nth x0 (ngraph t) i = t ord0 i. -Proof. by rewrite -tnth_nth tnth_map tnth_ord_tuple. Qed. +Lemma inSAsetD1 s x y : y \in SAsetD1 s x = (y \in s) && (y != x). +Proof. by rewrite inSAsetD inSAset1. Qed. + +Definition SAsetX m (s1 : {SAset F^n}) (s2 : {SAset F^m}) : {SAset F^(n + m)} := + [set | s1 /\ subst_formula (iota n m) s2 ]. -Lemma SAset1_formulaP (x y : 'rV[F]_n) : - rcf_sat (ngraph x) (SAset1_formula y) = (x == y). +Lemma inSAsetX m (s1 : {SAset F^n}) (s2 : {SAset F^m}) (x : 'rV[F]_(n + m)) : + x \in SAsetX s1 s2 = (lsubmx x \in s1) && (rsubmx x \in s2). Proof. -rewrite rcf_sat_forallP; apply/forallP/eqP; last first. - by move=> -> i; rewrite simp_rcf_sat /= nth_ngraph. -move=> h; apply/rowP => i; move/(_ i) : h. -by rewrite simp_rcf_sat /= nth_ngraph => /eqP. -Qed. +move: (lsubmx x) (rsubmx x) (hsubmxK x) => l r <- {x}. +apply/SAin_setP/andP => /= -[]; rewrite ngraph_cat. + move=> /holds_take + /holds_subst. + rewrite take_size_cat ?size_ngraph// subst_env_iota_catr ?size_ngraph//. + by split; apply/rcf_satP. +move=> ls rs; split. + by apply/holds_take; rewrite take_size_cat ?size_ngraph//; apply/rcf_satP. +apply/holds_subst; rewrite subst_env_iota_catr ?size_ngraph//. +exact/rcf_satP. +Qed. + +Definition SAset_sub s1 s2 := SAsetD s1 s2 == SAset0. + +Lemma SAset_subP s1 s2 : reflect {subset s1 <= s2} (SAset_sub s1 s2). +Proof. +apply/(iffP idP) => [/SAsetP|] s12; last first. + by apply/SAsetP => x; rewrite inSAsetD inSAset0; apply/negP => /andP[/s12 ->]. +move=> x x1; apply/negP => /negP x2. +suff: x \in SAset0 by rewrite inSAset0. +by rewrite -s12 inSAsetD x1. +Qed. + +Definition SAset_proper s1 s2 := SAset_sub s1 s2 && ~~ SAset_sub s2 s1. + +End Ops. + +Definition SAset_cast (F : rcfType) (n m : nat) (s : {SAset F^n}) : {SAset F^m} := + [set | (\big[And/True]_(i <- iota n (m-n)) ('X_i == 0)) /\ + nquantify m (n-m) Exists s]. + +Notation "[ 'set' x1 ; .. ; xn ]" := + (SAset_seq (cons x1 .. (cons xn nil) .. )): sa_scope. +Notation "A :|: B" := (SAsetU A B) : sa_scope. +Notation "x |: A" := (SAsetU1 x A) : sa_scope. +Notation "A :&: B" := (SAsetI A B) : sa_scope. +Notation "~: A" := (SAsetC A) : sa_scope. +Notation "A :\: B" := (SAsetD A B) : sa_scope. +Notation "A :\ x" := (SAsetD1 A x) : sa_scope. +Notation "A :*: B" := (SAsetX A B) (at level 35) : sa_scope. +Notation "A :<=: B" := (SAset_sub A B) (at level 49) : sa_scope. +Notation "A :<: B" := (SAset_proper A B) (at level 49) : sa_scope. + +Definition SAset_itv (F : rcfType) (I : interval F) := + let 'Interval l u := I in + (match l with + | BSide false lb => [set | lb%:T <% 'X_0] + | BSide true lb => [set | lb%:T <=% 'X_0] + | BInfty false => SAset0 F 1 + | BInfty true => SAsetT F 1 + end) :&: ( + match u with + | BSide false ub => [set | 'X_0 <=% ub%:T] + | BSide true ub => [set | 'X_0 <% ub%:T] + | BInfty false => SAsetT F 1 + | BInfty true => SAset0 F 1 + end). + +Arguments SAset_itv : simpl never. + +Lemma inSAset_itv (F : rcfType) (I : interval F) (x : 'rV[F]_1) : + (x \in SAset_itv I) = (x 0 0 \in I). +Proof. +rewrite in_itv; case: I => l u. +rewrite inSAsetI; congr andb. + case: l => [+ t|]; case=> /=; last first. + - exact/inSAset0. + - exact/inSAsetT. + - by apply/SAin_setP/idP => /=; rewrite enum_ordSl/=. + - by apply/SAin_setP/idP => /=; rewrite enum_ordSl/=. +case: u => [+ t|]; case=> /=; last first. +- exact/inSAsetT. +- exact/inSAset0. +- by apply/SAin_setP/idP => /=; rewrite enum_ordSl/=. +- by apply/SAin_setP/idP => /=; rewrite enum_ordSl/=. +Qed. + +Definition SAset_pos (F : rcfType) : {SAset F^1} := + SAset_itv `]0, +oo[%R. + +Section SAsetTheory. +Variables (F : rcfType) (n : nat). +Implicit Types (A B C : {SAset F^n}) (x y z : 'rV[F]_n) (s t : seq 'rV[F]_n). -Lemma SAset1_proof (x : 'rV[F]_n) : @nvar F n (SAset1_formula x). +Lemma eqEsubset A B : (A == B) = (A :<=: B) && (B :<=: A). Proof. -rewrite /SAset1_formula; elim/big_ind: _; rewrite /nvar. -- exact: fsub0set. -- by move=> ???? /=; apply/fsubUsetP. -- by move=> i /= _; rewrite fsetU0 fsub1set mnfsetE /=. +apply/SAsetP/andP => [AB|[] /SAset_subP AB /SAset_subP BA x]. + by split; apply/SAset_subP => x; rewrite AB. +by apply/idP/idP => [/AB|/BA]. Qed. -Definition SAset1 (x : 'rV[F]_n) : {SAset F^n} := - \pi_{SAset F^n} (MkFormulan (SAset1_proof x)). +Lemma subEproper A B : (A :<=: B) = (A == B) || (A :<: B). +Proof. by rewrite eqEsubset -andb_orr orbN andbT. Qed. -Lemma inSAset1 (x y : 'rV[F]_n) : (x \in SAset1 y) = (x == y). -Proof. by rewrite pi_form SAset1_formulaP. Qed. +Lemma properEneq A B : (A :<: B) = (A != B) && (A :<=: B). +Proof. by rewrite andbC eqEsubset negb_and andb_orr [X in X || _]andbN. Qed. -End Next. +(* lt_def does things the other way. Should we have a fixed convention? *) +Lemma properEneq' A B : (A :<: B) = (B != A) && (A :<=: B). +Proof. by rewrite properEneq eq_sym. Qed. -Section POrder. +Lemma proper_neq A B : A :<: B -> A != B. +Proof. by rewrite properEneq; case/andP. Qed. -Variable F : rcfType. +Lemma eqEproper A B : (A == B) = (A :<=: B) && ~~ (A :<: B). +Proof. by rewrite negb_and negbK andb_orr andbN eqEsubset. Qed. -Variable n : nat. +Lemma sub0set A : SAset0 F n :<=: A. +Proof. by apply/SAset_subP => x; rewrite inSAset0. Qed. -Definition SAsub (s1 s2 : {SAset F^n}) := - rcf_sat [::] (nquantify O n Forall (s1 ==> s2)). +Lemma subset0 A : (A :<=: SAset0 F n) = (A == SAset0 F n). +Proof. by rewrite eqEsubset sub0set andbT. Qed. -Lemma reflexive_SAsub : reflexive SAsub. -Proof. by move=> s; apply/rcf_satP/nforallP => u; rewrite cat0s. Qed. +Lemma proper0 A : (SAset0 F n :<: A) = (A != SAset0 F n). +Proof. by rewrite properEneq sub0set andbT eq_sym. Qed. -Lemma antisymetry_SAsub : antisymmetric SAsub. +Lemma set0Vmem A : (A = SAset0 F n) + {x | x \in A}. Proof. -apply: quotP => f1 _; apply: quotP => f2 _. -move => /andP [/rcf_satP/nforallP sub1 /rcf_satP/nforallP sub2]. -apply/eqP; rewrite eqmodE; apply/rcf_satP/nforallP => u. -split; move/holds_repr_pi=> hf. -+ move/(_ u) : sub1; rewrite cat0s => sub1. - by apply/holds_repr_pi; apply: sub1. -+ by move/(_ u) : sub2 => sub2; apply/holds_repr_pi; apply: sub2. +case/boolP: (A == SAset0 F n) => [/eqP|] A0; first by left. +right; move: A A0; apply: quotW => /= f; rewrite eqmodE /=. +move=> /rcf_satP/n_nforall_formula/nexistsP P. +apply: sigW; move: P => [x hx] /=; exists (\row_(i < n) x`_i). +rewrite inE ngraph_nth rcf_sat_repr_pi. +move/rcf_satP: hx; rewrite cat0s !simp_rcf_sat; case: rcf_sat => //=. +by rewrite implybF negbK big_nil => /rcf_satP/holds_subst. Qed. -Lemma transitive_SAsub : transitive SAsub. +Lemma proper0P A : reflect (exists x, x \in A) (SAset0 F n :<: A). Proof. -apply: quotP => f1 _; apply: quotP => f2 _; apply: quotP => f3 _. -move/rcf_satP/nforallP => sub21; move/rcf_satP/nforallP => sub13. -apply/rcf_satP/nforallP => u. -move/holds_repr_pi => holds_uf2. -by apply: sub13; apply: sub21; apply/holds_repr_pi. +rewrite proper0; have [->|[x xA]] := set0Vmem A. + by rewrite eqxx/=; apply/Bool.ReflectF => -[x]; rewrite inSAset0. +suff ->: (A != SAset0 F n) by apply/Bool.ReflectT; exists x. +by apply/eqP => A0; rewrite A0 inSAset0 in xA. Qed. -Fact SAset_disp : unit. Proof. exact tt. Qed. +Lemma subsetT A : A :<=: SAsetT F n. +Proof. by apply/SAset_subP => x; rewrite inSAsetT. Qed. + +Lemma subTset A : (SAsetT F n :<=: A) = (A == SAsetT F n). +Proof. by rewrite eqEsubset subsetT. Qed. + +Lemma properT A : (A :<: SAsetT F n) = (A != SAsetT F n). +Proof. by rewrite properEneq subsetT andbT. Qed. + +Lemma perm_SAset_seq s t : + perm_eq s t -> SAset_seq s = SAset_seq t. +Proof. +by move=> st; apply/eqP/SAsetP => x; rewrite !inSAset_seq (perm_mem st). +Qed. + +Lemma SAset_nil : SAset_seq [::] = SAset0 F n. +Proof. by []. Qed. -Fact nvar_False : @formula_fv F False `<=` mnfset 0 n. -Proof. by rewrite fsub0set. Qed. +Lemma SAset_cons x s : SAset_seq (x :: s) = x |: SAset_seq s. +Proof. by apply/eqP/SAsetP => y; rewrite inSAsetU1 !inSAset_seq in_cons. Qed. -Definition SAset_bottom := \pi_{SAset F^n} (MkFormulan nvar_False). +Lemma SAset_cat s t : SAset_seq (s ++ t) = SAset_seq s :|: SAset_seq t. +Proof. by apply/eqP/SAsetP => y; rewrite inSAsetU !inSAset_seq mem_cat. Qed. -Lemma SAset_bottomP (s : {SAset F^n}) : SAsub SAset_bottom s. -Proof. by apply/rcf_satP/nforallP => u; move/holds_repr_pi. Qed. +Lemma SAset_rev s : SAset_seq (rev s) = SAset_seq s. +Proof. exact/perm_SAset_seq/permPl/perm_rev. Qed. -(* TODO: Why does {SAset F^n} not have a structure of bPOrderType yet? *) +Lemma SAset0U A : SAset0 F n :|: A = A. +Proof. by apply/eqP/SAsetP => x; rewrite inSAsetU inSAset0. Qed. -Definition SAset_meet (s1 s2 : {SAset F^n}) : {SAset F^n} := - \pi_{SAset F^n} (formulan_and s1 s2). +Lemma SAsetUC A B : A :|: B = B :|: A. +Proof. by apply/eqP/SAsetP => x; rewrite !inSAsetU orbC. Qed. -Definition SAset_join (s1 s2 : {SAset F^n}) : {SAset F^n} := - \pi_{SAset F^n} (formulan_or s1 s2). +Lemma SAsetUA A B C : A :|: (B :|: C) = A :|: B :|: C. +Proof. by apply/eqP/SAsetP => x; rewrite !inSAsetU orbA. Qed. -Fact commutative_meet : commutative SAset_meet. +Lemma SAsetU_comprehension (f g : formula F) : + [set| f] :|: [set| g] = [set| f \/ g] :> {SAset F^n}. Proof. -move=> s1 s2; apply/eqP; rewrite eqmodE. -by apply/rcf_satP/nforallP => u; split => [[h1 h2] | [h2 h1]]; split. +apply/eqP/SAsetP => x; rewrite inSAsetU; apply/orP/SAin_setP => /=. + by case=> /SAin_setP xfg; [left|right]. +by case=> xfg; [left|right]; apply/SAin_setP. Qed. -Fact commutative_join : commutative SAset_join. +HB.instance Definition _ := + Monoid.isComLaw.Build {SAset F^n} + (SAset0 F n) (@SAsetU F n) SAsetUA SAsetUC SAset0U. + +Lemma SAsetIC A B : A :&: B = B :&: A. +Proof. by apply/eqP/SAsetP => x; rewrite !inSAsetI andbC. Qed. + +Lemma SAsetIA A B C : A :&: (B :&: C) = A :&: B :&: C. +Proof. by apply/eqP/SAsetP => x; rewrite !inSAsetI andbA. Qed. + +Lemma SAsetI0 A : + A :&: SAset0 F n = SAset0 F n. +Proof. by apply/eqP/SAsetP => x; rewrite inSAsetI inSAset0 andbF. Qed. + +Lemma SAsetTI A : SAsetT F n :&: A = A. +Proof. by apply/eqP/SAsetP => x; rewrite inSAsetI inSAsetT. Qed. + +Lemma SAsetIT A : A :&: SAsetT F n = A. +Proof. by rewrite SAsetIC SAsetTI. Qed. + +Lemma SAsetI_comprehension (f g : formula F) : + [set| f] :&: [set| g] = [set| f /\ g] :> {SAset F^n}. Proof. -move=> s1 s2; apply/eqP; rewrite eqmodE; apply/rcf_satP/nforallP => u. -by split => h; apply/or_comm. +apply/eqP/SAsetP => x; rewrite inSAsetI; apply/andP/SAin_setP. + by move=> [] /SAin_setP xf /SAin_setP yf /=; split. +by move=> /= [] xf yf; split; apply/SAin_setP. Qed. -Fact associative_meet : associative SAset_meet. +HB.instance Definition _ := + Monoid.isComLaw.Build {SAset F^n} + (SAsetT F n) (@SAsetI F n) SAsetIA SAsetIC SAsetTI. + +Lemma SAsetCK A : + ~: ~: A = A. +Proof. by apply/eqP/SAsetP => x; rewrite !inSAsetC negbK. Qed. + +Lemma SAsetCU A B : ~: (A :|: B) = ~: A :&: ~: B. Proof. -move => s1 s2 s3; apply/eqP; rewrite eqmodE; apply/rcf_satP/nforallP => u. -split=> [[h1 /holds_repr_pi [h2 h3]]|[/holds_repr_pi [h1 h2] h3]]; -by split=> //; apply/holds_repr_pi => []; split. +by apply/eqP/SAsetP => x; rewrite inSAsetI !inSAsetC inSAsetU negb_or. Qed. -Fact associative_join : associative SAset_join. +Lemma SAsetCI A B : ~: (A :&: B) = ~: A :|: ~: B. Proof. -move=> s1 s2 s3; apply/eqP; rewrite eqmodE. -apply/rcf_satP/nforallP => u. -split => [ [ | /holds_repr_pi [|]] | [/holds_repr_pi [|] | ] ]. -+ by left; apply/holds_repr_pi; left. -+ by left; apply/holds_repr_pi; right. -+ by right. -+ by left. -+ by right; apply/holds_repr_pi; left. -+ by right; apply/holds_repr_pi; right. +by apply/eqP/SAsetP => x; rewrite inSAsetU !inSAsetC inSAsetI negb_and. Qed. -Fact meet_join (s1 s2 : {SAset F^n}) : SAset_meet s2 (SAset_join s2 s1) = s2. +Lemma SAsetC_comprehension (f : formula F) : + ~: [set | f] = [set | Not f] :> {SAset F^n}. Proof. -apply/eqP/SAsetP => x; rewrite !inE. -rewrite !rcf_sat_repr_pi simp_rcf_sat rcf_sat_repr_pi. -by rewrite simp_rcf_sat andbC orbK. +apply/eqP/SAsetP => x; rewrite inSAsetC !inE. +apply/negP/SAin_setP => [fP|/nn_formula + /SAin_setP fP //]. +by apply/nn_formula => fP'; apply/fP/SAin_setP. Qed. -Fact join_meet (s1 s2 : {SAset F^n}) : SAset_join s2 (SAset_meet s2 s1) = s2. +Lemma SAsubset_refl : reflexive (@SAset_sub F n). +Proof. by move=> A; apply/SAset_subP. Qed. + +Lemma SAsubset_anti : antisymmetric (@SAset_sub F n). +Proof. by move=> A B /andP[] AB BA; apply/eqP; rewrite eqEsubset AB. Qed. + +Lemma SAsubset_trans : transitive (@SAset_sub F n). Proof. -apply/eqP/SAsetP => x; rewrite !inE !rcf_sat_repr_pi. -by rewrite simp_rcf_sat rcf_sat_repr_pi simp_rcf_sat andbC andKb. +by move=> A B C /SAset_subP BA /SAset_subP AC; apply/SAset_subP => x /BA /AC. Qed. -Fact le_meet (s1 s2 : {SAset F^n}) : SAsub s1 s2 = (SAset_meet s1 s2 == s1). +Lemma SAsetIUr A B C : A :&: (B :|: C) = (A :&: B) :|: (A :&: C). Proof. -apply/idP/idP=> [sub12| /SAsetP h]. -+ apply/SAsetP => x; move : (ngraph x) => e. - rewrite !inE rcf_sat_repr_pi simp_rcf_sat. - apply : andb_idr; apply/implyP. - move : sub12 => /rcf_satP/nforallP sub12. - apply/implyP; move/rcf_satP => holds_e_s1. - apply/rcf_satP; move : holds_e_s1. - exact: sub12. -+ apply/rcf_satP/nforallP => e. - by move/holds_tuple; rewrite -h; move/holds_tuple/holds_repr_pi => []. +by apply/eqP/SAsetP => x; rewrite inSAsetI !inSAsetU !inSAsetI andb_orr. Qed. -Fact left_distributive_meet_join : left_distributive SAset_meet SAset_join. +Lemma SAsetIUl A B C : (A :|: B) :&: C = (A :&: C) :|: (B :&: C). +Proof. by rewrite ![_ :&: C]SAsetIC SAsetIUr. Qed. + +Lemma SAsetUIr A B C : A :|: (B :&: C) = (A :|: B) :&: (A :|: C). Proof. -set vw := holds_repr_pi; move=> s1 s2 s3; apply/eqP; rewrite eqmodE. -apply/rcf_satP/nforallP => t. -split=> [[/vw /= [h1|h2] h3]|[/vw [h1 h3]| /vw [h2 h3]]]. -+ by left; apply/vw. -+ by right; apply/vw. -+ by split => //; apply/vw; left. -+ by split => //; apply/vw; right. +by apply/eqP/SAsetP => x; rewrite inSAsetU !inSAsetI !inSAsetU orb_andr. Qed. -Fact idempotent_meet : idempotent SAset_meet. +Lemma SAsetDIr A B : + A :\: (A :&: B) = A :\: B. Proof. -move=> x; apply/eqP/SAsetP => i. -by rewrite !inE rcf_sat_repr_pi simp_rcf_sat andbb. +apply/eqP/SAsetP => x. +by rewrite !inSAsetI !inSAsetC inSAsetI negb_and andb_orr andbN. Qed. -#[non_forgetful_inheritance] -HB.instance Definition SAset_latticeType := - Order.isMeetJoinDistrLattice.Build SAset_disp {SAset _} - le_meet (fun _ _ => erefl) commutative_meet commutative_join - associative_meet associative_join meet_join join_meet left_distributive_meet_join idempotent_meet. - -HB.instance Definition _ := - Order.hasBottom.Build SAset_disp {SAset F^n} SAset_bottomP. - -Definition SAset_top : {SAset F^n} := - \pi_{SAset F^n} (MkFormulan (nvar_True _ _)). +Lemma SAsubsetI A B C : A :<=: B :&: C = (A :<=: B) && (A :<=: C). +Proof. +apply/SAset_subP/andP => [ABC|[/SAset_subP AB]/SAset_subP AC x xA]; last first. + by rewrite inSAsetI (AB _ xA) (AC _ xA). +by split; apply/SAset_subP => x /ABC; rewrite inSAsetI => /andP[]. +Qed. -Lemma SAset_topP (s : {SAset F^n}) : (s <= SAset_top)%O. -Proof. by apply/rcf_satP/nforallP => t h; apply/holds_repr_pi. Qed. +Lemma SAsubsetIl A B : A :&: B :<=: A. +Proof. by apply/SAset_subP => x; rewrite inSAsetI => /andP[]. Qed. -Canonical SAset_tblatticeType := - Order.hasTop.Build _ _ SAset_topP. +Lemma SAsubsetIidl A B : (A :<=: A :&: B) = (A :<=: B). +Proof. by rewrite SAsubsetI SAsubset_refl. Qed. -Definition SAset_sub (s1 s2 : {SAset F^n}) : {SAset F^n} := - \pi_{SAset F^n} (formulan_and s1 (formulan_not s2)). +Lemma SAsubsetEI A B : A :<=: B = (A :&: B == A). +Proof. by rewrite eqEsubset SAsubsetIl SAsubsetIidl. Qed. -Fact meet_sub (s1 s2 : {SAset F^n}) : - SAset_meet s2 (SAset_sub s1 s2) = SAset_bottom. +Lemma SAsubsetED A B : + A :<=: B = (A :\: B == SAset0 F n). Proof. -apply/eqP; rewrite eqmodE; apply/rcf_satP/nforallP => t. -by split => //; move => [? /holds_repr_pi [_ ?]]. +rewrite -subset0; apply/SAset_subP/SAset_subP => AB x. + by rewrite inSAsetD => /andP[] /AB + /negP. +move=> xA; apply/negP => /negP xB. +have /AB: x \in A :\: B by rewrite inSAsetD xA. +by rewrite inSAset0. Qed. -Fact join_meet_sub (s1 s2 : {SAset F^n}) : - SAset_join (SAset_meet s1 s2) (SAset_sub s1 s2) = s1. +Lemma SAsetI_idem : idempotent (@SAsetI F n). Proof. -apply/eqP/SAsetP => x; rewrite !inE. -rewrite !rcf_sat_repr_pi !simp_rcf_sat !rcf_sat_repr_pi. -by rewrite !simp_rcf_sat -andb_orr orbN andbT. +by move=> A; apply/eqP; rewrite eqEsubset SAsubsetIl SAsubsetIidl SAsubset_refl. Qed. -HB.instance Definition _ := Order.hasRelativeComplement.Build SAset_disp {SAset F^n} meet_sub join_meet_sub. +Lemma SAsetKU A B : A :&: (B :|: A) = A. +Proof. by apply/eqP/SAsetP => x; rewrite inSAsetI inSAsetU orKb. Qed. -End POrder. +Lemma SAsetKU' B A : A :&: (A :|: B) = A. +Proof. by rewrite SAsetUC SAsetKU. Qed. -Section SAFunction. +Lemma SAsetKI A B : A :|: (B :&: A) = A. +Proof. by apply/eqP/SAsetP => x; rewrite inSAsetU inSAsetI andKb. Qed. -Variable F : rcfType. +Lemma SAsetKI' B A : A :|: (A :&: B) = A. +Proof. by rewrite SAsetIC SAsetKI. Qed. + +Lemma SAsetICr A : A :&: ~: A = SAset0 F n. +Proof. by apply/eqP/SAsetP => x; rewrite inSAsetI inSAsetC andbN inSAset0. Qed. + +Lemma SAset0I A : SAset0 F n :&: A = SAset0 F n. +Proof. by apply/eqP/SAsetP => x; rewrite inSAsetI inSAset0. Qed. -Lemma existsn_formulaSn (m : nat) (f : {formula_(m.+1) F}) : - nvar m ('exists 'X_m, f)%oT. +Lemma SAsetID0 A B : SAsetI B (SAsetD A B) = (SAset0 F n). +Proof. by rewrite /SAsetD [A :&: _]SAsetIC SAsetIA SAsetICr SAset0I. Qed. + +Lemma SAsetUCr A : A :|: ~: A = SAsetT F n. +Proof. by apply/eqP/SAsetP => x; rewrite inSAsetU inSAsetC orbN inSAsetT. Qed. + +Lemma SAsetUID A B : A :&: B :|: A :\: B = A. +Proof. by rewrite -SAsetIUr SAsetUCr SAsetIT. Qed. + +Notation "\bigcap_( i <- r | P ) f" := + (\big[@SAsetI _ _/SAsetT _ _]_(i <- r | P) f) + (at level 41, f at level 41, r, P at level 50). + +Lemma inSAset_bigcap (I : Type) (r : seq I) (P : pred I) + (f : I -> {SAset F^n}) (x : 'rV[F]_n) : + (x \in \bigcap_(i <- r | P i) f i) = all (fun i => P i ==> (x \in f i)) r. Proof. -rewrite /nvar fsubDset (fsubset_trans (fsubset_formulan_fv _)) // => {f}. -rewrite -add1n addnC iotaD add0n seq_fset_cat fsetUC. -by rewrite seq_fset_cons seq_fset_nil fsetU0 fsubset_refl. +elim: r => /= [|i r IHr]; first by rewrite big_nil inSAsetT. +by rewrite big_cons; case: (P i) => //; rewrite inSAsetI IHr. Qed. -Lemma existsPn_formulan (m : nat) (f : {formula_m F}) : - nvar m.-1 ('exists 'X_m.-1, f)%oT. +Notation "\bigcup_( i <- r | P ) f" := + (\big[@SAsetU _ _/SAset0 _ _]_(i <- r | P) f) + (at level 41, f at level 41, r, P at level 50). + +Lemma inSAset_bigcup (I : Type) (r : seq I) (P : pred I) + (f : I -> {SAset F^n}) (x : 'rV[F]_n) : + (x \in \bigcup_(i <- r | P i) f i) = has (fun i => P i && (x \in f i)) r. Proof. -move: f; case: m => [f|n f] //=; last exact: existsn_formulaSn. -by rewrite /nvar fsubDset (fsubset_trans (fsubset_formulan_fv _)) // fsubsetUr. +elim: r => /= [|i r IHr]; first by rewrite big_nil inSAset0. +by rewrite big_cons; case: (P i) => //; rewrite inSAsetU IHr. Qed. -Lemma nexists_formulan m n (f : {formula_m F}) : - nvar n (nquantify n (m - n) Exists f). +Lemma SAsetIbigcupr A (I : Type) (r : seq I) (P : pred I) + (f : I -> {SAset F^n}) : + A :&: \bigcup_(i <- r | P i) f i = \bigcup_(i <- r | P i) (A :&: f i). Proof. -rewrite /nvar formula_fv_nexists fsubDset fsetUC -seq_fset_cat -iotaD. -have [/ltnW lt_mn| leq_nm] := ltnP m n; last first. - by rewrite subnKC // fsubset_formulan_fv. -rewrite (fsubset_trans (fsubset_formulan_fv _)) //. -apply/fsubsetP=> x; rewrite !seq_fsetE !mem_iota !add0n => /andP [_ lt_xm]. -by rewrite leq0n (leq_trans lt_xm) // (leq_trans lt_mn) // leq_addr. +elim: r => [|i r IHr]; first by rewrite !big_nil SAsetI0. +by rewrite !big_cons; case: (P i) => //; rewrite SAsetIUr IHr. Qed. -Canonical Structure formulan_nexists m n (f : {formula_m F}) := - MkFormulan (nexists_formulan n f). - -Lemma ngraph_nil (t : 'rV[F]_0) : ngraph t = [tuple of nil]. -Proof. by apply/eq_from_tnth => - []. Qed. - -Fact size_ngraph (m : nat) (t : 'rV[F]_m) : size (ngraph t) = m. -Proof. by rewrite size_tuple. Qed. +Lemma SAsetIbigcup (I J : Type) (r : seq I) (P : pred I) (f : I -> {SAset F^n}) + (s : seq J) (Q : pred J) (g : J -> {SAset F^n}) : + (\bigcup_(i <- r | P i) f i) :&: (\bigcup_(j <- s | Q j) g j) + = \bigcup_(ij <- allpairs pair r s | P (fst ij) && Q (snd ij)) + (f (fst ij) :&: g (snd ij)). +Proof. +elim: r => /= [|i r IHr]; first by rewrite !big_nil SAset0I. +rewrite big_cons big_cat/= big_map/=; case: (P i) => /=; last first. + by rewrite big_pred0_eq SAset0U. +by rewrite SAsetIUl -IHr SAsetIbigcupr. +Qed. -Fact cat_ffunE (x0 : F) (m : nat) (t : 'rV[F]_m) (p : nat) - (u : 'rV[F]_p) (i : 'I_(m + p)) : -(row_mx t u) ord0 i = if (i < m)%N then (ngraph t)`_i else (ngraph u)`_(i - m). +Lemma SAsetCbigcap (I : Type) (r : seq I) (P : pred I) (f : I -> {SAset F^n}) : + (~: \bigcap_(i <- r | P i) f i) = \bigcup_(i <- r | P i) ~: f i. Proof. -by rewrite mxE; case: splitP => j ->; rewrite ?(addnC, addnK) nth_ngraph. +apply/eqP/SAsetP => x; rewrite inSAsetC inSAset_bigcap inSAset_bigcup. +rewrite -has_predC; elim: r => [//|] i r IHr /=. +by rewrite negb_imply IHr inSAsetC. Qed. -Fact ngraph_cat (m : nat) (t : 'rV[F]_m) (p : nat) (u : 'rV[F]_p) : - ngraph (row_mx t u) = ngraph t ++ ngraph u :> seq F. +Lemma SAsetCbigcup (I : Type) (r : seq I) (P : pred I) (f : I -> {SAset F^n}) : + (~: \bigcup_(i <- r | P i) f i) = \bigcap_(i <- r | P i) ~: f i. Proof. -apply: (@eq_from_nth _ 0) => [|i]; first by rewrite size_cat ?size_ngraph. -rewrite size_ngraph=> lt_i_mp; rewrite nth_cat. -have -> : i = nat_of_ord (Ordinal lt_i_mp) by []. -by rewrite nth_ngraph (cat_ffunE 0) size_ngraph. +rewrite -[RHS]SAsetCK SAsetCbigcap; congr (~: _). +by apply/eq_bigr => i _; rewrite SAsetCK. Qed. -Variables (n m : nat). +Lemma SAset0X (s : {SAset F^n}) : + SAset0 F 0 :*: s = SAset0 F n. +Proof. by apply/eqP/SAsetP => x; rewrite inSAsetX !inSAset0. Qed. -Definition ftotal (f : {formula_(n + m) F}) := - nquantify O n Forall (nquantify n m Exists f). +Lemma SAsetX0 (s : {SAset F^n}) : + s :*: SAset0 F 0 = SAset0 F (n + 0). +Proof. by apply/eqP/SAsetP => x; rewrite inSAsetX !inSAset0 andbF. Qed. -Lemma formuladd (p : nat) (f : {formula_p F}) : nvar (p + m) f. +Lemma inSAset_pos (x : 'rV[F]_1) : x \in SAset_pos F = (0 < x ord0 ord0). +Proof. by rewrite inSAset_itv in_itv/= andbT. Qed. + +Lemma SAset_cast_id m (A : {SAset F^m}) : SAset_cast m A = A. Proof. -rewrite /nvar (fsubset_trans (fsubset_formulan_fv _)) //. -apply/fsubsetP=> x; rewrite !seq_fsetE !mem_iota !add0n !leq0n. -exact: ltn_addr. +apply/eqP/SAsetP => x; apply/SAin_setP/rcf_satP => /= [[] _|hx]; + rewrite subnn nquantify0//. +by split=> //; apply/holdsAnd. +Qed. + +Lemma SAset_cast_le m k (A : {SAset F^m}) : (k <= m)%N -> + SAset_cast k A = [set | nquantify k (m - k) Exists A]. +Proof. +rewrite -subn_eq0 => /eqP km; apply/eqP/SAsetP => x. +apply/Bool.eq_iff_eq_true. +rewrite [X in X <-> _](iff_sym (rwP (SAin_setP _ _))). +rewrite [X in _ <-> X](iff_sym (rwP (SAin_setP _ _))). +rewrite km big_nil/=. +by split=> // -[]. +Qed. + +Lemma SAset_cast_ge m k (A : {SAset F^m}) : (m <= k)%N -> + SAset_cast k A + = [set | A /\ \big[And/True]_(i <- iota m (k - m)) ('X_i == 0)]. +Proof. +rewrite -subn_eq0 => /eqP km; apply/eqP/SAsetP => x. +apply/Bool.eq_iff_eq_true. +rewrite [X in X <-> _](iff_sym (rwP (SAin_setP _ _))). +rewrite [X in _ <-> X](iff_sym (rwP (SAin_setP _ _))). +rewrite km nquantify0/=. +by split=> -[]. +Qed. + +Lemma inSAset_cast m (s : {SAset F^n}) (x : 'rV[F]_m) (mn : m = n) : + x \in SAset_cast m s = (castmx (erefl, mn) x \in s). +Proof. +by move: x (mn); rewrite mn => x nn; rewrite SAset_cast_id castmx_id. +Qed. + +Lemma inSAset_castDn m k (A : {SAset F^(m+k)}) (x : 'rV[F]_m) : + reflect (exists y : 'rV[F]_(m+k), y \in A /\ x = lsubmx y) + (x \in SAset_cast m A). +Proof. +rewrite SAset_cast_le ?leq_addr// subDnCA// subnn addn0. +rewrite -[X in nquantify X](size_ngraph x). +apply/(iffP (SAin_setP _ _)) => [/nexistsP [y] hxy|[y][yA]->]. + exists (row_mx x (\row_i tnth y i)); rewrite row_mxKl; split=> //. + by apply/rcf_satP; rewrite ngraph_cat ngraph_tnth. +apply/nexistsP; exists (ngraph (rsubmx y)); rewrite -ngraph_cat hsubmxK. +exact/rcf_satP. +Qed. + +Lemma inSAset_castnD m k (A : {SAset F^m}) (x : 'rV[F]_(m+k)) : + x \in SAset_cast (m+k) A = (lsubmx x \in A) && (rsubmx x == 0). +Proof. +rewrite SAset_cast_ge ?leq_addr//. +apply/SAin_setP/andP => /=; + rewrite -holds_take take_ngraph holdsAnd /= => -[/rcf_satP hx]. + move=> h0; split=> //; apply/eqP/rowP => i. + move/(_ (@unsplit m k (inr i))): h0. + rewrite nth_ngraph mem_iota subnKC ?leq_addr//= -addnS leq_add//. + move=> /(_ Logic.eq_refl Logic.eq_refl). + by rewrite !mxE. +move=> /eqP /rowP x0; split=> // => i. +rewrite mem_iota subnKC ?leq_addr// => /andP[mi im] _. +rewrite (nth_ngraph _ _ (Ordinal im)) -(splitK (Ordinal im)). +move: mi; rewrite leqNgt -{1}[i%N]/(Ordinal im : nat). +case: splitP => // j _ _. +by move: (x0 j); rewrite !mxE. +Qed. + +Lemma SAset_cast_trans k m A : (minn n k <= m)%N -> + SAset_cast k (SAset_cast m A) = SAset_cast k A. +Proof. +case: (ltnP m n) => [mn|nm _]; last first. + case/orP: (leq_total m k) => [mk|km]. + rewrite -(subnKC mk) -(subnKC nm) [X in (k-X)%N]subnKC//. + apply/eqP/SAsetP => x. + rewrite 2!inSAset_castnD. + move: (lsubmx x) (rsubmx x) (hsubmxK x) => l r <- {x}. + move: (lsubmx l) (rsubmx l) (hsubmxK l) => ll lr <- {l}. + rewrite SAset_cast_ge; last by rewrite subnKC// subnKC// (leq_trans nm mk). + apply/andP/SAin_setP => /=; + rewrite holdsAnd -holds_take -(take_takel _ (@leq_addr (m-n) n)%N); + rewrite !take_ngraph !row_mxKl (rwP (rcf_satP _ _)); + rewrite subDnCA ?leq_addr// subDnCA// subnn addn0 addnC. + move=> [] /andP[] llA /eqP -> /eqP ->; split=> //= i. + rewrite mem_iota addnA => /andP[+ ilt] _. + rewrite -[i%N]/(Ordinal ilt : nat) nth_ngraph mxE. + case: (splitP (Ordinal ilt)) => j ->; rewrite mxE//. + by case: (splitP j) => j' ->; rewrite leqNgt ?ltn_ord// mxE. + move=> [llA /= h0]; split; last first. + apply/eqP/rowP => i. + move/(_ (unsplit (inr i) : 'I_(n + (m - n) + (k - m))%N)): h0. + rewrite nth_ngraph !mxE unsplitK. + by rewrite mem_iota addnA ltn_ord/= -addnA leq_addr; apply. + apply/andP; split=> //. + apply/eqP/rowP => i; move: h0. + move=> /(_ (unsplit (inl (unsplit (inr i))) : + 'I_(n + (m - n) + (k - m))%N)). + rewrite nth_ngraph !mxE unsplitK mxE unsplitK. + by rewrite mem_iota addnA ltn_ord/= leq_addr; apply. + case/orP: (leq_total n k) => [nk|kn]. + rewrite -(subnKC km) -(subnKC nk) [X in (m-X)%N]subnKC//. + apply/eqP/SAsetP => x. + rewrite inSAset_castnD. + move: (lsubmx x) (rsubmx x) (hsubmxK x) => l r <- {x}. + apply/inSAset_castDn/andP => [[y]|[lA] /eqP ->]; + rewrite SAset_cast_ge -?addnA ?leq_addr//. + move: (lsubmx y) (rsubmx y) (hsubmxK y). + move=> yl yr <- {y} [] /[swap] <- {yl} /SAin_setP/= [] /holds_take. + rewrite -(take_takel _ (@leq_addr (k - n)%N n)) !take_ngraph !row_mxKl. + move=> /rcf_satP lA /holdsAnd. + rewrite subDnCA ?leq_addr// subDnCA// subnn addn0 addnC /= => h0. + split=> //; apply/eqP/rowP => i; move: h0. + move=> /(_ (unsplit (inl (unsplit (inr i))) : + 'I_(n + (k - n) + (m - k))%N)). + rewrite nth_ngraph !mxE unsplitK mxE unsplitK mem_iota addnA ltn_ord/=. + by rewrite leq_addr; apply. + exists (row_mx (row_mx l 0) 0); rewrite row_mxKl; split=> //. + apply/SAin_setP => /=; split. + apply/holds_take. + rewrite -(take_takel _ (@leq_addr (k - n)%N n)) !take_ngraph !row_mxKl. + exact/rcf_satP. + apply/holdsAnd => i; rewrite mem_iota subDnCA ?leq_addr// subDnCA// subnn. + rewrite addn0 [X in (n + X)%N]addnC /= addnA => /andP[+ ilt] _. + rewrite -[i%N]/(Ordinal ilt : nat) nth_ngraph mxE. + case: (splitP (Ordinal ilt)) => j ->; rewrite mxE//. + by case: (splitP j) => j' ->; rewrite leqNgt ?ltn_ord// mxE. + move: A; rewrite -(subnKC nm) -(subnKC kn) [X in (m - X)%N]subnKC// -addnA. + move=> A. + apply/eqP/SAsetP => x; apply/inSAset_castDn/inSAset_castDn => -[y]. + rewrite [_ _ A]SAset_cast_ge ?addnA ?leq_addr//. + move=> -[] /SAin_setP /= [] /holds_take + _. + rewrite takeD take_ngraph drop_ngraph take_ngraph -ngraph_cat => yA -> {x}. + exists (row_mx (lsubmx y) (lsubmx (rsubmx y))); split; first exact/rcf_satP. + by rewrite row_mxKl. + move=> [] /rcf_satP yA -> {x}. + exists (row_mx (lsubmx y) (row_mx (rsubmx y) 0)). + split; last by rewrite row_mxKl. + rewrite [_ _ A]SAset_cast_ge ?addnA ?leq_addr//; apply/SAin_setP => /=; split. + apply/holds_take. + rewrite takeD take_ngraph drop_ngraph take_ngraph -ngraph_cat row_mxKr. + by rewrite !row_mxKl hsubmxK. + apply/holdsAnd => i; rewrite {1}addnA subnKC// subnKC// mem_iota. + rewrite -{1 2}(subnKC kn) -addnA => /andP[] + ilt _ /=. + rewrite -[i%N]/(Ordinal ilt : nat) nth_ngraph. + rewrite mxE; case: splitP => j ->. + by rewrite leqNgt (leq_trans (ltn_ord j) (leq_addr _ _)). + rewrite leq_add2l mxE; case: splitP => j' ->; last by rewrite mxE. + by rewrite leqNgt ltn_ord. +rewrite geq_min leqNgt mn/= => km. +rewrite SAset_cast_le// SAset_cast_le ?(ltnW mn)//. +rewrite SAset_cast_le ?(ltnW (leq_ltn_trans km mn))//. +apply/eqP/SAsetP => x; rewrite -[X in nquantify X](size_ngraph x). +apply/SAin_setP/SAin_setP => /nexistsP [y] => /rcf_satP. + rewrite -[in X in rcf_sat _ X](subnKC km). + rewrite -[y]ngraph_tnth -ngraph_cat => /SAin_setP. + have mE: (k + (m - k))%N = size (ngraph x ++ y). + by rewrite size_cat size_ngraph size_tuple subnKC. + rewrite [X in nquantify X]mE -{2}[y]ngraph_tnth -ngraph_cat. + move=> /nexistsP [] {mE}. + rewrite ngraph_cat (subnKC km) ngraph_tnth => z hA. + apply/nexistsP. + have ->: (n - k)%N = (n - m + m - k)%N by rewrite subnK// (ltnW mn). + have /eqP scat: size (y ++ z) = (n - m + m - k)%N. + by rewrite size_cat !size_tuple addnC addnBA. + by exists (Tuple scat) => /=; rewrite catA. +move=> /rcf_satP hy; apply/nexistsP. +have /eqP ts: size (take (m - k)%N y) = (m - k)%N. + by rewrite size_takel// size_tuple leq_sub// ltnW. +exists (Tuple ts); rewrite -[in X in holds _ X](subnKC km). +rewrite -[Tuple ts]ngraph_tnth -ngraph_cat. +apply/rcf_satP/SAin_setP. +have mE: (k + (m - k))%N = size (ngraph x ++ Tuple ts). + by rewrite size_cat size_ngraph size_tuple subnKC. +rewrite [X in nquantify X]mE -{2}[Tuple ts]ngraph_tnth -ngraph_cat. +apply/nexistsP. +rewrite ngraph_cat subnKC//. +have /eqP ds: size (drop (m - k)%N y) = (n - m)%N. + rewrite size_drop size_tuple subnBA// addnC subnKC//. + exact/(ltnW (leq_ltn_trans km mn)). +by exists (Tuple ds); rewrite -catA ngraph_tnth/= cat_take_drop. Qed. -Canonical Structure formulan_add (m : nat) (f : {formula_m F}) := - MkFormulan (formuladd f). +End SAsetTheory. +Section SAsetTheory. +Variables (F : rcfType) (n : nat). +Implicit Types (A B C : {SAset F^n}) (x y z : 'rV[F]_n) (s t : seq 'rV[F]_n). -Definition ex_y (f : {formula_(n + m) F}) (x : 'rV[F]_n) := - rcf_sat (ngraph x) (nquantify n m Exists f). +Lemma SAset_castXl m (s : {SAset F^n}) (t : {SAset F^m}) : + t != SAset0 F m -> SAset_cast n (s :*: t) = s. +Proof. +have [->|[] x0 xt _] := set0Vmem t; first by rewrite eqxx. +apply/eqP/SAsetP => x. + apply/inSAset_castDn/idP => [[y [+ ->]]|xs]. + by rewrite inSAsetX => /andP[+ _]. +by exists (row_mx x x0); rewrite inSAsetX row_mxKl row_mxKr xs. +Qed. -Definition SAtot := - [pred s : {SAset F ^ _} | rcf_sat [::] (ftotal s)]. +Definition SAset_disjoint (s1 s2 : {SAset F^n}) := + s1 :&: s2 == SAset0 F n. -Fact test_can1 (f g h : {formula_(n + m) F}) : -formula_fv (nquantify O (n + m) Forall (f /\ (g ==> h))%oT) == fset0. -Proof. exact: closed_nforall_formulan. Qed. +Lemma SAset_disjointC (s1 s2 : {SAset F^n}) : + SAset_disjoint s1 s2 = SAset_disjoint s2 s1. +Proof. by rewrite /SAset_disjoint SAsetIC. Qed. -Fact test_can2 (f g h : {formula_(n + m) F}) : -formula_fv (nquantify O (n + m + m) Forall f) == fset0. -Proof. exact: closed_nforall_formulan. Qed. +Definition SAset_trivI (I : {fset {SAset F^n}}) := + [forall s1 : I, + [forall s2 : I, (val s1 != val s2) ==> SAset_disjoint (val s1) (val s2)]]. -Fact extP (p : nat) (f : {formula_p F}) : nvar (p + m) f. -Proof. -rewrite /nvar (fsubset_trans (@nvar_formulan _ _ _)) //. -by rewrite mnfset_triangle fsubsetUl. -Qed. +Definition SAset_partition (I : {fset {SAset F^n}}) := + (SAset0 F n \notin I) + && SAset_trivI I + && (\big[@SAsetU F n/SAset0 F n]_(s : I) val s == SAsetT F n). + +End SAsetTheory. + +Section POrder. + +Variable F : rcfType. + +Variable n : nat. + +Fact SAset_disp : unit. Proof. exact tt. Qed. + +HB.instance Definition SAset_latticeType := + Order.isMeetJoinDistrLattice.Build SAset_disp {SAset _} + (@SAsubsetEI F n) (@properEneq' F n) (@SAsetIC F n) (@SAsetUC F n) + (@SAsetIA F n) (@SAsetUA F n) (@SAsetKU' F n) (@SAsetKI' F n) + (@SAsetIUl F n) (@SAsetI_idem F n). + +HB.instance Definition _ := + Order.hasBottom.Build SAset_disp {SAset F^n} (@sub0set F n). + +HB.instance Definition SAset_tblatticeType := + Order.hasTop.Build SAset_disp {SAset F^n} (@subsetT F n). + +HB.instance Definition _ := + Order.hasRelativeComplement.Build SAset_disp {SAset F^n} + (@SAsetID0 F n) (@SAsetUID F n). + +End POrder. + +Section SAFunction. + +Variable F : rcfType. + +Variables (n m : nat). + +Definition ftotal (f : {formula_(n + m) F}) := + nquantify O n Forall (nquantify n m Exists f). -Definition ext (p : nat) (f : {formula_p F}) := MkFormulan (extP f). +Definition ex_y (f : {formula_(n + m) F}) (x : 'rV[F]_n) := + rcf_sat (ngraph x) (nquantify n m Exists f). + +Definition SAtot := + [pred s : {SAset F ^ _} | rcf_sat [::] (ftotal s)]. -Fact test_can3 (f g h : {formula_(n + m) F}) : -formula_fv (nquantify O (n + m + m) Forall ((ext f) /\ (ext f))) == fset0. -Proof. exact: closed_nforall_formulan. Qed. +Definition ext (p : nat) (f : {formula_p F}) : {formula_(p+m) F} := + MkFormulan (formuladd m f). -Lemma f_is_ftotalE (f : {formula_(n + m) F}) : - reflect +Lemma ftotalP (f : {formula_(n + m) F}) : + reflect (forall (t : n.-tuple F), exists (u : m.-tuple F), rcf_sat (t ++ u) f) (rcf_sat [::] (ftotal f)). Proof. apply: (iffP idP) => [h x | h]. -+ move/rcf_satP/nforallP/(_ x) : h. + move/rcf_satP/nforallP/(_ x) : h. case: x => s /= /eqP -{1}<-. by move/nexistsP => [t h]; exists t; apply/rcf_satP. -+ apply/rcf_satP/nforallP => x /=. - move/(_ x) : h => [t]. - case: x => s /= /eqP -{2}<-. - by move/rcf_satP => h; apply/nexistsP; exists t. -Qed. - -Definition subst_term s := - let fix sterm (t : GRing.term F) := match t with - | 'X_i => if (i < size s)%N then 'X_(nth O s i) else 0 - | t1 + t2 => (sterm t1) + (sterm t2) - | - t => - (sterm t) - | t *+ i => (sterm t) *+ i - | t1 * t2 => (sterm t1) * (sterm t2) - | t ^-1 => (sterm t) ^-1 - | t ^+ i => (sterm t) ^+ i - | _ => t -end%T in sterm. - -(* quantifier elim + evaluation of invariant variables to 0 *) -Definition qf_elim (f : formula F) : formula F := - let g := (quantifier_elim (@wproj _) (to_rform f)) in - foldr (fun i h => fsubst h (i, GRing.Const 0)) g - (enum_fset (formula_fv g `\` formula_fv f)). - -Lemma fv_foldr_fsubst (f : formula F) (s : seq nat) : - formula_fv (foldr (fun i h => fsubst h (i, GRing.Const 0)) f s) = - (formula_fv f) `\` (seq_fset mnfset_key s). -Proof. -elim: s => [|i s ih]; first by rewrite seq_fset_nil fsetD0 // fsubset_refl. -by rewrite formula_fv_fsubst ih seq_fset_cons fsetDDl fsetUC. -Qed. - -Fact qf_form_fsubst (f : formula F) (i : nat) (t : GRing.term F) : - qf_form (fsubst f (i, t)) = (qf_form f). -Proof. by elim: f=> //=; move=> f1 -> f2 ->. Qed. - -Fact qf_form_fsubstn (f : formula F) (s : seq nat) (t : GRing.term F) : - qf_form (foldr (fun i h => fsubst h (i, t)) f s) = (qf_form f). -Proof. by elim: s => // x s ih; rewrite qf_form_fsubst ih. Qed. - -Lemma qf_elim_qf (f : formula F) : qf_form (qf_elim f). -Proof. by rewrite qf_form_fsubstn qf_form_elim // to_rform_rformula. Qed. - -Lemma enum_fsetE (K : choiceType) (s : {fset K}) : enum_fset s =i s. -Proof. by []. Qed. - -Lemma qf_elim_fv (f : formula F) : formula_fv (qf_elim f) `<=` formula_fv f. -Proof. -rewrite fv_foldr_fsubst fsubDset; apply/fsubsetP => i. -by rewrite in_fsetU seq_fsetE !enum_fsetE in_fsetD /= => ->; rewrite andbT orNb. +apply/rcf_satP/nforallP => x /=. +move/(_ x) : h => [t]. +case: x => s /= /eqP -{2}<-. +by move/rcf_satP => h; apply/nexistsP; exists t. Qed. -Fact test1 (f : formula F) (e : seq F) : - reflect (holds e (to_rform f)) - (qf_eval e (quantifier_elim (@wproj _) (to_rform f))). -Proof. -apply: quantifier_elim_rformP; last by rewrite to_rform_rformula. -- by move=> i bc /= h; apply: wf_QE_wproj. -- by move=> i bc /= e2 h; apply: valid_QE_wproj. -Qed. - -Fact test2 (i : nat) (e : seq F) (f : formula F) : - i \notin formula_fv f -> - (holds e (fsubst f (i, GRing.Const 0)) <-> holds e f). -Proof. by move=> h; rewrite fsubst_id. Qed. - -Fact test3 (k : unit) (f : formula F) (s : seq nat) (e : seq F) : - [disjoint (seq_fset k s) & (formula_fv f)] -> - (holds e (foldr (fun i h => fsubst h (i, GRing.Const 0)) f s) - <-> holds e f). -Proof. -elim: s => // i s ih. -rewrite seq_fset_cons fdisjointU1X => /andP [hi dis] /=. -rewrite fsubst_id; first exact : ih. -move: hi; apply: contra. -by rewrite fv_foldr_fsubst in_fsetD; move/andP => []. -Qed. - -(* How to factorize both goals? *) -Lemma indep_elim (i : nat) (f : formula F) : - rformula f -> - (is_independent i (quantifier_elim (@wproj _) f) <-> is_independent i f). -Proof. -move=> rform_f; rewrite /is_independent. -split => h e; (split; first exact: holds_forall). -- move/(rwP (elim_rformP _ rform_f))/(rwP (qf_evalP _ (qf_form_elim rform_f))). - move/h; apply: monotonic_forall_if=> e2 h2. - apply/(rwP (elim_rformP _ rform_f)). - by apply/(rwP (qf_evalP _ (qf_form_elim rform_f))). -- move/(rwP (qf_evalP _ (qf_form_elim rform_f)))/(rwP (elim_rformP _ rform_f)). - move/h; apply: monotonic_forall_if=> e2 h2. - apply/(rwP (qf_evalP _ (qf_form_elim rform_f))). - by apply/(rwP (elim_rformP _ rform_f)). -Qed. - -Lemma fv_foldr (f : formula F) (s : seq (formula F)) : - formula_fv (foldr Or f s) = - (formula_fv f) `|` \bigcup_(i <- s) (formula_fv i). -Proof. -elim: s => [|g s /= ->]; first by rewrite big_nil fsetU0. -by rewrite big_cons fsetUCA. -Qed. - -Lemma fsubst_indep (i : nat) (f : formula F) (x : F) (e : seq F) : - is_independent i f -> (holds e f) -> holds e (fsubst f (i, GRing.Const x)). -Proof. by move=> h1 h2; apply/holds_fsubst; move/h1/(_ x): h2. Qed. - -Lemma is_independentP (i : nat) (f : formula F) : - is_independent i f <-> - (forall (e : seq F) (x y : F), - (holds (set_nth 0 e i x) f) <-> (holds (set_nth 0 e i y) f)). -Proof. -split => h e; [|split => [|h2 z]]. -+ move=> x y. - apply: (iff_trans _ (h (set_nth 0 e i y))); apply: iff_sym. - apply: (iff_trans _ (h (set_nth 0 e i x))). - split=> h2 u; rewrite set_set_nth eqxx; - by move/(_ u) : h2; rewrite set_set_nth eqxx. -+ by move/(_ e`_i); rewrite set_nth_nth; move/holds_cat_nseq. -+ by apply/(h e e`_i _); rewrite set_nth_nth; apply/holds_cat_nseq. -Qed. - -Lemma foldr_fsubst_indep (s : seq nat) (f : formula F) (x : F) (e : seq F) : - (forall i : nat, i \in s -> is_independent i f) -> - holds e (foldr (fun i : nat => (fsubst (T:=F))^~ (i, (x%R%:T)%oT)) f s) <-> - holds e f. -Proof. -move: f x e; elim: s => // a s. -move => ih f x e h. -apply: (iff_trans (holds_fsubst _ _ _ _)). -apply: (iff_trans (ih _ _ _ _)) => [j j_in_s|]. - by apply: h; rewrite inE j_in_s orbT. -have /is_independentP ha : is_independent a f by apply: h; rewrite inE eqxx. -by apply: (iff_trans (ha _ _ e`_a)); rewrite set_nth_nth; apply/holds_cat_nseq. -Qed. - -Lemma indep_to_rform (f : formula F) (i : nat) : - is_independent i (to_rform f) <-> is_independent i f. -Proof. -split=> h e. -+ apply: (iff_trans _ (to_rformP _ _)). - apply: (iff_trans _ (h _)). - by split; apply: monotonic_forall_if=> e2; move/to_rformP. -+ apply: iff_sym; apply: (iff_trans (to_rformP _ _)). - apply: iff_sym; apply: (iff_trans _ (h _)). - by split; apply: monotonic_forall_if=> e2; move/to_rformP. -Qed. - -Lemma qf_elim_holdsP (f : formula F) (e : seq F) : - reflect (holds e f) (rcf_sat e (qf_elim f)). -Proof. -apply: (equivP _ (to_rformP _ _)); apply: (equivP (rcf_satP _ _)). -apply: (iff_trans (foldr_fsubst_indep _ _ _)) => [i | ]; last first. - apply: (iff_trans (rwP (qf_evalP _ (qf_form_elim (to_rform_rformula _))))). - apply: iff_sym. - by apply: (iff_trans _ (rwP (elim_rformP _ (to_rform_rformula _)))). -rewrite in_fsetD => /andP [not_fv _] e2. -apply: iff_sym. -apply: (iff_trans (rwP (qf_evalP _ (qf_form_elim (to_rform_rformula _))))). -apply: iff_sym. -apply: (iff_trans _ (rwP (elim_rformP _ (to_rform_rformula _)))). -move/(_ e2) : (independent not_fv) => h. -move: (independent not_fv) => /(indep_to_rform _ _) /(_ e2) indep. -apply: (iff_trans _ indep). -apply: monotonic_forall_iff=> e3. -apply: (iff_trans (rwP (qf_evalP _ (qf_form_elim (to_rform_rformula _))))). -apply: iff_sym. -by apply: (iff_trans _ (rwP (elim_rformP _ (to_rform_rformula _)))). -Qed. - -Fixpoint qf_subst_formula s (f : formula F) := let sterm := subst_term s in -match f with - | (t1 == t2) => (sterm t1) == (sterm t2) - | t1 <% t2 => (sterm t1) <% (sterm t2) - | t1 <=% t2 => (sterm t1) <=% (sterm t2) - | Unit t => Unit (sterm t) - | f1 /\ f2 => (qf_subst_formula s f1) /\ (qf_subst_formula s f2) - | f1 \/ f2 => (qf_subst_formula s f1) \/ (qf_subst_formula s f2) - | f1 ==> f2 => (qf_subst_formula s f1) ==> (qf_subst_formula s f2) - | ~ f => ~ (qf_subst_formula s f) - | ('forall 'X_i, _) | ('exists 'X_i, _) => False - | _ => f -end%oT. - -Definition subst_formula s (f : formula F) := qf_subst_formula s (qf_elim f). - -Definition eq_vec (v1 v2 : seq nat) : formula F := - if size v1 == size v2 then - (\big[And/True]_(i < size v1) ('X_(nth 0%N v1 i) == 'X_(nth 0%N v2 i)))%oT - else False%oT. - Definition functional (f : {formula_(n+m) F}) := (nquantify O (n + m + m) Forall ( - ((subst_formula (iota 0 n ++ iota n m) f) - /\ (subst_formula (iota 0 n ++ iota (n + m) m) f)) - ==> (eq_vec (iota n m) (iota (n + m) m)))). + ((subst_formula (iota 0 n ++ iota n m) f) + /\ (subst_formula (iota 0 n ++ iota (n + m) m) f)) + ==> (eq_vec F (iota n m) (iota (n + m) m)))). Definition SAfunc := - [pred s : {SAset F ^ _} | rcf_sat [::] (functional s)]. - -Definition subst_env (s : seq nat) (e : seq F) := [seq nth 0 e i | i <- s]. - -Lemma subst_env_cat s1 s2 e : - subst_env (s1 ++ s2) e = subst_env s1 e ++ subst_env s2 e. -Proof. by rewrite /subst_env map_cat. Qed. - -Lemma subst_env_iota k1 k2 e1 e2 e3 : size e1 = k1 -> size e2 = k2 -> - subst_env (iota k1 k2) (e1 ++ e2 ++ e3) = e2. -Proof. -move=> h1 h2; rewrite /subst_env; apply: (@eq_from_nth _ 0) => [ | i]. - by rewrite size_map size_iota; symmetry. -rewrite size_map size_iota => lt_ik2. -rewrite (nth_map O); last by rewrite size_iota. -by rewrite !nth_cat nth_iota // ltnNge h1 leq_addr addnC addnK h2 lt_ik2. -Qed. - -Lemma subst_env_iota_catl k e1 e2 : size e1 = k -> - subst_env (iota 0 k) (e1 ++ e2) = e1. -Proof. by move=> ?; rewrite -[e1 ++ e2]cat0s (@subst_env_iota 0). Qed. - -Lemma subst_env_iota_catr k1 k2 e1 e2 : size e1 = k1 -> size e2 = k2 -> - subst_env (iota k1 k2) (e1 ++ e2) = e2. -Proof. by move=> h1 h2; rewrite -[e1 ++ e2]cats0 -catA subst_env_iota. Qed. - -Lemma subst_env_nil s : subst_env s [::] = nseq (size s) 0. -Proof. -apply: (@eq_from_nth _ 0); rewrite ?size_map ?size_nseq // => i lt_is. -by rewrite (nth_map O) // nth_nil nth_nseq if_same. -Qed. - -Lemma eval_subst (e : seq F) (s : seq nat) (t : GRing.term F) : - GRing.eval e (subst_term s t) = GRing.eval (subst_env s e) t. -Proof. -elim: t. -- move=> i //=. - have [lt_is| leq_si] := ltnP i (size s); last first. - + by rewrite [RHS]nth_default ?size_map // !nth_default. - + by rewrite (nth_map i) //=; congr nth; apply: set_nth_default. -- by move=> x. -- by move=> i. -- by move=> /= t1 -> t2 ->. -- by move=> /= t ->. -- by move=> /= t -> i. -- by move=> /= t1 -> t2 ->. -- by move=> /= t ->. -- by move=> /= t -> i. -Qed. - -Lemma holds_subst e s f : - holds e (subst_formula s f) <-> holds (subst_env s e) f. -Proof. -rewrite (rwP (@qf_elim_holdsP f _)) -(rwP (@rcf_satP _ _ _)) /subst_formula. -move: e s; elim: (qf_elim f) (qf_elim_qf f) => // {f}. -- by move=> t1 t2 ? e s /=; rewrite !eval_subst. -- by move=> t1 t2 ? e s /=; rewrite !eval_subst. -- by move=> t1 t2 ? e s /=; rewrite !eval_subst. -- by move=> t ? e s /=; rewrite eval_subst. -- by move=> f1 h1 f2 h2 /andP[??] e s /=; rewrite h1 // h2. -- by move=> f1 h1 f2 h2 /andP[??] e s /=; rewrite h1 // h2. -- by move=> f1 h1 f2 h2 /andP[??] e s /=; rewrite h1 // h2. -- by move=> f1 h1 ? e s /=; rewrite h1. -Qed. - -Lemma fv0_holds (e : seq F) f : - formula_fv f = fset0 -> (holds e f <-> holds [::] f). -Proof. -move/eqP; move=> h; elim/last_ind: e => //. -move=> e x <-; move: h; elim: f => //. -- move=> t1 t2 /=; rewrite fsetU_eq0 => /andP [/eqP ht1 /eqP ht2]. - by rewrite !eval_fv. -- move=> t1 t2 /=; rewrite fsetU_eq0 => /andP [/eqP ht1 /eqP ht2]. - by rewrite !eval_fv. -- move=> t1 t2 /=; rewrite fsetU_eq0 => /andP [/eqP ht1 /eqP ht2]. - by rewrite !eval_fv. -- by move=> t /eqP h /=; rewrite !eval_fv. -- move=> f1 h1 f2 h2. - rewrite fsetU_eq0 => /andP [ht1 ht2]. - move: (h1 ht1) => {h1} h1; move: (h2 ht2) => {h2} h2. - by apply: (iff_trans (and_iff_compat_r _ _) (and_iff_compat_l _ _)). -- move=> f1 h1 f2 h2. - rewrite fsetU_eq0 => /andP [ht1 ht2]. - move: (h1 ht1) => {h1} h1; move: (h2 ht2) => {h2} h2. - by apply: (iff_trans (or_iff_compat_r _ _) (or_iff_compat_l _ _)). -- move=> f1 h1 f2 h2 /=. - rewrite fsetU_eq0 => /andP [ht1 ht2]. - move: (h1 ht1) => {h1} h1; move: (h2 ht2) => {h2} h2. - by apply: (iff_trans (if_iff_compat_r _ _) (if_iff_compat_l _ _)). -- by move=> f holds_ex_f fv_f; split => ?; apply/(holds_ex_f fv_f). -- move=> i f h. - (* the following line causes a problem in PB if I remove /= *) - rewrite [X in X -> _]/= fsetD_eq0 fsubset1 => /orP [h1 | fv0]; last first. - + move/(_ fv0) : h => h. - have hi : i \notin formula_fv f by move/eqP : fv0 ->. (* PB problem here *) - split; move/holds_Nfv_ex => h';apply/holds_Nfv_ex => //; - by apply/h; apply: h'. - + rewrite -(rcons_set_nth x 0); split => [|h']. - - move/holds_fsubst. - by rewrite fsubst_id //=; move/eqP : h1 ->; rewrite fsetDv in_fset0. - - apply/holds_fsubst. - by rewrite fsubst_id //=; move/eqP : h1 ->; rewrite fsetDv in_fset0. -- move=> i f h. - rewrite [X in X -> _]/= fsetD_eq0 fsubset1 => /orP [h1 | fv0]; last first. - + move/(_ fv0) : h => h. - have hi : i \notin formula_fv f by move/eqP : fv0 ->. - split; move/holds_Nfv_all=> h'; apply/holds_Nfv_all =>//; - by apply/h; apply: h'. - + rewrite -(rcons_set_nth x 0); split => [|h']. - - move/holds_fsubst. - by rewrite fsubst_id //=; move/eqP : h1 ->; rewrite fsetDv in_fset0. - - apply/holds_fsubst. - by rewrite fsubst_id //=; move/eqP : h1 ->; rewrite fsetDv in_fset0. -Qed. - -Fact fv_tsubst_nil (t : GRing.term F) : term_fv (subst_term [::] t) = fset0. -Proof. by elim: t => //= t1 -> t2 ->; rewrite fsetU0. Qed. - -Fact fv_tsubst (k : unit) (s : seq nat) (t : GRing.term F) : - term_fv (subst_term s t) `<=` seq_fset k s. -Proof. -elim: t => //. -- move=> i /=. - have [lt_is|leq_si] := ltnP i (size s); rewrite ?fsub0set //. - by rewrite fsub1set seq_fsetE; apply/(nthP _); exists i. -- by move=> t1 h1 t2 h2 /=; rewrite fsubUset; apply/andP; split. -- by move=> t1 h1 t2 h2 /=; rewrite fsubUset; apply/andP; split. -Qed. - -Lemma fsubset_seq_fset (k : unit) (K : choiceType) (s1 s2 : seq K) : - reflect {subset s1 <= s2} ((seq_fset k s1) `<=` (seq_fset k s2)). -Proof. -apply: (@equivP _ _ _ (@fsubsetP _ _ _)). -by split => h x; move/(_ x) : h; rewrite !seq_fsetE. -Qed. - -Fact fv_tsubst_map (k : unit) (s : seq nat) (t : GRing.term F) : - term_fv (subst_term s t) `<=` - seq_fset k [seq nth O s i | i <- (iota O (size s)) & (i \in term_fv t)]. -Proof. -elim: t => //. -- move=> i /=. - have [lt_is|leq_si] := ltnP i (size s); rewrite ?fsub0set //. - rewrite fsub1set seq_fsetE; apply: map_f. - by rewrite mem_filter in_fset1 eqxx mem_iota leq0n add0n. -- move=> t1 h1 t2 h2 /=; rewrite fsubUset; apply/andP; split. - + rewrite (fsubset_trans h1) //. - apply/fsubset_seq_fset; apply: sub_map_filter => x. - by rewrite in_fsetU => ->. - + rewrite (fsubset_trans h2) //. - apply/fsubset_seq_fset; apply: sub_map_filter => x. - by rewrite in_fsetU => ->; rewrite orbT. -- move=> t1 h1 t2 h2 /=; rewrite fsubUset; apply/andP; split. - + rewrite (fsubset_trans h1) //. - apply/fsubset_seq_fset; apply: sub_map_filter => x. - by rewrite in_fsetU => ->. - + rewrite (fsubset_trans h2) //. - apply/fsubset_seq_fset; apply: sub_map_filter => x. - by rewrite in_fsetU => ->; rewrite orbT. -Qed. - -Fact fv_subst_formula (k : unit) (s : seq nat) f : - formula_fv (subst_formula s f) `<=` seq_fset k s. -Proof. -rewrite /subst_formula. -move: s; elim: (qf_elim f) => // {f}. -- by move=> t1 t2 s; rewrite fsubUset !fv_tsubst. -- by move=> t1 t2 s; rewrite fsubUset !fv_tsubst. -- by move=> t1 t2 s; rewrite fsubUset !fv_tsubst. -- by move=> t s; rewrite fv_tsubst. -- by move=> f1 h1 f2 h2 s; rewrite fsubUset h1 h2. -- by move=> f1 h1 f2 h2 s; rewrite fsubUset h1 h2. -- by move=> f1 h1 f2 h2 s; rewrite fsubUset h1 h2. -Qed. - -Fact fv_qf_subst_formula (k : unit) (s : seq nat) f : - formula_fv (qf_subst_formula s f) `<=` - seq_fset k [seq nth O s i | i <- (iota O (size s)) & (i \in formula_fv f)]. -Proof. -move: s; elim: f => //. -- move=> t1 t2 s; rewrite fsubUset /=. - apply/andP; split. - + rewrite (fsubset_trans (fv_tsubst_map k _ _)) //. - apply/fsubset_seq_fset. - apply: sub_map_filter. - move=> i. - by rewrite in_fsetU => ->. - + rewrite (fsubset_trans (fv_tsubst_map k _ _)) //. - apply/fsubset_seq_fset. - apply: sub_map_filter. - move=> i. - by rewrite in_fsetU => ->; rewrite orbT. -- move=> t1 t2 s; rewrite fsubUset /=. - apply/andP; split. - + rewrite (fsubset_trans (fv_tsubst_map k _ _)) //. - apply/fsubset_seq_fset. - apply: sub_map_filter. - move=> i. - by rewrite in_fsetU => ->. - + rewrite (fsubset_trans (fv_tsubst_map k _ _)) //. - apply/fsubset_seq_fset. - apply: sub_map_filter. - move=> i. - by rewrite in_fsetU => ->; rewrite orbT. -- move=> t1 t2 s; rewrite fsubUset /=. - apply/andP; split. - + rewrite (fsubset_trans (fv_tsubst_map k _ _)) //. - apply/fsubset_seq_fset. - apply: sub_map_filter. - move=> i. - by rewrite in_fsetU => ->. - + rewrite (fsubset_trans (fv_tsubst_map k _ _)) //. - apply/fsubset_seq_fset. - apply: sub_map_filter. - move=> i. - by rewrite in_fsetU => ->; rewrite orbT. -- by move=> t s; apply: fv_tsubst_map. -- move=> f1 h1 f2 h2 s /=. - rewrite fsubUset. - apply/andP; split. - + rewrite (fsubset_trans (h1 _)) //. - apply/fsubset_seq_fset. - apply: sub_map_filter. - move=> i. - by rewrite in_fsetU => ->. - + rewrite (fsubset_trans (h2 _)) //. - apply/fsubset_seq_fset. - apply: sub_map_filter. - move=> i. - by rewrite in_fsetU => ->; rewrite orbT. -- move=> f1 h1 f2 h2 s /=. - rewrite fsubUset. - apply/andP; split. - + rewrite (fsubset_trans (h1 _)) //. - apply/fsubset_seq_fset. - apply: sub_map_filter. - move=> i. - by rewrite in_fsetU => ->. - + rewrite (fsubset_trans (h2 _)) //. - apply/fsubset_seq_fset. - apply: sub_map_filter. - move=> i. - by rewrite in_fsetU => ->; rewrite orbT. -- move=> f1 h1 f2 h2 s /=. - rewrite fsubUset. - apply/andP; split. - + rewrite (fsubset_trans (h1 _)) //. - apply/fsubset_seq_fset. - apply: sub_map_filter. - move=> i. - by rewrite in_fsetU => ->. - + rewrite (fsubset_trans (h2 _)) //. - apply/fsubset_seq_fset. - apply: sub_map_filter. - move=> i. - by rewrite in_fsetU => ->; rewrite orbT. -Qed. - -Fact fv_subst_formula_map (k : unit) (s : seq nat) f : - formula_fv (subst_formula s f) `<=` - seq_fset k [seq nth O s i | i <- (iota O (size s)) & (i \in formula_fv f)]. -Proof. -rewrite /subst_formula. -rewrite (fsubset_trans (fv_qf_subst_formula k _ _)) //. -apply/fsubset_seq_fset. -apply: sub_map_filter. -move=> i. -by move/fsubsetP/(_ i): (qf_elim_fv f). -Qed. - -Fact fv_subst_nil f : formula_fv (subst_formula [::] f) = fset0. -Proof. -by apply/eqP; rewrite -fsubset0 -(seq_fset_nil _ tt) fv_subst_formula. -Qed. - -Lemma leq_foldr_maxn j a (s : seq nat) : (j \in s -> j <= foldr maxn a s)%N. -Proof. -elim: s => // b s ih. -rewrite in_cons; move/orP => [/eqP eq_jb|j_in_s] /=. -- by rewrite eq_jb leq_maxl. -- by rewrite (leq_trans _ (leq_maxr _ _)) // ih. -Qed. - -Lemma foldr_maxn_undup a s : foldr maxn a (undup s) = foldr maxn a s. -Proof. -elim: s => // b s ih /=. -have [b_in_s | b_notin_s] := boolP (b \in s); rewrite /= ih //. -by symmetry; apply/maxn_idPr; rewrite leq_foldr_maxn. -Qed. - -Lemma foldr_maxn_leq a s b : - ((foldr maxn a s <= b) = ((a <= b) && all (fun x => x <= b) s))%N. -Proof. -by elim: s; rewrite /= ?andbT // => c s ih; rewrite geq_max ih andbCA. -Qed. - -Lemma subseq_cons (T : eqType) (x : T) (s1 s2 : seq T) : - x \notin s1 -> subseq s1 (x :: s2) = subseq s1 s2. -Proof. -case: s1; first by rewrite /= sub0seq. -move=> y s1. -rewrite in_cons negb_or => /andP [/negbTE neq_xy x_notin_s1]. -by rewrite /= eq_sym neq_xy. -Qed. - -Lemma leq_foldr_maxl a s : (a <= foldr maxn a s)%N. -Proof. by elim: s => // *; rewrite (leq_trans _ (leq_maxr _ _)). Qed. - -Lemma aux_leq_max_max a (s1 s2 : seq nat) : uniq s1-> uniq s2 -> - {subset s1 <= s2} -> (foldr maxn a s1 <= foldr maxn a s2)%N. -Proof. -elim: s1; rewrite ?leq_foldr_maxl // => x s1 ih /andP [x_notin_s1 uniq_s1]. -move=> uniq_s2 /subset_cons [x_in_s2 sub_12]. -by rewrite geq_max leq_foldr_maxn // ih. -Qed. - -Lemma leq_max_max a (s1 s2 : seq nat) : - {subset s1 <= s2} -> (foldr maxn a s1 <= foldr maxn a s2)%N. -Proof. -rewrite -foldr_maxn_undup -[X in (_ <= X)%N]foldr_maxn_undup => h. -rewrite aux_leq_max_max ?undup_uniq // => x. -by rewrite !mem_undup; apply: h. -Qed. + [pred s : {SAset F ^ _} | rcf_sat [::] (functional s)]. -Lemma holds_eq_vec e v1 v2 : - holds e (eq_vec v1 v2) <-> (subst_env v1 e) = (subst_env v2 e). -Proof. -move: v2; elim: v1 => [v2|] /=. - by case: v2 => /=; rewrite /eq_vec ?big_ord0. -move=> a v1 ih v2 /=. -case: v2 => //= b v2. -rewrite /=. -apply: iff_sym; apply: (iff_trans (rwP (eqP ))). -rewrite eqseq_cons. -rewrite /eq_vec /= eqSS big_ord_recl /=. -split. -move=> /andP [/eqP eq_ab /eqP eq_v2]. -rewrite fun_if /=; move/(ih v2) : eq_v2. -by rewrite /eq_vec; case: (_ == _). -rewrite fun_if /= => h. -apply/andP; split; first by move: h; case: (_ == _) => //; move=> [] ->. -by apply/eqP/(ih v2); move: h;rewrite /eq_vec;case: (_ == _) => //; move=> [] _. -Qed. - -Lemma subst_envP (i : nat) (t : i.-tuple nat) (e : seq F) : - size (subst_env t e) = i. -Proof. by rewrite size_map size_tuple. Qed. - -Fact subst_env_tupleP (i : nat) (t : i.-tuple nat) (e : seq F) : - size (subst_env t e) == i. Proof. by rewrite subst_envP. Qed. - -Canonical subst_env_tuple (i : nat) (t : i.-tuple nat) (e : seq F) := - Tuple (subst_env_tupleP t e). - -Lemma f_is_funcE (f : {formula_(n + m) F}) : - reflect +Lemma functionalP (f : {formula_(n + m) F}) : + reflect (forall (t : n.-tuple F) (u1 u2 : m.-tuple F), rcf_sat (t ++ u1) f -> rcf_sat (t ++ u2) f -> u1 = u2) (rcf_sat [::] (functional f)). @@ -2091,37 +1110,24 @@ apply: (iffP idP). by move/(congr1 val). Qed. -Lemma SAtotE (s : {SAset F ^ (n + m)}) : - reflect - (forall (x : 'rV[F]_n), exists (y : 'rV[F]_m), (row_mx x y) \in s) - (s \in SAtot). +Lemma inSAtot (s : {SAset F ^ (n + m)}) : + reflect (forall x, exists y, (row_mx x y) \in s) (s \in SAtot). Proof. -rewrite inE; apply: (iffP (f_is_ftotalE _)) => s_sat x. +rewrite inE; apply: (iffP (ftotalP _)) => s_sat x. have [y sat_s_xy] := s_sat (ngraph x). exists (\row_(i < m) (nth 0 y i)). - by rewrite inE ngraph_cat ngraph_tnth. + by rewrite inE ngraph_cat ngraph_nth. have [y xy_in_s] := s_sat ((\row_(i < n) (nth 0 x i))). exists (ngraph y). -by move: xy_in_s; rewrite inE ngraph_cat ngraph_tnth. +by move: xy_in_s; rewrite inE ngraph_cat ngraph_nth. Qed. -Lemma ngraph_bij k : bijective (@ngraph F k). -Proof. -pose g := fun (x : k.-tuple F) => (\row_(i < k) (nth 0 x i)). -have h : cancel (@ngraph F k) g. - by move=> x; apply/rowP => i; rewrite mxE nth_ngraph. -have h' : cancel g (@ngraph F k). - by move=> x; rewrite ngraph_tnth. -exact: (Bijective h h'). -Qed. - -Lemma SAfuncE (s : {SAset F ^ (n + m)}) : - reflect - (forall (x : 'rV[F]_n), forall (y1 y2 : 'rV[F]_m), - (row_mx x y1) \in s -> (row_mx x y2) \in s -> y1 = y2) +Lemma inSAfunc (s : {SAset F ^ (n + m)}) : + reflect + (forall x y1 y2, (row_mx x y1) \in s -> (row_mx x y2) \in s -> y1 = y2) (s \in SAfunc). Proof. -rewrite inE; apply: (iffP (f_is_funcE _)) => fun_s x y1 y2. +rewrite inE; apply: (iffP (functionalP _)) => fun_s x y1 y2. rewrite !inE !ngraph_cat => /fun_s fun_s1 /fun_s1. exact/bij_inj/ngraph_bij. move=> s_sat1 s_sat2. @@ -2130,44 +1136,28 @@ suff eq_y12 : (\row_(i < m) (nth 0 y1 i)) = (\row_(i < m) (nth 0 y2 i)). have /rowP /(_ i) := eq_y12. by rewrite !mxE !(tnth_nth 0). by apply: (fun_s (\row_(i < n) (nth 0 x i))); -rewrite inE !ngraph_cat !ngraph_tnth. -Qed. - -Fact nvar_SAimset (f : {SAset F ^ (n + m)}) (s : {SAset F^n}) : - formula_fv (nquantify m n Exists ((subst_formula ((iota m n) - ++ (iota O m)) f) /\ (subst_formula (iota m n) s))) - `<=` mnfset 0 m. -Proof. -rewrite formula_fv_nexists fsubDset fsubUset. -rewrite !(fsubset_trans (fv_subst_formula mnfset_key _ _)); -by rewrite ?fsubsetUl // seq_fset_cat fsubset_refl. +rewrite inE !ngraph_cat !ngraph_nth. Qed. -Definition SAimset (f : {SAset F ^ (n + m)}) (s : {SAset F^n}) := - \pi_{SAset F^m} (MkFormulan (nvar_SAimset f s)). - Lemma ex_yE (f : {formula_(n + m) F}) (t : 'rV[F]_n) : - reflect (exists (u : 'rV[F]_m), rcf_sat (ngraph (row_mx t u)) f) (ex_y f t). + reflect (exists (u : 'rV[F]_m), rcf_sat (ngraph (row_mx t u)) f) (ex_y f t). Proof. apply: (iffP idP); rewrite /ex_y. rewrite -{1}[X in nquantify X _ _](size_ngraph t). move/rcf_satP/nexistsP=> [u h]. exists (\row_(i < m) (nth 0 u i)). - by rewrite ngraph_cat ngraph_tnth; apply/rcf_satP. + by rewrite ngraph_cat ngraph_nth; apply/rcf_satP. move=> [u]; rewrite ngraph_cat => ftu. apply/rcf_satP; rewrite -{1}[X in nquantify X _ _](size_ngraph t). by apply/nexistsP; exists (ngraph u); apply/rcf_satP. Qed. -Definition get_y (f : {formula_(n + m) F}) (x : 'rV[F]_n) : ('rV[F]_m):= +Definition form_to_fun (f : {formula_(n + m) F}) (x : 'rV[F]_n) : 'rV[F]_m := match boolP (ex_y f x) with | AltTrue p => proj1_sig (sigW (ex_yE f x p)) | AltFalse _ => (\row_(i < m) 0) end. -Definition form_to_fun (f : {formula_(n + m) F}) : 'rV[F]_n -> 'rV[F]_m := - fun (x : 'rV[F]_n) => get_y f x. - Record SAfun := MkSAfun { SAgraph :> {SAset F ^ (n + m)}; @@ -2183,19 +1173,18 @@ HB.instance Definition SAfun_eqType := [Equality of SAfun by <:]. HB.instance Definition SAfun_choiceType := [Choice of SAfun by <:]. HB.instance Definition SAfun_of_subType := SubType.copy {SAfun} SAfun. -Definition SAfun_of_eqType := Equality.copy {SAfun} SAfun. -Definition SAfun_of_choiceType := Choice.copy {SAfun} SAfun. +HB.instance Definition SAfun_of_eqType := Equality.copy {SAfun} SAfun. +HB.instance Definition SAfun_of_choiceType := Choice.copy {SAfun} SAfun. -Lemma SAfun_func (f : {SAfun}) (x : 'rV[F]_n) (y1 y2 : 'rV[F]_m) : - row_mx x y1 \in SAgraph f -> row_mx x y2 \in SAgraph f -> y1 = y2. -Proof. by apply: SAfuncE; case: f; move => /= [f h /andP [h1 h2]]. Qed. +Lemma SAfun_func (f : {SAfun}) x y1 y2 : + row_mx x y1 \in SAgraph f -> row_mx x y2 \in SAgraph f -> y1 = y2. +Proof. by apply: inSAfunc; case: f; move => /= [f h /andP [h1 h2]]. Qed. Lemma SAfun_tot (f : {SAfun}) (x : 'rV[F]_n) : - exists (y : 'rV[F]_m), row_mx x y \in SAgraph f. -Proof. by apply: SAtotE; case: f; move => /= [f h /andP [h1 h2]]. Qed. + exists y, row_mx x y \in SAgraph f. +Proof. by apply: inSAtot; case: f; move => /= [f h /andP [h1 h2]]. Qed. -Definition SAfun_to_fun (f : SAfun) : 'rV[F]_n -> 'rV[F]_m := - fun x => proj1_sig (sigW (SAfun_tot f x)). +Definition SAfun_to_fun (f : SAfun) x := proj1_sig (sigW (SAfun_tot f x)). Coercion SAfun_to_fun : SAfun >-> Funclass. @@ -2210,157 +1199,60 @@ Arguments SAfunc {F n m}. Arguments SAtot {F n m}. Notation "{ 'SAfun' T }" := (SAfun_of (Phant T)) : type_scope. -Section SASetTheory. - -Variable F : rcfType. - -Lemma in_SAset_bottom (m : nat) (x : 'rV[F]_m) : - x \in (@SAset_bottom F m) = false. -Proof. by rewrite pi_form. Qed. - -Lemma SAset1_neq0 (n : nat) (x : 'rV[F]_n) : (SAset1 x) != (@SAset_bottom F n). -Proof. -apply/negP; move/SAsetP/(_ x) => h. -by move: h; rewrite inSAset1 eqxx pi_form. -Qed. - -Lemma SAemptyP (n : nat) (x : 'rV[F]_n) : x \notin (@SAset_bottom F n). -Proof. by rewrite in_SAset_bottom. Qed. - -Lemma inSAset1B (n : nat) (x y : 'rV[F]_n) : (x \in SAset1 y) = (x == y). -Proof. by rewrite inSAset1. Qed. - -Lemma sub_SAset1 (n : nat) (x : 'rV[F]_n) (s : {SAset F^n}) : - (SAset1 x <= s)%O = (x \in s). -Proof. -apply: (sameP (rcf_satP _ _)). -apply: (equivP _ (nforallP _ _ _)). -apply: (iffP idP). - move=> h t; rewrite cat0s /=. - move/rcf_satP : h => holds_s. - move/holds_tuple; rewrite inSAset1 => /eqP eq_x. - by move: holds_s; rewrite -eq_x ngraph_tnth. -move/(_ (ngraph x)). -rewrite cat0s inE => /rcf_satP. -rewrite simp_rcf_sat => /implyP; apply. -apply/rcf_satP/holds_tuple; rewrite inSAset1; apply/eqP/rowP => i. -by rewrite mxE nth_ngraph. -Qed. - -Lemma nn_formula (e : seq F) (f : formula F) : holds e (~ f) <-> ~ (holds e f). -Proof. by case: f. Qed. - -Lemma n_forall_formula (e : seq F) (f : formula F) (i : nat) : - holds e (~ ('forall 'X_i, f)) <-> holds e ('exists 'X_i, ~ f). -Proof. -split; last by move=> [x hx] h2; apply/hx/h2. -move=> /nn_formula/rcf_satP Nallf. -apply/rcf_satP; apply: contraNT Nallf => /rcf_satP NexNf. -apply/rcf_satP => /= x; apply/rcf_satP. -rewrite -[rcf_sat _ _]negbK -!rcf_sat_Not. -by apply/rcf_satP => /= Nf_holds; apply: NexNf; exists x. -Qed. - -Lemma n_nforall_formula (e : seq F) (f : formula F) (a b : nat) : - holds e (~ (nquantify a b Forall f)) <-> holds e (nquantify a b Exists (~ f)). -Proof. -move: f; elim: b => [f|b ih f]; first by rewrite !nquantify0. -rewrite !nquantSin; split. -+ move/ih; apply: monotonic_nexist => e'. - exact: (iffLR (n_forall_formula _ _ _)). -+ move=> h; apply/ih; move: h. - apply: monotonic_nexist=> e'. - exact: (iffRL (n_forall_formula _ _ _)). -Qed. - -Lemma decidableP (P : Prop) : decidable P -> Decidable.decidable P. -Proof. by move=> [p | np]; [left | right]. Qed. +Section SAfunTheory. -Fact not_and (P Q : Prop) (b : bool) : reflect P b -> ~ (P /\ Q) -> ~ P \/ ~ Q. -Proof. by move=> h; move/(Decidable.not_and P Q (decidableP (decP h))). Qed. +Variable (F : rcfType) (n m : nat). -Lemma laya (e : seq F) (f1 f2 : formula F) : - holds e (f1 /\ f2) <-> ((holds e f1) /\ (holds e f2)). -Proof. by []. Qed. - -Lemma notP (e : seq F) (f : formula F) : - holds e (~ f) <-> holds e (f ==> False). -Proof. by split => // h h'; move: (h h'). Qed. - -Lemma non_empty : forall (n : nat) (s : {SAset F^n}), - ((@SAset_bottom F n) < s)%O -> {x : 'rV[F]_n | x \in s}. +Lemma inSAgraph (f : {SAfun F^n -> F^m}) x : + row_mx x (f x) \in SAgraph f. Proof. -move=> a s /andP [bot_neq_s _]. -move: s bot_neq_s; apply: quotW => /= f; rewrite eqmodE /=. -move=> /rcf_satP/n_nforall_formula/nexistsP P. -apply: sigW; move: P => [x hx] /=; exists (\row_(i < a) x`_i). -rewrite inE ngraph_tnth rcf_sat_repr_pi. -by move/rcf_satP: hx; rewrite cat0s !simp_rcf_sat; case: rcf_sat. +by rewrite /SAfun_to_fun; case: ((sigW (SAfun_tot f x))) => y h. Qed. -Lemma les1s2 : forall (n : nat) (s1 s2 : {SAset F^n}), - (forall (x : 'rV[F]_n), x \in s1 -> x \in s2) -> (s1 <= s2)%O. +Lemma inSAfun (f : {SAfun F^n -> F^m}) x y : + (f x == y) = (row_mx x y \in SAgraph f). Proof. -move=> a s1 s2 sub12; apply/rcf_satP/nforallP => t. -rewrite cat0s /= => /rcf_satP s1_sat; apply/rcf_satP. -by move/(_ ((\row_(i < a) t`_i))): sub12; rewrite !inE ngraph_tnth => ->. +apply/eqP/idP => [<- | h]; first by rewrite inSAgraph. +exact: (SAfun_func (inSAgraph _ _)). Qed. -Lemma SAunion : forall (n : nat) (x : 'rV[F]_n) (s1 s2 : {SAset F^n}), - (x \in SAset_join s1 s2) = (x \in s1) || (x \in s2). +Lemma SAfunE (f1 f2 : {SAfun F^n -> F^m}) : + reflect (f1 =1 f2) (f1 == f2). Proof. -move=> n x s1 s2. -rewrite /SAset_join pi_form !inE. -apply/idP/idP. -move/rcf_satP => /=. -by move=> [l|r]; apply/orP; [left|right]; apply/rcf_satP. -by move/orP => [l|r]; apply/rcf_satP; [left|right]; apply/rcf_satP. +apply: (iffP idP); first by move/eqP ->. +move=> h; apply/SAsetP => x. +by rewrite -(cat_ffun_id x) -!inSAfun h. Qed. -Lemma in_graph_SAfun (n m : nat) (f : {SAfun F^n -> F^m}) (x : 'rV[F]_n) : - row_mx x (f x) \in SAgraph f. -Proof. -by rewrite /SAfun_to_fun; case: ((sigW (SAfun_tot f x))) => y h. -Qed. +Definition SAimset (f : {SAset F ^ (n + m)}) (s : {SAset F^n}) : {SAset F^m} := + [set | nquantify m n Exists ((subst_formula ((iota m n) + ++ (iota O m)) f) /\ (subst_formula (iota m n) s)) ]. -Lemma in_SAimset (m n : nat) (x : 'rV[F]_n) - (s : {SAset F^n}) (f : {SAfun F^n -> F^m}) : +Lemma inSAimset (f : {SAfun F^n -> F^m}) s x : x \in s -> f x \in SAimset f s. Proof. rewrite pi_form /= => h. -have hsiz : m = size (ngraph (f x)) by rewrite size_ngraph. -rewrite [X in nquantify X _ _]hsiz. -apply/rcf_satP/nexistsP. +apply/rcf_satP/holds_subst. +rewrite -[map _ _]cats0 subst_env_iota_catl ?size_ngraph //. +rewrite -[X in nquantify X _ _](size_ngraph (f x)); apply/nexistsP. exists (ngraph x). -split; last first. -+ apply/holds_subst. - move: h; rewrite inE. - move/rcf_satP. - rewrite -[ngraph (f x) ++ ngraph x]cats0. +split; apply/holds_subst; move: h; rewrite inE => /rcf_satP hs; last first. ++ rewrite -[_ ++ ngraph x]cats0. by rewrite -catA subst_env_iota // size_ngraph. -+ apply/holds_subst. - move: h; rewrite inE. - move/rcf_satP => h. - rewrite subst_env_cat subst_env_iota_catl ?size_ngraph //. - rewrite -[ngraph (f x) ++ ngraph x]cats0. ++ rewrite subst_env_cat subst_env_iota_catl ?size_ngraph //. + rewrite -[_ ++ ngraph x]cats0. rewrite -catA subst_env_iota ?size_ngraph //. - move: (in_graph_SAfun f x); rewrite inE. - by move/rcf_satP; rewrite ngraph_cat. + by move: (inSAgraph f x); rewrite inE => /rcf_satP; rewrite ngraph_cat. Qed. -Lemma SAsetfunsort (n m: nat) (f : {SAfun F^n -> F^m}) - (s : {SAset F^n}) (y : 'rV[F]_m) : - reflect (exists2 x : 'rV[F]_n, x \in s & y = f x) - (y \in (SAimset f s)). +Lemma SAimsetP (f : {SAfun F^n -> F^m}) s y : + reflect (exists2 x, x \in s & y = f x) (y \in (SAimset f s)). Proof. -apply: (iffP idP); last by move=> [x h] ->; apply: in_SAimset. -rewrite /SAimset pi_form. -move/rcf_satP. -rewrite /= -[X in nquantify X _ _ _](size_ngraph y). -move/nexistsP => [t] /=. -rewrite !holds_subst subst_env_cat; move => [h1 h2]. +apply: (iffP idP) => [/SAin_setP|[x h]->]; last exact: inSAimset. +rewrite -[X in nquantify X _ _ _](size_ngraph y) => /nexistsP [t] /=. +rewrite !holds_subst subst_env_cat => -[h1 h2]. exists (\row_(i < n) t`_i). -+ rewrite inE ngraph_tnth. ++ rewrite inE ngraph_nth. apply/rcf_satP. move: h2; rewrite -[ngraph y ++ t]cats0 -catA. by rewrite subst_env_iota // ?size_tuple. @@ -2370,84 +1262,152 @@ exists (\row_(i < n) t`_i). rewrite subst_env_iota ?size_ngraph // ?size_tuple //. rewrite /SAfun_to_fun; case: sigW => /= x h h'. symmetry; apply: (SAfun_func h). - by rewrite inE ngraph_cat ngraph_tnth; apply/rcf_satP. -Qed. - -(* -Definition SAset_setMixin := - SET.Semiset.Mixin SAemptyP inSAset1B sub_SAset1 non_empty - les1s2 SAunion SAsetfunsort. - -Notation SemisetType set m := - (@SET.Semiset.pack _ _ set _ _ m _ _ (fun => id) _ id). -Canonical SAset_setType := SemisetType (fun n => {SAset F^n}) SAset_setMixin. - *) -(* Import SET.Theory. *) -(* Definition SAset_setMixin := *) -(* SemisetMixin SAemptyP inSAset1B sub_SAset1 non_empty *) -(* les1s2 SAunion SAsetfunsort. *) - -(* Notation SemisetType set m := *) -(* (@SET.Semiset.pack _ _ set _ _ m _ _ (fun => id) _ id). *) - -Lemma in_SAfun (n m : nat) (f : {SAfun F^n -> F^m}) - (x : 'rV[F]_n) (y : 'rV[F]_m): - (f x == y) = (row_mx x y \in SAgraph f). -Proof. -apply/eqP/idP => [<- | h]; first by rewrite in_graph_SAfun. -exact: (SAfun_func (in_graph_SAfun _ _)). -Qed. - -Lemma SAfunE (n m : nat) (f1 f2 : {SAfun F^n -> F^m}) : - reflect (f1 =1 f2) (f1 == f2). -Proof. -apply: (iffP idP); first by move/eqP ->. -move=> h; apply/SAsetP => x. -by rewrite -(cat_ffun_id x) -!in_SAfun h. -Qed. - -Definition max_abs (k : nat) (x : 'rV[F]_k) := - \big[maxr/0]_(i < k) `|(x ord0 i)|. - -Definition distance (k : nat) (x y : 'rV[F]_k) := max_abs (x - y). - -Lemma max_vectP (k : nat) (x : 'rV[F]_k) (i :'I_k) : x ord0 i <= max_abs x. -Proof. -rewrite /max_abs; move: x i. -elim: k => [x [i lt_i0]| k ihk x i] //. -rewrite big_ord_recl le_max. -have [->|] := eqVneq i ord0; first by rewrite ler_norm. -rewrite eq_sym => neq_i0; apply/orP; right. -move: (unlift_some neq_i0) => /= [j lift_0j _]. -move: (ihk (\row_(i < k) x ord0 (lift ord0 i)) j); rewrite mxE /=. -rewrite (eq_big predT (fun i => `|x ord0 (lift ord0 i)|)) //. - by rewrite -lift_0j. -by move=> l _; rewrite mxE. -Qed. - -Definition max_vec (v : seq nat) (n : nat) : formula F := - ((\big[Or/False]_(i < size v) ('X_n == 'X_(nth O v i))) /\ - (\big[And/True]_(i < size v) ('X_(nth O v i) <=% 'X_n)))%oT. + by rewrite inE ngraph_cat ngraph_nth; apply/rcf_satP. +Qed. + +Definition SApreimset (f : {SAfun F^n -> F^m}) (s : {SAset F^m}) : {SAset F^n} + := [set | nquantify n m Exists (f /\ (subst_formula (iota n m) s)) ]. + +Lemma inSApreimset (f : {SAfun F^n -> F^m}) s x : + x \in SApreimset f s = (f x \in s). +Proof. +apply/SAin_setP/rcf_satP => [|fxs]; + rewrite -[X in nquantify X](size_ngraph x). + move=> /nexistsP [y] /= []. + rewrite -{1}[y]ngraph_tnth -ngraph_cat => xyf /holds_subst. + have ->: (f x = \row_i tnth y i). + by apply/eqP; rewrite inSAfun inE; apply/rcf_satP. + rewrite subst_env_iota_catr ?size_ngraph// ?size_tuple//. + by rewrite -{1}[y]ngraph_tnth. +apply/nexistsP; exists (ngraph (f x)); rewrite -ngraph_cat => /=; split. + by move: (inSAgraph f x); rewrite inE => /rcf_satP. +apply/holds_subst; rewrite ngraph_cat subst_env_iota_catr// ?size_ngraph//. +Qed. + +Definition SAepigraph (f : {SAfun F^n -> F^1}) : {SAset F^(n + 1)} := + [set | nquantify (n + 1) 1 Exists ((subst_formula ((iota 0 n) + ++ [:: n.+1; n]) f) /\ ('X_n.+1 <% 'X_n)) ]. + +Definition SAhypograph (f : {SAfun F^n -> F^1}) : {SAset F^(n + 1)} := + [set | nquantify (n + 1) 1 Exists ((subst_formula ((iota 0 n) + ++ [:: n.+1; n]) f) /\ ('X_n <% 'X_n.+1)) ]. + +End SAfunTheory. + +Lemma inSAepigraph (F : rcfType) (n : nat) (f : {SAfun F^n -> F^1}) x : + (x \in SAepigraph f) = (f (lsubmx x) ord0 ord0 < rsubmx x ord0 ord0). +Proof. +move: (lsubmx x) (rsubmx x) (hsubmxK x) => l r <- {x}. +apply/SAin_setP/idP; rewrite -[X in nquantify X _ _](size_ngraph (row_mx l r)). + move=> /nexistsP [y] /= [] /holds_subst. + rewrite nth_cat size_map size_enum_ord {11 20}addn1 ltnn subnn. + rewrite nth_cat size_map size_enum_ord {11}addn1 leqnn. + rewrite (nth_map (unsplit (inr ord0))) ?size_enum_ord ?addn1//. + have {26}->: n = @unsplit n 1 (inr ord0) by rewrite /= addn0. + rewrite nth_ord_enum mxE unsplitK ngraph_cat -catA subst_env_cat. + rewrite subst_env_iota_catl ?size_ngraph//= !nth_cat size_map size_enum_ord. + rewrite ltnNge leqnSn/= subSnn size_ngraph/= ltnn !subnn/=. + rewrite (nth_map ord0) ?size_enum_ord//. + rewrite -[X in nth ord0 _ X]/(@ord0 1 : nat) (@nth_ord_enum 1 ord0 ord0). + move=> /holds_take; rewrite take_cat size_ngraph ltnNge {1}addn1 leqnSn/=. + rewrite subDnCA// subnn/= => hf; congr (_ < _). + transitivity ((\row_i tnth y i) ord0 ord0); first by rewrite mxE (tnth_nth 0). + congr (_ _ ord0 ord0); apply/esym/eqP => /=; rewrite inSAfun. + apply/rcf_satP; move: hf; congr holds; apply/(eq_from_nth (x0:=0)) => [|i]. + by rewrite size_cat size_map size_enum_ord size_ngraph. + rewrite size_cat size_map size_enum_ord /= => ilt. + have i0: 'I_(n+1) by rewrite addn1; exact: ord0. + rewrite (nth_map (Ordinal ilt)) ?size_enum_ord// -[i%N]/(Ordinal ilt : nat). + rewrite nth_ord_enum mxE -{1}(splitK (Ordinal ilt)); case: (split _) => j. + rewrite nth_cat size_map size_enum_ord ltn_unsplit/=. + by rewrite (nth_map j) ?size_enum_ord// nth_ord_enum /=. + rewrite nth_cat/= size_ngraph ltnNge leq_addr/= subDnCA// subnn addn0. + by case: j; case=> //= jlt; rewrite mxE (tnth_nth 0). +move=> fx; apply/nexistsP; exists (in_tuple [:: f l ord0 ord0]). +split; last first. + rewrite /= !nth_cat size_ngraph {1 10 11}addn1 ltnn leqnn subnn/=. + rewrite (nth_map (unsplit (inr ord0))) ?size_enum_ord ?addn1//. + have {12}->: n = @unsplit n 1 (inr ord0) by rewrite /= addn0. + by rewrite nth_ord_enum mxE unsplitK. +apply/holds_subst; rewrite ngraph_cat -catA subst_env_cat. +rewrite subst_env_iota_catl ?size_ngraph//= !nth_cat !size_ngraph ltnNge. +rewrite leqnSn/= subSnn/= ltnn subnn/=. +apply/holds_take; rewrite take_cat size_ngraph ltnNge leq_addr/=. +rewrite subDnCA// subnn/=. +have ->: (ngraph l) ++ [:: f l ord0 ord0] = ngraph (row_mx l (f l)). + rewrite ngraph_cat; congr (_ ++ _); apply/(eq_from_nth (x0:=0)) => [|/=]. + by rewrite size_ngraph. + case=> //= _; rewrite (nth_map ord0) ?size_enum_ord//. + by rewrite -[X in nth _ _ X]/(@ord0 1 : nat) (@nth_ord_enum 1 ord0 ord0). +by move: (inSAfun f l (f l)); rewrite eqxx => /esym/rcf_satP. +Qed. + +Lemma inSAhypograph (F : rcfType) (n : nat) (f : {SAfun F^n -> F^1}) x : + (x \in SAhypograph f) = (rsubmx x ord0 ord0 < f (lsubmx x) ord0 ord0). +Proof. +move: (lsubmx x) (rsubmx x) (hsubmxK x) => l r <- {x}. +apply/SAin_setP/idP; rewrite -[X in nquantify X _ _](size_ngraph (row_mx l r)). + move=> /nexistsP [y] /= [] /holds_subst. + rewrite !nth_cat size_map size_enum_ord {11 21 30}addn1 leqnn ltnn subnn. + rewrite (nth_map (unsplit (inr ord0))) ?size_enum_ord ?addn1//. + have {26}->: n = @unsplit n 1 (inr ord0) by rewrite /= addn0. + rewrite nth_ord_enum mxE unsplitK ngraph_cat -catA subst_env_cat. + rewrite subst_env_iota_catl ?size_ngraph//= !nth_cat size_map size_enum_ord. + rewrite ltnNge leqnSn/= subSnn size_ngraph/= ltnn !subnn/=. + rewrite (nth_map ord0) ?size_enum_ord//. + rewrite -[X in nth ord0 _ X]/(@ord0 1 : nat) (@nth_ord_enum 1 ord0 ord0). + move=> /holds_take; rewrite take_cat size_ngraph ltnNge {1}addn1 leqnSn/=. + rewrite subDnCA// subnn/= => hf; congr (_ < _). + transitivity ((\row_i tnth y i) ord0 ord0); first by rewrite mxE (tnth_nth 0). + congr (_ _ ord0 ord0); apply/esym/eqP => /=; rewrite inSAfun. + apply/rcf_satP; move: hf; congr holds; apply/(eq_from_nth (x0:=0)) => [|i]. + by rewrite size_cat size_map size_enum_ord size_ngraph. + rewrite size_cat size_map size_enum_ord /= => ilt. + have i0: 'I_(n+1) by rewrite addn1; exact: ord0. + rewrite (nth_map (Ordinal ilt)) ?size_enum_ord// -[i%N]/(Ordinal ilt : nat). + rewrite nth_ord_enum mxE -{1}(splitK (Ordinal ilt)); case: (split _) => j. + rewrite nth_cat size_map size_enum_ord ltn_unsplit/=. + by rewrite (nth_map j) ?size_enum_ord// nth_ord_enum /=. + rewrite nth_cat/= size_ngraph ltnNge leq_addr/= subDnCA// subnn addn0. + by case: j; case=> //= jlt; rewrite mxE (tnth_nth 0). +move=> fx; apply/nexistsP; exists (in_tuple [:: f l ord0 ord0]). +split; last first. + rewrite /= !nth_cat size_ngraph {1 11 20}addn1 ltnn leqnn subnn/=. + rewrite (nth_map (unsplit (inr ord0))) ?size_enum_ord ?addn1//. + have {11}->: n = @unsplit n 1 (inr ord0) by rewrite /= addn0. + by rewrite nth_ord_enum mxE unsplitK. +apply/holds_subst; rewrite ngraph_cat -catA subst_env_cat. +rewrite subst_env_iota_catl ?size_ngraph//= !nth_cat !size_ngraph ltnNge. +rewrite leqnSn/= subSnn/= ltnn subnn/=. +apply/holds_take; rewrite take_cat size_ngraph ltnNge leq_addr/=. +rewrite subDnCA// subnn/=. +have ->: (ngraph l) ++ [:: f l ord0 ord0] = ngraph (row_mx l (f l)). + rewrite ngraph_cat; congr (_ ++ _); apply/(eq_from_nth (x0:=0)) => [|/=]. + by rewrite size_ngraph. + case=> //= _; rewrite (nth_map ord0) ?size_enum_ord//. + by rewrite -[X in nth _ _ X]/(@ord0 1 : nat) (@nth_ord_enum 1 ord0 ord0). +by move: (inSAfun f l (f l)); rewrite eqxx => /esym/rcf_satP. +Qed. + +Section SAfunOps. + +Variable (F : rcfType). Definition abs (i j : nat) : formula F := - ((('X_j == 'X_i) \/ ('X_j == - 'X_i)) /\ (0 <=% 'X_j))%oT. + ((('X_j == 'X_i) \/ ('X_j == - 'X_i)) /\ (0 <=% 'X_j))%oT. Lemma absP (e : seq F) (i j : nat) : holds e (abs i j) <-> e`_j = `|e`_i|. Proof. -rewrite /abs /=; split. -+ move=> [[->|-> h]]; first by move=> h; rewrite ger0_norm. +rewrite /abs /=; split=> [|->]. + move=> [[->|-> h]]; first by move=> h; rewrite ger0_norm. by rewrite ler0_norm // -oppr_gte0. -+ move->. - rewrite normr_ge0; split => //. - have [le_e0|lt_0e] := ler0P e`_i; first by right. - by left. +rewrite normr_ge0; split => //. +have [le_e0|lt_0e] := ler0P e`_i; first by right. +by left. Qed. Lemma absP2 (e : seq F) (i j : nat) : rcf_sat e (abs i j) = (e`_j == `|e`_i|). -Proof. -apply/rcf_satP/eqP; first by move/absP. -by move=> h; apply/absP. -Qed. +Proof. by apply/rcf_satP/eqP => [/absP //|h]; apply/absP. Qed. Fact nvar_abs (i j : nat) : @nvar F (maxn i j).+1 (abs i j). Proof. @@ -2464,10 +1424,8 @@ Lemma functional_absset : absset \in SAfunc. Proof. apply/rcf_satP/nforallP => t. move=> [/holds_subst/holds_repr_pi/absP h1 /holds_subst/holds_repr_pi/absP h2]. -apply/holds_eq_vec; move: h1 h2; case: t => s sz //= {sz}. -case: s => // a s; case: s => // b s -> /= {b}; case: s => //. - by move <-. -by move=> b // _ ->. +apply/holds_eq_vec; move: h1 h2; case: t => s _ /=. +by case: s => // a; case=> // b + -> /= {b}; case=> [<-|b _ ->]. Qed. Lemma total_absset : absset \in SAtot. @@ -2481,8 +1439,7 @@ move: size_abs_t; case: t => s; case: s => // x s /=. rewrite eqSS size_eq0 => /eqP -> _. apply/holds_repr_pi => /=. split; last by rewrite normr_ge0. -have [le_e0|lt_0e] := ler0P x; first by right. -by left. +by case: (ler0P x); [right|left]. Qed. Fact SAfun_SAabs : (absset \in SAfunc) && (absset \in SAtot). @@ -2490,92 +1447,35 @@ Proof. by rewrite functional_absset total_absset. Qed. Definition SAabs := MkSAfun SAfun_SAabs. -Definition diagf_form (f : {formula_(1 + 1) F}) (n : nat) (v1 v2 : seq nat) := -(if size v1 == size v2 then -(\big[And/True]_(i < size v1) -(subst_formula [::(nth O v1 (nat_of_ord i)); (nth O v2 (nat_of_ord i))] f)%oT) - else False). - -Fact pre_nvar_diagf_form (a b n : nat) (f : {formula_(1 + 1) F}) : -@nvar F ((maxn a b) + n) (diagf_form f n (iota a n) (iota b n)). -Proof. -rewrite /diagf_form !size_iota eqxx /nvar formula_fv_bigAnd. -apply/bigfcupsP => /= i _. -rewrite (fsubset_trans (fv_subst_formula mnfset_key _ _)) //. -apply/fsubsetP=> j. -rewrite !seq_fsetE mem_iota /=. -rewrite in_cons mem_seq1 add0n !nth_iota //. -rewrite addn_maxl. -by move/orP => [/eqP -> | /eqP ->]; rewrite leq_max ltn_add2l ltn_ord //= orbT. -Qed. - -Fact nvar_diagf_form (f : {formula_(1 + 1) F}) (n : nat) : -@nvar F (n + n) (diagf_form f n (iota 0 n) (iota n n)). -Proof. by rewrite -{1}[n]max0n pre_nvar_diagf_form. Qed. - -Definition diagf (n : nat) (f : {formula_(1 + 1) F}) := - \pi_{SAset F ^ (n + n)} (MkFormulan (nvar_diagf_form f n)). - -Lemma functional_diagf (f : {SAfun F^1 -> F^1}) (n : nat) : - diagf n f \in SAfunc. -Proof. -apply/rcf_satP/nforallP => t [/holds_subst h1 /holds_subst h2]. -move: h1 h2; rewrite !subst_env_cat /diagf. -move/holds_repr_pi/rcf_satP => h1. -move/holds_repr_pi/rcf_satP. -move: h1. -rewrite /= /diagf_form !size_iota eqxx !rcf_sat_forall=> /forallP h1 /forallP h2. -apply/holds_eq_vec. -apply: (@eq_from_nth _ 0) => [ | i ]; rewrite !subst_envP // => lt_in. -rewrite !(nth_map O) ?size_iota //. -move/(_ (Ordinal lt_in))/rcf_satP/holds_subst : h2. -move/(_ (Ordinal lt_in))/rcf_satP/holds_subst : h1. -rewrite !nth_iota //= ?nth_cat ?size_iota ?subst_envP lt_in. -rewrite -[X in (_ < X)%N]addn0 ltn_add2l ltn0 add0n. -rewrite !(nth_map O) ?size_iota // ?(addnC, addnK) //. -rewrite [in (n + _ - n)%N]addnC addnK. -rewrite !nth_iota // add0n => /rcf_satP h1 /rcf_satP h2. -move: (@SAfun_func F 1 1 f (const_mx t`_i) - (const_mx t`_(n + i)) - (const_mx t`_(2 * n + i))). -rewrite !inE !ngraph_cat /= enum_ordSl enum_ord0. -rewrite /= !mxE mul2n -addnn. -by move/(_ h1 h2)/matrixP/(_ ord0 ord0); rewrite !mxE. -Qed. - -Lemma total_diagf (f : SAfun F 1 1) (n : nat) : diagf n f \in SAtot. +Definition SAid_graph (n : nat) : {SAset F^(n + n)} := + [set | \big[And/True]_(i : 'I_n) ('X_(n + i) == 'X_i)]. + +Lemma SAid_graphP n (x y : 'rV[F]_n) : + (row_mx x y \in SAid_graph n) = (y == x). Proof. -apply/rcf_satP/nforallP => t. -rewrite -[X in nquantify X _ _ _](size_tuple t). -apply/nexistsP. -pose x := \row_(i < n) ((f (const_mx (nth 0 t (nat_of_ord i)))) ord0 ord0). -exists (ngraph x); apply/holds_repr_pi => /=. -rewrite /diagf_form !size_iota eqxx. -apply/rcf_satP; rewrite rcf_sat_forall; apply/forallP => /= i. -apply/rcf_satP/holds_subst. -rewrite ?nth_iota // add0n /= !nth_cat size_tuple ltn_ord. -rewrite -ltn_subRL subnn ltn0. (* this line can be used earlier in the code *) -rewrite addnC addnK. -move : (in_graph_SAfun f (const_mx t`_i)); rewrite inE. -move/rcf_satP; apply: eqn_holds => j y. -rewrite !mxE /=. -rewrite (nth_map 0); last by rewrite size_enum_ord ltn_ord. -rewrite (nth_map 0); last by rewrite -enumT size_enum_ord. -rewrite -enumT nth_ord_enum; case: y => m lt_m2. -rewrite mxE; case: splitP => k ->; first by rewrite !ord1 mxE. -rewrite !ord1 addn0 -[in RHS]tnth_nth /=. -have -> : [seq (\row_i1 (f (const_mx t`_i1)) 0 0) 0 i0 | i0 <- enum 'I_n]`_i = - (\row_i1 (f (const_mx t`_i1)) 0 0) 0 i. - by rewrite mxE (nth_map i _) ?size_enum_ord // nth_ord_enum mxE. -by rewrite mxE. +apply/SAin_setP/eqP => [/holdsAnd xy|->]; + [apply/rowP => i; move: xy => /(_ i (mem_index_enum _) isT) /= + | apply/holdsAnd => i _ _ /=]; + (rewrite enum_ordD map_cat nth_catr; + last by rewrite 2!size_map size_enum_ord); + rewrite -map_comp (nth_map i) ?size_enum_ord// nth_ord_enum/=; + rewrite nth_cat 2!size_map size_enum_ord ltn_ord -map_comp; + rewrite (nth_map i) ?size_enum_ord// nth_ord_enum/= !mxE; + by rewrite (unsplitK (inl i)) (unsplitK (inr i)). Qed. -Fact SAfun_diagf (f : {SAfun F^1 -> F^1}) (n : nat) : - (diagf n f \in SAfunc) && (diagf n f \in SAtot). -Proof. by rewrite functional_diagf total_diagf. Qed. +Lemma SAfun_SAid n : + (SAid_graph n \in SAfunc) && (SAid_graph n \in SAtot). +Proof. +apply/andP; split; last by apply/inSAtot => y; exists y; rewrite SAid_graphP. +by apply/inSAfunc => x0 y1 y2; rewrite !SAid_graphP => /eqP -> /eqP. +Qed. + +Definition SAid n := MkSAfun (SAfun_SAid n). -Definition SAdiagf (f : {SAfun F^1 -> F^1}) (n : nat) := - MkSAfun (SAfun_diagf f n). +Lemma SAidE n (x : 'rV[F]_n) : + SAid n x = x. +Proof. by apply/eqP; rewrite inSAfun /SAid SAid_graphP. Qed. Definition comp_formula (m n p : nat) (f : {SAfun F^m -> F^n}) (g : {SAfun F^n -> F^p}) : formula F := @@ -2608,6 +1508,7 @@ Lemma holds_ngraph (m n : nat) (f : {SAfun F^m -> F^n}) (t : 'rV[F]_(m + n)) : reflect (holds (ngraph t) f) (t \in SAgraph f). Proof. by rewrite inE; apply: rcf_satP. Qed. +(* Who put composition in this direction? *) Lemma SAcomp_graphP (m n p : nat) (f : {SAfun F^m -> F^n}) (g : {SAfun F^n -> F^p}) (u : 'rV[F]_m) (v : 'rV[F]_p) : @@ -2618,52 +1519,2686 @@ have h : size ([seq u ord0 i | i <- enum 'I_m] ++ [seq v ord0 i | i <- enum 'I_p]) = (m + p)%N. by rewrite size_cat size_map size_enum_ord size_map size_enum_ord. rewrite /= -[X in nquantify X _ _ _]h. -apply: (sameP (rcf_satP _ _)). -apply: (equivP _ (nexistsP _ _ _)). -apply: (iffP idP); last first. -+ move=> [t] /=. - move=> [ /holds_subst hf /holds_subst hg]. - move: hf hg. - rewrite subst_env_cat -catA. - rewrite subst_env_iota_catl; last by rewrite size_map size_enum_ord. - rewrite catA subst_env_iota_catr ?size_tuple ?card_ord //. - rewrite subst_env_cat subst_env_iota_catr ?size_tuple ?card_ord //. - rewrite -catA subst_env_iota; last 2 first. - - by rewrite size_map size_enum_ord. - - by rewrite size_map size_enum_ord. - rewrite -[t]ngraph_tnth -!ngraph_cat. - move/holds_ngraph; rewrite -in_SAfun; move/eqP ->. - by move/holds_ngraph; rewrite -in_SAfun; move/eqP ->. -+ move/eqP => eq_gfu_v. +apply/(sameP (rcf_satP _ _))/(equivP _ (nexistsP _ _ _))/(iffP idP). + move/eqP => eq_gfu_v. exists (ngraph (f u)). split; apply/holds_subst; rewrite subst_env_cat. - - rewrite -catA subst_env_iota_catl; last by rewrite size_map size_enum_ord. + rewrite -catA subst_env_iota_catl; last by rewrite size_map size_enum_ord. rewrite catA subst_env_iota_catr ?size_tuple ?card_ord // -ngraph_cat. - by apply/holds_ngraph; apply: in_graph_SAfun. - - rewrite subst_env_iota_catr ?size_tuple ?card_ord //. - rewrite -catA subst_env_iota; last 2 first. - by rewrite size_map size_enum_ord. + by apply/holds_ngraph; apply: inSAgraph. + rewrite subst_env_iota_catr ?size_tuple ?card_ord //. + rewrite -catA subst_env_iota; last 2 first. by rewrite size_map size_enum_ord. - rewrite -ngraph_cat; apply/holds_ngraph; rewrite -eq_gfu_v. - exact: in_graph_SAfun. + by rewrite size_map size_enum_ord. + rewrite -ngraph_cat; apply/holds_ngraph; rewrite -eq_gfu_v. + exact: inSAgraph. +move=> [t] /= [ /holds_subst + /holds_subst]. +rewrite subst_env_cat -catA. +rewrite subst_env_iota_catl; last by rewrite size_map size_enum_ord. +rewrite catA subst_env_iota_catr ?size_tuple ?card_ord //. +rewrite subst_env_cat subst_env_iota_catr ?size_tuple ?card_ord //. +rewrite -catA subst_env_iota; first last. +- by rewrite size_map size_enum_ord. +- by rewrite size_map size_enum_ord. +rewrite -[t]ngraph_tnth -!ngraph_cat. +move/holds_ngraph; rewrite -inSAfun; move/eqP ->. +by move/holds_ngraph; rewrite -inSAfun; move/eqP ->. Qed. Fact SAfun_SAcomp (m n p : nat) (f : SAfun F m n) (g : SAfun F n p) : - (SAcomp_graph f g \in SAfunc) && (SAcomp_graph f g \in SAtot). + (SAcomp_graph f g \in SAfunc) && (SAcomp_graph f g \in SAtot). Proof. apply/andP; split. - by apply/SAfuncE => x y1 y2; rewrite !SAcomp_graphP; move=> /eqP-> /eqP->. -by apply/SAtotE => x; exists (g (f x)); rewrite SAcomp_graphP. + by apply/inSAfunc => x y1 y2; rewrite !SAcomp_graphP => /eqP -> /eqP ->. +by apply/inSAtot => x; exists (g (f x)); rewrite SAcomp_graphP. Qed. -Definition SAcomp (m n p : nat) (f : SAfun F m n) (g : SAfun F n p) := - MkSAfun (SAfun_SAcomp f g). +Definition SAcomp (m n p : nat) (f : SAfun F n p) (g : SAfun F m n) := + MkSAfun (SAfun_SAcomp g f). -Lemma SAcompP (m n p : nat) (f : SAfun F m n) (g : SAfun F n p) : - SAcomp f g =1 g \o f. +Lemma SAcompE (m n p : nat) (f : SAfun F n p) (g : SAfun F m n) : + SAcomp f g =1 f \o g. Proof. move=> x; apply/eqP; rewrite eq_sym -SAcomp_graphP. -by move: (in_graph_SAfun (SAcomp f g) x). +by move: (inSAgraph (SAcomp f g) x). +Qed. + +Definition SAfun_const_graph n m (x : 'rV[F]_m) : {SAset F^(n + m)%N} := + [set | \big[And/True]_(i : 'I_m) + ('X_(@unsplit n m (inr i)) == GRing.Const (x ord0 i))]. + +Lemma SAfun_constP n m (x : 'rV[F]_m) y z : + row_mx y z \in SAfun_const_graph n x = (z == x). +Proof. +apply/SAin_setP/eqP => [/holdsAnd zx|->]. + apply/rowP => i. + move/(_ i): zx; rewrite mem_index_enum => /(_ isT isT). + rewrite ngraph_cat/= nth_cat size_ngraph ltnNge leq_addr/=. + by rewrite subDnCA// subnn addn0 nth_ngraph. +apply/holdsAnd => i _ _ /=. +rewrite ngraph_cat/= nth_cat size_ngraph ltnNge leq_addr/=. +by rewrite subDnCA// subnn addn0 nth_ngraph. +Qed. + +Lemma SAfun_SAfun_const n m (x : 'rV[F]_m) : + (SAfun_const_graph n x \in SAfunc) && (SAfun_const_graph n x \in SAtot). +Proof. +apply/andP; split. + by apply/inSAfunc => x0 y1 y2; rewrite !SAfun_constP => /eqP -> /eqP. +by apply/inSAtot => y; exists x; rewrite SAfun_constP. +Qed. + +Definition SAfun_const n m (x : 'rV[F]_m) := MkSAfun (SAfun_SAfun_const n x). + +Lemma SAfun_constE n m (x : 'rV[F]_m) (y : 'rV[F]_n) : SAfun_const n x y = x. +Proof. by apply/eqP; rewrite inSAfun /SAfun_const SAfun_constP. Qed. + +Definition join_formula (m n p : nat) (f : {SAfun F^m -> F^n}) + (g : {SAfun F^m -> F^p}) : formula F := + (repr (val f)) /\ (subst_formula (iota 0 m ++ iota (m+n) p) (repr (val g))). + +Lemma nvar_join_formula (m n p : nat) (f : {SAfun F^m -> F^n}) + (g : {SAfun F^m -> F^p}) : + @nvar F (m + (n + p)) (join_formula f g). +Proof. +rewrite /nvar /join_formula /=; apply/fsubUsetP; split. + apply/(fsubset_trans (fsubset_formulan_fv f)). + by rewrite mnfset0_sub addnA leq_addr. +apply/(fsubset_trans (fv_subst_formula mnfset_key _ g)). +rewrite seq_fset_cat; apply/fsubUsetP; split. + by rewrite mnfset0_sub leq_addr. +case: {f g} p => [|p]; first by rewrite m0fset fsub0set. +by rewrite mnfset_sub //= !addnA. +Qed. + +Definition SAjoin_graph (m n p : nat) (f : {SAfun F^m -> F^n}) + (g : {SAfun F^m -> F^p}) := + \pi_{SAset F^(m + (n + p))} (MkFormulan (nvar_join_formula f g)). + +Lemma SAjoin_graphP (m n p : nat) (f : {SAfun F^m -> F^n}) + (g : {SAfun F^m -> F^p}) u v : + (row_mx u v \in SAjoin_graph f g) = (row_mx (f u) (g u) == v). +Proof. +move: (lsubmx v) (rsubmx v) (hsubmxK v) => l r <- {v}. +rewrite /SAjoin_graph /= pi_form /join_formula /= !ngraph_cat. +apply: (sameP (rcf_satP _ _)). +apply: (iffP eqP) => [|/= [/holds_take + /holds_subst]]; + last first. + rewrite subst_env_cat subst_env_iota_catl ?size_ngraph//. + rewrite catA -ngraph_cat subst_env_iota_catr ?size_ngraph//. + rewrite take_size_cat ?size_ngraph// -ngraph_cat. + move=> /holds_ngraph + /holds_ngraph. + by rewrite -!inSAfun => /eqP -> /eqP ->. +move=> /[dup] /(congr1 lsubmx) + /(congr1 rsubmx). +rewrite !row_mxKl !row_mxKr => <- <-. +split. + rewrite catA -ngraph_cat; apply/holds_take. + rewrite take_size_cat ?size_ngraph//. + exact/holds_ngraph/inSAgraph. +apply/holds_subst; rewrite subst_env_cat subst_env_iota_catl ?size_ngraph//. +rewrite catA -ngraph_cat subst_env_iota_catr ?size_ngraph// -ngraph_cat. +exact/holds_ngraph/inSAgraph. +Qed. + +Fact SAfun_SAjoin (m n p : nat) (f : {SAfun F^m -> F^n}) + (g : {SAfun F^m -> F^p}) : + (SAjoin_graph f g \in SAfunc) && (SAjoin_graph f g \in SAtot). +Proof. +apply/andP; split. + by apply/inSAfunc => x y1 y2; rewrite !SAjoin_graphP => /eqP <- /eqP. +by apply/inSAtot => x; exists (row_mx (f x) (g x)); rewrite SAjoin_graphP. +Qed. + +Definition SAjoin (m n p : nat) (f : {SAfun F^m -> F^n}) + (g : {SAfun F^m -> F^p}) := + MkSAfun (SAfun_SAjoin f g). + +Lemma SAjoinE (m n p : nat) (f : {SAfun F^m -> F^n}) + (g : {SAfun F^m -> F^p}) x : + SAjoin f g x = row_mx (f x) (g x). +Proof. by apply/eqP; rewrite eq_sym -SAjoin_graphP; apply/inSAgraph. Qed. + +Definition add_formula (p : nat) : formula F := + (\big[And/True]_(i : 'I_p) ('X_(i + 2 * p) == 'X_i + 'X_(i + p)))%oT. + +Lemma nvar_add_formula p : nvar (p + p + p) (add_formula p). +Proof. +apply/fsubsetP => x; rewrite formula_fv_bigAnd => /bigfcupP [i _] /fset1UP. +by case=> [->|/fset2P [|] ->]; + rewrite mnfsetE /= add0n 1?mulSn ?mul1n ?addnA ?ltn_add2r// -[i.+1]add0n; + apply/leq_add. +Qed. + +Definition SAadd_graph p := + \pi_{SAset F^(p + p + p)} (MkFormulan (nvar_add_formula p)). + +Lemma SAadd_graphP p u v : + (row_mx u v \in SAadd_graph p) = (v == lsubmx u + rsubmx u)%R. +Proof. +rewrite rowPE. +apply/(sameP (rcf_satP _ _))/(equivP _ (iff_sym (holds_repr_pi _ _))) => /=. +apply/(equivP _ (iff_sym (holdsAnd _ _ _ _)))/forallPP => /= i. +rewrite mem_index_enum mul2n -addnn addnA. +rewrite -[(i + p + p)%N]addnA [(i + _)%N]addnC. +rewrite (nth_map (unsplit (inr i))) ?size_enum_ord ?rshift_subproof//. +rewrite (nth_ord_enum _ (rshift (p + p)%N i)) row_mxEr. +have {1}->: i = lshift p i :> nat by []. +rewrite (nth_map (unsplit (inr i))) ?size_enum_ord ?lshift_subproof//. +rewrite (nth_ord_enum _ (lshift p (lshift p i))) row_mxEl. +have ->: (i + p)%N = rshift p i :> nat by rewrite addnC. +rewrite (nth_map (unsplit (inr i))) ?size_enum_ord ?lshift_subproof//. +rewrite (nth_ord_enum _ (lshift p (rshift p i))) row_mxEl !mxE. +by apply/(iffP eqP) => // /(_ Logic.eq_refl) /(_ Logic.eq_refl). +Qed. + +Fact SAfun_SAadd p : + (SAadd_graph p \in @SAfunc _ (p + p) p) + && (SAadd_graph p \in @SAtot _ (p + p) p). +Proof. +apply/andP; split. + by apply/inSAfunc => x y1 y2; rewrite !SAadd_graphP => /eqP -> /eqP. +apply/inSAtot => x; exists (lsubmx x + rsubmx x)%R. +by rewrite SAadd_graphP eqxx. +Qed. + +Definition SAadd p := MkSAfun (SAfun_SAadd p). + +Lemma SAaddE p x y : SAadd p (row_mx x y) = (x + y)%R. +Proof. by apply/eqP; rewrite inSAfun SAadd_graphP row_mxKl row_mxKr. Qed. + +Definition SAfun_add n p (f g : {SAfun F^n -> F^p}) := + SAcomp (SAadd p) (SAjoin f g). + +Lemma SAfun_addE n p (f g : {SAfun F^n -> F^p}) x : + SAfun_add f g x = (f x + g x)%R. +Proof. by rewrite SAcompE/= SAjoinE SAaddE. Qed. + +Definition opp_formula p : formula F := + (\big[And/True]_(i : 'I_p) ('X_(p + i) == - 'X_i))%oT. + +Lemma nvar_opp_formula p : nvar (p + p) (opp_formula p). +Proof. +apply/fsubsetP => x; rewrite formula_fv_bigAnd => /bigfcupP [i _] /fset2P. +case=> ->; rewrite seq_fsetE mem_iota /= add0n; last exact/ltn_addl. +by rewrite ltn_add2l. +Qed. + +Definition SAopp_graph p := + \pi_{SAset F^(p + p)} (MkFormulan (nvar_opp_formula p)). + +Lemma SAopp_graphP p u v : + (row_mx u v \in SAopp_graph p) = (v == - u)%R. +Proof. +rewrite rowPE. +apply/(sameP (rcf_satP _ _))/(equivP _ (iff_sym (holds_repr_pi _ _))) => /=. +apply/(equivP _ (iff_sym (holdsAnd _ _ _ _)))/forallPP => /= i. +rewrite mem_index_enum. +rewrite (nth_map (unsplit (inr i))) ?size_enum_ord ?rshift_subproof//. +rewrite (nth_ord_enum _ (rshift p i)) row_mxEr mxE. +rewrite (nth_map (unsplit (inr i))) ?size_enum_ord ?lshift_subproof//. +rewrite (nth_ord_enum _ (lshift p i)) row_mxEl. +by apply/(iffP eqP) => // /(_ Logic.eq_refl) /(_ Logic.eq_refl). +Qed. + +Fact SAfun_SAopp p : + (SAopp_graph p \in @SAfunc _ p p) && (SAopp_graph p \in @SAtot _ p p). +Proof. +apply/andP; split. + by apply/inSAfunc => x y1 y2; rewrite !SAopp_graphP => /eqP -> /eqP. +by apply/inSAtot => x; exists (-x)%R; rewrite SAopp_graphP eqxx. +Qed. + +Definition SAopp p := MkSAfun (SAfun_SAopp p). + +Lemma SAoppE p x : SAopp p x = - x. +Proof. by apply/eqP; rewrite inSAfun SAopp_graphP. Qed. + +Definition SAfun_opp n p (f : {SAfun F^n -> F^p}) := + SAcomp (SAopp p) f. + +Lemma SAfun_oppE n p (f : {SAfun F^n -> F^p}) x : + SAfun_opp f x = - f x. +Proof. by rewrite SAcompE/= SAoppE. Qed. + +Definition SAfun_sub n p (f g : {SAfun F^n -> F^p}) := + SAcomp (SAadd p) (SAjoin f (SAcomp (SAopp p) g)). + +Lemma SAfun_subE n p (f g : {SAfun F^n -> F^p}) x : + SAfun_sub f g x = f x - g x. +Proof. by rewrite SAcompE/= SAjoinE SAcompE/= SAoppE SAaddE. Qed. + +Lemma SAfun_addA n p : associative (@SAfun_add n p). +Proof. +move=> f g h; apply/eqP/SAfunE => x. +by rewrite !SAfun_addE addrA. +Qed. + +Lemma SAfun_addC n p : commutative (@SAfun_add n p). +Proof. +move=> f g; apply/eqP/SAfunE => x. +by rewrite !SAfun_addE addrC. +Qed. + +Lemma SAfun_add0r n p : left_id (SAfun_const n (0 : 'rV[F]_p)) (@SAfun_add n p). +Proof. +move=> f; apply/eqP/SAfunE => x. +by rewrite SAfun_addE SAfun_constE add0r. +Qed. + +Lemma SAfun_addNr n p : + left_inverse (SAfun_const n (0 : 'rV[F]_p)) (@SAfun_opp n p) (@SAfun_add n p). +Proof. +move=> f; apply/eqP/SAfunE => x. +by rewrite SAfun_addE SAfun_oppE SAfun_constE addNr. +Qed. + +HB.instance Definition _ n p := GRing.isZmodule.Build {SAfun F^n -> F^p} + (@SAfun_addA n p) (@SAfun_addC n p) (@SAfun_add0r n p) (@SAfun_addNr n p). + +Definition SAmul_graph p : {SAset F^(p + p + p)} := + [set| \big[And/True]_(i < p) ('X_(p.*2 + i) == 'X_i * 'X_(p + i))]. + +Lemma SAmul_graphP p u v : + (row_mx u v \in SAmul_graph p) + = (v == \row_i (lsubmx u 0 i * rsubmx u 0 i))%R. +Proof. +rewrite inE rcf_sat_repr_pi rcf_sat_subst -[_ (ngraph _)]cats0. +rewrite subst_env_iota_catl ?size_ngraph// rcf_sat_forall rowPE. +apply/eq_forallb => /= i. +rewrite !simp_rcf_sat/= enum_ordD map_cat !nth_cat 2!size_map size_enum_ord. +rewrite ltnNge -addnn leq_addr/= subDnCA// subnn addn0. +rewrite (leq_trans (ltn_ord i) (leq_addr _ _))/=. +rewrite ltn_add2l ltn_ord/= -map_comp nth_map_ord. +have iE: i = lshift p i :> nat by []. +rewrite [X in _`_X]iE -map_comp nth_map_ord. +have {}iE: p + i = rshift p i :> nat by []. +by rewrite [X in _`_X]iE nth_map_ord !mxE/= (unsplitK (inr _)) !(unsplitK (inl _)). +Qed. + +Fact SAfun_SAmul p : + (SAmul_graph p \in @SAfunc _ (p + p) p) + && (SAmul_graph p \in @SAtot _ (p + p) p). +Proof. +apply/andP; split. + by apply/inSAfunc => x y1 y2; rewrite !SAmul_graphP => /eqP -> /eqP. +apply/inSAtot => x; exists (\row_i (lsubmx x 0 i * rsubmx x 0 i))%R. +by rewrite SAmul_graphP eqxx. +Qed. + +Definition SAmul p := MkSAfun (SAfun_SAmul p). + +Lemma SAmulE p x y : SAmul p (row_mx x y) = \row_i (x 0 i * y 0 i)%R. +Proof. by apply/eqP; rewrite inSAfun SAmul_graphP row_mxKl row_mxKr. Qed. + +Definition SAfun_mul n p (f g : {SAfun F^n -> F^p}) := + SAcomp (SAmul p) (SAjoin f g). + +Lemma SAfun_mulE n p (f g : {SAfun F^n -> F^p}) x : + SAfun_mul f g x = \row_i (f x 0 i * g x 0 i)%R. +Proof. by rewrite SAcompE/= SAjoinE SAmulE. Qed. + +Definition SAinv_graph n : {SAset F^(n + n)} := + [set| \big[And/True]_(i < n) + ('X_i * 'X_(n + i) == Const 1%R + \/ 'X_i == Const 0%R /\ 'X_(n + i) == Const 0%R)]. + +Lemma SAinv_graphP n x y : + row_mx x y \in SAinv_graph n = (y == \row_i (x 0 i)^-1). +Proof. +rewrite inE rcf_sat_repr_pi rcf_sat_subst -[_ (ngraph _)]cats0. +rewrite subst_env_iota_catl ?size_ngraph// rcf_sat_forall rowPE. +apply/eq_forallb => /= i. +rewrite !simp_rcf_sat/= enum_ordD map_cat !nth_cat 2!size_map size_enum_ord. +rewrite (ltn_ord i) ltnNge leq_addr/= subDnCA// subnn addn0. +rewrite -map_comp nth_map_ord -map_comp nth_map_ord !mxE/=. +rewrite (unsplitK (inl _)) (unsplitK (inr _)). +have [->|x0] := eqVneq (x 0 i) 0. + by rewrite invr0 mul0r eq_sym oner_eq0/=. +by rewrite orbF -(divff x0) -subr_eq0 -mulrBr mulf_eq0 (negPf x0)/= subr_eq0. +Qed. + +Fact SAfun_SAinv p : + (SAinv_graph p \in @SAfunc _ p p) && (SAinv_graph p \in @SAtot _ p p). +Proof. +apply/andP; split. + by apply/inSAfunc => x y1 y2; rewrite !SAinv_graphP => /eqP -> /eqP. +by apply/inSAtot => x; exists (\row_i (x 0 i)^-1)%R; rewrite SAinv_graphP eqxx. +Qed. + +Definition SAinv p := MkSAfun (SAfun_SAinv p). + +Lemma SAinvE p x : SAinv p x = \row_i (x 0 i)^-1. +Proof. by apply/eqP; rewrite inSAfun SAinv_graphP. Qed. + +Definition SAfun_inv n p (f : {SAfun F^n -> F^p}) := + SAcomp (SAinv p) f. + +Lemma SAfun_invE n p (f : {SAfun F^n -> F^p}) x : + SAfun_inv f x = \row_i (f x 0 i)^-1. +Proof. by rewrite SAcompE/= SAinvE. Qed. + +Definition SAfun_div n p (f g : {SAfun F^n -> F^p}) := + SAcomp (SAmul p) (SAjoin f (SAcomp (SAinv p) g)). + +Lemma SAfun_divE n p (f g : {SAfun F^n -> F^p}) x : + SAfun_div f g x = \row_i (f x 0 i / g x 0 i). +Proof. +rewrite SAcompE/= SAjoinE SAcompE/= SAinvE SAmulE. +by apply/rowP => i; rewrite !mxE. +Qed. + +Definition SAfun_le n (f g : {SAfun F^n -> F^1}) := + SAgraph (SAfun_sub g f) :<=: (SAsetT F n) :*: (SAset_itv `[0, +oo[%R). + +Lemma SAfun_leP n (f g : {SAfun F^n -> F^1}) : + reflect (forall x, f x ord0 ord0 <= g x ord0 ord0) (SAfun_le f g). +Proof. +apply/(iffP (SAset_subP _ _)) => fg x. + move/(_ (row_mx x (g x - f x))) : fg. + rewrite -inSAfun SAfun_subE => /(_ (eqxx _)). + rewrite inSAsetX row_mxKl row_mxKr inSAset_itv in_itv/= !mxE subr_ge0 andbT. + by move=> /andP[_]. +rewrite -[x]hsubmxK -inSAfun SAfun_subE inSAsetX row_mxKl row_mxKr => /eqP <-. +move/(_ (lsubmx x)): fg. +by rewrite inSAsetT inSAset_itv in_itv/= !mxE subr_ge0 andbT. +Qed. + +(* alias on which we define the porder on functions *) +Definition SAfunleType n := {SAfun F^n -> F^1}. + +HB.instance Definition _ n := Equality.on (SAfunleType n). +HB.instance Definition _ n := Choice.on (SAfunleType n). + +Lemma SAfun_le_refl n : reflexive (@SAfun_le n). +Proof. by move=> f; apply/SAfun_leP => x; apply/lexx. Qed. + +Lemma SAfun_le_anti n : antisymmetric (@SAfun_le n). +Proof. +move=> f g /andP[] /SAfun_leP fg /SAfun_leP gf; apply/eqP/SAfunE => x. +apply/rowP; case; case => [|//] lt01; apply/le_anti. +have ->: Ordinal lt01 = 0 by apply/val_inj. +by apply/andP; split. +Qed. + +Lemma SAfun_le_trans n : transitive (@SAfun_le n). +Proof. +move=> f g h /SAfun_leP gf /SAfun_leP fh; apply/SAfun_leP => x. +exact/(le_trans (gf x) (fh x)). +Qed. + +HB.instance Definition _ n := + Order.Le_isPOrder.Build ring_display (SAfunleType n) (@SAfun_le_refl n) + (@SAfun_le_anti n) (@SAfun_le_trans n). + +Definition SAfun_lt n (f g : {SAfun F^n -> F^1}) := + SAgraph (SAfun_sub g f) :<=: (SAsetT F n) :*: (SAset_pos F). + +Lemma SAfun_ltP n (f g : {SAfun F^n -> F^1}) : + reflect (forall x, f x ord0 ord0 < g x ord0 ord0) (SAfun_lt f g). +Proof. +apply/(iffP (SAset_subP _ _)) => fg x. + move/(_ (row_mx x (g x - f x))) : fg. + rewrite -inSAfun SAfun_subE => /(_ (eqxx _)). + by rewrite inSAsetX row_mxKl row_mxKr inSAset_pos !mxE subr_gt0 => /andP[_]. +rewrite -[x]hsubmxK -inSAfun SAfun_subE inSAsetX row_mxKl row_mxKr => /eqP <-. +by move/(_ (lsubmx x)): fg; rewrite inSAsetT inSAset_pos !mxE subr_gt0. +Qed. + +(* alias on which we define the strict order on functions *) +Definition SAfunltType n := {SAfun F^n -> F^1}. + +HB.instance Definition _ n := Equality.on (SAfunltType n). +HB.instance Definition _ n := Choice.on (SAfunltType n). + +Lemma SAfun_lt_irr n : irreflexive (@SAfun_lt n). +Proof. by move=> f; apply/negP => /SAfun_ltP /(_ 0); rewrite ltxx. Qed. + +Lemma SAfun_lt_trans n : transitive (@SAfun_lt n). +Proof. +move=> f g h /SAfun_ltP gf /SAfun_ltP fh; apply/SAfun_ltP => x. +exact/(lt_trans (gf x) (fh x)). +Qed. + +HB.instance Definition _ n := + Order.Lt_isPOrder.Build ring_display (SAfunltType n) (@SAfun_lt_irr n) + (@SAfun_lt_trans n). + +Definition SAmpoly_graph n (p : {mpoly F[n]}) : {SAset F^(n + 1)} := + [set | 'X_n == term_mpoly p (fun i => 'X_i)]. + +Lemma SAmpoly_graphP n (p : {mpoly F[n]}) x y : + (row_mx x y \in SAmpoly_graph p) = (y ord0 ord0 == p.@[x ord0]). +Proof. +by apply/SAin_setP/eqP; rewrite /= eval_term_mpoly enum_ordD/= map_cat; + rewrite nth_cat/= -map_comp size_map size_enum_ord ltnn subnn enum_ordSl; + rewrite enum_ord0/= row_mxEr => ->; apply/meval_eq => i /=; + rewrite nth_cat size_map size_enum_ord (ltn_ord i); + rewrite (nth_map i) ?size_enum_ord// nth_ord_enum/= row_mxEl. Qed. -End SASetTheory. +Lemma SAfun_SAmpoly n p : + (SAmpoly_graph p \in @SAfunc _ n 1) && (SAmpoly_graph p \in @SAtot _ n 1). +Proof. +apply/andP; split. + apply/inSAfunc => x y1 y2; rewrite !SAmpoly_graphP => /eqP <- /eqP y12. + apply/rowP; case; case=> //= lt01. + by move/esym: y12; congr (_ = _); congr (_ _ _); apply/val_inj. +by apply/inSAtot => x; exists (\row__ p.@[x ord0]); rewrite SAmpoly_graphP mxE. +Qed. + +Definition SAmpoly n (p : {mpoly F[n]}) := MkSAfun (SAfun_SAmpoly p). + +Lemma SAmpolyE n (p : {mpoly F[n]}) x : + SAmpoly p x = \row__ p.@[x ord0]. +Proof. by apply/eqP; rewrite inSAfun SAmpoly_graphP !mxE. Qed. + +Definition SAselect_graph n m s : {SAset F^(n + m)} := + [set| \big[And/True]_(i : 'I_m) + ('X_(n + i) == 'X_(if (n <= (s`_i)%R)%N then ((s`_i)%R + m)%N else s`_i))]. + +Lemma SAselect_graphP n m s u v : + (row_mx u v \in SAselect_graph n m s) = (v == \row_i (ngraph u)`_(s`_i))%R. +Proof. +apply/SAin_setP/eqP => /= [|->]. + move=> /holdsAnd vE; apply/rowP => i. + move: vE => /(_ i (mem_index_enum _) isT)/=. + rewrite enum_ordD map_cat nth_catr 2?size_map ?size_enum_ord//. + rewrite -map_comp (nth_map i) ?size_enum_ord// nth_ord_enum/= !mxE. + rewrite (unsplitK (inr i)) nth_cat 2!size_map size_enum_ord. + case: (ltnP (s`_i)%R n) => ni ->. + rewrite ni -map_comp (nth_map (Ordinal ni)) ?size_enum_ord//. + rewrite (nth_map (Ordinal ni)) ?size_enum_ord//. + rewrite -[s`_i]/(nat_of_ord (Ordinal ni)) nth_ord_enum/= mxE. + by rewrite (unsplitK (inl (Ordinal ni))). + rewrite ltnNge (leq_trans ni (leq_addr _ _))/= nth_default. + by rewrite nth_default// size_map size_enum_ord. + by rewrite size_map size_enum_ord -addnBAC// leq_addl. +apply/holdsAnd => i _ _ /=. +rewrite enum_ordD map_cat nth_catr 2?size_map ?size_enum_ord//. +rewrite -map_comp (nth_map i) ?size_enum_ord// nth_ord_enum/= !mxE. +rewrite (unsplitK (inr i)) mxE nth_cat 2!size_map size_enum_ord. +case: (ltnP (s`_i)%R n) => ni. + rewrite ni -map_comp (nth_map (Ordinal ni)) ?size_enum_ord//. + rewrite (nth_map (Ordinal ni)) ?size_enum_ord//. + rewrite -[s`_i]/(nat_of_ord (Ordinal ni)) nth_ord_enum/= mxE. + by rewrite (unsplitK (inl (Ordinal ni))). +rewrite ltnNge (leq_trans ni (leq_addr _ _))/= nth_default; last first. + by rewrite size_map size_enum_ord. +by rewrite nth_default// size_map size_enum_ord -addnBAC// leq_addl. +Qed. + +Fact SAfun_SAselect n m s : + (SAselect_graph n m s \in @SAfunc _ n m) + && (SAselect_graph n m s \in @SAtot _ n m). +Proof. +apply/andP; split. + by apply/inSAfunc => u y1 y2; rewrite !SAselect_graphP => /eqP -> /eqP. +apply/inSAtot => u; exists (\row_i (ngraph u)`_(s`_i))%R. +by rewrite SAselect_graphP eqxx. +Qed. + +Definition SAselect n m s := MkSAfun (SAfun_SAselect n m s). + +Lemma SAselectE n m s u : + SAselect n m s u = \row_i (ngraph u)`_(s`_i). +Proof. by apply/eqP; rewrite inSAfun SAselect_graphP. Qed. + +Lemma SAselect_iotal n m x : + SAselect (n + m) n (iota 0 n) x = lsubmx x. +Proof. +apply/rowP => i; rewrite SAselectE !mxE nth_iota//. +have ->: (0 + i = lshift m i)%N by []. +by rewrite nth_ngraph. +Qed. + +Lemma SAselect_iotar n m (x : 'rV[F]_(n + m)) : + SAselect _ _ (iota n m) x = rsubmx x. +Proof. +apply/rowP => i; rewrite SAselectE !mxE/= nth_iota//. +by rewrite -[X in _`_X]/(nat_of_ord (rshift n i)) nth_map_ord. +Qed. + +Lemma SAset_castE_select n m s : + SAset_cast m s = SAimset (SAselect n m (iota 0 m)) s. +Proof. +apply/eqP/SAsetP => x. +case: (ltnP n m) => nm. + move: x; rewrite -(subnKC (ltnW nm)) => x. + rewrite inSAset_castnD; apply/andP/SAimsetP => -[]; last first. + move=> y ys ->; rewrite SAselectE; split. + move: ys; congr (_ \in s); apply/rowP => i. + by rewrite !mxE nth_iota// nth_ngraph. + apply/eqP/rowP => i; rewrite !mxE nth_iota// nth_default// size_ngraph. + exact/leq_addr. + move=> xs /eqP x0; exists (lsubmx x) => //. + apply/rowP => i; rewrite SAselectE mxE nth_iota// add0n. + case: (ltnP i n) => ni. + have ->: i = Ordinal ni :> nat by []. + by rewrite nth_ngraph mxE; congr (x _ _); apply/val_inj. + rewrite nth_default ?size_ngraph// -[x]hsubmxK mxE. + have ilt: (i - n < m - n)%N by rewrite leq_ltn_subLR. + have ->: i = rshift n (Ordinal ilt). + by apply/val_inj => /=; rewrite [(n + (i - n))%N]subnKC. + by rewrite (unsplitK (inr _)) x0 mxE. +move: s; rewrite -(subnKC nm) => s. +apply/inSAset_castDn/SAimsetP => -[] y. + move=> [] ys ->; exists y => //. + apply/rowP => i; rewrite SAselectE !mxE nth_iota//. + have iE: i = lshift (n - m) i :> nat by []. + by rewrite [X in _`_X]iE nth_ngraph. +move=> ys ->; exists y; split=> //. +apply/rowP => i; rewrite SAselectE !mxE nth_iota//. +have iE: i = lshift (n - m) i :> nat by []. +by rewrite [X in _`_X]iE nth_ngraph. +Qed. + +Fixpoint SAsum n : {SAfun F^n -> F^1}. +Proof. +case: n => [|n]; first exact: (SAfun_const 0 0). +apply/(SAcomp (SAadd 1) (SAjoin _ (SAselect _ 1 [:: n]))). +apply/(SAcomp (SAsum n) _). +exact/(SAselect _ _ (iota 0 n)). +Defined. + +Lemma SAsumE n u : SAsum n u = \row__ \sum_i (u ord0 i)%R. +Proof. +apply/eqP; rewrite rowPE forall_ord1 mxE; apply/eqP. +elim: n u => [|n IHn] u; first by rewrite /SAsum SAfun_constE big_ord0 mxE. +rewrite /= SAcompE/= SAjoinE SAaddE SAcompE/= !SAselectE !mxE IHn/=. +rewrite (nth_map ord0) ?size_enum_ord//. +rewrite -[X in nth _ _ X]/(nat_of_ord (@ord_max n)) nth_ord_enum big_ord_recr/=. +congr (_ + _)%R; apply/eq_bigr => i _. +rewrite mxE nth_iota// (nth_map ord0); last first. + by rewrite size_enum_ord ltnS ltnW//= add0n. +congr (u _ _). +have ->: i = lift ord_max i :> nat by rewrite /= /bump leqNgt (ltn_ord i). +rewrite nth_ord_enum; apply/val_inj => /=. +by rewrite /bump leqNgt (ltn_ord i). +Qed. + +(* Evaluates a polynomial represented in big-endian in F^n at a point in F. *) +Definition SAhorner_graph n : {SAset F^(n + 1 + 1)} := + [set| nquantify n.+2 n Exists ( + subst_formula (rcons (iota n.+2 n) n.+1) (SAsum n) /\ + \big[And/True]_(i < n) ('X_(n.+2 + i) == ('X_i * 'X_n ^+ i)))]. + +Lemma SAhorner_graphP n (u : 'rV[F]_(n + 1)) (v : 'rV[F]_1) : + (row_mx u v \in SAhorner_graph n) + = (v == \row__ (\poly_(i < n) (ngraph u)`_i).[u ord0 (rshift n ord0)])%R. +Proof. +rewrite /SAhorner_graph -2![X in nquantify X]addn1. +rewrite -[X in nquantify X](size_ngraph (row_mx u v)). +apply/SAin_setP/eqP => [/nexistsP[x]/= []|vE]. + move=> /holds_subst + /holdsAnd/= xE. + rewrite -cats1 subst_env_cat/= subst_env_iota_catr; first last. + - exact/size_tuple. + - by rewrite size_map size_enum_ord !addn1. + rewrite nth_cat size_map size_enum_ord 2!{1}addn1 leqnn. + have nsE: n.+1 = rshift (n + 1)%N (@ord0 0) by rewrite /= addn0 addn1. + rewrite [X in _`_X]nsE nth_map_ord mxE (unsplitK (inr _)) => xv. + have {xv} <-: SAsum _ (\row_(i < n) tnth x i) = v. + apply/eqP; rewrite inSAfun. + apply/rcf_satP; rewrite ngraph_cat ngraph_tnth. + suff ->: ngraph v = [:: v ord0 ord0] :> seq _ by []. + apply/(@eq_from_nth _ 0); first exact/size_ngraph. + rewrite size_ngraph; case=> // ltn01. + by rewrite -[X in _`_X]/(nat_of_ord (@ord0 0)) nth_mktuple. + rewrite SAsumE; apply/eqP; rewrite rowPE forall_ord1 !mxE horner_poly. + apply/eqP/eq_bigr => /= i _. + have {1}->: i = lshift 1 (lshift 1 i) :> nat by []. + rewrite mxE nth_map_ord. + move: xE => /(_ i (mem_index_enum _) isT). + rewrite nth_cat size_map size_enum_ord 2!{1}addn1 ltnNge (leq_addr _)/=. + rewrite 2!{1}addn1 subDnCA// subnn addn0. + rewrite nth_cat size_map size_enum_ord 2!{1}addn1. + rewrite (ltn_trans (ltn_ord i) (leqnSn n.+1)). + rewrite nth_cat size_map size_enum_ord [X in (_ < X + 1)%N]addn1 leq_addr. + have nE: n = lshift 1 (rshift n (@ord0 0)) by rewrite /= addn0. + have {2}->: i = lshift 1 (lshift 1 i) :> nat by []. + by rewrite [X in _`_X ^+ _]nE !nth_map_ord !mxE !(unsplitK (inl _)) -tnth_nth. +apply/nexistsP. +exists ([tuple ((ngraph u)`_i * u ord0 (rshift n ord0) ^+ i)%R | i < n]) => /=. +split. + apply/holds_subst. + rewrite -cats1 subst_env_cat/= subst_env_iota_catr; first last. + - by rewrite size_map size_enum_ord. + - by rewrite size_map size_enum_ord !addn1. + rewrite nth_cat size_map size_enum_ord 2![in X in (_ < X)%N]addn1 leqnn. + have nsE: n.+1 = rshift (n + 1) (@ord0 0) by rewrite /= addn0 addn1. + rewrite [X in _`_X]nsE nth_map_ord mxE (unsplitK (inr _)). + suff: SAsum _ (\row_(i < n) ((ngraph u)`_i * u ord0 (rshift n ord0) ^+ i)%R) + = v. + move=> /eqP; rewrite inSAfun => /rcf_satP. + rewrite ngraph_cat; congr holds; congr cat; last first. + by rewrite /= enum_ordSl enum_ord0/=. + apply/(@eq_from_nth _ 0). + by rewrite size_ngraph size_map size_enum_ord. + rewrite size_ngraph => i ilt. + by rewrite -/(nat_of_ord (Ordinal ilt)) nth_mktuple nth_map_ord mxE. + rewrite SAsumE; apply/eqP; rewrite rowPE forall_ord1 vE horner_poly !mxE. + apply/eqP/eq_bigr => /= i _; rewrite mxE. + have {1 3}->: i = lshift 1 (lshift 1 i) :> nat by []. + by rewrite nth_map_ord. +apply/holdsAnd => i _ _ /=. +rewrite nth_cat size_map size_enum_ord 2!{1}addn1 ltnNge (leq_addr _)/=. +rewrite 2![in X in (_ - X)%N]addn1 subDnCA// subnn addn0. +rewrite nth_cat size_map size_enum_ord 2![in X in (_ - X)%N]addn1. +rewrite -[X in (_ < X)%N]addnA (leq_trans (ltn_ord i) (leq_addr _ _)). +rewrite nth_cat size_map size_enum_ord [X in (_ < X + 1)%N]addn1 leq_addr. +rewrite nth_map_ord. +have nE: n = lshift 1 (rshift n (@ord0 0)) by rewrite /= addn0. +have {1 3}->: i = lshift 1 (lshift 1 i) :> nat by []. +by rewrite [X in _`_X ^+ _]nE !nth_map_ord !mxE !(unsplitK (inl _)). +Qed. + +Fact SAfun_SAhorner n : + (SAhorner_graph n \in @SAfunc _ (n + 1) 1) + && (SAhorner_graph n \in @SAtot _ (n + 1) 1). +Proof. +apply/andP; split. + by apply/inSAfunc => u y1 y2; rewrite !SAhorner_graphP => /eqP -> /eqP. +apply/inSAtot => u. +exists (\row__ (\poly_(i < n) (ngraph u)`_i).[u ord0 (rshift n ord0)])%R. +by rewrite SAhorner_graphP eqxx. +Qed. + +Definition SAhorner n := MkSAfun (SAfun_SAhorner n). + +Lemma SAhornerE n u : + SAhorner n u + = (\row__ (\poly_(i < n) (ngraph u)`_i).[u ord0 (rshift n ord0)])%R. +Proof. by apply/eqP; rewrite inSAfun SAhorner_graphP. Qed. + +Definition rootsR_formula n i := + (((\big[And/True]_(j < n) ('X_j == 0)) /\ (if i == 0%N then True else False)) + \/ \big[And/True]_(j < i) subst_formula + (iota 0 n ++ [:: (n + j)%N; (n + i)%N]) + (SAhorner_graph n) + /\ \big[And/True]_(j < i.-1) ('X_(n + j) <% 'X_(n + j.+1))%oT /\ + ('forall 'X_(n + i), + subst_formula (iota 0 n ++ [:: (n + i)%N; (n + i).+1]) + (SAhorner_graph n) ==> + \big[Or/False]_(j < i) ('X_(n + i) == 'X_(n + j))))%oT. + +Lemma rootsR_formulaE n (u : 'rV[F]_n) d (r : d.-tuple F) : + rcf_sat (ngraph u ++ r) (rootsR_formula n d) + = (tval r == rootsR (\poly_(i0 < n) (ngraph u)`_i0)). +Proof. +have subst_envE (v : 'rV[F]_n) (x : F) (m : nat) (s : m.-tuple F) : + (subst_env (iota 0 n ++ [:: (n + m)%N; (n + m).+1]) + (set_nth 0 (ngraph v ++ s) + (n + m) x)) + = ngraph v ++ [:: x; 0]. + rewrite set_nth_cat size_map size_enum_ord ltnNge leq_addr/=. + rewrite subst_env_cat subst_env_iota_catl/=; last first. + by rewrite size_map size_enum_ord. + rewrite !subDnCA// subnn !addn0 !nth_cat size_map size_enum_ord. + rewrite ltnNge leq_addr -addnS ltnNge leq_addr/= !subDnCA// subnn !addn0. + rewrite !nth_set_nth/= eqxx -[X in X == _]addn1 -[X in _ == X]addn0. + by rewrite eqn_add2l/= [_`_m.+1]nth_default// size_tuple. +rewrite /rootsR_formula !simp_rcf_sat !rcf_sat_forall. +under eq_forallb => /= i. + rewrite simp_rcf_sat/= nth_cat size_map size_enum_ord (ltn_ord i) nth_map_ord. + over. +have ->: [forall i, u ord0 i == 0] = (u == 0). + by rewrite rowPE; apply/eq_forallb => /= i; rewrite mxE. +under [X in [&& X, _ & _]]eq_forallb => /= i. + rewrite rcf_sat_subst subst_env_cat subst_env_iota_catl/=; last first. + by rewrite size_map size_enum_ord. + rewrite !nth_cat size_map size_enum_ord ltnNge leq_addr ltnNge leq_addr/=. + rewrite !subDnCA// subnn !addn0 [_`_d]nth_default ?size_tuple//. + over. +under [X in [&& _, X & _]]eq_forallb => /= i. + rewrite simp_rcf_sat/=. + rewrite !nth_cat size_map size_enum_ord ltnNge leq_addr ltnNge leq_addr/=. + rewrite !subDnCA// subnn !addn0. + over. +have [->|u0] /= := eqVneq u 0. + have p0: \poly_(i0 < n) [seq (0 : 'rV[F]_n) ord0 i | i <- enum 'I_n]`_i0 = 0. + apply/polyP => i; rewrite coef_poly coef0. + case: (ltnP i n) => [ilt|//]. + by rewrite -/(nat_of_ord (Ordinal ilt)) nth_map_ord mxE. + rewrite p0 rootsR0 -size_eq0 size_tuple; case: d r => [//|d] r /=. + apply/negP => /= /andP[_] /andP[] /forallP/= rsort /rcf_satP/=. + move=> /(_ (r`_(@ord0 d) - 1))/(_ _)/wrap[]. + apply/holds_subst; rewrite subst_envE. + suff: SAhorner n (row_mx 0 (\row__ (r`_0 - 1))) = 0. + move=> /eqP; rewrite inSAfun => /rcf_satP; rewrite !ngraph_cat -catA. + by congr (holds (_ ++ _) _); rewrite /= enum_ordSl enum_ord0/= !mxE. + rewrite SAhornerE !mxE (unsplitK (inr _)) !mxE. + apply/rowP => j; rewrite ord1 !mxE. + under eq_poly => i ilt. + rewrite ngraph_cat nth_cat size_ngraph ilt. + over. + by rewrite p0 horner0. + move=> /holdsOr[/=] i [_][_]. + rewrite !nth_set_nth/= eqxx eqn_add2l. + move: (ltn_ord i); have [->|_ _] := eqVneq (i : nat) d.+1. + by rewrite ltnn. + rewrite nth_cat size_map size_enum_ord ltnNge leq_addr/=. + rewrite subDnCA// subnn addn0 => /eqP iE. + case: (posnP i) => i0. + by move: iE; rewrite i0 -subr_eq0 addrAC subrr add0r oppr_eq0 oner_eq0. + have: sorted <%O r. + apply/(sortedP 0) => j; rewrite size_tuple ltnS => jd. + exact/(rsort (Ordinal jd)). + rewrite lt_sorted_pairwise => /(pairwiseP 0)/(_ 0 i). + rewrite !inE size_tuple ltnS => /(_ (leq0n _) (ltn_ord i) i0). + by rewrite -(eqP iE) -subr_gt0 addrAC subrr add0r oppr_gt0 ltr10. +case: d r => [|d]r. + rewrite !forall_ord0/= tuple0/= => {r}. + move rE: (rootsR _) => r; case: r rE => [|x r] rE. + apply/rcf_satP => /= x /holds_subst; rewrite big_ord0/= subst_envE => x0. + suff: x \in [::] by []. + rewrite -rE in_rootsR; apply/andP; split. + move: u0; apply/contraNN => /eqP/polyP u0. + apply/eqP/rowP => i; rewrite mxE. + by move: (u0 i); rewrite coef0 coef_poly (ltn_ord i) nth_map_ord. + have: SAhorner n (row_mx u (\row__ x)) = 0. + apply/eqP; rewrite inSAfun; apply/rcf_satP; rewrite !ngraph_cat -catA. + move: x0; congr (holds (_ ++ _) _). + by rewrite /= enum_ordSl enum_ord0/= !mxE. + rewrite SAhornerE !mxE (unsplitK (inr _)) !mxE => /eqP. + rewrite rowPE forall_ord1 !mxE /root. + congr (_.[_] == 0); apply/polyP => i. + rewrite !coefE; case: (ltnP i n) => [ilt|//]. + by rewrite ngraph_cat nth_cat size_ngraph ilt. + apply/rcf_satP => /= /(_ x); rewrite big_ord0/= => /(_ _)/wrap[]//. + apply/holds_subst; rewrite subst_envE. + move: (mem_head x r); rewrite -rE in_rootsR => /andP[_] x0. + suff: SAhorner n (row_mx u (\row__ x)) = 0. + move=> /eqP; rewrite inSAfun => /rcf_satP; rewrite !ngraph_cat -catA. + by congr (holds (_ ++ _) _); rewrite /= enum_ordSl enum_ord0/= !mxE. + rewrite SAhornerE !mxE (unsplitK (inr _)) !mxE. + apply/rowP => j; rewrite ord1 !mxE. + under eq_poly => i ilt. + rewrite ngraph_cat nth_cat size_ngraph ilt. + over. + exact/eqP. +apply/andP/eqP => /=. + move=> [] /forallP/= r0 /andP[] /forallP/= rsort /rcf_satP/= rall. + apply/rootsRPE. + - move=> i. + move: r0 {rsort rall} => /(_ i) /rcf_satP ri0. + suff: SAhorner n (row_mx u (\row__ r`_i)) = 0. + move=> /eqP; rewrite SAhornerE rowPE forall_ord1 !mxE (unsplitK (inr _)). + rewrite !mxE -tnth_nth /root; congr (_.[_]%R == 0). + by apply/eq_poly => k kn; rewrite ngraph_cat nth_cat size_ngraph kn. + apply/eqP; rewrite inSAfun; apply/rcf_satP; rewrite !ngraph_cat -catA. + move: ri0; congr (holds (_ ++ _) _). + by rewrite /= enum_ordSl enum_ord0/= !mxE. + - move=> x x0; move: rall {r0 rsort} => /(_ x)/(_ _)/wrap[]. + apply/holds_subst; rewrite subst_envE. + have: SAhorner n (row_mx u (\row__ x)) = 0. + apply/eqP; rewrite SAhornerE rowPE forall_ord1 !mxE (unsplitK (inr _)). + rewrite mxE; move: x0; rewrite /root; congr (_.[_]%R == 0). + by apply/eq_poly => k kn; rewrite ngraph_cat nth_cat size_ngraph kn. + move=> /eqP; rewrite inSAfun => /rcf_satP; rewrite !ngraph_cat -catA. + congr (holds (_ ++ _) _). + by rewrite /= enum_ordSl enum_ord0/= !mxE. + move=> /holdsOr[/=] i [_][_]. + rewrite !nth_set_nth/= eqxx eqn_add2l. + move: (ltn_ord i); have [->|_ _ ->] := eqVneq (i : nat) d.+1. + by rewrite ltnn. + rewrite nth_cat size_map size_enum_ord ltnNge leq_addr/=. + rewrite subDnCA// subnn addn0. + by apply/mem_nth; rewrite size_tuple. + - apply/(sortedP 0) => i; rewrite size_tuple. + rewrite -ltn_predRL => id. + exact/(rsort (Ordinal id)). +move=> rE; split. + apply/forallP => /= i. + have: r`_i \in r by apply/mem_nth; rewrite size_tuple. + rewrite memtE {2}rE in_rootsR => /andP[_] r0; apply/rcf_satP. + have {}r0: SAhorner n (row_mx u (\row__ r`_i)) = 0. + apply/eqP; rewrite SAhornerE rowPE forall_ord1 !mxE (unsplitK (inr _)). + move: r0; rewrite !mxE /root; congr (_.[_]%R == 0). + by apply/eq_poly => k kn; rewrite ngraph_cat nth_cat size_ngraph kn. + move/eqP : r0; rewrite inSAfun => /rcf_satP; rewrite !ngraph_cat -catA. + congr (holds (_ ++ _) _); last first. + by rewrite /= enum_ordSl enum_ord0/= !mxE. +apply/andP; split. + apply/forallP => /= i. + have /sortedP: sorted <%R r by rewrite rE; apply/sorted_roots. + by move=> /(_ 0 i); rewrite size_tuple ltnS; apply. +apply/rcf_satP => /= x /holds_subst; rewrite subst_envE => x0. +suff: x \in tval r. + move=> /(nthP 0)[] i; rewrite size_tuple => ir <-. + apply/holdsOr; exists (Ordinal ir). + split; first exact/mem_index_enum. + split=> //=; rewrite !nth_set_nth/= eqxx eqn_add2l. + move: ir; have [->|_ ir] := eqVneq (i : nat) d.+1. + by rewrite ltnn. + rewrite nth_cat size_map size_enum_ord ltnNge leq_addr/=. + by rewrite subDnCA// subnn addn0. +rewrite rE in_rootsR; apply/andP; split. +move: u0; apply/contraNN => /eqP/polyP u0. + apply/eqP/rowP => i; rewrite mxE. + by move: (u0 i); rewrite coef0 coef_poly (ltn_ord i) nth_map_ord. +have: SAhorner n (row_mx u (\row__ x)) = 0. + apply/eqP; rewrite inSAfun; apply/rcf_satP; rewrite !ngraph_cat -catA. + move: x0; congr (holds (_ ++ _) _). + by rewrite /= enum_ordSl enum_ord0/= !mxE. +rewrite SAhornerE !mxE (unsplitK (inr _)) !mxE => /eqP. +rewrite rowPE forall_ord1 !mxE /root. +congr (_.[_] == 0); apply/polyP => i. +rewrite !coefE; case: (ltnP i n) => [ilt|//]. +by rewrite ngraph_cat nth_cat size_ngraph ilt. +Qed. + +(* Function giving the number of roots of a polynomial of degree at most n.-1 + encoded in big endian in F^n *) +Definition SAnbroots_graph n : {SAset F^(n + 1)} := + [set| (\big[And/True]_(i < n.+1) ('X_i == 0)) + \/ \big[Or/False]_(i < n) (('X_n == Const i%:R%R) + /\ nquantify n.+1 i Exists ( + subst_formula (iota 0 n ++ iota n.+1 i) (rootsR_formula n i)))]. + +Lemma SAnbroots_graphP n u v : + (row_mx u v \in SAnbroots_graph n) = (v == \row__ (size (rootsR (\poly_(i < n) (ngraph u)`_i)))%:R). +Proof. +rewrite inE rcf_sat_repr_pi rcf_sat_subst -[_ (ngraph _)]cats0. +rewrite subst_env_iota_catl ?size_ngraph// rcf_sat_Or rcf_sat_forall rcf_sat_exists. +set p := \poly_(i < n) (ngraph u)`_i. +set P := [forall _, _]. +have ->: P = ((u == 0) && (v == 0)). + rewrite /P; apply/forallP/andP => /= [uv0|[] /eqP -> /eqP -> i]; last first. + rewrite simp_rcf_sat/=. + have ilt: (val i < n + 1)%N by rewrite addn1 ltn_ord. + rewrite (nth_map_ord _ _ (Ordinal ilt)) mxE. + by case: (split _) => j; rewrite mxE. + split. + apply/eqP/rowP => i; move: (uv0 (lift ord_max i)). + rewrite simp_rcf_sat/= /bump leqNgt (ltn_ord i)/=. + by rewrite (nth_map_ord _ _ (lshift 1 i)) !mxE (unsplitK (inl _)) => /eqP. + rewrite rowPE forall_ord1; move: (uv0 ord_max). + rewrite simp_rcf_sat/=. + have nE: n = rshift n (@ord0 0) by rewrite /= addn0. + by rewrite [X in _`_X] nE nth_map_ord !mxE (unsplitK (inr _)). +under eq_existsb => /= i. + rewrite simp_rcf_sat. + have nE: size (ngraph (row_mx u v)) = n.+1 by rewrite size_ngraph addn1. + rewrite -[X in nquantify X]nE. + rewrite -[X in nquantify _ X](size_resize 0 (rootsR p) i). + rewrite rcf_sat_nexists; last first. + move=> r; rewrite size_resize => ri. + rewrite rcf_sat_subst subst_env_cat ngraph_cat -{1}catA. + rewrite subst_env_iota_catl ?size_ngraph//. + rewrite subst_env_iota_catr//; last first. + by rewrite size_cat !size_ngraph addn1. + move/eqP: ri => ri. + rewrite -[r]/(val (Tuple ri)) rootsR_formulaE => /= /eqP rE. + move: ri; rewrite rE => /eqP ri. + by rewrite -ri resize_id. + rewrite simp_rcf_sat/=. + have nE': n = rshift n (@ord0 0) by rewrite /= addn0. + rewrite [X in _`_X]nE' nth_map_ord mxE (unsplitK (inr _)). + rewrite rcf_sat_subst subst_env_cat ngraph_cat -{1}catA. + rewrite subst_env_iota_catl ?size_ngraph//. + rewrite subst_env_iota_catr//; first last. + - exact/size_resize. + - by rewrite -ngraph_cat. + move/eqP: (size_resize 0 (rootsR p) i) => ri. + rewrite -[resize _ _ _]/(val (Tuple ri)) rootsR_formulaE/= resize_idE. + over. +apply/orP/eqP. + case=> [/andP[] /eqP uE /eqP ->|/existsP[] /=]; last first. + move=> i /andP[] /eqP vi /eqP ri. + by apply/rowP => j; rewrite ord1 vi mxE -ri. + apply/rowP => i; rewrite ord1 !mxE. + suff ->: p = 0 by rewrite rootsR0. + apply/polyP => {}i; rewrite coef_poly coef0. + case: (ltnP i n) => [ni|//] /=. + by rewrite (nth_map_ord _ _ (Ordinal ni)) uE mxE. +have [uE vE|u0 vE] /= := eqVneq u 0; [left|right]. + rewrite rowPE forall_ord1 vE !mxE. + suff ->: p = 0 by rewrite rootsR0. + apply/polyP => i; rewrite coef_poly coef0. + case: (ltnP i n) => [ni|//] /=. + by rewrite (nth_map_ord _ _ (Ordinal ni)) uE mxE. +apply/existsP => /=. +suff pn: (size (rootsR p) < n)%N. + by exists (Ordinal pn); rewrite /= vE mxE !eqxx. +rewrite ltnNge; apply/negP. +have pn: (size p <= n)%N by apply/size_poly. +move=> /(leq_trans pn)/poly_ltsp_roots/(_ (uniq_roots _ _ _))/(_ _)/wrap[]. + by apply/allP => x; rewrite in_rootsR => /andP[_]. +suff/eqP: p != 0 by []. +move: u0; apply/contraNN => /eqP/polyP/= p0. +apply/eqP/rowP => i; move: (p0 i). +by rewrite coef_poly coef0 (ltn_ord i) nth_map_ord mxE. +Qed. + +Fact SAfun_SAnbroots n : + (SAnbroots_graph n \in @SAfunc _ n 1) && (SAnbroots_graph n \in @SAtot _ n 1). +Proof. +apply/andP; split. + by apply/inSAfunc => u y1 y2; rewrite !SAnbroots_graphP => /eqP -> /eqP. +apply/inSAtot => u. +exists (\row__ (size (rootsR (\poly_(i < n) (ngraph u)`_i)))%:R)%R. +by rewrite SAnbroots_graphP eqxx. +Qed. + +Definition SAnbroots n := MkSAfun (SAfun_SAnbroots n). + +Lemma SAnbrootsE n u : + SAnbroots n u = (\row__ (size (rootsR (\poly_(i < n) (ngraph u)`_i)))%:R)%R. +Proof. by apply/eqP; rewrite inSAfun SAnbroots_graphP. Qed. + +Definition SAnthroot_graph n i : {SAset F^(n + 1)} := + [set| (\big[And/True]_(d < n.+1) ('X_d == 0)) \/ \big[Or/False]_(d < n) ( + nquantify n.+1 d Exists ('X_n == 'X_(n.+1 + i) /\ + subst_formula ((iota 0 n) ++ (iota n.+1 d)) (rootsR_formula n d)))]. + +Lemma SAnthroot_graphP n m (u : 'rV[F]_n) (v : 'rV[F]_1) : + (row_mx u v \in SAnthroot_graph n m) = (v + == \row__ ((rootsR (\poly_(i < n) (ngraph u)`_i))`_m)). +Proof. +rewrite inE rcf_sat_repr_pi rcf_sat_subst -[_ (ngraph _)]cats0. +rewrite subst_env_iota_catl ?size_ngraph// rcf_sat_Or rcf_sat_forall. +rewrite rcf_sat_exists. +set p := \poly_(i < n) (ngraph u)`_i. +set P := [forall _, _]. +have ->: P = ((u == 0) && (v == 0)). + rewrite /P; apply/forallP/andP => /= [uv0|[] /eqP -> /eqP -> i]; last first. + rewrite simp_rcf_sat/=. + have ilt: (val i < n + 1)%N by rewrite addn1 ltn_ord. + rewrite (nth_map_ord _ _ (Ordinal ilt)) mxE. + by case: (split _) => j; rewrite mxE. + split. + apply/eqP/rowP => i; move: (uv0 (lift ord_max i)). + rewrite simp_rcf_sat/= /bump leqNgt (ltn_ord i)/=. + by rewrite (nth_map_ord _ _ (lshift 1 i)) !mxE (unsplitK (inl _)) => /eqP. + rewrite rowPE forall_ord1; move: (uv0 ord_max). + rewrite simp_rcf_sat/=. + have nE: n = rshift n (@ord0 0) by rewrite /= addn0. + by rewrite [X in _`_X] nE nth_map_ord !mxE (unsplitK (inr _)). +under eq_existsb => /= i. + have nE: size (ngraph (row_mx u v)) = n.+1 by rewrite size_ngraph addn1. + rewrite -[X in nquantify X]nE. + rewrite -[X in nquantify _ X](size_resize 0 (rootsR p) i). + rewrite rcf_sat_nexists; last first. + move=> r; rewrite size_resize => ri. + rewrite simp_rcf_sat rcf_sat_subst subst_env_cat ngraph_cat -{2}catA. + move=> /andP[_]. + rewrite subst_env_iota_catl ?size_ngraph// subst_env_iota_catr//; last first. + by rewrite size_cat !size_ngraph addn1. + move/eqP: ri => ri. + rewrite -[r]/(val (Tuple ri)) rootsR_formulaE => /= /eqP rE. + move: ri; rewrite rE => /eqP ri. + by rewrite -ri resize_id. + rewrite !simp_rcf_sat/= !nth_cat size_map size_enum_ord. + rewrite -{1}[n]addn0 ltn_add2l/= [X in (_ < X)%N]addn1 ltnNge leq_addr/=. + rewrite [X in (_ - X)%N]addn1 subDnCA// subnn addn0. + have nE': n = rshift n (@ord0 0) by rewrite /= addn0. + rewrite [X in _`_X]nE' nth_map_ord mxE (unsplitK (inr _)). + rewrite rcf_sat_subst subst_env_cat ngraph_cat -{1}catA. + rewrite subst_env_iota_catl ?size_ngraph//. + rewrite subst_env_iota_catr//; first last. + - exact/size_resize. + - by rewrite -ngraph_cat. + move/eqP: (size_resize 0 (rootsR p) i) => ri. + rewrite -[resize _ _ _]/(val (Tuple ri)) rootsR_formulaE/= resize_idE. + over. +apply/orP/eqP. + case=> [/andP[] /eqP uE /eqP ->|/existsP[] /=]; last first. + move=> i /andP[] /eqP vi /eqP ri. + by apply/rowP => j; rewrite ord1 vi mxE ri resize_id. + apply/rowP => i; rewrite ord1 !mxE. + suff ->: p = 0 by rewrite rootsR0 nth_nil. + apply/polyP => {}i; rewrite coef_poly coef0. + case: (ltnP i n) => [ni|//] /=. + by rewrite (nth_map_ord _ _ (Ordinal ni)) uE mxE. +have [uE vE|u0 vE] /= := eqVneq u 0; [left|right]. + rewrite rowPE forall_ord1 vE !mxE. + suff ->: p = 0 by rewrite rootsR0 nth_nil. + apply/polyP => i; rewrite coef_poly coef0. + case: (ltnP i n) => [ni|//] /=. + by rewrite (nth_map_ord _ _ (Ordinal ni)) uE mxE. +apply/existsP => /=. +suff pn: (size (rootsR p) < n)%N. + by exists (Ordinal pn); rewrite /= vE mxE resize_id !eqxx. +rewrite ltnNge; apply/negP. +have pn: (size p <= n)%N by apply/size_poly. +move=> /(leq_trans pn)/poly_ltsp_roots/(_ (uniq_roots _ _ _))/(_ _)/wrap[]. + by apply/allP => x; rewrite in_rootsR => /andP[_]. +suff/eqP: p != 0 by []. +move: u0; apply/contraNN => /eqP/polyP/= p0. +apply/eqP/rowP => i; move: (p0 i). +by rewrite coef_poly coef0 (ltn_ord i) nth_map_ord mxE. +Qed. + +Fact SAfun_SAnthroot n i : + (SAnthroot_graph n i \in @SAfunc _ n 1) + && (SAnthroot_graph n i \in @SAtot _ n 1). +Proof. +apply/andP; split. + by apply/inSAfunc => u y1 y2; rewrite !SAnthroot_graphP => /eqP -> /eqP. +apply/inSAtot => u; exists (\row__ (rootsR (\poly_(i < n) (ngraph u)`_i))`_i)%R. +by rewrite SAnthroot_graphP eqxx. +Qed. + +Definition SAnthroot n i := MkSAfun (SAfun_SAnthroot n i). + +Lemma SAnthrootE n i (u : 'rV[F]_n) : + SAnthroot n i u = (\row__ (rootsR (\poly_(i < n) (ngraph u)`_i))`_i)%R. +Proof. by apply/eqP; rewrite inSAfun SAnthroot_graphP. Qed. + +(* TODO: See if rcf_sat_nexists shortens the previous proofs. *) + +Definition SAmulc_graph : {SAset F^((2 + 2) + 2)} := + [set| 'X_4 == ('X_0 * 'X_2 - 'X_1 * 'X_3) + /\ 'X_5 == ('X_0 * 'X_3 + 'X_1 * 'X_2)]. + +Lemma SAmulc_graphP (u v w : 'rV[F]_2) : + row_mx (row_mx u v) w \in SAmulc_graph = + (let x := + ((u ord0 ord0 +i* u ord0 ord_max) * (v ord0 ord0 +i* v ord0 ord_max))%C in + (w == \row_i if i == 0 then complex.Re x else complex.Im x)). +Proof. +rewrite inE rcf_sat_repr_pi rcf_sat_subst -[_ (ngraph _)]cats0. +rewrite subst_env_iota_catl ?size_ngraph// rcf_sat_And !rcf_sat_Equal/=. +have nE: 4 = rshift 4 (@ord0 1) :> nat by []. +rewrite [X in _`_X]nE nth_map_ord mxE (unsplitK (inr _)). +have {}nE: 0 = lshift 2 (lshift 2 (@ord0 1)) :> nat by []. +rewrite [X in _`_X]nE nth_map_ord mxE (unsplitK (inl _)). +have {}nE: 2 = lshift 2 (rshift 2 (@ord0 1)) :> nat by []. +rewrite [X in _`_X]nE nth_map_ord !mxE !(unsplitK (inl _)). +have {}nE: 1 = lshift 2 (lshift 2 (@ord_max 1)) :> nat by []. +rewrite [X in _`_X]nE nth_map_ord !mxE (unsplitK (inl _)) (unsplitK (inr _)). +have {}nE: 3 = lshift 2 (rshift 2 (@ord_max 1)) :> nat by []. +rewrite [X in _`_X]nE nth_map_ord !mxE !(unsplitK (inl _)). +have {}nE: 5 = rshift 4 (@ord_max 1) :> nat by []. +rewrite [X in _`_X]nE nth_map_ord !mxE !(unsplitK (inr _)). +by rewrite rowPE forall_ord2 !mxE/=. +Qed. + +Fact SAfun_SAmulc : + (SAmulc_graph \in @SAfunc _ (2 + 2) 2) + && (SAmulc_graph \in @SAtot _ (2 + 2) 2). +Proof. +apply/andP; split. + apply/inSAfunc => u y1 y2; rewrite -[u]hsubmxK !SAmulc_graphP. + by move=> /eqP -> /eqP. +apply/inSAtot => u. +pose x := ((lsubmx u ord0 ord0 +i* lsubmx u ord0 ord_max) + * (rsubmx u ord0 ord0 +i* rsubmx u ord0 ord_max))%C. +exists (\row_i if i == 0 then complex.Re x else complex.Im x). +by rewrite -[u]hsubmxK SAmulc_graphP. +Qed. + +Definition SAmulc := MkSAfun SAfun_SAmulc. + +Lemma SAmulcE u v : + SAmulc (row_mx u v) = + (let x := ((u ord0 ord0 +i* u ord0 ord_max) + * (v ord0 ord0 +i* v ord0 ord_max))%C in + \row_i if i == 0 then complex.Re x else complex.Im x). +Proof. by apply/eqP; rewrite inSAfun SAmulc_graphP. Qed. + +Fixpoint SAexpc_subdef n : + {f : {SAfun F^2 -> F^2} | + forall u : 'rV[F]_2, + let x := (u ord0 ord0 +i* u ord0 ord_max)%C ^+ n in + (f u = \row_(i < 2) if i == 0 then complex.Re x else complex.Im x)}. +Proof. +case: n => [|n]. + exists (SAfun_const 2 (\row_(i < 2) (i == 0)%:R)) => u/=. + by rewrite SAfun_constE; apply/rowP => i; rewrite !mxE mulrb. +case: (SAexpc_subdef n) => f fE. +exists (SAcomp SAmulc (SAjoin f (SAid 2))) => u/=. +rewrite SAcompE/= SAjoinE SAidE fE SAmulcE/=. +apply/rowP => i; rewrite !mxE/= exprSr. +apply/complexI; rewrite [RHS]fun_if complexRe complexIm ReM ImM. +rewrite -!complexRe/= -!complexIm/= -!rmorphM/= -rmorphB/= -rmorphD/=. +by rewrite -fun_if [u ord0 ord0 * _]mulrC. +Qed. + +Definition SAexpc n := proj1_sig (SAexpc_subdef n). + +Lemma SAexpcE n u : + SAexpc n u = let x := (u ord0 ord0 +i* u ord0 ord_max)%C ^+ n in + \row_(i < 2) if i == 0 then complex.Re x else complex.Im x. +Proof. exact: (proj2_sig (SAexpc_subdef n) u). Qed. + +Lemma SAhornerRC_subdef n : + {f : {SAfun F^(n + 2) -> F^2} | forall (u : 'rV[F]_(n + 2)), + let x := (u ord0 (rshift n ord0) +i* u ord0 (rshift n ord_max))%C in + let r := (\poly_(i < n) ((ngraph u)`_i)%:C).[x]%C in + f u = (\row_i (if i == 0 then complex.Re r else complex.Im r))%R}. +Proof. +elim: n => [|n [f] fP]. + exists (SAfun_const 2 0) => u x r. + suff ->: r = 0. + by apply/eqP; rewrite SAfun_constE rowPE forall_ord2 !mxE/= eqxx. + rewrite -[RHS](horner0 x); congr horner. + by apply/eqP; rewrite -size_poly_eq0 -leqn0; apply/size_poly. +exists ( + SAfun_add + (SAcomp f (SAselect _ _ (iota 0 n ++ iota n.+1 2))) + (SAcomp SAmulc + (SAjoin + (SAselect _ _ [:: n; n.+3]) + (SAcomp (SAexpc n) (SAselect _ _ (iota n.+1 2)))))). +move=> u x r. +rewrite SAfun_addE !SAcompE/= SAjoinE SAcompE/= 3!SAselectE SAmulcE SAexpcE. +apply/rowP => i; rewrite !mxE. +have reE (a b : F) : complex.Re (a +i* b)%C = a by []. +have imE (a b : F) : complex.Im (a +i* b)%C = b by []. +rewrite reE imE/=. +have nE: n = lshift 2 (@ord_max n) by []. +rewrite [X in (ngraph u)`_X]nE nth_map_ord. +have n1E: n.+1 = rshift n.+1 (@ord0 1) by apply/esym/addn0. +rewrite [X in (ngraph u)`_X]n1E nth_map_ord. +have n2E: n.+2 = rshift n.+1 (@ord_max 1) by apply/esym/addn1. +rewrite [X in (ngraph u)`_X]n2E nth_map_ord. +rewrite [(ngraph u)`__]nth_default; last by rewrite size_ngraph addn2. +rewrite !mul0r subr0 addr0 fP !mxE. +have ->: forall a (b c d e : F), + ((if a then b else c) + (if a then d else e)) = if a then b + d else (c + e). + by case. +have ->: forall (a : F) b, a * complex.Re b = complex.Re (a *: b). + by move=> a; case=> /=. +have ->: forall (a : F) b, a * complex.Im b = complex.Im (a *: b). + by move=> a; case=> /=. +rewrite -!raddfD/=. +set g := (fun x : F[i] => if i == 0 then complex.Re x else complex.Im x). +rewrite -[LHS]/(g _) -[RHS]/(g _); congr g. +rewrite /r !horner_poly big_ord_recr/=. +rewrite [X in _ = _ + (_`_X)%:C%C * _]nE nth_map_ord -/x. +have ->: forall (a : F) (b : F[i]), a%:C%C * b = a *: b. + by move=> a; case=> b c; rewrite /GRing.mul/= !mul0r subr0 addr0. +apply/(subIr (u ord0 (lshift 2 ord_max) *: x ^+ n)). +rewrite -[LHS]addrA -[RHS]addrA subrr [LHS]addr0 [RHS]addr0. +apply/eq_bigr => j _. +have jE: j = lshift 2 j :> nat by []. +rewrite {1}jE nth_map_ord mxE/=. +rewrite !nth_cat size_iota (ltn_ord j) nth_iota; last by []. +rewrite addn0 ltnn subnn/= ltnNge leq_addr/=. +rewrite subDnCA; last by []. +rewrite subnn/=. +have {}jE: j = lshift 2 (lift ord_max j) :> nat. + by rewrite /= /bump leqNgt (ltn_ord j). +rewrite [X in (ngraph u)`_X]jE nth_map_ord. +rewrite [X in (ngraph u)`_X]n1E nth_map_ord. +by rewrite [X in (ngraph u)`_X]n2E nth_map_ord. +Qed. + +Definition SAhornerRC n := proj1_sig (SAhornerRC_subdef n). + +Lemma SAhornerRCE n (u : 'rV[F]_(n + 2)) : + let x := (u ord0 (rshift n ord0) +i* u ord0 (rshift n ord_max))%C in + let r := (\poly_(i < n) ((ngraph u)`_i)%:C).[x]%C in + SAhornerRC n u = (\row_i (if i == 0 then complex.Re r else complex.Im r))%R. +Proof. exact/(proj2_sig (SAhornerRC_subdef n)). Qed. + +(* Function giving the number of complex roots of a polynomial of degree at most + n.-1 encoded in big endian in F^n *) +Definition SAnbrootsC_graph n : {SAset F^(n + 1)} := + [set| (\big[And/True]_(i < n.+1) ('X_i == 0)) + \/ \big[Or/False]_(d < n) (('X_n == Const d%:R%R) + /\ nquantify n.+1 d.*2 Exists ( + \big[And/True]_(j < d) + subst_formula + (iota 0 n ++ + [:: n.+1 + j.*2; n.+1 + j.*2.+1; n.+1 + d.*2; n.+1 + d.*2]%N) + (SAhornerRC n) + /\ \big[And/True]_(i < d) \big[And/True]_(j < d | j != i) + ('X_(n.+1 + i.*2) != 'X_(n.+1 + j.*2) + \/ 'X_(n.+1 + i.*2.+1) != 'X_(n.+1 + j.*2.+1)) + /\ nquantify (n.+1 + d.*2) 2 Forall + (subst_formula + (iota 0 n ++ + [:: n.+1 + d.*2; n.+1 + d.*2.+1; n.+1 + d.*2.+2; + n.+1 + d.*2.+2]%N) + (SAhornerRC n) ==> \big[Or/False]_(j < d) + ('X_(n.+1 + d.*2) == 'X_(n.+1 + j.*2) + /\ 'X_(n.+1 + d.*2.+1) == 'X_(n.+1 + j.*2.+1)))))]. + +Lemma SAnbrootsC_graphP n u v : + (row_mx u v \in SAnbrootsC_graph n) + = (v == \row__ (size (dec_roots (\poly_(i < n) ((ngraph u)`_i)%:C%C)))%:R). +Proof. +move uvE: (tval (ngraph (row_mx u v))) => uv. +move: uvE; have [->|u0] := eqVneq u 0 => uvE. + have ->: \poly_(i < n) ((@ngraph F n 0)`_i)%:C%C = 0. + apply/polyP => i; rewrite coef_poly coef0. + case: (ltnP i n) => [ilt|//]. + by rewrite (nth_mktuple _ _ (Ordinal ilt)) mxE. + rewrite dec_roots0/=. + apply/SAin_setP/eqP => [/= [/holdsAnd|/holdsOr-[] i]| ->]. + - move=> /(_ ord_max (mem_index_enum _) isT) /=. + have nE: n = rshift n (@ord0 0) by rewrite /= addn0. + rewrite [X in _`_X]nE nth_map_ord mxE (unsplitK (inr _)) => v0. + by apply/eqP; rewrite rowPE forall_ord1 mxE; apply/eqP. + - move=> [_][_]/= [_]; rewrite -[X in nquantify X]addn1. + rewrite -[X in nquantify X](size_ngraph (row_mx 0 v)). + move=> /nexistsP[r]/= [_][_]; rewrite uvE. + have suvr: (n.+1 + i.*2)%N = size (uv ++ r). + by rewrite -uvE size_cat size_ngraph size_tuple addn1. + rewrite suvr => /nforallP. + move=> /(_ (mktuple (fun=> 1 + \big[Order.max/0]_(x <- r) x)))%R /=. + mp. + apply/holds_subst; rewrite subst_env_cat. + rewrite -{1}uvE/= {1}enum_ordD map_cat -!catA. + rewrite subst_env_iota_catl; last by rewrite 2!size_map size_enum_ord. + rewrite catA nth_cat ltnn subnn enum_ordSl/=. + rewrite nth_cat [X in (X < _)%N]addnS suvr ltnNge leqnSn/=. + rewrite -suvr subnDl subSn// subnn enum_ordSl/=. + rewrite nth_default; last first. + by rewrite !addnS suvr size_cat/= enum_ord0/= addn2. + have: SAhornerRC n (row_mx 0 (\row__ (1 + \big[maxr/0]_(x <- r) x)%R)) + = \row__ 0. + apply/eqP; rewrite SAhornerRCE rowPE forall_ord2 !mxE/=. + rewrite !(unsplitK (inr _)). + move pE : (poly _ _) => p. + suff ->: p = 0 by rewrite horner0/= eqxx. + apply/polyP => j; rewrite -pE coef0 coef_poly. + case: (ltnP j n) => [jn|//]. + rewrite ngraph_cat nth_cat size_ngraph jn. + by rewrite (nth_mktuple _ _ (Ordinal jn)) mxE. + move=> /eqP; rewrite inSAfun => /rcf_satP; rewrite !ngraph_cat -catA. + congr (holds (_ ++ _) _); last by rewrite /= !enum_ordSl enum_ord0/= !mxE. + apply/(@eq_from_nth _ 0) => [|k]; rewrite size_ngraph. + by rewrite 2!size_map size_enum_ord. + move=> kn; rewrite /= -map_comp !(nth_map_ord _ _ (Ordinal kn)). + by rewrite [in RHS]mxE (unsplitK (inl _)). + move=> /holdsOr[j] [_][_]/= [] + _. + rewrite nth_cat ltnn subnn {1}enum_ordSl/=. + rewrite nth_cat -suvr ltn_add2l ltn_double ltn_ord nth_cat. + rewrite -{1 3}uvE size_ngraph addn1 ltnNge leq_addr/=. + rewrite subDnCA// subnn addn0 => rE. + suff: r`_j.*2 <= \big[maxr/0]_(x <- r) x. + by rewrite -rE; rewrite -subr_ge0 opprD addrCA subrr addr0 oppr_ge0 ler10. + rewrite le_bigmax; apply/orP; right; apply/hasP; exists r`_j.*2. + by apply/mem_nth; rewrite size_tuple ltn_double. + exact/lexx. + left; apply/holdsAnd; case=> i /= ilt _ _ /=. + rewrite enum_ordD map_cat -2!map_comp nth_cat size_map size_enum_ord. + case: (ltnP i n) => iltn. + rewrite -/(nat_of_ord (Ordinal iltn)) nth_map_ord mxE (unsplitK (inl _)). + by rewrite mxE. + have ->: i = n by apply/le_anti/andP. + rewrite subnn -[X in _`_X]/(nat_of_ord (@ord0 0)) nth_map_ord mxE. + by rewrite (unsplitK (inr _)) mxE. +have pu0: \poly_(i < n) (([seq u ord0 i0 | i0 <- enum 'I_n]`_i)%:C)%C != 0. + apply/eqP => /polyP pu0. + move/eqP: u0 => /rowP; apply => i. + move: (pu0 i); rewrite coef_poly ltn_ord nth_map_ord mxE coef0. + by move/complexI. +have ComplexK (x : F[i]): (complex.Re x +i* complex.Im x)%C = x. + by apply/eqP; rewrite eq_complex !eqxx. +rewrite inE rcf_sat_repr_pi rcf_sat_subst uvE -[uv]cats0. +rewrite subst_env_iota_catl; last by rewrite -uvE size_ngraph. +rewrite rcf_sat_Or rcf_sat_forall. +have /negP/negPf -> /=: ~ [forall i : 'I_(n.+1), rcf_sat uv ('X_i == 0)]. + move=> /forallP /= uv0. + move: u0; rewrite rowPE => /forallPn/= [] i. + move: (uv0 (lift ord_max i)) => /rcf_satP/=. + rewrite -uvE ngraph_cat nth_cat /bump [(n <= i)%N]leqNgt size_ngraph. + by rewrite !(ltn_ord i)/= nth_map_ord mxE => -> /eqP. +apply/rcf_satP/eqP => [/holdsOr/=[] d [_][_]|vE]. + rewrite -{1}uvE ngraph_cat nth_cat size_ngraph ltnn. + rewrite subnn (nth_map_ord _ _ ord0) => -[] vE. + rewrite -[X in nquantify X]addn1. + rewrite -[X in nquantify X](size_ngraph (row_mx u v)) uvE. + move=> /nexistsP[r]/= [] /holdsAnd/= rroot [] runiq rall. + set r' := (mktuple (fun i : 'I_d => (r`_(val i).*2 +i* r`_(val i).*2.+1)%C)). + apply/eqP; rewrite rowPE forall_ord1 vE mxE eqr_nat -(size_tuple r'). + apply/eqP/perm_size/uniq_perm. + - apply/negP => /negP/(uniqPn 0)/= [] i [] j [] ij. + rewrite size_map size_enum_ord => jd. + rewrite (nth_map_ord _ _ (Ordinal (ltn_trans ij jd))). + rewrite (nth_map_ord _ _ (Ordinal jd)) => -[] rij rij1. + move/holdsAnd: runiq => /=. + move=> /(_ (Ordinal (ltn_trans ij jd)) (mem_index_enum _) isT). + move=> /holdsAnd /= /(_ (Ordinal jd) (mem_index_enum _)). + rewrite -(inj_eq val_inj)/=. + mp; first by apply/eqP => ji; rewrite ji ltnn in ij. + rewrite !nth_cat -[X in size X]uvE size_ngraph addn1. + do 4 (rewrite ltnNge leq_addr/= subDnCA// subnn addn0). + by rewrite rij rij1; case. + - exact/uniq_dec_roots. + move=> x; rewrite mem_dec_roots pu0/= rootE. + apply/(nthP 0)/eqP => [[] i|x0]. + rewrite size_map size_enum_ord => id <-. + rewrite (nth_map_ord _ _ (Ordinal id)). + move: rroot => /(_ (Ordinal id) (mem_index_enum _) isT) /holds_subst. + rewrite subst_env_cat -{1}uvE ngraph_cat -catA. + rewrite subst_env_iota_catl ?size_ngraph//=. + rewrite !nth_cat -![X in size X]uvE size_ngraph addn1. + do 3 (rewrite ltnNge leq_addr/= subDnCA// subnn addn0). + rewrite [r`_d.*2]nth_default ?size_tuple// => ru0. + have /eqP: SAhornerRC n (row_mx u (\row_j r`_(j + i.*2))) = \row__ 0. + apply/eqP; rewrite inSAfun; apply/rcf_satP; rewrite !ngraph_cat -catA. + by rewrite /= !enum_ordSl enum_ord0/= !mxE/= /bump/=. + rewrite SAhornerRCE/= !mxE !(unsplitK (inr _)) !mxE. + rewrite rowPE forall_ord2 !mxE/=. + move pE: (poly _ _) => p. + move qE: (poly _ _) => q. + rewrite [q.[_]]complexE. + suff ->: p = q by move=> /andP[] /eqP -> /eqP ->; rewrite mulr0 addr0. + apply/polyP => j; rewrite -pE -qE !coef_poly/=. + case: (ltnP j n) => [jn|//]. + rewrite (nth_map_ord _ _ (lshift 2 (Ordinal jn))) mxE (unsplitK (inl _)). + by rewrite (nth_map_ord _ _ (Ordinal jn)). + move: rall. + have suvr: size (uv ++ r) = (n.+1 + d.*2)%N. + by rewrite size_cat -uvE size_ngraph size_tuple addn1. + rewrite -suvr => /nforallP. + move=> /(_ (mktuple + (fun i => if i == 0 then complex.Re x else complex.Im x)))/=. + mp. + apply/holds_subst. + rewrite subst_env_cat -{1}uvE ngraph_cat -!catA. + rewrite subst_env_iota_catl ?size_ngraph//= catA !nth_cat ltnn subnn suvr. + rewrite !addnS ltnNge leqnSn/= ltnNge (leq_trans (leqnSn _) (leqnSn _))/=. + rewrite subSn// subnn subSn// subSn// subnn !enum_ordSl enum_ord0/=. + suff: SAhornerRC n + (row_mx u (\row_j if j == 0 then complex.Re x else complex.Im x)) + = \row__ 0. + move=> /eqP; rewrite inSAfun => /rcf_satP; rewrite !ngraph_cat -catA. + by rewrite /= !enum_ordSl enum_ord0/= !mxE/= /bump/=. + rewrite SAhornerRCE/= !mxE !(unsplitK (inr _)) !mxE. + apply/eqP; rewrite rowPE forall_ord2 !mxE/=. + move: x0; move pE: (poly _ _) => p; move qE: (poly _ _) => q. + suff ->: p = q by rewrite ComplexK => ->; rewrite !eqxx. + apply/esym/polyP => j; rewrite -pE -qE !coef_poly/=. + case: (ltnP j n) => [jn|//]. + rewrite (nth_map_ord _ _ (lshift 2 (Ordinal jn))) mxE (unsplitK (inl _)). + by rewrite (nth_map_ord _ _ (Ordinal jn)). + move=> /holdsOr/= [] i [_][_]. + rewrite !nth_cat ltnn subnn suvr !ltn_add2l ltn_double (ltn_ord i). + rewrite -[X in size X]uvE size_ngraph addn1 ltnNge leq_addr/=. + rewrite subDnCA// subnn addn0. + rewrite ltnNge (leqnSn _)/= 2!addnS subSn// subnn. + rewrite ltn_Sdouble (ltn_ord i) -addnS ltnNge leq_addr/=. + rewrite subDnCA// subnn addn0 !enum_ordSl enum_ord0/= => -[] ri ris. + exists i; first by rewrite size_map size_enum_ord. + by apply/eqP; rewrite nth_map_ord eq_complex/= ri ris !eqxx. +apply/holdsOr => /=. +move pE: (poly _ _) vE => p vE. +have sn: (size (dec_roots p) < n)%N. + rewrite size_dec_roots; last exact/char_num. + apply/(leq_ltn_trans (leq_predn (leq_divp p _))). + case: (posnP n) => n0. + move/eqP: u0; elim; apply/rowP; case=> i ilt; exfalso. + by rewrite n0 in ilt. + case sp: (size p) => [//|k]; rewrite succnK. + by move: sp => <-; rewrite -pE; apply/size_poly. +exists (Ordinal sn) => /=. +split; first exact/mem_index_enum. +split=> //. +split. + rewrite -uvE ngraph_cat nth_cat size_ngraph ltnn subnn vE/= enum_ordSl/=. + by rewrite mxE. +have ->: n.+1 = size uv by rewrite -uvE size_ngraph addn1. +apply/nexistsP. +exists (mktuple (fun i => + if odd i + then complex.Im (dec_roots p)`_i./2 + else complex.Re (dec_roots p)`_i./2)%N). +split. + apply/holdsAnd => /= i _ _; apply/holds_subst. + rewrite subst_env_cat -{1}uvE ngraph_cat -!catA. + rewrite subst_env_iota_catl ?size_ngraph//=. + do 3 rewrite nth_cat ltnNge leq_addr/= subDnCA// subnn addn0. + move: (ltn_ord i); rewrite -ltn_double => i2lt. + rewrite (nth_map_ord _ _ (Ordinal i2lt))/= odd_double doubleK. + move: (ltn_ord i); rewrite -ltn_Sdouble => i2slt. + rewrite (nth_map_ord _ _ (Ordinal i2slt))/= odd_double/= uphalf_double. + rewrite [(map _ _)`__]nth_default; last by rewrite size_map size_enum_ord. + suff: SAhornerRC n (row_mx u (\row_j + if j == 0 + then complex.Re (dec_roots p)`_i + else complex.Im (dec_roots p)`_i)) + = \row__ 0. + move=> /eqP; rewrite inSAfun => /rcf_satP; rewrite !ngraph_cat -catA. + by rewrite /= !enum_ordSl enum_ord0/= !mxE/= /bump/=. + rewrite SAhornerRCE/= !mxE !(unsplitK (inr _)) !mxE. + apply/eqP; rewrite rowPE forall_ord2 !mxE/= ComplexK. + move qE: (poly _ _) => q. + have <-: p = q. + apply/esym/polyP => j; rewrite -pE -qE !coef_poly/=. + case: (ltnP j n) => [jn|//]. + rewrite (nth_map_ord _ _ (lshift 2 (Ordinal jn))) mxE (unsplitK (inl _)). + by rewrite (nth_map_ord _ _ (Ordinal jn)). + have: (dec_roots p)`_i \in dec_roots p by apply/mem_nth. + rewrite mem_dec_roots => /andP[_] /rootP ->. + by rewrite eqxx. +split. + apply/holdsAnd => /= i _ _. + apply/holdsAnd => /= j _; rewrite eq_sym => /negPf ji. + do 4 rewrite nth_cat ltnNge leq_addr/= subDnCA// subnn addn0. + move: (ltn_ord i); rewrite -ltn_double => i2lt. + rewrite (nth_map_ord _ _ (Ordinal i2lt))/= odd_double doubleK. + move: (ltn_ord i); rewrite -ltn_Sdouble => i2slt. + rewrite (nth_map_ord _ _ (Ordinal i2slt))/= odd_double/= uphalf_double. + move: (ltn_ord j); rewrite -ltn_double => j2lt. + rewrite (nth_map_ord _ _ (Ordinal j2lt))/= odd_double doubleK. + move: (ltn_ord j); rewrite -ltn_Sdouble => j2slt. + rewrite (nth_map_ord _ _ (Ordinal j2slt))/= odd_double/= uphalf_double. + move: (uniq_dec_roots p) => /(nth_uniq 0)/= /(_ i j (ltn_ord i) (ltn_ord j)). + rewrite (inj_eq val_inj) ji => /negP/negP. + by rewrite eq_complex negb_and => /orP [/eqP|/eqP] ij; [left|right]. +move tE: (mktuple _) => t. +rewrite -[X in (_ + X)%N](size_tuple t) -size_cat. +apply/nforallP => w/= /holds_subst. +rewrite subst_env_cat -{1}uvE ngraph_cat -!catA. +rewrite subst_env_iota_catl ?size_ngraph//= !addnS. +rewrite -[in X in (_ + X)%N](size_tuple t) -size_cat catA. +rewrite nth_cat ltnNge leqnn/= subnn. +rewrite nth_cat ltnNge leqnSn/= subSn// subnn. +rewrite [(_ ++ _)`__]nth_default => [w0|]; last first. + by rewrite size_cat size_tuple addn2. +have: (w`_0 +i* w`_1)%C \in dec_roots p. + rewrite mem_dec_roots -{1}pE pu0/= rootE. + have: SAhornerRC n (row_mx u (\row_j w`_j)) == \row__ 0. + rewrite inSAfun; apply/rcf_satP; rewrite !ngraph_cat -catA. + by rewrite /= !enum_ordSl enum_ord0/= !mxE/= /bump/=. + rewrite SAhornerRCE/= !mxE !(unsplitK (inr _)) !mxE. + rewrite rowPE forall_ord2 !mxE/=. + move qE: (poly _ _) => q. + suff <-: p = q by rewrite eq_complex. + apply/esym/polyP => j; rewrite -pE -qE !coef_poly/=. + case: (ltnP j n) => [jn|//]. + rewrite (nth_map_ord _ _ (lshift 2 (Ordinal jn))) mxE (unsplitK (inl _)). + by rewrite (nth_map_ord _ _ (Ordinal jn)). +move=> /(nthP 0)/= [] i ip iE. +apply/holdsOr => /=; exists (Ordinal ip). +split; first exact/mem_index_enum. +split=> //. +split; rewrite nth_cat. + rewrite ltnn subnn -catA nth_cat ltnNge leq_addr/= subDnCA// subnn addn0. + rewrite -ltn_double in ip. + rewrite nth_cat size_tuple ip -tE (nth_map_ord _ _ (Ordinal ip))/=. + by rewrite odd_double doubleK iE. +rewrite ltnNge leqnSn/= -catA subSn// subnn. +rewrite nth_cat ltnNge leq_addr/= subDnCA// subnn addn0. +rewrite -ltn_Sdouble in ip. +rewrite nth_cat size_tuple ip -tE (nth_map_ord _ _ (Ordinal ip))/=. +by rewrite odd_double uphalf_double iE. +Qed. + +Fact SAfun_SAnbrootsC n : + (SAnbrootsC_graph n \in @SAfunc _ n 1) + && (SAnbrootsC_graph n \in @SAtot _ n 1). +Proof. +apply/andP; split. + by apply/inSAfunc => u y1 y2; rewrite !SAnbrootsC_graphP => /eqP -> /eqP. +apply/inSAtot => u. +exists (\row__ (size (dec_roots (\poly_(i < n) ((ngraph u)`_i)%:C%C)))%:R)%R. +by rewrite SAnbrootsC_graphP. +Qed. + +Definition SAnbrootsC n := MkSAfun (SAfun_SAnbrootsC n). + +Lemma SAnbrootsCE n u : + SAnbrootsC n u + = (\row__ (size (dec_roots (\poly_(i < n) ((ngraph u)`_i)%:C%C)))%:R)%R. +Proof. by apply/eqP; rewrite inSAfun SAnbrootsC_graphP. Qed. + +Definition SAset_lt (s t : {SAset F^1}) := + (t != SAset0 F 1) + && rcf_sat [::] + ('forall 'X_0, s ==> 'forall 'X_1, subst_formula [:: 1%N] t + ==> ('X_0 <% 'X_1))%oT. + +Lemma SAset_ltP (s t : {SAset F^1}) : + reflect (t != SAset0 F 1 /\ forall x y, x \in s -> y \in t -> x 0 0 < y 0 0) + (SAset_lt s t). +Proof. +apply/andPP; first exact/idP. +apply/(iffP (rcf_satP _ _)) => /=. + move=> + x y /rcf_satP + /rcf_satP. + rewrite /ngraph/= enum_ordSl enum_ord0/= => /(_ (x 0 0)) /[apply]. + move=> /(_ (y 0 0)) + yt. + have /[swap]/[apply]// : holds [:: x 0 0; y 0 0] (subst_formula [:: 1%N] t). + exact/holds_subst. +move=> + x xs y /holds_subst/= yt => /(_ (\row__ x) (\row__ y)). +have /[swap]/[apply] : \row__ x \in s. + by apply/rcf_satP; rewrite /ngraph/= enum_ordSl enum_ord0 /= mxE. +have /[swap]/[apply] : \row__ y \in t. + by apply/rcf_satP; rewrite /ngraph/= enum_ordSl enum_ord0 /= mxE. +by rewrite !mxE. +Qed. + +Definition SAsetltType := {SAset F^1}. + +Lemma SAset_lt_irr : irreflexive SAset_lt. +Proof. +move=> s; apply/negP => /SAset_ltP []. +have [->|[x xs]] := set0Vmem s; first by rewrite eqxx. +by move=> _ /(_ x x xs xs); rewrite ltxx. +Qed. + +Lemma SAset_lt_trans : transitive SAset_lt. +Proof. +move=> s t u /SAset_ltP []. +have [->|[x xs] _ ts /SAset_ltP [u0] su] := set0Vmem s; first by rewrite eqxx. +by apply/SAset_ltP; split=> // y z yt zu; apply/(lt_trans (ts y x yt xs))/su. +Qed. + +HB.instance Definition _ := Equality.on SAsetltType. +HB.instance Definition _ := Choice.on SAsetltType. +HB.instance Definition _ := Order.Lt_isPOrder.Build ring_display SAsetltType + SAset_lt_irr SAset_lt_trans. + +Lemma SAset_lt_trivI (S : seq SAsetltType) : + path.sorted <%O S -> SAset_trivI [fset x | x in S]. +Proof. +set T := [fset x | x in S]. +have inT x : x \in T = (x \in S). + by apply/imfsetP/idP => [[] y yS -> //|xS]; exists x. +move=> /(lt_sorted_ltn_nth (SAset0 F 1 : SAsetltType)) Ssort. +apply/forallP => /= -[] /= s; rewrite inT => sS. +(* What ??? *) +move: (elimT (nthP (SAset0 F 1)) sS) => {sS} [] i iS <-. +apply/forallP => /= -[] /= t; rewrite inT => tS. +move: (elimT (nthP (SAset0 F 1)) tS) => {tS} [] j jS <-. +apply/implyP; move: iS jS; wlog: i j / (i < j)%N => ij iS jS ijE. + have /lt_total : i != j. + by move: ijE; apply/contra => /eqP ->; apply/eqP. + move=> /orP [ij'|ji]; first exact/ij. + by rewrite SAset_disjointC; apply/ij => //; rewrite eq_sym. +move: (Ssort i j); rewrite !inE => /(_ iS jS). +rewrite ij => /SAset_ltP [_] {}ij. +rewrite /SAset_disjoint -subset0; apply/SAset_subP => x. +by rewrite inSAsetI => /andP[] /ij /[apply]; rewrite ltxx. +Qed. (* ~4'' *) + +Definition SAset_fiber n m (s : {SAset F^(n + m)}) (x : 'rV[F]_n) := + SApreimset (SAjoin (SAfun_const m x) (SAid m)) s. + +Lemma inSAset_fiber n m (s : {SAset F^(n + m)}) x y : + (y \in SAset_fiber s x) = (row_mx x y \in s). +Proof. by rewrite inSApreimset SAjoinE SAfun_constE SAidE. Qed. + +Definition partition_of_pts (xi : seq F) : seq {SAset F^1} := + [seq + if i == 0 then + \big[@SAsetI F 1/SAsetT F 1]_(x <- xi) SAset_itv `]-oo, x[%R + else if i == (size xi).*2 then + \big[@SAsetI F 1/SAsetT F 1]_(x <- xi) SAset_itv `]x, +oo[%R + else if odd i then + [set \row__ xi`_i./2] + else SAset_itv `]xi`_i./2.-1, xi`_i./2[%R + | i <- iota 0 (size xi).*2.+1]. + +Lemma partition_of_pts0 : partition_of_pts [::] = [:: SAsetT F _]. +Proof. by rewrite /partition_of_pts /= big_nil. Qed. + +Lemma sorted_partition_of_pts xi : + path.sorted <%O xi -> + path.sorted <%O (partition_of_pts xi : seq SAsetltType). +Proof. +move=> /[dup] /(lt_sorted_ltn_nth 0) xilt /(lt_sorted_leq_nth 0) xile. +apply/(path.sortedP (SAset0 F 1)) => i /[dup]. +rewrite /partition_of_pts size_map size_iota {1}ltnS => ilt islt. +rewrite (nth_map 0) ?size_iota ?ltnS 1?ltnW// nth_iota// ?ltnS 1?ltnW// add0n. +rewrite (nth_map 0) ?size_iota// nth_iota// add0n/=. +have xi0: (0 < size xi)%N by rewrite -double_gt0 (leq_ltn_trans (leq0n i)). +rewrite (ltn_eqF ilt). +apply/SAset_ltP; rewrite -subset0; case: (posnP i) => [->|i0]. + have -> : 0.+1 == (size xi).*2 = false by case: (size xi). + split=> [|x y]. + apply/negP => /SAset_subP /(_ (\row__ xi`_0)). + by rewrite inSAset_seq mem_seq1 eqxx inSAset0 => /(_ isT). + rewrite inSAset_bigcap inSAset1 => /allP/(_ xi`_0)/= + /eqP ->. + rewrite inSAset_itv in_itv/= mxE; apply. + by apply/mem_nth; move: ilt; case: (size xi). +move: islt; rewrite leq_eqVlt ltnS eqSS => /orP[/[dup] /eqP iE ->|islt]. + split=> [|x y]. + apply/negP => /SAset_subP /(_ (\row__ (last 0 xi + 1))%R). + rewrite inSAset_bigcap inSAset0. + move=> H; (suff: false by []); apply: H. + apply/allP => x /(nthP 0) [j] jlt <- /=. + rewrite inSAset_itv in_itv/= mxE andbT. + move: (xile j (size xi).-1); rewrite !inE ltn_predL => /(_ jlt xi0). + rewrite -ltnS prednK// jlt => xj. + by apply/(le_lt_trans xj); rewrite -nth_last -subr_gt0 addrAC subrr add0r. + have -> /=: odd i by rewrite -[odd i]negbK -oddS iE odd_double. + rewrite inSAset_seq mem_seq1 inSAset_bigcap => /eqP -> /allP/(_ xi`_i./2) /=. + rewrite inSAset_itv in_itv/= andbT mxE; apply. + by apply/mem_nth; rewrite ltn_half_double. +rewrite (ltn_eqF islt). +case/boolP: (odd i) => /= i2; (split=> [|x y]; + [apply/negP => /SAset_subP| + rewrite inSAset_seq mem_seq1 inSAset_itv in_itv/=]); first last. +- by move=> /andP[_] xlt /eqP ->; rewrite mxE uphalf_half (negPf i2). +- move=> /(_ (\row__ xi`_(uphalf i))); rewrite inSAset_seq mem_head inSAset0. + by move=> /(_ isT). +- by move=> /eqP -> /andP[] + _; rewrite mxE uphalf_half i2 add1n succnK. +move=> /(_ (\row__ (2^-1 * (xi`_(uphalf i) + xi`_(uphalf i).-1)))%R). +rewrite inSAset_itv in_itv/= mxE inSAset0. +move=> H; (suff: false by []); apply: H. +have ltr02 : 0 < 2 :> F by []. +have neq20 : 2 != 0 :> F by rewrite pnatr_eq0. +move: (xilt (uphalf i).-1 (uphalf i)); rewrite !inE. +rewrite prednK ?uphalf_gt0// leq_uphalf_double ltn_uphalf_double. +move=> /(_ (ltnW ilt) islt); rewrite leqnn => xii. +by apply/andP; split; rewrite -subr_gt0 -(pmulr_rgt0 _ ltr02) mulrBr mulrA + divff// mul1r mulr_natl mulr2n opprD addrACA subrr ?add0r ?addr0 subr_gt0. +Qed. + +Lemma SAset_partition_of_ptsU (xi : seq F) : + path.sorted <=%O xi -> + \big[@SAsetU F 1/SAset0 F 1]_(s <- partition_of_pts xi) s = SAsetT F 1. +Proof. +elim: xi => [|x xi IHxi]; first by rewrite partition_of_pts0 big_seq1. +move=> /[dup] xile /path.path_sorted xile'. +apply/eqP; rewrite -subTset; apply/SAset_subP => y. +rewrite -IHxi// inSAset_bigcup => /hasP[] /= s sxi. +(* What??? *) +move: (elimT (nthP (SAset0 F _)) sxi) => {sxi} [] i. +rewrite size_map size_iota => ilt <-. +rewrite (nth_map 0) ?size_iota// nth_iota// add0n. +case: (posnP i) => i0. + rewrite inSAset_bigcap => yxi. + case: (ltP (y 0 0) x) => [yx|]. + rewrite inSAset_bigcup; apply/hasP. + exists (nth (SAset0 F 1) (partition_of_pts (x :: xi)) 0). + by apply/mem_nth; rewrite size_map size_iota. + rewrite (nth_map 0)// nth_iota//= inSAset_bigcap/=. + by rewrite inSAset_itv in_itv/= yx. + rewrite le_eqVlt => /orP[/eqP ->|xy]. + rewrite inSAset_bigcup; apply/hasP. + exists (nth (SAset0 F 1) (partition_of_pts ((y 0 0) :: xi)) 1). + by apply/mem_nth; rewrite size_map size_iota/= doubleS. + rewrite (nth_map 0)// nth_iota//= inSAset_seq mem_seq1 rowPE forall_ord1. + by rewrite mxE. + rewrite inSAset_bigcup; apply/hasP. + exists (nth (SAset0 F 1) (partition_of_pts (x :: xi)) 2). + by apply/mem_nth; rewrite size_map size_iota/= doubleS. + rewrite (nth_map 0)// nth_iota//=. + case: xi {IHxi ilt xile xile'} yxi => /= [|z xi] yxi. + by rewrite big_seq1 inSAset_itv in_itv/= xy. + rewrite inSAset_itv in_itv/= xy. + by move: yxi => /andP[+] _; rewrite inSAset_itv in_itv/=. +case/boolP: (_ == _) => [_|im]. + rewrite inSAset_bigcap => /= yxi. + rewrite inSAset_bigcup; apply/hasP. + exists (nth (SAset0 F 1) (partition_of_pts (x :: xi)) ((size xi).+1.*2)). + by apply/mem_nth; rewrite size_map size_iota. + rewrite (nth_map 0) ?size_iota// nth_iota//= eqxx. + rewrite inSAset_bigcap/= inSAset_itv in_itv/= yxi. + case: xi {IHxi xile'} i0 ilt xile yxi; first by case: i. + move=> z xi _ _ /= /andP[] xz _ /andP[]. + by rewrite inSAset_itv in_itv/= => /andP[] /(le_lt_trans xz) ->. +case/boolP: (odd i) => i2 yE; + rewrite inSAset_bigcup; apply/hasP; + (exists (nth (SAset0 F 1) (partition_of_pts (x :: xi)) i.+2); + first by apply/mem_nth; rewrite size_map size_iota/= doubleS 2!ltnS); + (rewrite (nth_map 0); last by rewrite size_iota/= doubleS 2!ltnS); + rewrite nth_iota/= doubleS 2?ltnS// 2!eqSS (negPf im) i2//. +rewrite -[X in (x :: xi)`_X]prednK// half_gt0. +by case: i {ilt im yE} i0 i2 => [//|]; case. +Qed. + +Lemma SAset_partition_of_pts (xi : seq F) : + path.sorted <%O xi -> SAset_partition [fset x | x in partition_of_pts xi]. +Proof. +move=> /[dup] /[dup] xisort. +move=> /(lt_sorted_ltn_nth 0) xilt /(lt_sorted_leq_nth 0) xile. +set S := [fset x | x in partition_of_pts xi]. +have inS x : x \in S = (x \in partition_of_pts xi). + by apply/imfsetP/idP => [[] y yS -> //|xS]; exists x. +apply/andP; split; last first. + move: xisort; rewrite lt_sorted_uniq_le => /andP[_]. + move=> /SAset_partition_of_ptsU <-. + apply/SAsetP => x; rewrite 2!inSAset_bigcup. + apply/hasP/hasP => /= -[]. + by move=> [] /= s + _ /=; rewrite inS => sxi xs; exists s. + move=> s; rewrite -inS => sS xs. + by exists [` sS] => //; apply/mem_index_enum. +apply/andP; split; last exact/SAset_lt_trivI/sorted_partition_of_pts. +rewrite inS; apply/negP => xi0. +(* What??? *) +move: (elimT (nthP (SAset0 F 1)) xi0) => {xi0} [] i. +rewrite size_map size_iota; case: (posnP i) => [->|i0] ixi; last first. + move: xisort => /sorted_partition_of_pts. + move=> /(lt_sorted_ltn_nth (SAset0 F 1 : SAsetltType)). + move=> /(_ 0 i); rewrite !inE size_map size_iota => /(_ isT ixi). + by rewrite i0 => /SAset_ltP[] /eqP + _. +rewrite (nth_map 0) ?size_iota// nth_iota//= => xi0. +suff: \row__ (xi`_0 - 1) \in SAset0 F 1 by rewrite inSAset0. +rewrite -xi0 inSAset_bigcap; apply/allP => /= x /(nthP 0) [j] jxi <-. +rewrite inSAset_itv in_itv/= mxE. +move: (xile 0 j); rewrite !inE => /(_ (leq_ltn_trans (leq0n _) jxi) jxi). +rewrite leq0n => x0j; apply/(lt_le_trans _ x0j). +by rewrite -subr_gt0 opprB addrCA subrr addr0. +Qed. + +Definition partition_of_graphs n + (xi : seq {SAfun F^n -> F^1}) : seq {SAset F^(n + 1)%N} := + [seq + if i == 0 then + \big[@SAsetI F (n + 1)/SAsetT F (n + 1)]_(f <- xi) SAhypograph f + else if i == (size xi).*2 then + \big[@SAsetI F (n + 1)/SAsetT F (n + 1)]_(f <- xi) SAepigraph f + else if odd i then + SAgraph xi`_i./2 + else SAepigraph (xi`_i./2.-1) :&: SAhypograph (xi`_i./2) + | i <- iota 0 (size xi).*2.+1]. + +Lemma SApreimsetI n m (f : {SAfun F^n -> F^m}) s t : + SApreimset f (s :&: t) = (SApreimset f s) :&: SApreimset f t. +Proof. +by apply/eqP/SAsetP => x; rewrite inSApreimset !inSAsetI !inSApreimset. +Qed. + +Lemma SApreimsetU n m (f : {SAfun F^n -> F^m}) s t : + SApreimset f (s :|: t) = SApreimset f s :|: SApreimset f t. +Proof. by apply/eqP/SAsetP => x; rewrite inSAsetU !inSApreimset inSAsetU. Qed. + +Lemma SApreimsetT n m f : SApreimset f (SAsetT F n) = SAsetT F m. +Proof. +apply/eqP; rewrite -subTset; apply/SAset_subP => x _. +by rewrite inSApreimset inSAsetT. +Qed. + +Lemma SApreimset_bigcap n m (I : Type) (r : seq I) (P : pred I) + (S : I -> {SAset F^m}) (f : {SAfun F^n -> F^m}) : + SApreimset f (\big[SAsetI (n:=m)/SAsetT F m]_(i <- r | P i) S i) = + \big[SAsetI (n:=n)/SAsetT F n]_(i <- r | P i) SApreimset f (S i). +Proof. +elim: r => [|i r IHr]; first by rewrite !big_nil SApreimsetT. +rewrite 2!big_cons; case: (P i) => //. +by rewrite SApreimsetI IHr. +Qed. + +Lemma SAset_fiber_fun n m (f : {SAfun F^n -> F^m}) (x : 'rV[F]_n) : + SAset_fiber f x = [set f x]. +Proof. +apply/eqP/SAsetP => y; rewrite inSApreimset SAjoinE -inSAfun. +by rewrite SAfun_constE SAidE inSAset_seq mem_seq1 eq_sym. +Qed. + +Lemma SAset_fiber_epigraph n (f : {SAfun F^n -> F^1}) (x : 'rV[F]_n) : + SAset_fiber (SAepigraph f) x = SAset_itv `]f x 0 0, +oo[%R. +Proof. +apply/eqP/SAsetP => y; rewrite inSApreimset inSAepigraph SAjoinE row_mxKl. +by rewrite row_mxKr SAfun_constE SAidE inSAset_itv in_itv/= andbT. +Qed. + +Lemma SAset_fiber_hypograph n (f : {SAfun F^n -> F^1}) (x : 'rV[F]_n) : + SAset_fiber (SAhypograph f) x = SAset_itv `]-oo, f x 0 0[%R. +Proof. +apply/eqP/SAsetP => y; rewrite inSApreimset inSAhypograph SAjoinE row_mxKl. +by rewrite row_mxKr SAfun_constE SAidE inSAset_itv in_itv/=. +Qed. + +Lemma SAset_fiber_partition_of_graphs (n : nat) + (xi : seq {SAfun F^n -> F^1}) (x : 'rV[F]_n) : + [seq SAset_fiber s x | s <- partition_of_graphs xi] = + partition_of_pts [seq (f : {SAfun F^n -> F^1}) x 0 0 | f <- xi]. +Proof. +apply/(@eq_from_nth _ (SAset0 F 1)) => [|i]; first by rewrite !size_map. +rewrite 2!size_map size_iota => ilt. +rewrite (nth_map 0); last by rewrite size_iota size_map. +rewrite (nth_map (SAset0 F _)); last by rewrite size_map size_iota. +rewrite (nth_map 0) ?size_iota// nth_iota// nth_iota ?size_map// add0n. +case: (posnP i) => [_|i0]. + rewrite big_map /SAset_fiber SApreimset_bigcap. + apply/eq_bigr => f _; exact/SAset_fiber_hypograph. +case/boolP: (_ == _) => [_|im]. + rewrite big_map /SAset_fiber SApreimset_bigcap. + apply/eq_bigr => f _; exact/SAset_fiber_epigraph. +case/boolP: (odd i) => i2. + rewrite SAset_fiber_fun (nth_map 0); last first. + by rewrite -ltn_double odd_halfK// prednK. + by congr [set _]; apply/eqP; rewrite rowPE forall_ord1 mxE. +rewrite /SAset_fiber SApreimsetI [X in X :&: _]SAset_fiber_epigraph. +rewrite [X in _ :&: X]SAset_fiber_hypograph. +apply/eqP/SAsetP => y; rewrite inSAsetI !inSAset_itv !in_itv/= andbT. +rewrite (nth_map 0). + by rewrite (nth_map 0)// -ltn_double even_halfK// ltn_neqAle im -ltnS. +rewrite -ltn_double double_pred even_halfK// prednK; last first. + by case: i {ilt im} i0 i2 => //; case. +by rewrite -ltnS prednK// ltnW. +Qed. + +Lemma SApreimset0 n m f : SApreimset f (SAset0 F n) = SAset0 F m. +Proof. +apply/eqP; rewrite -subset0; apply/SAset_subP => x. +by rewrite inSApreimset [_ _ \in _]inSAset0. +Qed. + +Lemma SAset_partition_of_graphs (n : nat) (xi : seq (SAfunltType n)) : + path.sorted <%O xi -> SAset_partition [fset x | x in partition_of_graphs xi]. +Proof. +set S := [fset x | x in partition_of_graphs xi]. +have inS x : x \in S = (x \in partition_of_graphs xi). + by apply/imfsetP/idP => [[] y yS -> //|xS]; exists x. +move=> /(lt_sorted_ltn_nth (0 : SAfunltType n)) xisort. +have {}xisort x : + path.sorted <%O [seq (f : {SAfun F^n -> F^1}) x 0 0 | f <- xi]. + apply/path.pairwise_sorted/(pairwiseP 0) => i j. + rewrite !inE size_map => ilt jlt ij. + move: (xisort i j); rewrite !inE => /(_ ilt jlt); rewrite ij. + by rewrite (nth_map 0)// (nth_map 0)// => /SAfun_ltP. +apply/andP; split; last first. + rewrite -subTset; apply/SAset_subP => x _. + move: (SAset_partition_of_pts (xisort (lsubmx x))). + set T := [fset x | x in _]. + move=> /andP[_]; rewrite -subTset => /SAset_subP/(_ (rsubmx x)). + rewrite inSAsetT => /(_ isT). + rewrite 2!inSAset_bigcup => /= /hasP[[]] /= s + _. + move=> /imfsetP [t] /= + ->. + rewrite -SAset_fiber_partition_of_graphs => /mapP[u]. + rewrite -inS => uS ->. + rewrite inSAset_fiber hsubmxK => xu. + by apply/hasP; exists [` uS ] => //; apply/mem_index_enum. +apply/andP; split. + apply/negP; rewrite inS => xi0. + move: (elimT (nthP (SAset0 F _)) xi0) => {xi0} [] i. + rewrite size_map size_iota => ilt i0. + have: SAset_fiber (SAset0 F (n + 1)) 0 = SAset0 F _. + by rewrite /SAset_fiber SApreimset0. + rewrite -i0 -[LHS](@nth_map _ _ _ (SAset0 F _) (fun s => SAset_fiber s 0)); + last by rewrite size_map size_iota. + rewrite SAset_fiber_partition_of_graphs => {}i0. + move: (SAset_partition_of_pts (xisort 0)). + set T := [fset x | x in _] => /andP[] /andP[] + _ _ => /imfsetP; apply. + exists (SAset0 F 1) => //=. + by rewrite -i0 mem_nth// size_map size_iota size_map. +apply/forallP => -[] /= s; rewrite inS => sxi. +move: (elimT (nthP (SAset0 F _)) sxi) => {sxi} [] i + <-. +rewrite size_map size_iota => ilt. +apply/forallP => -[] /= t; rewrite inS => txi. +move: (elimT (nthP (SAset0 F _)) txi) => {txi} [] j + <-. +rewrite size_map size_iota => jlt. +apply/implyP => ij. +case/boolP: (i == j) => [/eqP ijE|{}ij]; first by rewrite ijE eqxx in ij. +rewrite /SAset_disjoint -subset0; apply/SAset_subP => x. +rewrite inSAsetI => /andP[] xii xj. +move: (SAset_partition_of_pts (xisort (lsubmx x))). +set xi' := [seq (f : {SAfun F^n -> F^1}) (lsubmx x) 0 0 | f <- xi]. +set T := [fset x | x in _] => /andP[] /andP[_] + _. +have inT y : y \in T = (y \in partition_of_pts xi'). + by apply/imfsetP/idP => [[] z zS -> //|yS]; exists y. +have nk k: (k < (size xi).*2.+1)%N -> + nth (SAset0 F _) (partition_of_pts xi') k \in T. + by rewrite inT => klt; apply/mem_nth; rewrite size_map size_iota size_map. +move=> /forallP/(_ [` nk i ilt]) /forallP/(_ [` nk j jlt]) /implyP/=. +rewrite nth_uniq ?size_map ?size_iota//; last first. + by move: (xisort (lsubmx x)) => /sorted_partition_of_pts /lt_sorted_uniq. +move=> /(_ ij) /eqP ij0. +suff: rsubmx x \in SAset0 F 1 by rewrite inSAset0. +rewrite -ij0 -!SAset_fiber_partition_of_graphs inSAsetI. +rewrite (nth_map (SAset0 F _)) ?size_map ?size_iota//. +rewrite (nth_map (SAset0 F _)) ?size_map ?size_iota//. +by rewrite !inSAset_fiber hsubmxK xii. +Qed. + +Definition partition_of_graphs_above n (s : {SAset F^n}) + (xi : seq {SAfun F^n -> F^1}) : {fset {SAset F^(n + 1)%N}} := + [fset x :&: (s :*: SAsetT F 1) | x in partition_of_graphs xi]. + +Lemma SAset_partition_of_graphs_above n (S : {fset {SAset F^n}}) + (xi : S -> seq (SAfunltType n)) : + SAset_partition S -> + (forall s, path.sorted <%O (xi s)) -> + SAset_partition + (\big[fsetU/fset0]_(s : S) + partition_of_graphs_above (val s) (in_tuple (xi s))). +Proof. +move=> /andP[] /andP[] S0 SI /eqP SU xisort. +have {}xisort (s : S) x : + path.sorted <%O [seq (f : {SAfun F^n -> F^1}) x 0 0 | f <- xi s]. + apply/path.pairwise_sorted/(pairwiseP 0) => i j. + rewrite !inE size_map => ilt jlt ij. + move: (xisort s) => /(lt_sorted_ltn_nth (0 : SAfunltType n))/(_ i j). + rewrite !inE => /(_ ilt jlt); rewrite ij. + by rewrite (nth_map 0)// (nth_map 0)// => /SAfun_ltP. +apply/andP; split; last first. + rewrite -subTset; apply/SAset_subP => x _. + have: lsubmx x \in SAsetT F n by rewrite inSAsetT. + rewrite -SU inSAset_bigcup => /hasP[] /= s _ xs. + move: (SAset_partition_of_pts (xisort s (lsubmx x))). + set T := [fset x | x in _] => /andP[_]. + rewrite -subTset => /SAset_subP/(_ (rsubmx x)). + rewrite inSAsetT => /(_ isT). + rewrite 2!inSAset_bigcup => /= /hasP[[]] /= t + _. + move=> /imfsetP [u] /= + ->. + rewrite -SAset_fiber_partition_of_graphs => /mapP[v] vxi ->. + rewrite inSAset_fiber hsubmxK => xv. + have vS: + v :&: \val s :*: SAsetT F 1 + \in \bigcup_(s | true) partition_of_graphs_above (val s) (xi s). + apply/bigfcupP; exists s; first by rewrite mem_index_enum. + by apply/imfsetP; exists v. + apply/hasP; exists [` vS ] => /=; first exact/mem_index_enum. + by rewrite inSAsetI xv inSAsetX xs inSAsetT. +apply/andP; split. + apply/negP => /bigfcupP [] /= s _ /imfsetP [t] /= txi. + move: (elimT (nthP (SAset0 F _)) txi) => {txi} [] i. + rewrite size_map size_iota => ilt <- i0. + have [s0|[x xs]] := set0Vmem (val s). + by move: S0; rewrite -s0 => /negP; apply; apply/(fsvalP s). + have: SAset_fiber (SAset0 F (n + 1)) x = SAset0 F _. + by rewrite /SAset_fiber SApreimset0. + rewrite i0 /SAset_fiber SApreimsetI -/(SAset_fiber _ _). + have ->: + SApreimset (SAjoin (SAfun_const 1 x) (SAid 1)) (fsval s :*: SAsetT F 1) + = SAsetT F _. + apply/eqP/SAsetP => y; rewrite inSApreimset SAjoinE SAfun_constE inSAsetX. + by rewrite row_mxKl xs !inSAsetT. + rewrite SAsetIT. + rewrite -[LHS](@nth_map _ _ _ (SAset0 F _) (fun s => SAset_fiber s x)); + last by rewrite size_map size_iota. + rewrite SAset_fiber_partition_of_graphs => {}i0. + move: (SAset_partition_of_pts (xisort s x)). + set T := [fset x | x in _] => /andP[] /andP[] + _ _ => /imfsetP; apply. + exists (SAset0 F 1) => //=. + by rewrite -i0 mem_nth// size_map size_iota size_map. +apply/forallP => -[] /= a /bigfcupP [s] _ /imfsetP [sa] /= saxi. +move: (elimT (nthP (SAset0 F _)) saxi) => {saxi} [] i + <- ->. +rewrite size_map size_iota => ilt. +apply/forallP => -[] /= b /bigfcupP [t] _ /imfsetP [tb] /=. +move=>/(nthP (SAset0 F _)) [j] + <- ->. +rewrite size_map size_iota => jlt; apply/implyP. +move: jlt; have [<- jlt ij|st _ _] := eqVneq s t; last first. + rewrite /SAset_disjoint -subset0; apply/SAset_subP => x. + rewrite !inSAsetI 2!inSAsetX. + move=> /andP[] /andP[_] /andP[xs] _ /andP[_] /andP[xt] _. + move: SI => /forallP/(_ s) /forallP /(_ t) /implyP. + rewrite (inj_eq val_inj) => /(_ st). + rewrite /SAset_disjoint /subset0 => /eqP st0. + suff: lsubmx x \in SAset0 F n by rewrite inSAset0. + by rewrite -st0 inSAsetI xs. +case/boolP: (i == j) => [/eqP ijE|{}ij]; first by rewrite ijE eqxx in ij. +rewrite /SAset_disjoint -subset0; apply/SAset_subP => x. +rewrite !inSAsetI => /andP[] /andP[] xii _ /andP[] xj _. +move: (SAset_partition_of_pts (xisort s (lsubmx x))). +set xi' := [seq (f : {SAfun F^n -> F^1}) (lsubmx x) 0 0 | f <- xi s]. +set T := [fset x | x in _] => /andP[] /andP[_] + _. +have inT y : y \in T = (y \in partition_of_pts xi'). + by apply/imfsetP/idP => [[] z zS -> //|yS]; exists y. +have nk k: (k < (size (xi s)).*2.+1)%N -> + nth (SAset0 F _) (partition_of_pts xi') k \in T. + by rewrite inT => klt; apply/mem_nth; rewrite size_map size_iota size_map. +move=> /forallP/(_ [` nk i ilt]) /forallP/(_ [` nk j jlt]) /implyP/=. +rewrite nth_uniq ?size_map ?size_iota//; last first. + by move: (xisort s (lsubmx x)) => /sorted_partition_of_pts /lt_sorted_uniq. +move=> /(_ ij) /eqP ij0. +suff: rsubmx x \in SAset0 F 1 by rewrite inSAset0. +rewrite -ij0 -!SAset_fiber_partition_of_graphs inSAsetI. +rewrite (nth_map (SAset0 F _)) ?size_map ?size_iota//. +rewrite (nth_map (SAset0 F _)) ?size_map ?size_iota//. +by rewrite !inSAset_fiber hsubmxK xii. +Qed. + +Lemma SAset_cast_partition_of_graphs_above n (s : {SAset F^n}) + (xi : seq (SAfunltType n)) t : + sorted <%O xi -> + t \in partition_of_graphs_above s xi -> SAset_cast n t = s. +Proof. +move=> xisort /imfsetP[] /= u uxi ->. +apply/eqP/SAsetP => x; apply/inSAset_castDn/idP => [|xs]. + by move=> [y] [+] ->; rewrite inSAsetI inSAsetX => /andP[_] /andP[]. +move: uxi => /(nthP (SAset0 F _)) [] i. +rewrite size_map size_iota => ilt <-. +set xi' := [seq (f : {SAfun F^n -> F^1}) x ord0 ord0 | f <- xi]. +have: sorted <%O xi' by apply/(homo_sorted _ _ xisort) => f g /SAfun_ltP /(_ x). +move=> /SAset_partition_of_pts. +set S := [fset x0 | x0 in _] => /andP[] /andP[] + _ _. +have [<-|[y] yi _] := set0Vmem (nth (SAset0 F _) (partition_of_pts xi') i). + move=> /negP; elim; apply/imfsetP. + exists (nth (SAset0 F 1) (partition_of_pts xi') i) => //=. + by apply/mem_nth; rewrite 2!size_map size_iota. +exists (row_mx x y); split; last by rewrite row_mxKl. +move: yi; rewrite -SAset_fiber_partition_of_graphs. +rewrite (nth_map (SAset0 F _)) ?size_map ?size_iota// inSAset_fiber inSAsetI. +by move=> ->; rewrite inSAsetX row_mxKl row_mxKr xs inSAsetT. +Qed. + +Lemma SAset_partition_cast n m (S : {fset {SAset F^n}}) : + n = m -> SAset_partition [fset SAset_cast m x | x in S] = SAset_partition S. +Proof. +move=> nm; move: S; rewrite nm => S; congr SAset_partition. +apply/fsetP => /= x; apply/imfsetP/idP => [|xS]. + by move=> /= [y] yS ->; rewrite SAset_cast_id. +by exists x => //; rewrite SAset_cast_id. +Qed. + +End SAfunOps. + +Lemma SAset_formula (F : rcfType) (n : nat) (s : {SAset F^n}) : + {f : formula F | rformula f /\ qf_form f /\ s = [set | f]}. +Proof. +exists (qf_elim s); split; first exact/rform_qf_elim. +split; first exact/qf_elim_qf. +apply/eqP/SAsetP => x. +apply/rcf_satP/SAin_setP => [xs|/rcf_satP/qf_elim_holdsP//]. +exact/rcf_satP/qf_elim_holdsP. +Qed. + +Lemma SAset_nf (F : rcfType) (n : nat) (s : {SAset F^n}) : + {P : seq ({mpoly F[n]} * seq {mpoly F[n]}) | + s = \big[@SAsetU F n/SAset0 F n]_(p <- P) + (SApreimset (SAmpoly (fst p)) (SAset_seq [:: 0]) + :&: \big[@SAsetI F n/SAsetT F n]_(q <- (snd p)) + SApreimset (SAmpoly q) (SAset_pos F))}. +Proof. +pose has_nf (f : {SAset F^n}) := + {P : seq ({mpoly F[n]} * seq {mpoly F[n]}) + | f = + \big[SAsetU (n:=n)/SAset0 F n]_(p <- P) + (SApreimset (SAmpoly (p.1)%PAIR) [ set 0] + :&: \big[SAsetI (n:=n)/SAsetT F n]_(q <- (p.2)%PAIR) + SApreimset (SAmpoly q) (SAset_pos F))}. +have IHI (f g : {SAset F^n}) : + has_nf f -> has_nf g -> has_nf (f :&: g). + move=> [Pf] fE [Pg] gE. + exists ([seq ((fst pf) ^+ 2 + (fst pg) ^+ 2, (snd pf) ++ (snd pg)) + | pf <- Pf, pg <- Pg])%R. + rewrite fE gE SAsetIbigcup/=. + apply/eqP/SAsetP => x; rewrite !inSAset_bigcup/=. + apply/hasP/hasP => /= -[[i j]] /allpairsP /= [[pf pg]] /= [] pfP pgP + /pair_equal_spec [-> ->]. + rewrite !inSAsetI 2!inSApreimset !inSAset1 !SAmpolyE !inSAset_bigcap/=. + rewrite !rowPE !forall_ord1 !mxE. + move=> /andP[]/andP[] /eqP pf10 /allP pf20 /andP[] /eqP pg10 /allP pg20. + exists ((fst pf) ^+ 2 + (fst pg) ^+ 2, (snd pf) ++ (snd pg))%R. + by apply/allpairsP => /=; exists (pf, pg). + rewrite inSAsetI inSApreimset inSAset1 SAmpolyE inSAset_bigcap/=. + rewrite rowPE forall_ord1 !mxE mevalD !mevalXn pf10 pg10 expr0n/= addr0 + eqxx/=. + by apply/allP => p; rewrite mem_cat => /orP [/pf20|/pg20]. + rewrite inSAsetI inSApreimset inSAset1 SAmpolyE inSAset_bigcap/= rowPE + forall_ord1 !mxE mevalD !mevalXn paddr_eq0 ?sqr_ge0// !sqrf_eq0. + move=> /andP[]/andP[] pf10 pg10 /allP pfg20. + exists (pf, pg); first by apply/allpairsP => /=; exists (pf, pg). + rewrite !inSAsetI 2!inSApreimset !SAmpolyE !inSAset1 !rowPE !forall_ord1 !mxE. + rewrite pf10 pg10/= !inSAset_bigcap; apply/andP. + by split; apply/allP => p pP /=; apply/pfg20; rewrite mem_cat pP// orbT. +have IHIs (I : Type) (r : seq I) (f : I -> {SAset F^n}) : + (forall i, has_nf (f i)) + -> has_nf (\big[@SAsetI F n/SAsetT F n]_(i <- r) f i). + move=> P; elim: r => [|i r IHr]; last by rewrite big_cons; apply/IHI. + exists [:: (0, [::])]; rewrite big_seq1 !big_nil SAsetIT; apply/esym/eqP. + rewrite -subTset; apply/SAset_subP => x _. + by rewrite inSApreimset inSAset1 SAmpolyE/= meval0 rowPE forall_ord1 !mxE. +have IHC (f : {SAset F^n}) : has_nf f -> has_nf (~: f). + move=> [P] ->; rewrite SAsetCbigcup; apply/IHIs => pf. + rewrite SAsetCI SAsetCbigcap. + exists ((0, [:: fst pf]) :: (0, [:: - (fst pf)]) :: + [seq (p, [::]) | p <- snd pf] ++ [seq (0, [:: - p]) | p <- snd pf]). + rewrite big_cons big_seq1 big_cons big_seq1/=; apply/eqP/SAsetP => x. + rewrite !inSAsetU !inSAsetI inSAsetC 4!inSApreimset !SAmpolyE 2!inSAset1 + !rowPE !forall_ord1 !inSAset_pos !mxE meval0 eqxx/= mevalN oppr_gt0 + !inSAset_bigcup/=. + apply/orP/orP => [[/lt_total pf10|/hasP [p pP]]|[pf10|/orP [pf10|/hasP [p]]]]. + - by apply/orP; rewrite orbCA orbA pf10. + - rewrite inSAsetC inSApreimset inSAset_pos SAmpolyE mxE -leNgt + le_eqVlt => /orP p0. + right; apply/orP; right; apply/hasP; case: p0 => p0. + exists (p, [::]). + by rewrite mem_cat; apply/orP; left; apply/mapP; exists p. + by rewrite big_nil SAsetIT inSApreimset SAmpolyE inSAset1 rowPE + forall_ord1 !mxE/=. + exists (0, [:: -p]). + by rewrite mem_cat; apply/orP; right; apply/mapP; exists p. + rewrite inSAsetI/= big_seq1 2!inSApreimset inSAset1 inSAset_pos !SAmpolyE. + by rewrite rowPE forall_ord1 !mxE meval0 eqxx mevalN oppr_gt0. + - by left; rewrite eq_sym (lt_eqF pf10). + - by left; rewrite (lt_eqF pf10). + rewrite mem_cat => /= /orP [|] /mapP [q]/= qf ->. + rewrite big_nil SAsetIT inSApreimset inSAset1 SAmpolyE rowPE forall_ord1 + !mxE/= => /eqP q0. + right; apply/hasP; exists q => //. + by rewrite inSAsetC inSApreimset inSAset_pos SAmpolyE !mxE q0 ltxx. + rewrite big_seq1 inSAsetI 2!inSApreimset inSAset1 inSAset_pos !SAmpolyE + rowPE forall_ord1 !mxE/= meval0 eqxx mevalN oppr_gt0/= => q0. + right; apply/hasP; exists q => //. + by rewrite inSAsetC inSApreimset inSAset_pos SAmpolyE !mxE -leNgt le_eqVlt + q0 orbT. +case: (SAset_formula s) => + [+][+] -> {s}; elim=> //=. +- move=> + _ _; case; last first. + exists [::]; rewrite big_nil; apply/eqP/SAsetP => x. + by rewrite inSAset0; apply/negP => /SAin_setP. + exists [:: (0, [::])]; apply/esym/eqP. + rewrite -subTset big_seq1 big_nil SAsetIT; apply/SAset_subP => x _. + rewrite inSApreimset inSAset1 SAmpolyE/= meval0. + by apply/eqP/rowP => i; rewrite !mxE. +- move=> t u /andP[] rt ru _. + exists [:: (mpoly_rterm n (to_rterm (GRing.Add t (GRing.Opp u))), [::])]. + rewrite big_seq1/= big_nil SAsetIT; apply/eqP/SAsetP => x. + rewrite inSApreimset SAmpolyE [RHS]inSAset1 rowPE forall_ord1 !mxE mevalB subr_eq0. + by rewrite !meval_mpoly_rterm !evalE !eval_rterm//; apply/SAin_setP/eqP. +- move=> t u /andP[] rt ru _. + exists [:: (0, [:: mpoly_rterm n (to_rterm (GRing.Add u (GRing.Opp t)))])]. + rewrite big_seq1/= big_seq1; apply/eqP/SAsetP => x. + rewrite inSAsetI 2!inSApreimset !SAmpolyE [in RHS]inSAset1 rowPE forall_ord1. + rewrite inSAset_pos !mxE meval0 eqxx/= mevalB subr_gt0 !meval_mpoly_rterm. + by rewrite !evalE !eval_rterm//; apply/SAin_setP/idP. +- move=> t u /andP[] rt ru _. + pose v := GRing.Add u (GRing.Opp t). + exists [:: (mpoly_rterm n (to_rterm v), [::]); + (0, [:: mpoly_rterm n (to_rterm v)])]. + rewrite big_cons big_nil big_seq1/= big_seq1 SAsetIT; apply/eqP/SAsetP => x. + rewrite inSAsetU inSAsetI 3!inSApreimset !SAmpolyE 2![in RHS]inSAset1 !rowPE. + rewrite !forall_ord1 inSAset_pos !mxE meval0 eqxx/= mevalB subr_gt0. + rewrite subr_eq0 eq_sym -le_eqVlt !meval_mpoly_rterm !evalE !eval_rterm//. + exact/SAin_setP/idP. +- move=> f IHf g IHg /andP[] /IHf {}IHf /IHg {}IHg. + move=> /andP[] {}/IHf fnf {}/IHg gnf. + by rewrite -SAsetI_comprehension; apply/IHI. +- move=> f IHf g IHg /andP[] /IHf {}IHf /IHg {}IHg. + move=> /andP[] {}/IHf [Pf]fE {}/IHg [Pg]gE. + by exists (Pf ++ Pg); rewrite big_cat/= -fE -gE SAsetU_comprehension. +- move=> f IHf g IHg /andP[] /IHf {}IHf /IHg {}IHg. + move=> /andP[] {}/IHf fnf {}/IHg gnf. + suff ->: [set| f ==> g] = ~: ([set| f] :&: ~: [set| g]) :> {SAset F^n}. + by apply/IHC/IHI => //; apply/IHC. + apply/eqP/SAsetP => x. + rewrite inSAsetC inSAsetI inSAsetC negb_and negbK. + apply/SAin_setP/orP => /= [fg|[/negP xf /SAin_setP|/SAin_setP xg _]//]. + case /boolP: (x \in [set| f]) => /SAin_setP xf; last by left. + by right; apply/SAin_setP/fg. +- by move=> f /[apply]/[apply] /IHC; rewrite SAsetC_comprehension. +Qed. + +Lemma SAset_nf_1Uitv (F : rcfType) (s : {SAset F^1}) : + {r | s = \big[@SAsetU F 1/SAset0 F 1]_(i <- r) SAset_itv i}. +Proof. +pose has_nf (f : {SAset F^1}) := + {r | f = \big[@SAsetU F 1/SAset0 F 1]_(i <- r) SAset_itv i}. +have has_nfU2 f g : has_nf f -> has_nf g -> has_nf (f :|: g). + by move=> [] fi -> [] gi ->; exists (fi ++ gi); rewrite big_cat. +have has_nfU (T : Type) (r : seq T) f : + (forall i, has_nf (f i)) -> + has_nf (\big[@SAsetU F 1/SAset0 F 1]_(i <- r) f i). + elim: r => [|i r IHr] fP. + by rewrite big_nil; exists [::]; rewrite big_nil. + by rewrite big_cons; apply/has_nfU2 => //; apply/IHr. +have has_nfI2 f g : has_nf f -> has_nf g -> has_nf (f :&: g). + move=> [] fi -> [] gi ->; rewrite SAsetIbigcup/=. + exists [seq let: (Interval xl xr, Interval yl yr) := x in + Interval (Order.max xl yl) (Order.min xr yr) | x <- allpairs pair fi gi]. + rewrite big_map; apply/eq_bigr => -[] [] xl xr [] yl yr _. + apply/eqP/SAsetP => x. + rewrite inSAsetI !inSAset_itv !in_itv'. + by rewrite ge_max le_min/= andbACA. +have has_nfI (T : Type) (r : seq T) f : + (forall i, has_nf (f i)) -> + has_nf (\big[@SAsetI F 1/SAsetT F 1]_(i <- r) f i). + elim: r => [|i r IHr] fP; last first. + by rewrite big_cons; apply/has_nfI2 => //; apply/IHr. + rewrite big_nil; exists [:: `]-oo, +oo[]. + rewrite big_cons big_nil SAsetUC SAset0U. + apply/eqP/SAsetP => x. + by rewrite inSAsetT inSAset_itv in_itv. +case: (SAset_nf s) => + -> => nf. +have mnm0 (m : 'X_{1.. 1}): + [multinom [tuple m (widen_ord (leqnSn 0) i) | i < 0]] == 0%MM. + by apply/(@eqP (_.-tuple _))/eq_from_tnth; case. +have coeffp1 (p : {mpoly F[1]}) (m : 'X_{1.. 1}) : + p@_m = (map_poly (mcoeff 0) (muni p))`_(m ord0). + rewrite coef_map/= muniE coef_sum. + under eq_bigr => n _. + rewrite coefZ coefXn mulr_natr mulrb. + have ->: (m ord0 == n ord_max) = (n == m). + rewrite [RHS]eq_sym; case: m => m/=; case: n => n/=. + apply/eqP/eqP => [mn|->]; last first. + by congr (_ _); apply/val_inj. + suff ->: m = n by []. + apply/eq_from_tnth; case; case=> [|//] lt01. + have {1}->: (Ordinal lt01) = ord0 by apply/val_inj. + by rewrite [LHS]mn; congr tnth; apply/val_inj. + over. + rewrite -big_mkcond/= big_pred1_seq ?msupp_uniq//. + case/boolP: (m \in _) => mp; first by rewrite mcoeffZ mcoeffX/= mnm0 mulr1. + by apply/eqP; rewrite mcoeff0 mcoeff_eq0. +have mevalp1 (p : {mpoly F[1]}) (x : 'I_1 -> F) : + p.@[x] = (map_poly (mcoeff 0) (muni p)).[x ord0]. + rewrite -[x 0](mpolyCK 0) horner_map/= muniE horner_sum. + rewrite raddf_sum {1}(mpolyE p) raddf_sum/=. + apply/eq_bigr => m _. + rewrite mevalZ mevalX big_ord_recl big_ord0 mulr1. + rewrite hornerZ hornerXn -rmorphXn/= [in RHS]mulrC mcoeffCM. + rewrite mcoeffZ mcoeffX mnm0 mulr1 mulrC. + by congr (_ ^+ (m _) * _); apply/val_inj. +apply/has_nfU => -[/=] p r; apply/has_nfI2. + have [->|p0] := eqVneq p 0. + exists [:: `]-oo, +oo[]. + apply/eqP/SAsetP => x. + rewrite inSApreimset inSAset1 SAmpolyE rowPE forall_ord1 !mxE. + rewrite meval0 big_cons big_nil SAsetUC SAset0U inSAset_itv in_itv/=. + by rewrite eqxx. + exists [seq `[x, x] | x <- rootsR (map_poly (mcoeff 0) (muni p))]. + apply/eqP/SAsetP => x. + rewrite inSApreimset inSAset1 SAmpolyE rowPE forall_ord1 !mxE. + rewrite inSAset_bigcup has_map/= /preim/=. + under eq_has => y/=. + rewrite inSAset_itv in_itv/=. + have ->: (y <= x 0 0 <= y) = (y == x 0 0). + by apply/idP/eqP => [/le_anti //| ->]; rewrite lexx. + over. + rewrite has_pred1 in_rootsR. + suff -> /=: map_poly (mcoeff 0) (muni p) != 0. + by rewrite rootE mevalp1. + move: p0; apply/contraNN => /eqP/polyP p0. + by apply/eqP/mpolyP => m; rewrite mcoeff0 coeffp1 p0 coef0. +apply/has_nfI => {nf r}p. +pose q := (map_poly (mcoeff 0) (muni p)). +move rE: (rootsR q) => r. +case: r rE => [|x r] rE. + case/boolP: (0 < lead_coef q) => [|/negP] p0. + exists [:: `]-oo, +oo[]; rewrite big_seq1. + apply/eqP/SAsetP => x. + rewrite inSApreimset inSAset_pos SAmpolyE mxE inSAset_itv in_itv/=. + by rewrite -sgz_gt0 mevalp1 sgz_horner rE/= big_nil expr0 !mulr1 sgz_gt0. + exists [::]; rewrite big_nil. + apply/eqP; rewrite -subset0; apply/SAset_subP => x. + rewrite inSApreimset inSAset_pos SAmpolyE mxE inSAset0. + by rewrite -sgz_gt0 mevalp1 sgz_horner rE/= big_nil expr0 !mulr1 sgz_gt0. +move id_natE: (@id nat) => id_nat. +exists ( +(if (0 < lead_coef q) (+) odd (\sum_(y0 <- rootsR q) \mu_y0 q) then + cons `]-oo, x[ else id) + ((if 0 < lead_coef q then + cons `]last x r, +oo[ else id) + [seq `](x :: r)`_i, r`_i[ | + i <- iota 0 (size r) & sgz q.[((x :: r)`_i + r`_i) / 2] == 1])). +apply/eqP/SAsetP => y. +rewrite inSApreimset inSAset_pos SAmpolyE mxE inSAset_bigcup. +move: rE; have [->|q0 rE] := eqVneq q 0. + by rewrite rootsR0. +rewrite mevalp1 -/q. +have /(pairwiseP 0) xr_sort: pairwise <%O (x :: r). + by rewrite -lt_sorted_pairwise -rE; exact/sorted_roots. +have xr_sort': + {in gtn (size (x :: r)) &, + {homo nth 0 (x :: r) : i j / (i <= j)%N >-> i <= j}}. + move=> i j ilt jlt. + rewrite leq_eqVlt => /orP[/eqP ->|ij]; first exact/lexx. + exact/ltW/xr_sort. +case /boolP: (root q (y 0 0)) => qy0 /=. + rewrite -sgz_gt0 sgz_horner in_rootsR q0/= qy0. + rewrite mulr0 mul0r ltxx; apply/esym/negP => /hasP[/=] I IE yI. + have: y 0 0 \in x :: r by rewrite -rE in_rootsR q0. + move=> /(nthP 0)[/=] i ir yE. + move: yI; have [->|Ix] := eqVneq I `]-oo, x[. + rewrite inSAset_itv in_itv/= -yE. + case: (posnP i) => [->|i0]; first by rewrite ltxx. + rewrite ltNge ltW//. + by move: (xr_sort 0 i); rewrite inE ltn0Sn inE ir; apply. + move: IE; rewrite if_arg 2!fun_if in_cons (negPf Ix)/= if_same. + have [-> _|Ir] := eqVneq I `]last x r, +oo[. + rewrite inSAset_itv in_itv/= andbT (last_nth 0) -yE. + move: (xr_sort' i (size r)); rewrite !inE => /(_ ir (leqnn _)). + rewrite -ltnS => /(_ ir) => {}ir. + by move=> /(le_lt_trans ir); rewrite ltxx. + rewrite if_arg 2!fun_if in_cons (negPf Ir)/= if_same. + move=> /mapP[/=] n; rewrite mem_filter mem_iota/=. + move=> /andP[_] nr ->. + rewrite inSAset_itv in_itv/= -yE => /andP[] nlt ilt. + case: (ltnP i n) => [iltn|]. + move: (xr_sort i n); rewrite !inE/= [(n < _)%N]ltnS. + move=> /(_ ir (ltnW nr) iltn). + by rewrite ltNge ltW. + rewrite leq_eqVlt => /orP[/eqP nE|ni]. + by rewrite nE ltxx in nlt. + move: xr_sort' => /(_ n.+1 i). + by rewrite !inE/= ltnS => /(_ nr ir ni) /(lt_le_trans ilt); rewrite ltxx. +apply/idP/idP => [q0'|]; last first. + move=> /hasP[] I. + have [->|Ix] := eqVneq I `]-oo, x[. + case/boolP: ((0 < lead_coef q) (+) odd (\sum_(y0 <- rootsR q) \mu_y0 q)) + => [q0'|] _; last first. + case: (0 < lead_coef q); last by move=> /mapP[]. + by rewrite in_cons/= => /mapP[]. + rewrite inSAset_itv in_itv/= => yx. + rewrite -sgz_gt0 sgz_horner in_rootsR (negPf qy0) andbF/= mulr1. + rewrite big_mkcond big_seq -big_mkcondr/=. + under eq_bigl => z. + have ->: (z \in rootsR q) && (y 0 0 < z) = (z \in rootsR q). + case/boolP: (z \in rootsR q) => [/=|//]. + rewrite rE => /(nthP 0)[] i iq <-. + move: (xr_sort 0 i). + rewrite !inE => /(_ (leq_trans (ltn0Sn _) iq) iq). + by case: i {iq} => [//|i] /(_ isT)/(lt_trans yx). + over. + rewrite -big_seq -signr_odd; case: (odd _) q0'; last first. + by rewrite addbF expr0 mulr1 sgz_gt0. + rewrite addbT expr1 mulrN1 oppr_gt0 -leNgt le_eqVlt. + by rewrite lead_coef_eq0 (negPf q0)/= sgz_lt0. + have [->|Ir] := eqVneq I `]last x r, +oo[. + case/boolP: (0 < lead_coef q) => [q0'|] _; last first. + case: (odd _) => /=; last by move=> /mapP[]. + by rewrite in_cons/= => /mapP[]. + rewrite inSAset_itv in_itv/= andbT => ry. + rewrite -sgz_gt0 sgz_horner in_rootsR (negPf qy0) andbF/= mulr1. + rewrite big_mkcond big_seq -big_mkcondr/=. + under eq_bigl => z. + have ->: (z \in rootsR q) && (y 0 0 < z) = false. + apply/negP => /andP[]; rewrite rE => /(nthP 0)[] i ir <-. + move: (xr_sort i (size r)); rewrite !inE => /(_ ir (leqnn _)). + move: ir; rewrite /= ltnS leq_eqVlt => /orP[/eqP -> _|]. + by rewrite nth_last/= => /(lt_trans ry); rewrite ltxx. + move=> /[swap]/[apply]; rewrite nth_last/= => ir /(lt_trans ry). + by move=> /(lt_trans ir); rewrite ltxx. + over. + by rewrite big_pred0// expr0 mulr1 sgz_gt0. + rewrite 2!if_arg 2!fun_if in_cons (negPf Ix)/= 3!fun_if in_cons (negPf Ir)/=. + rewrite 2!if_same => /mapP[]/= i; rewrite mem_filter sgz_cp0 mem_iota/=. + move=> /andP[] q0' ilt ->. + rewrite inSAset_itv in_itv/= => /andP[] iy yi. + move: q0'; rewrite -sgz_gt0 -[X in _ -> _ X]sgz_gt0 !sgz_horner. + congr (_ < _ * Posz (_ _) * _ ^+ _). + rewrite [in RHS]in_rootsR (negPf qy0) andbF/= rE; apply/negP. + move=> /(nthP 0)[] j jq ji. + case: (ltnP i j) => ij. + move: (xr_sort' i.+1 j); rewrite !inE/= ltnS => /(_ ilt jq ij). + rewrite ji ler_pdivlMr// mulr_natr mulr2n -subr_ge0 addrKA subr_ge0. + rewrite leNgt => /negP; apply. + apply/(xr_sort i i.+1) => //. + by rewrite inE/= ltnS; apply/ltnW. + move: (xr_sort' j i). + rewrite !inE/= [(i < _)%N]ltnS => /(_ jq (ltnW ilt) ij). + rewrite ji ler_pdivrMr// mulr_natr mulr2n -subr_ge0 addrKA subr_ge0. + rewrite leNgt => /negP; apply. + apply/(xr_sort i i.+1) => //. + by rewrite inE/= ltnS; apply/ltnW. + rewrite big_mkcond big_seq -big_mkcondr [in RHS]big_mkcond [in RHS]big_seq. + rewrite -big_mkcondr/=. + apply/eq_bigl => z; case/boolP: (z \in rootsR q) => // /(nthP 0)[] j. + rewrite rE => jlt <- /=. + rewrite ltr_pdivrMr// mulr_natr mulr2n. + case: (ltnP i j) => ij. + move: (xr_sort' i.+1 j); rewrite !inE/= ltnS => /(_ ilt jlt ij) rij. + rewrite (lt_le_trans yi rij); apply/ltr_leD => //. + exact/(lt_le_trans _ rij)/(lt_trans iy). + move: (xr_sort' j i). + rewrite !inE/= [(i < _)%N]ltnS => /(_ jlt (ltnW ilt) ij) rji. + rewrite [RHS]ltNge (ltW (le_lt_trans rji iy))/=; apply/negP/negP. + rewrite -leNgt; apply/lerD => //. + exact/(le_trans rji)/ltW/(lt_trans iy). +rewrite 2!if_arg 2!fun_if/= inSAset_itv in_itv/=. +case: (ltP (y 0 0) x) => yx /=. + move: q0'; rewrite -sgz_gt0 sgz_horner in_rootsR (negPf qy0) andbF/= mulr1. + rewrite big_mkcond big_seq -big_mkcondr/=. + under eq_bigl => z. + have ->: (z \in rootsR q) && (y 0 0 < z) = (z \in rootsR q). + case/boolP: (z \in rootsR q) => [/=|//]. + rewrite rE => /(nthP 0)[] i iq <-. + move: (xr_sort 0 i). + rewrite !inE => /(_ (leq_trans (ltn0Sn _) iq) iq). + by case: i {iq} => [//|i] /(_ isT)/(lt_trans yx). + over. + rewrite -big_seq -signr_odd; case: (odd _); last first. + by rewrite expr0 mulr1 sgz_gt0 => ->. + rewrite expr1 mulrN1 oppr_gt0 sgz_lt0 addbT -leNgt. + by rewrite le_eqVlt lead_coef_eq0 (negPf q0) => ->. +rewrite if_same fun_if/= inSAset_itv in_itv/= andbT. +case: (ltP (last x r) (y 0 0)) => ry. + move: q0'; rewrite -sgz_gt0 sgz_horner in_rootsR (negPf qy0) andbF/= mulr1. + rewrite big_mkcond big_seq -big_mkcondr/=. + under eq_bigl => z. + have ->: (z \in rootsR q) && (y 0 0 < z) = false. + apply/negP => /andP[]; rewrite rE => /(nthP 0)[] i ir <-. + move: (xr_sort i (size r)); rewrite !inE => /(_ ir (leqnn _)). + move: ir; rewrite /= ltnS leq_eqVlt => /orP[/eqP -> _|]. + by rewrite nth_last/= => /(lt_trans ry); rewrite ltxx. + move=> /[swap]/[apply]; rewrite nth_last/= => ir /(lt_trans ry). + by move=> /(lt_trans ir); rewrite ltxx. + over. + by rewrite big_pred0// expr0 mulr1 sgz_gt0 => ->. +rewrite if_same has_map; apply/hasP => /=. +move: yx; rewrite le_eqVlt => /orP[/eqP|] xy. + by move: (mem_head x r); rewrite -rE in_rootsR xy (negPf qy0) andbF. +move: ry; rewrite le_eqVlt => /orP[/eqP|] ry. + by move: (mem_last x r); rewrite -rE in_rootsR -ry (negPf qy0) andbF. +case: (@arg_maxnP 'I_(size r).+1 0 (fun i => (x :: r)`_i < y 0 0) val xy). +move=> j jy/= yj. +move: (ltn_ord j); rewrite ltnS leq_eqVlt => /orP[/eqP|] jr. + by move: jy; rewrite jr -last_nth => /(lt_trans ry); rewrite ltxx. +exists j; last first. + rewrite inSAset_itv in_itv/= jy/= ltNge le_eqVlt. + apply/negP => /orP[/eqP|] yr; last first. + by rewrite -ltnS in jr; move: (yj (Ordinal jr) yr); rewrite ltnn. + have /=: (x :: r)`_j.+1 \in x :: r by apply/mem_nth; rewrite ltnS. + by rewrite yr -rE in_rootsR (negPf qy0) andbF. +rewrite mem_filter mem_iota/= jr andbT sgz_cp0. +move: q0'; rewrite -sgz_gt0 -[X in _ X -> _]sgz_gt0 !sgz_horner. +congr (_ < _ * Posz (_ _) * _ ^+ _). + rewrite in_rootsR (negPf qy0) andbF/= rE; apply/esym/negP. + move=> /(nthP 0)[] k kq kj. + case: (ltnP j k) => jk. + move: (xr_sort' j.+1 k); rewrite !inE/= ltnS => /(_ jr kq jk). + rewrite kj ler_pdivlMr// mulr_natr mulr2n -subr_ge0 addrKA subr_ge0. + rewrite leNgt => /negP; apply. + apply/(xr_sort j j.+1) => //. + by rewrite inE/= ltnS; apply/ltnW. + move: (xr_sort' k j); rewrite !inE/= => /(_ kq (ltn_ord j) jk). + rewrite kj ler_pdivrMr// mulr_natr mulr2n -subr_ge0 addrKA subr_ge0. + rewrite leNgt => /negP; apply. + apply/(xr_sort j j.+1) => //. + by rewrite inE/= ltnS; apply/ltnW. +rewrite big_mkcond big_seq -big_mkcondr [in RHS]big_mkcond [in RHS]big_seq. +rewrite -big_mkcondr/=. +apply/eq_bigl => z; case/boolP: (z \in rootsR q) => // /(nthP 0)[] k. +rewrite rE => klt <- /=. +rewrite ltr_pdivrMr// mulr_natr mulr2n. +case: (ltnP j k) => jk. + rewrite -ltnS in jr. + move: (xr_sort' j.+1 k); rewrite !inE/= => /(_ jr klt jk) rjk. + move: (yj (Ordinal klt)) => /implyP; rewrite -implybNN -ltnNge jk/= -leNgt. + rewrite le_eqVlt => /orP[/eqP jE|yk]. + by move: (mem_nth 0 klt); rewrite -jE -rE in_rootsR (negPf qy0) andbF. + rewrite yk; apply/esym/ltr_leD; first by apply/xr_sort => //; rewrite inE. + by rewrite -[r`_j]/((x :: r)`_j.+1); apply/xr_sort'. +move: (xr_sort' k j). +rewrite !inE/= [(j < _)%N]ltnS => /(_ klt (ltnW jr) jk) rjk. +rewrite ltNge (ltW (le_lt_trans rjk jy))/=; apply/esym/negP/negP. +rewrite -leNgt; apply/lerD => //. +apply/(le_trans rjk)/ltW/(lt_trans jy). +rewrite -ltnS in jr. +move: (yj (Ordinal jr)) => /implyP; rewrite -implybNN ltnn/= -leNgt. +rewrite le_eqVlt => /orP[/eqP yE|//]. +have /=: (x :: r)`_j.+1 \in x :: r by exact/mem_nth. +by rewrite -yE -rE in_rootsR (negPf qy0) andbF. +Qed. + +Section SAorder. +Variables (F : rcfType) (n : nat). +Implicit Types (s : {SAset F^n}). + +Definition SAsetUB (s : {SAset F^1}) : {SAset F^1} := + [set | 'forall 'X_1, (subst_formula [:: 1%N] s ==> ('X_1 <=% 'X_0))%oT]. + +Lemma inSAsetUB (s : {SAset F^1}) (x : 'rV[F]_1) : + reflect (forall y, y \in s -> y ord0 ord0 <= x ord0 ord0) (x \in SAsetUB s). +Proof. +apply/(iffP (SAin_setP _ _)) => /= [+ y ys|yx y]. +move=> /(_ (y ord0 ord0)); rewrite holds_subst/= !nth_set_nth/= enum_ordSl/=. +apply; move: ys => /rcf_satP; congr holds => /=. +by rewrite enum_ordSl enum_ord0. +rewrite holds_subst/= !nth_set_nth/= enum_ordSl/= => ys. +move: yx => /(_ (\row__ y)); rewrite inE/= mxE; apply. +by rewrite enum_ordSl enum_ord0/= mxE; apply/rcf_satP. +Qed. + +Lemma inSAsetUBC (s : {SAset F^1}) (x : 'rV[F]_1) : + reflect (exists y, y \in s /\ x ord0 ord0 < y ord0 ord0) (x \in ~: SAsetUB s). +Proof. +rewrite SAsetC_comprehension. +apply/(iffP (SAin_setP _ _)) => [/n_forall_formula /= [y]|[y][ys] xy]. +rewrite holds_subst/= !nth_set_nth/= enum_ordSl/= => yP. +exists (\row__ y); case/boolP: (\row__ y \in s) => [|/negP ys]. + by move=> /rcf_satP => ys; split=> //; rewrite mxE ltNge; apply/negP => xy. +exfalso; apply/yP => /rcf_satP => ys'; exfalso; apply/ys; move: ys'. +by congr rcf_sat; rewrite /= enum_ordSl enum_ord0/= mxE. +apply/n_forall_formula; exists (y ord0 ord0). +rewrite /= holds_subst/= !nth_set_nth/= enum_ordSl/= => yP. +move: xy; rewrite ltNge => /negP; apply; apply/yP. +move: ys => /rcf_satP; congr holds. +by rewrite /= enum_ordSl enum_ord0/=. +Qed. + +Lemma SAsetUB0 : SAsetUB (SAset0 F 1) = SAsetT F 1. +Proof. +apply/eqP; rewrite -subTset; apply/SAset_subP => x _. +by apply/inSAsetUB => y; rewrite inSAset0. +Qed. + +Lemma SAsetUBT : SAsetUB (SAsetT F 1) = SAset0 F 1. +Proof. +apply/eqP; rewrite -subset0; apply/SAset_subP. +move=> x /inSAsetUB/(_ (x+\row__ 1)%R); rewrite inSAsetT => /(_ isT). +by rewrite !mxE -subr_ge0 opprD addrA subrr add0r leNgt oppr_lt0 ltr01. +Qed. + +Lemma SAsetUBU (s t : {SAset F^1}) : + SAsetUB (s :|: t) = SAsetUB s :&: SAsetUB t. +Proof. +apply/eqP/SAsetP => x; rewrite inSAsetI. +apply/inSAsetUB/andP => [xst|[] /inSAsetUB xs/inSAsetUB xt y]; last first. +by rewrite inSAsetU => /orP [/xs|/xt]. +by split; apply/inSAsetUB => y yst; apply/xst; rewrite inSAsetU yst// orbT. +Qed. + +Lemma SAsetUBbigcup (I : Type) (r : seq I) (P : pred I) (f : I -> {SAset F^1}) : + SAsetUB (\big[@SAsetU F 1/SAset0 F 1]_(i <- r | P i) f i) + = \big[@SAsetI F 1/SAsetT F 1]_(i <- r | P i) (SAsetUB (f i)). +Proof. +elim: r => [|i r IHr]; first by rewrite !big_nil SAsetUB0. +by rewrite !big_cons; case: (P i) => //; rewrite SAsetUBU IHr. +Qed. + +Definition SAsetLB (s : {SAset F^1}) : {SAset F^1} := + [set | 'forall 'X_1, (subst_formula [:: 1%N] s ==> ('X_0 <=% 'X_1))%oT]. + +Lemma inSAsetLB (s : {SAset F^1}) (x : 'rV[F]_1) : + reflect (forall y, y \in s -> x ord0 ord0 <= y ord0 ord0) (x \in SAsetLB s). +Proof. +apply/(iffP (SAin_setP _ _)) => /= [+ y ys|yx y]. + move=> /(_ (y ord0 ord0)); rewrite holds_subst/= !nth_set_nth/= enum_ordSl/=. + apply; move: ys => /rcf_satP; congr holds => /=. + by rewrite enum_ordSl enum_ord0. +rewrite holds_subst/= !nth_set_nth/= enum_ordSl/= => ys. +move: yx => /(_ (\row__ y)); rewrite inE/= mxE; apply. +by rewrite enum_ordSl enum_ord0/= mxE; apply/rcf_satP. +Qed. + +Lemma inSAsetLBC (s : {SAset F^1}) (x : 'rV[F]_1) : + reflect (exists y, y \in s /\ y ord0 ord0 < x ord0 ord0) (x \in ~: SAsetLB s). +Proof. +rewrite SAsetC_comprehension. +apply/(iffP (SAin_setP _ _)) => [/n_forall_formula /= [y]|[y][ys] xy]. + rewrite holds_subst/= !nth_set_nth/= enum_ordSl/= => yP. + exists (\row__ y); case/boolP: (\row__ y \in s) => [|/negP ys]. + by move=> /rcf_satP => ys; split=> //; rewrite mxE ltNge; apply/negP => xy. + exfalso; apply/yP => /rcf_satP => ys'; exfalso; apply/ys; move: ys'. + by congr rcf_sat; rewrite /= enum_ordSl enum_ord0/= mxE. +apply/n_forall_formula; exists (y ord0 ord0). +rewrite /= holds_subst/= !nth_set_nth/= enum_ordSl/= => yP. +move: xy; rewrite ltNge => /negP; apply; apply/yP. +move: ys => /rcf_satP; congr holds. +by rewrite /= enum_ordSl enum_ord0/=. +Qed. + +Lemma SAsetLB0 : SAsetLB (SAset0 F 1) = SAsetT F 1. +Proof. +apply/eqP; rewrite -subTset; apply/SAset_subP => x _. +by apply/inSAsetLB => y; rewrite inSAset0. +Qed. + +Lemma SAsetLBT : SAsetLB (SAsetT F 1) = SAset0 F 1. +Proof. +apply/eqP; rewrite -subset0; apply/SAset_subP. +move=> x /inSAsetLB/(_ (x-\row__ 1)%R); rewrite inSAsetT => /(_ isT). +by rewrite !mxE -subr_ge0 addrAC subrr add0r leNgt oppr_lt0 ltr01. +Qed. + +Lemma SAsetLBU (s t : {SAset F^1}) : + SAsetLB (s :|: t) = SAsetLB s :&: SAsetLB t. +Proof. +apply/eqP/SAsetP => x; rewrite inSAsetI. +apply/inSAsetLB/andP => [xst|[] /inSAsetLB xs/inSAsetLB xt y]; last first. + by rewrite inSAsetU => /orP [/xs|/xt]. +by split; apply/inSAsetLB => y yst; apply/xst; rewrite inSAsetU yst// orbT. +Qed. + +Lemma SAsetLBbigcup (I : Type) (r : seq I) (P : pred I) (f : I -> {SAset F^1}) : + SAsetLB (\big[@SAsetU F 1/SAset0 F 1]_(i <- r | P i) f i) + = \big[@SAsetI F 1/SAsetT F 1]_(i <- r | P i) (SAsetLB (f i)). +Proof. +elim: r => [|i r IHr]; first by rewrite !big_nil SAsetLB0. +by rewrite !big_cons; case: (P i) => //; rewrite SAsetLBU IHr. +Qed. + +Lemma SAset_supP (s : {SAset F^1}) : + s != SAset0 F 1 -> SAsetUB s != SAset0 F 1 + -> {x : F | SAsetUB s = SAset_itv `[x, +oo[%R}. +Proof. +pose Goal (t : {SAset F^1}) := t != SAset0 F 1 -> + SAsetUB t != SAset0 F 1 -> + {x : F | SAsetUB t = SAset_itv `[x, +oo[%R}. +have supU : forall s t : {SAset F^1}, Goal s -> Goal t -> Goal (s :|: t). + move=> {}s t; rewrite /Goal. + have [-> _|s0 /(_ isT)] := eqVneq s (SAset0 F 1); first by rewrite SAset0U. + have [-> + _|t0 + /(_ isT)] := eqVneq t (SAset0 F 1). + by rewrite SAsetUC SAset0U. + rewrite SAsetUBU. + have [-> _ _ _|_ /(_ isT) []sm ->] := eqVneq (SAsetUB s) (SAset0 F 1). + by rewrite SAset0I eqxx. + have [-> _ _|_ /(_ isT) []tm -> _ _] := eqVneq (SAsetUB t) (SAset0 F 1). + by rewrite SAsetI0 eqxx. + exists (maxr sm tm). + apply/eqP/SAsetP => x. + by rewrite inSAsetI !inSAset_itv !in_itv/= ge_max !andbT. +have {}supU (I : Type) (r : seq I) (f : I -> {SAset F^1}) : + (forall i, Goal (f i)) -> Goal (\big[@SAsetU F 1/SAset0 F 1]_(i <- r) f i). + move=> iub; elim: r => [|i r IHr]; first by rewrite big_nil /Goal eqxx. + by rewrite big_cons; apply/supU. +rewrite -/(Goal s); case: (SAset_nf_1Uitv s) => r ->. +apply/supU => I; rewrite /Goal. +case: (set0Vmem (SAset_itv I)) => [-> /[!eqxx]//|[]] x + _. +case: I => l; case=> [br xr|br] xI; last first. + move=> /negP; elim; apply/SAsetP => y. + rewrite inSAset0; apply/negP => /inSAsetUB. + move=> /(_ (\row__ maxr (x 0 0) (y 0 0) + 1)). + move: xI; rewrite !inSAset_itv !in_itv'/= !mxE eqxx/= => /andP[]. + case: br => // lx _. + have ->: (l <= BLeft (maxr (x 0 0) (y 0 0) + 1))%O. + apply/(le_trans lx). + suff: x 0 0 <= maxr (x 0 0) (y 0 0) + 1 by []. + rewrite -subr_ge0 -addrA -opprB subr_ge0 le_max -subr_ge0. + by rewrite opprB addrCA subrr addr0 ler01. + move=> /(_ isT); rewrite leNgt => /negP; apply. + rewrite -subr_gt0 -addrA -opprB subr_gt0 lt_max. + apply/orP; right. + by rewrite -subr_gt0 opprB addrCA subrr addr0 ltr01. +move=> _; exists xr. +apply/eqP/SAsetP => y. +rewrite inSAset_itv in_itv/= andbT. +case: (ltP (y 0 0) xr) => yx. + apply/negP => /inSAsetUB/(_ (\row__ (((maxr (y 0 0) (x 0 0)) + xr) / 2))). + move: xI; rewrite !inSAset_itv !itv_boundlr => /andP[] lx xxr. + rewrite mxE. + have ->: (l <= BLeft ((maxr (y 0 0) (x 0 0) + xr) / 2))%O. + apply/(le_trans lx). + suff: (x 0 0 <= ((maxr (y 0 0) (x 0 0) + xr) / 2)) by []. + rewrite ler_pdivlMr// mulr_natr mulr2n; apply/lerD. + by rewrite le_max lexx orbT. + by move: xxr; case: br => // /ltW. + have -> /=: (BRight ((maxr (y 0 0) (x 0 0) + xr) / 2) <= BSide br xr)%O. + move: xxr; rewrite !leBSide. + case: br => /= xxr. + rewrite ltr_pdivrMr// mulr_natr mulr2n; apply/ltr_leD; last exact/lexx. + by rewrite gt_max yx. + rewrite ler_pdivrMr// mulr_natr mulr2n; apply/lerD; last exact/lexx. + by rewrite ge_max (ltW yx). + move=> /(_ isT). + rewrite ler_pdivrMr// mulr_natr mulr2n leNgt => /negP; apply. + by apply/ler_ltD => //; rewrite le_max lexx. +apply/inSAsetUB => z. +rewrite inSAset_itv itv_boundlr => /andP[_]. +rewrite leBSide => /lteifW zx. +exact/(le_trans zx yx). +Qed. + +End SAorder. diff --git a/subresultant.v b/subresultant.v index a587970..3628761 100644 --- a/subresultant.v +++ b/subresultant.v @@ -1,14 +1,10 @@ -From mathcomp -Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq div fintype tuple. -From mathcomp -Require Import finfun bigop fingroup perm ssralg zmodp matrix mxalgebra. -From mathcomp -Require Import binomial poly polydiv mxpoly ssrnum. -From mathcomp -Require Import ssrint. -From mathcomp Require Import polyrcf qe_rcf_th. - -Require Import extra_ssr. +From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq order. +From mathcomp Require Import div fintype tuple finfun bigop fingroup perm. +From mathcomp Require Import ssralg zmodp matrix mxalgebra interval binomial. +From mathcomp Require Import ssrint poly polydiv mxpoly ssrnum. +From mathcomp Require Import polyorder polyrcf qe_rcf_th. + +Require Import extra_ssr auxresults. (***************************************************************************) (* The statements and proofs in this file are largely inpired by BPR *) @@ -23,7 +19,7 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. -Import GRing.Theory Monoid.Theory Pdiv.Idomain. +Import GRing.Theory Monoid.Theory Pdiv.Idomain Order.POrderTheory. Local Open Scope ring_scope. (**************************************************************************) @@ -106,26 +102,100 @@ case: odd; rewrite /= (mulN1r, mul1r) ?sgrN. by rewrite variationrr mulr0n. Qed. -(* Notation 4.31. from BPR *) -(* Warning! must test if n is odd *) +(* Notation 4.30. from BPR *) Fixpoint pmv_aux (R : numDomainType) (a : R) (n : nat) (s : seq R) := if s is b :: s then if b == 0 then pmv_aux a n.+1 s - else pmv_aux b 0%N s + (-1) ^+ 'C(n, 2) * sgz (a * b) + else pmv_aux b 0%N s + (-1) ^+ 'C(n, 2) * sgz (a * b) *+ ~~ (odd n) else 0. Definition pmv (R : numDomainType) (s : seq R) : int := if s is a :: s then pmv_aux a 0%N s else 0. +Arguments pmv : simpl never. Notation nonzero := (forall x, x != 0). +Lemma pmv_cat0s (R : numDomainType) (a b : R) (s0 s : seq R) : + b != 0 -> {in s0, forall x, x == 0} -> + pmv (a :: s0 ++ b :: s) = + pmv (b :: s) + (-1) ^+ 'C(size s0, 2) * sgz (a * b) *+ ~~ odd (size s0). +Proof. +move=> /negPf b0 s00; rewrite /pmv -[size s0]/(0 + size s0)%N. +move: {1 3 5}0%N => n; elim: s0 n s00 => [|x s0 IHs0] n s00. + by rewrite /= b0 addn0. +rewrite /= s00 ?mem_head// addnS -addSn IHs0// => y ys0. +by apply/s00; rewrite in_cons ys0 orbT. +Qed. + +Lemma pmv_cat00 (R : numDomainType) (a : R) (s0 : seq R) : + {in s0, forall x, x == 0} -> pmv (a :: s0) = 0. +Proof. +rewrite /pmv /=; move: 0%N. +elim: s0 => //= b s0 IHs0 n bs0. +rewrite bs0 ?mem_head// IHs0// => i is0. +by apply/bs0; rewrite in_cons is0 orbT. +Qed. + +Lemma pmv_0s (R : numDomainType) (s : seq R) : + pmv (0 :: s) = pmv s. +Proof. +rewrite /pmv/=; move: {1}0%N. +elim: s => // x s IHs n /=. +have [->|_] := eqVneq x 0; first by rewrite !IHs. +by rewrite mul0r sgz0 mulr0 mul0rn addr0. +Qed. + +Lemma pmv_s0 (R : numDomainType) (s : seq R) : + pmv (rcons s 0) = pmv s. +Proof. +rewrite /pmv; case: s => // x s /=. +elim: s x 0%N => [|y s IHs] /= x n; first by rewrite eqxx. +case: (y == 0); first exact: IHs. +by congr (_ + _); apply: IHs. +Qed. + +Lemma pmv_sgz (R : realDomainType) (s : seq R) : + pmv [seq sgz x | x <- s] = pmv s. +Proof. +rewrite /pmv; case: s => // a s /=. +elim: s a 0%N => // a s IHs b k/=. +by rewrite sgz_eq0 !IHs !sgzM !sgz_id. +Qed. + +Lemma eq_pmv (R : realDomainType) (s t : seq R) : + all2 (fun x y => sgz x == sgz y) s t -> pmv s = pmv t. +Proof. +move=> st; rewrite -pmv_sgz -(pmv_sgz t); congr pmv; apply/eqP. +rewrite eqseq_all; elim: s t st => [|x s IHs]; case=> //= y t /andP[xy] st. +by apply/andP; split=> //; apply/IHs. +Qed. + +Lemma pmv_opp (R : numDomainType) (s : seq R) : + pmv [seq - x | x <- s] = pmv s. +Proof. +rewrite /pmv; case: s => // a s /=. +elim: s a 0%N => // a s IHs b k/=. +by rewrite oppr_eq0 !IHs mulrNN. +Qed. + +Lemma pmvZ (R : realDomainType) (a : R) (s : seq R) : + a != 0 -> pmv [seq a * x | x <- s] = pmv s. +Proof. +rewrite /pmv; case: s => // x s /= /negPf a0. +elim: s x 0%N => // x s IHs y k/=. +rewrite mulf_eq0 a0/= !IHs mulrACA sgzM -expr2 sgzX. +suff ->: sgz a ^+ 2 = 1 by rewrite mul1r. +rewrite /sgz a0/=; case: (a < 0); last exact/expr1n. +by rewrite -signr_odd/= expr0. +Qed. + Fixpoint permanences (R : numDomainType) (s : seq R) : nat := (if s is a :: q then (a * (head 0 q) > 0)%R + permanences q else 0)%N. -(* First remark about Notation 4.31 in BPR *) +(* First remark about Notation 4.30 in BPR *) Lemma nonzero_pmvE (R : rcfType) (s : seq R) : {in s, nonzero} -> pmv s = (permanences s)%:Z - (changes s)%:Z. Proof. -case: s => // a s /=. +rewrite /pmv; case: s => // a s /=. elim: s a => [|b s ihs] a s_neq0; first by rewrite /= mulr0 subrr. rewrite /= (negPf (s_neq0 _ _)); last by rewrite in_cons mem_head orbT. rewrite mul1r ihs; last by move=> x Hx; rewrite /= s_neq0 // in_cons Hx orbT. @@ -144,7 +214,7 @@ have [->|p_neq0]:= eqVneq p 0; first by rewrite lead_coef0 mul0r mulr0. by rewrite polySpred //= negbK addbN addbb mulN1r oppr_lt0. Qed. -(* Second remark about Notation 4.31 in BPR *) +(* Second remark about Notation 4.30 in BPR *) Lemma pmv_changes_poly (R : rcfType) (sp : seq {poly R}) : {in sp, nonzero} -> (forall i, (size sp`_i.+1) = (size sp`_i).-1) -> pmv (map lead_coef sp) = changes_poly sp. @@ -165,6 +235,10 @@ Section SubResultant. Variables (R : ringType) (np nq k : nat) (p q : {poly R}). +Lemma band0 n m : + band 0 = 0 :> 'M[R]_(n, m). +Proof. by apply/matrixP => i j; rewrite !mxE/= mulr0 polyseq0 nth_nil. Qed. + (**************************************************************************) (* We define the SylvesterHabitch_mx in this way, in order to be able to *) (* reuse the poly_rV and rVpoly mappings rather than redefining custom *) @@ -194,21 +268,42 @@ Qed. End SubResultant. +Lemma det_rsub_band (R : comRingType) m n (p : {poly R}) : + (size p).-1 = n -> + \det (rsubmx (band p : 'M_(m, n + m))) = lead_coef p ^+ m. +Proof. +move <-; elim: m => [|m ihm] //; first by rewrite det_mx00 expr0. +rewrite exprS -add1n -[X in \det X]submxK. +rewrite [X in block_mx X _ _ _]mx11_scalar. +rewrite !mxE /= rVpoly_delta /= expr0 mul1r addn0 -lead_coefE. +set ur := ursubmx _; have -> : ur = 0. + apply/matrixP=> i j; rewrite !mxE/= !rVpoly_delta/= !add1n ord1 expr0 mul1r. + by rewrite nth_default // addnS -addn1 addnC -leq_subLR subn1 leq_addr. +rewrite det_lblock det_scalar expr1 -ihm; congr (_ * \det _). +apply/matrixP => i j; rewrite !mxE /= !rVpoly_delta /= !add1n addnS. +by rewrite !coefXnM ltnS subSS. +Qed. + (* Note: it is unclear yet whether the appropriate formulation is *) (* ((size q).-1 - j) or (size q - j.+1) -- Cyril *) Definition subresultant (R : ringType) j (p q : {poly R}) := - let nq := ((size p).-1 - j)%N in let np := ((size q).-1 - j)%N in - (- 1) ^+ 'C(np + nq, 2) * - \det (rsubmx ((block_mx perm_rev_mx 0 0 1%:M) *m - SylvesterHabicht_mx np nq (j + (np + nq)) p q)). + if (j <= (size p).-1)%N && (j <= (size q).-1)%N then + let nq := ((size p).-1 - j)%N in let np := ((size q).-1 - j)%N in + (- 1) ^+ 'C(np + nq, 2) * + \det (rsubmx ((block_mx perm_rev_mx 0 0 1%:M) *m + SylvesterHabicht_mx np nq (j + (np + nq)) p q)) + else if j == (size p).-1 then lead_coef p + else if j == (size q).-1 then lead_coef q + else 0. Lemma subresultantE (R : comRingType) j (p q : {poly R}) : + (j <= (size p).-1)%N -> (j <= (size q).-1)%N -> let np := ((size p).-1 - j)%N in let nq := ((size q).-1 - j)%N in subresultant j p q = (-1) ^+ ('C(nq + np, 2) + 'C(nq, 2)) * \det (rsubmx (SylvesterHabicht_mx nq np (j + (nq + np)) p q)). Proof. -rewrite /subresultant /SylvesterHabicht_mx. +rewrite /subresultant /SylvesterHabicht_mx => -> -> /=. rewrite -mulmx_rsub det_mulmx det_ublock det1 mulr1. by rewrite det_perm odd_perm_rev signr_odd exprD mulrA. Qed. @@ -218,17 +313,19 @@ Remark subresultant0 (R : comRingType) (p q : {poly R}) : (-1) ^+ ('C((size q).-1 + (size p).-1, 2) + 'C((size q).-1, 2)) * resultant p q. Proof. -rewrite /resultant /Sylvester_mx subresultantE /SylvesterHabicht_mx !subn0. +rewrite /resultant /Sylvester_mx subresultantE// /SylvesterHabicht_mx !subn0. move: (col_mx _ _) => x; congr (_ * \det _). by apply/matrixP => i j /=; rewrite !mxE; congr (x _ _); apply: val_inj. Qed. Lemma subresultant_eq0 (R : comRingType) j (p q : {poly R}) : + (j <= (size p).-1)%N -> (j <= (size q).-1)%N -> let np := ((size p).-1 - j)%N in let nq := ((size q).-1 - j)%N in (subresultant j p q == 0) = (\det (rsubmx (SylvesterHabicht_mx nq np (j + (nq + np)) p q)) == 0). Proof. -by rewrite subresultantE -signr_odd mulr_sign; case: ifP; rewrite ?oppr_eq0. +move=> jp jq; rewrite subresultantE// -signr_odd mulr_sign; case: ifP => //. +by rewrite oppr_eq0. Qed. (* Remark 4.23. from BPR *) @@ -259,7 +356,7 @@ Lemma subresultantP (R : idomainType) j (p q : {poly R}) : (subresultant j p q == 0). Proof. have Xj_neq0 : 'X^j != 0 :> {poly R} by rewrite monic_neq0 ?monicXn. -move=> p0 q0 le_jp le_jq; rewrite subresultant_eq0. +move=> p0 q0 le_jp le_jq; rewrite subresultant_eq0//. apply: (iffP det0P) => [[r]|[[u v] /= /andP [su sv] s_upvq]]; last first. move: su sv; rewrite !size_poly_gt0 => /andP [u_neq0 su] /andP [v_neq0 sv]. exists (row_mx (poly_rV u) (poly_rV v)). @@ -299,10 +396,11 @@ Qed. Fact gt_size_gcd (R : idomainType) (p q u v : {poly R}) j : p != 0 -> q != 0 -> u != 0 -> - (j < size (gcdp p q))%N -> (j <= (size q).-1)%N -> (size u <= (size q).-1 - j)%N -> - (size (u * p + v * q)%R <= j)%N -> (j < (size (gcdp p q)).-1)%N. + (j < size (gcdp p q))%N -> + (size u <= (size q).-1 - j)%N -> (size (u * p + v * q)%R <= j)%N -> + (j < (size (gcdp p q)).-1)%N. Proof. -move=> p0 q0 u0 gt_sg_j ge_sq_j ge_sqmj_u. +move=> p0 q0 u0 gt_sg_j ge_sqmj_u. set l := _ * _ + _ * _ => sl; have /eqP : l = 0. apply: contraTeq (leq_ltn_trans sl gt_sg_j) => l_neq0. by rewrite -leqNgt dvdp_leq // dvdp_add ?dvdp_mull ?(dvdp_gcdl, dvdp_gcdr). @@ -312,7 +410,8 @@ have /dvdp_leq : lcmp p q %| u * p. by rewrite dvdp_lcm dvdp_mull //= eq_up_Nvq dvdpNr dvdp_mull. rewrite mulf_neq0 // => /(_ isT); rewrite -ltnS => /leq_trans -> //. rewrite !size_mul // prednK ?ltn_addr ?size_poly_gt0 //. -by rewrite addnC -subn1 -!addnBA ?size_poly_gt0 ?subn1 // leq_add2l. +rewrite addnC -subn1 -!addnBA ?size_poly_gt0 ?subn1 // ?leq_add2l//. +by rewrite -(succnK j); apply/leq_predn/(leq_trans gt_sg_j)/leq_gcdpr. Qed. (* Proposition 4.25. from BPR *) @@ -338,7 +437,7 @@ move=> s_jp s_jq; apply/idP/idP => [sg|/forallP /= rpq]. by rewrite -!subn1 -!subnDA add1n subn1 !leq_sub2l // (leq_trans _ sg). rewrite mulNr !scalerCA -!divpK ?(dvdp_gcdr, dvdp_gcdl) //. by rewrite mulrCA subrr size_poly0. -have {rpq} rpq : forall i, (i < j)%N -> subresultant i p q = 0. +have {}rpq : forall i, (i < j)%N -> subresultant i p q = 0. by move=> i Hi; apply/eqP; rewrite -[i]/(val (Ordinal Hi)); apply: rpq. elim: j => // j ihj in s_jp s_jq rpq *. have [s_jp' s_jq'] := (ltnW s_jp, ltnW s_jq). @@ -379,13 +478,20 @@ Lemma subresultantC (R : idomainType) j (p q : {poly R}) : subresultant j p q = (-1) ^+ ('C((size p).-1 - j + ((size q).-1 - j), 2)) * subresultant j q p. Proof. -rewrite -signr_odd /subresultant; set M := (_ *m _ in RHS). -rewrite mulrCA; congr (_ * _); first by rewrite addnC. -transitivity (\det (rsubmx (perm_rev_mx *m M))); rewrite /M. - rewrite !mul_block_col !mul1mx !mul0mx !add0r !addr0. - rewrite mulmx_perm_rev_col //= mulmxA -perm_mxM perm_rev2 perm_mx1 mul1mx. - by case: _ / addnC => //=. -by rewrite -mulmx_rsub det_mulmx det_perm odd_perm_rev. +rewrite -signr_odd /subresultant andbC; set M := (_ *m _ in RHS). +case /boolP: (_ && _) => [_|jpq]. + rewrite mulrCA; congr (_ * _); first by rewrite addnC. + transitivity (\det (rsubmx (perm_rev_mx *m M))); rewrite /M. + rewrite !mul_block_col !mul1mx !mul0mx !add0r !addr0. + rewrite mulmx_perm_rev_col //= mulmxA -perm_mxM perm_rev2 perm_mx1 mul1mx. + by case: _ / addnC => //=. + by rewrite -mulmx_rsub det_mulmx det_perm odd_perm_rev. +case: eqP jpq => [->|_]. + rewrite leqnn andbT -ltnNge subnn => qp. + by rewrite eq_sym (negPf (ltn_neq qp)) (geq_subn (ltnW qp)) expr0 mul1r. +case: eqP => [->|_]; last by rewrite mulr0. +rewrite leqnn/= -ltnNge subnn => /ltnW pq. +by rewrite (geq_subn pq) expr0 mul1r. Qed. Lemma SylvesterHabicht_mod (R : idomainType) np nq k (p q : {poly R}) : @@ -450,44 +556,29 @@ by case: insubP => [i' _ _|]; rewrite ?(mulr0, mxE). Qed. Lemma subresultant_scaler (R : idomainType) j (p q : {poly R}) (c : R) : - c != 0 -> + c != 0 -> (j <= (size p).-1)%N -> (j <= (size q).-1)%N -> subresultant j (c *: p) q = c ^+ ((size q).-1 - j) * subresultant j p q. Proof. -move=> c_neq0; rewrite !subresultantE size_scale // mulrCA; congr (_ * _). -rewrite SylvesterHabicht_scaler // -mulmx_rsub. +move=> c_neq0 jp jq; rewrite !subresultantE// size_scale // mulrCA. +congr (_ * _); rewrite SylvesterHabicht_scaler // -mulmx_rsub. by rewrite det_mulmx det_ublock det1 det_scalar mulr1. Qed. Lemma subresultant_scalel (R : idomainType) j (p q : {poly R}) (c : R) : - c != 0 -> + c != 0 -> (j <= (size p).-1)%N -> (j <= (size q).-1)%N -> subresultant j p (c *: q) = c ^+ ((size p).-1 - j) * subresultant j p q. Proof. -move=> c_neq0; rewrite subresultantC subresultant_scaler ?size_scale //. +move=> c_neq0 jp jq; rewrite subresultantC subresultant_scaler ?size_scale //. by rewrite mulrA subresultantC addnC -signr_odd mulr_signM addbb mul1r. Qed. -Lemma det_rsub_band (R : idomainType) m n (p : {poly R}) : - (size p).-1 = n -> - \det (rsubmx (band p : 'M_(m, n + m))) = lead_coef p ^+ m. -Proof. -move <-; elim: m => [|m ihm] //; first by rewrite det_mx00 expr0. -rewrite exprS -add1n -[X in \det X]submxK. -rewrite [X in block_mx X _ _ _]mx11_scalar. -rewrite !mxE /= rVpoly_delta /= expr0 mul1r addn0 -lead_coefE. -set ur := ursubmx _; have -> : ur = 0. - apply/matrixP=> i j; rewrite !mxE/= !rVpoly_delta/= !add1n ord1 expr0 mul1r. - by rewrite nth_default // addnS -addn1 addnC -leq_subLR subn1 leq_addr. -rewrite det_lblock det_scalar expr1 -ihm; congr (_ * \det _). -apply/matrixP => i j; rewrite !mxE /= !rVpoly_delta /= !add1n addnS. -by rewrite !coefXnM ltnS subSS. -Qed. - -(* Something like Proposition 4.37 from BPR *) +(* Something like Proposition 4.36 from BPR *) (* Should we parametrize by a remainder of p rather than correcting p? *) Lemma subresultant_mod (R : idomainType) j (p q : {poly R}) (c := (-1) ^+ 'C((size p).-1 - (size q).-1, 2) * lead_coef q ^+ ((size p).-1 - (size (p %% q)).-1)) : - p != 0 -> q != 0 -> ((size q).-1 <= (size p).-1)%N -> (j <= (size (p %% q)%R).-1)%N -> + p != 0 -> q != 0 -> ((size q).-1 <= (size p).-1)%N -> + (j <= (size (p %% q)%R).-1)%N -> subresultant j (lead_coef q ^+ (scalp p q) *: p) q = c * subresultant j q (- (p %% q)). Proof. @@ -496,7 +587,8 @@ move=> p_neq0 q_neq0 le_pq le_jr; have le_jq : (j <= (size q).-1)%N. rewrite -[- _ as X in subresultant _ _ X]scaleN1r. rewrite subresultant_scalel ?oppr_eq0 ?oner_eq0 //. rewrite [in RHS]subresultantC ?size_opp //. -rewrite !subresultantE !size_scale ?lc_expn_scalp_neq0 //. +rewrite !subresultantE// !size_scale ?lc_expn_scalp_neq0 //; last first. + exact/(leq_trans le_jq). rewrite ![in X in c * X]mulrA [c * _]mulrA -!exprD. set np := ((size p).-1 - j)%N; set nq := ((size q).-1 - j)%N. set nr := ((size (p %% q)%R).-1 - j)%N. @@ -536,5 +628,218 @@ have -> : ((size p).-1 - (size q).-1 = np - nq)%N. by rewrite addbC odd_bin2B ?leq_sub // addKb addnC. Qed. -(* Lemma 4.35 from BPR is cindexR_rec from qe_rcf_th, except it uses rmodp *) +Lemma subresultant_gt_mod (R : idomainType) j (p q : {poly R}) : + p != 0 -> q != 0 -> ((size q).-1 <= (size p).-1)%N -> + (size (p %% q)%R <= j < (size q)%R.-1)%N -> + subresultant j p q = 0. +Proof. +move=> p_neq0 q_neq0 le_pq /andP[le_rj] le_jq. +apply/eqP/subresultantP => //. +- by apply/(leq_trans _ le_pq)/ltnW. +- exact/ltnW. +exists ((lead_coef q ^+ scalp p q)%:P, - (p %/ q)) => /=; last first. + by rewrite mul_polyC divp_eq addrAC mulNr subrr add0r. +rewrite size_polyC expf_neq0 ?lead_coef_eq0//= subn_gt0 le_jq/= size_opp. +rewrite size_poly_gt0 divpN0// -(leq_sub2rE (p:=1)) ?size_poly_gt0//. +by rewrite !subn1 le_pq/= size_divp// -predn_sub -subnS leq_sub2l. +Qed. + +Lemma subresultantp0 (R : idomainType) j (p : {poly R}) : + (j < (size p).-1)%N -> subresultant j p 0 = 0. +Proof. +case: (posnP j) => [->|]. + rewrite ltnNge -subn_eq0 => /negPf sp; apply/eqP. + rewrite subresultant_eq0// size_poly0/= sub0n /SylvesterHabicht_mx band0. + case: ((size p).-1 - 0)%N sp => //= n _. + apply/det0P; exists (row_mx 0 (\row_i (i == ord_max)%:R)). + apply/eqP => /rowP /(_ (unsplit (inr ord_max))). + rewrite mxE unsplitK !mxE eqxx => /eqP; apply/negP/oner_neq0. + apply/rowP => i; rewrite !mxE big1_idem//= ?addr0// => k _. + by rewrite !mxE; case: (split k) => a; rewrite !mxE (mul0r, mulr0). +move=> j0 jp. +rewrite /subresultant size_poly0/= (leqNgt j 0) j0 andbF (negPf (ltn_neq jp)). +by rewrite eq_sym (negPf (ltn_neq j0)). +Qed. + +Lemma subresultant0p (R : idomainType) j (q : {poly R}) : + (j < (size q).-1)%N -> subresultant j 0 q = 0. +Proof. +move=> jq; apply/eqP; rewrite subresultantC mulf_eq0; apply/orP; right. +exact/eqP/subresultantp0. +Qed. +Lemma subresultant_map_poly (A B : ringType) i + (p q : {poly A}) (f : {rmorphism A -> B}) : + f (lead_coef p) != 0 -> f (lead_coef q) != 0 -> + subresultant i (map_poly f p) (map_poly f q) = f (subresultant i p q). +Proof. +move=> fp0 fq0; rewrite /subresultant !size_map_poly_id0//. +case: ifP => [_|ipq]. + rewrite rmorphM rmorphXn rmorphN1 -det_map_mx. + rewrite map_rsubmx map_mxM map_block_mx map_perm_mx !map_mx0 map_mx1. + rewrite /SylvesterHabicht_mx map_col_mx. + congr (_ * \det (rsubmx (_ *m _)))%R; apply/esym. + by congr col_mx; apply/map_lin1_mx => x /=; + rewrite mxpoly.map_poly_rV rmorphM/= mxpoly.map_rVpoly. +case: eqP => _; first exact/lead_coef_map_eq. +case: eqP => _; first exact/lead_coef_map_eq. +exact/esym/raddf0. +Qed. + +Lemma subresultant_last (A : idomainType) (p q : {poly A}) : + subresultant (size p).-1 p q + = lead_coef p ^+ ((size q).-1 - (size p).-1 + ((size q).-1 < (size p).-1))%N. +Proof. +case: (ltnP (size q).-1 (size p).-1) => [qp|pq]. + rewrite /subresultant [X in _ && X]leqNgt qp andbF eqxx. + by rewrite (geq_subn (ltnW qp)) expr1. +rewrite subresultantE// subnn det_trig; last first. + apply/forallP => /= i; apply/forallP => /= k; apply/implyP => ik; apply/eqP. + rewrite mxE SylvesterHabicht_mxE. + case: (fintype.split i) (splitK i) ik => [i' <- /= ik|[]//]/=. + rewrite nth_default ?mul0rn// -addnBA; last exact/ltnW. + case: {1 2}(size p) => [//|n] /=. + by rewrite -[X in (X < _)%N]addn0 ltn_add2l subn_gt0. +rewrite {1}addn0 addnn -signr_odd odd_double expr0 mul1r. +under eq_bigr => i _. + suff ->: rsubmx + (SylvesterHabicht_mx ((size q).-1 - (size p).-1) 0 + ((size p).-1 + ((size q).-1 - (size p).-1 + 0)) p q) i i + = lead_coef p. + over. + rewrite mxE SylvesterHabicht_mxE. + case: (fintype.split i) (splitK i) => [i' <- /=|[]//]/=. + by rewrite leq_addl mulr1n -addnBA// subnn addn0 lead_coefE. +by rewrite prodr_const cardT size_enum_ord addn0. +Qed. + +Import Num.Theory Order.POrderTheory Pdiv.Field. + +(* Lemma 4.34 from BPR is cindexR_rec from qe_rcf_th, except it uses rmodp *) + +Theorem pmv_subresultant (R : rcfType) (p q : {poly R}) : + (size q < size p)%N -> + pmv [seq subresultant i p q | i <- rev (iota 0 (size p))] = cindexR q p. +Proof. +move sq: (size q) => n; move: p q sq. +apply/(@Wf_nat.lt_wf_ind n + (fun n => forall p q : {poly R}, size q = n -> (n < size p)%N -> _)). +move=> {}n IHn p q sq sp. +case/boolP: (q == 0) sq sp => [/eqP ->|q0 sq sp]. + rewrite size_poly0 => <- {n IHn} /= p0. + rewrite -(prednK p0) iotanS rev_rcons/= cindexR0p. + apply/pmv_cat00 => _ /mapP[i] + ->. + rewrite mem_rev mem_iota/= => ip. + exact/eqP/subresultantp0. +have p0: p != 0 by apply/eqP => p0; move: sp; rewrite p0 size_poly0. +have n0: (0 < n)%N by rewrite -sq size_poly_gt0. +rewrite -(subnKC (ltnW sp)) iotaD rev_cat map_cat. +move mE: (size p - n)%N => m. +case: m mE => [/eqP|m mE]; first by rewrite subn_eq0 leqNgt sp. +rewrite iotanS rev_rcons/= -(succnK (n + m)%N) -addnS -mE subnKC ?(ltnW sp)//. +rewrite {1}/subresultant sq [X in _ && X]leqNgt ltn_predRL prednK//. +rewrite sp andbF eqxx. +under eq_map_seq => i. +rewrite mem_rev mem_iota => /andP[] ni. + rewrite -(succnK (n + m)%N) -addnS -mE subnKC ?(ltnW sp)// => ip. + rewrite /subresultant sq [X in _ && X]leq_npred; last exact/(leq_trans n0). + rewrite ltnNge ni andbF (negPf (ltn_neq ip)) eq_sym. + move: ni; rewrite -{1}(prednK n0) => /ltn_neq/negPf ->. + over. +move srE : (size (p %% q)) => sr. +have srn : (sr < n)%N by rewrite -srE -sq; apply/ltn_modpN0. +rewrite -{2}(subnKC (ltnW srn)) iotaD rev_cat. +move kE: (n - sr)%N => k. +case: k kE => [/eqP|k kE]; first by rewrite subn_eq0 leqNgt srn. +rewrite iotanS rev_rcons/= map_cat. +have ->: (sr + k = (size q).-1)%N. + apply/succn_inj; rewrite -addnS -kE subnKC ?(ltnW srn)// sq prednK//. +rewrite subresultantC subresultant_last subnn addn0 sq subn_prednn//. +under [X in _ :: X ++ _]eq_map_seq => i. + rewrite mem_rev mem_iota => /andP[] sri. + rewrite -ltnS -addnS -kE subnKC ?(ltnW srn)// => ilt. + rewrite subresultant_gt_mod//; first by over. + by apply/leq_predn/ltnW; rewrite sq. + by rewrite srE sri sq ltn_predRL. +(* Whaaaat??? Why do I need to alias `p` for `over` to work? *) +set a := p. +under [X in _ :: _ ++ X]eq_map_seq => i. + rewrite mem_rev mem_iota/= => isr. + have ->: a = (lead_coef q ^+ scalp p q) *: a. + by rewrite scalpE expr0 scale1r. + rewrite subresultant_mod//; first by over. + by apply/leq_predn/ltnW; rewrite sq. + rewrite -ltnS srE; apply/(leq_trans isr)/leqSpred. +rewrite {}/a [LHS]pmv_cat0s; first last. +- by move=> x /mapP[] i _ /eqP. +- by rewrite mulf_eq0 signr_eq0 expf_eq0 lead_coef_eq0 (negPf q0) andbF. +rewrite size_map size_rev size_iota addrC cindexR_rec; congr (_ + _). + rewrite crossRE lead_coefM size_mul// sq. + have odd2: forall i, (1 < i)%N -> (odd i.-2 = odd i). + by case=> [//|]; case=> [//|i _] /=; rewrite negbK. + rewrite odd2; last first. + by apply/(@leq_add 1) => //; apply/(leq_ltn_trans _ sp). + rewrite oddD -oddB ?(ltnW sp)// mE/=. + case/boolP: (odd m) => modd; first by rewrite !mulr0n. + rewrite !mulr1n !sgzM !sgzX sgzN1 mulrCA; congr (_ * _). + rewrite sgz_odd ?lead_coef_eq0//= ltn_predRL prednK; last first. + exact/(ltn_trans n0). + rewrite ltnNge (ltnW sp) [(m + _)%Nrec]addn0 modd expr1 mulrA -exprD !bin2. + rewrite succnK. + case: m {mE} => [|m] in modd *; first by rewrite expr0 mul1r. + rewrite succnK mulnC !mulSn addnA addnn halfD odd_double doubleK add0n. + rewrite addnCA addnn halfK oddM andbN subn0 -signr_odd oddD oddM. + by rewrite (negPf modd) andbF/= expr0 mul1r. +have ->: cindexR (next_mod p q) q = cindexR (- (p %% q)) q. + by rewrite /next_mod modpE -scaleNr !cindexR_mulCp !sgzN sgz_invr. +rewrite -(IHn sr); first last. +- by rewrite sq. +- by rewrite size_opp. +- exact/ltP. +case: sr => [/=|sr] in srE srn kE *. + rewrite !cats0 [LHS]pmv_cat00; last by move=> x /mapP[] i _ /eqP. + rewrite subn0 in kE. + rewrite sq kE iotanS rev_rcons/= [RHS]pmv_cat00// => _ /mapP[] i + ->. + rewrite mem_rev mem_iota/= => ik. + move/eqP: srE; rewrite -leqn0 => /size_poly_leq0P ->. + rewrite oppr0; apply/eqP/subresultantp0. + by rewrite sq kE succnK. +rewrite sq -[in RHS](subnKC (ltnW srn)) iotaD rev_cat map_cat kE !iotanS. +rewrite !rev_rcons/= -(succnK (sr.+1 + k)%N) -addnS -kE (subnKC (ltnW srn)). +rewrite -[sr]succnK -srE -[size (p %% q)]size_opp. +rewrite subresultantC subresultant_last size_opp srE succnK subnn addn0 sq. +rewrite subn_prednn; last by rewrite -sq size_poly_gt0. +rewrite mE -[(n.-1 - _)%N]predn_sub -subnS kE -{1}[in RHS]sq. +rewrite subresultant_last [RHS]pmv_cat0s; first last. +- move=> _ /mapP[] i + ->. + rewrite mem_rev mem_iota => /andP[] sri. + rewrite -(succnK (sr.+1 + k)%N) -addnS -kE (subnKC (ltnW srn)) => iq. + rewrite /subresultant size_opp srE succnK [X in _ && X]leqNgt sri andbF sq. + by rewrite (negPf (ltn_neq iq)) [i == _]eq_sym (negPf (ltn_neq sri)). +- rewrite mulf_eq0 signr_eq0/= expf_eq0 lead_coef_eq0 oppr_eq0 -size_poly_eq0. + by rewrite srE andbF. +rewrite [LHS]pmv_cat0s; first last. +- by move=> x /mapP[] i _ /eqP. +- rewrite !mulf_eq0 !expf_eq0 !lead_coef_eq0 (negPf q0) !oppr_eq0 oner_eq0. + by rewrite !andbF/= -size_poly_gt0 srE. +congr (_ + _). + rewrite map_comp; apply/esym/(esym (pmvZ _ _)). + by rewrite mulf_eq0 signr_eq0 expf_eq0 lead_coef_eq0 (negPf q0) andbF. +rewrite !size_map !size_rev !size_iota. +case/boolP: (odd k) => kodd; first by rewrite !mulr0n. +rewrite !mulr1n; congr (_ * _). +rewrite !sgzM !mulrA; congr (_ * _ * _). +rewrite !sgzX !sgzN1. +rewrite ltn_predRL prednK; last exact/(ltn_trans n0). +rewrite ltnNge (ltnW sp) addn0 sq size_opp srE succnK ltn_predRL srn. +rewrite [(sr - _)%N]geq_subn; last first. + by rewrite -(succnK sr); apply/leq_predn/ltnW. +rewrite expr1. +rewrite mulrAC -[X in X * _]mulrA -exprD mulrAC -exprD addnn -signr_odd. +rewrite odd_double expr0 mul1r sgz_odd ?lead_coef_eq0// -mE. +rewrite -(@subnKC n.-1 (size p).-1); last by apply/leq_predn/ltnW. +rewrite subDnCA; last first. + by apply/ltnW; rewrite ltnNge -subn_eq0 -predn_sub -subnS kE. +rewrite subn_prednn; last by rewrite -sq size_poly_gt0. +by rewrite addnA addnn oddD odd_double/= -predn_sub -subnS kE/= kodd expr1. +Qed. diff --git a/topology.v b/topology.v new file mode 100644 index 0000000..8dba7d8 --- /dev/null +++ b/topology.v @@ -0,0 +1,961 @@ +From mathcomp Require Import ssreflect ssrfun ssrbool eqtype choice seq ssrnat bigop fintype finfun order ssralg ssrnum poly polydiv complex polyorder. +From mathcomp Require Import matrix topology normedtype classical_sets interval. +Require Import auxresults semialgebraic. + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Import numFieldTopology.Exports Order.TotalTheory Order.POrderTheory GRing Order Num.Theory. + +Local Open Scope type_scope. +Local Open Scope ring_scope. +Local Open Scope sa_scope. +Local Open Scope classical_set_scope. +Local Open Scope order_scope. + +Ltac mp := + match goal with + | |- (?x -> _) -> _ => have /[swap]/[apply]: x + end. + +Section SAconnected. +Variable (R : rcfType) (n : nat). + +Lemma set_of_SAsetC (A : {SAset R^n}) : + [set` ~: A] = ~` [set` A]. +Proof. +rewrite classical_sets.eqEsubset; split; apply/subsetP => /= x; rewrite in_setC/= !inE/= inSAsetC => /negP xAN; apply/negP => xA; apply/xAN. + by rewrite inE in xA. +by rewrite inE. +Qed. + +Definition SAconnected (s : {SAset R ^ n}) := + forall (u v : {SAset R^n}), + @open (subspace [set` s]) [set` u] -> + @open (subspace [set` s]) [set` v] -> + s :&: u != SAset0 R n -> + s :&: v != SAset0 R n -> + s :<=: (u :|: v) -> + s :&: u :&: v != SAset0 R n. + +Lemma SAconnected_clopen s : + SAconnected s <-> + forall (u v : {SAset R^n}), + @open (subspace [set` s]) [set` u] -> + @closed (subspace [set` s]) [set` v] -> + s :&: u = s :&: v -> + (s :<=: u) || (s :&: u == SAset0 R n). +Proof. +split=> scon u v uo. + move=> vc uvs; apply/negP => /negP; rewrite negb_or => /andP[su]su0. + move/(_ u (~: v) uo): scon. + rewrite set_of_SAsetC openC => /(_ vc su0). + move: su; rewrite SAsubsetED -SAsetDIr uvs SAsetDIr => /[swap]/[apply]. + rewrite SAsubsetEI SAsetIUr uvs -SAsetIUr SAsetUCr SAsetIT => /(_ (eqxx _)). + by rewrite -SAsetIA SAsetICr SAsetI0 eqxx. +move=> vo us vs suv; apply/eqP => uv0. +move/(_ u (~: v) uo): scon. +rewrite set_of_SAsetC closedC => /(_ vo). +mp. + apply/eqP; rewrite eqEsubset; apply/andP; split; apply/SAset_subP => x; rewrite !inSAsetI => /andP[] /[dup] xs -> /=; rewrite inSAsetC => xu. + apply/negP => xv. + suff: x \in s :&: u :&: v by rewrite uv0 inSAset0. + by rewrite !inSAsetI xs xu. + by move/SAset_subP: suv => /(_ _ xs); rewrite inSAsetU (negPf xu) orbF. +rewrite (negPf us) orbF => /SAset_subP su. +move: vs; have [->|[x]] := (set0Vmem (s :&: v)); first by rewrite eqxx. +rewrite inSAsetI => /andP[] xs xv. +have: x \in s :&: u :&: v by rewrite !inSAsetI xs (su _ xs). +by rewrite uv0 inSAset0. +Qed. + +Lemma SAconnected_closed s : + SAconnected s <-> + forall (u v : {SAset R^n}), + @closed (subspace [set` s]) [set` u] -> + @closed (subspace [set` s]) [set` v] -> + s :&: u != SAset0 R n -> + s :&: v != SAset0 R n -> + s :<=: (u :|: v) -> + s :&: u :&: v != SAset0 R n. +Proof. +by split=> scon u v ut vt su0 sv0 suv; apply/eqP => suv0; +move: (scon (~: u) (~: v)); +rewrite !set_of_SAsetC ?openC ?closedC => /(_ ut vt); +(mp; [rewrite -SAsubsetED; apply/negP => /SAset_subP su; + move/negP: sv0; apply; rewrite -subset0; apply/SAset_subP => x; + rewrite -suv0 !inSAsetI => /andP[xs xv]; + rewrite xs (su _ xs)//|]); +(mp; [rewrite -SAsubsetED; apply/negP => /SAset_subP sv; + move/negP: su0; apply; rewrite -subset0; apply/SAset_subP => x; + rewrite -suv0 !inSAsetI => /andP[xs xu]; + rewrite xs xu (sv _ xs)//|]); +rewrite SAsubsetED /SAsetD SAsetCU !SAsetCK SAsetIA suv0 eqxx => /(_ isT); +rewrite -SAsetIA -SAsetCU -SAsubsetED suv. +Qed. + +Definition locally_constant_on (T : topologicalType) (U : Type) (f : T -> U) + (S : set T) (v : U) := + {in S, forall x, f x = v -> exists O, + @open (subspace S) O /\ + x \in O /\ + {in (S `&` O)%classic, forall y, f y = v}}. + +Definition locally_constant (T : topologicalType) (U : Type) (f : T -> U) (S : set T) := + {in S, forall x, exists O, + @open (subspace S) O /\ + x \in O /\ + {in (S `&` O)%classic, forall y, f x = f y}}. + +Lemma open_subspace_ballP (F : numDomainType) (T : pseudoMetricType F) (S : set T) (A : set T) : + @open (subspace S) A <-> + forall x, (x \in A `&` S)%classic -> + exists eps, 0 < eps /\ (ball x eps `&` S `<=` A)%classic. +Proof. +rewrite openE/=; split=> [/subsetP Aopen x|Aopen]. + rewrite in_setI => /andP[] /[dup] xA /Aopen + xS. + rewrite /interior inE => /nbhs_ballP [] e /= e0. + rewrite -[ball _ _]/(subspace_ball _ _) /subspace_ball xS setIC. + by exists e. +apply/subsetP => x xA. +rewrite /interior inE; apply/nbhs_ballP. +have [xS|xnS] := boolP (x \in S); last first. + exists 1 => //=. + apply/subsetP => y. + rewrite -[ball _ _]/(subspace_ball _ _) /subspace_ball. + by rewrite (negPf xnS) inE => /= ->. +move: (Aopen x); rewrite in_setI xA => /(_ xS) []e []e0 xSA. +exists e => //=. +by rewrite -[ball _ _]/(subspace_ball _ _) /subspace_ball xS setIC. +Qed. + +Lemma SAconnected_locally_constant_on_constant m (f : {SAfun R^n -> R^m}) + (S : {SAset R^n}) (x : 'rV_n) : + x \in S -> + SAconnected S -> + locally_constant_on f [set` S] (f x) -> + {within [set` S], continuous f} -> + {in S, forall y, f y = f x}. +Proof. +case: m f => [|m] f. + move=> _ _ _ _ u _. + by apply/rowP; case. +move=> xS S_con f_const /continuousP/= fcon y yS. +apply/eqP/negP => /negP yx. +move: (S_con (SApreimset f (SAset_seq [:: f x])) (SApreimset f (~: (SAset_seq [:: f x])))). +have /[swap]/[apply]: @open (subspace [set` S]) [set` SApreimset f [set f x]]. + apply/open_subspace_ballP => /= z. + rewrite in_setI mem_setE inSApreimset inSAset_seq mem_seq1 => /andP[] /eqP zy zS. + case: (f_const z) => //= O [] + []. + rewrite openE/= => /subsetP /[apply]. + rewrite /interior inE => /nbhs_ballP [] e /= e0 /subsetP zeO fz. + exists e; split=> //. + apply/subsetP => u; rewrite in_setI => /andP[] uz uS. + rewrite mem_setE inSApreimset inSAset_seq mem_seq1; apply/eqP/fz. + rewrite in_setI uS; apply/zeO. + rewrite -[ball _ _]/(subspace_ball _ _) /subspace_ball zS. + by rewrite in_setI uS. +have /[swap]/[apply]: @open (subspace [set` S]) [set` SApreimset f (~: [set f x])]. + have ->: [set` SApreimset f (~: [set f x])] = f @^-1` ~` (set1 (f x)). + by apply/seteqP; split; apply/subsetP => z; rewrite !inE/= inSApreimset inSAsetC inSAset1 => /eqP. + apply/fcon; rewrite -open_subspace_setT. + apply/open_subspace_ballP => /= z. + rewrite setIT in_setC => zx. + exists `|z - f x|; split. + rewrite normr_gt0 subr_eq0; apply/eqP => xz. + move: zx; rewrite unfold_in/==> /negP; apply. + by rewrite inE/=. + rewrite setIT; apply/subsetP => t. + rewrite -ball_normE inE/= in_setC => tx. + apply/negP; rewrite inE => /= tE. + by rewrite tE ltxx in tx. +have /[swap]/[apply]: S :&: SApreimset f [set f x] != SAset0 R n. + rewrite -subset0; apply/negP => /SAset_subP/(_ x). + by rewrite inSAset0 inSAsetI xS inSApreimset inSAset_seq => /(_ (mem_head _ _)). +have /[swap]/[apply]: S :&: SApreimset f (~: [ set f x]) != SAset0 R n. + rewrite -subset0; apply/negP => /SAset_subP/(_ y). + rewrite inSAset0 inSAsetI yS inSApreimset inSAsetC inSAset_seq mem_seq1. + by move=> /(_ yx). +rewrite -SApreimsetU SAsetUCr SApreimsetT => /(_ (subsetT _)). +by rewrite -SAsetIA -SApreimsetI SAsetICr SApreimset0 SAsetI0 eqxx. +Qed. + +Lemma SAconnected_locally_constant_constant m (f : {SAfun R^n -> R^m}) (S : {SAset R^n}): + SAconnected S -> + locally_constant f [set` S] -> + {in S &, forall x y, f x = f y}. +Proof. +case: m f => [|m] f. + move=> _ _ u v _ _. + by apply/rowP; case. +move=> S_con f_const x y xS yS. +apply/eqP/negP => /negP xy. +move: (S_con (SApreimset f (SAset_seq [:: f x])) (SApreimset f (~: (SAset_seq [:: f x])))). +have /[swap]/[apply]: @open (subspace [set` S]) [set` SApreimset f [ set f x]]. + apply/open_subspace_ballP => /= z. + rewrite in_setI mem_setE inSApreimset inSAset_seq mem_seq1 => /andP[] /eqP zx zS. + case: (f_const z) => //= O [] + []. + rewrite openE/= => /subsetP /[apply]. + rewrite /interior inE => /nbhs_ballP [] e /= e0 /subsetP zeO fz. + exists e; split=> //. + apply/subsetP => u; rewrite in_setI => /andP[] uz uS. + rewrite mem_setE inSApreimset inSAset_seq mem_seq1 -zx; apply/eqP/esym/fz. + rewrite in_setI uS; apply/zeO. + rewrite -[ball _ _]/(subspace_ball _ _) /subspace_ball zS. + by rewrite in_setI uS. +have /[swap]/[apply]: @open (subspace [set` S]) [set` SApreimset f (~: [ set f x])]. + apply/open_subspace_ballP => /= z. + rewrite in_setI mem_setE inSApreimset inSAsetC inSAset_seq mem_seq1 => /andP[] zx zS. + case: (f_const z) => //= O [] + []. + rewrite openE/= => /subsetP /[apply]. + rewrite /interior inE => /nbhs_ballP [] e /= e0 /subsetP zeO => fz. + exists e; split=> //. + apply/subsetP => u; rewrite in_setI => /andP[] uz uS. + rewrite mem_setE inSApreimset inSAsetC inSAset_seq mem_seq1 -(fz u)//. + rewrite in_setI uS; apply/zeO. + rewrite -[ball _ _]/(subspace_ball _ _) /subspace_ball zS. + by rewrite in_setI uS. +have /[swap]/[apply]: S :&: SApreimset f [ set f x] != SAset0 R n. + rewrite -subset0; apply/negP => /SAset_subP/(_ x). + by rewrite inSAset0 inSAsetI xS inSApreimset inSAset_seq => /(_ (mem_head _ _)). +have /[swap]/[apply]: S :&: SApreimset f (~: [ set f x]) != SAset0 R n. + rewrite -subset0; apply/negP => /SAset_subP/(_ y). + rewrite inSAset0 inSAsetI yS inSApreimset inSAsetC inSAset_seq mem_seq1. + by rewrite eq_sym => /(_ xy). +rewrite -SApreimsetU SAsetUCr SApreimsetT => /(_ (subsetT _)). +by rewrite -SAsetIA -SApreimsetI SAsetICr SApreimset0 SAsetI0 eqxx. +Qed. + +Lemma subseq_sorted_continuous_SAfun (f g : seq (SAfunltType R n)) (s : {SAset R^n}) : + {in s, forall x, uniq [seq (f : {SAfun R^n -> R^1}) x | f <- f]} + -> {in s, forall x, uniq [seq (f : {SAfun R^n -> R^1}) x | f <- g]} + -> (forall i : 'I_(size f), {within [set` s], continuous f`_i}) + -> (forall i : 'I_(size g), {within [set` s], continuous g`_i}) + -> SAconnected s + -> {in s, forall x, subseq [seq (f : {SAfun R^n -> R^1}) x | f <- f] [seq (f : {SAfun R^n -> R^1}) x | f <- g]} + -> (exists t : seq nat, + subseq t (iota 0 (size g)) /\ + {in s, forall x, [seq (f : {SAfun R^n -> R^1}) x | f <- f] = [seq g`_i x | i <- t]}) +. +Proof. +move=> funiq guniq fcont gcont scon fg. +case: (set0Vmem s) => [->|[] x xs]. + exists nil; split; first exact/sub0seq. + by move=> y; rewrite inSAset0. +move: (fg x xs) => /(subseq_nth_iota 0)[] /= r. +rewrite size_map => -[] rg fE. +move: (fE) => /(congr1 size); rewrite !size_map => fr. +exists r; split=> // y ys. +apply/(@eq_from_nth _ 0); rewrite !size_map// => i ilt. +rewrite (nth_map 0)// (nth_map 0); last by rewrite -fr. +have rig: (r`_i < size g)%N. + move/mem_subseq: rg => /(_ r`_i); mp. + by apply/mem_nth; rewrite -fr. + by rewrite mem_iota. +have fgx: SAfun_sub f`_i g`_(r`_i) x = 0. + move: fE => /(congr1 (fun f => f`_i)). + rewrite (nth_map 0)// (nth_map 0); last by rewrite -fr. + rewrite SAfun_subE (nth_map 0)// => ->. + exact/subrr. +suff: (SAfun_sub f`_i g`_(r`_i) y = SAfun_sub f`_i g`_(r`_i) x). + by move=> /eqP; rewrite fgx SAfun_subE subr_eq0 => /eqP. +apply/(SAconnected_locally_constant_on_constant xs scon) => // {ys}y; last first. + apply/(@eq_continuous (subspace [set` s]) _ (fun y => f`_i y - g`_(r`_i) y)). + by move=> z; rewrite SAfun_subE. + move=> z. + apply/continuousB. + exact/(fcont (Ordinal ilt)). + exact/(gcont (Ordinal rig)). +rewrite inE/= fgx SAfun_subE => ys /eqP. +rewrite subr_eq0 => /eqP fgy. +set e := (min (\big[min/1%R]_(i < size f) \big[min/1%R]_(j < size f | i != j) `|f`_j y - f`_i y|) + (\big[min/1%R]_(i < size g) \big[min/1%R]_(j < size g | i != j) `|g`_j y - g`_i y|)) / 2. +have e0: 0 < e. + apply/divr_gt0 => //. + rewrite lt_min; apply/andP; split; apply/lt_bigmin => //= j _; apply/lt_bigmin => // k jk; rewrite normr_gt0 subr_eq0; apply/eqP => jE; + move: (ltn_ord j) (ltn_ord k); rewrite -{2 4}(size_map (fun f : {SAfun R^n -> R^1} => f y)) => jlt klt. + move: (funiq y ys) => /(nth_uniq 0 jlt klt). + rewrite size_map in jlt klt. + by rewrite [RHS](inj_eq (@ord_inj _)) (negPf jk) (nth_map 0)// (nth_map 0)// jE eqxx. + move: (guniq y ys) => /(nth_uniq 0 jlt klt). + rewrite size_map in jlt klt. + by rewrite [RHS](inj_eq (@ord_inj _)) (negPf jk) (nth_map 0)// (nth_map 0)// jE eqxx. +exists ((\big[setI/setT]_(i < size f) f`_i @^-1` (ball (f`_i y) e)) `&` + \big[setI/setT]_(i < size g) g`_i @^-1` (ball (g`_i y) e)). +split. + apply/openI; apply/open_bigcap => /= j _. + by move: (fcont j) => /continuousP; apply; apply/ball_open. + by move: (gcont j) => /continuousP; apply; apply/ball_open. +split. + by rewrite in_setI -!bigcap_seq !unfold_in/=; apply/andP; split; rewrite inE/= => z _ /=; apply/ballxx. +move=> z; rewrite !in_setI -!bigcap_seq mem_setE/= => /andP[zs]. +rewrite !unfold_in => /andP[]; rewrite !inE/= => zf zg. +apply/eqP; rewrite SAfun_subE subr_eq0; apply/eqP. +move: (fg z zs) => /mem_subseq/(_ (f`_i z)); mp. + by apply/map_f/mem_nth. +move=> /mapP[/=] _ /(nthP 0)[] j jg <- fzE. +rewrite fzE; congr (nth _ g _ z). +apply/eqP/negP => /negP ji. +move: (zf (Ordinal ilt) (mem_index_enum _)) => /=. +move: (zg (Ordinal jg) (mem_index_enum _)) => /=. +rewrite -ball_normE/= fzE fgy => gyz ryz. +have: (`|g`_(r`_i) y - g`_j y| < e * 2)%R. + rewrite -(subrBB (g`_j z)) mulr_natr mulr2n. + exact/(le_lt_trans (ler_normB _ _))/ltrD. +rewrite /e mulrAC -mulrA divff ?pnatr_eq0// mulr1 lt_min => /andP[_]. +move=> /bigmin_gtP[_] /(_ (Ordinal jg) isT) /bigmin_gtP[_] /(_ (Ordinal rig)). +by rewrite -(inj_eq val_inj)/= ltxx => /(_ ji). +Qed. + +End SAconnected. + +Lemma SAset_itv_connected (R : rcfType) (I : interval R) : + SAconnected (SAset_itv I). +Proof. +move=> u v uopen vopen. +case: (set0Vmem (SAset_itv I :&: u)) => [->|[] x]; first by rewrite eqxx => + _. +rewrite inSAsetI => /andP[] xI xu _. +case: (set0Vmem (SAset_itv I :&: v)) => [->|[] y]; first by rewrite eqxx. +rewrite inSAsetI => /andP[] yI yv _. +wlog: x y u v xI xu yI yv uopen vopen / x ord0 ord0 <= y ord0 ord0 => xy. + move: (le_total (x ord0 ord0) (y ord0 ord0)) => /orP[|yx]; first exact/xy. + rewrite SAsetUC -SAsetIA [u :&: v]SAsetIC SAsetIA. + by move: yx; apply/xy. +have uy: y \in SAsetUB (SAset_itv `[(x ord0 ord0), (y ord0 ord0)]%R :&: u). + apply/inSAsetUB => z; rewrite inSAsetI inSAset_itv in_itv/=. + by move=> /andP[]/andP[_]. +move: (@SAset_supP _ (SAset_itv `[x ord0 ord0, y ord0 ord0] :&: u)). +mp. + apply/negP => /SAsetP/(_ x). + by rewrite inSAsetI inSAset_itv in_itv/= lexx xy xu inSAset0. +mp=> [|[] z ubu]. + by apply/negP => /SAsetP/(_ y); rewrite uy inSAset0. +move: uy; rewrite ubu inSAset_itv in_itv/= andbT => zy. +have: \row__ z \in SAset_itv `[z, +oo[%R. + by rewrite inSAset_itv in_itv/= mxE lexx. +rewrite -ubu => /inSAsetUB; rewrite mxE => zub. +move: (zub x); rewrite inSAsetI inSAset_itv in_itv/= lexx xy xu => /(_ isT) xz. +move=> /SAset_subP Iuv. +have /SAset_subP xyI: SAset_itv `[x ord0 ord0, y ord0 ord0] :<=: SAset_itv I. + apply/SAset_subP => a. + case: I xI yI {Iuv uopen vopen} => l r. + rewrite !inSAset_itv !itv_boundlr => /andP[] lx _ /andP[] _ yr /andP[] xa ay. + apply/andP; split; first exact/(le_trans lx). + exact/(le_trans ay). +have zI: \row__ z \in SAset_itv I. + by apply/xyI; rewrite inSAset_itv in_itv/= mxE xz. +move: (Iuv _ zI); rewrite inSAsetU => /orP[zu|zv]. + move: zy; rewrite le_eqVlt => /orP[/eqP|] zy. + apply/negP => /SAsetP/(_ y). + rewrite 2!inSAsetI inSAset0 yv andbT => /negP; apply. + apply/andP; split. + by apply/xyI; rewrite inSAset_itv in_itv/= xy lexx. + move: zu; congr (_ \in u); apply/eqP; rewrite rowPE forall_ord1 mxE. + exact/eqP. + move: uopen => /open_subspace_ballP/(_ (\row__ z)); mp. + rewrite in_setI mem_setE/= zu mem_setE inSAset_itv mxE/=. + by move: zI; rewrite inSAset_itv mxE. + move=> [] /= e [] e0 /subsetP eu. + move: (zub (\row__ (Order.min (z + e / 2) (y ord0 ord0))))%R; mp; last first. + rewrite mxE leNgt lt_min zy andbT -[X in (X < _)%R]addr0 => /negP; elim. + apply/ler_ltD; first exact/lexx. + exact/divr_gt0. + rewrite inSAsetI inSAset_itv in_itv/= mxE. + rewrite le_min xy -[x _ _]addr0 ge_min lexx orbT !andbT; apply/andP; split. + by apply/lerD => //; apply/divr_ge0 => //; apply/ltW. + suff: \row__ Num.min (z + e / 2)%R (y ord0 ord0) \in [set` u]. + by rewrite mem_setE. + apply/eu; rewrite in_setI -ball_normE/=. + (* N.B. This is a very weird way to do it. *) + rewrite mem_setE/= unfold_in/= [X in isPOrder.lt _ X]mx_normrE/=. + apply/andP; split; last first. + rewrite mem_setE; apply/xyI; rewrite inSAset_itv in_itv/= mxE. + rewrite ge_min lexx orbT le_min xy 2!andbT -[x _ _]addr0. + by apply/lerD => //; apply/divr_ge0 => //; apply/ltW. + apply/bigmax_lt => //; case; case; case=> //= ltr01; case; case=> // ltr01' _. + rewrite !mxE; apply/ltr_normlP; split; rewrite -subr_gt0. + rewrite opprK addrA subr_gt0 gt_min addrC; apply/orP; left. + apply/ltr_leD; last exact/lexx. + rewrite ltr_pdivrMr// mulr_natr mulr2n -[X in (X < _)%R]addr0. + by apply/ler_ltD => //; apply/lexx. + rewrite opprB addrCA -opprB subr_gt0 lt_min; apply/andP; split; last first. + by rewrite -[X in (_ < X)%R]addr0; apply/ltrD => //; rewrite oppr_lt0. + apply/ler_ltD; first exact/lexx. + rewrite ltr_pdivlMr// -subr_gt0 mulNr opprK -[X in (X + _)%R]mulr1. + by rewrite -mulrDr; apply/mulr_gt0 => //; apply/addr_gt0. +move: xz; rewrite le_eqVlt => /orP[/eqP|] xz. + apply/negP => /SAsetP/(_ x). + rewrite 2!inSAsetI inSAset0 xu andbT => /negP; apply. + apply/andP; split. + by apply/xyI; rewrite inSAset_itv in_itv/= xy lexx. + move: zv; congr (_ \in v); apply/eqP; rewrite rowPE forall_ord1 mxE. + exact/eqP. +move: vopen => /open_subspace_ballP/(_ (\row__ z)); mp. + rewrite in_setI mem_setE/= zv mem_setE inSAset_itv mxE/=. + by move: zI; rewrite inSAset_itv mxE. +move=> [] /= e [] e0 /subsetP ev. +have: (\row__ (Order.max (z - e / 2) (x ord0 ord0))) \in ~: SAset_itv `[z, +oo[%R. + rewrite inSAsetC inSAset_itv in_itv/= mxE andbT -ltNge gt_max xz andbT. + rewrite -[X in (_ < X)%R]addr0; apply/ler_ltD; first exact/lexx. + by rewrite oppr_lt0; apply/divr_gt0. +rewrite -ubu => /inSAsetUBC[] t. +rewrite inSAsetI inSAset_itv in_itv/= mxE gt_max => -[] /andP[]/andP[_] ty tu. +move=> /andP[] zt xt. +apply/negP => /SAsetP/(_ t); rewrite 2!inSAsetI inSAset0 tu andbT => /negP. +apply; apply/andP; split. + by apply/xyI; rewrite inSAset_itv in_itv/= (ltW xt). +suff: t \in [set` v] by rewrite mem_setE. +apply/ev; rewrite in_setI -ball_normE/=. +(* N.B. This is a very weird way to do it. *) +rewrite mem_setE/= unfold_in/= [X in isPOrder.lt _ X]mx_normrE/=. +apply/andP; split; last first. + by rewrite mem_setE; apply/xyI; rewrite inSAset_itv in_itv/= (ltW xt). +apply/bigmax_lt => //; case; case; case=> //= ltr01; case; case=> // ltr01' _. +rewrite !mxE; apply/ltr_normlP; split; rewrite -subr_gt0. + rewrite opprK addrA subr_gt0 -[X in (X < _)%R]add0r; apply/ltr_leD => //. + move: (zub t); mp; last by congr (t _ _ <= z)%R; apply/val_inj. + by rewrite inSAsetI inSAset_itv in_itv/= (ltW xt) ty. +rewrite opprB addrCA -opprB subr_gt0. +have ze: z - e < z - e / 2. + apply/ler_ltD; first exact/lexx. + rewrite -subr_gt0 -opprD opprB subr_gt0. + rewrite ltr_pdivrMr// -subr_gt0 -[X in (_ - X)%R]mulr1 -mulrBr. + by rewrite mulr2n -addrA subrr addr0 mulr1. +by apply/(lt_trans ze); move: zt; congr (_ < t _ _)%R; apply/val_inj. +Qed. + +Lemma SAimset_connected (R : rcfType) n m (s : {SAset R^n}) (f : {SAfun R^n -> R^m}) : + SAconnected s -> {within [set` s], continuous f} -> SAconnected (SAimset f s). +Proof. +move=> scon /continuousP fcon u v. +move=> /open_subspaceP[] U [] /fcon /open_subspaceP[] Us [] Uso UsE UE. +move=> /open_subspaceP[] V [] /fcon /open_subspaceP[] Vs [] Vso VsE VE. +move=> fsu fsv fsuv. +move: (scon (SApreimset f u) (SApreimset f v)). +mp. + apply/open_subspaceP; exists Us; split=> //. + rewrite UsE; apply/seteqP; split; apply/subsetP => x; + rewrite !in_setI !mem_setE inSApreimset => /andP[] fxu xs; + apply/andP; split=> //. + suff: f x \in (U `&` [set` SAimset f s])%classic. + by rewrite UE in_setI mem_setE => /andP[]. + rewrite in_setI mem_setE; apply/andP; split=> //. + exact/inSAimset. + suff: f x \in (U `&` [set` SAimset f s])%classic. + by rewrite in_setI => /andP[]. + rewrite UE in_setI !mem_setE; apply/andP; split=> //. + exact/inSAimset. +mp. + apply/open_subspaceP; exists Vs; split=> //. + rewrite VsE; apply/seteqP; split; apply/subsetP => x; + rewrite !in_setI !mem_setE inSApreimset => /andP[] fxv xs; + apply/andP; split=> //. + suff: f x \in (V `&` [set` SAimset f s])%classic. + by rewrite VE in_setI mem_setE => /andP[]. + rewrite in_setI mem_setE; apply/andP; split=> //. + exact/inSAimset. + suff: f x \in (V `&` [set` SAimset f s])%classic. + by rewrite in_setI => /andP[]. + rewrite VE in_setI !mem_setE; apply/andP; split=> //. + exact/inSAimset. +mp. + move: fsu; apply/contraNN => /eqP fsu. + apply/SAsetP => x; rewrite inSAsetI inSAset0. + apply/negP => /andP[] /SAimsetP[] y ys -> fyu. + suff: y \in SAset0 R n by rewrite inSAset0. + by rewrite -fsu inSAsetI ys inSApreimset. +mp. + move: fsv; apply/contraNN => /eqP fsv. + apply/SAsetP => x; rewrite inSAsetI inSAset0. + apply/negP => /andP[] /SAimsetP[] y ys -> fyv. + suff: y \in SAset0 R n by rewrite inSAset0. + by rewrite -fsv inSAsetI ys inSApreimset. +mp. + apply/SAset_subP => x xs; rewrite inSAsetU 2!inSApreimset. + move: fsuv => /SAset_subP/(_ (f x) (inSAimset _ xs)). + by rewrite inSAsetU. +apply/contraNN => /eqP fsuv0. +apply/SAsetP => x; rewrite 2!inSAsetI 2!inSApreimset inSAset0. +apply/negP => /andP[]/andP[] xs fxu fxv. +suff: f x \in SAset0 R m by rewrite inSAset0. +rewrite -fsuv0 2!inSAsetI fxu fxv !andbT. +exact/inSAimset. +Qed. + +Lemma SAselect_continuous R n m s : continuous (SAselect R n m s). +Proof. +case: m => [|m]. + apply/continuousP => /= a _. + have [->|/set0P[] x ax] := eqVneq a set0. + rewrite preimage_set0; exact/open0. + suff ->: a = setT by rewrite preimage_setT; exact/openT. + rewrite -classical_sets.subTset; apply/subsetP => y _. + suff ->: y = x by rewrite inE. + by apply/rowP; case. +case: n => [|n]. + apply/(eq_continuous (f:=fun=> 0)); last exact/cst_continuous. + move=> x; rewrite SAselectE; apply/rowP => i. + by rewrite !mxE nth_default// size_ngraph. +apply/continuousP => /= a; rewrite -open_subspace_setT => /open_subspace_ballP/= aopen. +rewrite -open_subspace_setT; apply/open_subspace_ballP => /= x. +rewrite setIT => xa. +move: aopen => /(_ (SAselect _ _ _ s x)) => /=. +rewrite setIT => /(_ xa)[] e [] e0 /subsetP ea. +exists e; split=> //; apply/subsetP => y. +rewrite -ball_normE inE/= [X in (X < _)%R]mx_normrE => -[] + _. +move=> /bigmax_ltP[_]/= xye. +apply/ea; rewrite -ball_normE inE/=; split=> //. +rewrite [X in (X < _)%R]mx_normrE; apply/bigmax_ltP; split=> //=. +case=> i j _; rewrite !SAselectE/= !mxE. +case: (ltnP (s`_j) n.+1) => jn; last first. + by rewrite nth_default ?size_ngraph// nth_default ?size_ngraph// subrr normr0. +have ->: s`_j = Ordinal jn by []. +rewrite !nth_ngraph. +move: (xye (i, Ordinal jn) isT); rewrite /= !mxE. +by congr (`|x _ _ - y _ _| < e)%R; apply/val_inj; case: i; case. +Qed. + +Lemma SAcast_connected (R : rcfType) n m (s : {SAset R^n}) : + SAconnected s -> SAconnected (SAset_cast m s). +Proof. +move=> scon. +rewrite SAset_castE_select. +apply/SAimset_connected => //=. +apply/(continuous_subspaceW (B:=setT)). + exact/classical_sets.subsetT. +move=> x y. +move: (@SAselect_continuous R n m (iota 0 m) x y) => /[apply]. +by rewrite nbhs_subspaceT. +Qed. + +Lemma SAconnected0 (R : rcfType) n : + SAconnected (SAset0 R n). +Proof. by move=> s t _ _ _; rewrite SAset0I eqxx. Qed. + +Lemma SAconnectedX (R : rcfType) n m (s : {SAset R^n}) (t : {SAset R^m}) : + SAconnected s -> SAconnected t -> SAconnected (s :*: t). +Proof. +case: n s => [|n] s. + case: (set0Vmem s) => [->|[] y ys]. + by rewrite SAset0X => _ _; apply/SAconnected0. + suff ->: s :*: t = t by []. + apply/eqP/SAsetP => x; rewrite inSAsetX. + have ->: lsubmx x \in s. + by move: ys; congr (_ \in s); apply/rowP; case. + congr (_ \in t); apply/rowP => i. + by rewrite mxE; congr (x _ _); apply/val_inj. +case: m t => [|m] t. + case: (set0Vmem t) => [->|[]y yt]. + by rewrite SAsetX0 => _ _; apply/SAconnected0. + suff ->: s :*: t = SAset_cast (n.+1 + 0) s. + by move=> scon _; apply/SAcast_connected. + apply/eqP/SAsetP => x; rewrite inSAsetX inSAset_castnD. + have ->: rsubmx x \in t. + by move: yt; congr (_ \in t); apply/rowP; case. + have ->: rsubmx x == 0 by apply/eqP/rowP; case. + by rewrite !andbT. +move=> scon tcon u v /open_subspace_ballP/= uopen /open_subspace_ballP/= vopen. +case: (set0Vmem (s :*: t :&: u)) => [-> +|[] x xstu] _; first by rewrite eqxx. +case: (set0Vmem (s :*: t :&: v)) => [-> +|[] y ystv] _; first by rewrite eqxx. +move=> /SAset_subP stuv. +move: (scon (SAimset (SAselect _ _ _ (iota 0 n.+1)) (s :*: t :&: u)) (SAimset (SAselect _ _ _ (iota 0 n.+1)) (s :*: t :&: v))). +mp. + apply/open_subspace_ballP => a. + rewrite in_setI !mem_setE => /andP[] /SAimsetP[] b. + rewrite inSAsetI => /andP[] bst bu ->. + rewrite SAselectE => bs. + move: (uopen b); rewrite in_setI !mem_setE bu => /(_ bst)[] e [] e0 /subsetP eu. + exists e; split=> //. + apply/subsetP => c; rewrite in_setI !mem_setE => /andP[] + cs. + rewrite -ball_normE inE/= [`|_|]mx_normrE => /bigmax_ltP[_]/= ce. + suff: c \in (SAimset (SAselect R (n.+1 + m.+1) n.+1 (iota 0 n.+1)) (s :*: t :&: u)) by []. + apply/SAimsetP; exists (row_mx c (rsubmx b)); last first. + by rewrite SAselect_iotal row_mxKl. + move: bst; rewrite inSAsetX => /andP[_] bt. + rewrite inSAsetI inSAsetX row_mxKl row_mxKr cs bt/=. + move: (eu (row_mx c (rsubmx b))); rewrite mem_setE; apply. + rewrite -ball_normE inE/=; split; last first. + by rewrite inSAsetX row_mxKl row_mxKr cs. + rewrite [`|_|]mx_normrE; apply/bigmax_lt => //=; case=> i j _ /=. + rewrite -(@splitK n.+1 m.+1 j) !mxE unsplitK. + case: (@split n.+1 m.+1 j) => /= k; last first. + by rewrite mxE subrr normr0. + move: (ce (i, k) isT); rewrite !mxE/= (nth_iota _ _ (n:=n.+1))//. + have ->: (0 + k = lshift m.+1 k)%N by []. + rewrite nth_ngraph; congr (`|b _ _ - _| < e)%R. + by apply/val_inj; case: i; case. +mp. + apply/open_subspace_ballP => a. + rewrite in_setI !mem_setE => /andP[] /SAimsetP[] b. + rewrite inSAsetI => /andP[] bst bv ->. + rewrite SAselectE => bs. + move: (vopen b); rewrite in_setI !mem_setE bv => /(_ bst)[] e [] e0 /subsetP ev. + exists e; split=> //. + apply/subsetP => c; rewrite in_setI !mem_setE => /andP[] + cs. + rewrite -ball_normE inE/= [`|_|]mx_normrE => /bigmax_ltP[_]/= ce. + suff: c \in (SAimset (SAselect R (n.+1 + m.+1) n.+1 (iota 0 n.+1)) (s :*: t :&: v)) by []. + apply/SAimsetP; exists (row_mx c (rsubmx b)); last first. + by rewrite SAselect_iotal row_mxKl. + move: bst; rewrite inSAsetX => /andP[_] bt. + rewrite inSAsetI inSAsetX row_mxKl row_mxKr cs bt/=. + move: (ev (row_mx c (rsubmx b))); rewrite mem_setE; apply. + rewrite -ball_normE inE/=; split; last first. + by rewrite inSAsetX row_mxKl row_mxKr cs. + rewrite [`|_|]mx_normrE; apply/bigmax_lt => //=; case=> i j _ /=. + rewrite -(@splitK n.+1 m.+1 j) !mxE unsplitK. + case: (@split n.+1 m.+1 j) => /= k; last first. + by rewrite mxE subrr normr0. + move: (ce (i, k) isT); rewrite !mxE/= (nth_iota _ _ (n:=n.+1))//. + have ->: (0 + k = lshift m.+1 k)%N by []. + rewrite nth_ngraph; congr (`|b _ _ - _| < e)%R. + by apply/val_inj; case: i; case. +mp. + apply/negP => /SAsetP/(_ (lsubmx x)). + move: (xstu); rewrite !inSAsetI inSAsetX inSAset0 => /andP[]/andP[] xs xt xu /negP; apply. + by rewrite xs; apply/SAimsetP; exists x => //; rewrite SAselect_iotal. +mp. + apply/negP => /SAsetP/(_ (lsubmx y)). + move: (ystv); rewrite !inSAsetI inSAsetX inSAset0 => /andP[]/andP[] ys yt yv /negP; apply. + by rewrite ys; apply/SAimsetP; exists y => //; rewrite SAselect_iotal. +mp. + apply/SAset_subP => z zs. + move: (xstu); rewrite !inSAsetI inSAsetX => /andP[]/andP[] xs xt xu. + have /stuv: (row_mx z (rsubmx x)) \in s :*: t. + by rewrite inSAsetX row_mxKl row_mxKr zs. + rewrite !inSAsetU => /orP[zu|zv]; apply/orP; [left|right]; apply/SAimsetP; exists (row_mx z (rsubmx x)). + - by rewrite inSAsetI inSAsetX row_mxKl row_mxKr zs xt. + - by rewrite SAselect_iotal row_mxKl. + - by rewrite inSAsetI inSAsetX row_mxKl row_mxKr zs xt. + - by rewrite SAselect_iotal row_mxKl. +move=> {x xstu y ystv}; set sfib := (_ :&: _ :&: _). +case: (set0Vmem sfib) => [->|[] x]; first by rewrite eqxx. +rewrite /sfib !inSAsetI => {sfib} /andP[]/andP[] xs. +move=> /SAimsetP[] yz. +rewrite -(hsubmxK yz) inSAsetI inSAsetX SAselect_iotal row_mxKl row_mxKr. +move: (rsubmx yz) => y /andP[]/andP[_] yt /[swap] <- yu {yz}. +move=> /SAimsetP[] yz. +rewrite -(hsubmxK yz) inSAsetI inSAsetX SAselect_iotal row_mxKl row_mxKr. +move: (rsubmx yz) => z /andP[]/andP[_] zt /[swap] <- zv {yz} _. +move: (tcon (SApreimset (SAjoin (SAfun_const _ x) (SAid _ _)) (s :*: t :&: u)) (SApreimset (SAjoin (SAfun_const _ x) (SAid _ _)) (s :*: t :&: v))). +mp. + apply/open_subspace_ballP => /= a. + rewrite in_setI !mem_setE inSApreimset SAjoinE SAfun_constE SAidE inSAsetI. + move=> /andP[]/andP[_] au aint. + move: (uopen (row_mx x a)); rewrite in_setI !mem_setE au. + rewrite inSAsetX row_mxKl row_mxKr xs => /(_ aint)[] e [] e0 /subsetP eu. + exists e; split=> //. + apply/subsetP => b; rewrite in_setI !mem_setE => /andP[] + bt. + rewrite -ball_normE inE/= [`|_|]mx_normrE => /bigmax_ltP[_]/= be. + rewrite inSApreimset SAjoinE SAfun_constE SAidE inSAsetI inSAsetX. + rewrite row_mxKl row_mxKr xs bt. + move: (eu (row_mx x b)); rewrite mem_setE; apply. + rewrite -ball_normE inE/=; split; last first. + by rewrite inSAsetX row_mxKl row_mxKr xs. + rewrite [`|_|]mx_normrE; apply/bigmax_lt => //=; case=> i j _ /=. + rewrite -(@splitK n.+1 m.+1 j) !mxE unsplitK. + case: (@split n.+1 m.+1 j) => /= k. + by rewrite subrr normr0. + by move: (be (i, k) isT); rewrite !mxE. +mp. + apply/open_subspace_ballP => /= a. + rewrite in_setI !mem_setE inSApreimset SAjoinE SAfun_constE SAidE inSAsetI. + move=> /andP[]/andP[_] av aint. + move: (vopen (row_mx x a)); rewrite in_setI !mem_setE av. + rewrite inSAsetX row_mxKl row_mxKr xs => /(_ aint)[] e [] e0 /subsetP ev. + exists e; split=> //. + apply/subsetP => b; rewrite in_setI !mem_setE => /andP[] + bt. + rewrite -ball_normE inE/= [`|_|]mx_normrE => /bigmax_ltP[_]/= be. + rewrite inSApreimset SAjoinE SAfun_constE SAidE inSAsetI inSAsetX. + rewrite row_mxKl row_mxKr xs bt. + move: (ev (row_mx x b)); rewrite mem_setE; apply. + rewrite -ball_normE inE/=; split; last first. + by rewrite inSAsetX row_mxKl row_mxKr xs. + rewrite [`|_|]mx_normrE; apply/bigmax_lt => //=; case=> i j _ /=. + rewrite -(@splitK n.+1 m.+1 j) !mxE unsplitK. + case: (@split n.+1 m.+1 j) => /= k. + by rewrite subrr normr0. + by move: (be (i, k) isT); rewrite !mxE. +mp. + apply/negP => /SAsetP/(_ y); rewrite inSAsetI yt inSApreimset. + rewrite SAjoinE SAfun_constE SAidE inSAsetI inSAsetX row_mxKl row_mxKr. + by rewrite xs yt yu inSAset0. +mp. + apply/negP => /SAsetP/(_ z); rewrite inSAsetI zt inSApreimset. + rewrite SAjoinE SAfun_constE SAidE inSAsetI inSAsetX row_mxKl row_mxKr. + by rewrite xs zt zv inSAset0. +mp. + apply/SAset_subP => a aint. + have /stuv: row_mx x a \in s :*: t by rewrite inSAsetX row_mxKl row_mxKr xs. + by rewrite !inSAsetU => /orP[au|av]; apply/orP; [left|right]; + rewrite inSApreimset SAjoinE SAfun_constE SAidE inSAsetI inSAsetX + row_mxKl row_mxKr xs aint. +move=> {y yt yu z zt zv}. +set tfib := (_ :&: _); case: (set0Vmem tfib) => [->|]; first by rewrite eqxx. +rewrite /tfib => {tfib} -[] y; rewrite !inSAsetI => /andP[]/andP[] yt. +rewrite !inSApreimset SAjoinE SAfun_constE SAidE !inSAsetI. +move=> /andP[_] xyu /andP[xyst] xyv _. +apply/negP => /SAsetP/(_ (row_mx x y)). +by rewrite !inSAsetI xyst xyu xyv inSAset0. +Qed. + +(* N.B. This breaks the previous proofs. *) +From mathcomp Require Import functions finmap. + +Lemma SAconnected_partition_of_graphs_above (R : rcfType) n (s : {SAset R^n}) (xi : seq (SAfunltType R n)) : + SAconnected s -> + path.sorted <%O xi -> + (forall i, i < size xi -> {within [set` s], continuous (xi`_i)}) -> + forall t, t \in partition_of_graphs_above s xi -> SAconnected t. +Proof. +move=> /= scon. +rewrite lt_sorted_pairwise => /(pairwiseP 0)/= xisort. +move=> xicont t /imfsetP[/=] u + ->. +move=> /(nthP (SAset0 _ _))[] i; rewrite size_map size_iota => ilt <-. +have mx0_continuous (T U : topologicalType) (S : set 'rV[U]_0) (x : U) (f : T -> subspace S) : + continuous f. + apply/(@eq_continuous _ (subspace S) (fun=> \row__ x)); last exact/cst_continuous. + by move=> y; apply/rowP; case. +(* WHAT?????? *) +have lsubmx_continuous (I : interval R) (x : subspace [set` s :*: SAset_itv I]) : {for x, continuous [eta lsubmx : subspace [set` s :*: SAset_itv I] -> subspace [set` s]]}. + case: n {xi scon xisort xicont t u i ilt} s x => [|n] s x. + by apply/mx0_continuous; exact: 0. + move: x; apply/continuousP => a /open_subspace_ballP/= aopen. + apply/open_subspace_ballP => /= x. + rewrite in_setI mem_preimage mem_setE inSAsetX => /andP[] xa /andP[] xs _. + move: aopen => /(_ (lsubmx x)); rewrite in_setI xa mem_setE => /(_ xs)[] e. + rewrite -ball_normE => -[] e0 /subsetP ea. + exists e; split=> //; rewrite -ball_normE; apply/subsetP => y. + rewrite in_setI mem_setE/= [X in X && _]inE mem_setE inSAsetX. + rewrite [(`|_|)%R]mx_normrE => /andP[] /bigmax_ltP[_]/= xye /andP[] ys _. + apply/ea; rewrite in_setI mem_setE/= [X in X && _]inE mem_setE ys andbT. + rewrite [(`|_|)%R]mx_normrE; apply/bigmax_lt => //= -[] u v _ /=. + move: xye => /(_ (u, lshift 1 v) isT) /=. + by rewrite !mxE/=. +pose g (f : {SAfun R^n -> R^1}) : {SAfun R^(n + 1) -> R^(n + 1)} := + SAjoin (SAselect R (n + 1) n (iota 0 n)) (SAfun_add (SAselect R (n + 1) 1 [:: n]) (SAcomp f (SAselect _ _ _ (iota 0 n)))). +have gE f x : g f x = row_mx (lsubmx x) (rsubmx x + f (lsubmx x)). + by rewrite /g SAjoinE SAfun_addE SAcompE/= SAselect_iotal SAselect_iotar. +have gcont (f : {SAfun R^n -> R^1}) (I : interval R) : {within [set` s], continuous f} -> {within [set` s :*: SAset_itv I], continuous (g f)}. + case: n s {xi scon xisort xicont t u i ilt} f g gE lsubmx_continuous => [|n] s f g gE lsubmx_continuous. + move=> _; apply/(subspace_eq_continuous (f:=fun x : 'cV[R]_1 => x + f 0)). + move=> x _; rewrite gE row_thin_mx; congr (_ + f _); last first. + by apply/rowP; case. + apply/eqP; rewrite rowPE forall_ord1 !mxE/=; apply/eqP. + by congr (x _ _); apply/val_inj. + apply/subspace_continuousP => /= x _. + apply/(@cvg_within_filter 'rV[R]_1 'rV[R]_1 _ (nbhs x) _ (nbhs (x + f 0)) [set` s :*: SAset_itv I]). + apply/(@continuousD _ _ _ id (fun=> f 0) x); first exact/id_continuous. + exact/cst_continuous. + move=> fcont; apply/mx_continuous => i j. + case: (ltnP j n.+1) => jn. + apply/(subspace_eq_continuous (f:=fun x : 'rV[R]_(n.+1 + 1) => x i j)); last first. + apply/subspace_continuousP => /= x _. + apply/(@cvg_within_filter _ _ _ (nbhs x) _ (nbhs (x i j)) [set` s :*: SAset_itv I]). + exact/coord_continuous. + move=> x _; rewrite gE mxE/=. + have ->: j = lshift 1 (Ordinal jn) by apply/val_inj. + by rewrite (unsplitK (inl _)) mxE. + apply/(subspace_eq_continuous (f:=fun x : 'rV[R]_(n.+1 + 1) => x i j + f (lsubmx x) i ord0)). + move=> x _; rewrite gE !mxE/=. + suff ->: j = rshift n.+1 (@ord0 0). + by rewrite (unsplitK (inr _)) !mxE. + apply/val_inj; rewrite /= addn0; apply/le_anti/andP; split=> //. + by rewrite -[leRHS]addn1; move: (ltn_ord j); rewrite ltnS. + move=> x. + apply/(@continuousD _ R^o (subspace [set` s :*: SAset_itv I]) (fun x : 'rV[R]_(n.+1 + 1) => x i j) (fun x : 'rV[R]_(n.+1 + 1) => f (lsubmx x) i ord0)). + move: x; apply/subspace_continuousP => /= x _. + apply/(@cvg_within_filter _ _ _ (nbhs x) _ (nbhs (x i j)) [set` s :*: SAset_itv I]). + exact/coord_continuous. + apply/(@continuous_comp (subspace [set` s :*: SAset_itv I]) _ _ (fun x : 'rV[R]_(n.+1 + 1) => f (lsubmx x)) (fun x : 'rV[R]_1 => x i ord0)); last first. + exact/coord_continuous. + apply/(@continuous_comp (subspace [set` s :*: SAset_itv I]) (subspace [set` s]) _ (fun x : 'rV[R]_(n.+1 + 1) => lsubmx x) f); last first. + exact/fcont. + exact/lsubmx_continuous. +rewrite (nth_map 0); last by rewrite size_iota. +rewrite nth_iota; last by []. +case: (posnP (size xi)) => xi0. + move: ilt; rewrite xi0 ltnS leqn0 => ->. + move/eqP: xi0; rewrite size_eq0 => /eqP ->; rewrite big_nil SAsetTI. + apply/SAconnectedX; first by []. + suff ->: SAsetT R 1 = SAset_itv `]-oo, +oo[ by apply/SAset_itv_connected. + by apply/eqP/SAsetP => x; rewrite inSAsetT inSAset_itv in_itv. +have xisort': {in gtn (size xi) &, + {homo nth 0 xi : i j / (i <= j)%N >-> ((i : SAfunleType _ _) <= j)%R}}. + move=> x y xlt ylt. + rewrite leq_eqVlt => /orP[/eqP ->|]; first exact/lexx. + move=> /xisort-/(_ xlt ylt)/SAfun_ltP xy. + by apply/SAfun_leP => z; apply/ltW. +case: (posnP i) => [_|i0]. + set S := _ :&: _. + suff ->: S = SAimset (g (xi`_0)) (s :*: SAset_itv `]-oo, 0[). + apply/SAimset_connected; last exact/gcont/xicont. + apply/SAconnectedX; first by []. + exact/SAset_itv_connected. + apply/eqP/SAsetP => x. + rewrite /S inSAsetI inSAset_bigcap inSAsetX inSAsetT andbT. + apply/andP/SAimsetP. + move=> [] /allP xxi xs. + exists (row_mx (lsubmx x) (rsubmx x - xi`_0 (lsubmx x))); last first. + by rewrite gE row_mxKl row_mxKr addrAC -addrA subrr addr0 hsubmxK. + rewrite inSAsetX row_mxKl row_mxKr xs inSAset_itv in_itv/= !mxE/=. + rewrite subr_lt0. + by move: xxi => /(_ _ (mem_nth 0 xi0)); rewrite inSAhypograph mxE. + move=> [] y; rewrite inSAsetX inSAset_itv in_itv/= => /andP[] ys y0 ->. + rewrite gE row_mxKl; split=> //. + apply/allP => _ /(nthP 0)[] j jxi <-. + rewrite inSAhypograph row_mxKl row_mxKr -[ltRHS]add0r mxE; apply/ltr_leD => //. + by move: xisort' => /(_ 0 j); rewrite !inE => /(_ xi0 jxi (leq0n _)) /SAfun_leP. +move: ilt; rewrite ltnS leq_eqVlt => /orP[->|ilt]. + set S := _ :&: _. + suff ->: S = SAimset (g (xi`_(size xi).-1)) (s :*: SAset_itv `]0, +oo[). + apply/SAimset_connected; last first. + by apply/gcont/xicont; rewrite [_ < _]ltn_predL. + apply/SAconnectedX; first by []. + exact/SAset_itv_connected. + apply/eqP/SAsetP => x. + rewrite /S inSAsetI inSAset_bigcap inSAsetX inSAsetT andbT. + apply/andP/SAimsetP. + move=> [] /allP xxi xs. + exists (row_mx (lsubmx x) (rsubmx x - xi`_(size xi).-1 (lsubmx x))); last first. + by rewrite gE row_mxKl row_mxKr addrAC -addrA subrr addr0 hsubmxK. + rewrite inSAsetX row_mxKl row_mxKr xs inSAset_itv in_itv/= !mxE/= andbT. + rewrite subr_gt0; move: xxi => /(_ (xi`_(size xi).-1)); mp. + by apply/mem_nth; rewrite ltn_predL. + by rewrite inSAepigraph mxE. + move=> [] y; rewrite inSAsetX inSAset_itv in_itv/= andbT => /andP[] ys y0 ->. + rewrite gE row_mxKl; split=> //. + apply/allP => _ /(nthP 0)[] j jxi <-. + rewrite inSAepigraph row_mxKl row_mxKr -[ltLHS]add0r mxE; apply/ltr_leD => //. + move: xisort' => /(_ j (size xi).-1); rewrite !inE ltn_predL => /(_ jxi xi0). + by rewrite -ltnS prednK// => /(_ jxi) => /SAfun_leP. +have ->: i == (size xi).*2 = false. + apply/negP => /eqP iE. + by move: ilt; rewrite iE ltnn. +case/boolP: (odd i) => iodd. + set S := _ :&: _. + suff ->: S = SAimset (g (xi`_i./2)) (s :*: SAset_itv `[0, 0]). + apply/SAimset_connected; last first. + by apply/gcont/xicont; rewrite [_ < _]ltn_half_double. + apply/SAconnectedX; first by []. + exact/SAset_itv_connected. + apply/eqP/SAsetP => x. + rewrite /S inSAsetI -{1}[x]hsubmxK -inSAfun inSAsetX inSAsetT andbT. + apply/andP/SAimsetP. + move=> [] /eqP xE xs. + exists (row_mx (lsubmx x) (rsubmx x - xi`_i./2 (lsubmx x))); last first. + by rewrite gE row_mxKl row_mxKr addrAC -addrA subrr addr0 hsubmxK. + rewrite inSAsetX row_mxKl row_mxKr xs inSAset_itv in_itv/= !mxE/=. + by rewrite xE mxE subrr lexx. + move=> [] y; rewrite inSAsetX inSAset_itv in_itv/= => /andP[] ys. + move=> /andP[] y0 y0' ->. + have {y0'}y0: rsubmx y ord0 ord0 = 0 by apply/le_anti/andP. + rewrite gE row_mxKl row_mxKr; split=> //; apply/eqP. + rewrite -[LHS]add0r; congr (_ + _); apply/eqP. + by rewrite rowPE forall_ord1 y0 mxE eqxx. +(* Why does `move=> {...}` unfold the goal ??? *) +clear g gE gcont. +pose h (f g : {SAfun R^n -> R^1}) : {SAfun R^(n + 1) -> R^(n + 1)} := + SAjoin (SAselect R (n + 1) n (iota 0 n)) + (SAfun_add (SAcomp f (SAselect _ _ _ (iota 0 n))) + (SAfun_mul (SAselect R (n + 1) 1 [:: n]) (SAcomp (SAfun_sub g f) (SAselect _ _ _ (iota 0 n))))). +have hE f g x : h f g x = row_mx (lsubmx x) (f (lsubmx x) + x ord0 (rshift n ord0) *: (g (lsubmx x) - (f (lsubmx x)))). + rewrite /h SAjoinE SAfun_addE SAfun_mulE !SAcompE/= SAfun_subE. + rewrite SAselect_iotal SAselect_iotar. + congr (row_mx _ (_ + _)). + apply/rowP => j; rewrite !mxE/=; congr (x _ _ * _); apply/val_inj. + by case: j; case. +have hcont (f g : {SAfun R^n -> R^1}) (I : interval R) : {within [set` s], continuous f} + -> {within [set` s], continuous g} + -> {within [set` s :*: SAset_itv I], continuous (h f g)}. + case: n s {xi scon xi0 xisort xisort' xicont t u i ilt i0 iodd} f g h hE lsubmx_continuous => [|n] s f g h hE lsubmx_continuous. + move=> _ _; apply/(subspace_eq_continuous (f:=fun x : 'cV[R]_1 => f 0 + x * (g 0 - f 0))). + move=> x _; rewrite hE row_thin_mx. + have ->: lsubmx (x : 'rV_(0 + 1)) = 0 by apply/rowP; case. + congr (_ + _); apply/rowP; case; case=> [|//] j. + rewrite !mxE/= big_ord_recl big_ord0 addr0 !mxE; congr (x _ _ * _). + exact/val_inj. + apply/subspace_continuousP => /= x _. + apply/(@cvg_within_filter 'rV[R]_1 'rV[R]_1 _ (nbhs x) _ (nbhs (f 0 + x * (g 0 - f 0))) [set` s :*: SAset_itv I]). + apply/(@continuousD _ _ _ (fun=> f 0) (fun x : 'cV[R]_1 => x * (g 0 - f 0)) x). + exact/cst_continuous. + apply/mx_continuous => i j; rewrite !ord1. + apply/(eq_continuous (f:=fun x : 'cV[R]_1 => x ord0 ord0 * (g 0 - f 0) ord0 ord0)). + by move=> y; rewrite [in RHS]mxE big_ord_recl big_ord0 addr0. + move=> {}x. + apply/(@continuousM R 'cV[R]_1 (fun x : 'cV[R]_1 => x ord0 ord0) (fun=> (g 0 - f 0) ord0 ord0)). + exact/coord_continuous. + exact/cst_continuous. + move=> fcont gcont; apply/mx_continuous => i j. + case: (ltnP j n.+1) => jn. + apply/(subspace_eq_continuous (f:=fun x : 'rV[R]_(n.+1 + 1) => x i j)); last first. + apply/subspace_continuousP => /= x _. + apply/(@cvg_within_filter _ _ _ (nbhs x) _ (nbhs (x i j)) [set` s :*: SAset_itv I]). + exact/coord_continuous. + move=> x _; rewrite hE mxE/=. + have ->: j = lshift 1 (Ordinal jn) by apply/val_inj. + by rewrite (unsplitK (inl _)) mxE. + apply/(subspace_eq_continuous (f:=fun x : 'rV[R]_(n.+1 + 1) => f (lsubmx x) i ord0 + x i j * (g (lsubmx x) - f (lsubmx x)) i ord0)). + move=> x _; rewrite hE !mxE/=. + suff ->: j = rshift n.+1 (@ord0 0). + by rewrite (unsplitK (inr _)) !mxE ord1. + apply/val_inj; rewrite /= addn0; apply/le_anti/andP; split=> //. + by rewrite -[leRHS]addn1; move: (ltn_ord j); rewrite ltnS. + move=> x. + apply/(@continuousD _ (GRing_regular__canonical__normedtype_PseudoMetricNormedZmod R) (subspace [set` s :*: SAset_itv I])). + apply/(@continuous_comp (subspace [set` s :*: SAset_itv I]) _ _ _ (fun x : 'rV[R]_1 => x i ord0)); last first. + exact/coord_continuous. + apply/(@continuous_comp (subspace [set` s :*: SAset_itv I]) (subspace [set` s])). + exact/lsubmx_continuous. + exact/fcont. + apply/(@continuousM R (subspace [set` s :*: SAset_itv I])). + move: x; apply/subspace_continuousP => /= x _. + apply/(@cvg_within_filter _ _ _ (nbhs x) _ (nbhs (x i j)) [set` s :*: SAset_itv I]). + exact/coord_continuous. + apply/(@continuous_comp (subspace [set` s :*: SAset_itv I]) _ _ _ (fun x : 'rV[R]_1 => x i ord0)); last first. + exact/coord_continuous. + apply/(@continuousB _ 'rV[R]_1 (subspace [set` s :*: SAset_itv I])). + apply/(@continuous_comp (subspace [set` s :*: SAset_itv I]) (subspace [set` s])). + exact/lsubmx_continuous. + exact/gcont. + apply/(@continuous_comp (subspace [set` s :*: SAset_itv I]) (subspace [set` s])). + exact/lsubmx_continuous. + exact/fcont. +have i20: (0 < i./2)%N. + by rewrite half_gt0; case: i i0 iodd {ilt} => [//|]; case. +have ilt': (i./2.-1 < size xi)%N. + by rewrite prednK// leq_half_double; apply/ltnW/(ltn_trans ilt)/leqnn. +move: (xisort i./2.-1 i./2); rewrite !inE => /(_ ilt'). +rewrite ltn_half_double => /(_ ilt). +rewrite prednK// => /(_ (leqnn _)) /SAfun_ltP {}xisort. +set S := _ :&: _. +suff ->: S = SAimset (h xi`_i./2.-1 xi`_i./2) (s :*: SAset_itv `]0, 1[). + apply/SAimset_connected; last first. + apply/hcont; apply/xicont => //. + by rewrite [_ < _]ltn_half_double. + apply/SAconnectedX; first by []. + exact/SAset_itv_connected. +apply/eqP/SAsetP => x. +rewrite /S !inSAsetI inSAepigraph inSAhypograph inSAsetX inSAsetT andbT mxE. +apply/andP/SAimsetP. + move=> [] /andP[] xix xxi xs. + exists (row_mx (lsubmx x) (\row__ ((rsubmx x ord0 ord0 - xi`_i./2.-1 (lsubmx x) ord0 ord0) / (xi`_i./2 (lsubmx x) ord0 ord0 - xi`_i./2.-1 (lsubmx x) ord0 ord0)))); last first. + rewrite -[LHS]hsubmxK hE row_mxKl; congr (row_mx _ _). + apply/rowP => j; rewrite !ord1 !mxE (unsplitK (inr _)) !mxE. + rewrite mulrAC -mulrA divff. + by rewrite mulr1 addrCA subrr addr0. + rewrite subr_eq0; apply/eqP => xiE. + by move: (xisort (lsubmx x)); rewrite xiE ltxx. + rewrite inSAsetX row_mxKl row_mxKr xs inSAset_itv in_itv/= !mxE/=. + apply/andP; split; first by apply/divr_gt0; rewrite subr_gt0. + by rewrite ltr_pdivrMr ?subr_gt0// mul1r -subr_gt0 subrBB subr_gt0. +move=> [] y; rewrite inSAsetX inSAset_itv in_itv/= => /andP[] ys. +rewrite mxE => /andP[] y0 y1 ->. +rewrite hE row_mxKl; split=> //. +rewrite mxE (unsplitK (inr _)) !mxE; apply/andP; split. + rewrite -subr_gt0 addrAC subrr add0r; apply/mulr_gt0 => //. + by rewrite subr_gt0. +rewrite -subr_gt0 opprD addrA -[X in (X - _)%R]mul1r -mulrBl. +by apply/mulr_gt0; rewrite subr_gt0. +Qed. +