diff --git a/.codespellignore b/.codespellignore index 979a2c1b24..2fa232ffde 100644 --- a/.codespellignore +++ b/.codespellignore @@ -16,3 +16,7 @@ dOut SINIC ofSet mapP +hTe +hSA +hsI +hax diff --git a/.github/workflows/alphaBuild.yml b/.github/workflows/alphaBuild.yml index 7bed6fb78f..2adc3b8169 100644 --- a/.github/workflows/alphaBuild.yml +++ b/.github/workflows/alphaBuild.yml @@ -13,9 +13,14 @@ jobs: alpha_build: name: Lean based style linters runs-on: ubuntu-latest + env: + LAKE_CACHE_DIR: .lake/cache steps: + # Full history so lake can look back for a commit with a cache, see build.yml - uses: actions/checkout@v4 + with: + fetch-depth: 0 - name: Install elan run: | @@ -29,10 +34,18 @@ jobs: lean --version lake --version - - name: build cache + - name: Mathlib build cache run: | lake exe cache get + # PhyslibAlpha has its own cache in the bucket so we pull that one + - name: PhyslibAlpha's build cache + env: + LAKE_CONFIG: ${{ github.workspace }}/lake-cache.toml + run: | + lake cache get --scope="physlib-master/$(tr '/:' '--' < lean-toolchain | tr -d '[:space:]')/alpha" \ + || echo "no existing cache to restore -- building from scratch" + - name: build PhyslibAlpha id: build uses: liskin/gh-problem-matcher-wrap@v3 @@ -50,6 +63,13 @@ jobs: linters: gcc run: env LEAN_ABORT_ON_PANIC=1 lake exe runPhyslibAlphaLinters + - name: Check no PhyslibAlpha in Physlib and QuantumInfo + run: env LEAN_ABORT_ON_PANIC=1 lake exe noAlphaImports + + - name: Check PhyslibAlpha imports + run: env LEAN_ABORT_ON_PANIC=1 lake exe alphaFileImports + + style_lint: name: Python based linters runs-on: ubuntu-latest @@ -73,16 +93,6 @@ jobs: with: python-version: 3.8 - - name: Check PhyslibAlpha imports - run: | - chmod u+x scripts/PhyslibAlpha/alphaFileImports.py - ./scripts/PhyslibAlpha/alphaFileImports.py - - - name: Check no PhyslibAlpha in Physlib and QuantumInfo - run: | - chmod u+x scripts/PhyslibAlpha/noAlphaImports.py - ./scripts/PhyslibAlpha/noAlphaImports.py - - name: Python linters for PhyslibAlpha run: | chmod u+x scripts/PhyslibAlpha/alphaPythonLinters.sh diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index dbb17cdb1e..f846b68122 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -13,9 +13,15 @@ jobs: doc_lint: name: Lean based style linters runs-on: ubuntu-latest + env: + LAKE_CACHE_DIR: .lake/cache steps: + # Need the full history here, lake looks back through the commits to find + # one with a cache. A shallow clone only has one so it never finds anything. - uses: actions/checkout@v4 + with: + fetch-depth: 0 - name: Install elan run: | @@ -29,10 +35,19 @@ jobs: lean --version lake --version - - name: build cache + - name: Mathlib build cache run: | lake exe cache get + # Pulls the cache from the bucket so we only compile what the PR changed. + # No key needed as it is only reading. If it fails we just build from scratch. + - name: Physlib's build cache + env: + LAKE_CONFIG: ${{ github.workspace }}/lake-cache.toml + run: | + lake cache get --scope="physlib-master/$(tr '/:' '--' < lean-toolchain | tr -d '[:space:]')/physlib" \ + || echo "no existing cache to restore -- building from scratch" + - name: build Physlib id: build uses: liskin/gh-problem-matcher-wrap@v3 diff --git a/.github/workflows/pr_size_label.yaml b/.github/workflows/pr_size_label.yaml new file mode 100644 index 0000000000..ce51b8a94a --- /dev/null +++ b/.github/workflows/pr_size_label.yaml @@ -0,0 +1,85 @@ +name: PR size label + +on: + pull_request_target: + types: [opened, synchronize, reopened] + +# Limit permissions for GITHUB_TOKEN for the entire workflow +permissions: + contents: read + pull-requests: write # Only allow PR comments/labels + # All other permissions are implicitly 'none' + +jobs: + add_size_label: + name: Add size label + runs-on: ubuntu-latest + # Don't run on forks, where we wouldn't have permissions to add the label anyway. + if: github.repository == 'leanprover-community/physlib' + steps: + - name: Label PR by size + uses: actions/github-script@v7 + with: + script: | + const SIZES = [ + { label: 'small', color: '2ea44f', max: 100 }, + { label: 'medium', color: 'f66a0a', max: 500 }, + { label: 'large', color: 'd73a4a', max: Infinity }, + ]; + + const { data: pr } = await github.rest.pulls.get({ + owner: context.repo.owner, + repo: context.repo.repo, + pull_number: context.issue.number, + }); + + const changedLines = pr.additions + pr.deletions; + const target = SIZES.find(s => changedLines < s.max) ?? SIZES[SIZES.length - 1]; + + core.info(`PR #${pr.number}: ${changedLines} lines changed -> ${target.label}`); + + // Ensure all three size labels exist with the right color, and remove + // any size label that isn't the one that currently applies. + for (const size of SIZES) { + try { + await github.rest.issues.getLabel({ + owner: context.repo.owner, + repo: context.repo.repo, + name: size.label, + }); + } catch (err) { + if (err.status === 404) { + await github.rest.issues.createLabel({ + owner: context.repo.owner, + repo: context.repo.repo, + name: size.label, + color: size.color, + }); + } else { + throw err; + } + } + + if (size.label !== target.label) { + try { + await github.rest.issues.removeLabel({ + owner: context.repo.owner, + repo: context.repo.repo, + issue_number: pr.number, + name: size.label, + }); + } catch (err) { + if (err.status !== 404) throw err; + } + } + } + + const existingLabels = pr.labels.map(l => l.name); + if (!existingLabels.includes(target.label)) { + await github.rest.issues.addLabels({ + owner: context.repo.owner, + repo: context.repo.repo, + issue_number: pr.number, + labels: [target.label], + }); + } diff --git a/.github/workflows/publish-cache.yml b/.github/workflows/publish-cache.yml new file mode 100644 index 0000000000..6e90b23b59 --- /dev/null +++ b/.github/workflows/publish-cache.yml @@ -0,0 +1,194 @@ +on: + push: + branches: + - master + +name: Publish build cache + +# Pulls the cache from the bucket and then does a build with the new changes that are being merged +# Then it creates a new cache which is pushed to the web bucket where they can be accessed +# by `lake exe get_cache`. + +jobs: + # `secrets` is not allowed in a job-level `if:` -- GitHub rejects the whole + # file. Gating on a `needs` output instead skips the build jobs when the + # bucket is not set up yet. + gate: + name: Check for cache credentials + runs-on: ubuntu-latest + outputs: + has_key: ${{ steps.check.outputs.has_key }} + steps: + - name: look for LAKE_CACHE_KEY + id: check + env: + LAKE_CACHE_KEY: ${{ secrets.LAKE_CACHE_KEY }} + run: | + set -euo pipefail + if [ -n "$LAKE_CACHE_KEY" ]; then + echo "has_key=true" >> "$GITHUB_OUTPUT" + else + echo "::notice::LAKE_CACHE_KEY is not set, so the build cache will not be published. See docs/cache-setup.md." + echo "has_key=false" >> "$GITHUB_OUTPUT" + fi + + physlib: + name: Physlib + QuantumInfo + needs: gate + if: needs.gate.outputs.has_key == 'true' + runs-on: ubuntu-latest + env: + LAKE_CACHE_DIR: .lake/cache + steps: + # Full history so lake can look back for a commit with a cache, + # a shallow clone only has one so the restore below never finds anything + - uses: actions/checkout@v4 + with: + fetch-depth: 0 + + # Each job needs its own scope: Lake PUTs the revision mappings to + # //.jsonl, so a shared scope would have + # one job overwrite the other's. The toolchain is in the scope because + # Lake ignores --toolchain for verbatim scopes. + # scripts/get_cache.lean builds the same strings -- keep them in step. + - name: compute cache scope + run: | + set -euo pipefail + TC="$(tr '/:' '--' < lean-toolchain | tr -d '[:space:]')" + echo "CACHE_SCOPE=physlib-master/$TC/physlib" >> "$GITHUB_ENV" + + - name: Install elan + run: | + set -o pipefail + curl https://raw.githubusercontent.com/leanprover/elan/master/elan-init.sh -sSf | sh -s -- --default-toolchain none -y + ~/.elan/bin/lean --version + echo "$HOME/.elan/bin" >> "$GITHUB_PATH" + + - name: build cache + run: | + lake exe cache get + + # This reads the existing info in the bucket so that we only have to update whats changed + # If the bucket is empty we will have to build from scratch. + - name: restore Physlib's own cache + env: + LAKE_CONFIG: ${{ github.workspace }}/lake-cache.toml + run: | + lake cache get --scope="$CACHE_SCOPE" || echo "no existing cache to restore -- building from scratch" + + - name: build Physlib + run: | + bash -o pipefail -c "env LEAN_ABORT_ON_PANIC=1 lake build -KCI | tee stdout.log" + + # `--no-build` here does not build anything; it emits the + # input-to-output mappings for what was just built. + - name: stage build outputs for the cache + id: stage + continue-on-error: true + run: | + set -euo pipefail + mkdir -p ../lake-cache-staging + lake build --no-build -KCI -o .lake/outputs.jsonl + echo "mappings: $(wc -l < .lake/outputs.jsonl) entries" + lake cache stage .lake/outputs.jsonl ../lake-cache-staging + echo "staged: $(find ../lake-cache-staging -name '*.ltar' | wc -l) ltar files" + + - name: publish to R2 cache + id: publish + if: steps.stage.outcome == 'success' + continue-on-error: true + env: + LAKE_CACHE_KEY_RAW: ${{ secrets.LAKE_CACHE_KEY }} + LAKE_CONFIG: ${{ github.workspace }}/lake-cache.toml + run: | + set -euo pipefail + # GitHub secrets commonly carry a trailing newline, which breaks the + # SigV4 signature. Trim it, and mask the value so it cannot surface + # in logs. + KEY="$(printf %s "$LAKE_CACHE_KEY_RAW" | sed -e 's/[[:space:]]*$//')" + echo "::add-mask::$KEY" + export LAKE_CACHE_KEY="$KEY" + + lake cache put-staged ../lake-cache-staging \ + --scope="$CACHE_SCOPE" \ + --rev="${{ github.sha }}" + + - name: warn if cache publish failed + if: steps.stage.outcome == 'failure' || steps.publish.outcome == 'failure' + run: echo "::warning::Physlib build cache was not published this run (staging or upload failed). Contributors will fall back to compiling from source until the next successful push." + + physlib_alpha: + name: PhyslibAlpha + needs: gate + if: needs.gate.outputs.has_key == 'true' + runs-on: ubuntu-latest + env: + LAKE_CACHE_DIR: .lake/cache + steps: + # Full history, see the physlib job above + - uses: actions/checkout@v4 + with: + fetch-depth: 0 + + # Own scope, so this job does not overwrite the physlib job's mappings. + - name: compute cache scope + run: | + set -euo pipefail + TC="$(tr '/:' '--' < lean-toolchain | tr -d '[:space:]')" + echo "CACHE_SCOPE=physlib-master/$TC/alpha" >> "$GITHUB_ENV" + + - name: Install elan + run: | + set -o pipefail + curl https://raw.githubusercontent.com/leanprover/elan/master/elan-init.sh -sSf | sh -s -- --default-toolchain none -y + ~/.elan/bin/lean --version + echo "$HOME/.elan/bin" >> "$GITHUB_PATH" + + - name: build cache + run: | + lake exe cache get + + # See the physlib job's "restore Physlib's own cache" step -- same + # idea, seeding from this job's own scope before its build. + - name: restore PhyslibAlpha's own cache + env: + LAKE_CONFIG: ${{ github.workspace }}/lake-cache.toml + run: | + lake cache get --scope="$CACHE_SCOPE" || echo "no existing cache to restore -- building from scratch" + + - name: build PhyslibAlpha + run: | + bash -o pipefail -c "env LEAN_ABORT_ON_PANIC=1 lake build -KCI PhyslibAlpha | tee stdout.log" + + # Stage the cache so it can be pushed to the bucket + - name: stage build outputs for the cache + id: stage + continue-on-error: true + run: | + set -euo pipefail + mkdir -p ../lake-cache-staging + lake build --no-build -KCI PhyslibAlpha -o .lake/outputs.jsonl + echo "mappings: $(wc -l < .lake/outputs.jsonl) entries" + lake cache stage .lake/outputs.jsonl ../lake-cache-staging + echo "staged: $(find ../lake-cache-staging -name '*.ltar' | wc -l) ltar files" + + - name: publish to R2 cache + id: publish + if: steps.stage.outcome == 'success' + continue-on-error: true + env: + LAKE_CACHE_KEY_RAW: ${{ secrets.LAKE_CACHE_KEY }} + LAKE_CONFIG: ${{ github.workspace }}/lake-cache.toml + run: | + set -euo pipefail + KEY="$(printf %s "$LAKE_CACHE_KEY_RAW" | sed -e 's/[[:space:]]*$//')" + echo "::add-mask::$KEY" + export LAKE_CACHE_KEY="$KEY" + + lake cache put-staged ../lake-cache-staging \ + --scope="$CACHE_SCOPE" \ + --rev="${{ github.sha }}" + + - name: warn if cache publish failed + if: steps.stage.outcome == 'failure' || steps.publish.outcome == 'failure' + run: echo "::warning::PhyslibAlpha build cache was not published this run." diff --git a/.github/workflows/review_claim.yml b/.github/workflows/review_claim.yml new file mode 100644 index 0000000000..aac585c616 --- /dev/null +++ b/.github/workflows/review_claim.yml @@ -0,0 +1,86 @@ +# Review claims: `claim` / `disclaim` commands on a pull request. +# +# To avoid two reviewers (human or AI) picking up the same PR, a reviewer says +# what they intend to review and claims it: +# +# claim -- claim this PR for review, for the default window +# claim 5 days -- ... for a specific window (hours / days / weeks) +# claim 2026-08-01 -- ... until a specific date +# disclaim -- release the claim early +# +# The bot assigns the claimant, applies the `review-claimed` label and keeps a +# single status comment recording the deadline. Claiming again extends the +# window; submitting a review completes the claim. Stale claims are released +# automatically by `review_claim_expiry.yml`, so nothing stays blocked forever. +# +# A claim is cooperative, not a lock: it signals intent so that others can steer +# around it, and anyone remains free to review the PR. +# +# As in `labels_from_comment.yml`, a command is a whole line of the comment, so +# that a comment merely discussing claims does not trigger one. Commands need +# no repository permissions -- anyone can claim a review. +# +# The work itself is in `scripts/review_claim.py`. + +name: Review claims + +on: + issue_comment: + types: [created] + pull_request_review: + types: [submitted] + +# Limit permissions for GITHUB_TOKEN for the entire workflow +permissions: + contents: read + issues: write # Only allow issue/PR comments, labels and reactions + pull-requests: write # Only allow PR comments/labels/assignees + # All other permissions are implicitly 'none' + +jobs: + command: + name: Handle claim command + runs-on: ubuntu-latest + # Cheap prefilter: only comments on PRs, and only ones that mention a command + # at all, reach the checkout below. `disclaim` contains `claim`, so one test + # covers both; the capitalised variant is here because expressions have no + # case-insensitive compare, while the parser itself accepts any casing. + # + # Don't run on forks, where we wouldn't have permission to act on the PR anyway. + if: >- + github.repository == 'leanprover-community/physlib' && + github.event_name == 'issue_comment' && + github.event.issue.pull_request && + github.event.comment.user.type != 'Bot' && + (contains(github.event.comment.body, 'claim') || + contains(github.event.comment.body, 'Claim')) + steps: + - name: Check out the claim script + uses: actions/checkout@v7.0.0 + with: + sparse-checkout: scripts/review_claim.py + sparse-checkout-cone-mode: false + persist-credentials: false + - name: Claim or disclaim + run: python3 scripts/review_claim.py comment + env: + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + + complete: + name: Complete claim on review + runs-on: ubuntu-latest + # Don't run on forks, where we wouldn't have permission to act on the PR anyway. + if: >- + github.repository == 'leanprover-community/physlib' && + github.event_name == 'pull_request_review' + steps: + - name: Check out the claim script + uses: actions/checkout@v7.0.0 + with: + sparse-checkout: scripts/review_claim.py + sparse-checkout-cone-mode: false + persist-credentials: false + - name: Clear the claim once its claimant has reviewed + run: python3 scripts/review_claim.py review + env: + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} diff --git a/.github/workflows/review_claim_expiry.yml b/.github/workflows/review_claim_expiry.yml new file mode 100644 index 0000000000..d5fd314047 --- /dev/null +++ b/.github/workflows/review_claim_expiry.yml @@ -0,0 +1,57 @@ +# Gives review claims a time to live, so that nothing stays blocked forever. +# +# A reviewer claims a PR by commenting `claim` (see `review_claim.yml`). This +# workflow runs hourly and, for every PR carrying the `review-claimed` label: +# +# * @-mentions the claimant 48h and then 24h before the deadline, skipping a +# reminder that is not shorter than the window they asked for; +# * once the deadline passes, completes the claim quietly if they did review +# in time, and otherwise releases it -- dropping the label and taking the +# claimant off the PR as reviewer and assignee -- announcing the release on +# Zulip so that somebody else picks the PR up. +# +# The deadline is read back out of the claim's status comment, so extending a +# claim (`claim` again) moves the deadline and resets its reminders with it. +# +# The work itself is in `scripts/review_claim.py`. + +name: Expire review claims + +on: + schedule: + # hourly, so a deadline or a reminder is never overshot by more than an hour + - cron: '0 * * * *' + workflow_dispatch: + +# Limit permissions for GITHUB_TOKEN for the entire workflow +permissions: + contents: read + issues: write # Only allow reading/labelling issues + pull-requests: write # Only allow PR comments/labels/assignees + # All other permissions are implicitly 'none' + +jobs: + expire: + name: Expire review claims + runs-on: ubuntu-latest + # Don't run on forks, where we wouldn't have permission to act on the PR anyway. + if: github.repository == 'leanprover-community/physlib' + steps: + - name: Check out the claim script + uses: actions/checkout@v7.0.0 + with: + sparse-checkout: scripts/review_claim.py + sparse-checkout-cone-mode: false + persist-credentials: false + - name: Remind and expire + run: python3 scripts/review_claim.py expire + env: + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + # Same bot credentials as the Physlib Zulip bots. Missing secrets + # downgrade to a warning rather than failing the job: releasing the + # claim on GitHub matters more than announcing it. + ZULIP_SITE: ${{ secrets.ZULIP_SITE }} + ZULIP_BOT_EMAIL: ${{ secrets.ZULIP_BOT_EMAIL }} + ZULIP_BOT_API_KEY: ${{ secrets.ZULIP_BOT_API_KEY }} + ZULIP_STREAM: ${{ secrets.ZULIP_STREAM }} + ZULIP_TOPIC: PR reviews diff --git a/AGENTS.md b/AGENTS.md index c3937eec38..73bc0d0a48 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -58,8 +58,8 @@ When a long proof cannot be split, make sure it contains comments. - Check `./scripts/lint-style.sh`, but **commit your changes first**; this linter reads committed state. - If edited a `PhyslibAlpha` file, check the following: - `lake exe runPhyslibAlphaLinters` - - `./scripts/PhyslibAlpha/alphaFileImports.py` - - `./scripts/PhyslibAlpha/noAlphaImports.py` + - `lake exe noAlphaImports` + - `lake exe alphaFileImports` - `./scripts/PhyslibAlpha/alphaPythonLinters.sh` ## PR scope diff --git a/Physlib.lean b/Physlib.lean index 5d704d8935..0ca71f8760 100644 --- a/Physlib.lean +++ b/Physlib.lean @@ -5,6 +5,7 @@ public import Physlib.ClassicalMechanics.Basic public import Physlib.ClassicalMechanics.DampedHarmonicOscillator.Basic public import Physlib.ClassicalMechanics.DampedHarmonicOscillator.Solution public import Physlib.ClassicalMechanics.EulerLagrange +public import Physlib.ClassicalMechanics.Force public import Physlib.ClassicalMechanics.FreeParticle.Basic public import Physlib.ClassicalMechanics.HamiltonsEquations public import Physlib.ClassicalMechanics.HarmonicOscillator.Basic @@ -17,7 +18,19 @@ public import Physlib.ClassicalMechanics.Mass.MassUnit public import Physlib.ClassicalMechanics.OrbitalMechanics.VisViva public import Physlib.ClassicalMechanics.Pendulum.CoplanarDoublePendulum public import Physlib.ClassicalMechanics.Pendulum.MiscellaneousPendulumPivotMotions +public import Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Basic +public import Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Equilibria +public import Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Geometric.Basic +public import Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Geometric.PhysicalSpace +public import Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Geometric.Trajectory +public import Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Hamiltonian +public import Physlib.ClassicalMechanics.Pendulum.SimplePendulum.LiftInvariance +public import Physlib.ClassicalMechanics.Pendulum.SimplePendulum.PeriodFormula +public import Physlib.ClassicalMechanics.Pendulum.SimplePendulum.SmallAngle +public import Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Solution public import Physlib.ClassicalMechanics.Pendulum.SlidingPendulum +public import Physlib.ClassicalMechanics.PointParticle.Basic +public import Physlib.ClassicalMechanics.PointParticle.NewtonianSystem.Basic public import Physlib.ClassicalMechanics.RigidBody.AngularMomentum public import Physlib.ClassicalMechanics.RigidBody.AngularVelocity public import Physlib.ClassicalMechanics.RigidBody.Basic @@ -28,9 +41,15 @@ public import Physlib.ClassicalMechanics.Scattering.RigidSphere public import Physlib.ClassicalMechanics.Vibrations.LinearTriatomic public import Physlib.ClassicalMechanics.WaveEquation.Basic public import Physlib.ClassicalMechanics.WaveEquation.HarmonicWave +public import Physlib.CondensedMatter.BandTheory.Basic public import Physlib.CondensedMatter.Basic +public import Physlib.CondensedMatter.Crystal.Basic +public import Physlib.CondensedMatter.LatticeModels.Basic +public import Physlib.CondensedMatter.ManyBody.Basic +public import Physlib.CondensedMatter.Response.Basic public import Physlib.CondensedMatter.Thermoelectric.Basic public import Physlib.CondensedMatter.TightBindingChain.Basic +public import Physlib.CondensedMatter.Topology.Basic public import Physlib.Cosmology.Basic public import Physlib.Cosmology.FLRW.Basic public import Physlib.Cosmology.FLRW.ConformalTime @@ -91,8 +110,10 @@ public import Physlib.FluidDynamics.FluidFlow.Newtonian public import Physlib.FluidDynamics.ThermodynamicCauchyFlow.Basic public import Physlib.FluidDynamics.ThermodynamicCauchyFlow.Bernoulli public import Physlib.FluidDynamics.ThermodynamicCauchyFlow.Isentropic +public import Physlib.LatticeQFT.Basic public import Physlib.Mathematics.Calculus.AdjFDeriv public import Physlib.Mathematics.Calculus.Divergence +public import Physlib.Mathematics.Calculus.Gradient public import Physlib.Mathematics.Calculus.ParametricIntegration public import Physlib.Mathematics.Calculus.Wirtinger.Basic public import Physlib.Mathematics.Calculus.Wirtinger.Coordinate @@ -109,6 +130,7 @@ public import Physlib.Mathematics.Fin public import Physlib.Mathematics.Fin.Involutions public import Physlib.Mathematics.Geometry.Metric.PseudoRiemannian.Defs public import Physlib.Mathematics.Geometry.Metric.Riemannian.Defs +public import Physlib.Mathematics.HasTemperateGrowth public import Physlib.Mathematics.InnerProductSpace.Adjoint public import Physlib.Mathematics.InnerProductSpace.Basic public import Physlib.Mathematics.InnerProductSpace.Calculus @@ -122,13 +144,17 @@ public import Physlib.Mathematics.LinearPMap public import Physlib.Mathematics.List public import Physlib.Mathematics.List.InsertIdx public import Physlib.Mathematics.List.InsertionSort +public import Physlib.Mathematics.OneParameterSubgroups.Basic +public import Physlib.Mathematics.OneParameterSubgroups.Unitary public import Physlib.Mathematics.OrthogonalMatrix public import Physlib.Mathematics.PiTensorProduct public import Physlib.Mathematics.RatComplexNum public import Physlib.Mathematics.Resolvent public import Physlib.Mathematics.SO3.Basic public import Physlib.Mathematics.SchurTriangulation +public import Physlib.Mathematics.SpecialFunctions.EllipticIntegral public import Physlib.Mathematics.SpecialFunctions.PhysHermite +public import Physlib.Mathematics.Trigonometry.SinSq public import Physlib.Mathematics.Trigonometry.Tanh public import Physlib.Mathematics.VariationalCalculus.Basic public import Physlib.Mathematics.VariationalCalculus.HasVarAdjDeriv @@ -301,13 +327,13 @@ public import Physlib.QFT.QED.AnomalyCancellation.VectorLike public import Physlib.QuantumMechanics.FiniteTarget public import Physlib.QuantumMechanics.FreeParticle.Basic public import Physlib.QuantumMechanics.HarmonicOscillator.Basic +public import Physlib.QuantumMechanics.HarmonicOscillator.Eigenstates public import Physlib.QuantumMechanics.HarmonicOscillator.LadderOperators public import Physlib.QuantumMechanics.HarmonicOscillator.OneDimension.Basic public import Physlib.QuantumMechanics.HarmonicOscillator.OneDimension.Completeness public import Physlib.QuantumMechanics.HarmonicOscillator.OneDimension.Eigenfunction public import Physlib.QuantumMechanics.HarmonicOscillator.OneDimension.Examples public import Physlib.QuantumMechanics.HarmonicOscillator.OneDimension.TISE -public import Physlib.QuantumMechanics.HilbertSpaces.CompleteTensorProduct public import Physlib.QuantumMechanics.HilbertSpaces.FiniteTarget.Basic public import Physlib.QuantumMechanics.HilbertSpaces.OneDimension.Basic public import Physlib.QuantumMechanics.HilbertSpaces.OneDimension.Gaussians @@ -317,9 +343,12 @@ public import Physlib.QuantumMechanics.HilbertSpaces.OneDimension.SchwartzSubmod public import Physlib.QuantumMechanics.HilbertSpaces.SpaceD.Basic public import Physlib.QuantumMechanics.HilbertSpaces.SpaceD.DirichletSubmodule public import Physlib.QuantumMechanics.HilbertSpaces.SpaceD.Fourier +public import Physlib.QuantumMechanics.HilbertSpaces.SpaceD.MomentumStates public import Physlib.QuantumMechanics.HilbertSpaces.SpaceD.PolyBddSchwartzSubmodule +public import Physlib.QuantumMechanics.HilbertSpaces.SpaceD.PositionStates public import Physlib.QuantumMechanics.HilbertSpaces.SpaceD.SchwartzSubmodule public import Physlib.QuantumMechanics.HilbertSpaces.SpaceD.SobolevSubmodule +public import Physlib.QuantumMechanics.HilbertSpaces.TensorProducts.CompleteTensorProduct public import Physlib.QuantumMechanics.Hydrogen.Basic public import Physlib.QuantumMechanics.Hydrogen.LaplaceRungeLenzVector public import Physlib.QuantumMechanics.InfiniteSquareWell.Basic @@ -345,9 +374,9 @@ public import Physlib.QuantumMechanics.Operators.StateObservables.Variance public import Physlib.QuantumMechanics.Operators.Unbounded public import Physlib.QuantumMechanics.Operators.Uncertainty public import Physlib.QuantumMechanics.PlanckConstant +public import Physlib.QuantumMechanics.PoschlTeller.Basic public import Physlib.QuantumMechanics.QuantumSystem.Basic public import Physlib.QuantumMechanics.RectangularBarrier.Basic -public import Physlib.QuantumMechanics.ReflectionlessPotential.Basic public import Physlib.QuantumMechanics.SpaceDQuantumSystem public import Physlib.Relativity.Bispinors.Basic public import Physlib.Relativity.CliffordAlgebra @@ -366,6 +395,7 @@ public import Physlib.Relativity.LorentzAlgebra.Basis public import Physlib.Relativity.LorentzAlgebra.ExponentialMap public import Physlib.Relativity.LorentzGroup.Basic public import Physlib.Relativity.LorentzGroup.Boosts.Apply +public import Physlib.Relativity.LorentzGroup.Boosts.Axis public import Physlib.Relativity.LorentzGroup.Boosts.Basic public import Physlib.Relativity.LorentzGroup.Boosts.Generalized public import Physlib.Relativity.LorentzGroup.Orthochronous.Basic @@ -381,6 +411,7 @@ public import Physlib.Relativity.PauliMatrices.CliffordAlgebra public import Physlib.Relativity.PauliMatrices.Relations public import Physlib.Relativity.PauliMatrices.SelfAdjoint public import Physlib.Relativity.PauliMatrices.ToTensor +public import Physlib.Relativity.SL2C.AxisRotations public import Physlib.Relativity.SL2C.Basic public import Physlib.Relativity.SL2C.SelfAdjoint public import Physlib.Relativity.Special.ProperTime @@ -418,6 +449,7 @@ public import Physlib.Relativity.Tensors.Dual public import Physlib.Relativity.Tensors.Elab public import Physlib.Relativity.Tensors.Evaluation public import Physlib.Relativity.Tensors.LeviCivita.Basic +public import Physlib.Relativity.Tensors.LeviCivita.Complex public import Physlib.Relativity.Tensors.LeviCivita.Contractions public import Physlib.Relativity.Tensors.MetricTensor public import Physlib.Relativity.Tensors.OfInt @@ -426,11 +458,13 @@ public import Physlib.Relativity.Tensors.RealTensor.Basic public import Physlib.Relativity.Tensors.RealTensor.CoVector.Basic public import Physlib.Relativity.Tensors.RealTensor.CoVector.Representation public import Physlib.Relativity.Tensors.RealTensor.CoVector.Tensorial +public import Physlib.Relativity.Tensors.RealTensor.Contraction.CrossToEnd public import Physlib.Relativity.Tensors.RealTensor.Matrix.Pre public import Physlib.Relativity.Tensors.RealTensor.Metrics.Basic public import Physlib.Relativity.Tensors.RealTensor.Metrics.Pre public import Physlib.Relativity.Tensors.RealTensor.Representation.Contraction public import Physlib.Relativity.Tensors.RealTensor.ToComplex +public import Physlib.Relativity.Tensors.RealTensor.Units.Basic public import Physlib.Relativity.Tensors.RealTensor.Units.Pre public import Physlib.Relativity.Tensors.RealTensor.Vector.Basic public import Physlib.Relativity.Tensors.RealTensor.Vector.Causality.Basic @@ -448,6 +482,7 @@ public import Physlib.Relativity.Tensors.TensorSpecies.Basic public import Physlib.Relativity.Tensors.Tensorial public import Physlib.Relativity.Tensors.UnitTensor public import Physlib.SpaceAndTime.GalileanGroup.Basic +public import Physlib.SpaceAndTime.ReferenceFrame public import Physlib.SpaceAndTime.Space.Basic public import Physlib.SpaceAndTime.Space.ConstantSliceDist public import Physlib.SpaceAndTime.Space.CrossProduct @@ -476,6 +511,7 @@ public import Physlib.SpaceAndTime.Space.Norm.IteratedLaplacian public import Physlib.SpaceAndTime.Space.Norm.Regularized public import Physlib.SpaceAndTime.Space.Origin public import Physlib.SpaceAndTime.Space.Slice +public import Physlib.SpaceAndTime.Space.SmoothFunctions public import Physlib.SpaceAndTime.Space.Translations public import Physlib.SpaceAndTime.SpaceTime.Basic public import Physlib.SpaceAndTime.SpaceTime.Boosts @@ -520,6 +556,7 @@ public import Physlib.Thermodynamics.Temperature.TemperatureUnits public import Physlib.Units.Basic public import Physlib.Units.Dimension public import Physlib.Units.Examples +public import Physlib.Units.Exponent public import Physlib.Units.FDeriv public import Physlib.Units.ISQBridge public import Physlib.Units.ISQDimensionBase diff --git a/Physlib/ClassicalFieldTheory/GaugeTheory/API-map.yaml b/Physlib/ClassicalFieldTheory/GaugeTheory/API-map.yaml index d883f96788..9531440d98 100644 --- a/Physlib/ClassicalFieldTheory/GaugeTheory/API-map.yaml +++ b/Physlib/ClassicalFieldTheory/GaugeTheory/API-map.yaml @@ -48,11 +48,11 @@ Requirements: - description: "Gauge invariance of the field strength under abelian U(1) gauge transformations" done: true - location: Physlib/Electromagnetism/Kinematics/GaugeTransformation.lean (toFieldStrength_gaugeTransform, fieldStrengthMatrix_gaugeTransform) + location: Physlib/Electromagnetism/Kinematics/GaugeTransformation.lean (toFieldStrength_gaugeTransform, toFieldStrength_eval_gaugeTransform) - description: "Pure-gauge (flat) configurations have vanishing curvature, and the bare gradient does not (necessity of the metric contraction)" done: true - location: Physlib/Electromagnetism/Kinematics/GaugeTransformation.lean (toFieldStrength_ofGradient, fieldStrengthMatrix_bareGradient_inl_inr, toFieldStrength_bareGradient_ne_zero) + location: Physlib/Electromagnetism/Kinematics/GaugeTransformation.lean (toFieldStrength_ofGradient, toFieldStrength_eval_bareGradient_inl_inr, toFieldStrength_bareGradient_ne_zero) - description: "Group structure of gauge transformations: identity shift and composition of successive shifts" done: true diff --git a/Physlib/ClassicalFieldTheory/Local/Variation.lean b/Physlib/ClassicalFieldTheory/Local/Variation.lean index 942899ddbf..bbf9a87ae3 100644 --- a/Physlib/ClassicalFieldTheory/Local/Variation.lean +++ b/Physlib/ClassicalFieldTheory/Local/Variation.lean @@ -28,6 +28,7 @@ predicate rather than introducing a second support calculus. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/ClassicalMechanics/DampedHarmonicOscillator/Basic.lean b/Physlib/ClassicalMechanics/DampedHarmonicOscillator/Basic.lean index 197c1de3d9..19fd33ab1f 100644 --- a/Physlib/ClassicalMechanics/DampedHarmonicOscillator/Basic.lean +++ b/Physlib/ClassicalMechanics/DampedHarmonicOscillator/Basic.lean @@ -80,13 +80,15 @@ In the `Solution` module: ## iv. References References for the damped harmonic oscillator include: -- Landau & Lifshitz, Mechanics, page 76, section 25. -- Goldstein, Classical Mechanics, Chapter 2. + +* Landau & Lifshitz, Mechanics, page 76, section 25. [ref: landau_mechanics] +* Goldstein, Classical Mechanics, Chapter 6, Section 6.5 (Forced Vibrations and the Effect of + Dissipative Forces). [ref: goldstein_classicalmechanics] References for the Caldirola–Kanai lagrangian include: -- Caldirola, Nuovo Cimento 18 (1941) 393. -- Kanai, Progress of Theoretical Physics 3 (1948) 440. +* Caldirola, Nuovo Cimento 18 (1941) 393. [ref: caldirola_1941] +* Kanai, Progress of Theoretical Physics 3 (1948) 440. [ref: kanai_1948] -/ @[expose] public section @@ -504,11 +506,6 @@ lagrangian, using that the gradient scales with the constant `exp (γ/m * t)`. -/ -private lemma gradient_const_mul {f : EuclideanSpace ℝ (Fin 1) → ℝ} {x : EuclideanSpace ℝ (Fin 1)} - (c : ℝ) (hf : DifferentiableAt ℝ f x) : - gradient (fun y => c * f y) x = c • gradient f x := by - simp [gradient, fderiv_const_mul hf, map_smul] - lemma gradient_lagrangian_position_eq (t : Time) (x v : EuclideanSpace ℝ (Fin 1)) : gradient (fun x => S.lagrangian t x v) x = -(exp (S.γ / S.m * t) * S.k) • x := by have hf : DifferentiableAt ℝ (fun y => S.toHarmonicOscillator.lagrangian t y v) x := by diff --git a/Physlib/ClassicalMechanics/DampedHarmonicOscillator/Solution.lean b/Physlib/ClassicalMechanics/DampedHarmonicOscillator/Solution.lean index 944d1b40ab..d4019935bf 100644 --- a/Physlib/ClassicalMechanics/DampedHarmonicOscillator/Solution.lean +++ b/Physlib/ClassicalMechanics/DampedHarmonicOscillator/Solution.lean @@ -49,9 +49,10 @@ case, polynomial for the critically damped case, and hyperbolic for the overdamp ## iv. References References for the damped harmonic oscillator include: -- Landau & Lifshitz, Mechanics, page 76, section 25. -- Goldstein, Classical Mechanics, Chapter 2. +* Landau & Lifshitz, Mechanics, page 76, section 25. [ref: landau_mechanics] +* Goldstein, Classical Mechanics, Chapter 6, Section 6.5 (Forced Vibrations and the Effect of + Dissipative Forces). [ref: goldstein_classicalmechanics] -/ @[expose] public section @@ -496,21 +497,6 @@ private lemma phaseVectorField_apply (a b : EuclideanSpace ℝ (Fin 1)) : S.phaseVectorField (a, b) = (b, (-(S.m⁻¹ * S.k)) • a + (-(S.m⁻¹ * S.γ)) • b) := by simp [phaseVectorField] -private lemma toRealCLE_symm_one : Time.toRealCLE.symm (1 : ℝ) = (1 : Time) := by - rw [ContinuousLinearEquiv.symm_apply_eq] - change (1 : ℝ) = (1 : Time).val - rw [Time.one_val] - -/-- Bridge from the time derivative to `HasDerivAt` for a curve reparametrised through the -canonical `ℝ ≃L[ℝ] Time` equivalence. -/ -private lemma hasDerivAt_comp_toRealCLE_symm (w : Time → EuclideanSpace ℝ (Fin 1)) (τ : ℝ) - (hw : DifferentiableAt ℝ w (Time.toRealCLE.symm τ)) : - HasDerivAt (fun τ : ℝ => w (Time.toRealCLE.symm τ)) - (∂ₜ w (Time.toRealCLE.symm τ)) τ := by - simpa [Function.comp_def, Time.deriv_eq, toRealCLE_symm_one] using - hw.hasFDerivAt.comp_hasDerivAt_of_eq τ - ((Time.toRealCLE.symm : ℝ →L[ℝ] Time).hasDerivAt) rfl - /-- The phase curve `τ ↦ (z t, ẋ t)` (with `t = toRealCLE.symm τ`) of a smooth solution `z` solves the first-order phase-space ODE with vector field `phaseVectorField`. -/ private lemma phaseCurve_hasDerivAt (z : Time → EuclideanSpace ℝ (Fin 1)) @@ -519,8 +505,8 @@ private lemma phaseCurve_hasDerivAt (z : Time → EuclideanSpace ℝ (Fin 1)) (S.phaseVectorField (z (Time.toRealCLE.symm τ), ∂ₜ z (Time.toRealCLE.symm τ))) τ := by rw [S.phaseVectorField_apply, ← S.acceleration_eq_of_equationOfMotion z hEOM (Time.toRealCLE.symm τ)] - exact (hasDerivAt_comp_toRealCLE_symm z τ (hz.differentiable (by simp) _)).prodMk - (hasDerivAt_comp_toRealCLE_symm (∂ₜ z) τ (deriv_differentiable_of_contDiff z hz _)) + exact (Time.hasDerivAt_comp_toRealCLE_symm z τ (hz.differentiable (by simp) _)).prodMk + (Time.hasDerivAt_comp_toRealCLE_symm (∂ₜ z) τ (deriv_differentiable_of_contDiff z hz _)) /-- Any two smooth solutions of the damped equation of motion with the same initial position and velocity are equal. -/ diff --git a/Physlib/ClassicalMechanics/Force.lean b/Physlib/ClassicalMechanics/Force.lean new file mode 100644 index 0000000000..ab50a79e3a --- /dev/null +++ b/Physlib/ClassicalMechanics/Force.lean @@ -0,0 +1,77 @@ +/- +Copyright (c) 2026 Raunak Chhatwal. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Raunak Chhatwal +-/ +module + +public import Mathlib.Data.Multiset.Fintype +public import Physlib.SpaceAndTime.ReferenceFrame +/-! +# Forces + +This module defines forces acting on objects, expressed in a reference frame. +A `Force` records its target and its vector value over time. An `InternalForce` +additionally records a distinct source object. + +The time-dependent vector describes the force acting on the target, without +prescribing how that force is determined. For example, a gravitational force can +be specified directly from the target's mass, while a constraint force can be +specified by its relation to the motion of the objects. Representing both by the +same type allows Newton's laws to be stated independently of the particular +interactions present. + +The reference frame appears in the type of a force's vector values, keeping their +coordinate dependence explicit. The definition lives in the +`ClassicalMechanics.ReferenceFrame` namespace to support dot notation such as +`frame.Force Object`, but also occupies a general name that future non-particle +Newtonian formalizations may need. + +The target type `Object` is therefore deliberately left arbitrary. Newtonian mechanics is +not limited to point particles, so this force representation is kept independent +of any particular model of matter, with the intention it may get generalized for +rigid body mechanics, continuum mechanics, or other Newtonian models in the future. +-/ + +@[expose] public noncomputable section + +open scoped BigOperators Classical + +namespace ClassicalMechanics.ReferenceFrame + +variable {d : ℕ} {frame : ReferenceFrame d} {Object : Type} + +/-- A time-dependent force acting on an object. -/ +structure Force (frame : ReferenceFrame d) (Object : Type) where + /-- The force vector. -/ + value : Time → frame.Vector + /-- The target object. -/ + target : Object + +instance : CoeFun (frame.Force Object) (fun _ => Time → frame.Vector) where + coe := Force.value + +/-- A force between two objects. -/ +structure InternalForce (frame : ReferenceFrame d) (Object : Type) extends frame.Force Object where + /-- The source object. -/ + source : Object + source_ne_target : source ≠ target + +instance : CoeFun (frame.InternalForce Object) (fun _ => Time → frame.Vector) where + coe force := force.value + +instance : Coe (frame.InternalForce Object) (frame.Force Object) where + coe := InternalForce.toForce + +/-- The equal-and-opposite force with source and target exchanged. -/ +def InternalForce.reverse (force : frame.InternalForce Object) : frame.InternalForce Object where + value := -force.value + target := force.source + source := force.target + source_ne_target := force.source_ne_target.symm + +/-- The net force on `object`. -/ +def netForce (object : Object) (internalForces : Multiset (frame.InternalForce Object)) + (externalForces : Multiset (frame.Force Object)) (t : Time) : frame.Vector := + let forces := internalForces.map InternalForce.toForce + externalForces + ∑ force : forces with force.1.target = object, force.1 t diff --git a/Physlib/ClassicalMechanics/FreeParticle/Basic.lean b/Physlib/ClassicalMechanics/FreeParticle/Basic.lean index 7609b89b3f..d9acf9d1e9 100644 --- a/Physlib/ClassicalMechanics/FreeParticle/Basic.lean +++ b/Physlib/ClassicalMechanics/FreeParticle/Basic.lean @@ -52,6 +52,7 @@ Newton’s law → zero acceleration → constant velocity → constant momentum ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/ClassicalMechanics/HamiltonsEquations.lean b/Physlib/ClassicalMechanics/HamiltonsEquations.lean index 71d0ed6d01..a1e79b5dde 100644 --- a/Physlib/ClassicalMechanics/HamiltonsEquations.lean +++ b/Physlib/ClassicalMechanics/HamiltonsEquations.lean @@ -21,9 +21,9 @@ applied to `(p, q)`. ## References -- G. J. Sussman and J. Wisdom, "Structure and Interpretation of Classical Mechanics", Section 3.1.2. - - +* G. J. Sussman and J. Wisdom, "Structure and Interpretation of Classical Mechanics", Section 3.1.2. + . + [ref: sussman_wisdom_sicm] -/ @[expose] public section diff --git a/Physlib/ClassicalMechanics/HarmonicOscillator/Basic.lean b/Physlib/ClassicalMechanics/HarmonicOscillator/Basic.lean index 7147a691cd..8100b914a6 100644 --- a/Physlib/ClassicalMechanics/HarmonicOscillator/Basic.lean +++ b/Physlib/ClassicalMechanics/HarmonicOscillator/Basic.lean @@ -7,6 +7,7 @@ module public import Physlib.ClassicalMechanics.EulerLagrange public import Physlib.ClassicalMechanics.HamiltonsEquations +public import Physlib.Mathematics.Calculus.Gradient public import Mathlib.Algebra.Order.Archimedean.Real.Hom /-! @@ -84,8 +85,13 @@ In the `Solution` module: ## iv. References References for the classical harmonic oscillator include: -- Landau & Lifshitz, Mechanics, page 58, section 21. +* Landau & Lifshitz, Mechanics, page 58, section 21. [ref: landau_mechanics] + +A reference for the geometric model of position/velocity discussed in a TODO below: + +* https://web.williams.edu/Mathematics/it3/texts/var_noether.pdf. + [ref: terek_variational_manifolds] -/ @[expose] public section @@ -99,7 +105,7 @@ TODO "Create a new file for the geometric model which properly models the positi configuration space and velocity as its tangent space, then show explicitly how this coordinate model is a simplification of the geometric model. A nice reference for such an analysis is: - https://web.williams.edu/Mathematics/it3/texts/var_noether.pdf" + https://web.williams.edu/Mathematics/it3/texts/var_noether.pdf [ref: terek_variational_manifolds]" /-! @@ -337,25 +343,6 @@ lemma contDiff_lagrangian (n : WithTop ℕ∞) : ContDiff ℝ n ↿S.lagrangian rw [lagrangian_eq] fun_prop -lemma toDual_symm_innerSL (x : EuclideanSpace ℝ (Fin 1)) : - (InnerProductSpace.toDual ℝ (EuclideanSpace ℝ (Fin 1))).symm (innerSL ℝ x) = x := - (InnerProductSpace.toDual ℝ (EuclideanSpace ℝ (Fin 1))).symm_apply_apply x - -lemma gradient_inner_self (x : EuclideanSpace ℝ (Fin 1)) : - gradient (fun y : EuclideanSpace ℝ (Fin 1) => ⟪y, y⟫_ℝ) x = (2 : ℝ) • x := by - refine ext_inner_right (𝕜 := ℝ) fun y => ?_ - unfold gradient - rw [InnerProductSpace.toDual_symm_apply, - fderiv_inner_apply (𝕜 := ℝ) differentiableAt_fun_id differentiableAt_fun_id] - simp [real_inner_comm, inner_smul_right, two_mul] - -lemma gradient_const_mul_inner_self (c : ℝ) (x : EuclideanSpace ℝ (Fin 1)) : - gradient (fun y : EuclideanSpace ℝ (Fin 1) => c * ⟪y, y⟫_ℝ) x = (2 * c) • x := by - unfold gradient - rw [fderiv_const_mul (by fun_prop) c, map_smul] - show c • gradient (fun y : EuclideanSpace ℝ (Fin 1) => ⟪y, y⟫_ℝ) x = (2 * c) • x - rw [gradient_inner_self, smul_smul, mul_comm] - /-! #### D.1.3. Gradients of the lagrangian @@ -365,18 +352,13 @@ position and velocity. -/ -private lemma gradient_add_const' {f : EuclideanSpace ℝ (Fin 1) → ℝ} {c : ℝ} - (x : EuclideanSpace ℝ (Fin 1)) : - gradient (fun y => f y + c) x = gradient f x := - congrArg (InnerProductSpace.toDual ℝ (EuclideanSpace ℝ (Fin 1))).symm (fderiv_add_const c) - lemma gradient_lagrangian_position_eq (t : Time) (x : EuclideanSpace ℝ (Fin 1)) (v : EuclideanSpace ℝ (Fin 1)) : gradient (fun x => lagrangian S t x v) x = - S.k • x := by have h_eq : (fun y : EuclideanSpace ℝ (Fin 1) => lagrangian S t y v) = fun y => (-(1 / (2 : ℝ)) * S.k) * ⟪y, y⟫_ℝ + (1 / (2 : ℝ) * S.m * ⟪v, v⟫_ℝ) := by funext y; simp only [lagrangian_eq]; ring - rw [h_eq, gradient_add_const', gradient_const_mul_inner_self] + rw [h_eq, gradient_add_const, gradient_const_mul_inner_self] module lemma gradient_lagrangian_velocity_eq (t : Time) (x : EuclideanSpace ℝ (Fin 1)) @@ -386,7 +368,7 @@ lemma gradient_lagrangian_velocity_eq (t : Time) (x : EuclideanSpace ℝ (Fin 1) fun y => ((1 / (2 : ℝ)) * S.m) * ⟪y, y⟫_ℝ + (-(1 / (2 : ℝ)) * S.k * ⟪x, x⟫_ℝ) := by funext y; simp only [lagrangian_eq]; ring change gradient (fun y : EuclideanSpace ℝ (Fin 1) => lagrangian S t x y) v = S.m • v - rw [h_eq, gradient_add_const', gradient_const_mul_inner_self] + rw [h_eq, gradient_add_const, gradient_const_mul_inner_self] module /-! @@ -679,7 +661,7 @@ lemma gradient_hamiltonian_position_eq (t : Time) (x : EuclideanSpace ℝ (Fin 1 simp only [hamiltonian_eq] ring change gradient (fun y : EuclideanSpace ℝ (Fin 1) => hamiltonian S t p y) x = S.k • x - rw [h_eq, gradient_add_const', gradient_const_mul_inner_self] + rw [h_eq, gradient_add_const, gradient_const_mul_inner_self] module lemma gradient_hamiltonian_momentum_eq (t : Time) (x : EuclideanSpace ℝ (Fin 1)) @@ -691,7 +673,7 @@ lemma gradient_hamiltonian_momentum_eq (t : Time) (x : EuclideanSpace ℝ (Fin 1 funext y simp only [hamiltonian_eq] change gradient (fun y : EuclideanSpace ℝ (Fin 1) => hamiltonian S t y x) p = (1 / S.m) • p - rw [h_eq, gradient_add_const', gradient_const_mul_inner_self] + rw [h_eq, gradient_add_const, gradient_const_mul_inner_self] module /-! diff --git a/Physlib/ClassicalMechanics/HarmonicOscillator/Geometric/Basic.lean b/Physlib/ClassicalMechanics/HarmonicOscillator/Geometric/Basic.lean index 6c6003aba3..a4392f4028 100644 --- a/Physlib/ClassicalMechanics/HarmonicOscillator/Geometric/Basic.lean +++ b/Physlib/ClassicalMechanics/HarmonicOscillator/Geometric/Basic.lean @@ -57,8 +57,8 @@ tangent-coordinate infrastructure is used by later geometric constructions on th ## iv. References -- Ivo Terek, Introductory Variational Calculus on Manifolds, page 1 (Section 1, Basic - definitions and examples). +* Ivo Terek, Introductory Variational Calculus on Manifolds, page 1 (Section 1, Basic definitions + and examples). [ref: terek_variational_manifolds] -/ @[expose] public section diff --git a/Physlib/ClassicalMechanics/HarmonicOscillator/Geometric/KineticEnergy.lean b/Physlib/ClassicalMechanics/HarmonicOscillator/Geometric/KineticEnergy.lean index ccdaf6bdd9..f2e492c6ea 100644 --- a/Physlib/ClassicalMechanics/HarmonicOscillator/Geometric/KineticEnergy.lean +++ b/Physlib/ClassicalMechanics/HarmonicOscillator/Geometric/KineticEnergy.lean @@ -48,7 +48,8 @@ In coordinates this gives the standard expression ## iv. References -- Ivo Terek, Introductory Variational Calculus on Manifolds, pages 1-2. +* Ivo Terek, Introductory Variational Calculus on Manifolds, pages 1-2. + [ref: terek_variational_manifolds] -/ @[expose] public section diff --git a/Physlib/ClassicalMechanics/HarmonicOscillator/Geometric/Trajectory.lean b/Physlib/ClassicalMechanics/HarmonicOscillator/Geometric/Trajectory.lean index af6f0d4c53..4b67ff9e74 100644 --- a/Physlib/ClassicalMechanics/HarmonicOscillator/Geometric/Trajectory.lean +++ b/Physlib/ClassicalMechanics/HarmonicOscillator/Geometric/Trajectory.lean @@ -40,8 +40,8 @@ trajectory be tested as ordinary smoothness of its coordinate curve. ## iv. References -- Ivo Terek, Introductory Variational Calculus on Manifolds, pages 1-2 (Section 1, Basic - definitions and examples). +* Ivo Terek, Introductory Variational Calculus on Manifolds, pages 1-2 (Section 1, Basic definitions + and examples). [ref: terek_variational_manifolds] -/ @[expose] public section diff --git a/Physlib/ClassicalMechanics/HarmonicOscillator/Solution.lean b/Physlib/ClassicalMechanics/HarmonicOscillator/Solution.lean index 1fb84c320d..da7ee06119 100644 --- a/Physlib/ClassicalMechanics/HarmonicOscillator/Solution.lean +++ b/Physlib/ClassicalMechanics/HarmonicOscillator/Solution.lean @@ -64,8 +64,8 @@ prove that they satisfy the equation of motion, and prove some properties of the ## iv. References References for the classical harmonic oscillator include: -- Landau & Lifshitz, Mechanics, page 58, section 21. +* Landau & Lifshitz, Mechanics, page 58, section 21. [ref: landau_mechanics] -/ TODO "Split this file into smaller modules, keeping `Solution.lean` as an umbrella import. diff --git a/Physlib/ClassicalMechanics/Lagrangian/TotalDerivativeEquivalence.lean b/Physlib/ClassicalMechanics/Lagrangian/TotalDerivativeEquivalence.lean index 6bc2d46457..356a2561b8 100644 --- a/Physlib/ClassicalMechanics/Lagrangian/TotalDerivativeEquivalence.lean +++ b/Physlib/ClassicalMechanics/Lagrangian/TotalDerivativeEquivalence.lean @@ -54,9 +54,8 @@ This is because: ## iv. References -- Landau & Lifshitz, "Mechanics", §2 (The principle of least action) -- Landau & Lifshitz, "Mechanics", §4 (The Lagrangian for a free particle) - +* Landau & Lifshitz, "Mechanics", §2 (The principle of least action). [ref: landau_mechanics] +* Landau & Lifshitz, "Mechanics", §4 (The Lagrangian for a free particle). [ref: landau_mechanics] -/ @[expose] public section diff --git a/Physlib/ClassicalMechanics/Mass/MassUnit.lean b/Physlib/ClassicalMechanics/Mass/MassUnit.lean index 2c05994584..71a7ea4a8a 100644 --- a/Physlib/ClassicalMechanics/Mass/MassUnit.lean +++ b/Physlib/ClassicalMechanics/Mass/MassUnit.lean @@ -23,6 +23,10 @@ To define specific mass units, we first state the existence of a a given mass unit, and then construct all other mass units from it. We choose to state the existence of the mass unit of kilograms, and construct all other mass units from that. +## References + +* The numerical value used for the nominal solar mass. [ref: nominal_solar_mass_article] + -/ @[expose] public section @@ -79,9 +83,13 @@ lemma div_self (x : MassUnit) : lemma div_symm (x y : MassUnit) : x / y = (y / x)⁻¹ := NNReal.eq <| by - rw [div_eq_val, inv_eq_one_div, div_eq_val] - simp only [one_div, NNReal.coe_inv] - rw [toReal, inv_div] + show x.val / y.val = (y.val / x.val)⁻¹ + rw [inv_div] + +/-- The unit-ratio cocycle at `ℝ≥0` (the un-coerced form of `div_mul_div_coe`). -/ +lemma div_mul_div (x y z : MassUnit) : (x / y) * (y / z) = x / z := NNReal.eq <| by + show x.val / y.val * (y.val / z.val) = x.val / z.val + rw [div_mul_div_comm, mul_comm x.val y.val, mul_div_mul_left _ _ y.val_ne_zero] @[simp] lemma div_mul_div_coe (x y z : MassUnit) : @@ -103,6 +111,7 @@ def scale (r : ℝ) (x : MassUnit) (hr : 0 < r := by norm_num) : MassUnit := lemma scale_div_self (x : MassUnit) (r : ℝ) (hr : 0 < r) : scale r x hr / x = (⟨r, le_of_lt hr⟩ : ℝ≥0) := by simp [scale, div_eq_val] + rfl @[simp] lemma self_div_scale (x : MassUnit) (r : ℝ) (hr : 0 < r) : @@ -118,9 +127,8 @@ lemma scale_one (x : MassUnit) : scale 1 x = x := by lemma scale_div_scale (x1 x2 : MassUnit) {r1 r2 : ℝ} (hr1 : 0 < r1) (hr2 : 0 < r2) : scale r1 x1 hr1 / scale r2 x2 hr2 = (⟨r1, le_of_lt hr1⟩ / ⟨r2, le_of_lt hr2⟩) * (x1 / x2) := by refine NNReal.eq ?_ - simp [scale, div_eq_val] - rw [toReal] - field_simp + show r1 * x1.val / (r2 * x2.val) = r1 / r2 * (x1.val / x2.val) + rw [div_mul_div_comm] @[simp] lemma scale_scale (x : MassUnit) (r1 r2 : ℝ) (hr1 : 0 < r1) (hr2 : 0 < r2) : @@ -177,7 +185,7 @@ noncomputable def metricTons : MassUnit := scale (1000) kilograms noncomputable def longTons : MassUnit := scale (2240) pounds /-- The mass unit of nominal solar masses (1.988416 × 10 ^ 30 kilograms). - See: https://iopscience.iop.org/article/10.3847/0004-6256/152/2/41 -/ + See: https://iopscience.iop.org/article/10.3847/0004-6256/152/2/41 [ref: nominal_solar_mass_article] -/ noncomputable def nominalSolarMasses : MassUnit := scale (1.988416e30) kilograms /-! @@ -187,7 +195,10 @@ noncomputable def nominalSolarMasses : MassUnit := scale (1.988416e30) kilograms -/ lemma pounds_div_ounces : pounds / ounces = (16 : ℝ≥0) := NNReal.eq <| by - simp [pounds, ounces]; rw [toReal]; norm_num + simp [pounds, ounces] + show (0.45359237 : ℝ) / 0.028349523125 = ((16 : ℝ≥0) : ℝ) + push_cast + norm_num lemma shortTons_div_kilograms : shortTons / kilograms = (907.18474 : ℝ≥0) := NNReal.eq <| by simp [shortTons, pounds]; rw [toReal]; norm_num diff --git a/Physlib/ClassicalMechanics/Pendulum/API-map.yaml b/Physlib/ClassicalMechanics/Pendulum/API-map.yaml index cebdc018a3..7183e64439 100644 --- a/Physlib/ClassicalMechanics/Pendulum/API-map.yaml +++ b/Physlib/ClassicalMechanics/Pendulum/API-map.yaml @@ -9,13 +9,15 @@ Overview: | covers the pendulum problems of Landau and Lifshitz, Mechanics, 3rd ed., Chapter 1, Section 5. - At present only the sliding pendulum has a defined configuration space, with - the horizontal support position and the string angle as its generalized - coordinates. The coplanar double pendulum's configuration space is declared but - not yet defined, and the miscellaneous pivot-motion problems have documentation - only. The remaining requirements, a manifold structure on the configuration - space, a map into real space, trajectories, and the lagrangian, are open and - recorded below with location N/A. + The sliding pendulum has a defined configuration space in the generalized coordinates of the + support position and the string angle. The simple pendulum's configuration space, an angle + modulo a full turn, carries the manifold structure and the map into `Space`; it has its own API + map in `Physlib/ClassicalMechanics/Pendulum/SimplePendulum`. The coplanar double pendulum's + configuration space is declared but not yet defined, and the miscellaneous pivot-motion problems + have documentation only. The simple pendulum's Lagrangian and equation of motion on the + Euclidean lift are recorded in its own API map; the trajectory based on the configuration + space, and the identification of the lifted Lagrangian with that of the bob in physical + space, are recorded below. ParentAPIs: - Classical mechanics Lagrangian (Physlib/ClassicalMechanics/Lagrangian) @@ -33,20 +35,18 @@ Requirements: done: true location: Physlib/ClassicalMechanics/Pendulum/SlidingPendulum.lean (ConfigurationSpace) - - description: The API shall contain the structure of a manifold on the configuration space. - done: false - location: "N/A" + - description: The API contains the structure of a manifold on the configuration space (for the simple pendulum). + done: true + location: Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Geometric/Basic.lean (SimplePendulum.ConfigurationSpace.instIsManifold) - - description: > - The API shall contain a map from the configuration space to `Space`, giving the - position of the pendulum in real space. - done: false - location: "N/A" - - - description: The API shall contain the definition of a trajectory based on the configuration space. - done: false - location: "N/A" - - - description: The API shall subsequently contain the definition of the lagrangian. - done: false - location: "N/A" + - description: The API contains a map from the configuration space to `Space`, giving the position of the pendulum in real space (for the simple pendulum). + done: true + location: Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Geometric/Basic.lean (SimplePendulum.ConfigurationSpace.toSpace) + + - description: The API contains the definition of a trajectory based on the configuration space. + done: true + location: Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Geometric/Trajectory.lean (SimplePendulum.Trajectory, SimplePendulum.Trajectory.ofLift) + + - description: The API subsequently contains the definition of the lagrangian. + done: true + location: Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Basic.lean (SimplePendulum.lagrangian); Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Geometric/PhysicalSpace.lean (SimplePendulum.lagrangian_eq_space) diff --git a/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/API-map.yaml b/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/API-map.yaml new file mode 100644 index 0000000000..0f977e6f44 --- /dev/null +++ b/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/API-map.yaml @@ -0,0 +1,100 @@ +version: v0.1 + +Title: Simple pendulum + +Overview: | + A simple pendulum is a bob on a rigid massless rod of length ℓ, pinned at a pivot and swinging + in a vertical plane under gravity g. Its configuration is the angle of the rod from the downward + vertical, taken modulo a full turn, so the configuration space is a circle; the position of the + bob in the plane is (ℓ sin θ, −ℓ cos θ). The motion is governed by θ̈ + (g/ℓ) sin θ = 0. For + small amplitudes it is harmonic with period 2π√(ℓ/g); for librations (amplitudes below the + inverted position) the period grows with the amplitude and is given by a complete elliptic + integral. This API records the configuration space with its manifold structure and its + embedding into physical space, together with the lifted Lagrangian and equation of motion, + the equivalence of that equation with the vanishing of the variational gradient of the + action, the conservation of energy, the Hamiltonian formulation with the equivalence of + the Newtonian, scalar, Hamiltonian and variational formulations, the equilibria with + the separatrix energy and the below/above-threshold energy bounds, the invariance of + the lifted dynamics under shifting the angle by whole turns, + the uniqueness of the solutions with given initial angle and + angular velocity together with their time-reversal symmetry, and, for any initial data, a + curve with that initial data satisfying the equation of motion within ε of the initial + instant, and the small-angle limit — + the linearized dynamics as a harmonic oscillator, its period 2π√(ℓ/g), and the cubic bound + on the linearization error — and the classical amplitude-dependent period formula + 4√(ℓ/g) K(sin²(θ₀/2)), with its small-angle limit and its monotonicity and bounds in the + amplitude; its identification with the nonlinear return time remains open. + +ParentAPIs: + - "Space (Physlib/SpaceAndTime/Space)" + - "Configuration space for pendulum (Physlib/ClassicalMechanics/Pendulum)" + +References: + - Landau & Lifshitz, Mechanics, 3rd Edition, Chapter 1 (The Equations of motion), Section 5 (The Lagrangian for a system of particles). + - Landau & Lifshitz, Mechanics, 3rd Edition, Chapter 3 (Integration of the equations of motion), Section 11 (Motion in one dimension), Problem 1 (the period of the pendulum as a complete elliptic integral). + - Landau & Lifshitz, Mechanics, 3rd Edition, Chapter 5 (Small oscillations), Section 21 (Free oscillations in one dimension). + - Landau & Lifshitz, Mechanics, 3rd Edition, Chapter 7 (The canonical equations), Section 40 (Hamilton's equations). + +Requirements: + + - description: The key data structure, the configuration space of the simple pendulum, is defined as the angle of the rod from the downward vertical modulo a full turn. + done: true + location: Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Geometric/Basic.lean (SimplePendulum.ConfigurationSpace, SimplePendulum.ConfigurationSpace.circleHomeomorph) + + - description: The API contains the structure of a manifold on the configuration space. + done: true + location: Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Geometric/Basic.lean (SimplePendulum.ConfigurationSpace.instChartedSpace, SimplePendulum.ConfigurationSpace.instIsManifold) + + - description: The API contains the angular lift from the real line to the configuration space, periodic with period 2π. + done: true + location: Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Geometric/Basic.lean (SimplePendulum.ConfigurationSpace.ofAngle, SimplePendulum.ConfigurationSpace.ofAngle_periodic, SimplePendulum.ConfigurationSpace.ofAngle_eq_iff) + + - description: The API contains a map from the configuration space to `Space`, giving the position of the bob in real space, together with the rod-length constraint. + done: true + location: Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Geometric/Basic.lean (SimplePendulum.ConfigurationSpace.toSpace, SimplePendulum.ConfigurationSpace.toSpace_ofAngle, SimplePendulum.ConfigurationSpace.toSpace_norm) + + - description: The API shall contain the definition of a trajectory based on the configuration space. + done: false + location: N/A + + - description: The API contains the Lagrangian of the simple pendulum and its equation of motion. + done: true + location: Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Basic.lean (SimplePendulum.lagrangian, SimplePendulum.torque, SimplePendulum.EquationOfMotion, SimplePendulum.equationOfMotion_iff_scalar) + + - description: The API contains the equivalence of the equation of motion with the vanishing of the variational gradient of the action, and energy conservation. + done: true + location: Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Basic.lean (SimplePendulum.equationOfMotion_iff_gradLagrangian_zero, SimplePendulum.energy_conservation_of_equationOfMotion) + + - description: The API contains the Hamiltonian formulation and the equivalence of the Newtonian, scalar, Hamiltonian and variational formulations. + done: true + location: Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Hamiltonian.lean (SimplePendulum.hamiltonian, SimplePendulum.hamiltonEqOp, SimplePendulum.equationOfMotion_tfae) + + - description: The API contains the equilibria of the pendulum as solutions, together with the separatrix energy and the below/above-threshold energy bounds. + done: true + location: Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Equilibria.lean (SimplePendulum.equationOfMotion_const_zero, SimplePendulum.equationOfMotion_const_pi, SimplePendulum.isSolution_const_zero, SimplePendulum.isSolution_const_pi, SimplePendulum.separatrixEnergy, SimplePendulum.neg_one_lt_cos_of_energy_lt, SimplePendulum.deriv_ne_zero_of_energy_gt) + + - description: The API contains the invariance of the lifted dynamics under shifting the angle by whole turns. + done: true + location: Physlib/ClassicalMechanics/Pendulum/SimplePendulum/LiftInvariance.lean (SimplePendulum.equationOfMotion_add_int_mul_two_pi, SimplePendulum.energy_add_int_mul_two_pi, SimplePendulum.isSolution_add_int_mul_two_pi) + - description: The API contains the uniqueness of the solutions with given initial angle and angular velocity, and the time-reversal symmetry of the solutions. + done: true + location: Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Solution.lean (SimplePendulum.phaseVectorField, SimplePendulum.equationOfMotion_unique, SimplePendulum.IsSolution.eq_of_initial, SimplePendulum.isSolution_comp_neg, SimplePendulum.releasedFromRest_even) + - description: The API contains, for any initial angle and angular velocity, a curve with that initial data satisfying the equation of motion within ε of the initial instant. + done: true + location: Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Solution.lean (SimplePendulum.exists_local_solution) + + - description: The API contains the small-angle limit, in which the pendulum is a harmonic oscillator of mass m ℓ² and spring constant m g ℓ, with the equivalence of the linearized equation of motion with the oscillator's, the existence and uniqueness of the small-angle motions, and the small-angle period 2π√(ℓ/g). + done: true + location: Physlib/ClassicalMechanics/Pendulum/SimplePendulum/SmallAngle.lean (SimplePendulum.toHarmonicOscillator, SimplePendulum.linearizedEquationOfMotion_iff, SimplePendulum.smallAngleTrajectory_linearizedEquationOfMotion, SimplePendulum.linearized_unique, SimplePendulum.smallAnglePeriod_eq) + + - description: The API contains the relation between the full and the linearized dynamics, with the cubic bound m g ℓ |θ|³/6 on the linearization error of the torque and the identification of the difference of the variational gradients of the two actions with the difference of torque and linearized force. + done: true + location: Physlib/ClassicalMechanics/Pendulum/SimplePendulum/SmallAngle.lean (SimplePendulum.abs_torque_add_linear_le, SimplePendulum.gradLagrangian_sub_toHarmonicOscillator) + + - description: The API contains the classical formula 4√(ℓ/g) K(sin²(θ₀/2)) for the period of libration with amplitude θ₀, with its value 2π√(ℓ/g) at zero amplitude, its small-angle limit, monotonicity and bounds in the amplitude. + done: true + location: Physlib/ClassicalMechanics/Pendulum/SimplePendulum/PeriodFormula.lean (SimplePendulum.periodFormula, SimplePendulum.periodFormula_neg, SimplePendulum.periodFormula_zero, SimplePendulum.continuousOn_periodFormula, SimplePendulum.continuousAt_periodFormula_zero, SimplePendulum.periodFormula_tendsto_smallAnglePeriod, SimplePendulum.periodFormula_mono, SimplePendulum.periodFormula_strictMono, SimplePendulum.monotoneOn_periodFormula, SimplePendulum.strictMonoOn_periodFormula, SimplePendulum.smallAnglePeriod_le_periodFormula, SimplePendulum.periodFormula_pos, SimplePendulum.periodFormula_le, SimplePendulum.periodFormula_le') + + - description: The API contains the theorem that the period formula is the period of the solution of the equation of motion released from rest at the amplitude θ₀, for 0 < θ₀ < π. + done: false + location: N/A diff --git a/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Basic.lean b/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Basic.lean new file mode 100644 index 0000000000..352ce8bbd1 --- /dev/null +++ b/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Basic.lean @@ -0,0 +1,883 @@ +/- +Copyright (c) 2026 Aadarsh Agarwal. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Aadarsh Agarwal +-/ +module + +public import Physlib.ClassicalMechanics.EulerLagrange +public import Physlib.Mathematics.Calculus.Gradient +/-! + +# The simple gravity pendulum + +## i. Overview + +A simple gravity pendulum is a bob of mass `m` fixed to one end of a rigid massless rod of length +`ℓ`, the other end of which is pinned at a pivot, swinging in a vertical plane under a uniform +gravitational acceleration `g`. Its configuration is the angle `θ` of the rod from the downward +vertical. The bob moves on the circle of radius `ℓ` about the pivot, so its moment of inertia +about the pivot is `I = m ℓ²` and its kinetic energy is `T = ½ I θ̇²`. Swinging out to the angle +`θ` raises the bob by `ℓ (1 - cos θ)` against gravity, so the potential energy is +`V = m g ℓ (1 - cos θ)`, normalized to vanish at the bottom of the swing. Balancing the rate of +change of the angular momentum about the pivot against the torque `-m g ℓ sin θ` of gravity gives +the equation of motion `I θ̈ = -m g ℓ sin θ`, equivalently `θ̈ + (g/ℓ) sin θ = 0`. The mass drops +out of the motion, which is governed by the single quantity `ω = √(g/ℓ)`, the angular frequency of +the small oscillations about the bottom. + +The configuration of the pendulum is genuinely an angle modulo a full turn, an element of the +circle `SimplePendulum.ConfigurationSpace`. As for the harmonic oscillator, the dynamics in this +file are written instead on the Euclidean lift `Time → EuclideanSpace ℝ (Fin 1)`: the angle is +carried by a real number, from which the configuration is recovered by +`SimplePendulum.ConfigurationSpace.ofAngle`, and the one-dimensional Euclidean space stands in for +both the configuration space and its tangent space, so that the Euler–Lagrange operator of Physlib +applies verbatim. Two lifts differing by `2π n` describe the same motion: the invariance of the +dynamics under such shifts is proved in the module `SimplePendulum.LiftInvariance`, and the full +connection of the model here with the geometric configuration space is made in a later module. +The first consequences of the dynamics — the equilibria, and the below- and above-separatrix +energy bounds characteristic of libration and rotation — follow in `SimplePendulum.Equilibria`. + +## ii. Key results + +- `SimplePendulum` contains the input data of the problem: the mass `m` of the bob, the length `ℓ` + of the rod and the gravitational acceleration `g`. +- `SimplePendulum.ω` is the angular frequency `√(g/ℓ)` of the small oscillations, and + `SimplePendulum.inertia` is the moment of inertia `m ℓ²` of the bob about the pivot. They are + tied together by `SimplePendulum.ω_sq_mul_inertia`, the identity by which the mass cancels from + the equation of motion. +- `SimplePendulum.kineticEnergy`, `SimplePendulum.potentialEnergy` and `SimplePendulum.energy` are + the energies, with the bounds `potentialEnergy_nonneg`, `potentialEnergy_le` and + `potentialEnergy_eq_zero_iff`, the gradient `gradient_potentialEnergy` of the potential and the + time derivatives `kineticEnergy_deriv`, `potentialEnergy_deriv` and `energy_deriv`. +- `SimplePendulum.lagrangian` is the Lagrangian `T - V` of the pendulum, and + `SimplePendulum.torque` is the torque about the pivot, the generalized force conjugate to + the angle. +- `SimplePendulum.EquationOfMotion` is the equation of motion `I θ̈ = τ(θ)`, with its scalar form + `equationOfMotion_iff_scalar` and its independence of the mass `equationOfMotion_iff_of_eq_ω`; + `SimplePendulum.IsSolution` is a smooth solution of it. +- `SimplePendulum.gradLagrangian` is the variational derivative of the action, computed by + `gradLagrangian_eq_eulerLagrangeOp` and `gradLagrangian_eq_torque`. +- `SimplePendulum.equationOfMotion_iff_gradLagrangian_zero` identifies the equation of motion, + for smooth lifts of the angle, with the vanishing of the variational derivative of the action, + and `SimplePendulum.isSolution_iff` characterizes the solutions as the smooth critical points + of the action. +- `SimplePendulum.energy_conservation_of_equationOfMotion`, + `SimplePendulum.energy_conservation_of_equationOfMotion'` and + `SimplePendulum.IsSolution.energy_eq` express the conservation of energy along the motions of + the pendulum. +## iii. Table of contents + +- A. The input data + - A.1. The structure of the input data + - A.2. Simple inequalities for the input data +- B. Frequency and moment of inertia + - B.1. The angular frequency + - B.2. The moment of inertia +- C. The energies + - C.1. The definitions of the energies + - C.2. Simple equalities and bounds for the energies + - C.3. Smoothness of the energies and the gradient of the potential + - C.4. Time derivatives of the energies +- D. The Lagrangian + - D.1. The definition of the Lagrangian and equalities for it + - D.2. Smoothness of the Lagrangian + - D.3. Gradients of the Lagrangian +- E. The torque and the equation of motion + - E.1. The torque + - E.2. The equation of motion + - E.3. Smooth solutions + - E.4. The scalar equation and independence of the mass +- F. The variational derivative of the action + - F.1. The definition of the variational derivative + - F.2. Equality with the Euler–Lagrange operator + - F.3. The variational derivative in terms of the torque +- G. Equation of motion and the variational principle + - G.1. Equivalence with the vanishing of the variational derivative + - G.2. The variational characterization of solutions +- H. Energy conservation + - H.1. Energy conservation in terms of time derivatives + - H.2. Energy conservation in terms of constant energy + - H.3. Energy conservation for solutions +## iv. References + +References for the simple gravity pendulum include: + +* Landau & Lifshitz, Mechanics, 3rd ed., §5 and §21. [ref: landau_mechanics] +* Arnold, Mathematical Methods of Classical Mechanics, 2nd ed., §4. [ref: arnold_mechanics] +-/ + +@[expose] public section + +namespace ClassicalMechanics +open Real InnerProductSpace + +/-! + +## A. The input data + +We start by defining a structure containing the input data of the simple pendulum, and proving +basic properties thereof. The input data consists of the mass `m` of the bob, the length `ℓ` of +the rod, and the gravitational acceleration `g`; everything else in this file is built from these +three numbers. + +-/ + +/-! + +### A.1. The structure of the input data + +The three numbers are carried by a structure, together with the positivity assumptions: a +pendulum with a massless bob, a rod of zero length or no gravity is not a pendulum. + +-/ + +/-- The simple gravity pendulum is specified by the mass `m` of its bob, the length `ℓ` of its + rod, and the gravitational acceleration `g`. All three are assumed to be positive. The + configuration of the pendulum is the angle of the rod from the downward vertical. -/ +structure SimplePendulum where + /-- The mass of the bob. -/ + m : ℝ + /-- The length of the massless rod. -/ + ℓ : ℝ + /-- The gravitational acceleration. -/ + g : ℝ + m_pos : 0 < m + ℓ_pos : 0 < ℓ + g_pos : 0 < g + +namespace SimplePendulum + +variable (S : SimplePendulum) + +/-! + +### A.2. Simple inequalities for the input data + +The positivity of the input data is used most often through the corresponding non-vanishing +statements, which is the form in which the field-clearing tactics consume it. + +-/ + +/-- The mass of the bob is not equal to zero. -/ +@[simp] +lemma m_ne_zero : S.m ≠ 0 := S.m_pos.ne' + +/-- The length of the rod is not equal to zero. -/ +@[simp] +lemma ℓ_ne_zero : S.ℓ ≠ 0 := S.ℓ_pos.ne' + +/-- The gravitational acceleration is not equal to zero. -/ +@[simp] +lemma g_ne_zero : S.g ≠ 0 := S.g_pos.ne' + +/-! + +## B. Frequency and moment of inertia + +Two derived quantities control the dynamics of the pendulum: the angular frequency `ω = √(g/ℓ)` +of the small oscillations about the bottom of the swing, and the moment of inertia `I = m ℓ²` of +the bob about the pivot. + +The mass enters the equation of motion only through `I`, where it cancels against the mass in the +torque of gravity; what survives is `ω`. The identity performing that cancellation is +`ω_sq_mul_inertia`. + +-/ + +/-! + +### B.1. The angular frequency + +Linearizing `sin θ ≈ θ` about the bottom of the swing turns the equation of motion into that of a +harmonic oscillator of angular frequency `√(g/ℓ)`. The exact motion is not harmonic, but this +frequency is the natural time scale of the pendulum and appears throughout its analysis. + +-/ + +/-- The angular frequency of the simple pendulum, `ω`, is defined as `√(g/ℓ)`. It is the angular + frequency of the small oscillations of the pendulum about the bottom of its swing. -/ +noncomputable def ω : ℝ := √(S.g / S.ℓ) + +/-- The angular frequency of the simple pendulum is positive. -/ +@[simp] +lemma ω_pos : 0 < S.ω := sqrt_pos.mpr (div_pos S.g_pos S.ℓ_pos) + +/-- The angular frequency of the simple pendulum is not equal to zero. -/ +lemma ω_ne_zero : S.ω ≠ 0 := S.ω_pos.ne' + +/-- The square of the angular frequency of the simple pendulum is equal to `g/ℓ`. -/ +lemma ω_sq : S.ω ^ 2 = S.g / S.ℓ := sq_sqrt (div_pos S.g_pos S.ℓ_pos).le + +/-- The inverse of the square of the angular frequency of the simple pendulum is `ℓ/g`. -/ +lemma inverse_ω_sq : (S.ω ^ 2)⁻¹ = S.ℓ / S.g := by rw [ω_sq, inv_div] + +/-! + +### B.2. The moment of inertia + +The bob is a point mass at the fixed distance `ℓ` from the pivot, so the moment of inertia of the +pendulum about the pivot is `m ℓ²`. It is the coefficient relating the angular acceleration to +the torque, and so plays for the angle the role that the mass plays for a position. + +-/ + +/-- The moment of inertia of the simple pendulum about its pivot is `I = m ℓ²`, the moment of + inertia of a point mass `m` at distance `ℓ` from the axis. -/ +def inertia : ℝ := S.m * S.ℓ ^ 2 + +/-- The moment of inertia of the simple pendulum is positive. -/ +lemma inertia_pos : 0 < S.inertia := mul_pos S.m_pos (pow_pos S.ℓ_pos 2) + +/-- The moment of inertia of the simple pendulum is not equal to zero. -/ +@[simp] +lemma inertia_ne_zero : S.inertia ≠ 0 := S.inertia_pos.ne' + +/-- The square of the angular frequency times the moment of inertia is `m g ℓ`, the coefficient + appearing in the potential energy and in the torque. This is the identity by which the mass + cancels from the equation of motion. -/ +lemma ω_sq_mul_inertia : S.ω ^ 2 * S.inertia = S.m * S.g * S.ℓ := by + rw [ω_sq, inertia] + field_simp + +open Time +open scoped ContDiff + +/-! + +## C. The energies + +The simple pendulum has a kinetic energy determined by the rate of change of its angle, and a +potential energy determined by the height of the bob, hence by the angle itself. These combine to +give the total energy of the pendulum. + +Here we state and prove a number of properties of these energies, including the gradient of the +potential energy, which is the object entering the equation of motion. + +-/ + +/-! + +### C.1. The definitions of the energies + +We define the three energies; it is these energies which control the dynamics of the pendulum, +through the Lagrangian. + +-/ + +/-- The kinetic energy of the simple pendulum along a lift `θ` of the angle is + $\frac{1}{2} I ‖\dot θ‖^2$, where `I` is the moment of inertia about the pivot. -/ +noncomputable def kineticEnergy (θ : Time → EuclideanSpace ℝ (Fin 1)) : Time → ℝ := fun t => + (1 / (2 : ℝ)) * S.inertia * ⟪∂ₜ θ t, ∂ₜ θ t⟫_ℝ + +/-- The potential energy of the simple pendulum at the angle `x` is `m g ℓ (1 - cos (x 0))`, the + work done against gravity in raising the bob from the bottom of the swing. It is normalized to + vanish at the bottom. -/ +noncomputable def potentialEnergy (x : EuclideanSpace ℝ (Fin 1)) : ℝ := + S.m * S.g * S.ℓ * (1 - Real.cos (x 0)) + +/-- The energy of the simple pendulum is the kinetic energy plus the potential energy. -/ +noncomputable def energy (θ : Time → EuclideanSpace ℝ (Fin 1)) : Time → ℝ := fun t => + S.kineticEnergy θ t + S.potentialEnergy (θ t) + +/-! + +### C.2. Simple equalities and bounds for the energies + +Besides the definitional unfoldings, the potential energy of the pendulum is non-negative and +vanishes exactly at the bottom of the swing, just as the potential energy of the harmonic +oscillator is non-negative and vanishes exactly at the origin. What has no harmonic-oscillator +analogue is the upper bound: the potential energy of the pendulum is at most `2 m g ℓ`, its +value at the top of the swing. + +-/ + +/-- The kinetic energy of the simple pendulum, written out. -/ +lemma kineticEnergy_eq (θ : Time → EuclideanSpace ℝ (Fin 1)) : + S.kineticEnergy θ = fun t => (1 / (2 : ℝ)) * S.inertia * ⟪∂ₜ θ t, ∂ₜ θ t⟫_ℝ := rfl + +/-- The potential energy of the simple pendulum, written out. -/ +lemma potentialEnergy_eq (x : EuclideanSpace ℝ (Fin 1)) : + S.potentialEnergy x = S.m * S.g * S.ℓ * (1 - Real.cos (x 0)) := rfl + +/-- The energy of the simple pendulum, written out. -/ +lemma energy_eq (θ : Time → EuclideanSpace ℝ (Fin 1)) : + S.energy θ = fun t => S.kineticEnergy θ t + S.potentialEnergy (θ t) := rfl + +/-- The potential energy of the simple pendulum is non-negative, the bottom of the swing being + the lowest point of the circle on which the bob moves. -/ +lemma potentialEnergy_nonneg (x : EuclideanSpace ℝ (Fin 1)) : 0 ≤ S.potentialEnergy x := by + have hc : 0 < S.m * S.g * S.ℓ := mul_pos (mul_pos S.m_pos S.g_pos) S.ℓ_pos + have h : (0 : ℝ) ≤ 1 - Real.cos (x 0) := by + have := Real.cos_le_one (x 0) + linarith + rw [potentialEnergy_eq] + exact mul_nonneg hc.le h + +/-- The potential energy of the simple pendulum is at most `2 m g ℓ`, its value at the top of the + swing. -/ +lemma potentialEnergy_le (x : EuclideanSpace ℝ (Fin 1)) : + S.potentialEnergy x ≤ 2 * (S.m * S.g * S.ℓ) := by + have hc : 0 < S.m * S.g * S.ℓ := mul_pos (mul_pos S.m_pos S.g_pos) S.ℓ_pos + have h : 1 - Real.cos (x 0) ≤ 2 := by + have := Real.neg_one_le_cos (x 0) + linarith + calc S.potentialEnergy x = S.m * S.g * S.ℓ * (1 - Real.cos (x 0)) := S.potentialEnergy_eq x + _ ≤ S.m * S.g * S.ℓ * 2 := mul_le_mul_of_nonneg_left h hc.le + _ = 2 * (S.m * S.g * S.ℓ) := by ring + +/-- The potential energy of the simple pendulum vanishes exactly when the cosine of the angle is + equal to `1`, that is exactly at the bottom of the swing. -/ +lemma potentialEnergy_eq_zero_iff (x : EuclideanSpace ℝ (Fin 1)) : + S.potentialEnergy x = 0 ↔ Real.cos (x 0) = 1 := by + have hc : S.m * S.g * S.ℓ ≠ 0 := (mul_pos (mul_pos S.m_pos S.g_pos) S.ℓ_pos).ne' + rw [potentialEnergy_eq, mul_eq_zero, or_iff_right hc, sub_eq_zero, eq_comm] + +/-! + +### C.3. Smoothness of the energies and the gradient of the potential + +The potential energy is a smooth function of the angle, and its gradient on the one-dimensional +Euclidean lift is `m g ℓ sin θ` times the unit vector of the angular coordinate. This gradient is +what the equation of motion balances against the angular acceleration, so we record it here, once. +The subsection also records that, along a smooth lift of the angle, each of the three energies is +a differentiable function of the time — differentiability in time along the lift, as distinct +from the differentiability in the angle of the potential energy — which is the differentiability +that the time derivatives of section C.4 consume. + +-/ + +/-- The potential energy of the simple pendulum is a smooth function of the angle. -/ +@[fun_prop] +lemma potentialEnergy_contDiff (n : WithTop ℕ∞) : ContDiff ℝ n S.potentialEnergy := by + unfold potentialEnergy + fun_prop + +/-- The potential energy of the simple pendulum is a differentiable function of the angle. This + is differentiability in the angle; for differentiability in time along a smooth lift of the + angle see `potentialEnergy_differentiable`. -/ +@[fun_prop] +lemma differentiable_potentialEnergy : Differentiable ℝ S.potentialEnergy := + (S.potentialEnergy_contDiff 1).differentiable one_ne_zero + +/-- The gradient of the potential energy of the simple pendulum is `m g ℓ sin θ` times the unit + vector of the angular coordinate. -/ +lemma gradient_potentialEnergy (x : EuclideanSpace ℝ (Fin 1)) : + gradient S.potentialEnergy x = + (S.m * S.g * S.ℓ * Real.sin (x 0)) • EuclideanSpace.single 0 1 := by + have hcos : DifferentiableAt ℝ (fun y : EuclideanSpace ℝ (Fin 1) => Real.cos (y 0)) x := by + fun_prop + have h : S.potentialEnergy = fun y : EuclideanSpace ℝ (Fin 1) => + -(S.m * S.g * S.ℓ) * Real.cos (y 0) + S.m * S.g * S.ℓ := by + funext y + rw [potentialEnergy_eq] + ring + rw [h, gradient_add_const, gradient_const_mul _ hcos, + gradient_comp_coord 0 x (Real.hasDerivAt_cos (x 0))] + module + +/-- Along a smooth lift of the angle the kinetic energy is differentiable in time. -/ +@[fun_prop] +lemma kineticEnergy_differentiable (θ : Time → EuclideanSpace ℝ (Fin 1)) (hθ : ContDiff ℝ ∞ θ) : + Differentiable ℝ (S.kineticEnergy θ) := by + rw [kineticEnergy_eq] + fun_prop + +/-- Along a smooth lift of the angle the potential energy is a differentiable function of the + time. This is differentiability in time along the lift; for differentiability in the angle see + `differentiable_potentialEnergy`. -/ +@[fun_prop] +lemma potentialEnergy_differentiable (θ : Time → EuclideanSpace ℝ (Fin 1)) (hθ : ContDiff ℝ ∞ θ) : + Differentiable ℝ (fun t => S.potentialEnergy (θ t)) := by + have hd : Differentiable ℝ θ := hθ.differentiable (by simp) + fun_prop + +/-- Along a smooth lift of the angle the energy is differentiable in time. -/ +@[fun_prop] +lemma energy_differentiable (θ : Time → EuclideanSpace ℝ (Fin 1)) (hθ : ContDiff ℝ ∞ θ) : + Differentiable ℝ (S.energy θ) := by + rw [energy_eq] + fun_prop + +/-! + +### C.4. Time derivatives of the energies + +For a general smooth lift of the angle, which need not satisfy the equation of motion, we can +compute the time derivatives of the energies. Each is an inner product against the angular +velocity: the equation of motion will be exactly the statement that the two contributions cancel. + +-/ + +/-- The rate of change of the kinetic energy is the angular velocity paired with the angular + momentum's rate of change, `I θ̈`. -/ +lemma kineticEnergy_deriv (θ : Time → EuclideanSpace ℝ (Fin 1)) (hθ : ContDiff ℝ ∞ θ) : + ∂ₜ (S.kineticEnergy θ) = fun t => ⟪∂ₜ θ t, S.inertia • ∂ₜ (∂ₜ θ) t⟫_ℝ := by + funext t + unfold kineticEnergy + have hd : DifferentiableAt ℝ (∂ₜ θ) t := + (deriv_differentiable_of_contDiff θ hθ).differentiableAt + rw [Time.deriv_eq, fderiv_const_mul (by fun_prop), _root_.smul_apply, + fderiv_inner_apply (𝕜 := ℝ) hd hd, ← Time.deriv_eq] + simp [inner_smul_right, real_inner_comm] + ring + +/-- The rate of change of the potential energy is the angular velocity paired with the gradient + of the potential. -/ +lemma potentialEnergy_deriv (θ : Time → EuclideanSpace ℝ (Fin 1)) (hθ : ContDiff ℝ ∞ θ) : + ∂ₜ (fun t => S.potentialEnergy (θ t)) = + fun t => ⟪∂ₜ θ t, gradient S.potentialEnergy (θ t)⟫_ℝ := by + funext t + have hd : DifferentiableAt ℝ θ t := (hθ.differentiable (by simp)).differentiableAt + have hV : DifferentiableAt ℝ S.potentialEnergy (θ t) := + (S.potentialEnergy_contDiff 1).differentiable one_ne_zero (θ t) + have hf : HasFDerivAt (fun t => S.potentialEnergy (θ t)) _ t := + hV.hasFDerivAt.comp t hd.hasFDerivAt + rw [Time.deriv_eq, hf.fderiv] + simp [Time.deriv_eq] + +/-- The rate of change of the energy is the angular velocity paired with the sum of `I θ̈` and + the gradient of the potential; the equation of motion is exactly the vanishing of that sum. -/ +lemma energy_deriv (θ : Time → EuclideanSpace ℝ (Fin 1)) (hθ : ContDiff ℝ ∞ θ) : + ∂ₜ (S.energy θ) = + fun t => ⟪∂ₜ θ t, S.inertia • ∂ₜ (∂ₜ θ) t + gradient S.potentialEnergy (θ t)⟫_ℝ := by + unfold energy + funext t + rw [Time.deriv_eq, fderiv_fun_add (by fun_prop) (S.potentialEnergy_differentiable θ hθ t)] + simp only [_root_.add_apply, ← Time.deriv_eq, S.kineticEnergy_deriv θ hθ, + S.potentialEnergy_deriv θ hθ, ← inner_add_right] + +/-! + +## D. The Lagrangian + +The pendulum is a conservative system, so its Lagrangian is the kinetic energy minus the potential +energy, `L = ½ I θ̇² - m g ℓ (1 - cos θ)`. As for the harmonic oscillator, it is defined as a +function on phase space, of the time, the angle and the angular velocity separately; that it is +`T - V` along a lift of the angle is then a lemma rather than the definition. + +The Lagrangian carries no explicit time dependence, the pendulum being autonomous; the time +argument is kept because it is the type the Euler–Lagrange operator of Physlib expects. + +-/ + +/-! + +### D.1. The definition of the Lagrangian and equalities for it + +The Lagrangian is written directly in terms of the moment of inertia and the potential energy, +so that the equalities below are the two ways of reading it: expanded in the input data, and as +the kinetic energy minus the potential energy along a lift of the angle. + +-/ + +set_option linter.unusedVariables false in +/-- The Lagrangian of the simple pendulum, `L(t, θ, θ̇) = ½ I ‖θ̇‖² - V(θ)`, the kinetic energy + minus the potential energy as a function on phase space. It does not depend on the time. -/ +@[nolint unusedArguments] +noncomputable def lagrangian (t : Time) (x v : EuclideanSpace ℝ (Fin 1)) : ℝ := + (1 / (2 : ℝ)) * S.inertia * ⟪v, v⟫_ℝ - S.potentialEnergy x + +/-- The Lagrangian of the simple pendulum, written out in the input data. -/ +lemma lagrangian_eq : + S.lagrangian = fun _ x v => + (1 / (2 : ℝ)) * S.inertia * ⟪v, v⟫_ℝ - S.m * S.g * S.ℓ * (1 - Real.cos (x 0)) := by + funext t x v + rw [lagrangian, potentialEnergy_eq] + +/-- Along a lift of the angle the Lagrangian of the simple pendulum is the kinetic energy minus + the potential energy. -/ +lemma lagrangian_eq_kineticEnergy_sub_potentialEnergy (t : Time) + (θ : Time → EuclideanSpace ℝ (Fin 1)) : + S.lagrangian t (θ t) (∂ₜ θ t) = S.kineticEnergy θ t - S.potentialEnergy (θ t) := rfl + +/-! + +### D.2. Smoothness of the Lagrangian + +The Lagrangian is a smooth function of all of its arguments jointly. This is the hypothesis that +the Euler–Lagrange theorem of Physlib places on a Lagrangian, so it is recorded on the uncurried +form `↿S.lagrangian`. + +-/ + +/-- The Lagrangian of the simple pendulum is a smooth function of the time, the angle and the + angular velocity jointly. -/ +@[fun_prop] +lemma contDiff_lagrangian (n : WithTop ℕ∞) : ContDiff ℝ n ↿S.lagrangian := by + rw [lagrangian_eq] + fun_prop + +/-! + +### D.3. Gradients of the Lagrangian + +The Euler–Lagrange operator is built from the two partial gradients of the Lagrangian. The +gradient in the angle is minus the gradient of the potential energy, that is the torque of +section E; the gradient in the angular velocity is the angular momentum `I θ̇`. + +-/ + +/-- The gradient of the Lagrangian of the simple pendulum in the angle is minus the gradient of + the potential energy, `-m g ℓ sin θ` times the unit vector of the angular coordinate. -/ +lemma gradient_lagrangian_position_eq (t : Time) (x v : EuclideanSpace ℝ (Fin 1)) : + gradient (fun x => S.lagrangian t x v) x = + -((S.m * S.g * S.ℓ * Real.sin (x 0)) • EuclideanSpace.single 0 1) := by + have h : (fun y : EuclideanSpace ℝ (Fin 1) => S.lagrangian t y v) = + fun y => (-1 : ℝ) * S.potentialEnergy y + (1 / (2 : ℝ)) * S.inertia * ⟪v, v⟫_ℝ := by + funext y + rw [lagrangian] + ring + rw [h, gradient_add_const, gradient_const_mul _ (S.differentiable_potentialEnergy x), + gradient_potentialEnergy] + module + +/-- The gradient of the Lagrangian of the simple pendulum in the angular velocity is the angular + momentum `I θ̇` about the pivot. -/ +lemma gradient_lagrangian_velocity_eq (t : Time) (x v : EuclideanSpace ℝ (Fin 1)) : + gradient (S.lagrangian t x) v = S.inertia • v := by + have h : S.lagrangian t x = fun y : EuclideanSpace ℝ (Fin 1) => + ((1 / (2 : ℝ)) * S.inertia) * ⟪y, y⟫_ℝ + -S.potentialEnergy x := by + funext y + rw [lagrangian] + ring + rw [h, gradient_add_const, gradient_const_mul_inner_self] + module + +/-! + +## E. The torque and the equation of motion + +Gravity exerts on the bob a torque `-m g ℓ sin θ` about the pivot, the generalized force conjugate +to the angle, and the equation of motion balances it against the rate of change `I θ̈` of the +angular momentum. + +We take that pointwise relation as the definition of the equation of motion, rather than the +vanishing of the variational derivative of the action, which is how the harmonic oscillator defines +its own. The reason is that the variational derivative is defined to be `0` whenever no variational +gradient exists, so its vanishing holds vacuously for every lift of the angle too rough to admit +one; it says what it is meant to say only under a smoothness assumption. The pointwise equation is +totalized too — `∂ₜ` is `fderiv`, which is `0` off differentiability — but its totalization cannot +make the equation vacuously true: both sides remain genuine, and generally unequal, functions of +time. A rough lift can still satisfy the equation accidentally — a discontinuous lift hopping +between equilibrium angles solves it, as section E.3 explains — which is why the notion of a +solution, `IsSolution`, demands smoothness as well. It is also the form in which the equation of +motion is solved and used. The two agree for smooth lifts, by +`equationOfMotion_iff_gradLagrangian_zero` of section G, which is one rearrangement away from +`gradLagrangian_eq_torque` of section F. + +-/ + +/-! + +### E.1. The torque + +The pendulum is conservative, so the generalized force conjugate to the angle is minus the +gradient of the potential energy. It is a torque about the pivot rather than a force, the angle +being the coordinate; this is why it is `m g ℓ sin θ` and not `m g sin θ`. + +-/ + +/-- The generalized force of the simple pendulum conjugate to the angle, that is the torque about + the pivot, is minus the gradient of the potential energy, `τ = -∂V/∂θ`. -/ +noncomputable def torque (x : EuclideanSpace ℝ (Fin 1)) : EuclideanSpace ℝ (Fin 1) := + -gradient S.potentialEnergy x + +/-- The torque of the simple pendulum is `-m g ℓ sin θ` times the unit vector of the angular + coordinate. It is restoring near the bottom of the swing: for `|θ| < π` it opposes the + displacement, and it vanishes both at the bottom and at the inverted position. -/ +lemma torque_eq (x : EuclideanSpace ℝ (Fin 1)) : + S.torque x = -((S.m * S.g * S.ℓ * Real.sin (x 0)) • EuclideanSpace.single 0 1) := by + rw [torque, gradient_potentialEnergy] + +/-- The single component of the torque of the simple pendulum is `-m g ℓ sin θ`. -/ +lemma torque_apply (x : EuclideanSpace ℝ (Fin 1)) : + S.torque x 0 = -(S.m * S.g * S.ℓ * Real.sin (x 0)) := by + rw [torque_eq] + simp + +/-! + +### E.2. The equation of motion + +The equation of motion of the simple pendulum equates the rate of change of the angular momentum +about the pivot with the torque of gravity, at every instant. + +-/ + +/-- The equation of motion of the simple pendulum: at every instant the rate of change `I θ̈` of + the angular momentum about the pivot equals the torque `τ(θ)` of gravity. + + This pointwise relation, and not the vanishing of the variational derivative of the action, is + the definition of the equation of motion here; see the discussion in section E. For a smooth + lift of the angle the two agree, by `equationOfMotion_iff_gradLagrangian_zero` of section G. -/ +def EquationOfMotion (θ : Time → EuclideanSpace ℝ (Fin 1)) : Prop := + ∀ t, S.inertia • ∂ₜ (∂ₜ θ) t = S.torque (θ t) + +/-- The equation of motion of the simple pendulum with all of its terms on one side: at every + instant the rate of change `I θ̈` of the angular momentum plus the gradient of the potential + energy vanishes. This is the rotational form of Newton's second law, in the shape in which + `DampedHarmonicOscillator` states its own; the sum on the left is exactly the combination that + `energy_deriv` pairs with the velocity `∂ₜ θ`. -/ +lemma equationOfMotion_iff_newtons_2nd_law (θ : Time → EuclideanSpace ℝ (Fin 1)) : + S.EquationOfMotion θ ↔ + ∀ t, S.inertia • ∂ₜ (∂ₜ θ) t + gradient S.potentialEnergy (θ t) = 0 := by + simp only [EquationOfMotion, torque, eq_neg_iff_add_eq_zero] + +/-! + +### E.3. Smooth solutions + +A solution of the pendulum is a smooth lift satisfying the equation of motion. Smoothness is part +of the definition because the bare pointwise equation, being totalized, admits unphysical +solutions: a lift jumping between the equilibrium angles `0` and `π` has zero torque everywhere, +and — being locally constant wherever it is differentiable at all — it has `∂ₜ θ`, and hence +`∂ₜ (∂ₜ θ)`, identically zero, so it satisfies the equation even when it is nowhere continuous. +Demanding smoothness excludes such junk, and is the regularity under which the variational +description of the motion agrees with the pointwise one. + +-/ + +/-- A solution of the simple pendulum is a smooth lift of the angle satisfying the equation of + motion. -/ +def IsSolution (θ : Time → EuclideanSpace ℝ (Fin 1)) : Prop := + ContDiff ℝ ∞ θ ∧ S.EquationOfMotion θ + +/-- A solution of the simple pendulum is smooth. -/ +lemma IsSolution.contDiff {S : SimplePendulum} {θ : Time → EuclideanSpace ℝ (Fin 1)} + (h : S.IsSolution θ) : ContDiff ℝ ∞ θ := h.1 + +/-- A solution of the simple pendulum satisfies the equation of motion. -/ +lemma IsSolution.equationOfMotion {S : SimplePendulum} {θ : Time → EuclideanSpace ℝ (Fin 1)} + (h : S.IsSolution θ) : S.EquationOfMotion θ := h.2 + +/-! + +### E.4. The scalar equation and independence of the mass + +The angle is a single number, so the vector equation of motion is equivalent to the scalar +equation obtained by reading off its one component. Dividing that component by the moment of +inertia, using `ω_sq_mul_inertia`, cancels the mass and leaves `θ̈ + ω² sin θ = 0`: two pendulums +with the same `ω = √(g/ℓ)` have exactly the same angular motions, whatever their masses. + +-/ + +/-- The equation of motion of the simple pendulum in scalar form, `θ̈ + ω² sin θ = 0`. The mass + has cancelled: only the angular frequency `ω = √(g/ℓ)` survives. -/ +lemma equationOfMotion_iff_scalar (θ : Time → EuclideanSpace ℝ (Fin 1)) : + S.EquationOfMotion θ ↔ ∀ t, ∂ₜ (∂ₜ θ) t 0 + S.ω ^ 2 * Real.sin (θ t 0) = 0 := by + simp only [EquationOfMotion] + refine forall_congr' fun t => ?_ + have hcomp : (S.inertia • ∂ₜ (∂ₜ θ) t = S.torque (θ t)) ↔ + S.inertia * ∂ₜ (∂ₜ θ) t 0 = -(S.m * S.g * S.ℓ * Real.sin (θ t 0)) := by + rw [← S.torque_apply (θ t)] + constructor + · intro h + simpa using congrArg (fun y : EuclideanSpace ℝ (Fin 1) => y 0) h + · intro h + ext i + fin_cases i + simpa using h + rw [hcomp, ← S.ω_sq_mul_inertia] + constructor + · intro h + have h' : S.inertia * (∂ₜ (∂ₜ θ) t 0 + S.ω ^ 2 * Real.sin (θ t 0)) = 0 := by + linear_combination h + exact (mul_eq_zero.mp h').resolve_left S.inertia_ne_zero + · intro h + linear_combination S.inertia * h + +/-- Two simple pendulums with the same angular frequency have the same angular equation of + motion, and hence the same angular motions; in particular, changing only the mass does not + affect the angular motion. An equal `ω` still permits different lengths, and so different + trajectories of the bob in space. -/ +lemma equationOfMotion_iff_of_eq_ω (S' : SimplePendulum) (h : S'.ω = S.ω) + (θ : Time → EuclideanSpace ℝ (Fin 1)) : + S'.EquationOfMotion θ ↔ S.EquationOfMotion θ := by + rw [S'.equationOfMotion_iff_scalar, S.equationOfMotion_iff_scalar, h] + +/-! + +## F. The variational derivative of the action + +The action of the simple pendulum is the time integral of the Lagrangian along a lift of the +angle. Its variational derivative is computed here, in two steps: it is the Euler–Lagrange +operator of the Lagrangian, and that operator is the torque minus the rate of change of the +angular momentum. + +-/ + +/-! + +### F.1. The definition of the variational derivative + +The variational derivative is that of Physlib's variational calculus, applied to the action of the +pendulum. Recall that it is defined to be `0` when no variational gradient exists, so the lemmas +below are stated for smooth lifts of the angle. + +-/ + +/-- The variational derivative of the action of the simple pendulum, the action being the time + integral of the Lagrangian along a lift of the angle. -/ +noncomputable def gradLagrangian (θ : Time → EuclideanSpace ℝ (Fin 1)) : + Time → EuclideanSpace ℝ (Fin 1) := + (δ (q':=θ), ∫ t, S.lagrangian t (q' t) (fderiv ℝ q' t 1)) + +/-! + +### F.2. Equality with the Euler–Lagrange operator + +For a smooth lift of the angle the variational derivative of the action is the Euler–Lagrange +operator of the Lagrangian, by the general theorem `euler_lagrange_varGradient`; the hypotheses +of that theorem are the smoothness of the lift and `contDiff_lagrangian`. + +-/ + +/-- For a smooth lift of the angle the variational derivative of the action of the simple + pendulum is the Euler–Lagrange operator of its Lagrangian. -/ +lemma gradLagrangian_eq_eulerLagrangeOp (θ : Time → EuclideanSpace ℝ (Fin 1)) + (hθ : ContDiff ℝ ∞ θ) : + S.gradLagrangian θ = eulerLagrangeOp S.lagrangian θ := by + rw [gradLagrangian, euler_lagrange_varGradient _ _ hθ (S.contDiff_lagrangian _)] + +/-! + +### F.3. The variational derivative in terms of the torque + +Evaluating the Euler–Lagrange operator with the gradients of section D.3 gives the variational +derivative as the torque minus the rate of change of the angular momentum. Its vanishing is +therefore the equation of motion of section E; that equivalence is +`equationOfMotion_iff_gradLagrangian_zero` of section G. + +-/ + +/-- For a smooth lift of the angle the variational derivative of the action of the simple + pendulum is the torque minus the rate of change `I θ̈` of the angular momentum. -/ +lemma gradLagrangian_eq_torque (θ : Time → EuclideanSpace ℝ (Fin 1)) (hθ : ContDiff ℝ ∞ θ) : + S.gradLagrangian θ = fun t => S.torque (θ t) - S.inertia • ∂ₜ (∂ₜ θ) t := by + funext t + rw [S.gradLagrangian_eq_eulerLagrangeOp θ hθ, eulerLagrangeOp] + simp [S.gradient_lagrangian_position_eq, S.gradient_lagrangian_velocity_eq, S.torque_eq, + Time.deriv_smul _ S.inertia (deriv_differentiable_of_contDiff θ hθ)] + +/-! + +## G. Equation of motion and the variational principle + +Section E took the pointwise balance of the angular momentum's rate of change against the torque +as the definition of the equation of motion, and section F computed the variational derivative of +the action. This section proves that for smooth lifts of the angle the two agree: the pointwise +law is exactly the Euler–Lagrange equation of the action, the statement that the motion is a +critical point of the action. The equivalence holds only under smoothness — the variational +derivative is `0` by convention on lifts too rough to admit a variational gradient, so on such +lifts its vanishing says nothing — which is why section E took the pointwise form as primary. + +-/ + +/-! + +### G.1. Equivalence with the vanishing of the variational derivative + +By `gradLagrangian_eq_torque` the variational derivative of the action along a smooth lift is +the torque minus the rate of change of the angular momentum, so its vanishing is a rearrangement +of the equation of motion. + +-/ + +/-- For a smooth lift of the angle the equation of motion of the simple pendulum holds if and + only if the variational derivative of the action vanishes: the smooth motions of the pendulum + are the critical points of its action. -/ +lemma equationOfMotion_iff_gradLagrangian_zero (θ : Time → EuclideanSpace ℝ (Fin 1)) + (hθ : ContDiff ℝ ∞ θ) : + S.EquationOfMotion θ ↔ S.gradLagrangian θ = 0 := by + rw [S.gradLagrangian_eq_torque θ hθ, funext_iff] + simp only [EquationOfMotion, Pi.zero_apply, sub_eq_zero] + exact forall_congr' fun t => eq_comm + +/-! + +### G.2. The variational characterization of solutions + +A solution was defined in section E.3 as a smooth lift satisfying the equation of motion. +Substituting the equivalence of G.1 for the equation of motion turns this into the variational +characterization: the solutions of the pendulum are exactly the smooth lifts of the angle along +which the variational derivative of the action vanishes. + +-/ + +/-- A lift of the angle is a solution of the simple pendulum if and only if it is smooth and the + variational derivative of the action vanishes along it. -/ +lemma isSolution_iff (θ : Time → EuclideanSpace ℝ (Fin 1)) : + S.IsSolution θ ↔ ContDiff ℝ ∞ θ ∧ S.gradLagrangian θ = 0 := + and_congr_right fun hθ => S.equationOfMotion_iff_gradLagrangian_zero θ hθ + +/-! + +## H. Energy conservation + +The pendulum is conservative: along any smooth lift of the angle satisfying the equation of +motion the energy is constant. No computation remains to be done here: by `energy_deriv` the +rate of change of the energy is the angular velocity paired with the sum of `I θ̈` and the +gradient of the potential, and the equation of motion is exactly the vanishing of that sum. + +-/ + +/-! + +### H.1. Energy conservation in terms of time derivatives + +The first form of energy conservation: the time derivative of the energy vanishes identically +along any smooth lift of the angle satisfying the equation of motion. + +-/ + +/-- Along a smooth lift of the angle satisfying the equation of motion the time derivative of + the energy of the simple pendulum vanishes. -/ +lemma energy_conservation_of_equationOfMotion (θ : Time → EuclideanSpace ℝ (Fin 1)) + (hθ : ContDiff ℝ ∞ θ) (h : S.EquationOfMotion θ) : ∂ₜ (S.energy θ) = 0 := by + rw [S.equationOfMotion_iff_newtons_2nd_law θ] at h + funext t + rw [S.energy_deriv θ hθ] + simp [h t] + +/-! + +### H.2. Energy conservation in terms of constant energy + +The second form: the energy is differentiable in time along a smooth lift of the angle, so the +vanishing of its derivative makes it a constant function of the time, equal to its initial +value. + +-/ + +/-- Along a smooth lift of the angle satisfying the equation of motion the energy of the simple + pendulum at any time is equal to its initial value. -/ +lemma energy_conservation_of_equationOfMotion' (θ : Time → EuclideanSpace ℝ (Fin 1)) + (hθ : ContDiff ℝ ∞ θ) (h : S.EquationOfMotion θ) (t : Time) : + S.energy θ t = S.energy θ 0 := by + apply is_const_of_fderiv_eq_zero (𝕜 := ℝ) (S.energy_differentiable θ hθ) + intro t + ext p + rw [p.eq_one_smul, map_smul, ← Time.deriv_eq, + S.energy_conservation_of_equationOfMotion θ hθ h] + simp + +/-! + +### H.3. Energy conservation for solutions + +The hypotheses of energy conservation — smoothness and the equation of motion — are exactly the +two components of being a solution, so for solutions conservation takes its most compact form. + +-/ + +/-- The energy of the simple pendulum along a solution at any time is equal to its initial + value. -/ +lemma IsSolution.energy_eq {S : SimplePendulum} {θ : Time → EuclideanSpace ℝ (Fin 1)} + (h : S.IsSolution θ) (t : Time) : S.energy θ t = S.energy θ 0 := + S.energy_conservation_of_equationOfMotion' θ h.contDiff h.equationOfMotion t + +end SimplePendulum + +end ClassicalMechanics + +end diff --git a/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Equilibria.lean b/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Equilibria.lean new file mode 100644 index 0000000000..7f98d10765 --- /dev/null +++ b/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Equilibria.lean @@ -0,0 +1,336 @@ +/- +Copyright (c) 2026 Aadarsh Agarwal. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Aadarsh Agarwal +-/ +module + +public import Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Basic +/-! + +# Equilibria and energy regimes of the simple pendulum + +## i. Overview + +The equation of motion of the simple gravity pendulum, `I θ̈ = -m g ℓ sin θ` in the lifted +formulation of `SimplePendulum.Basic`, has two elementary consequences that follow from the +vanishing of the torque and from energy conservation alone, before any non-constant solution is +constructed. The first is the equilibria: the torque of gravity vanishes exactly where `sin θ` +does, so the constant lifts at the angle `0` — the bob hanging at rest below the pivot — and at +the angle `π` — the bob balanced above it — solve the equation of motion, and conversely a +constant lift is a solution only at the multiples of `π`. The second is the division of the +smooth motions into regimes by the value of the conserved energy. The threshold is the energy +`2 m g ℓ` of the inverted equilibrium, the separatrix energy: below it the potential energy +cannot reach its value at the top of the swing, so the bob never gets there — classically the +regime of libration, the bob swinging back and forth; above it the kinetic energy never +vanishes, so the bob never halts — classically the regime of rotation, the pendulum circulating +over the top. This is the phase portrait of the pendulum drawn in Arnold §4, whose level curves +of the energy are closed ovals below the threshold and unbounded waves above it. + +As in `SimplePendulum.Basic`, the motion is written on the Euclidean lift +`Time → EuclideanSpace ℝ (Fin 1)` of the angle. Only the bounds characteristic of each regime +are proved here: the librating and rotating motions themselves, and the instability of the +inverted equilibrium, are statements about non-constant solutions and are not constructed in +this module. + +## ii. Key results + +- `SimplePendulum.equationOfMotion_const_zero` and `SimplePendulum.equationOfMotion_const_pi` + are the hanging and the inverted equilibrium, packaged as the simplest explicit solutions of + the pendulum by `SimplePendulum.isSolution_const_zero` and `SimplePendulum.isSolution_const_pi`, + and `SimplePendulum.equationOfMotion_const_iff` shows that the constant solutions are exactly + the equilibria. +- `SimplePendulum.separatrixEnergy` is the energy `2 m g ℓ` of the inverted equilibrium + (`SimplePendulum.energy_const_pi`), the threshold between libration and rotation. +- `SimplePendulum.neg_one_lt_cos_of_energy_lt`: below the threshold the bob never reaches the + top of the swing. `SimplePendulum.deriv_ne_zero_of_energy_gt`: above it the angular velocity + never vanishes. `SimplePendulum.potentialEnergy_eq_energy_of_deriv_eq_zero`: at a turning + point the potential energy equals the total energy. + +## iii. Table of contents + +- A. Equilibria + - A.1. The hanging equilibrium + - A.2. The inverted equilibrium + - A.3. The constant solutions are the equilibria +- B. Energy regimes + - B.1. The separatrix energy + - B.2. Energy bounds + - B.3. Libration and rotation + - B.4. Turning points + +## iv. References + +References for the equilibria and the energy regimes of the simple pendulum include: + +* Landau & Lifshitz, Mechanics, 3rd ed., §11 (motion in one dimension: the turning points, and + finite and infinite motion according to the energy). [ref: landau_mechanics] +* Arnold, Mathematical Methods of Classical Mechanics, 2nd ed., §4 (the phase portrait of the + pendulum). [ref: arnold_mechanics] +-/ + +@[expose] public section + +namespace ClassicalMechanics +open Real InnerProductSpace Time +open scoped ContDiff + +namespace SimplePendulum + +variable (S : SimplePendulum) + +/-! + +## A. Equilibria + +The two configurations at which the torque of gravity vanishes — the bob hanging at rest below +the pivot and the bob balanced above it — give constant solutions of the equation of motion, the +simplest explicit solutions of the pendulum. This section verifies the two, and proves the +converse: a constant lift solves the equation of motion only where the torque vanishes, that is +only at the angles `π n`. The constant solutions are exactly the equilibria. + +-/ + +/-! + +### A.1. The hanging equilibrium + +At the angle `0` the bob hangs at rest at the bottom of its swing. The lift is constant, so the +angular momentum does not change, and the torque vanishes with `sin 0`: both sides of the +equation of motion are zero. + +-/ + +/-- The constant lift at the angle `0` — the bob hanging at rest at the bottom of its swing — + satisfies the equation of motion of the simple pendulum. -/ +lemma equationOfMotion_const_zero : + S.EquationOfMotion (fun _ => (0 : EuclideanSpace ℝ (Fin 1))) := by + intro t + have h1 : ∂ₜ (fun _ : Time => (0 : EuclideanSpace ℝ (Fin 1))) = fun _ => 0 := by + funext s + simp + rw [h1] + simp [torque_eq] + +/-- The hanging equilibrium is a solution of the simple pendulum: the constant lift at the angle + `0` is smooth and satisfies the equation of motion. It is the simplest explicit solution of the + pendulum. -/ +lemma isSolution_const_zero : S.IsSolution (fun _ => 0) := + ⟨contDiff_const, S.equationOfMotion_const_zero⟩ + +/-! + +### A.2. The inverted equilibrium + +At the angle `π` the bob is balanced directly above the pivot, where the torque vanishes with +`sin π`; the pendulum stays there. That this balance is unstable — neighbouring solutions run +away from it — is a statement about non-constant solutions, and is not proved here. + +-/ + +/-- The constant lift at the angle `π` — the bob balanced directly above the pivot — satisfies + the equation of motion of the simple pendulum. -/ +lemma equationOfMotion_const_pi : + S.EquationOfMotion (fun _ => EuclideanSpace.single 0 Real.pi) := by + intro t + have h1 : ∂ₜ (fun _ : Time => EuclideanSpace.single (0 : Fin 1) Real.pi) = fun _ => 0 := by + funext s + simp + rw [h1] + simp [torque_eq] + +/-- The inverted equilibrium is a solution of the simple pendulum: the constant lift at the + angle `π` is smooth and satisfies the equation of motion. -/ +lemma isSolution_const_pi : S.IsSolution (fun _ => EuclideanSpace.single 0 Real.pi) := + ⟨contDiff_const, S.equationOfMotion_const_pi⟩ + +/-! + +### A.3. The constant solutions are the equilibria + +For a constant lift the angular momentum does not change, so the equation of motion reduces to +the vanishing of the torque, that is to `sin θ = 0`, which holds exactly at the multiples of +`π`. The constant solutions are therefore exactly the equilibria: the hanging equilibrium, the +inverted equilibrium, and their copies shifted by whole turns. + +-/ + +/-- A constant lift satisfies the equation of motion of the simple pendulum if and only if the + sine of its angle vanishes — classically, the angles straight down and straight up: the + constant solutions are exactly the equilibria. -/ +lemma equationOfMotion_const_iff (x : EuclideanSpace ℝ (Fin 1)) : + S.EquationOfMotion (fun _ => x) ↔ Real.sin (x 0) = 0 := by + have h1 : ∂ₜ (fun _ : Time => x) = fun _ => 0 := by + funext s + simp + have he : EuclideanSpace.single (0 : Fin 1) (1 : ℝ) ≠ 0 := + fun h => one_ne_zero ((PiLp.single_eq_zero_iff 2 (0 : Fin 1)).mp h) + have hc : S.m * S.g * S.ℓ ≠ 0 := (mul_pos (mul_pos S.m_pos S.g_pos) S.ℓ_pos).ne' + simp only [EquationOfMotion, h1, Time.deriv_const, smul_zero, forall_const] + rw [eq_comm, torque_eq, neg_eq_zero, smul_eq_zero, or_iff_left he, mul_eq_zero, + or_iff_right hc] + +/-! + +## B. Energy regimes + +Energy conservation divides the smooth motions of the pendulum into regimes according to the +value of the conserved energy, the threshold being the energy `2 m g ℓ` of the inverted +equilibrium. Below the threshold the potential energy cannot reach its value at the top of the +swing, so the bob never reaches the top; classically this is the regime of libration, the bob +swinging back and forth. Above the threshold the kinetic energy can never vanish, so the bob +never halts; classically this is the regime of rotation, the pendulum circulating over the top. +This is the phase portrait of the pendulum drawn in Arnold §4, whose level curves of the energy +are closed ovals below the threshold and unbounded waves above it. This section proves the +below- and above-threshold bounds characteristic of each regime, from two elementary bounds +relating the energies — the librating and rotating motions themselves are not constructed +here — and characterizes the turning points, the instants at which the velocity vanishes and +the potential energy exhausts the total energy. + +-/ + +/-! + +### B.1. The separatrix energy + +The threshold between the regimes is the energy of the inverted equilibrium: no kinetic energy, +and the potential energy `2 m g ℓ` of the top of the swing. It is called the separatrix energy +after the curve it names in the phase portrait, the level set of the energy separating the +closed orbits of libration from the unbounded orbits of rotation. Only the threshold value is +used in this file: the separatrix motions themselves — the non-constant solutions asymptotic to +the inverted equilibrium — are not constructed here. + +-/ + +/-- The separatrix energy of the simple pendulum is `2 m g ℓ`, the energy of the inverted + equilibrium. It is the threshold separating the two regimes of the motion, libration below it + and rotation above it. -/ +def separatrixEnergy : ℝ := 2 * (S.m * S.g * S.ℓ) + +/-- The separatrix energy of the simple pendulum, written out. -/ +lemma separatrixEnergy_eq : S.separatrixEnergy = 2 * (S.m * S.g * S.ℓ) := rfl + +/-- The separatrix energy of the simple pendulum is positive. -/ +lemma separatrixEnergy_pos : 0 < S.separatrixEnergy := + mul_pos two_pos (mul_pos (mul_pos S.m_pos S.g_pos) S.ℓ_pos) + +/-- The energy of the simple pendulum along the inverted equilibrium is the separatrix energy: + the bob balanced at the top has no kinetic energy and the full potential energy `2 m g ℓ`. -/ +lemma energy_const_pi : + S.energy (fun _ => EuclideanSpace.single 0 Real.pi) = fun _ => S.separatrixEnergy := by + funext t + simp only [energy_eq, kineticEnergy_eq, Time.deriv_const, inner_zero_left, mul_zero, + zero_add, potentialEnergy_eq, separatrixEnergy_eq, PiLp.single_apply, reduceIte, Real.cos_pi] + ring + +/-! + +### B.2. Energy bounds + +Two elementary bounds drive the regime theorems: the kinetic energy is non-negative, so the +potential energy is at most the total energy; and the potential energy is non-negative, so +`I θ̇²` is at most twice the total energy. None of the bounds of this subsection uses the +equation of motion — they hold along every lift of the angle. + +-/ + +/-- The kinetic energy of the simple pendulum is non-negative along every lift of the angle. -/ +lemma kineticEnergy_nonneg (θ : Time → EuclideanSpace ℝ (Fin 1)) (t : Time) : + 0 ≤ S.kineticEnergy θ t := by + simp only [kineticEnergy_eq] + exact mul_nonneg (mul_nonneg (by norm_num) S.inertia_pos.le) real_inner_self_nonneg + +/-- The moment of inertia times the square of the angular speed, `I θ̇²`, is at most twice the + total energy, along every lift of the angle. -/ +lemma inertia_mul_inner_deriv_le (θ : Time → EuclideanSpace ℝ (Fin 1)) (t : Time) : + S.inertia * ⟪∂ₜ θ t, ∂ₜ θ t⟫_ℝ ≤ 2 * S.energy θ t := by + have hV := S.potentialEnergy_nonneg (θ t) + have hE : S.energy θ t = (1 / (2 : ℝ)) * S.inertia * ⟪∂ₜ θ t, ∂ₜ θ t⟫_ℝ + + S.potentialEnergy (θ t) := by + rw [energy_eq, kineticEnergy_eq] + linarith + +/-- The potential energy of the simple pendulum is at most the total energy along every lift of + the angle. -/ +lemma potentialEnergy_le_energy (θ : Time → EuclideanSpace ℝ (Fin 1)) (t : Time) : + S.potentialEnergy (θ t) ≤ S.energy θ t := by + have hK := S.kineticEnergy_nonneg θ t + have hE : S.energy θ t = S.kineticEnergy θ t + S.potentialEnergy (θ t) := by + rw [energy_eq] + linarith + +/-! + +### B.3. Libration and rotation + +Along a smooth solution with energy below the separatrix energy, the potential energy — being +at most the conserved total energy — stays strictly below `2 m g ℓ`, so the cosine of the angle +stays strictly above `-1`: the bob never reaches the top of the swing, and the motion is a +libration, swinging back and forth — though only the bound is proved here. Along a smooth +solution with energy above the separatrix energy the angular velocity can never vanish, for at +such an instant the whole energy would be potential, and the potential energy never exceeds +`2 m g ℓ`; the velocity being continuous, it keeps a fixed sign, and the motion is a rotation +over the top — though only the non-vanishing is proved here. + +-/ + +/-- Libration: along a smooth lift of the angle satisfying the equation of motion, with energy + below the separatrix energy, the cosine of the angle stays strictly above `-1` — the bob + never reaches the top of the swing. -/ +lemma neg_one_lt_cos_of_energy_lt (θ : Time → EuclideanSpace ℝ (Fin 1)) + (hθ : ContDiff ℝ ∞ θ) (h : S.EquationOfMotion θ) + (hE : S.energy θ 0 < S.separatrixEnergy) (t : Time) : -1 < Real.cos (θ t 0) := by + have hc : 0 < S.m * S.g * S.ℓ := mul_pos (mul_pos S.m_pos S.g_pos) S.ℓ_pos + have hV : S.m * S.g * S.ℓ * (1 - Real.cos (θ t 0)) < 2 * (S.m * S.g * S.ℓ) := by + rw [← S.potentialEnergy_eq (θ t), ← S.separatrixEnergy_eq] + calc S.potentialEnergy (θ t) ≤ S.energy θ t := S.potentialEnergy_le_energy θ t + _ = S.energy θ 0 := S.energy_conservation_of_equationOfMotion' θ hθ h t + _ < S.separatrixEnergy := hE + nlinarith [hV, hc] + +/-- Rotation: along a smooth lift of the angle satisfying the equation of motion, with energy + above the separatrix energy, the angular velocity never vanishes — the bob never halts. -/ +lemma deriv_ne_zero_of_energy_gt (θ : Time → EuclideanSpace ℝ (Fin 1)) + (hθ : ContDiff ℝ ∞ θ) (h : S.EquationOfMotion θ) + (hE : S.separatrixEnergy < S.energy θ 0) (t : Time) : ∂ₜ θ t ≠ 0 := by + intro h0 + have hK : S.kineticEnergy θ t = 0 := by + simp only [kineticEnergy_eq] + simp [h0] + have ht : S.energy θ t = S.kineticEnergy θ t + S.potentialEnergy (θ t) := by + rw [energy_eq] + have hle := S.potentialEnergy_le (θ t) + have hcons := S.energy_conservation_of_equationOfMotion' θ hθ h t + have hsep : S.separatrixEnergy = 2 * (S.m * S.g * S.ℓ) := S.separatrixEnergy_eq + linarith + +/-! + +### B.4. Turning points + +At an instant where the angular velocity vanishes the kinetic energy vanishes with it, and the +conserved total energy is purely potential. These are the turning points of the motion, where a +librating bob halts at the extremes of its arc before swinging back; by the rotation theorem of +B.3 they can occur only at energies not above the separatrix energy. + +-/ + +/-- Turning points: along a smooth lift of the angle satisfying the equation of motion, at an + instant where the angular velocity vanishes, the potential energy equals the conserved total + energy. -/ +lemma potentialEnergy_eq_energy_of_deriv_eq_zero (θ : Time → EuclideanSpace ℝ (Fin 1)) + (hθ : ContDiff ℝ ∞ θ) (h : S.EquationOfMotion θ) (t : Time) (h0 : ∂ₜ θ t = 0) : + S.potentialEnergy (θ t) = S.energy θ 0 := by + have hK : S.kineticEnergy θ t = 0 := by + simp only [kineticEnergy_eq] + simp [h0] + have ht : S.energy θ t = S.kineticEnergy θ t + S.potentialEnergy (θ t) := by + rw [energy_eq] + have hcons := S.energy_conservation_of_equationOfMotion' θ hθ h t + linarith + +end SimplePendulum + +end ClassicalMechanics + +end diff --git a/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Geometric/Basic.lean b/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Geometric/Basic.lean new file mode 100644 index 0000000000..1b28933a1a --- /dev/null +++ b/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Geometric/Basic.lean @@ -0,0 +1,406 @@ +/- +Copyright (c) 2026 Aadarsh Agarwal. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Aadarsh Agarwal +-/ +module + +public import Physlib.SpaceAndTime.Space.Module +public import Mathlib.Analysis.SpecialFunctions.Complex.Circle +public import Mathlib.Geometry.Manifold.Instances.Sphere +public import Mathlib.Topology.Covering.AddCircle +/-! + +# Configuration space of the simple pendulum + +## i. Overview + +A simple pendulum is a bob fixed to one end of a rigid massless rod of length `ℓ`, the other end +of which is pinned at a pivot, swinging in a vertical plane under gravity. Its position is fixed by +the angle of the rod from the downward vertical, and two angles that differ by a full turn describe +the same position. The configuration space is therefore a circle. + +We record a configuration by its angle modulo `2π`, i.e. by an element of `Real.Angle`, as the +sliding pendulum does (`Physlib.ClassicalMechanics.Pendulum.SlidingPendulum`). The circle carries +the structure of a compact analytic one-dimensional manifold; we obtain it by identifying the +configuration space with Mathlib's unit circle `Circle` and pulling back its charts. The smooth +identification of the configuration space with `Circle` (the analogue of the harmonic oscillator's +`valDiffeomorph`) is deferred to a later module. The real-valued angle that is used to +write down the dynamics is a lift of the configuration along the covering map +`ℝ → ConfigurationSpace`; it is not a chart, and two lifts differing by `2π n` describe the same +configuration. Finally the position of the bob in the plane is recorded by `toSpace ℓ`, which sends +the configuration at angle `θ` to `(ℓ sin θ, -ℓ cos θ)`: the pivot is the origin and the second axis +points upwards. + +## ii. Key results + +- `ConfigurationSpace` : the configuration space of the planar simple pendulum. +- `ConfigurationSpace.circleHomeomorph` : its identification with the unit circle, with inverse + `ConfigurationSpace.ofCircle` (`toCircle_ofCircle`, `ofCircle_toCircle`). +- `ConfigurationSpace.instChartedSpace`, `ConfigurationSpace.instIsManifold` : the analytic + manifold structure, pulled back from `Circle` (`chartAt_source`, `chartAt_target`). +- `ConfigurationSpace.ofAngle` : the angular lift `ℝ → ConfigurationSpace`, periodic with period + `2π`, continuous, surjective, analytic, and a covering map (`isCoveringMap_ofAngle`). +- `ConfigurationSpace.toSpace` : the position of the bob in `Space 2`, with + `toSpace_ofAngle` and the rod-length constraint `toSpace_norm`; for `ℓ ≠ 0` it is a closed + embedding (`toSpace_isClosedEmbedding`). + +## iii. Table of contents + +- A. The configuration space type +- B. Topology and identification with the unit circle +- C. Manifold structure +- D. The angular lift +- E. Map to physical space + +## iv. References + +* Landau & Lifshitz, Mechanics, 3rd ed., §5, Problems 1–3 (pendulum configurations). + [ref: landau_mechanics] +* Mathlib, `Mathlib.Geometry.Manifold.Instances.Sphere` (the manifold structure on `Circle`). +-/ + +@[expose] public section + +noncomputable section + +open scoped Manifold ContDiff + +namespace ClassicalMechanics +namespace SimplePendulum + +/-! + +## A. The configuration space type + +A configuration is the angle of the rod from the downward vertical, taken modulo a full turn. + +-/ + +/-- The configuration space of the planar simple pendulum: the angle of the rod from the downward + vertical, modulo `2π`. -/ +structure ConfigurationSpace where + /-- The angle of the rod from the downward vertical, modulo `2π`. -/ + angle : Real.Angle + +namespace ConfigurationSpace + +/-- Two configurations are equal precisely when their angles are equal. -/ +@[ext] +lemma ext {p q : ConfigurationSpace} (h : p.angle = q.angle) : p = q := by + cases p; cases q; cases h; rfl + +/-! + +## B. Topology and identification with the unit circle + +The topology is that of `Real.Angle`; composing with Mathlib's identification of `Real.Angle` +(the additive circle of period `2π`) with the unit circle `Circle ⊆ ℂ` gives a homeomorphism +`ConfigurationSpace ≃ₜ Circle`, through which the circle's compactness and Hausdorff property +transfer. + +-/ + +/-- The identification of the configuration space with `Real.Angle`. -/ +def angleEquiv : ConfigurationSpace ≃ Real.Angle where + toFun := angle + invFun φ := ⟨φ⟩ + left_inv q := by cases q; rfl + right_inv φ := rfl + +/-- The topology of the configuration space, induced from `Real.Angle`. -/ +instance instTopologicalSpace : TopologicalSpace ConfigurationSpace := + TopologicalSpace.induced angle inferInstance + +/-- The identification with `Real.Angle` as a homeomorphism. -/ +def angleHomeomorph : ConfigurationSpace ≃ₜ Real.Angle where + toEquiv := angleEquiv + continuous_toFun := continuous_induced_dom + continuous_invFun := continuous_induced_rng.mpr continuous_id + +/-- The point of the unit circle `e^{iθ}` corresponding to a configuration at angle `θ`. -/ +def toCircle (q : ConfigurationSpace) : Circle := q.angle.toCircle + +/-- The identification of the configuration space with the unit circle. -/ +def circleHomeomorph : ConfigurationSpace ≃ₜ Circle := + angleHomeomorph.trans AddCircle.homeomorphCircle' + +-- `rfl` proves this because `Real.Angle.toCircle` and `AddCircle.homeomorphCircle'` are the same +-- lift of `Circle.exp`; should that stop holding definitionally, the fallback proof is +-- `Real.Angle.induction_on` with `Real.Angle.toCircle_coe` and +-- `AddCircle.homeomorphCircle'_apply_mk`. +/-- The identification with the unit circle is given by `ConfigurationSpace.toCircle`. -/ +lemma circleHomeomorph_apply (q : ConfigurationSpace) : circleHomeomorph q = q.toCircle := rfl + +/-- The configuration corresponding to a point of the unit circle. -/ +def ofCircle : Circle → ConfigurationSpace := circleHomeomorph.symm + +/-- The point of the unit circle of the configuration attached to a point of the unit circle is + that point. -/ +@[simp] +lemma toCircle_ofCircle (z : Circle) : (ofCircle z).toCircle = z := + circleHomeomorph.apply_symm_apply z + +/-- The configuration attached to the point of the unit circle of a configuration is that + configuration. -/ +@[simp] +lemma ofCircle_toCircle (q : ConfigurationSpace) : ofCircle q.toCircle = q := + circleHomeomorph.symm_apply_apply q + +/-- The configuration space is Hausdorff, being homeomorphic to the unit circle. -/ +instance instT2Space : T2Space ConfigurationSpace := circleHomeomorph.symm.t2Space + +/-- The configuration space is compact, being homeomorphic to the unit circle. -/ +instance instCompactSpace : CompactSpace ConfigurationSpace := circleHomeomorph.symm.compactSpace + +/-- The configuration space is second countable, being homeomorphic to the unit circle. -/ +instance instSecondCountableTopology : SecondCountableTopology ConfigurationSpace := + circleHomeomorph.secondCountableTopology + +/-! + +## C. Manifold structure + +The unit circle is an analytic one-dimensional manifold modelled on `EuclideanSpace ℝ (Fin 1)` +(Mathlib, via stereographic projection). We pull its atlas back along `circleHomeomorph`: a chart +of the configuration space is the identification with the circle followed by a chart of the circle. +Since the identification cancels in every change of charts, the changes of charts are exactly those +of the circle, hence analytic. + +-/ + +/-- The charts of the configuration space: the identification with the unit circle followed by a + chart of the circle. -/ +instance instChartedSpace : ChartedSpace (EuclideanSpace ℝ (Fin 1)) ConfigurationSpace where + atlas := {circleHomeomorph.toOpenPartialHomeomorph.trans e | + e ∈ atlas (EuclideanSpace ℝ (Fin 1)) Circle} + chartAt q := circleHomeomorph.toOpenPartialHomeomorph.trans + (chartAt (EuclideanSpace ℝ (Fin 1)) (circleHomeomorph q)) + mem_chart_source q := by simp + chart_mem_atlas q := ⟨_, chart_mem_atlas _ _, rfl⟩ + +/-- The chart at a configuration is the identification with the unit circle followed by the chart + of the circle at the corresponding point. -/ +lemma chartAt_eq (q : ConfigurationSpace) : + chartAt (EuclideanSpace ℝ (Fin 1)) q = + circleHomeomorph.toOpenPartialHomeomorph.trans + (chartAt (EuclideanSpace ℝ (Fin 1)) q.toCircle) := rfl + +/-- The domain of the chart at a configuration is the preimage under the identification with the + unit circle of the domain of the chart of the circle at the corresponding point. -/ +lemma chartAt_source (q : ConfigurationSpace) : + (chartAt (EuclideanSpace ℝ (Fin 1)) q).source = + circleHomeomorph ⁻¹' (chartAt (EuclideanSpace ℝ (Fin 1)) q.toCircle).source := by + rw [chartAt_eq, OpenPartialHomeomorph.trans_source] + simp + +/-- The codomain of the chart at a configuration is the codomain of the chart of the circle at the + corresponding point. -/ +lemma chartAt_target (q : ConfigurationSpace) : + (chartAt (EuclideanSpace ℝ (Fin 1)) q).target = + (chartAt (EuclideanSpace ℝ (Fin 1)) q.toCircle).target := by + rw [chartAt_eq, OpenPartialHomeomorph.trans_target] + simp + +/-- The configuration space is an analytic manifold: every change of charts is a change of charts + of the unit circle. -/ +instance instIsManifold : IsManifold (𝓡 1) ω ConfigurationSpace where + compatible := by + rintro _ _ ⟨e₁, he₁, rfl⟩ ⟨e₂, he₂, rfl⟩ + -- The identification `h` with the circle is global, so `h.symm ≫ₕ h` is the identity. + have hself : circleHomeomorph.toOpenPartialHomeomorph.symm.trans + circleHomeomorph.toOpenPartialHomeomorph = OpenPartialHomeomorph.refl Circle := by + rw [← Homeomorph.symm_toOpenPartialHomeomorph, ← Homeomorph.trans_toOpenPartialHomeomorph, + Homeomorph.symm_trans_self, Homeomorph.refl_toOpenPartialHomeomorph] + -- Hence it cancels in the change of charts, which is therefore that of the circle. + have hcancel : (circleHomeomorph.toOpenPartialHomeomorph.trans e₁).symm.trans + (circleHomeomorph.toOpenPartialHomeomorph.trans e₂) = e₁.symm.trans e₂ := by + rw [OpenPartialHomeomorph.trans_symm_eq_symm_trans_symm, OpenPartialHomeomorph.trans_assoc, + ← OpenPartialHomeomorph.trans_assoc circleHomeomorph.toOpenPartialHomeomorph.symm, + hself, OpenPartialHomeomorph.refl_trans] + rw [hcancel] + exact HasGroupoid.compatible he₁ he₂ + +/-! + +## D. The angular lift + +`ofAngle θ` is the configuration at angle `θ` from the downward vertical. It is the quotient map +`ℝ → ℝ / 2πℤ`, a covering map of the circle: it is continuous, surjective and `2π`-periodic, and +two angles give the same configuration exactly when they differ by a whole number of turns. The +dynamics of the pendulum are written for a real-valued lift of the angle; this section is what +makes different lifts describe the same configuration. In the charts pulled back from the circle +is `Circle.exp`, so it is analytic. + +-/ + +/-- The configuration at angle `θ` (measured from the downward vertical). -/ +def ofAngle (θ : ℝ) : ConfigurationSpace := ⟨θ⟩ + +/-- The angle of the configuration at angle `θ` is `θ` modulo `2π`. -/ +@[simp] +lemma ofAngle_angle (θ : ℝ) : (ofAngle θ).angle = θ := rfl + +/-- Adding a full turn to the angle leaves the configuration unchanged. -/ +lemma ofAngle_add_two_pi (θ : ℝ) : ofAngle (θ + 2 * Real.pi) = ofAngle θ := by + ext + simp [Real.Angle.coe_add, Real.Angle.coe_two_pi] + +/-- The angular lift is periodic with period `2π`. -/ +lemma ofAngle_periodic : Function.Periodic ofAngle (2 * Real.pi) := ofAngle_add_two_pi + +/-- Two angles describe the same configuration exactly when they differ by a whole number of + turns. -/ +lemma ofAngle_eq_iff (θ₁ θ₂ : ℝ) : + ofAngle θ₁ = ofAngle θ₂ ↔ ∃ n : ℤ, θ₂ = θ₁ + n * (2 * Real.pi) := by + constructor + · intro h + obtain ⟨k, hk⟩ := + Real.Angle.angle_eq_iff_two_pi_dvd_sub.mp (congrArg ConfigurationSpace.angle h) + exact ⟨-k, by push_cast; linarith⟩ + · rintro ⟨n, rfl⟩ + exact ConfigurationSpace.ext + (Real.Angle.angle_eq_iff_two_pi_dvd_sub.mpr ⟨-n, by push_cast; ring⟩) + +/-- Every configuration is the configuration at some real angle: the lift is surjective. -/ +lemma ofAngle_surjective : Function.Surjective ofAngle := by + rintro ⟨φ⟩ + induction φ using Real.Angle.induction_on + next θ => exact ⟨θ, rfl⟩ + +/-- The angular lift is continuous. -/ +@[fun_prop] +lemma continuous_ofAngle : Continuous ofAngle := + continuous_induced_rng.mpr Real.Angle.continuous_coe + +/-- The angular lift is a covering map. -/ +lemma isCoveringMap_ofAngle : IsCoveringMap ofAngle := by + have h : IsCoveringMap ((↑) : ℝ → Real.Angle) := AddCircle.isCoveringMap_coe (2 * Real.pi) + have he : ofAngle = ⇑angleHomeomorph.symm ∘ ((↑) : ℝ → Real.Angle) := rfl + rw [he] + exact h.homeomorph_comp angleHomeomorph.symm + +/-- The configuration at angle `θ` corresponds to the point `e^{iθ}` of the unit circle. -/ +@[simp] +lemma toCircle_ofAngle (θ : ℝ) : (ofAngle θ).toCircle = Circle.exp θ := Real.Angle.toCircle_coe θ + +/-- The configuration of a point `e^{iθ}` of the unit circle is `ofAngle θ`. -/ +@[simp] +lemma ofCircle_circleExp (θ : ℝ) : ofCircle (Circle.exp θ) = ofAngle θ := by + rw [← toCircle_ofAngle, ofCircle_toCircle] + +/-- The angular lift is analytic: read in the charts pulled back from the circle it is + `Circle.exp`. -/ +lemma contMDiff_ofAngle : ContMDiff 𝓘(ℝ, ℝ) (𝓡 1) ω ofAngle := by + rw [contMDiff_iff] + refine ⟨continuous_ofAngle, fun x y => ?_⟩ + have h := (contMDiff_iff.mp (contMDiff_circleExp (m := ω))).2 x y.toCircle + -- Two goals remain: the map read in the charts, and the domain on which it is read. + convert h using 2 + · rfl + · ext θ + simp [chartAt_eq, circleHomeomorph_apply, toCircle_ofAngle] + +/-- The cosine of the angle of a configuration. -/ +def cos (q : ConfigurationSpace) : ℝ := Real.Angle.cos q.angle + +/-- The sine of the angle of a configuration. -/ +def sin (q : ConfigurationSpace) : ℝ := Real.Angle.sin q.angle + +/-- The cosine of a configuration is the cosine of its angle. -/ +lemma cos_angle (q : ConfigurationSpace) : q.cos = Real.Angle.cos q.angle := rfl + +/-- The sine of a configuration is the sine of its angle. -/ +lemma sin_angle (q : ConfigurationSpace) : q.sin = Real.Angle.sin q.angle := rfl + +/-- The cosine of the configuration at angle `θ` is `cos θ`. -/ +@[simp] +lemma cos_ofAngle (θ : ℝ) : (ofAngle θ).cos = Real.cos θ := Real.Angle.cos_coe θ + +/-- The sine of the configuration at angle `θ` is `sin θ`. -/ +@[simp] +lemma sin_ofAngle (θ : ℝ) : (ofAngle θ).sin = Real.sin θ := Real.Angle.sin_coe θ + +/-- The Pythagorean identity for the angle of a configuration. -/ +lemma cos_sq_add_sin_sq (q : ConfigurationSpace) : q.cos ^ 2 + q.sin ^ 2 = 1 := + Real.Angle.cos_sq_add_sin_sq q.angle + +/-- The cosine of the angle depends continuously on the configuration. -/ +@[fun_prop] +lemma continuous_cos : Continuous (cos : ConfigurationSpace → ℝ) := + Real.Angle.continuous_cos.comp continuous_induced_dom + +/-- The sine of the angle depends continuously on the configuration. -/ +@[fun_prop] +lemma continuous_sin : Continuous (sin : ConfigurationSpace → ℝ) := + Real.Angle.continuous_sin.comp continuous_induced_dom + +/-! + +## E. Map to physical space + +The pivot is the origin of the plane `Space 2`, the first coordinate is horizontal and the second +points upwards. A rod of length `ℓ` at angle `θ` from the downward vertical places the bob at +`(ℓ sin θ, -ℓ cos θ)`; at `θ = 0` the bob hangs straight down at `(0, -ℓ)`. The bob lies on the +circle of radius `|ℓ|` about the pivot — the rod-length constraint — and for `ℓ ≠ 0` the map is +injective, so the configuration is determined by the position. + +-/ + +/-- The position of the bob in the plane, for a rod of length `ℓ`. `ℓ` is not assumed positive; the + bob is at distance `|ℓ|` from the pivot. -/ +def toSpace (ℓ : ℝ) (q : ConfigurationSpace) : Space 2 := ⟨![ℓ * q.sin, -ℓ * q.cos]⟩ + +/-- The horizontal coordinate of the bob, `ℓ * q.sin`. -/ +@[simp] +lemma toSpace_apply_zero (ℓ : ℝ) (q : ConfigurationSpace) : + toSpace ℓ q 0 = ℓ * q.sin := rfl + +/-- The vertical coordinate of the bob, `-(ℓ * q.cos)`. -/ +@[simp] +lemma toSpace_apply_one (ℓ : ℝ) (q : ConfigurationSpace) : + toSpace ℓ q 1 = -(ℓ * q.cos) := neg_mul ℓ q.cos + +/-- The position of the bob for the configuration at angle `θ`. -/ +@[simp] +lemma toSpace_ofAngle (ℓ θ : ℝ) : + toSpace ℓ (ofAngle θ) = ⟨![ℓ * Real.sin θ, -ℓ * Real.cos θ]⟩ := by + simp [toSpace] + +/-- The rod-length constraint: the bob is at distance `|ℓ|` from the pivot. -/ +@[simp] +lemma toSpace_norm (ℓ : ℝ) (q : ConfigurationSpace) : ‖toSpace ℓ q‖ = |ℓ| := by + have hq : (ℓ * q.sin) ^ 2 + (-(ℓ * q.cos)) ^ 2 = ℓ ^ 2 := by + linear_combination ℓ ^ 2 * cos_sq_add_sin_sq q + rw [Space.norm_eq, Fin.sum_univ_two, toSpace_apply_zero, toSpace_apply_one, hq, + Real.sqrt_sq_eq_abs] + +/-- The position of the bob depends continuously on the configuration. -/ +@[fun_prop] +lemma continuous_toSpace (ℓ : ℝ) : Continuous (toSpace ℓ) := by + refine Space.mk_continuous.comp (continuous_pi fun i => ?_) + fin_cases i <;> simp <;> fun_prop + +/-- For a rod of nonzero length the configuration is determined by the position of the bob. -/ +lemma toSpace_injective {ℓ : ℝ} (hℓ : ℓ ≠ 0) : Function.Injective (toSpace ℓ) := by + -- Equality of angles is detected by their cosine and sine. + have key : ∀ θ ψ : Real.Angle, θ.cos = ψ.cos → θ.sin = ψ.sin → θ = ψ := by + intro θ ψ + induction θ using Real.Angle.induction_on + induction ψ using Real.Angle.induction_on + simpa using Real.Angle.cos_sin_inj + intro q₁ q₂ h + have h0 : ℓ * q₁.sin = ℓ * q₂.sin := congrArg (fun p : Space 2 => p 0) h + have h1 : -ℓ * q₁.cos = -ℓ * q₂.cos := congrArg (fun p : Space 2 => p 1) h + exact ConfigurationSpace.ext + (key _ _ (mul_left_cancel₀ (neg_ne_zero.mpr hℓ) h1) (mul_left_cancel₀ hℓ h0)) + +/-- For `ℓ ≠ 0` the position map is a closed embedding of the configuration circle. -/ +lemma toSpace_isClosedEmbedding {ℓ : ℝ} (hℓ : ℓ ≠ 0) : Topology.IsClosedEmbedding (toSpace ℓ) := + (continuous_toSpace ℓ).isClosedEmbedding (toSpace_injective hℓ) + +end ConfigurationSpace +end SimplePendulum +end ClassicalMechanics + +end diff --git a/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Geometric/PhysicalSpace.lean b/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Geometric/PhysicalSpace.lean new file mode 100644 index 0000000000..1c6abfb821 --- /dev/null +++ b/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Geometric/PhysicalSpace.lean @@ -0,0 +1,226 @@ +/- +Copyright (c) 2026 Aadarsh Agarwal. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Aadarsh Agarwal +-/ +module + +public import Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Basic +public import Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Geometric.Trajectory +/-! + +# The simple pendulum in physical space + +## i. Overview + +The trajectory module places the bob in the plane along a lifted trajectory; this module fixes a +simple pendulum `S` and identifies the dynamics of `SimplePendulum.Basic`, written on the +Euclidean lift of the angle, with the dynamics of the bob moving in physical space. Along a lift +`θ` the bob is at `S.spaceTrajectory θ`, at the fixed distance `ℓ` from the pivot; its velocity +is obtained by differentiating the position componentwise, and the square of its speed is +`ℓ² θ̇²`. The chart kinetic energy `½ I θ̇²` is then exactly the kinetic energy `½ m ‖v‖²` of +the bob, the chart potential energy `m g ℓ (1 - cos θ)` is exactly the gravitational potential +`m g h` of the bob with the height `h` measured from the bottom of the swing, and the chart +Lagrangian is the constrained Lagrangian `T - V` of a point mass moving on the circle of radius +`ℓ` about the pivot. Velocities in this module are physical-space time derivatives; the +geometric velocity as a tangent vector to the configuration circle is deferred, as discussed in +the trajectory module. + +## ii. Key results + +- `SimplePendulum.spaceTrajectory` : the bob's position in the plane along a lifted trajectory, + with the rod-length constraint `SimplePendulum.norm_spaceTrajectory`. +- `SimplePendulum.deriv_spaceTrajectory` : the bob's velocity along a lifted trajectory, with + the square of its speed `SimplePendulum.norm_sq_deriv_spaceTrajectory`. +- `SimplePendulum.kineticEnergy_eq_space`, `SimplePendulum.potentialEnergy_eq_height` and + `SimplePendulum.lagrangian_eq_space` : the chart kinetic energy, potential energy and + Lagrangian are those of the bob in physical space; `SimplePendulum.energy_eq_space` is the + corresponding statement for the total energy. + +## iii. Table of contents + +- A. The bob's position along a lifted trajectory +- B. The bob's velocity and speed +- C. The energies and the Lagrangian in physical space + +## iv. References + +* `Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Basic` (the lifted dynamics: the energies and + the Lagrangian on the Euclidean lift of the angle). +* `Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Geometric.Trajectory` (trajectories on the + configuration circle and the position of the bob along them). +* Landau & Lifshitz, Mechanics, 3rd ed., §5, Problems 1–3 (pendulum configurations). + [ref: landau_mechanics] +-/ + +@[expose] public section + +open Real InnerProductSpace Time + +namespace ClassicalMechanics.SimplePendulum + +variable (S : SimplePendulum) + +/-! + +## A. The bob's position along a lifted trajectory + +Fixing a pendulum `S`, the position of the bob in the plane along the trajectory described by a +lift `θ` of the angle is obtained by composing the lifted trajectory with the map to physical +space for a rod of length `S.ℓ`. Along it the bob is at `(ℓ sin θ, -ℓ cos θ)`, and since the +length of the rod is positive the bob stays at distance `ℓ` from the pivot at all times. + +-/ + +/-- The position of the bob in the plane along the trajectory described by a lift `θ` of the + angle, for the pendulum `S`. -/ +noncomputable def spaceTrajectory (θ : Time → EuclideanSpace ℝ (Fin 1)) : Time → Space 2 := + Trajectory.toSpace S.ℓ (Trajectory.ofLift θ) + +/-- Along the trajectory described by a lift `θ` of the angle the bob of the pendulum `S` is at + `(ℓ sin (θ t 0), -ℓ cos (θ t 0))`. -/ +lemma spaceTrajectory_eq (θ : Time → EuclideanSpace ℝ (Fin 1)) : + S.spaceTrajectory θ = fun t => ⟨![S.ℓ * Real.sin (θ t 0), -S.ℓ * Real.cos (θ t 0)]⟩ := + funext fun t => Trajectory.toSpace_ofLift S.ℓ θ t + +/-- The horizontal position of the bob along a lifted trajectory is `ℓ sin (θ t 0)`. -/ +lemma spaceTrajectory_apply_zero (θ : Time → EuclideanSpace ℝ (Fin 1)) (t : Time) : + S.spaceTrajectory θ t 0 = S.ℓ * Real.sin (θ t 0) := by + simp [S.spaceTrajectory_eq θ] + +/-- The vertical position of the bob along a lifted trajectory is `-ℓ cos (θ t 0)`, the pivot + being the origin and the second axis pointing upwards. -/ +lemma spaceTrajectory_apply_one (θ : Time → EuclideanSpace ℝ (Fin 1)) (t : Time) : + S.spaceTrajectory θ t 1 = -S.ℓ * Real.cos (θ t 0) := by + simp [S.spaceTrajectory_eq θ] + +/-- The rod-length constraint along a lifted trajectory: the bob of the pendulum `S` stays at + distance `ℓ` from the pivot, the length of the rod being positive. -/ +lemma norm_spaceTrajectory (θ : Time → EuclideanSpace ℝ (Fin 1)) (t : Time) : + ‖S.spaceTrajectory θ t‖ = S.ℓ := + (Trajectory.norm_toSpace S.ℓ (Trajectory.ofLift θ) t).trans (abs_of_pos S.ℓ_pos) + +/-! + +## B. The bob's velocity and speed + +Differentiating the position of the bob componentwise gives its velocity in the plane: along a +differentiable lift the bob's position is differentiable in time, and its velocity is +`(ℓ cos θ, ℓ sin θ)` times the angular velocity — the vector tangent to the circle of radius +`ℓ`, of length `ℓ |θ̇|`. The square of the speed is therefore `ℓ² θ̇²`, which is the identity +behind the identification of the kinetic energies in the next section. The two chain-rule +computations for the sine and the cosine of the angle read from a lift are recorded as +stand-alone lemmas. + +-/ + +/-- The time derivative of the sine of the angle read from a lift is the cosine of the angle + times the angular velocity. -/ +lemma deriv_sin_coord (θ : Time → EuclideanSpace ℝ (Fin 1)) (hθ : Differentiable ℝ θ) + (t : Time) : ∂ₜ (fun s => Real.sin (θ s 0)) t = Real.cos (θ t 0) * (∂ₜ θ t) 0 := by + rw [Time.deriv_eq, fderiv_sin, smul_apply, smul_eq_mul, ← Time.deriv_eq, Time.deriv_euclid hθ t] + fun_prop + +/-- The time derivative of the cosine of the angle read from a lift is minus the sine of the + angle times the angular velocity. -/ +lemma deriv_cos_coord (θ : Time → EuclideanSpace ℝ (Fin 1)) (hθ : Differentiable ℝ θ) + (t : Time) : ∂ₜ (fun s => Real.cos (θ s 0)) t = -Real.sin (θ t 0) * (∂ₜ θ t) 0 := by + rw [Time.deriv_eq, fderiv_cos, smul_apply, smul_eq_mul, ← Time.deriv_eq, Time.deriv_euclid hθ t] + fun_prop + +/-- Along a differentiable lift of the angle the position of the bob is differentiable in + time. -/ +@[fun_prop] +lemma differentiable_spaceTrajectory (θ : Time → EuclideanSpace ℝ (Fin 1)) + (hθ : Differentiable ℝ θ) : Differentiable ℝ (S.spaceTrajectory θ) := by + rw [S.spaceTrajectory_eq θ] + apply Space.mk_differentiable.comp + rw [differentiable_pi] + intro i + fin_cases i <;> (simp; fun_prop) + +/-- The velocity of the bob along a differentiable lift `θ` of the angle is + `(ℓ cos (θ t 0), ℓ sin (θ t 0))` times the angular velocity: the vector tangent to the circle + of radius `ℓ` at the position of the bob. -/ +lemma deriv_spaceTrajectory (θ : Time → EuclideanSpace ℝ (Fin 1)) (hθ : Differentiable ℝ θ) + (t : Time) : + ∂ₜᵥ (S.spaceTrajectory θ) t = + !₂[S.ℓ * Real.cos (θ t 0) * (∂ₜ θ t) 0, S.ℓ * Real.sin (θ t 0) * (∂ₜ θ t) 0] := by + refine PiLp.ext fun i ↦ ?_ + fin_cases i <;> apply (Time.derivVec_space (by fun_prop) t _).trans + · simp only [S.spaceTrajectory_apply_zero, Fin.zero_eta, Matrix.cons_val_zero] + rw [Time.deriv_eq, fderiv_const_mul, smul_apply, smul_eq_mul, ← Time.deriv, deriv_sin_coord, + mul_assoc] + all_goals fun_prop + · simp only [Fin.mk_one, S.spaceTrajectory_apply_one, Matrix.cons_val_one, Matrix.cons_val_zero] + rw [Time.deriv_eq, fderiv_const_mul, smul_apply, smul_eq_mul, ← Time.deriv, deriv_cos_coord] + ring + all_goals fun_prop + +/-- The square of the speed of the bob along a differentiable lift of the angle is `ℓ² θ̇²`. -/ +lemma norm_sq_deriv_spaceTrajectory (θ : Time → EuclideanSpace ℝ (Fin 1)) + (hθ : Differentiable ℝ θ) (t : Time) : + ‖∂ₜᵥ (S.spaceTrajectory θ) t‖ ^ 2 = S.ℓ ^ 2 * ((∂ₜ θ t) 0) ^ 2 := by + rw [S.deriv_spaceTrajectory θ hθ t, EuclideanSpace.real_norm_sq_eq, Fin.sum_univ_two] + show (S.ℓ * Real.cos (θ t 0) * (∂ₜ θ t) 0) ^ 2 + + (S.ℓ * Real.sin (θ t 0) * (∂ₜ θ t) 0) ^ 2 = _ + linear_combination S.ℓ ^ 2 * ((∂ₜ θ t) 0) ^ 2 * Real.sin_sq_add_cos_sq (θ t 0) + +/-! + +## C. The energies and the Lagrangian in physical space + +The identities of the previous section identify the energies of `SimplePendulum.Basic`, written +on the lift of the angle, with the energies of the bob in the plane. The chart kinetic energy +`½ I θ̇²` is the kinetic energy `½ m ‖v‖²` of the bob, since `I = m ℓ²` and the square of the +speed is `ℓ² θ̇²`; the chart potential energy `m g ℓ (1 - cos θ)` is the gravitational +potential `m g h` of the bob, the height `h` above the bottom of the swing being the vertical +position of the bob plus `ℓ`. Consequently the chart Lagrangian is the constrained Lagrangian +`T - V` of a point mass moving on the circle of radius `ℓ`, and the chart energy is its total +energy `T + V`. + +-/ + +/-- The chart kinetic energy of the pendulum along a differentiable lift of the angle is the + kinetic energy of the bob in physical space. -/ +lemma kineticEnergy_eq_space (θ : Time → EuclideanSpace ℝ (Fin 1)) (hθ : Differentiable ℝ θ) + (t : Time) : + S.kineticEnergy θ t = (1 / (2 : ℝ)) * S.m * ‖∂ₜᵥ (S.spaceTrajectory θ) t‖ ^ 2 := by + rw [S.norm_sq_deriv_spaceTrajectory θ hθ t] + show (1 / (2 : ℝ)) * (S.m * S.ℓ ^ 2) * ⟪∂ₜ θ t, ∂ₜ θ t⟫_ℝ = _ + rw [PiLp.inner_apply, Fin.sum_univ_one, RCLike.inner_apply, conj_trivial] + ring + +/-- The chart potential energy of the pendulum is the gravitational potential of the bob in + physical space, normalized to vanish at the bottom of the swing: the height of the bob above + the bottom is its vertical position plus `ℓ`. -/ +lemma potentialEnergy_eq_height (θ : Time → EuclideanSpace ℝ (Fin 1)) (t : Time) : + S.potentialEnergy (θ t) = S.m * S.g * (S.spaceTrajectory θ t 1 + S.ℓ) := by + rw [S.potentialEnergy_eq (θ t), S.spaceTrajectory_apply_one θ t] + ring + +/-- The chart Lagrangian of the pendulum along a differentiable lift of the angle is the + constrained Lagrangian of the bob in physical space: the kinetic energy of the point mass + minus its gravitational potential. -/ +lemma lagrangian_eq_space (θ : Time → EuclideanSpace ℝ (Fin 1)) (hθ : Differentiable ℝ θ) + (t : Time) : + S.lagrangian t (θ t) (∂ₜ θ t) = + (1 / (2 : ℝ)) * S.m * ‖∂ₜᵥ (S.spaceTrajectory θ) t‖ ^ 2 + - S.m * S.g * (S.spaceTrajectory θ t 1 + S.ℓ) := by + rw [S.lagrangian_eq_kineticEnergy_sub_potentialEnergy t θ, S.kineticEnergy_eq_space θ hθ t, + S.potentialEnergy_eq_height θ t] + +/-- The chart energy of the pendulum along a differentiable lift of the angle is the total + energy of the bob in physical space: the kinetic energy of the point mass plus its + gravitational potential. -/ +lemma energy_eq_space (θ : Time → EuclideanSpace ℝ (Fin 1)) (hθ : Differentiable ℝ θ) + (t : Time) : + S.energy θ t = + (1 / (2 : ℝ)) * S.m * ‖∂ₜᵥ (S.spaceTrajectory θ) t‖ ^ 2 + + S.m * S.g * (S.spaceTrajectory θ t 1 + S.ℓ) := by + rw [← S.kineticEnergy_eq_space θ hθ t, ← S.potentialEnergy_eq_height θ t] + rfl + +end ClassicalMechanics.SimplePendulum + +end diff --git a/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Geometric/Trajectory.lean b/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Geometric/Trajectory.lean new file mode 100644 index 0000000000..6f5fe149ab --- /dev/null +++ b/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Geometric/Trajectory.lean @@ -0,0 +1,161 @@ +/- +Copyright (c) 2026 Aadarsh Agarwal. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Aadarsh Agarwal +-/ +module + +public import Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Geometric.Basic +public import Physlib.SpaceAndTime.Time.Basic +public import Mathlib.Geometry.Manifold.ContMDiff.NormedSpace +/-! + +# Geometric trajectories of the simple pendulum + +## i. Overview + +A trajectory of the simple pendulum is a time-parametrized curve in the configuration circle. +The dynamics of the pendulum is written for a real-valued lift of the angle; +`Trajectory.ofLift` sends such a lift to the trajectory it describes on the circle, by applying +the angular lift `ConfigurationSpace.ofAngle` at each time. Two lifts describe the same +trajectory exactly when at each time they differ by a whole number of turns, a smooth lift +describes a smooth curve in the circle, and composing with `ConfigurationSpace.toSpace` places +the bob in the plane along the trajectory, at distance `|ℓ|` from the pivot at all times. + +The geometric velocity — the `mfderiv` of a trajectory as a tangent vector to the circle, read +in its stereographic charts — is left for a later module, as is the smooth identification of +the configuration space with `Circle`; in this module and the next, velocities are computed in +physical space, on the position of the bob in the plane. + +## ii. Key results + +- `Trajectory` : a trajectory of the pendulum, a curve in the configuration circle. +- `Trajectory.ofLift` : the trajectory described by a lift of the angle, with + `Trajectory.ofLift_add_int_mul_two_pi` and `Trajectory.ofLift_eq_iff` making precise that two + lifts describe the same trajectory exactly when they differ by whole turns at each time. +- `Trajectory.contMDiff_ofLift` : the trajectory described by a `C^n` lift is a `C^n` curve in + the configuration circle; `Trajectory.continuous_ofLift` is the topological counterpart. +- `Trajectory.toSpace` : the physical position of the bob along a trajectory, with the + rod-length constraint `Trajectory.norm_toSpace`. + +## iii. Table of contents + +- A. The trajectory type and the lift +- B. Smoothness of lifted trajectories +- C. Physical position along a trajectory + +## iv. References + +* `Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Geometric.Basic` (the configuration circle, + the angular lift `ofAngle` and the map to physical space). +* `Physlib.ClassicalMechanics.HarmonicOscillator.Geometric.Trajectory` (the corresponding trajectory + module of the harmonic oscillator, whose structure this module follows). +-/ + +@[expose] public section + +noncomputable section + +open scoped Manifold + +namespace ClassicalMechanics.SimplePendulum + +/-! + +## A. The trajectory type and the lift + +A trajectory is a curve in the configuration circle, parametrized by `Time`. The dynamics is +written for the Euclidean lift `Time → EuclideanSpace ℝ (Fin 1)` of the angle; `ofLift` sends a +lift to the trajectory it describes, and the lift is faithful up to a whole number of turns at +each time: shifting a lift by `2π n` gives the same trajectory, and two lifts give the same +trajectory exactly when at each time they differ by some whole number of turns (possibly a +different number at different times). + +-/ + +/-- A trajectory of the pendulum: a curve in the configuration space. -/ +abbrev Trajectory := Time → ConfigurationSpace + +namespace Trajectory + +/-- The trajectory on the circle described by a lift `θ` of the angle. -/ +def ofLift (θ : Time → EuclideanSpace ℝ (Fin 1)) : Trajectory := fun t => + ConfigurationSpace.ofAngle (θ t 0) + +/-- At time `t` the trajectory described by a lift `θ` of the angle is the configuration at + angle `θ t 0`. -/ +lemma ofLift_apply (θ : Time → EuclideanSpace ℝ (Fin 1)) (t : Time) : + ofLift θ t = ConfigurationSpace.ofAngle (θ t 0) := rfl + +/-- Two lifts of the angle describe the same trajectory exactly when at each time they differ by + a whole number of turns. -/ +lemma ofLift_eq_iff (θ₁ θ₂ : Time → EuclideanSpace ℝ (Fin 1)) : + ofLift θ₁ = ofLift θ₂ ↔ ∀ t, ∃ n : ℤ, θ₂ t 0 = θ₁ t 0 + n * (2 * Real.pi) := by + simp only [funext_iff, ofLift_apply, ConfigurationSpace.ofAngle_eq_iff] + +/-- Shifting a lift of the angle by a whole number of turns leaves the described trajectory + unchanged. -/ +lemma ofLift_add_int_mul_two_pi (θ : Time → EuclideanSpace ℝ (Fin 1)) (n : ℤ) : + ofLift (fun t => θ t + (n * (2 * Real.pi)) • EuclideanSpace.single 0 1) = ofLift θ := by + rw [ofLift_eq_iff] + intro + exact ⟨-n, by simp⟩ + +/-! + +## B. Smoothness of lifted trajectories + +The angular lift `ConfigurationSpace.ofAngle` is analytic, so the trajectory described by a lift +inherits the regularity of the lift: a continuous lift describes a continuous trajectory, and a +`C^n` lift describes a `C^n` curve in the configuration circle. Since `Time` is a normed space, +smoothness of the lift is ordinary `ContDiff` smoothness, while smoothness of the trajectory is +manifold smoothness into the circle. + +-/ + +/-- The trajectory described by a continuous lift of the angle is continuous. -/ +lemma continuous_ofLift {θ : Time → EuclideanSpace ℝ (Fin 1)} (hθ : Continuous θ) : + Continuous (ofLift θ) := + ConfigurationSpace.continuous_ofAngle.comp + ((EuclideanSpace.proj (0 : Fin 1)).continuous.comp hθ) + +/-- The trajectory described by a `C^n` lift of the angle is a `C^n` curve in the configuration + circle. -/ +lemma contMDiff_ofLift {n : WithTop ℕ∞} {θ : Time → EuclideanSpace ℝ (Fin 1)} + (hθ : ContDiff ℝ n θ) : ContMDiff 𝓘(ℝ, Time) (𝓡 1) n (ofLift θ) := by + apply (ConfigurationSpace.contMDiff_ofAngle.of_le le_top).comp (contMDiff_iff_contDiff.mpr _) + exact (ContinuousLinearMap.contDiff (𝕜 := ℝ) (EuclideanSpace.proj (0 : Fin 1))).comp hθ + +/-! + +## C. Physical position along a trajectory + +Composing a trajectory with the map to physical space places the bob in the plane at each time. +Along the trajectory described by a lift the bob is at `(ℓ sin θ, -ℓ cos θ)`, and the rod-length +constraint holds at all times: the bob stays on the circle of radius `|ℓ|` about the pivot. + +-/ + +/-- The physical position of the bob along a trajectory, over time, for a rod of length `ℓ`. -/ +def toSpace (ℓ : ℝ) (γ : Trajectory) (t : Time) : Space 2 := (γ t).toSpace ℓ + +/-- Along the trajectory described by a lift `θ` of the angle the bob is at + `(ℓ sin (θ t 0), -ℓ cos (θ t 0))`. -/ +lemma toSpace_ofLift (ℓ : ℝ) (θ : Time → EuclideanSpace ℝ (Fin 1)) (t : Time) : + toSpace ℓ (ofLift θ) t = ⟨![ℓ * Real.sin (θ t 0), -ℓ * Real.cos (θ t 0)]⟩ := + ConfigurationSpace.toSpace_ofAngle ℓ (θ t 0) + +/-- The rod-length constraint along a trajectory: the bob stays at distance `|ℓ|` from the + pivot. -/ +lemma norm_toSpace (ℓ : ℝ) (γ : Trajectory) (t : Time) : ‖toSpace ℓ γ t‖ = |ℓ| := + ConfigurationSpace.toSpace_norm ℓ (γ t) + +/-- The physical position of the bob along a continuous trajectory depends continuously on the + time. -/ +lemma continuous_toSpace (ℓ : ℝ) {γ : Trajectory} (hγ : Continuous γ) : + Continuous (toSpace ℓ γ) := + (ConfigurationSpace.continuous_toSpace ℓ).comp hγ + +end ClassicalMechanics.SimplePendulum.Trajectory + +end diff --git a/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Hamiltonian.lean b/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Hamiltonian.lean new file mode 100644 index 0000000000..cdab3617d2 --- /dev/null +++ b/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Hamiltonian.lean @@ -0,0 +1,327 @@ +/- +Copyright (c) 2026 Aadarsh Agarwal. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Aadarsh Agarwal +-/ +module + +public import Physlib.ClassicalMechanics.HamiltonsEquations +public import Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Basic +/-! + +# The Hamiltonian formulation of the simple pendulum + +## i. Overview + +This module gives the Hamiltonian formulation of the simple gravity pendulum, on the same +one-dimensional Euclidean lift of the angle as `SimplePendulum.Basic`. The canonical momentum +conjugate to the angle is the gradient of the Lagrangian in the angular velocity, the angular +momentum `p = I θ̇` about the pivot; since the moment of inertia is positive, taking the +canonical momentum is a linear equivalence between velocities and momenta. The Hamiltonian is +the Legendre transform `H = ⟪p, θ̇⟫ - L` of the Lagrangian, which works out to the energy +written on momentum-angle phase space, `H(t, p, θ) = ½ (1/I) ‖p‖² + V(θ)`; along any lift of +the angle it is the energy of the lift. Hamilton's equations for the pendulum are packaged, as +for the harmonic oscillator, into the vanishing of an operator on phase space, and for a smooth +lift of the angle they are equivalent to the equation of motion of `SimplePendulum.Basic`. + +## ii. Key results + +- `SimplePendulum.canonicalMomentum` is the canonical momentum `p = ∂L/∂θ̇ = I θ̇`, as a + linear equivalence between velocities and momenta, with its value recorded by + `canonicalMomentum_eq`. +- `SimplePendulum.hamiltonian` is the Legendre transform of the Lagrangian, computed by + `hamiltonian_eq` to be `½ (1/I) ‖p‖² + V(θ)`, smooth by `hamiltonian_contDiff`, with the + two partial gradients `gradient_hamiltonian_position_eq` and + `gradient_hamiltonian_momentum_eq`. +- `SimplePendulum.hamiltonian_eq_energy` identifies the Hamiltonian, evaluated along any lift + of the angle on its canonical momentum, with the energy of the lift. +- `SimplePendulum.hamiltonEqOp` is the operator on momentum-angle phase space whose vanishing + is Hamilton's equations, and `SimplePendulum.equationOfMotion_iff_hamiltonEqOp_eq_zero` + proves that, for a smooth lift of the angle, Hamilton's equations are equivalent to the + equation of motion. +- `SimplePendulum.equationOfMotion_tfae` gathers the formulations into a single equivalence: + for a smooth lift of the angle the equation of motion, its scalar form `θ̈ + ω² sin θ = 0`, + Hamilton's equations, and the Lagrangian and Hamiltonian variational principles are all + equivalent. + +## iii. Table of contents + +- A. The canonical momentum and the Hamiltonian + - A.1. The canonical momentum + - A.2. The Hamiltonian + - A.2.1. Equality for the Hamiltonian + - A.2.2. Smoothness of the Hamiltonian + - A.2.3. Gradients of the Hamiltonian + - A.3. Relation between Hamiltonian and energy + - A.4. Hamilton equation operator + - A.5. Equation of motion if and only if Hamilton's equations +- B. Equivalences between the formulations + +## iv. References + +References for the Hamiltonian formulation of the simple pendulum include: + +* Landau & Lifshitz, Mechanics, 3rd ed., §40, for the canonical momentum, the Hamiltonian as the + Legendre transform of the Lagrangian, and Hamilton's equations. [ref: landau_mechanics] +* The module `Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Basic`, whose Lagrangian, energy + and equation of motion this module reformulates. +-/ + +@[expose] public section + +namespace ClassicalMechanics + +open InnerProductSpace Time +open scoped ContDiff + +namespace SimplePendulum + +variable (S : SimplePendulum) + +/-! + +## A. The canonical momentum and the Hamiltonian + +We now turn to the Hamiltonian formulation of the simple pendulum. We define the canonical +momentum and the Hamiltonian, relate the Hamiltonian to the energy, and show that the equation +of motion is equivalent to Hamilton's equations. + +-/ + +/-! + +### A.1. The canonical momentum + +We define the canonical momentum as the gradient of the Lagrangian with respect to the angular +velocity. By `gradient_lagrangian_velocity_eq` this is the angular momentum `I θ̇` about the +pivot, and since the moment of inertia is positive it is a linear equivalence between +velocities and momenta. + +-/ + +/-- The canonical momentum of the simple pendulum, `p = ∂L/∂θ̇ = I θ̇`, as a linear + equivalence between velocities and momenta in the angular chart. -/ +noncomputable def canonicalMomentum (t : Time) (x : EuclideanSpace ℝ (Fin 1)) : + EuclideanSpace ℝ (Fin 1) ≃ₗ[ℝ] EuclideanSpace ℝ (Fin 1) where + toFun v := gradient (S.lagrangian t x ·) v + invFun p := (1 / S.inertia) • p + left_inv v := by simp [S.gradient_lagrangian_velocity_eq, smul_smul, S.inertia_ne_zero] + right_inv p := by simp [S.gradient_lagrangian_velocity_eq, smul_smul, S.inertia_ne_zero] + map_add' v1 v2 := by simp [S.gradient_lagrangian_velocity_eq] + map_smul' c v := by simp [S.gradient_lagrangian_velocity_eq]; module + +/-- The canonical momentum of the simple pendulum is the angular momentum `I θ̇` about the + pivot. -/ +lemma canonicalMomentum_eq (t : Time) (x v : EuclideanSpace ℝ (Fin 1)) : + S.canonicalMomentum t x v = S.inertia • v := + S.gradient_lagrangian_velocity_eq t x v + +/-! + +### A.2. The Hamiltonian + +The Hamiltonian is defined as a function of time, canonical momentum and angle, as the +Legendre transform +``` +H = ⟪p, θ̇⟫ - L(t, θ, θ̇) +``` +where the angular velocity `θ̇` is a function of `p` and `θ` through the inverse of the +canonical momentum. + +-/ + +/-- The Hamiltonian of the simple pendulum as a function of time, momentum and angle: the + Legendre transform `H(t, p, θ) = ⟪p, θ̇⟫ - L(t, θ, θ̇)` of the Lagrangian, the angular + velocity `θ̇` being recovered from the momentum by inverting the canonical momentum. -/ +noncomputable def hamiltonian (t : Time) (p x : EuclideanSpace ℝ (Fin 1)) : ℝ := + ⟪p, (S.canonicalMomentum t x).symm p⟫_ℝ - + S.lagrangian t x ((S.canonicalMomentum t x).symm p) + +/-! + +#### A.2.1. Equality for the Hamiltonian + +We prove a simple equality for the Hamiltonian, to help in computations: it is the kinetic +energy written in terms of the momentum, plus the potential energy. + +-/ + +/-- The Hamiltonian of the simple pendulum is the kinetic energy written in terms of the + momentum, `½ (1/I) ‖p‖²`, plus the potential energy. -/ +lemma hamiltonian_eq : + S.hamiltonian = fun _ p x => + (1 / (2 : ℝ)) * (1 / S.inertia) * ⟪p, p⟫_ℝ + S.potentialEnergy x := by + funext t p x + simp only [hamiltonian, canonicalMomentum, lagrangian, one_div, LinearEquiv.coe_symm_mk', + inner_smul_right, inner_smul_left, starRingEnd_apply, star_trivial] + field_simp [S.inertia_ne_zero] + ring + +/-! + +#### A.2.2. Smoothness of the Hamiltonian + +We show that the Hamiltonian is smooth in all its arguments jointly. + +-/ + +/-- The Hamiltonian of the simple pendulum is a smooth function of the time, the momentum and + the angle jointly. -/ +@[fun_prop] +lemma hamiltonian_contDiff (n : WithTop ℕ∞) : ContDiff ℝ n ↿S.hamiltonian := by + rw [hamiltonian_eq] + fun_prop + +/-! + +#### A.2.3. Gradients of the Hamiltonian + +We now write down the gradients of the Hamiltonian with respect to the angle and the momentum. +These are the two sides of Hamilton's equations. + +-/ + +/-- The gradient of the Hamiltonian of the simple pendulum in the angle is the gradient of the + potential energy, that is minus the torque. -/ +lemma gradient_hamiltonian_position_eq (t : Time) (x p : EuclideanSpace ℝ (Fin 1)) : + gradient (S.hamiltonian t p) x = gradient S.potentialEnergy x := by + have h : (fun y : EuclideanSpace ℝ (Fin 1) => S.hamiltonian t p y) = + fun y => S.potentialEnergy y + (1 / (2 : ℝ)) * (1 / S.inertia) * ⟪p, p⟫_ℝ := by + funext y + simp only [hamiltonian_eq] + ring + change gradient (fun y : EuclideanSpace ℝ (Fin 1) => S.hamiltonian t p y) x = + gradient S.potentialEnergy x + rw [h, gradient_add_const] + +/-- The gradient of the Hamiltonian of the simple pendulum in the momentum is the angular + velocity `(1/I) p` recovered from the momentum. -/ +lemma gradient_hamiltonian_momentum_eq (t : Time) (x p : EuclideanSpace ℝ (Fin 1)) : + gradient (S.hamiltonian t · x) p = (1 / S.inertia) • p := by + have h : (fun y : EuclideanSpace ℝ (Fin 1) => S.hamiltonian t y x) = + fun y => ((1 / (2 : ℝ)) * (1 / S.inertia)) * ⟪y, y⟫_ℝ + S.potentialEnergy x := by + funext y + simp only [hamiltonian_eq] + change gradient (fun y : EuclideanSpace ℝ (Fin 1) => S.hamiltonian t y x) p = + (1 / S.inertia) • p + rw [h, gradient_add_const, gradient_const_mul_inner_self] + module + +/-! + +### A.3. Relation between Hamiltonian and energy + +We show that the Hamiltonian, evaluated along any lift of the angle on the canonical momentum +of the lift, is the energy. This is independent of whether the lift satisfies the equation of +motion or not. + +-/ + +/-- Along any lift of the angle, the Hamiltonian of the simple pendulum evaluated on the + canonical momentum of the lift is the energy of the lift. This holds whether or not the lift + satisfies the equation of motion. -/ +lemma hamiltonian_eq_energy (θ : Time → EuclideanSpace ℝ (Fin 1)) : + (fun t => S.hamiltonian t (S.canonicalMomentum t (θ t) (∂ₜ θ t)) (θ t)) = S.energy θ := by + funext t + rw [hamiltonian_eq] + unfold energy kineticEnergy + simp only [canonicalMomentum_eq, inner_smul_left, inner_smul_right, starRingEnd_apply, + star_trivial] + field_simp [S.inertia_ne_zero] + +/-! + +### A.4. Hamilton equation operator + +We define the operator on momentum-angle phase space whose vanishing is equivalent to +Hamilton's equations. + +-/ + +/-- The Hamilton-equations operator of the Hamiltonian of the simple pendulum, on + momentum-angle phase space; its vanishing is equivalent to Hamilton's equations for the + momentum and the angle. -/ +noncomputable def hamiltonEqOp (p θ : Time → EuclideanSpace ℝ (Fin 1)) := + ClassicalMechanics.hamiltonEqOp S.hamiltonian p θ + +/-! + +### A.5. Equation of motion if and only if Hamilton's equations + +We show that, for a smooth lift of the angle, the equation of motion is equivalent to +Hamilton's equations for the lift and its canonical momentum, that is to the vanishing of the +Hamilton equation operator on the pair. The equation for the angle recovers the angular +velocity, and the equation for the momentum is the balance of the rate of change of the +angular momentum against the torque. + +-/ + +/-- For a smooth lift of the angle the equation of motion of the simple pendulum holds if and + only if Hamilton's equations hold for the lift and its canonical momentum, that is if and + only if the Hamilton-equations operator vanishes on the pair. -/ +lemma equationOfMotion_iff_hamiltonEqOp_eq_zero (θ : Time → EuclideanSpace ℝ (Fin 1)) + (hθ : ContDiff ℝ ∞ θ) : + S.EquationOfMotion θ ↔ + S.hamiltonEqOp (fun t => S.canonicalMomentum t (θ t) (∂ₜ θ t)) θ = 0 := by + rw [hamiltonEqOp, hamiltonEqOp_eq_zero_iff_hamiltons_equations, + S.equationOfMotion_iff_newtons_2nd_law θ] + simp only [canonicalMomentum_eq, gradient_hamiltonian_momentum_eq, one_div, smul_smul, + ne_eq, S.inertia_ne_zero, not_false_eq_true, inv_mul_cancel₀, one_smul, implies_true, + Time.deriv_smul _ S.inertia (deriv_differentiable_of_contDiff θ hθ), + gradient_hamiltonian_position_eq, true_and, eq_neg_iff_add_eq_zero] + +/-! + +## B. Equivalences between the formulations + +We gather the formulations of the dynamics of the simple pendulum into a single equivalence. +For a smooth lift of the angle the equation of motion, its scalar form, Hamilton's equations, +the Lagrangian variational principle and the Hamiltonian variational principle are all +equivalent. The equation of motion is itself the Newtonian formulation: the pointwise law is +the rotational form of Newton's second law, so, unlike for the harmonic oscillator, no +separate entry restates it. The equivalence of the equation of motion with the vanishing of +the variational derivative of the action lives in section G.1 of the `Basic` module; the +fourth entry states the same variational principle through the variational calculus directly. + +-/ + +/-- For a smooth lift of the angle the following formulations of the dynamics of the simple + pendulum are equivalent: + 1. the equation of motion, the pointwise rotational Newton law balancing the rate of change + of the angular momentum against the torque; + 2. the scalar mass-independent form `θ̈ + ω² sin θ = 0` of the equation of motion; + 3. Hamilton's equations for the lift and its canonical momentum, as the vanishing of the + Hamilton-equations operator; + 4. the Lagrangian variational principle, the vanishing of the variational gradient of the + action integral of the Lagrangian, written through the variational calculus directly; the + same principle, through the variational derivative of the action, is recorded standalone + as `equationOfMotion_iff_gradLagrangian_zero` in the `Basic` module; + 5. the Hamiltonian variational principle, the vanishing of the variational gradient of the + phase-space action on the pair of the canonical momentum and the lift. -/ +lemma equationOfMotion_tfae (θ : Time → EuclideanSpace ℝ (Fin 1)) (hθ : ContDiff ℝ ∞ θ) : + List.TFAE [S.EquationOfMotion θ, + ∀ t, ∂ₜ (∂ₜ θ) t 0 + S.ω ^ 2 * Real.sin (θ t 0) = 0, + S.hamiltonEqOp (fun t => S.canonicalMomentum t (θ t) (∂ₜ θ t)) θ = 0, + (δ (q':=θ), ∫ t, S.lagrangian t (q' t) (fderiv ℝ q' t 1)) = 0, + (δ (pq':= fun t => (S.canonicalMomentum t (θ t) (∂ₜ θ t), θ t)), + ∫ t, ⟪(pq' t).1, ∂ₜ (Prod.snd ∘ pq') t⟫_ℝ - + S.hamiltonian t (pq' t).1 (pq' t).2) = 0] := by + rw [← S.equationOfMotion_iff_hamiltonEqOp_eq_zero θ hθ, + ← S.equationOfMotion_iff_scalar θ] + rw [hamiltons_equations_varGradient, euler_lagrange_varGradient] + simp only [List.tfae_cons_self] + rw [← S.gradLagrangian_eq_eulerLagrangeOp θ hθ, + ← S.equationOfMotion_iff_gradLagrangian_zero θ hθ] + simp only [List.tfae_cons_self] + show List.TFAE [S.EquationOfMotion θ, + S.hamiltonEqOp (fun t => S.canonicalMomentum t (θ t) (∂ₜ θ t)) θ = 0] + rw [← S.equationOfMotion_iff_hamiltonEqOp_eq_zero θ hθ] + simp only [List.tfae_cons_self, List.tfae_singleton] + · exact hθ + · exact S.contDiff_lagrangian _ + · simp only [S.canonicalMomentum_eq]; fun_prop + · exact S.hamiltonian_contDiff _ + +end SimplePendulum + +end ClassicalMechanics diff --git a/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/LiftInvariance.lean b/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/LiftInvariance.lean new file mode 100644 index 0000000000..6d1e41d3c3 --- /dev/null +++ b/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/LiftInvariance.lean @@ -0,0 +1,203 @@ +/- +Copyright (c) 2026 Aadarsh Agarwal. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Aadarsh Agarwal +-/ +module + +public import Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Basic +public import Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Geometric.Basic +/-! + +# Independence of the lift for the simple pendulum + +## i. Overview + +The dynamics of the simple gravity pendulum in `SimplePendulum.Basic` is written on a lift of the +motion: the real angle `θ t 0` stands for the configuration `ConfigurationSpace.ofAngle (θ t 0)`, +and two lifts differing by a whole number of turns carry the same configurations. For the lifted +formulation to describe the pendulum faithfully, nothing dynamical may depend on the choice of +the lift. This module proves that the dynamical quantities — the potential and kinetic energies, +the torque, the energy, and the equation of motion together with its solutions — are invariant +under the deck transformations `θ ↦ θ + 2π n` of the angular lift, and closes by making the +starting point precise: the shifted lift describes the same configuration, by the periodicity of +the angular lift of the geometric configuration space. The packaging of this invariance at the +level of configuration-space trajectories comes with the geometric bridge in a later module. + +## ii. Key results + +- `SimplePendulum.potentialEnergy_add_int_mul_two_pi` and + `SimplePendulum.torque_add_int_mul_two_pi`: the potential energy and the torque are unchanged + by shifting the angle by a whole number of turns. +- `SimplePendulum.kineticEnergy_add_const` and `SimplePendulum.energy_add_int_mul_two_pi`: the + kinetic energy is unchanged by any constant shift of the lift, and the energy by a shift by a + whole number of turns. +- `SimplePendulum.equationOfMotion_add_int_mul_two_pi` and + `SimplePendulum.isSolution_add_int_mul_two_pi`: the equation of motion and its solutions are + invariant under shifting the lift by a whole number of turns. +- `SimplePendulum.ofAngle_add_int_mul_two_pi_coord`: the shifted lift describes the same + configuration. + +## iii. Table of contents + +- A. Independence of the lift + - A.1. Invariance of the potential energy and the torque + - A.2. Invariance of the energy + - A.3. Invariance of the equation of motion and its solutions + - A.4. The shifted lift describes the same configuration + +## iv. References + +References for the simple gravity pendulum include: + +* Landau & Lifshitz, Mechanics, 3rd ed., §5 and §21. [ref: landau_mechanics] +* Arnold, Mathematical Methods of Classical Mechanics, 2nd ed., §4. [ref: arnold_mechanics] +-/ + +@[expose] public section + +namespace ClassicalMechanics +open Real InnerProductSpace Time +open scoped ContDiff + +namespace SimplePendulum + +variable (S : SimplePendulum) + +/-! + +## A. Independence of the lift + +The dynamics of `SimplePendulum.Basic` are written on a lift of the motion: the real angle +`θ t 0` stands for the configuration `ConfigurationSpace.ofAngle (θ t 0)`, and two lifts +differing by a whole number of turns carry the same configurations. This section proves that the +dynamical quantities listed below — the energies, the torque, and the equation of motion and its +solutions — are invariant under the deck transformations `θ ↦ θ + 2π n` of the angular lift; +the packaging of this invariance at the level of configuration-space trajectories comes with +the geometric bridge in a later module. The section closes by making the starting point +precise: the shifted lift does describe the same configuration, by the periodicity of the +angular lift of the geometric configuration space. + +-/ + +/-! + +### A.1. Invariance of the potential energy and the torque + +The potential energy and the torque depend on the angle only through its cosine and its sine, +and both have period `2π`: neither quantity changes when the angle is shifted by a whole number +of turns. + +-/ + +/-- The potential energy of the simple pendulum is invariant under shifting the angle by a + whole number of turns. -/ +lemma potentialEnergy_add_int_mul_two_pi (x : EuclideanSpace ℝ (Fin 1)) (n : ℤ) : + S.potentialEnergy (x + (n * (2 * Real.pi)) • EuclideanSpace.single 0 1) = + S.potentialEnergy x := by + have h0 : (x + (n * (2 * Real.pi)) • EuclideanSpace.single 0 1 : EuclideanSpace ℝ (Fin 1)) 0 = + x 0 + n * (2 * Real.pi) := by + simp + rw [potentialEnergy_eq, potentialEnergy_eq, h0, Real.cos_add_int_mul_two_pi] + +/-- The torque of the simple pendulum is invariant under shifting the angle by a whole number + of turns. -/ +lemma torque_add_int_mul_two_pi (x : EuclideanSpace ℝ (Fin 1)) (n : ℤ) : + S.torque (x + (n * (2 * Real.pi)) • EuclideanSpace.single 0 1) = S.torque x := by + have h0 : (x + (n * (2 * Real.pi)) • EuclideanSpace.single 0 1 : EuclideanSpace ℝ (Fin 1)) 0 = + x 0 + n * (2 * Real.pi) := by + simp + rw [torque_eq, torque_eq, h0, Real.sin_add_int_mul_two_pi] + +/-! + +### A.2. Invariance of the energy + +The shift of the lift is constant in time, so it drops out of the velocity, and the kinetic +energy is unchanged by any constant shift at all; the potential energy is unchanged by the +invariance of A.1. Together the two give the invariance of the energy under shifting the lift +by a whole number of turns. + +-/ + +/-- The kinetic energy of the simple pendulum along a lift of the angle is invariant under + shifting the lift by any constant: the shift drops out of the velocity. -/ +lemma kineticEnergy_add_const (θ : Time → EuclideanSpace ℝ (Fin 1)) + (c : EuclideanSpace ℝ (Fin 1)) : + S.kineticEnergy (fun t => θ t + c) = S.kineticEnergy θ := by + have hd : ∂ₜ (fun t => θ t + c) = ∂ₜ θ := by + funext s + rw [Time.deriv_eq, Time.deriv_eq, fderiv_add_const] + funext t + simp only [kineticEnergy_eq, hd] + +/-- The energy of the simple pendulum along a lift of the angle is invariant under shifting the + lift by a whole number of turns: A.1 supplies the invariance of the potential energy, and the + velocity is unchanged by a constant shift. -/ +lemma energy_add_int_mul_two_pi (θ : Time → EuclideanSpace ℝ (Fin 1)) (n : ℤ) : + S.energy (fun t => θ t + (n * (2 * Real.pi)) • EuclideanSpace.single 0 1) = + S.energy θ := by + funext t + simp only [energy_eq, S.kineticEnergy_add_const θ _, S.potentialEnergy_add_int_mul_two_pi (θ t) n] + +/-! + +### A.3. Invariance of the equation of motion and its solutions + +Both sides of the equation of motion are invariant under the shift: the angular momentum, +because the shift is constant in time, and the torque, by the invariance of A.1. Smoothness is +likewise unaffected by adding a constant, so being a solution is invariant as well. + +-/ + +/-- A lift of the angle shifted by a whole number of turns satisfies the equation of motion of + the simple pendulum if and only if the lift itself does. -/ +lemma equationOfMotion_add_int_mul_two_pi (θ : Time → EuclideanSpace ℝ (Fin 1)) (n : ℤ) : + S.EquationOfMotion (fun t => θ t + (n * (2 * Real.pi)) • EuclideanSpace.single 0 1) ↔ + S.EquationOfMotion θ := by + have hd : ∂ₜ (fun t => θ t + (n * (2 * Real.pi)) • EuclideanSpace.single 0 1) = ∂ₜ θ := by + funext s + rw [Time.deriv_eq, Time.deriv_eq, fderiv_add_const] + simp only [EquationOfMotion, hd, torque_add_int_mul_two_pi] + +/-- A lift of the angle shifted by a whole number of turns is a solution of the simple pendulum + if and only if the lift itself is. -/ +lemma isSolution_add_int_mul_two_pi (θ : Time → EuclideanSpace ℝ (Fin 1)) (n : ℤ) : + S.IsSolution (fun t => θ t + (n * (2 * Real.pi)) • EuclideanSpace.single 0 1) ↔ + S.IsSolution θ := by + have hcd : ContDiff ℝ ∞ (fun t => θ t + (n * (2 * Real.pi)) • EuclideanSpace.single 0 1) ↔ + ContDiff ℝ ∞ θ := by + constructor + · intro h + have h2 := h.sub (contDiff_const (c := (n * (2 * Real.pi)) • EuclideanSpace.single 0 1)) + simpa using h2 + · exact fun h => h.add contDiff_const + exact and_congr hcd (S.equationOfMotion_add_int_mul_two_pi θ n) + +/-! + +### A.4. The shifted lift describes the same configuration + +Finally the statement giving the previous invariances their meaning: the lift and its shift by +a whole number of turns project to the same point of the configuration space, by the +periodicity of the angular lift `ConfigurationSpace.ofAngle` with period `2π`. + +-/ + +/-- A lift of the angle and its shift by a whole number of turns describe the same + configuration of the simple pendulum. -/ +lemma ofAngle_add_int_mul_two_pi_coord (x : EuclideanSpace ℝ (Fin 1)) (n : ℤ) : + ConfigurationSpace.ofAngle + ((x + (n * (2 * Real.pi)) • EuclideanSpace.single (0 : Fin 1) (1 : ℝ)) 0) = + ConfigurationSpace.ofAngle (x 0) := by + have h0 : (x + (n * (2 * Real.pi)) • EuclideanSpace.single 0 1 : EuclideanSpace ℝ (Fin 1)) 0 = + x 0 + n * (2 * Real.pi) := by + simp + rw [h0] + exact ConfigurationSpace.ofAngle_periodic.int_mul n (x 0) + +end SimplePendulum + +end ClassicalMechanics + +end diff --git a/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/PeriodFormula.lean b/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/PeriodFormula.lean new file mode 100644 index 0000000000..080619d438 --- /dev/null +++ b/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/PeriodFormula.lean @@ -0,0 +1,327 @@ +/- +Copyright (c) 2026 Aadarsh Agarwal. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Aadarsh Agarwal +-/ +module + +public import Physlib.ClassicalMechanics.Pendulum.SimplePendulum.SmallAngle +public import Physlib.Mathematics.SpecialFunctions.EllipticIntegral +public import Physlib.Mathematics.Trigonometry.SinSq +/-! + +# The period formula of the simple gravity pendulum + +## i. Overview + +Beyond the small-angle approximation the period of the simple gravity pendulum depends on the +amplitude of the swing. Released from rest at the angle `θ₀`, with `0 < θ₀ < π`, the pendulum +librates about the bottom of its swing, and the classical calculation (Landau & Lifshitz, §11, +Problem 1) integrates the energy first integral by quadrature: the quarter period is the time +of descent from `θ₀` to the bottom, the substitution `sin (θ/2) = sin (θ₀/2) sin φ` turns the +resulting integral into a complete elliptic integral of the first kind, and the period is + +`T = 4 √(ℓ/g) K(sin ½θ₀)`, + +with `K` Legendre's complete elliptic integral of the first kind in the modulus convention. In +the parameter convention of `Real.completeEllipticK`, where the parameter is the square +`m = k²` of the modulus, the same formula reads `4 √(ℓ/g) completeEllipticK (sin² (θ₀/2))`. + +This module records that formula as `SimplePendulum.periodFormula` and proves what follows +for it from the theory of `completeEllipticK` alone: it is even in the amplitude, at zero +amplitude it is the small-angle period `2π √(ℓ/g)`, it is continuous on `(-π, π)` and tends to +the small-angle period as the amplitude tends to zero, it is never below the small-angle +period, it is strictly increasing in the amplitude on `[0, π)`, and it is at most +`2π √(ℓ/g) / cos (θ₀/2)`. The formula is therefore not constant in the amplitude — the +classical statement that the pendulum is not isochronous, once the identification below is +proved — and the upper bound quantifies how it grows as the amplitude approaches the inverted +position. + +What this module does not do is identify `periodFormula θ₀` with the period of a solution of +the nonlinear equation of motion released from rest at `θ₀`. That identification is the +theorem the formula is named for, and its formalization — the quarter period as a first hitting +time, the quadrature of the energy first integral, the substitution, and their assembly, on top +of the uniqueness of solutions and the time-reversal symmetry of the equation of motion +(formalized in the companion module `SimplePendulum/Solution.lean`) — is not yet carried out; +the `TODO` after the definition lists the milestones. Until then +`periodFormula` is a definition, and the statements about it are statements about the elliptic +integral. + +## ii. Key results + +- `SimplePendulum.periodFormula` is the classical formula `4 √(ℓ/g) K(sin² (θ₀/2))` for the + period of libration with amplitude `θ₀`; for `|θ₀| < π` its parameter `sin² (θ₀/2)` lies + below `1` (`Real.sin_half_sq_lt_one`), so it is evaluated on the domain of + `completeEllipticK`. +- `SimplePendulum.periodFormula_neg`: the formula is even in the amplitude. +- `SimplePendulum.periodFormula_zero`: at zero amplitude the formula is the small-angle + period, `periodFormula 0 = smallAnglePeriod`. +- `SimplePendulum.continuousOn_periodFormula` and + `SimplePendulum.continuousAt_periodFormula_zero`: the formula is continuous on `(-π, π)`, + in particular at `0`. +- `SimplePendulum.periodFormula_tendsto_smallAnglePeriod`: the formula tends to the + small-angle period as the amplitude tends to zero. +- `SimplePendulum.periodFormula_mono` and `SimplePendulum.periodFormula_strictMono`, with the + bundled `SimplePendulum.monotoneOn_periodFormula` and + `SimplePendulum.strictMonoOn_periodFormula`: on `[0, π)` the formula is increasing, and + strictly increasing, in the amplitude. +- `SimplePendulum.smallAnglePeriod_le_periodFormula` and `SimplePendulum.periodFormula_pos`: + the formula is at least the small-angle period, in particular positive, whenever + `sin² (θ₀/2) < 1`. +- `SimplePendulum.periodFormula_le` and `SimplePendulum.periodFormula_le'`: for `|θ₀| < π` the + formula is at most `2π √(ℓ/g) / cos (θ₀/2) = smallAnglePeriod / cos (θ₀/2)`. + +## iii. Table of contents + +- A. The period formula, its continuity and its small-angle limit + - A.1. The formula, its domain and its evenness + - A.2. Continuity and the small-angle limit +- B. Monotonicity and bounds in the amplitude + - B.1. Monotonicity in the amplitude + - B.2. Bounds + +## iv. References + +* Landau & Lifshitz, Mechanics, 3rd ed., §11, Problem 1: `T = 4 √(l/g) K(sin ½φ₀)`, in the modulus + convention `K(k) = ∫ φ in 0..π/2, (1 - k² sin² φ)^(-1/2)`. [ref: landau_mechanics] +* M. Abramowitz, I. A. Stegun, Handbook of Mathematical Functions, 17.3.1 (the parameter convention + `K(m)`, `m = k²`, used by `Real.completeEllipticK`). [ref: abramowitz_stegun_1964] +* The module `Physlib.Mathematics.SpecialFunctions.EllipticIntegral`, for `completeEllipticK` and + its theory on the domain `m < 1`. +* The module `Physlib.ClassicalMechanics.Pendulum.SimplePendulum.SmallAngle`, for the small-angle + period `smallAnglePeriod = 2π √(ℓ/g)`. +-/ + +@[expose] public section + +namespace ClassicalMechanics + +namespace SimplePendulum + +variable (S : SimplePendulum) + +/-! + +## A. The period formula, its continuity and its small-angle limit + +The classical formula for the period of libration as a function of the amplitude, its evenness +and its domain, and its behaviour at small amplitudes: it is continuous on the libration range +`(-π, π)`, at zero amplitude it is exactly the small-angle period, and it tends to the +small-angle period as the amplitude tends to zero. These are facts about the elliptic integral +on its domain and at the parameter `0`, where `K 0 = π/2`. + +-/ + +/-! + +### A.1. The formula, its domain and its evenness + +The formula `4 √(ℓ/g) K(sin² (θ₀/2))` is defined for every real `θ₀`, and is even in `θ₀`; for +libration amplitudes `|θ₀| < π` the parameter `sin² (θ₀/2)` is below `1` +(`Real.sin_half_sq_lt_one`), so the elliptic integral is evaluated on its domain. At `θ₀ = ±π` +the parameter is `1`, where Legendre's `K` diverges — the pendulum released from rest at the +inverted position never returns — while the Lean value of `completeEllipticK` at `m = 1` is a +junk value (see the module docstring of `Physlib.Mathematics.SpecialFunctions.EllipticIntegral`), +so nothing is claimed there. + +-/ + +/-- The classical formula `4 √(ℓ/g) K(sin² (θ₀/2))` for the period of libration of the simple + gravity pendulum with amplitude `θ₀` (Landau & Lifshitz, §11, Problem 1, where it is written + `T = 4 √(l/g) K(sin ½φ₀)` in the modulus convention). Its identification with the return + time of a solution of the nonlinear equation of motion is not yet formalized (see the + TODO). -/ +noncomputable def periodFormula (θ₀ : ℝ) : ℝ := + 4 * √(S.ℓ / S.g) * Real.completeEllipticK (Real.sin (θ₀ / 2) ^ 2) + +TODO "Prove that `periodFormula θ₀` is the period of the motion of the simple pendulum released + from rest at the amplitude `θ₀`, for `0 < θ₀ < π`. Milestones 1–2 — the uniqueness of the + smooth solutions of the equation of motion with given initial data, and the time-reversal + symmetry of the equation of motion, so that the motion released from rest is even in time and + its period is four times the time of descent to the bottom — are formalized in a companion + module, `SimplePendulum/Solution.lean` (`SimplePendulum.equationOfMotion_unique`, + `SimplePendulum.releasedFromRest_even`); remaining here: + (3) the quarter period as the first hitting time of `θ = 0` by the motion released from rest; + (4) the quadrature of the energy first integral on the descent, `θ̇² = (2g/ℓ)(cos θ - cos θ₀)`, + giving the quarter period as `√(ℓ/(2g)) ∫ θ in 0..θ₀, (cos θ - cos θ₀)^(-1/2)`; + (5) the substitution `sin (θ/2) = sin (θ₀/2) sin φ`, which transforms that integral into + `√(ℓ/g) completeEllipticK (sin² (θ₀/2))`; + (6) the assembly of (1)–(5) into the theorem that the motion released from rest at `θ₀` is + periodic with period `periodFormula θ₀`." + +/-- The period formula is even in the amplitude, `periodFormula (-θ₀) = periodFormula θ₀`: its + parameter `sin² (θ₀/2)` is even in `θ₀`. -/ +lemma periodFormula_neg (θ₀ : ℝ) : S.periodFormula (-θ₀) = S.periodFormula θ₀ := by + simp only [periodFormula, neg_div, Real.sin_neg, neg_sq] + +/-! + +### A.2. Continuity and the small-angle limit + +At zero amplitude the parameter of the elliptic integral is `0`, where `K 0 = π/2`, and the +formula collapses to `4 √(ℓ/g) · π/2 = 2π √(ℓ/g)`: the small-angle period. Since `K` is +continuous on its domain and the parameter `sin² (θ₀/2)` is continuous in the amplitude and +stays below `1` for `|θ₀| < π`, the formula is continuous on `(-π, π)`; in particular it tends +to the small-angle period as the amplitude tends to zero — the sense in which the small-angle +theory of `SimplePendulum.SmallAngle` is the limit of the classical formula. + +-/ + +/-- At zero amplitude the period formula is the small-angle period: `K 0 = π/2` turns + `4 √(ℓ/g) K 0` into `2π √(ℓ/g)`. -/ +@[simp] +lemma periodFormula_zero : S.periodFormula 0 = S.smallAnglePeriod := by + rw [periodFormula, smallAnglePeriod_eq, zero_div, Real.sin_zero, zero_pow two_ne_zero, + Real.completeEllipticK_zero] + ring + +/-- The period formula is continuous on the libration range `(-π, π)`: `completeEllipticK` is + continuous at every parameter `m < 1`, and the parameter `sin² (θ₀/2)` is continuous in `θ₀` + and below `1` for `|θ₀| < π`. -/ +lemma continuousOn_periodFormula : ContinuousOn S.periodFormula (Set.Ioo (-Real.pi) Real.pi) := by + refine continuousOn_of_forall_continuousAt fun θ₀ hθ₀ => ?_ + have hp : ContinuousAt (fun θ : ℝ => Real.sin (θ / 2) ^ 2) θ₀ := by fun_prop + have hK : ContinuousAt Real.completeEllipticK (Real.sin (θ₀ / 2) ^ 2) := + Real.continuousAt_completeEllipticK (Real.sin_half_sq_lt_one (abs_lt.2 hθ₀)) + exact continuousAt_const.mul (hK.comp (f := fun θ : ℝ => Real.sin (θ / 2) ^ 2) hp) + +/-- The period formula is continuous at zero amplitude, an interior point of `(-π, π)`. -/ +lemma continuousAt_periodFormula_zero : ContinuousAt S.periodFormula 0 := + S.continuousOn_periodFormula.continuousAt + (Ioo_mem_nhds (by linarith [Real.pi_pos]) Real.pi_pos) + +/-- The period formula tends to the small-angle period as the amplitude tends to zero: it is + continuous at `0`, where its value is the small-angle period. -/ +lemma periodFormula_tendsto_smallAnglePeriod : + Filter.Tendsto S.periodFormula (nhds 0) (nhds S.smallAnglePeriod) := by + rw [← S.periodFormula_zero] + exact S.continuousAt_periodFormula_zero.tendsto + +/-! + +## B. Monotonicity and bounds in the amplitude + +The dependence of the period formula on the amplitude is inherited from the dependence of +`completeEllipticK` on its parameter: on `[0, π)` the parameter `sin² (θ₀/2)` is strictly +increasing in `θ₀` and stays below `1`, and `K` is strictly increasing on `(-∞, 1)`, so the +formula is strictly increasing in the amplitude. The bounds `π/2 ≤ K m ≤ (π/2) (1 - m)^(-1/2)` +on `[0, 1)` sandwich the formula between the small-angle period and +`2π √(ℓ/g) / cos (θ₀/2)`. + +-/ + +/-! + +### B.1. Monotonicity in the amplitude + +For `0 ≤ θ₁ ≤ θ₂ < π` the half-angles lie in `[0, π/2)`, where the sine is nonnegative and +increasing, so `sin² (θ₁/2) ≤ sin² (θ₂/2) < 1`, and the monotonicity of `K` on its domain does +the rest. The strict version uses the strict monotonicity of the sine on the same interval and +of `K`. Both are restated as bundled `MonotoneOn` and `StrictMonoOn` facts on `[0, π)`. + +-/ + +/-- The period formula is increasing in the amplitude on `[0, π)`: for `0 ≤ θ₁ ≤ θ₂ < π`, + `periodFormula θ₁ ≤ periodFormula θ₂`. Classically this is the statement that the pendulum is + not isochronous — the period of libration grows with the amplitude — once `periodFormula` is + identified with the period (see the TODO). -/ +lemma periodFormula_mono {θ₁ θ₂ : ℝ} (h0 : 0 ≤ θ₁) (h12 : θ₁ ≤ θ₂) (hπ : θ₂ < Real.pi) : + S.periodFormula θ₁ ≤ S.periodFormula θ₂ := by + have hπ0 := Real.pi_pos + have hs : Real.sin (θ₁ / 2) ≤ Real.sin (θ₂ / 2) := + Real.sin_le_sin_of_le_of_le_pi_div_two (by linarith) (by linarith) (by linarith) + have hs0 : 0 ≤ Real.sin (θ₁ / 2) := + Real.sin_nonneg_of_nonneg_of_le_pi (by linarith) (by linarith) + have hm : Real.sin (θ₂ / 2) ^ 2 < 1 := Real.sin_half_sq_lt_one (abs_lt.2 ⟨by linarith, hπ⟩) + simp only [periodFormula] + exact mul_le_mul_of_nonneg_left + (Real.completeEllipticK_mono (pow_le_pow_left₀ hs0 hs 2) hm) (by positivity) + +/-- The period formula is strictly increasing in the amplitude on `[0, π)`: for + `0 ≤ θ₁ < θ₂ < π`, `periodFormula θ₁ < periodFormula θ₂`. -/ +lemma periodFormula_strictMono {θ₁ θ₂ : ℝ} (h0 : 0 ≤ θ₁) (h12 : θ₁ < θ₂) (hπ : θ₂ < Real.pi) : + S.periodFormula θ₁ < S.periodFormula θ₂ := by + have hπ0 := Real.pi_pos + have hs : Real.sin (θ₁ / 2) < Real.sin (θ₂ / 2) := + Real.sin_lt_sin_of_lt_of_le_pi_div_two (by linarith) (by linarith) (by linarith) + have hs0 : 0 ≤ Real.sin (θ₁ / 2) := + Real.sin_nonneg_of_nonneg_of_le_pi (by linarith) (by linarith) + have hm : Real.sin (θ₂ / 2) ^ 2 < 1 := Real.sin_half_sq_lt_one (abs_lt.2 ⟨by linarith, hπ⟩) + have hℓ := S.ℓ_pos + have hg := S.g_pos + simp only [periodFormula] + exact mul_lt_mul_of_pos_left + (Real.completeEllipticK_strictMono (pow_lt_pow_left₀ hs hs0 two_ne_zero) hm) + (by positivity) + +/-- The period formula is monotone on `[0, π)`, as a bundled `MonotoneOn` statement. -/ +lemma monotoneOn_periodFormula : MonotoneOn S.periodFormula (Set.Ico 0 Real.pi) := + fun _ h₁ _ h₂ h => S.periodFormula_mono h₁.1 h h₂.2 + +/-- The period formula is strictly increasing on `[0, π)`, as a bundled `StrictMonoOn` + statement. -/ +lemma strictMonoOn_periodFormula : StrictMonoOn S.periodFormula (Set.Ico 0 Real.pi) := + fun _ h₁ _ h₂ h => S.periodFormula_strictMono h₁.1 h h₂.2 + +/-! + +### B.2. Bounds + +The lower bound `π/2 ≤ K m` on `[0, 1)` says that the period formula is never below the +small-angle period: the formula is least at zero amplitude, and in particular positive. The +upper bound `K m ≤ (π/2) (1 - m)^(-1/2)`, with `1 - sin² (θ₀/2) = cos² (θ₀/2)`, bounds the +formula by `2π √(ℓ/g) / cos (θ₀/2)` for `|θ₀| < π`: the formula is at most the small-angle +period divided by the cosine of the half-amplitude, a quantity that grows without bound as the +amplitude approaches the inverted position. + +-/ + +/-- The period formula is at least the small-angle period: for `sin² (θ₀/2) < 1`, + `smallAnglePeriod ≤ periodFormula θ₀`, since `π/2 ≤ K m` on `[0, 1)`. -/ +lemma smallAnglePeriod_le_periodFormula {θ₀ : ℝ} (h : Real.sin (θ₀ / 2) ^ 2 < 1) : + S.smallAnglePeriod ≤ S.periodFormula θ₀ := by + rw [smallAnglePeriod_eq, periodFormula] + calc 2 * Real.pi * √(S.ℓ / S.g) + = 4 * √(S.ℓ / S.g) * (Real.pi / 2) := by ring + _ ≤ 4 * √(S.ℓ / S.g) * Real.completeEllipticK (Real.sin (θ₀ / 2) ^ 2) := + mul_le_mul_of_nonneg_left (Real.pi_div_two_le_completeEllipticK (sq_nonneg _) h) + (by positivity) + +/-- The period formula is positive for `sin² (θ₀/2) < 1`: it is at least the small-angle + period, which is positive. -/ +lemma periodFormula_pos {θ₀ : ℝ} (h : Real.sin (θ₀ / 2) ^ 2 < 1) : 0 < S.periodFormula θ₀ := + S.smallAnglePeriod_pos.trans_le (S.smallAnglePeriod_le_periodFormula h) + +/-- The period formula is at most `2π √(ℓ/g) / cos (θ₀/2)` for `|θ₀| < π`: the bound + `K m ≤ (π/2) (1 - m)^(-1/2)` at `m = sin² (θ₀/2)`, where `1 - sin² (θ₀/2) = cos² (θ₀/2)` + and `cos (θ₀/2) > 0`. -/ +lemma periodFormula_le {θ₀ : ℝ} (h : |θ₀| < Real.pi) : + S.periodFormula θ₀ ≤ 2 * Real.pi * √(S.ℓ / S.g) / Real.cos (θ₀ / 2) := by + obtain ⟨h₁, h₂⟩ := abs_lt.1 h + have hc : 0 < Real.cos (θ₀ / 2) := Real.cos_pos_of_mem_Ioo ⟨by linarith, by linarith⟩ + have hpow : (1 - Real.sin (θ₀ / 2) ^ 2) ^ (-(1 / 2 : ℝ)) = (Real.cos (θ₀ / 2))⁻¹ := by + rw [← Real.cos_sq', ← Real.rpow_two, ← Real.rpow_mul hc.le, + show (2 : ℝ) * -(1 / 2) = -1 by norm_num, Real.rpow_neg_one] + rw [periodFormula] + calc 4 * √(S.ℓ / S.g) * Real.completeEllipticK (Real.sin (θ₀ / 2) ^ 2) + ≤ 4 * √(S.ℓ / S.g) * (Real.pi / 2 * (1 - Real.sin (θ₀ / 2) ^ 2) ^ (-(1 / 2 : ℝ))) := + mul_le_mul_of_nonneg_left + (Real.completeEllipticK_le (sq_nonneg _) (Real.sin_half_sq_lt_one h)) (by positivity) + _ = 2 * Real.pi * √(S.ℓ / S.g) / Real.cos (θ₀ / 2) := by + rw [hpow] + ring + +/-- The period formula is at most the small-angle period divided by `cos (θ₀/2)`, for + `|θ₀| < π`: `periodFormula_le` with `2π √(ℓ/g) = smallAnglePeriod`. Together with + `smallAnglePeriod_le_periodFormula` this sandwiches the formula, + `smallAnglePeriod ≤ periodFormula θ₀ ≤ smallAnglePeriod / cos (θ₀/2)`; the lower bound holds + under the more general hypothesis `sin² (θ₀/2) < 1`, which `|θ₀| < π` implies + (`Real.sin_half_sq_lt_one`). -/ +lemma periodFormula_le' {θ₀ : ℝ} (h : |θ₀| < Real.pi) : + S.periodFormula θ₀ ≤ S.smallAnglePeriod / Real.cos (θ₀ / 2) := by + rw [smallAnglePeriod_eq] + exact S.periodFormula_le h + +end SimplePendulum + +end ClassicalMechanics diff --git a/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/SmallAngle.lean b/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/SmallAngle.lean new file mode 100644 index 0000000000..61395c067d --- /dev/null +++ b/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/SmallAngle.lean @@ -0,0 +1,654 @@ +/- +Copyright (c) 2026 Aadarsh Agarwal. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Aadarsh Agarwal +-/ +module + +public import Physlib.ClassicalMechanics.HarmonicOscillator.Solution +public import Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Basic +/-! + +# Small-angle motion of the simple gravity pendulum + +## i. Overview + +Near the bottom of its swing the torque of the simple gravity pendulum is +`-m g ℓ sin θ ≈ -m g ℓ θ`, so for small angles the equation of motion `I θ̈ = -m g ℓ sin θ` +linearizes to `I θ̈ = -m g ℓ θ`: the equation of a harmonic oscillator whose mass is the moment +of inertia `I = m ℓ²` of the pendulum and whose spring constant is the coefficient `m g ℓ` of +the linearized torque. The angular frequency `√(k/m)` of this oscillator is `√(g/ℓ)`, which is +exactly the constant `ω` of `SimplePendulum.Basic`, there described as the frequency of the +small oscillations. + +This module packages the oscillator of the small oscillations as +`SimplePendulum.toHarmonicOscillator`, defines the linearized equation of motion +`θ̈ + ω² θ = 0` on the same Euclidean lift of the angle as the nonlinear equation, and proves +that for smooth lifts of the angle it is the equation of motion of the associated harmonic +oscillator, so that the solution theory of the harmonic oscillator applies verbatim to the +small oscillations of the pendulum. + +The equivalence carries the whole solution theory of the oscillator over to the small +oscillations. Every choice of initial angle and initial angular velocity determines a smooth +small-angle motion, unique among the smooth solutions of the linearized equation of motion, +with the closed form `cos (ω t) x₀ + (sin (ω t)/ω) v₀`; released from rest at the angle `θ₀` +it is the cosine `θ₀ cos (ω t)`. Every small-angle motion is periodic with the small-angle +period `2π √(ℓ/g)`, in which neither the mass of the bob nor the amplitude of the swing +appears: within the linearization the pendulum is isochronous. The linearization is not exact, +and the final section measures what it discards: the torque differs from its linearization +`-m g ℓ θ` by exactly `m g ℓ (θ - sin θ)`, of norm at most `m g ℓ ‖θ‖³/6`, so every +small-angle motion solves the equation of motion of the pendulum itself up to a residual +cubically small in the angle. + +## ii. Key results + +- `SimplePendulum.toHarmonicOscillator` is the harmonic oscillator to which the pendulum + linearizes, of mass `I = m ℓ²` and spring constant `m g ℓ`. The simp lemmas + `toHarmonicOscillator_m` and `toHarmonicOscillator_k` record its data, and + `toHarmonicOscillator_ω` identifies its angular frequency with the constant + `SimplePendulum.ω` of the pendulum. +- `SimplePendulum.LinearizedEquationOfMotion` is the small-angle equation of motion + `θ̈ + ω² θ = 0`. Its rotational Newton form is `linearizedEquationOfMotion_iff_newton`, and + `linearizedEquationOfMotion_iff` identifies it, for smooth lifts of the angle, with the + equation of motion of the associated harmonic oscillator. The linearization is literally + differentiation: `fderiv_torque_zero_apply` identifies the derivative of the torque at the + hanging equilibrium with the force of the oscillator, and + `linearizedEquationOfMotion_iff_fderiv_torque` restates the linearized equation as the + equation of motion with the torque replaced by that derivative. +- `SimplePendulum.smallAngleTrajectory` is the small-angle motion determined by a choice of + initial conditions, the trajectory of the associated harmonic oscillator: it has the closed + form `cos (ω t) x₀ + (sin (ω t)/ω) v₀` (`smallAngleTrajectory_eq`), it is smooth + (`smallAngleTrajectory_contDiff`), it assumes its initial data at time `0` + (`smallAngleTrajectory_at_zero`, `smallAngleTrajectory_velocity_at_zero`), and it satisfies + the linearized equation of motion (`smallAngleTrajectory_linearizedEquationOfMotion`). +- `SimplePendulum.linearized_unique`: a smooth solution of the linearized equation of motion + with the initial data of `IC` is `smallAngleTrajectory IC`. Together with the previous point, + this is the existence and uniqueness of the small-angle motions. +- `SimplePendulum.releasedFromRest` is the small-angle motion released from rest at angle + `θ₀`, the cosine `θ₀ cos (ω t)`; `releasedFromRest_eq` identifies it with the small-angle + trajectory of the initial conditions with initial angle `θ₀` and zero initial angular + velocity. +- `SimplePendulum.smallAnglePeriod` is the period of the small oscillations, the period of the + associated harmonic oscillator: `2π/ω` (`smallAnglePeriod_eq_two_pi_div_ω`), with closed + form `2π √(ℓ/g)` (`smallAnglePeriod_eq`). Every small-angle trajectory is periodic with this + period (`smallAngleTrajectory_periodic`, `releasedFromRest_periodic`), and along each the + energy of the associated oscillator is the constant fixed by the initial data + (`smallAngleTrajectory_energy`). +- `SimplePendulum.torque_sub_toHarmonicOscillator_force` computes the exact difference between + the torque and the force of the associated oscillator: the term `m g ℓ (θ - sin θ)` the + linearization discards. Its norm is at most `m g ℓ ‖θ‖³/6` + (`norm_torque_sub_toHarmonicOscillator_force_le`), in coordinates `abs_torque_add_linear_le`, + and `gradLagrangian_sub_toHarmonicOscillator` identifies the difference of the variational + gradients of the two actions with the difference of torque and linearized force, with the + norm bound `norm_gradLagrangian_sub_toHarmonicOscillator_le`. +- `SimplePendulum.norm_equationOfMotion_residual_le`: a small-angle motion nearly solves the + equation of motion of the pendulum itself, leaving at every instant a residual of norm at + most `m g ℓ ‖θ‖³/6` — the sense in which the small-angle theory approximates the pendulum; + in variational form, `norm_gradLagrangian_le_of_linearizedEquationOfMotion` makes it a + near-critical point of the pendulum's action. + +## iii. Table of contents + +- A. The harmonic oscillator of small oscillations + - A.1. The associated harmonic oscillator + - A.2. The frequency of the associated oscillator +- B. The linearized equation of motion + - B.1. The linearized equation + - B.2. Equivalence with the equation of motion of the oscillator + - B.3. Linearization as differentiation of the torque +- C. Small-angle trajectories + - C.1. The trajectory of given initial conditions + - C.2. Existence and uniqueness + - C.3. Release from rest +- D. The small-angle period + - D.1. The period and its closed form + - D.2. Periodicity and the energy of the small-angle motions +- E. The error of the linearization + - E.1. The cubic bound on the torque + - E.2. The variational gradients + - E.3. The residual of the small-angle motions + +## iv. References + +References for the small-angle motion of the simple pendulum include: + +* Huygens, Horologium Oscillatorium (1673). [ref: huygens_1673] +* Landau & Lifshitz, Mechanics, 3rd ed., §21. [ref: landau_mechanics] +* The module `Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Basic`, whose equation of motion + this module linearizes. +-/ + +@[expose] public section + +namespace ClassicalMechanics + +open Time +open scoped ContDiff + +namespace SimplePendulum + +variable (S : SimplePendulum) + +/-! + +## A. The harmonic oscillator of small oscillations + +Replacing `sin θ` by `θ` in the equation of motion `I θ̈ = -m g ℓ sin θ` produces the equation +of a harmonic oscillator: the moment of inertia plays the role of the mass, and the coefficient +`m g ℓ` of the linearized torque plays the role of the spring constant. We record this +oscillator once and for all; its solution theory is the solution theory of the small +oscillations of the pendulum. + +-/ + +/-! + +### A.1. The associated harmonic oscillator + +The data of the associated oscillator: the mass `I = m ℓ²` and the spring constant `m g ℓ`, +both positive because the data of the pendulum is. + +-/ + +/-- The harmonic oscillator to which the pendulum linearizes: mass `I = m ℓ²`, spring + constant `m g ℓ`. -/ +noncomputable def toHarmonicOscillator : HarmonicOscillator where + m := S.inertia + k := S.m * S.g * S.ℓ + m_pos := S.inertia_pos + k_pos := by have := S.m_pos; have := S.g_pos; have := S.ℓ_pos; positivity + +/-- The mass of the harmonic oscillator associated to the simple pendulum is the moment of + inertia `I = m ℓ²` of the pendulum about its pivot. -/ +@[simp] +lemma toHarmonicOscillator_m : S.toHarmonicOscillator.m = S.inertia := rfl + +/-- The spring constant of the harmonic oscillator associated to the simple pendulum is + `m g ℓ`, the coefficient of the linearized torque. -/ +@[simp] +lemma toHarmonicOscillator_k : S.toHarmonicOscillator.k = S.m * S.g * S.ℓ := rfl + +/-! + +### A.2. The frequency of the associated oscillator + +The angular frequency `√(k/m) = √(m g ℓ / m ℓ²)` of the associated oscillator collapses, the +mass cancelling, to `√(g/ℓ)`: the constant `ω` of the pendulum, as promised by its description +in `SimplePendulum.Basic` as the frequency of the small oscillations. + +-/ + +/-- The angular frequency of the harmonic oscillator associated to the simple pendulum is the + angular frequency `ω = √(g/ℓ)` of the small oscillations of the pendulum. -/ +lemma toHarmonicOscillator_ω : S.toHarmonicOscillator.ω = S.ω := by + unfold HarmonicOscillator.ω SimplePendulum.ω + rw [toHarmonicOscillator_k, toHarmonicOscillator_m, inertia] + congr 1 + field_simp + +/-! + +## B. The linearized equation of motion + +The linearized equation of motion is the equation `θ̈ + ω² θ = 0` obtained from the scalar form +`θ̈ + ω² sin θ = 0` of the equation of motion by replacing `sin θ` with `θ`. It is stated, like +the nonlinear equation, on the Euclidean lift of the angle, and it is exactly the associated +harmonic oscillator's form of Newton's second law: multiplying by the moment of inertia converts +one pointwise equation into the other. + +-/ + +/-! + +### B.1. The linearized equation + +The equation `θ̈ + ω² θ = 0`, together with its rotational Newton form `I θ̈ = -m g ℓ θ`, in +which the right-hand side is the force of the associated harmonic oscillator. + +-/ + +/-- The linearized equation of motion `θ̈ + ω² θ = 0` of the simple pendulum, the small-angle + form of the equation of motion, in which the torque is replaced by its linearization at the + bottom of the swing. -/ +def LinearizedEquationOfMotion (θ : Time → EuclideanSpace ℝ (Fin 1)) : Prop := + ∀ t, ∂ₜ (∂ₜ θ) t + (S.ω ^ 2) • θ t = 0 + +/-- The linearized equation of motion in the rotational form of Newton's second law: at every + instant the rate of change `I θ̈` of the angular momentum equals the force `-m g ℓ θ` of the + associated harmonic oscillator. No smoothness is required: the two pointwise equations differ + by the nonzero factor `I`. -/ +lemma linearizedEquationOfMotion_iff_newton (θ : Time → EuclideanSpace ℝ (Fin 1)) : + S.LinearizedEquationOfMotion θ ↔ + ∀ t, S.inertia • ∂ₜ (∂ₜ θ) t = S.toHarmonicOscillator.force (θ t) := by + simp only [LinearizedEquationOfMotion] + refine forall_congr' fun t => ?_ + rw [S.toHarmonicOscillator.force_eq_linear, toHarmonicOscillator_k, + neg_smul, eq_neg_iff_add_eq_zero, ← S.ω_sq_mul_inertia, mul_comm (S.ω ^ 2) S.inertia, + ← smul_smul, ← smul_add, smul_eq_zero, or_iff_right S.inertia_ne_zero] + +/-! + +### B.2. Equivalence with the equation of motion of the oscillator + +For a smooth lift of the angle, the linearized equation of motion is the equation of motion of +the associated harmonic oscillator, through the latter's own form of Newton's second law. The +solution theory of the harmonic oscillator thereby becomes available to the small oscillations +of the pendulum. + +-/ + +/-- For a smooth lift of the angle, the linearized equation of motion of the simple pendulum is + the equation of motion of the associated harmonic oscillator. The oscillator's equation of + motion is the vanishing of the variational gradient of its action, which is totalized; + smoothness is the regularity under which that variational description agrees with the pointwise + one. The smoothness-free pointwise content is `linearizedEquationOfMotion_iff_newton`. -/ +lemma linearizedEquationOfMotion_iff (θ : Time → EuclideanSpace ℝ (Fin 1)) + (hθ : ContDiff ℝ ∞ θ) : + S.LinearizedEquationOfMotion θ ↔ S.toHarmonicOscillator.EquationOfMotion θ := by + rw [S.toHarmonicOscillator.equationOfMotion_iff_newtons_2nd_law θ hθ] + exact S.linearizedEquationOfMotion_iff_newton θ + +/-! + +### B.3. Linearization as differentiation of the torque + +The linearized force is not an ansatz: it is the derivative of the pendulum's torque at the +hanging equilibrium. The torque vanishes at the equilibrium, so its best linear approximation +there is the derivative alone, and that derivative is exactly the force of the associated +harmonic oscillator. The linearized equation of motion is therefore the equation of motion +with the torque replaced by its derivative at the equilibrium — linearizing the pendulum is +differentiating its torque. + +-/ + +/-- The derivative of the torque at the hanging equilibrium is the force of the associated + harmonic oscillator: `(Dτ)(0) v = -m g ℓ v`. Linearizing the pendulum is differentiating + its torque at the equilibrium. -/ +lemma fderiv_torque_zero_apply (v : EuclideanSpace ℝ (Fin 1)) : + fderiv ℝ S.torque 0 v = S.toHarmonicOscillator.force v := by + have h1 := (EuclideanSpace.proj (𝕜 := ℝ) (0 : Fin 1)).hasFDerivAt + (x := (0 : EuclideanSpace ℝ (Fin 1))) + have h2 := (Real.hasDerivAt_sin 0).comp_hasFDerivAt_of_eq + (0 : EuclideanSpace ℝ (Fin 1)) h1 (by simp) + have h3 := (h2.const_mul (-(S.m * S.g * S.ℓ))).smul_const + (EuclideanSpace.single (0 : Fin 1) (1 : ℝ)) + have hfun : S.torque = fun x : EuclideanSpace ℝ (Fin 1) => + (-(S.m * S.g * S.ℓ) * (Real.sin ∘ EuclideanSpace.proj (𝕜 := ℝ) (0 : Fin 1)) x) • + EuclideanSpace.single (0 : Fin 1) (1 : ℝ) := by + funext x + rw [S.torque_eq x] + simp [Function.comp_apply, neg_smul, neg_mul] + rw [← hfun] at h3 + rw [h3.fderiv, S.toHarmonicOscillator.force_eq_linear, toHarmonicOscillator_k] + ext i + fin_cases i + simp [smul_eq_mul, Real.cos_zero] + +/-- The linearized equation of motion is the equation of motion with the torque replaced by + its derivative at the hanging equilibrium. -/ +lemma linearizedEquationOfMotion_iff_fderiv_torque (θ : Time → EuclideanSpace ℝ (Fin 1)) : + S.LinearizedEquationOfMotion θ ↔ + ∀ t, S.inertia • ∂ₜ (∂ₜ θ) t = fderiv ℝ S.torque 0 (θ t) := by + rw [S.linearizedEquationOfMotion_iff_newton θ] + exact forall_congr' fun t => by rw [S.fderiv_torque_zero_apply (θ t)] + +/-! + +## C. Small-angle trajectories + +For small angles the pendulum is approximated by its associated harmonic oscillator, and the +solution theory of the oscillator transfers verbatim: every choice of initial angle and +initial angular velocity determines a smooth motion, unique among the smooth solutions of the +linearized equation of motion. This section performs the transfer, and specializes it to the +classical motion released from rest at a given angle. + +-/ + +/-! + +### C.1. The trajectory of given initial conditions + +The small-angle motion determined by an initial angle `IC.x₀` and an initial angular velocity +`IC.v₀` is the trajectory of the associated harmonic oscillator for the same initial +conditions. It is smooth in time, it assumes the prescribed initial data at time `0`, and +written out it is the familiar `cos (ω t) x₀ + (sin (ω t)/ω) v₀`, with the frequency of the +oscillator read as the `ω` of the pendulum. + +-/ + +/-- The small-angle motion of the simple pendulum with initial angle `IC.x₀` and initial + angular velocity `IC.v₀`: the trajectory of the associated harmonic oscillator with the same + initial conditions. -/ +noncomputable def smallAngleTrajectory (IC : HarmonicOscillator.InitialConditions) : + Time → EuclideanSpace ℝ (Fin 1) := + IC.trajectory S.toHarmonicOscillator + +/-- The small-angle trajectories of the simple pendulum are smooth in time. -/ +@[fun_prop] +lemma smallAngleTrajectory_contDiff (IC : HarmonicOscillator.InitialConditions) + {n : WithTop ℕ∞} : ContDiff ℝ n (S.smallAngleTrajectory IC) := + HarmonicOscillator.InitialConditions.trajectory_contDiff S.toHarmonicOscillator IC + +/-- At time `0` the small-angle trajectory passes through its initial angle. -/ +@[simp] +lemma smallAngleTrajectory_at_zero (IC : HarmonicOscillator.InitialConditions) : + S.smallAngleTrajectory IC 0 = IC.x₀ := by + simp [smallAngleTrajectory] + +/-- At time `0` the small-angle trajectory moves with its initial angular velocity. -/ +@[simp] +lemma smallAngleTrajectory_velocity_at_zero (IC : HarmonicOscillator.InitialConditions) : + ∂ₜ (S.smallAngleTrajectory IC) 0 = IC.v₀ := by + simp [smallAngleTrajectory] + +/-- The closed form of the small-angle motion: `cos (ω t) x₀ + (sin (ω t)/ω) v₀`, the + trajectory of the associated harmonic oscillator with its frequency read as the `ω` of the + pendulum. -/ +lemma smallAngleTrajectory_eq (IC : HarmonicOscillator.InitialConditions) : + S.smallAngleTrajectory IC = fun t : Time => + Real.cos (S.ω * t.val) • IC.x₀ + (Real.sin (S.ω * t.val) / S.ω) • IC.v₀ := by + unfold smallAngleTrajectory + rw [HarmonicOscillator.InitialConditions.trajectory_eq, toHarmonicOscillator_ω] + +/-! + +### C.2. Existence and uniqueness + +The small-angle trajectories solve the linearized equation of motion, and they are the only +smooth solutions: a smooth solution with the initial data of `IC` is the small-angle +trajectory of `IC`. Both statements are the corresponding statements for the associated +harmonic oscillator, read through the equivalence `linearizedEquationOfMotion_iff` of the two +equations of motion. + +-/ + +/-- The small-angle trajectories satisfy the linearized equation of motion: for every choice + of initial conditions the linearized equation has a smooth solution assuming them. -/ +lemma smallAngleTrajectory_linearizedEquationOfMotion + (IC : HarmonicOscillator.InitialConditions) : + S.LinearizedEquationOfMotion (S.smallAngleTrajectory IC) := + (S.linearizedEquationOfMotion_iff _ (S.smallAngleTrajectory_contDiff IC)).mpr + (HarmonicOscillator.InitialConditions.trajectory_equationOfMotion S.toHarmonicOscillator IC) + +/-- Uniqueness of the small-angle motions: a smooth solution of the linearized equation of + motion is determined by its initial angle and initial angular velocity, being the + small-angle trajectory of those initial conditions. This is the uniqueness theorem for the + associated harmonic oscillator, transferred through `linearizedEquationOfMotion_iff`. -/ +lemma linearized_unique (IC : HarmonicOscillator.InitialConditions) + (θ : Time → EuclideanSpace ℝ (Fin 1)) (hθ : ContDiff ℝ ∞ θ) + (h : S.LinearizedEquationOfMotion θ) (h0 : θ 0 = IC.x₀) (hv : ∂ₜ θ 0 = IC.v₀) : + θ = S.smallAngleTrajectory IC := + HarmonicOscillator.InitialConditions.trajectories_unique S.toHarmonicOscillator IC θ hθ + ⟨(S.linearizedEquationOfMotion_iff θ hθ).mp h, h0, hv⟩ + +/-! + +### C.3. Release from rest + +The classical small-angle experiment: the pendulum is displaced to an angle `θ₀` and released +from rest. Its small-angle motion is the cosine `θ₀ cos (ω t)`, the small-angle trajectory of +the initial conditions with initial angle `θ₀` and zero initial angular velocity; it starts at +the angle `θ₀` with vanishing angular velocity, and satisfies the linearized equation of +motion. + +-/ + +/-- The small-angle motion of the pendulum released from rest at initial angle `θ₀`: the + cosine `θ₀ cos (ω t)` of angular frequency `ω`. -/ +noncomputable def releasedFromRest (θ₀ : ℝ) : Time → EuclideanSpace ℝ (Fin 1) := + fun t => Real.cos (S.ω * t.val) • EuclideanSpace.single (0 : Fin 1) θ₀ + +/-- The motion released from rest at angle `θ₀` is the small-angle trajectory of the initial + conditions with initial angle `θ₀` and zero initial angular velocity. -/ +lemma releasedFromRest_eq (θ₀ : ℝ) : + S.releasedFromRest θ₀ = S.smallAngleTrajectory ⟨EuclideanSpace.single 0 θ₀, 0⟩ := by + funext t + ext i + simp [releasedFromRest, smallAngleTrajectory, + HarmonicOscillator.InitialConditions.trajectory, toHarmonicOscillator_ω] + +/-- At time `0` the motion released from rest at angle `θ₀` is at the angle `θ₀`. -/ +@[simp] +lemma releasedFromRest_at_zero (θ₀ : ℝ) : + S.releasedFromRest θ₀ 0 = EuclideanSpace.single 0 θ₀ := by + simp [releasedFromRest] + +/-- The motion released from rest at angle `θ₀` is genuinely released from rest: its angular + velocity at time `0` vanishes. -/ +@[simp] +lemma releasedFromRest_velocity_at_zero (θ₀ : ℝ) : ∂ₜ (S.releasedFromRest θ₀) 0 = 0 := by + rw [S.releasedFromRest_eq θ₀] + exact S.smallAngleTrajectory_velocity_at_zero ⟨EuclideanSpace.single 0 θ₀, 0⟩ + +/-- The motion released from rest at angle `θ₀` satisfies the linearized equation of + motion. -/ +lemma releasedFromRest_linearizedEquationOfMotion (θ₀ : ℝ) : + S.LinearizedEquationOfMotion (S.releasedFromRest θ₀) := by + rw [S.releasedFromRest_eq θ₀] + exact S.smallAngleTrajectory_linearizedEquationOfMotion ⟨EuclideanSpace.single 0 θ₀, 0⟩ + +/-! + +## D. The small-angle period + +The associated harmonic oscillator completes one oscillation in the time `2π/ω`, and its +angular frequency is the `ω = √(g/ℓ)` of the pendulum: the small oscillations have period +`2π √(ℓ/g)`, independent of both the mass of the bob and the amplitude of the swing. Within +the linearization the pendulum is isochronous; the dependence of the true period on the +amplitude is invisible at this order. + +-/ + +/-! + +### D.1. The period and its closed form + +The period of the small oscillations is the period of the associated harmonic oscillator. Its +closed form `2π √(ℓ/g)` involves only the length of the rod and the strength of gravity: the +mass of the bob cancelled from the frequency, and the amplitude never entered. + +-/ + +/-- The period `2π √(ℓ/g)` of the small oscillations of the simple pendulum: the period of the + associated harmonic oscillator. Within the linearization it does not depend on the + amplitude — the small oscillations are isochronous, as derived by Huygens (1673). -/ +noncomputable def smallAnglePeriod : ℝ := HarmonicOscillator.period S.toHarmonicOscillator + +/-- The period of the small oscillations is `2π/ω`, one full circle of phase at the angular + frequency `ω` of the small oscillations. -/ +lemma smallAnglePeriod_eq_two_pi_div_ω : S.smallAnglePeriod = 2 * Real.pi / S.ω := by + unfold smallAnglePeriod + rw [HarmonicOscillator.period_eq, toHarmonicOscillator_ω] + +/-- The closed form of the small-angle period: `2π √(ℓ/g)`. Neither the mass of the bob nor + the amplitude of the swing appears. -/ +lemma smallAnglePeriod_eq : S.smallAnglePeriod = 2 * Real.pi * √(S.ℓ / S.g) := by + rw [smallAnglePeriod_eq_two_pi_div_ω] + unfold SimplePendulum.ω + rw [div_eq_mul_inv, ← Real.sqrt_inv, inv_div] + +/-- The period of the small oscillations is positive. -/ +lemma smallAnglePeriod_pos : 0 < S.smallAnglePeriod := + HarmonicOscillator.period_pos S.toHarmonicOscillator + +/-! + +### D.2. Periodicity and the energy of the small-angle motions + +Advancing time by one period shifts the phase `ω t` by `2π` and so returns every small-angle +motion to its state: the small-angle trajectories are periodic with the small-angle period. +Along each of them the energy of the associated harmonic oscillator is constant, equal to the +value fixed by the initial data. + +-/ + +/-- The small-angle trajectories of the simple pendulum are periodic with the small-angle + period `2π √(ℓ/g)`. -/ +lemma smallAngleTrajectory_periodic (IC : HarmonicOscillator.InitialConditions) : + Function.Periodic (S.smallAngleTrajectory IC) (S.smallAnglePeriod : Time) := + HarmonicOscillator.trajectory_periodic S.toHarmonicOscillator IC + +/-- The motion released from rest at angle `θ₀` is periodic with the small-angle period: after + each time `2π √(ℓ/g)` the motion returns to the angle `θ₀` with zero angular velocity. -/ +lemma releasedFromRest_periodic (θ₀ : ℝ) : + Function.Periodic (S.releasedFromRest θ₀) (S.smallAnglePeriod : Time) := by + rw [S.releasedFromRest_eq θ₀] + exact S.smallAngleTrajectory_periodic ⟨EuclideanSpace.single 0 θ₀, 0⟩ + +/-- Along a small-angle trajectory the energy of the associated harmonic oscillator is the + constant `½ (I ‖v₀‖² + m g ℓ ‖IC.x₀‖²)` fixed by the initial data: the rotational kinetic term + of the initial angular velocity plus the potential term of the initial angle. -/ +lemma smallAngleTrajectory_energy (IC : HarmonicOscillator.InitialConditions) : + S.toHarmonicOscillator.energy (S.smallAngleTrajectory IC) = + fun _ => 1 / 2 * (S.inertia * ‖IC.v₀‖ ^ 2 + S.m * S.g * S.ℓ * ‖IC.x₀‖ ^ 2) := + HarmonicOscillator.InitialConditions.trajectory_energy S.toHarmonicOscillator IC + +/-! + +## E. The error of the linearization + +The linearization replaces the torque `-m g ℓ sin θ` by `-m g ℓ θ`. The replacement is not +exact, and this section measures what it discards: pointwise the two differ by +`m g ℓ (θ - sin θ)`, which the Taylor estimate for the sine bounds by `m g ℓ |θ|³/6`; the +difference of the variational gradients of the two actions is exactly this difference of the +torques, the inertial terms cancelling; and every small-angle motion solves the equation of +motion of the pendulum itself up to a residual of the same cubic size. + +-/ + +/-! + +### E.1. The cubic bound on the torque + +The difference between the torque of the pendulum and the force of the associated oscillator +is exactly `m g ℓ (θ - sin θ)` times the unit vector of the angular direction, which the +Taylor estimate for the sine bounds in norm by `m g ℓ ‖θ‖³/6`: for small angles the discarded +term is cubically small. In the single coordinate of the angle the same bound reads +`m g ℓ |θ|³/6`. + +-/ + +/-- The difference between the torque of the simple pendulum and the force of its associated + harmonic oscillator is `m g ℓ (θ - sin θ)` times the unit vector of the angular direction: + exactly the term the linearization discards. -/ +lemma torque_sub_toHarmonicOscillator_force (x : EuclideanSpace ℝ (Fin 1)) : + S.torque x - S.toHarmonicOscillator.force x = + (S.m * S.g * S.ℓ * (x 0 - Real.sin (x 0))) • EuclideanSpace.single 0 1 := by + rw [torque_eq, S.toHarmonicOscillator.force_eq_linear, toHarmonicOscillator_k] + ext i + fin_cases i + simp only [Fin.isValue, neg_smul, sub_neg_eq_add, Fin.zero_eta, PiLp.add_apply, + PiLp.neg_apply, PiLp.smul_apply, PiLp.single_eq_same, smul_eq_mul, mul_one] + ring + +/-- The normed form of the cubic bound: the torque of the simple pendulum differs from the + force of its associated harmonic oscillator by at most `m g ℓ ‖θ‖³ / 6` in norm. -/ +lemma norm_torque_sub_toHarmonicOscillator_force_le (x : EuclideanSpace ℝ (Fin 1)) : + ‖S.torque x - S.toHarmonicOscillator.force x‖ ≤ S.m * S.g * S.ℓ * ‖x‖ ^ 3 / 6 := by + have hc : (0 : ℝ) < S.m * S.g * S.ℓ := by + have := S.m_pos; have := S.g_pos; have := S.ℓ_pos; positivity + have hx : ‖x‖ = |x 0| := by + rw [EuclideanSpace.norm_eq] + simp [Real.sqrt_sq_eq_abs] + rw [S.torque_sub_toHarmonicOscillator_force x, norm_smul, Real.norm_eq_abs, PiLp.norm_single, + norm_one, mul_one, abs_mul, abs_of_pos hc, hx, mul_div_assoc] + exact mul_le_mul_of_nonneg_left (Real.abs_sub_sin_le (x 0)) hc.le + +/-- The torque of the simple pendulum differs from its linearization `-m g ℓ θ` by at most + `m g ℓ |θ|³ / 6`: the error of the small-angle approximation is cubic in the angle. -/ +lemma abs_torque_add_linear_le (x : EuclideanSpace ℝ (Fin 1)) : + |S.torque x 0 + S.m * S.g * S.ℓ * x 0| ≤ S.m * S.g * S.ℓ * |x 0| ^ 3 / 6 := by + have hc : (0 : ℝ) < S.m * S.g * S.ℓ := by + have := S.m_pos; have := S.g_pos; have := S.ℓ_pos; positivity + have key : S.torque x 0 + S.m * S.g * S.ℓ * x 0 + = S.m * S.g * S.ℓ * (x 0 - Real.sin (x 0)) := by + calc S.torque x 0 + S.m * S.g * S.ℓ * x 0 + = (S.torque x - S.toHarmonicOscillator.force x) 0 := by + rw [S.toHarmonicOscillator.force_eq_linear, toHarmonicOscillator_k] + simp [PiLp.smul_apply, smul_eq_mul, sub_neg_eq_add] + _ = S.m * S.g * S.ℓ * (x 0 - Real.sin (x 0)) := by + rw [S.torque_sub_toHarmonicOscillator_force x] + simp + rw [key, abs_mul, abs_of_pos hc, mul_div_assoc] + exact mul_le_mul_of_nonneg_left (Real.abs_sub_sin_le (x 0)) hc.le + +/-! + +### E.2. The variational gradients + +The actions of the pendulum and of its associated oscillator have the same kinetic term, the +moment of inertia being the mass of the oscillator, so along a smooth lift of the angle the +difference of their variational gradients is the difference of torque and linearized force at +each instant: the linearization error of the dynamics is the linearization error of the +torque. + +-/ + +/-- Along a smooth lift of the angle, the variational gradients of the actions of the simple + pendulum and of its associated harmonic oscillator differ exactly by the difference between + the torque and the linearized force: the inertial terms cancel. -/ +lemma gradLagrangian_sub_toHarmonicOscillator (θ : Time → EuclideanSpace ℝ (Fin 1)) + (hθ : ContDiff ℝ ∞ θ) : + S.gradLagrangian θ - S.toHarmonicOscillator.gradLagrangian θ = + fun t => S.torque (θ t) - S.toHarmonicOscillator.force (θ t) := by + rw [S.gradLagrangian_eq_torque θ hθ, + S.toHarmonicOscillator.gradLagrangian_eq_force θ hθ] + funext t + simp only [Pi.sub_apply, toHarmonicOscillator_m] + abel + +/-- The normed form: along a smooth lift of the angle the variational gradients of the two + actions differ at every instant by at most `m g ℓ ‖θ t‖³ / 6` — the two actions have the + same critical-point equation to cubic accuracy in the angle. -/ +lemma norm_gradLagrangian_sub_toHarmonicOscillator_le (θ : Time → EuclideanSpace ℝ (Fin 1)) + (hθ : ContDiff ℝ ∞ θ) (t : Time) : + ‖S.gradLagrangian θ t - S.toHarmonicOscillator.gradLagrangian θ t‖ ≤ + S.m * S.g * S.ℓ * ‖θ t‖ ^ 3 / 6 := by + have h := congrFun (S.gradLagrangian_sub_toHarmonicOscillator θ hθ) t + rw [Pi.sub_apply] at h + rw [h] + exact S.norm_torque_sub_toHarmonicOscillator_force_le (θ t) + +/-! + +### E.3. The residual of the small-angle motions + +Combining the linearized dynamics with the cubic bound: a small-angle motion does not solve +the equation of motion of the pendulum exactly, but the residual it leaves in it is cubically +small in the angle — the small-angle theory solves the pendulum's own equation up to an error +of at most `m g ℓ ‖θ‖³/6` at every instant. + +-/ + +/-- A motion satisfying the linearized equation of motion nearly solves the equation of motion + of the pendulum itself: at every instant the residual `I θ̈ - τ(θ)` has norm at most + `m g ℓ ‖θ‖³ / 6`, cubically small for small angles. -/ +lemma norm_equationOfMotion_residual_le (θ : Time → EuclideanSpace ℝ (Fin 1)) + (h : S.LinearizedEquationOfMotion θ) (t : Time) : + ‖S.inertia • ∂ₜ (∂ₜ θ) t - S.torque (θ t)‖ ≤ S.m * S.g * S.ℓ * ‖θ t‖ ^ 3 / 6 := by + rw [(S.linearizedEquationOfMotion_iff_newton θ).mp h t, ← neg_sub, norm_neg] + exact S.norm_torque_sub_toHarmonicOscillator_force_le (θ t) + + +/-- The variational form of the residual: a smooth motion of the linearized dynamics is a + near-critical point of the pendulum's own action — along it the variational gradient of the + pendulum's action is cubically small in the angle. -/ +lemma norm_gradLagrangian_le_of_linearizedEquationOfMotion + (θ : Time → EuclideanSpace ℝ (Fin 1)) (hθ : ContDiff ℝ ∞ θ) + (h : S.LinearizedEquationOfMotion θ) (t : Time) : + ‖S.gradLagrangian θ t‖ ≤ S.m * S.g * S.ℓ * ‖θ t‖ ^ 3 / 6 := by + have h0 : S.toHarmonicOscillator.gradLagrangian θ = 0 := + (S.toHarmonicOscillator.equationOfMotion_iff_gradLagrangian_zero θ).mp + ((S.linearizedEquationOfMotion_iff θ hθ).mp h) + have hb := S.norm_gradLagrangian_sub_toHarmonicOscillator_le θ hθ t + simpa [h0] using hb + +TODO "Derive the small-angle trajectories from the pendulum's own dynamics: for the solution of + the nonlinear equation of motion with initial data scaled by `ε`, show that the motion rescaled + by `ε⁻¹` converges to the small-angle trajectory of the unscaled data, uniformly on compact time + intervals, as `ε → 0` — continuous dependence via a Grönwall bound, with the cubic residual of + section E as input. This requires the global solution theory of the nonlinear equation." + +end SimplePendulum + +end ClassicalMechanics diff --git a/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Solution.lean b/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Solution.lean new file mode 100644 index 0000000000..8b689192b1 --- /dev/null +++ b/Physlib/ClassicalMechanics/Pendulum/SimplePendulum/Solution.lean @@ -0,0 +1,388 @@ +/- +Copyright (c) 2026 Aadarsh Agarwal. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Aadarsh Agarwal +-/ +module + +public import Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Basic +public import Mathlib.Analysis.ODE.ExistUnique +/-! + +# Existence and uniqueness of the solutions of the simple pendulum + +## i. Overview + +The equation of motion of the simple pendulum, `θ̈ + ω² sin θ = 0`, is nonlinear, and unlike the +harmonic oscillator it has no solution in closed elementary form. Whatever is to be proved about +"the" motion of the pendulum released with a given angle and angular velocity must therefore rest +on the general theory of ordinary differential equations rather than on an explicit formula. This +module supplies that foundation: two smooth solutions of the equation of motion with the same +initial angle and the same initial angular velocity coincide for all time, and for any initial +angle and angular velocity there is a curve with that initial data satisfying the equation of +motion on some interval of time about the initial instant. + +The argument is the one used for the damped harmonic oscillator. The second-order equation is +rewritten as the first-order system `(θ, θ̇)' = (θ̇, -ω² sin θ)` on the phase space, whose +right-hand side, the phase-space vector field of the pendulum, is globally Lipschitz because `sin` +is. The global uniqueness theorem for Lipschitz first-order systems, Mathlib's +`ODE_solution_unique_univ`, then gives the uniqueness. The uniqueness is global in time and does +not depend on the size of the motion: it holds for librations and rotations alike. Existence comes +from the Picard–Lindelöf theorem applied to the same first-order system, the phase-space vector +field being smooth; the theorem is local, and so is the statement proved here. + +The equation of motion contains no first derivative of the angle: there is no damping. Reversing +the direction of time therefore carries solutions to solutions, and combined with uniqueness this +shows that a pendulum released from rest retraces its path, the angle being an even function of +the time since release. + +## ii. Key results + +- `SimplePendulum.phaseVectorField` is the phase-space vector field `(θ, θ̇) ↦ (θ̇, -ω² sin θ)`, + and `SimplePendulum.phaseVectorField_lipschitz` proves that it is globally Lipschitz, with + constant `1 + ω²`. +- `SimplePendulum.acceleration_eq_of_equationOfMotion` solves the equation of motion for the + angular acceleration, and `SimplePendulum.phaseCurve_hasDerivAt` shows that the phase curve + `(θ, θ̇)` of a smooth solution is an integral curve of the phase-space vector field. +- `SimplePendulum.equationOfMotion_unique` proves that two smooth solutions of the equation of + motion with the same initial angle and angular velocity are equal, and + `SimplePendulum.IsSolution.eq_of_initial` is the same statement for solutions. +- `SimplePendulum.isSolution_comp_neg` proves that the time reversal `t ↦ θ (-t)` of a solution + is a solution, and `SimplePendulum.releasedFromRest_even` that a solution released from rest is + an even function of time. +- `SimplePendulum.exists_local_solution` proves, from the Picard–Lindelöf theorem, that for any + initial angle and angular velocity there is a curve with that initial data, differentiable + together with its velocity and satisfying the equation of motion at all times within some + `ε > 0` of the initial instant. + +## iii. Table of contents + +- A. The phase-space vector field + - A.1. The definition of the vector field + - A.2. The Lipschitz bound +- B. The phase curve of a solution + - B.1. The angular acceleration along a solution + - B.2. The phase curve as an integral curve +- C. Uniqueness of the solutions +- D. Time-reversal symmetry + - D.1. Time reversal of solutions + - D.2. Motions released from rest +- E. Local existence + - E.1. Smoothness of the phase-space vector field + - E.2. Local existence of solutions + +## iv. References + +References for the motion of the pendulum, its phase plane, and the existence and uniqueness +theorem for ordinary differential equations include: + +* Landau & Lifshitz, Mechanics, 3rd ed., §11, for motion in one dimension. [ref: landau_mechanics] +* Arnold, Mathematical Methods of Classical Mechanics, 2nd ed., §4, for the phase plane of the + pendulum. [ref: arnold_mechanics] +* Arnold, Ordinary Differential Equations, Chapter 4 (Proofs of the main theorems), for the + existence and uniqueness theorem by Picard iteration. [ref: arnold_ode] + +The reduction to a first-order system on the phase space follows +`DampedHarmonicOscillator.equationOfMotion_unique`. +-/ + +@[expose] public section + +open Real Time +open scoped ContDiff + +namespace ClassicalMechanics.SimplePendulum + +variable (S : SimplePendulum) + +/-! + +## A. The phase-space vector field + +The equation of motion `θ̈ + ω² sin θ = 0` is of second order. Taking the angular velocity as a +second unknown turns it into the first-order system `(θ, θ̇)' = (θ̇, -ω² sin θ)` on the phase +space, the product of two copies of the one-dimensional Euclidean space carrying the angle and its +rate of change. The right-hand side of this system is the phase-space vector field of the +pendulum. Its first component is the projection onto the angular velocity, and its second is `-ω²` +times the sine of the angle; as the derivative of `sin` is bounded by one, the field is globally +Lipschitz on the phase space. This is the hypothesis under which the general uniqueness theorem +for first-order systems applies with no restriction on the time interval or on the size of the +motion. + +-/ + +/-! + +### A.1. The definition of the vector field + +-/ + +/-- The phase-space vector field of the simple pendulum, sending `(θ, θ̇)` to + `(θ̇, -ω² sin θ)`. It is the right-hand side of the first-order system on the phase space + equivalent to the equation of motion `θ̈ + ω² sin θ = 0`. -/ +noncomputable def phaseVectorField (p : EuclideanSpace ℝ (Fin 1) × EuclideanSpace ℝ (Fin 1)) : + EuclideanSpace ℝ (Fin 1) × EuclideanSpace ℝ (Fin 1) := + (p.2, -(S.ω ^ 2 * Real.sin (p.1 0)) • EuclideanSpace.single 0 1) + +/-! + +### A.2. The Lipschitz bound + +-/ + +/-- The phase-space vector field of the simple pendulum is globally Lipschitz, with constant + `1 + ω²`: the first component is the projection onto the angular velocity, and the second is + `-ω²` times `sin` of the angle, and `sin` is Lipschitz with constant one. -/ +lemma phaseVectorField_lipschitz : + LipschitzWith (Real.toNNReal (1 + S.ω ^ 2)) S.phaseVectorField := by + refine LipschitzWith.of_dist_le_mul fun p q => ?_ + rw [Real.coe_toNNReal _ (by positivity), Prod.dist_eq, add_mul, one_mul] + apply max_le _ _ + · apply le_trans _ (le_add_of_nonneg_right (by positivity)) + exact le_max_right _ _ + · apply le_trans _ (le_add_of_nonneg_left (by positivity)) + apply le_trans (dist_pair_smul _ _ _) + rw [dist_neg_neg, dist_eq_norm, norm_eq_abs, ← mul_sub, abs_mul, abs_of_nonneg (sq_nonneg _), + mul_assoc, mul_le_mul_iff_right₀ (pow_succ_pos S.ω_pos _), dist_zero_right, PiLp.norm_single, + norm_one, mul_one] + apply le_trans _ (le_max_left _ _) + apply le_trans (Real.abs_sin_sub_sin_le _ _) + rw [dist_eq_norm, ← Real.norm_eq_abs, ← PiLp.sub_apply] + exact PiLp.norm_apply_le _ _ + +/-! + +## B. The phase curve of a solution + +A smooth lift `θ` of the angle satisfying the equation of motion determines the phase curve +`t ↦ (θ t, θ̇ t)` in the phase space. Solving the equation of motion for the angular acceleration +shows that this curve is an integral curve of the phase-space vector field: its velocity at every +instant is the value of the field at its position. The curve is parametrised here by a real +variable through the canonical equivalence `Time.toRealCLE.symm : ℝ ≃L[ℝ] Time`, as the +uniqueness theorem of Mathlib is stated for curves on `ℝ`. + +-/ + +/-! + +### B.1. The angular acceleration along a solution + +-/ + +/-- Solving the equation of motion for the angular acceleration: along a solution the second + derivative of the angle is `-ω² sin θ` times the unit vector of the angular coordinate, the + mass having cancelled. -/ +lemma acceleration_eq_of_equationOfMotion (θ : Time → EuclideanSpace ℝ (Fin 1)) + (h : S.EquationOfMotion θ) (t : Time) : + ∂ₜ (∂ₜ θ) t = -(S.ω ^ 2 * Real.sin (θ t 0)) • EuclideanSpace.single 0 1 := by + ext i + fin_cases i + simpa using eq_neg_of_add_eq_zero_left ((S.equationOfMotion_iff_scalar θ).mp h t) + +/-- The pointwise equation of motion in terms of the angular frequency: the moment of inertia + times the acceleration `-ω² sin θ` is the torque. This reads the equation of motion back off + the second component of the phase-space vector field. -/ +lemma inertia_smul_eq_torque (x : EuclideanSpace ℝ (Fin 1)) : + S.inertia • (-(S.ω ^ 2 * Real.sin (x 0)) • EuclideanSpace.single 0 1) = S.torque x := by + rw [torque_eq, smul_smul, ← neg_smul, ← S.ω_sq_mul_inertia] + congr + ring + +/-! + +### B.2. The phase curve as an integral curve + +-/ + +/-- The phase curve `τ ↦ (θ t, θ̇ t)` (with `t = toRealCLE.symm τ`) of a smooth solution `θ` + solves the first-order phase-space ODE with vector field `phaseVectorField`. -/ +lemma phaseCurve_hasDerivAt {θ : Time → EuclideanSpace ℝ (Fin 1)} + (hθ : ContDiff ℝ ∞ θ) (h : S.EquationOfMotion θ) (τ : ℝ) : + HasDerivAt (fun τ : ℝ => (θ (toRealCLE.symm τ), ∂ₜ θ (toRealCLE.symm τ))) + (S.phaseVectorField (θ (toRealCLE.symm τ), ∂ₜ θ (toRealCLE.symm τ))) τ := by + rw [phaseVectorField, ← S.acceleration_eq_of_equationOfMotion θ h (Time.toRealCLE.symm τ)] + exact (hasDerivAt_comp_toRealCLE_symm θ τ (hθ.differentiable (by simp) _)).prodMk + (hasDerivAt_comp_toRealCLE_symm (∂ₜ θ) τ (deriv_differentiable_of_contDiff θ hθ _)) + +/-! + +## C. Uniqueness of the solutions + +The phase curves of two smooth solutions with the same initial angle and angular velocity are two +integral curves of the same globally Lipschitz vector field through the same point at time zero. +By the global uniqueness theorem `ODE_solution_unique_univ` they coincide, and reading off the +first component the two solutions are equal. The energy is conserved along a solution, but it is +not used here: the nonlinear equation of motion is handled exactly as the linear damped one, by the +first-order reduction alone. + +-/ + +/-- Any two smooth solutions of the equation of motion of the simple pendulum with the same + initial angle and angular velocity are equal. -/ +lemma equationOfMotion_unique {x y : Time → EuclideanSpace ℝ (Fin 1)} + (hx : ContDiff ℝ ∞ x) (hy : ContDiff ℝ ∞ y) + (hEOMx : S.EquationOfMotion x) (hEOMy : S.EquationOfMotion y) + (h0 : x 0 = y 0) (hv0 : ∂ₜ x 0 = ∂ₜ y 0) : x = y := by + have hEq := ODE_solution_unique_univ (t₀ := (0 : ℝ)) + (f := fun τ : ℝ => (x (Time.toRealCLE.symm τ), ∂ₜ x (Time.toRealCLE.symm τ))) + (g := fun τ : ℝ => (y (Time.toRealCLE.symm τ), ∂ₜ y (Time.toRealCLE.symm τ))) + (fun _ => S.phaseVectorField_lipschitz.lipschitzOnWith) + (fun τ => ⟨S.phaseCurve_hasDerivAt hx hEOMx τ, Set.mem_univ _⟩) + (fun τ => ⟨S.phaseCurve_hasDerivAt hy hEOMy τ, Set.mem_univ _⟩) + (by simp [h0, hv0]) + funext t + rw [funext_iff] at hEq + exact (Prod.ext_iff.mp (hEq (toRealCLE t))).1 + +/-- Two solutions of the simple pendulum with the same initial angle and angular velocity are + equal. -/ +lemma IsSolution.eq_of_initial {S : SimplePendulum} {x y : Time → EuclideanSpace ℝ (Fin 1)} + (hx : S.IsSolution x) (hy : S.IsSolution y) (h0 : x 0 = y 0) (hv0 : ∂ₜ x 0 = ∂ₜ y 0) : + x = y := + S.equationOfMotion_unique hx.contDiff hy.contDiff hx.equationOfMotion hy.equationOfMotion + h0 hv0 + +/-! + +## D. Time-reversal symmetry + +The equation of motion `I θ̈ = τ(θ)` is of second order and contains no first derivative of the +angle: there is no damping. Under the reversal of time `t ↦ -t` the angular velocity changes sign +and the angular acceleration does not, so the reversed curve `t ↦ θ (-t)` of a solution is again a +solution. Together with the uniqueness of section C this has a physical consequence: a pendulum +released from rest at the instant `0` retraces its path, the angle at time `-t` being the angle at +time `t`. The bookkeeping of the derivatives under the reflection of `Time` is done by the chain +rule `Time.deriv_comp_neg` and its second-order form `Time.deriv_deriv_comp_neg`. + +-/ + +/-! + +### D.1. Time reversal of solutions + +-/ + +/-- The time reversal `t ↦ θ (-t)` of a solution of the simple pendulum is a solution: the + equation of motion has no velocity term, and the angular acceleration is unchanged by the + reversal. -/ +lemma isSolution_comp_neg {S : SimplePendulum} {θ : Time → EuclideanSpace ℝ (Fin 1)} + (h : S.IsSolution θ) : S.IsSolution (fun t => θ (-t)) := by + refine ⟨h.contDiff.comp contDiff_neg, fun t => ?_⟩ + rw [Time.deriv_deriv_comp_neg θ (h.contDiff.of_le (by norm_cast)) t] + exact h.equationOfMotion (-t) + +/-! + +### D.2. Motions released from rest + +-/ + +/-- A solution of the simple pendulum released from rest at the instant `0` is an even function + of time: it retraces its path, `θ (-t) = θ t`. The time reversal of the solution has the same + initial angle and, the initial angular velocity being zero, the same initial angular velocity, + so the two coincide by uniqueness. -/ +lemma releasedFromRest_even {S : SimplePendulum} {θ : Time → EuclideanSpace ℝ (Fin 1)} + (h : S.IsSolution θ) (hv : ∂ₜ θ 0 = 0) (t : Time) : θ (-t) = θ t := by + apply congrFun (IsSolution.eq_of_initial (isSolution_comp_neg h) h _ _) t + · rw [neg_zero] + · rw [Time.deriv_comp_neg θ 0 (h.contDiff.differentiable (by simp) _), neg_zero, hv, neg_zero] + +/-! + +## E. Local existence + +The uniqueness of section C says that a solution with given initial angle and angular velocity is +unique if it exists. Existence comes from the Picard–Lindelöf theorem, in the form Mathlib states +it for a time-independent `C¹` vector field: the field admits an integral curve through any point, +defined on an open interval about the initial instant. Applied to the phase-space vector field of +the pendulum, which is smooth, this gives a curve `(θ, θ̇)` in the phase space through the initial +data, and its first component is the required angle. Mathlib's curve is parametrised by `ℝ`, so it +is pulled back to `Time` through `Time.toRealCLE`; its derivative is read off through +`Time.deriv_comp_toRealCLE_of_hasDerivAt`, the converse of the bridge lemma +`Time.hasDerivAt_comp_toRealCLE_symm`. + +The statement is local: at the times within `ε` of the initial instant, for some `ε > 0`, the +angle and its velocity are differentiable and the equation of motion holds, and nothing is claimed +about the curve outside that interval. The differentiability is part of the conclusion so that +the equation of motion there is a statement about genuine derivatives, and not about the value +`0` that `∂ₜ` assigns to a curve where it is not differentiable. Global existence, which the +global Lipschitz bound of section A makes true, is not proved here. + +-/ + +/-! + +### E.1. Smoothness of the phase-space vector field + +-/ + +/-- The phase-space vector field of the simple pendulum is smooth: its components are the + projection onto the angular velocity and `sin` of the angle. -/ +@[fun_prop] +lemma phaseVectorField_contDiff (n : WithTop ℕ∞) : ContDiff ℝ n S.phaseVectorField := by + unfold phaseVectorField + fun_prop + +/-! + +### E.2. Local existence of solutions + +-/ + +/-- **Local existence** of solutions of the simple pendulum: for any initial angle `x₀` and + angular velocity `v₀` there are `ε > 0` and a curve `θ` with `θ 0 = x₀` and `∂ₜ θ 0 = v₀` which, + at every time within `ε` of the initial instant, is differentiable together with its velocity + `∂ₜ θ` and satisfies the equation of motion. This is the Picard–Lindelöf theorem applied to the + phase-space vector field, the first component of the integral curve through `(x₀, v₀)` being + the angle. -/ +lemma exists_local_solution (x₀ v₀ : EuclideanSpace ℝ (Fin 1)) : + ∃ ε > (0 : ℝ), ∃ θ : Time → EuclideanSpace ℝ (Fin 1), θ 0 = x₀ ∧ ∂ₜ θ 0 = v₀ ∧ + ∀ t : Time, |t.val| ≤ ε → DifferentiableAt ℝ θ t ∧ DifferentiableAt ℝ (∂ₜ θ) t ∧ + S.inertia • ∂ₜ (∂ₜ θ) t = S.torque (θ t) := by + obtain ⟨α, hα0, ε, hε, hα⟩ := + ContDiffAt.exists_forall_mem_closedBall_exists_eq_forall_mem_Ioo_hasDerivAt₀ + ((S.phaseVectorField_contDiff 1).contDiffAt (x := (x₀, v₀))) 0 + have hmem : ∀ t : Time, |t.val| ≤ ε / 2 → Time.toRealCLE t ∈ Set.Ioo (0 - ε) (0 + ε) := by + intro t ht + have := abs_le.mp ht + change t.val ∈ Set.Ioo (0 - ε) (0 + ε) + constructor <;> linarith + have hd1 : ∀ t : Time, Time.toRealCLE t ∈ Set.Ioo (0 - ε) (0 + ε) → + ∂ₜ (fun s => (α (Time.toRealCLE s)).1) t = (α (Time.toRealCLE t)).2 := by + intro t ht + have hfst := (ContinuousLinearMap.fst ℝ (EuclideanSpace ℝ (Fin 1)) + (EuclideanSpace ℝ (Fin 1))).hasFDerivAt.comp_hasDerivAt (Time.toRealCLE t) (hα _ ht) + apply Time.deriv_comp_toRealCLE_of_hasDerivAt (fun τ => (α τ).1) t + simpa [Function.comp_def, phaseVectorField] using hfst + have hev : ∀ t : Time, Time.toRealCLE t ∈ Set.Ioo (0 - ε) (0 + ε) → + ∂ₜ (fun s => (α (Time.toRealCLE s)).1) =ᶠ[nhds t] fun s => (α (Time.toRealCLE s)).2 := by + intro t ht + have hU : IsOpen {s : Time | Time.toRealCLE s ∈ Set.Ioo (0 - ε) (0 + ε)} := + isOpen_Ioo.preimage Time.toRealCLE.continuous + exact Filter.eventuallyEq_of_mem (hU.mem_nhds ht) fun s hs => hd1 s hs + have hd2 : ∀ t : Time, Time.toRealCLE t ∈ Set.Ioo (0 - ε) (0 + ε) → + ∂ₜ (∂ₜ (fun s => (α (Time.toRealCLE s)).1)) t = + (S.phaseVectorField (α (Time.toRealCLE t))).2 := by + intro t ht + have hsnd := (ContinuousLinearMap.snd ℝ (EuclideanSpace ℝ (Fin 1)) + (EuclideanSpace ℝ (Fin 1))).hasFDerivAt.comp_hasDerivAt (Time.toRealCLE t) (hα _ ht) + have h2 : ∂ₜ (fun s => (α (Time.toRealCLE s)).2) t = + (S.phaseVectorField (α (Time.toRealCLE t))).2 := by + apply Time.deriv_comp_toRealCLE_of_hasDerivAt (fun τ => (α τ).2) t + simpa [Function.comp_def] using hsnd + rw [Time.deriv_eq, (hev t ht).fderiv_eq, ← Time.deriv_eq, h2] + have h0 : Time.toRealCLE (0 : Time) ∈ Set.Ioo (0 - ε) (0 + ε) := by + rw [map_zero] + constructor <;> linarith + refine ⟨ε / 2, half_pos hε, fun t => (α (Time.toRealCLE t)).1, ?_, ?_, fun t ht => ?_⟩ + · show (α (Time.toRealCLE 0)).1 = x₀ + rw [map_zero, hα0] + · rw [hd1 0 h0, map_zero, hα0] + · have hαt := (hα _ (hmem t ht)).differentiableAt + refine ⟨hαt.fst.comp t Time.toRealCLE.differentiableAt, ?_, ?_⟩ + · exact (hev t (hmem t ht)).differentiableAt_iff.mpr + (hαt.snd.comp t Time.toRealCLE.differentiableAt) + · rw [hd2 t (hmem t ht)] + exact S.inertia_smul_eq_torque _ + +end ClassicalMechanics.SimplePendulum diff --git a/Physlib/ClassicalMechanics/PointParticle/Basic.lean b/Physlib/ClassicalMechanics/PointParticle/Basic.lean new file mode 100644 index 0000000000..9c4feec6f5 --- /dev/null +++ b/Physlib/ClassicalMechanics/PointParticle/Basic.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Raunak Chhatwal. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Raunak Chhatwal +-/ +module + +public import Mathlib.Algebra.Order.Positive.Field +public import Physlib.SpaceAndTime.ReferenceFrame +public import Physlib.SpaceAndTime.Time.Derivatives +/-! +# Point particles + +This module defines point particles together with their motion relative to a +reference frame. A `Particle` has a constant positive mass and a position over +time. Velocity and acceleration are derived from that position rather than stored +as independent data. + +The trajectory is part of the particle's description, but need not be given by an +explicit solution formula. Particle values can be considered subject to conditions +on their positions and on the forces acting on them. A particular mechanical model +can therefore be specified by constraints on particles, with the existence of +particles satisfying those constraints established separately. + +A particle by itself carries no equation of motion or assumption about which +forces act on it. It is a constituent from which systems can be assembled, rather +than a specification of an isolated or unconstrained one-particle system. Newton's +laws are imposed when particles and forces are assembled in +`ClassicalMechanics.PointParticle.NewtonianSystem`. + +Position and its first time derivative are required to be differentiable when the +frame is inertial. This ensures that the velocity and acceleration used in +Newtonian systems are genuine derivatives. The trajectories in this definition +are defined for all `Time`. +-/ + +@[expose] public noncomputable section + +open scoped BigOperators Classical + +namespace ClassicalMechanics.ReferenceFrame + +variable {d : ℕ} {frame : ReferenceFrame d} + +/-- Positive real numbers. -/ +notation "ℝ+" => {x : ℝ // 0 < x} + +/-- A point particle in `frame`. -/ +structure Particle (frame : ReferenceFrame d) where + /-- The particle's mass. -/ + mass : ℝ+ + /-- The particle's position in frame coordinates. -/ + pos : Time → frame.Vector + pos_twice_differentiable : + frame.IsInertial → Differentiable ℝ pos ∧ Differentiable ℝ (Time.deriv pos) + +namespace Particle + +variable (particle : frame.Particle) + +/-- Position is differentiable in an inertial frame. -/ +instance [h : Fact frame.IsInertial] : Fact (Differentiable ℝ particle.pos) := + ⟨particle.pos_twice_differentiable h.out |>.left⟩ + +/-- The particle's velocity. -/ +def velocity [_h : Fact (Differentiable ℝ particle.pos)] : Time → frame.Vector := + Time.deriv particle.pos + +/-- Velocity is differentiable in an inertial frame. -/ +instance [h : Fact frame.IsInertial] : Fact (Differentiable ℝ particle.velocity) := + ⟨particle.pos_twice_differentiable h.out |>.right⟩ + +/-- The particle's acceleration. -/ +def acceleration [Fact (Differentiable ℝ particle.pos)] + [_h : Fact (Differentiable ℝ particle.velocity)] : Time → frame.Vector := + Time.deriv particle.velocity + +/-- The particle's position in affine space. -/ +def pointInSpace (t : Time) : Space d := + Vector.dispEquiv t (particle.pos t) +ᵥ frame.origin t + +end ClassicalMechanics.ReferenceFrame.Particle diff --git a/Physlib/ClassicalMechanics/PointParticle/NewtonianSystem/Basic.lean b/Physlib/ClassicalMechanics/PointParticle/NewtonianSystem/Basic.lean new file mode 100644 index 0000000000..150446d572 --- /dev/null +++ b/Physlib/ClassicalMechanics/PointParticle/NewtonianSystem/Basic.lean @@ -0,0 +1,205 @@ +/- +Copyright (c) 2026 Raunak Chhatwal. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Raunak Chhatwal +-/ +module + +public import Physlib.ClassicalMechanics.Force +public import Physlib.ClassicalMechanics.PointParticle.Basic +/-! +# Newtonian point-particle systems + +This module defines `NewtonianSystem`, consisting of an inertial reference frame, a finite +collection of point particles, and the internal and external forces acting on +them. Particles carry masses and positions over time; forces carry vector values +over time and identify the particles they act on. + +Newton's second law requires the net force on each particle to equal its mass +times its acceleration. Newton's third law requires the multiset of internal +forces to be invariant under equal-and-opposite reversal. + +Particles and forces are stored in multisets. For example, if two identical springs +connect the same pair of particles, the net force on either particle must count +both spring forces, even though they are equal. + +Many classical systems are specified by constraints rather than explicit position +and force functions. Such models can be formalized as conditions on `NewtonianSystem` +values: which particles and forces are present, geometric constraints such as +fixed distances, and restrictions on the forces such as centrality. + +Results can be proved for arbitrary systems satisfying these conditions. An +existence proof establishes that a satisfying system exists for given parameters +and initial conditions; choice can then be used to select one. Explicit formulas +for the positions and forces are not required to state the conditions or to +reason about systems satisfying them. +-/ + +@[expose] public noncomputable section + +open scoped BigOperators Classical + +namespace ClassicalMechanics.PointParticle + +open ReferenceFrame + +variable {d : ℕ} + +/-! +## A. Systems +-/ + +/-- A finite system of point particles satisfying Newton's laws. -/ +structure NewtonianSystem (d : ℕ) where + /-- The system's reference frame. -/ + frame : ReferenceFrame d + [isInertial : Fact frame.IsInertial] + /-- The particles in the system. -/ + particles : Multiset frame.Particle + /-- Forces between particles in the system. -/ + internalForces : Multiset (frame.InternalForce particles) + /-- Forces on the system from external sources. -/ + externalForces : Multiset (frame.Force particles) + /-- Newton's second law: the net force on each particle equals its mass times its acceleration. -/ + newton_second_law : ∀ particle : particles, + netForce particle internalForces externalForces = particle.1.mass • particle.1.acceleration + /-- Newton's third law: internal forces and their reverses occur with equal multiplicities. -/ + newton_third_law : internalForces.map .reverse = internalForces + +namespace NewtonianSystem + +variable (system : NewtonianSystem d) + +instance : Fact system.frame.IsInertial := + system.isInertial + +/-! +## B. System particles +-/ + +/-- Vectors in the system's frame. -/ +abbrev Vector := system.frame.Vector + +/-- A particle in `system`. -/ +abbrev Particle : Type := system.particles + +namespace Particle + +variable {system : NewtonianSystem d} (particle : system.Particle) (t : Time) + +/-- The particle's mass. -/ +def mass : ℝ+ := particle.1.mass + +/-- The particle's position at `t`. -/ +def pos : system.Vector := particle.1.pos t + +/-- The particle's velocity at `t`. -/ +def velocity : system.Vector := particle.1.velocity t + +/-- The particle's acceleration at `t`. -/ +def acceleration : system.Vector := particle.1.acceleration t + +/-- The particle's momentum at `t`. -/ +def momentum : system.Vector := particle.mass • particle.velocity t + +/-- The particle's kinetic energy at `t`. -/ +def kineticEnergy : ℝ := particle.mass * ‖particle.velocity t‖ ^ 2 / 2 + +end Particle + +/-! +## C. System forces +-/ + +/-- A force in `system`. -/ +abbrev Force : Type := + system.internalForces ⊕ system.externalForces + +namespace Force + +variable {system : NewtonianSystem d} (force : system.Force) + +/-- The underlying force. -/ +@[coe] def inner : system.frame.Force system.Particle := + match force with | .inl force => force | .inr force => force + +instance : Coe system.Force (system.frame.Force system.Particle) := Coe.mk inner + +/-- The force at `t`. -/ +def value (t : Time) : system.Vector := force.inner.value t + +instance : CoeFun system.Force (fun _ => Time → system.Vector) where + coe := value + +/-- The force's target. -/ +def target : system.Particle := force.inner.target + +/-- Whether `force` is internal. -/ +def Internal : Prop := force.isLeft + +/-- Whether `force` is external. -/ +def External : Prop := force.isRight + +end Force + +/-- An internal force in `system`. -/ +abbrev InternalForce : Type := system.internalForces + +namespace InternalForce + +variable {system : NewtonianSystem d} (force : system.InternalForce) + +/-- View an internal force as a system force. -/ +instance : Coe system.InternalForce system.Force := Coe.mk .inl + +/-- The force at `t`. -/ +def value (t : Time) : system.Vector := force.1.value t + +/-- The force's target. -/ +def target : system.Particle := force.1.target + +/-- The force's source. -/ +def source : system.Particle := force.1.source + +/-- A force and its reverse have the same multiplicity. -/ +lemma reverse_count_eq : + system.internalForces.count force.1.reverse = system.internalForces.count force.1 := by + rw [← congrArg (Multiset.count force.1.reverse) system.newton_third_law] + refine Multiset.count_map_eq_count' _ _ (Function.Involutive.injective ?_) _ + intro internalForce + rcases internalForce with ⟨⟨value, target⟩, source, source_ne_target⟩ + simp [ReferenceFrame.InternalForce.reverse] + +/-- The reverse force. -/ +def reverse : system.InternalForce := + ⟨force.1.reverse, (finCongr force.reverse_count_eq).symm force.2⟩ + +/-- Whether the force lies along the line joining its source and target. -/ +def Central : Prop := + ∀ t, ∃ c : ℝ, force.value t = c • (force.target.pos t - force.source.pos t) + +end InternalForce + +/-! +## D. Aggregate quantities +-/ + +variable (t : Time) + +/-- Total mass. -/ +def mass : ℝ := + ∑ particle : system.Particle, particle.mass + +/-- Total momentum at `t`. -/ +def momentum : system.Vector := + ∑ particle : system.Particle, particle.momentum t + +/-- Net external force at `t`. -/ +def netExternalForce : system.Vector := + ∑ force : system.Force with force.External, force t + +/-- Total kinetic energy at `t`. -/ +def kineticEnergy : ℝ := + ∑ particle : system.Particle, particle.kineticEnergy t + +end ClassicalMechanics.PointParticle.NewtonianSystem diff --git a/Physlib/ClassicalMechanics/RigidBody/AngularMomentum.lean b/Physlib/ClassicalMechanics/RigidBody/AngularMomentum.lean index 7a06174072..063a3b0380 100644 --- a/Physlib/ClassicalMechanics/RigidBody/AngularMomentum.lean +++ b/Physlib/ClassicalMechanics/RigidBody/AngularMomentum.lean @@ -18,7 +18,8 @@ position `r` moves with velocity `ω × r`, so the body's angular momentum about `L = I ω`. ## References -- Landau and Lifshitz, Mechanics, Section 32. + +* Landau and Lifshitz, Mechanics, Section 32. [ref: landau_mechanics] -/ @[expose] public section @@ -37,6 +38,7 @@ noncomputable def angularMomentum (R : RigidBody 3) (ω : Fin 3 → ℝ) : Fin 3 funext fun x => cross_cross_self_apply (x : Fin 3 → ℝ) ω i rw [h]; fun_prop⟩ +set_option backward.isDefEq.respectTransparency false in /-- The angular momentum of a rigid body equals its inertia tensor applied to the angular velocity: `L = I ω`. -/ theorem angularMomentum_eq_inertiaTensor_mulVec (R : RigidBody 3) (ω : Fin 3 → ℝ) : diff --git a/Physlib/ClassicalMechanics/RigidBody/AngularVelocity.lean b/Physlib/ClassicalMechanics/RigidBody/AngularVelocity.lean index c3c91dec36..0b3b853996 100644 --- a/Physlib/ClassicalMechanics/RigidBody/AngularVelocity.lean +++ b/Physlib/ClassicalMechanics/RigidBody/AngularVelocity.lean @@ -45,7 +45,8 @@ dimensions its dual is the *body-frame angular velocity vector* `ω_body = Ω_bo velocity `ω` resolved along the body-fixed axes, `ω_body = Rᵀ ω`. ## References -- Landau and Lifshitz, Mechanics, Sections 31 and 32. + +* Landau and Lifshitz, Mechanics, Sections 31 and 32. [ref: landau_mechanics] -/ @[expose] public section diff --git a/Physlib/ClassicalMechanics/RigidBody/Basic.lean b/Physlib/ClassicalMechanics/RigidBody/Basic.lean index e3e0c31281..80a5b5539f 100644 --- a/Physlib/ClassicalMechanics/RigidBody/Basic.lean +++ b/Physlib/ClassicalMechanics/RigidBody/Basic.lean @@ -5,7 +5,7 @@ Authors: Joseph Tooby-Smith -/ module -public import Physlib.SpaceAndTime.Space.Module +public import Physlib.SpaceAndTime.Space.SmoothFunctions public import Physlib.Meta.Informal.Basic public import Mathlib.Geometry.Manifold.Algebra.SmoothFunctions /-! @@ -26,12 +26,14 @@ reference frame. The parallel-axis theorem expresses it in terms of the inertia centre of mass. ## References -- Landau and Lifshitz, Mechanics, page 100, Section 32 + +* Landau and Lifshitz, Mechanics, page 100, Section 32. [ref: landau_mechanics] -/ @[expose] public section open Manifold InnerProductSpace +open Space (cmap cmap_apply) TODO "The definition of a rigid body is currently defined via linear maps from the space of smooth functions to ℝ. When possible, it should be change @@ -66,20 +68,6 @@ lemma inertiaTensor_symmetric {d : ℕ} (R : RigidBody d) (i j : Fin d) : R.inertiaTensor i j = R.inertiaTensor j i := by simp only [inertiaTensor, eq_comm, mul_comm] -TODO "Move `cmap` and `cmap_apply` to a more general location, such as a file in - `SpaceAndTime/Space/` or `Mathematics/`. Alternatively, define a version of `ρ` taking an - unbundled `(f : Space d → ℝ) (hf : ContDiff ℝ ⊤ f)` in place of a `ContMDiffMap`." - -/-- Bundle a smooth real-valued function on `Space d` as an element of the space of test -functions. Keeping this as a named constructor ensures the resulting type head stays -`ContMDiffMap`, so the module/ring operations and `comp` resolve correctly. -/ -def cmap {d : ℕ} (f : Space d → ℝ) (hf : ContDiff ℝ ⊤ f) : - C^⊤⟮𝓘(ℝ, Space d), Space d; 𝓘(ℝ, ℝ), ℝ⟯ := ⟨f, hf.contMDiff⟩ - -@[simp] -lemma cmap_apply {d : ℕ} (f : Space d → ℝ) (hf : ContDiff ℝ ⊤ f) (y : Space d) : - cmap f hf y = f y := rfl - /-- The first moment of the mass distribution about its own centre of mass vanishes: for nonzero mass, `ρ` of the centred `j`-th coordinate function is zero. -/ lemma rho_coord_sub_centerOfMass {d : ℕ} (R : RigidBody d) (h : R.mass ≠ 0) (j : Fin d) : diff --git a/Physlib/ClassicalMechanics/RigidBody/KineticEnergy.lean b/Physlib/ClassicalMechanics/RigidBody/KineticEnergy.lean index 03d4c3d77b..f7731c7bb2 100644 --- a/Physlib/ClassicalMechanics/RigidBody/KineticEnergy.lean +++ b/Physlib/ClassicalMechanics/RigidBody/KineticEnergy.lean @@ -31,12 +31,14 @@ smooth for any motion; for differentiable motions it agrees with the honest poin `∂ₜ (displacement · y)`, recovering `T = ½ ∫ ⟪v, v⟫ dm` (`kineticEnergy_eq_integral_velocity`). ## References -- Landau and Lifshitz, Mechanics, Section 32. + +* Landau and Lifshitz, Mechanics, Section 32. [ref: landau_mechanics] -/ @[expose] public section open Time Manifold Matrix RigidBody InnerProductSpace +open Space (cmap cmap_apply) attribute [local instance] Matrix.linftyOpNormedAddCommGroup Matrix.linftyOpNormedSpace Matrix.linftyOpNormedRing Matrix.linftyOpNormedAlgebra @@ -54,6 +56,7 @@ lemma rotationalKineticEnergy_eq_angularMomentum (R : RigidBody 3) (ω : Fin 3 R.rotationalKineticEnergy ω = (1 / (2 : ℝ)) * (ω ⬝ᵥ R.angularMomentum ω) := by rw [rotationalKineticEnergy, angularMomentum_eq_inertiaTensor_mulVec] +set_option backward.isDefEq.respectTransparency false in /-- The rotational kinetic energy equals the mass integral of the local rotational speed squared: `T = ½ ∫ |ω × r|² dm`. -/ theorem rotationalKineticEnergy_eq_integral (R : RigidBody 3) (ω : Fin 3 → ℝ) : @@ -120,11 +123,11 @@ lemma kineticEnergy_integrand_split {d : ℕ} (M : RigidBodyMotion d) (t : Time) cmap_apply, smul_eq_mul] rw [show (⟪M.velocityClosedForm t y, M.velocityClosedForm t y⟫_ℝ) = (M.velocityClosedForm t y : Fin d → ℝ) ⬝ᵥ (M.velocityClosedForm t y : Fin d → ℝ) from - Space.inner_eq_sum _ _, + EuclideanSpace.inner_eq_star_dotProduct _ _, velocityClosedForm_val, show (⟪M.centerOfMassVelocity t, M.centerOfMassVelocity t⟫_ℝ) = (M.centerOfMassVelocity t : Fin d → ℝ) ⬝ᵥ (M.centerOfMassVelocity t : Fin d → ℝ) from - Space.inner_eq_sum _ _, + EuclideanSpace.inner_eq_star_dotProduct _ _, add_dotProduct, dotProduct_add, dotProduct_add, dotProduct_comm (∂ₜ (fun s => (M.orientation s).1) t *ᵥ fun j => y j - M.centerOfMass j) (M.centerOfMassVelocity t : Fin d → ℝ), diff --git a/Physlib/ClassicalMechanics/RigidBody/Motion.lean b/Physlib/ClassicalMechanics/RigidBody/Motion.lean index 5b5f623515..02daf1fe80 100644 --- a/Physlib/ClassicalMechanics/RigidBody/Motion.lean +++ b/Physlib/ClassicalMechanics/RigidBody/Motion.lean @@ -22,12 +22,14 @@ momentum. The reference point is taken to be the centre of mass, following the d a rigid motion into a translation of the centre of mass plus a rotation about it. ## References -- Landau and Lifshitz, Mechanics, Section 32. + +* Landau and Lifshitz, Mechanics, Section 32. [ref: landau_mechanics] -/ @[expose] public section open Time Manifold Matrix RigidBody InnerProductSpace +open Space (cmap cmap_apply) attribute [local instance] Matrix.linftyOpNormedAddCommGroup Matrix.linftyOpNormedSpace Matrix.linftyOpNormedRing Matrix.linftyOpNormedAlgebra @@ -52,22 +54,24 @@ lemma orientation_mul_transpose {d : ℕ} (M : RigidBodyMotion d) (t : Time) : /-- The velocity of the centre of mass of a rigid body in motion, defined as the time-derivative of its centre-of-mass trajectory. This is the velocity `V` in the Landau–Lifshitz decomposition `v = V + Ω × r` of the velocity of a point of the body. -/ -noncomputable def centerOfMassVelocity {d : ℕ} (M : RigidBodyMotion d) : Time → Space d := - ∂ₜ M.comTrajectory +noncomputable def centerOfMassVelocity {d : ℕ} (M : RigidBodyMotion d) : + Time → EuclideanSpace ℝ (Fin d) := + ∂ₜᵥ M.comTrajectory lemma centerOfMassVelocity_eq {d : ℕ} (M : RigidBodyMotion d) : - M.centerOfMassVelocity = ∂ₜ M.comTrajectory := rfl + M.centerOfMassVelocity = ∂ₜᵥ M.comTrajectory := rfl /-- A rigid body whose centre of mass is stationary has zero centre-of-mass velocity. -/ lemma centerOfMassVelocity_of_comTrajectory_const {d : ℕ} (M : RigidBodyMotion d) (c : Space d) (h : M.comTrajectory = fun _ => c) : M.centerOfMassVelocity = 0 := by rw [centerOfMassVelocity_eq, h] funext t - exact Time.deriv_const c + exact Time.derivVec_const c /-- The linear momentum of a rigid body in motion: the total mass times the velocity of the centre of mass. -/ -noncomputable def linearMomentum {d : ℕ} (M : RigidBodyMotion d) : Time → Space d := +noncomputable def linearMomentum {d : ℕ} (M : RigidBodyMotion d) : + Time → EuclideanSpace ℝ (Fin d) := fun t => M.mass • M.centerOfMassVelocity t lemma linearMomentum_eq {d : ℕ} (M : RigidBodyMotion d) : @@ -106,6 +110,7 @@ lemma orientation_mulVec_sub_centerOfMass {d : ℕ} (M : RigidBodyMotion d) (t : rw [eq_sub_iff_add_eq, displacement_apply] rfl +set_option backward.isDefEq.respectTransparency false in /-- The mass distribution of the rigid body in motion at time `t`: the pushforward of the body-fixed mass distribution along the rigid displacement, acting on a test function `f` by `f ↦ ρ (f ∘ displacement t)`. -/ @@ -133,6 +138,7 @@ private lemma contMDiffMap_sum_apply {d : ℕ} {ι : Type*} (s : Finset ι) | insert a s ha ih => simp only [Finset.sum_insert ha, ContMDiffMap.coe_add, Pi.add_apply, ih] +set_option backward.isDefEq.respectTransparency false in /-- The centre of mass of the moving mass distribution tracks the prescribed trajectory: for a body of nonzero mass, the centre of mass of `massDistribution M t` is exactly `comTrajectory t`. This is the decisive check that `comTrajectory` and `orientation` are wired correctly in @@ -164,11 +170,12 @@ lemma massDistribution_centerOfMass {d : ℕ} (M : RigidBodyMotion d) (t : Time) /-- The velocity of the material point `y` of a rigid body in motion: the inertial-frame time derivative of the trajectory `s ↦ displacement s y` of that point. -/ -noncomputable def velocity {d : ℕ} (M : RigidBodyMotion d) (y : Space d) : Time → Space d := - fun t => ∂ₜ (fun s => M.displacement s y) t +noncomputable def velocity {d : ℕ} (M : RigidBodyMotion d) (y : Space d) : + Time → EuclideanSpace ℝ (Fin d) := + fun t => ∂ₜᵥ (fun s => M.displacement s y) t lemma velocity_eq {d : ℕ} (M : RigidBodyMotion d) (y : Space d) (t : Time) : - M.velocity y t = ∂ₜ (fun s => M.displacement s y) t := rfl + M.velocity y t = ∂ₜᵥ (fun s => M.displacement s y) t := rfl /-- The `i`-th component of the velocity of a body point is the time derivative of the `i`-th coordinate of its inertial-frame trajectory. -/ @@ -176,7 +183,7 @@ lemma velocity_apply {d : ℕ} (M : RigidBodyMotion d) (y : Space d) (t : Time) (hd : Differentiable ℝ (fun s => M.displacement s y)) : M.velocity y t i = ∂ₜ (fun s => M.displacement s y i) t := by rw [velocity_eq] - exact (Time.deriv_space hd t i).symm + exact derivVec_space hd t i /-- The material point at the centre of mass moves with the centre-of-mass velocity, for any motion: `v(centreOfMass) = V`. This is the velocity counterpart of `massDistribution_centerOfMass`. @@ -199,15 +206,14 @@ lemma velocity_of_orientation_const {d : ℕ} (M : RigidBodyMotion d) (y : Space funext t rw [velocity_eq, centerOfMassVelocity_eq] have hdisp : (fun s => M.displacement s y) - = fun s => (⟨fun k => ∑ j, R.1 k j * (y j - M.centerOfMass j)⟩ : Space d) - + M.comTrajectory s := by + = fun s => (WithLp.toLp 2 fun k => ∑ j, R.1 k j * (y j - M.centerOfMass j)) + +ᵥ M.comTrajectory s := by funext s ext k rw [displacement_apply, h] simp rw [hdisp] - simp only [Time.deriv_eq] - rw [fderiv_const_add] + simp only [Time.derivVec_eq, vadd_vsub_vadd_cancel_left] /-- The velocity of a body point decomposes as `v = Ṙ (y − c) + V`: the rate of change of the orientation acting on the body-frame position, plus the centre-of-mass velocity. -/ @@ -243,7 +249,7 @@ lemma velocity_eq_deriv_orientation {d : ℕ} (M : RigidBodyMotion d) (y : Space Time.deriv_mul_const (fun s => (M.orientation s).1 i j) (y j - M.centerOfMass j) ((hentry i j) t))] simp only [Time.deriv_matrix_apply (fun s => (M.orientation s).1) t (hR t)] - rw [hmv, Time.deriv_space hX t i, ← centerOfMassVelocity_eq] + rw [hmv, ← Time.derivVec_space hX t i, ← centerOfMassVelocity_eq] /-- The closed form `Ṙ(t) (y − c) + V(t)` of the velocity of the body point `y` at time `t`. Unlike `velocity` — whose junk values on non-differentiable motions need not vary continuously @@ -251,8 +257,8 @@ with `y` — it is polynomial in `y` for any motion, so its squared speed can be smooth integrand of the total kinetic energy; for differentiable motions the two agree, see `velocityClosedForm_eq_velocity`. -/ noncomputable def velocityClosedForm {d : ℕ} (M : RigidBodyMotion d) (t : Time) (y : Space d) : - Space d := - ⟨∂ₜ (fun s => (M.orientation s).1) t *ᵥ fun j => y j - M.centerOfMass j⟩ + EuclideanSpace ℝ (Fin d) := + WithLp.toLp 2 (∂ₜ (fun s => (M.orientation s).1) t *ᵥ fun j => y j - M.centerOfMass j) + M.centerOfMassVelocity t /-- The `i`-th coordinate of the closed-form velocity. -/ @@ -261,7 +267,7 @@ lemma velocityClosedForm_apply {d : ℕ} (M : RigidBodyMotion d) (t : Time) (y : M.velocityClosedForm t y i = (∂ₜ (fun s => (M.orientation s).1) t *ᵥ fun j => y j - M.centerOfMass j) i + M.centerOfMassVelocity t i := by - simp only [velocityClosedForm, Space.add_apply] + simp only [velocityClosedForm, PiLp.add_apply] /-- The closed-form velocity as a plain vector-valued function of the coordinates of `y`. -/ lemma velocityClosedForm_val {d : ℕ} (M : RigidBodyMotion d) (t : Time) (y : Space d) : @@ -283,7 +289,8 @@ lemma velocityClosedForm_eq_velocity {d : ℕ} (M : RigidBodyMotion d) (t : Time /-- The squared speed of a body point, in closed form, is a smooth function of the point. -/ lemma contDiff_velocityClosedForm_inner {d : ℕ} (M : RigidBodyMotion d) (t : Time) : ContDiff ℝ ⊤ fun y : Space d => (⟪M.velocityClosedForm t y, M.velocityClosedForm t y⟫_ℝ) := by - simp only [Space.inner_eq_sum, velocityClosedForm_apply, Matrix.mulVec, dotProduct] + simp only [EuclideanSpace.inner_eq_star_dotProduct, star_trivial, + velocityClosedForm_apply, Matrix.mulVec, dotProduct] fun_prop end RigidBodyMotion diff --git a/Physlib/ClassicalMechanics/Scattering/RigidSphere.lean b/Physlib/ClassicalMechanics/Scattering/RigidSphere.lean index 4d1a8dc640..10113a2cad 100644 --- a/Physlib/ClassicalMechanics/Scattering/RigidSphere.lean +++ b/Physlib/ClassicalMechanics/Scattering/RigidSphere.lean @@ -12,7 +12,7 @@ public import Physlib.Meta.TODO.Basic ## References -- Landau and Lifshitz, Mechanics, page 50, Section 18, Problem 1 +* Landau and Lifshitz, Mechanics, page 50, Section 18, Problem 1. [ref: landau_mechanics] -/ @[expose] public section diff --git a/Physlib/ClassicalMechanics/Vibrations/LinearTriatomic.lean b/Physlib/ClassicalMechanics/Vibrations/LinearTriatomic.lean index 569358b8a6..b2f2eab68d 100644 --- a/Physlib/ClassicalMechanics/Vibrations/LinearTriatomic.lean +++ b/Physlib/ClassicalMechanics/Vibrations/LinearTriatomic.lean @@ -12,7 +12,7 @@ public import Physlib.Meta.TODO.Basic ## References -- Landau and Lifshitz, Mechanics, page 72, Section 24, Problem 1 +* Landau and Lifshitz, Mechanics, page 72, Section 24, Problem 1. [ref: landau_mechanics] -/ @[expose] public section diff --git a/Physlib/ClassicalMechanics/WaveEquation/Basic.lean b/Physlib/ClassicalMechanics/WaveEquation/Basic.lean index 898c9f580b..d5e840e2c0 100644 --- a/Physlib/ClassicalMechanics/WaveEquation/Basic.lean +++ b/Physlib/ClassicalMechanics/WaveEquation/Basic.lean @@ -39,6 +39,7 @@ By a plne wave we mean a function of the form `f(t, x) = f₀(⟪x, s⟫_ℝ - c ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/CondensedMatter/BandTheory/Basic.lean b/Physlib/CondensedMatter/BandTheory/Basic.lean new file mode 100644 index 0000000000..19bcd9c42e --- /dev/null +++ b/Physlib/CondensedMatter/BandTheory/Basic.lean @@ -0,0 +1,18 @@ +/- +Copyright (c) 2026 Wahaj Ayub. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wahaj Ayub +-/ +module + +/-! + +# A. Band theory + +This module provides a home for the theory of Bloch Hamiltonians and states, band projectors, +energy bands and gaps, and band geometry. Generic quantum-mechanical infrastructure should be +reused from Physlib rather than redefined here. + +-/ + +@[expose] public section diff --git a/Physlib/CondensedMatter/Basic.lean b/Physlib/CondensedMatter/Basic.lean index 837df4a87c..19957a492f 100644 --- a/Physlib/CondensedMatter/Basic.lean +++ b/Physlib/CondensedMatter/Basic.lean @@ -7,17 +7,25 @@ module /-! -# Condensed Matter +# A. Condensed matter -This directory is currently a place holder. -Please feel free to contribute! +Condensed matter physics studies the collective behavior of matter, from crystalline structure +and lattice models to interacting phases, topology, and material response. -Some directories which are NOT currently place holders are: -- Mathematics -- Meta -- Particles -- QFT -- Quantum Mechanics -- Relativity +## A.1. Scope --/@[expose] public section +- `Crystal` covers crystal structures, reciprocal-space descriptions, symmetries, and dynamics. +- `LatticeModels` covers Hamiltonian models whose degrees of freedom live on lattices. +- `BandTheory` covers Bloch descriptions, energy bands, gaps, and band geometry. +- `ManyBody` covers correlations, quasiparticles, Green functions, and interacting matter. +- `Topology` covers topological phases and invariants in condensed matter systems. +- `Response` covers transport and the linear, optical, and nonlinear response of materials. + +## A.2. Existing modules + +Existing condensed-matter modules currently include `TightBindingChain` and `Thermoelectric`. +They remain in their existing locations and have not been reorganized into the scopes above. + +-/ + +@[expose] public section diff --git a/Physlib/CondensedMatter/Crystal/Basic.lean b/Physlib/CondensedMatter/Crystal/Basic.lean new file mode 100644 index 0000000000..bce17b51db --- /dev/null +++ b/Physlib/CondensedMatter/Crystal/Basic.lean @@ -0,0 +1,17 @@ +/- +Copyright (c) 2026 Wahaj Ayub. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wahaj Ayub +-/ +module + +/-! + +# A. Crystals + +This module provides a home for Bravais and reciprocal lattices, unit cells, crystal momentum, +Brillouin zones, crystalline symmetries, and lattice dynamics. + +-/ + +@[expose] public section diff --git a/Physlib/CondensedMatter/LatticeModels/Basic.lean b/Physlib/CondensedMatter/LatticeModels/Basic.lean new file mode 100644 index 0000000000..4912efc244 --- /dev/null +++ b/Physlib/CondensedMatter/LatticeModels/Basic.lean @@ -0,0 +1,18 @@ +/- +Copyright (c) 2026 Wahaj Ayub. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wahaj Ayub +-/ +module + +/-! + +# A. Lattice models + +This module provides a home for hopping Hamiltonians, tight-binding and Hubbard-type models, +and spin lattice models. A future design issue is the relation between real-space lattice +Hamiltonians and momentum-space Bloch Hamiltonians. + +-/ + +@[expose] public section diff --git a/Physlib/CondensedMatter/ManyBody/Basic.lean b/Physlib/CondensedMatter/ManyBody/Basic.lean new file mode 100644 index 0000000000..3da1460ed8 --- /dev/null +++ b/Physlib/CondensedMatter/ManyBody/Basic.lean @@ -0,0 +1,17 @@ +/- +Copyright (c) 2026 Wahaj Ayub. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wahaj Ayub +-/ +module + +/-! + +# A. Many-body physics + +This module provides a home for correlation functions, quasiparticles, Green functions, +mean-field descriptions, and interacting quantum matter. + +-/ + +@[expose] public section diff --git a/Physlib/CondensedMatter/Response/Basic.lean b/Physlib/CondensedMatter/Response/Basic.lean new file mode 100644 index 0000000000..26f3e497e2 --- /dev/null +++ b/Physlib/CondensedMatter/Response/Basic.lean @@ -0,0 +1,17 @@ +/- +Copyright (c) 2026 Wahaj Ayub. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wahaj Ayub +-/ +module + +/-! + +# A. Response + +This module provides a home for electrical and thermal transport, linear and thermoelectric +response, optical response, and nonlinear response. + +-/ + +@[expose] public section diff --git a/Physlib/CondensedMatter/Thermoelectric/Basic.lean b/Physlib/CondensedMatter/Thermoelectric/Basic.lean index 8bbbcf8b6f..fff71ce126 100644 --- a/Physlib/CondensedMatter/Thermoelectric/Basic.lean +++ b/Physlib/CondensedMatter/Thermoelectric/Basic.lean @@ -68,11 +68,10 @@ units, following the convention of `Physlib.Thermodynamics.IdealGas.Basic`. ## iv. References -- Ioffe, A.F., *Semiconductor Thermoelements and Thermoelectric Cooling*, - Infosearch (1957). -- Snyder, G.J., Toberer, E.S., *Complex thermoelectric materials*, - Nature Materials 7, 105–114 (2008). - +* Ioffe, A.F., Semiconductor Thermoelements and Thermoelectric Cooling, Infosearch (1957). + [ref: ioffe_1957] +* Snyder, G.J., Toberer, E.S., Complex thermoelectric materials, Nature Materials 7, 105–114 + (2008). [ref: snyder_toberer_2008] -/ @[expose] public section diff --git a/Physlib/CondensedMatter/TightBindingChain/Basic.lean b/Physlib/CondensedMatter/TightBindingChain/Basic.lean index 9e7328a89b..4a51de07bf 100644 --- a/Physlib/CondensedMatter/TightBindingChain/Basic.lean +++ b/Physlib/CondensedMatter/TightBindingChain/Basic.lean @@ -63,8 +63,7 @@ with periodic boundary conditions. ## iv. References -- https://www.damtp.cam.ac.uk/user/tong/aqm/aqmtwo.pdf - +* https://www.damtp.cam.ac.uk/user/tong/aqm/aqmtwo.pdf. [ref: tong_statistical_physics] -/ @[expose] public section diff --git a/Physlib/CondensedMatter/Topology/Basic.lean b/Physlib/CondensedMatter/Topology/Basic.lean new file mode 100644 index 0000000000..05e2a0eefc --- /dev/null +++ b/Physlib/CondensedMatter/Topology/Basic.lean @@ -0,0 +1,19 @@ +/- +Copyright (c) 2026 Wahaj Ayub. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Wahaj Ayub +-/ +module + +/-! + +# A. Topological condensed matter + +This module provides a home for topological invariants of bands, Chern and topological +insulators, Weyl and nodal semimetals, topological superconductors, symmetry-protected phases, +and interacting topological phases. It distinguishes local band geometry from global +topological invariants. + +-/ + +@[expose] public section diff --git a/Physlib/Cosmology/FLRW/API-map.yaml b/Physlib/Cosmology/FLRW/API-map.yaml new file mode 100644 index 0000000000..324fd49aea --- /dev/null +++ b/Physlib/Cosmology/FLRW/API-map.yaml @@ -0,0 +1,98 @@ +version: v0.1 + +Title: FLRW cosmology + +Overview: | + A Friedmann-Lemaître-Robertson-Walker (FLRW) spacetime models a homogeneous + and isotropic universe. Its geometry is set by a scale factor a(t), a function + of cosmic time, together with the curvature of the spatial slices, which is + spherical, flat, or saddle. The expansion rate is the Hubble parameter + H = (∂ₜ a) / a, and the change of the expansion rate is measured by the + deceleration parameter q = -(∂ₜ ∂ₜ a) a / (∂ₜ a)^2. The dynamics is governed + by the Friedmann equations, which relate the scale factor to the energy + density and pressure of the cosmic fluid, the spatial curvature, and the + cosmological constant. + + The formal content lives in FLRW/Basic.lean: the spatial geometry with its + metric profile function S and the flat limits of the spherical and saddle + cases, the first- and second-order Friedmann equations as propositions on a + scale factor, the Hubble parameter, and the deceleration parameter with the + relation ∂ₜ H = -H^2 (1 + q). The FLRW type itself is a placeholder; the file + records a TODO to replace it with a structure bundling a positive scale + factor and a spatial geometry. Six further modules, ConformalTime.lean, + DensityParameters.lean, Distances.lean, Dynamics.lean, MatterContent.lean and + Solutions.lean, contain only TODO items: conformal time and the conformal + Hubble factor, the critical density and density parameters, cosmological + distances and redshift, energy conditions and the Big-Bang singularity, the + matter content with its continuity equation and scaling laws, and the exact + de Sitter, radiation-dominated, Einstein-de Sitter, Milne and Einstein static + solutions. The requirements below record the two most basic of those open + items. Cosmology/Basic.lean is a placeholder module doc with no declarations. + +ParentAPIs: + - Time (Physlib/SpaceAndTime/Time) + +References: + - "D. Baumann, Cosmology, Cambridge University Press (2022), Chapter 2 (FLRW geometry, Hubble parameter, Friedmann equations, matter content)" + - "S. Dodelson and F. Schmidt, Modern Cosmology, 2nd ed., Chapter 2 (the smooth, expanding universe)" + - "S. Weinberg, Cosmology, Oxford University Press (2008), Chapter 1 (the Robertson-Walker metric, the deceleration parameter, the Friedmann equations)" + +Requirements: + + - description: > + The spatial geometry of the constant-time slices is defined, as an inductive + type with spherical, flat and saddle constructors, together with the metric + profile function S giving the transverse radius k sin(r/k), r, or + k sinh(r/k) in the three cases. + done: true + location: "Physlib/Cosmology/FLRW/Basic.lean (SpatialGeometry, SpatialGeometry.S)" + + - description: > + The flat geometry is the large-radius limit of the curved ones: the profile + S of the spherical and of the saddle geometry tends to the flat profile as + the curvature radius tends to infinity. + done: true + location: "Physlib/Cosmology/FLRW/Basic.lean (limit_S_sphere, limit_S_saddle, tendsto_sin_rx_over_x, tendsto_sinh_rx_over_x, mul_sin_as_div, mul_sinh_as_div)" + + - description: > + The key data structure, an FLRW model given by a positive scale factor + a : Time → ℝ together with an element of SpatialGeometry, is defined. + (FLRW currently exists only as a placeholder type; a TODO in the file + records the intended concrete structure.) + done: false + location: "Physlib/Cosmology/FLRW/Basic.lean (FLRW)" + + - description: > + The first-order Friedmann equation + (∂ₜ a / a)^2 = (8πG/3) ρ - k c^2 / a^2 + Λ c^2 / 3 and the second-order + Friedmann equation ∂ₜ ∂ₜ a / a = -(4πG/3) (ρ + 3 p / c^2) + Λ c^2 / 3 are + defined as propositions, the first on a scale factor and an energy density + with the curvature parameter explicit, the second additionally on a + pressure and without a curvature term; the cosmological constant, Newton's + constant and the speed of light are explicit in both. + done: true + location: "Physlib/Cosmology/FLRW/Basic.lean (FirstOrderFriedmann, SecondOrderFriedmann)" + + - description: > + The Hubble parameter H = ∂ₜ a / a is defined as a function of the scale + factor and cosmic time, and is nonzero whenever a and ∂ₜ a are both nonzero + at the given time. + done: true + location: "Physlib/Cosmology/FLRW/Basic.lean (hubbleConstant, hubbleConstant_ne_zero)" + + - description: > + The deceleration parameter q = -(∂ₜ ∂ₜ a) a / (∂ₜ a)^2 is defined, and the + API contains the quotient-rule formula for ∂ₜ H, the identities + q = -(1 + (∂ₜ H) / H^2) and ∂ₜ H = -H^2 (1 + q), and the pointwise and + existential equivalences between ∂ₜ H < 0 and q > -1. + done: true + location: "Physlib/Cosmology/FLRW/Basic.lean (decelerationParameter, deriv_hubbleConstant, decelerationParameter_eq_one_plus_hubbleConstant, deriv_hubbleConstant_eq_neg_sq_mul, deriv_hubbleConstant_neg_iff, exists_deriv_hubbleConstant_neg_iff)" + + - description: > + The continuity equation ∂ₜ ρ + 3 H (ρ + P/c^2) = 0 of the cosmic fluid, the + barotropic equation of state P = w ρ c^2, and the density scaling law + ρ ∝ a^(-3(1+w)) with its dust, radiation and vacuum-energy special cases. + Recorded as TODO items in Physlib/Cosmology/FLRW/MatterContent.lean; no + declarations exist yet. + done: false + location: "N/A" diff --git a/Physlib/Electromagnetism/Charge/ChargeUnit.lean b/Physlib/Electromagnetism/Charge/ChargeUnit.lean index 8056771454..81ed3164f4 100644 --- a/Physlib/Electromagnetism/Charge/ChargeUnit.lean +++ b/Physlib/Electromagnetism/Charge/ChargeUnit.lean @@ -84,9 +84,13 @@ lemma div_self (x : ChargeUnit) : lemma div_symm (x y : ChargeUnit) : x / y = (y / x)⁻¹ := NNReal.eq <| by - rw [div_eq_val, inv_eq_one_div, div_eq_val] - simp only [one_div, NNReal.coe_inv] - rw [toReal, inv_div] + show x.val / y.val = (y.val / x.val)⁻¹ + rw [inv_div] + +/-- The unit-ratio cocycle at `ℝ≥0` (the un-coerced form of `div_mul_div_coe`). -/ +lemma div_mul_div (x y z : ChargeUnit) : (x / y) * (y / z) = x / z := NNReal.eq <| by + show x.val / y.val * (y.val / z.val) = x.val / z.val + rw [div_mul_div_comm, mul_comm x.val y.val, mul_div_mul_left _ _ y.val_ne_zero] @[simp] lemma div_mul_div_coe (x y z : ChargeUnit) : @@ -108,6 +112,7 @@ def scale (r : ℝ) (x : ChargeUnit) (hr : 0 < r := by norm_num) : ChargeUnit := lemma scale_div_self (x : ChargeUnit) (r : ℝ) (hr : 0 < r) : scale r x hr / x = (⟨r, le_of_lt hr⟩ : ℝ≥0) := by simp [scale, div_eq_val] + rfl @[simp] lemma self_div_scale (x : ChargeUnit) (r : ℝ) (hr : 0 < r) : @@ -123,9 +128,8 @@ lemma scale_one (x : ChargeUnit) : scale 1 x = x := by lemma scale_div_scale (x1 x2 : ChargeUnit) {r1 r2 : ℝ} (hr1 : 0 < r1) (hr2 : 0 < r2) : scale r1 x1 hr1 / scale r2 x2 hr2 = (⟨r1, le_of_lt hr1⟩ / ⟨r2, le_of_lt hr2⟩) * (x1 / x2) := by refine NNReal.eq ?_ - simp [scale, div_eq_val] - rw [toReal] - field_simp + show r1 * x1.val / (r2 * x2.val) = r1 / r2 * (x1.val / x2.val) + rw [div_mul_div_comm] @[simp] lemma scale_scale (x : ChargeUnit) (r1 r2 : ℝ) (hr1 : 0 < r1) (hr2 : 0 < r2) : diff --git a/Physlib/Electromagnetism/Current/CircularCoil.lean b/Physlib/Electromagnetism/Current/CircularCoil.lean index a1095e8eea..906928a7f5 100644 --- a/Physlib/Electromagnetism/Current/CircularCoil.lean +++ b/Physlib/Electromagnetism/Current/CircularCoil.lean @@ -23,14 +23,15 @@ electromagnetic potentials and fields around a circular coil. ## iv. References -- https://ntrs.nasa.gov/api/citations/20140002333/downloads/20140002333.pdf - +* https://ntrs.nasa.gov/api/citations/20140002333/downloads/20140002333.pdf. + [ref: nasa_ntrs_20140002333] -/ @[expose] public section TODO "Prove that the magnetic field around a circular current loop is as given - in the reference https://ntrs.nasa.gov/api/citations/20140002333/downloads/20140002333.pdf." + in the reference https://ntrs.nasa.gov/api/citations/20140002333/downloads/20140002333.pdf + [ref: nasa_ntrs_20140002333]." namespace Electromagnetism namespace DistElectromagneticPotential diff --git a/Physlib/Electromagnetism/Current/InfiniteWire.lean b/Physlib/Electromagnetism/Current/InfiniteWire.lean index 25367e8ba5..2ef021d562 100644 --- a/Physlib/Electromagnetism/Current/InfiniteWire.lean +++ b/Physlib/Electromagnetism/Current/InfiniteWire.lean @@ -37,6 +37,7 @@ carrying a steady current along the x-axis. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/Electromagnetism/Distributional/Basic.lean b/Physlib/Electromagnetism/Distributional/Basic.lean index 2c3004bf60..667a6cd857 100644 --- a/Physlib/Electromagnetism/Distributional/Basic.lean +++ b/Physlib/Electromagnetism/Distributional/Basic.lean @@ -36,9 +36,8 @@ spacetime to contravariant Lorentz vectors. ## iv. References -- https://quantummechanics.ucsd.edu/ph130a/130_notes/node452.html -- https://ph.qmul.ac.uk/sites/default/files/EMT10new.pdf - +* https://quantummechanics.ucsd.edu/ph130a/130_notes/node452.html. [ref: ucsd_ph130a_node452] +* https://ph.qmul.ac.uk/sites/default/files/EMT10new.pdf. [ref: qmul_emt10_notes] -/ @[expose] public section diff --git a/Physlib/Electromagnetism/Distributional/Dynamics/CurrentDensity.lean b/Physlib/Electromagnetism/Distributional/Dynamics/CurrentDensity.lean index 38e1ce7e7b..6f1181153e 100644 --- a/Physlib/Electromagnetism/Distributional/Dynamics/CurrentDensity.lean +++ b/Physlib/Electromagnetism/Distributional/Dynamics/CurrentDensity.lean @@ -32,6 +32,7 @@ The current density is given in terms of the charge density `ρ` and the current ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/Electromagnetism/Distributional/Dynamics/IsExtrema.lean b/Physlib/Electromagnetism/Distributional/Dynamics/IsExtrema.lean index 1bb99344fa..62cc64c472 100644 --- a/Physlib/Electromagnetism/Distributional/Dynamics/IsExtrema.lean +++ b/Physlib/Electromagnetism/Distributional/Dynamics/IsExtrema.lean @@ -32,6 +32,7 @@ Maxwell's equations with sources, i.e. Gauss's law and Ampère's law. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/Electromagnetism/Distributional/Dynamics/KineticTerm.lean b/Physlib/Electromagnetism/Distributional/Dynamics/KineticTerm.lean index e47af046fd..4ceb0f7476 100644 --- a/Physlib/Electromagnetism/Distributional/Dynamics/KineticTerm.lean +++ b/Physlib/Electromagnetism/Distributional/Dynamics/KineticTerm.lean @@ -35,8 +35,7 @@ In this implementation we have set `μ₀ = 1`. It is a TODO to introduce this c ## iv. References -- https://quantummechanics.ucsd.edu/ph130a/130_notes/node452.html - +* https://quantummechanics.ucsd.edu/ph130a/130_notes/node452.html. [ref: ucsd_ph130a_node452] -/ @[expose] public section @@ -174,7 +173,6 @@ lemma gradKineticTerm_sum_inr_eq {d} {𝓕 : FreeSpace} -/ -set_option backward.isDefEq.respectTransparency false in attribute [-simp] Nat.reduceAdd Nat.reduceSucc Fin.isValue in lemma gradKineticTerm_eq_distTensorDeriv {d} {𝓕 : FreeSpace} (A : DistElectromagneticPotential d) (ε : 𝓢(SpaceTime d, ℝ)) (ν : Fin 1 ⊕ Fin d) : diff --git a/Physlib/Electromagnetism/Distributional/Dynamics/Lagrangian.lean b/Physlib/Electromagnetism/Distributional/Dynamics/Lagrangian.lean index e77b0b0355..c837cf7601 100644 --- a/Physlib/Electromagnetism/Distributional/Dynamics/Lagrangian.lean +++ b/Physlib/Electromagnetism/Distributional/Dynamics/Lagrangian.lean @@ -38,9 +38,8 @@ In this implementation we set `μ₀ = 1`. It is a TODO to introduce this consta ## iv. References -- https://quantummechanics.ucsd.edu/ph130a/130_notes/node452.html -- https://ph.qmul.ac.uk/sites/default/files/EMT10new.pdf - +* https://quantummechanics.ucsd.edu/ph130a/130_notes/node452.html. [ref: ucsd_ph130a_node452] +* https://ph.qmul.ac.uk/sites/default/files/EMT10new.pdf. [ref: qmul_emt10_notes] -/ @[expose] public section diff --git a/Physlib/Electromagnetism/Distributional/ElectricField.lean b/Physlib/Electromagnetism/Distributional/ElectricField.lean index 54867b70df..e94c954447 100644 --- a/Physlib/Electromagnetism/Distributional/ElectricField.lean +++ b/Physlib/Electromagnetism/Distributional/ElectricField.lean @@ -31,6 +31,7 @@ In this module we define the electric field, and prove lemmas about it. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/Electromagnetism/Distributional/FieldStrength.lean b/Physlib/Electromagnetism/Distributional/FieldStrength.lean index 4ec6cdb0ae..32f170483e 100644 --- a/Physlib/Electromagnetism/Distributional/FieldStrength.lean +++ b/Physlib/Electromagnetism/Distributional/FieldStrength.lean @@ -31,6 +31,7 @@ In this module we define the field strength tensor in terms of the electromagnet ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/Electromagnetism/Distributional/MagneticField.lean b/Physlib/Electromagnetism/Distributional/MagneticField.lean index 90e973906e..20db7b4e05 100644 --- a/Physlib/Electromagnetism/Distributional/MagneticField.lean +++ b/Physlib/Electromagnetism/Distributional/MagneticField.lean @@ -30,6 +30,7 @@ in this module for distributions. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/Electromagnetism/Distributional/ScalarPotential.lean b/Physlib/Electromagnetism/Distributional/ScalarPotential.lean index 358e7401c4..513f67312a 100644 --- a/Physlib/Electromagnetism/Distributional/ScalarPotential.lean +++ b/Physlib/Electromagnetism/Distributional/ScalarPotential.lean @@ -33,6 +33,7 @@ the scalar potential is non-relativistic and is therefore a distribution of `Tim ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/Electromagnetism/Distributional/VectorPotential.lean b/Physlib/Electromagnetism/Distributional/VectorPotential.lean index 010d08a3bc..8745b411b7 100644 --- a/Physlib/Electromagnetism/Distributional/VectorPotential.lean +++ b/Physlib/Electromagnetism/Distributional/VectorPotential.lean @@ -33,6 +33,7 @@ the vector potential is non-relativistic and is therefore a distribution of `Tim ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/Electromagnetism/Dynamics/Basic.lean b/Physlib/Electromagnetism/Dynamics/Basic.lean index 513934f8df..6bed1f8916 100644 --- a/Physlib/Electromagnetism/Dynamics/Basic.lean +++ b/Physlib/Electromagnetism/Dynamics/Basic.lean @@ -34,6 +34,7 @@ in free space in terms of these constants. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/Electromagnetism/Dynamics/CurrentDensity.lean b/Physlib/Electromagnetism/Dynamics/CurrentDensity.lean index 3869cfc866..506109cff7 100644 --- a/Physlib/Electromagnetism/Dynamics/CurrentDensity.lean +++ b/Physlib/Electromagnetism/Dynamics/CurrentDensity.lean @@ -41,6 +41,7 @@ The current density is given in terms of the charge density `ρ` and the current ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/Electromagnetism/Dynamics/Hamiltonian.lean b/Physlib/Electromagnetism/Dynamics/Hamiltonian.lean index d05778a750..b26dacd602 100644 --- a/Physlib/Electromagnetism/Dynamics/Hamiltonian.lean +++ b/Physlib/Electromagnetism/Dynamics/Hamiltonian.lean @@ -38,8 +38,8 @@ in the case of three spatial dimensions. ## iv. References -- https://quantummechanics.ucsd.edu/ph130a/130_notes/node452.html -- https://ph.qmul.ac.uk/sites/default/files/EMT10new.pdf +* https://quantummechanics.ucsd.edu/ph130a/130_notes/node452.html. [ref: ucsd_ph130a_node452] +* https://ph.qmul.ac.uk/sites/default/files/EMT10new.pdf. [ref: qmul_emt10_notes] -/ @[expose] public section @@ -58,6 +58,8 @@ open TensorProduct open minkowskiMatrix open InnerProductSpace open Lorentz.Vector + +attribute [-simp] Fin.succAbove_zero attribute [-simp] Fintype.sum_sum_type attribute [-simp] Nat.succ_eq_add_one @@ -127,12 +129,14 @@ lemma canonicalMomentum_eq_gradient_kineticTerm {d} lemma canonicalMomentum_eq {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (hA : ContDiff ℝ 2 A) (J : LorentzCurrentDensity d) : A.canonicalMomentum 𝓕 J = fun x => fun μ => - (1/𝓕.μ₀) * η μ μ • A.fieldStrengthMatrix x (μ, Sum.inl 0) := by + (1/𝓕.μ₀) * η μ μ • toField {A.toFieldStrength x | [μ] [Sum.inl 0]}ᵀ := by rw [canonicalMomentum_eq_gradient_kineticTerm A hA J] funext x apply ext_inner_right (𝕜 := ℝ) intro v simp [gradient] + conv_rhs => rw [Lorentz.Vector.inner_eq_sum] + simp only [toFieldStrength_eval_apply_eq_single] conv_lhs => enter [1, 2, v] rw [kineticTerm_add_time_mul_const _ (hA.differentiable (by simp))] @@ -143,11 +147,8 @@ lemma canonicalMomentum_eq {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential rw [← Finset.sum_sub_distrib, Finset.mul_sum] congr ext μ - simp only [Fin.isValue, RCLike.inner_apply, conj_trivial, equivEuclid_apply] - rw [fieldStrengthMatrix, toFieldStrength_basis_repr_apply_eq_single] - simp only [Fin.isValue, inl_0_inl_0, one_mul] - ring_nf - simp + linear_combination (-(v μ * 𝓕.μ₀⁻¹ * ∂_ μ A x (Sum.inl 0))) * + minkowskiMatrix.η_apply_mul_η_apply_diag μ /-! @@ -164,14 +165,14 @@ lemma canonicalMomentum_eq_electricField {d} {𝓕 : FreeSpace} (A : Electromagn rw [canonicalMomentum_eq A hA J] funext x μ match μ with - | Sum.inl 0 => simp + | Sum.inl 0 => simp [toFieldStrength_eval_diag_eq_zero] | Sum.inr i => simp only [one_div, inr_i_inr_i, Fin.isValue, smul_eq_mul, neg_mul, one_mul, mul_neg, mul_inv_rev, neg_inj] - rw [electricField_eq_fieldStrengthMatrix (hA := hA.differentiable (by simp))] + rw [electricField_eq_toFieldStrength_eval (hA := hA.differentiable (by simp))] simp only [Fin.isValue, toTimeAndSpace_symm_apply_time_space, neg_mul, mul_neg] field_simp - exact fieldStrengthMatrix_antisymm A x (Sum.inr i) (Sum.inl 0) + exact toFieldStrength_eval_antisymm A x (Sum.inr i) (Sum.inl 0) /-! ## B. The Hamiltonian diff --git a/Physlib/Electromagnetism/Dynamics/IsExtrema.lean b/Physlib/Electromagnetism/Dynamics/IsExtrema.lean index 5c5cee8795..046a681fcd 100644 --- a/Physlib/Electromagnetism/Dynamics/IsExtrema.lean +++ b/Physlib/Electromagnetism/Dynamics/IsExtrema.lean @@ -43,6 +43,7 @@ Maxwell's equations with sources, i.e. Gauss's law and Ampère's law. ## iv. References +* None. -/ @[expose] public section @@ -81,16 +82,18 @@ lemma isExtrema_iff_gradLagrangian {𝓕 : FreeSpace} (A : ElectromagneticPotent /-! -### A.1. Extrema condition in terms of the field strength matrix +### A.1. Extrema condition in terms of the field strength tensor -/ -lemma isExtrema_iff_fieldStrengthMatrix {𝓕 : FreeSpace} +lemma isExtrema_iff_toFieldStrength_eval {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) (hJ : ContDiff ℝ ∞ J) : IsExtrema 𝓕 A J ↔ - ∀ x, ∀ ν, ∑ μ, ∂_ μ (A.fieldStrengthMatrix · (μ, ν)) x = 𝓕.μ₀ * J x ν := by - rw [isExtrema_iff_gradLagrangian, gradLagrangian_eq_sum_fieldStrengthMatrix A hA J hJ, funext_iff] + ∀ x, ∀ ν, ∑ μ, ∂_ μ (fun x => toField {A.toFieldStrength x | [μ] [ν]}ᵀ) x = + 𝓕.μ₀ * J x ν := by + rw [isExtrema_iff_gradLagrangian, gradLagrangian_eq_sum_toFieldStrength_eval A hA J hJ, + funext_iff] conv_lhs => enter [x, 1, 2, ν] rw [smul_smul] @@ -171,8 +174,6 @@ the speed with which an electromagnetic wave propagates is invariant under Loren -/ -set_option maxHeartbeats 600000 in -set_option backward.isDefEq.respectTransparency false in lemma isExtrema_lorentzGroup_apply_iff {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) (hJ : ContDiff ℝ ∞ J) diff --git a/Physlib/Electromagnetism/Dynamics/KineticTerm.lean b/Physlib/Electromagnetism/Dynamics/KineticTerm.lean index 0a4c339f07..5e4465c8e7 100644 --- a/Physlib/Electromagnetism/Dynamics/KineticTerm.lean +++ b/Physlib/Electromagnetism/Dynamics/KineticTerm.lean @@ -45,7 +45,7 @@ In this implementation we have set `μ₀ = 1`. It is a TODO to introduce this c - B. Variational gradient of the kinetic term - B.1. Variational gradient in terms of fderiv - B.2. Writing the variational gradient as a sums over double derivatives of the potential - - B.3. Variational gradient as a sums over fieldStrengthMatrix + - B.3. Variational gradient as sums over the components of the field strength tensor - B.4. Variational gradient in terms of the Gauss's and Ampère laws - B.5. Linearity properties of the variational gradient - B.6. HasVarGradientAt for the variational gradient @@ -53,8 +53,7 @@ In this implementation we have set `μ₀ = 1`. It is a TODO to introduce this c ## iv. References -- https://quantummechanics.ucsd.edu/ph130a/130_notes/node452.html - +* https://quantummechanics.ucsd.edu/ph130a/130_notes/node452.html. [ref: ucsd_ph130a_node452] -/ @[expose] public section @@ -73,6 +72,7 @@ open TensorProduct open minkowskiMatrix attribute [-simp] Fintype.sum_sum_type attribute [-simp] Nat.succ_eq_add_one +attribute [-simp] Fin.succAbove_zero /-! @@ -97,7 +97,6 @@ We show that the kinetic energy is Lorentz invariant. -/ -set_option backward.isDefEq.respectTransparency false in lemma kineticTerm_equivariant {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (Λ : LorentzGroup d) (hf : Differentiable ℝ A) (x : SpaceTime d) : @@ -117,9 +116,7 @@ lemma kineticTerm_equivariant {d} {𝓕 : FreeSpace} (A : ElectromagneticPotenti lemma kineticTerm_eq_sum {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (x : SpaceTime d) : A.kineticTerm 𝓕 x = - 1/(4 * 𝓕.μ₀) * ∑ μ, ∑ ν, ∑ μ', ∑ ν', η μ μ' * η ν ν' * - (Lorentz.CoVector.basis.tensorProduct Lorentz.Vector.basis).repr (A.toFieldStrength x) (μ, ν) - * (Lorentz.CoVector.basis.tensorProduct Lorentz.Vector.basis).repr - (A.toFieldStrength x) (μ', ν') := by + toField {A.toFieldStrength x | [μ] [ν]}ᵀ * toField {A.toFieldStrength x | [μ'] [ν']}ᵀ := by rw [kineticTerm] rw [toField_eq_repr] rw [contrT_basis_repr_apply_eq_fin] @@ -137,24 +134,18 @@ lemma kineticTerm_eq_sum {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) enter [1] rw [prodT_basis_repr_apply] enter [1] - simp only [Tensorial.self_toTensor_apply] rw [coMetric_repr_apply_eq_minkowskiMatrix] change η μ' μ conv_lhs => enter [2, 2, μ, 2, ν, 1, 2, μ', 2, ν', 1, 2] - simp only [Tensorial.self_toTensor_apply] rw [coMetric_repr_apply_eq_minkowskiMatrix] change η (ν') (ν) conv_lhs => enter [2, 2, μ, 2, ν, 1, 2, μ', 2, ν', 2] - rw [toFieldStrength_tensor_basis_eq_basis] - change ((Lorentz.Vector.basis.tensorProduct Lorentz.Vector.basis).repr (A.toFieldStrength x)) - (μ', ν') + rw [toFieldStrength_tensor_basis_repr_eq_eval] conv_lhs => enter [2, 2, μ, 2, ν, 2] - rw [toFieldStrength_tensor_basis_eq_basis] - change ((Lorentz.Vector.basis.tensorProduct Lorentz.Vector.basis).repr (A.toFieldStrength x)) - (μ, ν) + rw [toFieldStrength_tensor_basis_repr_eq_eval] conv_lhs => enter [2, 2, μ] enter [2, ν] @@ -162,23 +153,16 @@ lemma kineticTerm_eq_sum {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) enter [2, μ'] rw [Finset.sum_mul] enter [2, ν'] - simp conv_lhs => enter [2, 2, μ]; rw [Finset.sum_comm] conv_lhs => rw [Finset.sum_comm] conv_lhs => enter [2, 2, μ', 2, ν]; rw [Finset.sum_comm] conv_lhs => enter [2, 2, μ']; rw [Finset.sum_comm] rfl -lemma kineticTerm_eq_sum_fieldStrengthMatrix {d} {𝓕 : FreeSpace} +lemma kineticTerm_eq_sum_sq {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (x : SpaceTime d) : A.kineticTerm 𝓕 x = - - 1/(4 * 𝓕.μ₀) * ∑ μ, ∑ ν, ∑ μ', ∑ ν', η μ μ' * η ν ν' * - A.fieldStrengthMatrix x (μ, ν) * A.fieldStrengthMatrix x (μ', ν') := by + - 1/(4 * 𝓕.μ₀) * ∑ μ, ∑ ν, η μ μ * η ν ν * ‖toField {A.toFieldStrength x | [μ] [ν]}ᵀ‖ ^ 2 := by rw [kineticTerm_eq_sum] - -lemma kineticTerm_eq_sum_fieldStrengthMatrix_sq {d} {𝓕 : FreeSpace} - (A : ElectromagneticPotential d) (x : SpaceTime d) : A.kineticTerm 𝓕 x = - - 1/(4 * 𝓕.μ₀) * ∑ μ, ∑ ν, η μ μ * η ν ν * ‖A.fieldStrengthMatrix x (μ, ν)‖ ^ 2 := by - rw [kineticTerm_eq_sum_fieldStrengthMatrix] congr 1 refine Finset.sum_congr rfl fun μ _ => Finset.sum_congr rfl fun ν _ => ?_ rw [Finset.sum_eq_single μ (fun b _ hb => by simp [minkowskiMatrix.off_diag_zero hb.symm]) @@ -202,7 +186,7 @@ lemma kineticTerm_eq_sum_potential {d} {𝓕 : FreeSpace} (by simp), Finset.sum_eq_single ν (fun b _ hb => by simp [minkowskiMatrix.off_diag_zero hb.symm]) (by simp), - toFieldStrength_basis_repr_apply_eq_single] + toFieldStrength_eval_apply_eq_single] _ = - 1/(4 * 𝓕.μ₀) * ∑ μ, ∑ ν, ((η μ μ * η ν ν * (∂_ μ A x ν) ^ 2 - ∂_ μ A x ν * ∂_ ν A x μ) + (η ν ν * η μ μ * (∂_ ν A x μ) ^ 2 - ∂_ ν A x μ * ∂_ μ A x ν)) := by @@ -236,8 +220,8 @@ lemma kineticTerm_eq_electric_magnetic {𝓕 : FreeSpace} (A : ElectromagneticPo simp only [one_div] conv_lhs => enter [2, 2, μ, 2, ν, 2, μ', 2, ν'] - rw [fieldStrengthMatrix_eq_electric_magnetic A t x hA, - fieldStrengthMatrix_eq_electric_magnetic A t x hA] + rw [toFieldStrength_eval_eq_electric_magnetic A t x hA, + toFieldStrength_eval_eq_electric_magnetic A t x hA] simp [Fintype.sum_sum_type, Fin.sum_univ_three, EuclideanSpace.norm_sq_eq] field_simp rw [FreeSpace.c_sq] @@ -263,22 +247,22 @@ lemma kineticTerm_eq_electricMatrix_magneticFieldMatrix_time_space {𝓕 : FreeS A.kineticTerm 𝓕 ((toTimeAndSpace 𝓕.c).symm (t, x)) = 1/2 * (𝓕.ε₀ * ‖A.electricField 𝓕.c t x‖ ^ 2 - (1 / (2 * 𝓕.μ₀)) * ∑ i, ∑ j, ‖A.magneticFieldMatrix 𝓕.c t x (i, j)‖ ^ 2) := by - rw [kineticTerm_eq_sum_fieldStrengthMatrix_sq] + rw [kineticTerm_eq_sum_sq] simp [Fintype.sum_sum_type] rw [Finset.sum_add_distrib] simp only [Fin.isValue, Finset.sum_neg_distrib] have h1 : ∑ i, ∑ j, magneticFieldMatrix 𝓕.c A t x (i, j) ^ 2 - = ∑ i, ∑ j, (A.fieldStrengthMatrix ((toTimeAndSpace 𝓕.c).symm (t, x))) - (Sum.inr i, Sum.inr j) ^ 2 := by rfl + = ∑ i, ∑ j, toField {A.toFieldStrength ((toTimeAndSpace 𝓕.c).symm (t, x)) | + [Sum.inr i] [Sum.inr j]}ᵀ ^ 2 := by rfl rw [h1] ring_nf have h2 : ‖electricField 𝓕.c A t x‖ ^ 2 = 𝓕.c.val ^ 2 * - ∑ i, |(A.fieldStrengthMatrix ((toTimeAndSpace 𝓕.c).symm (t, x))) - (Sum.inl 0, Sum.inr i)| ^ 2 := by + ∑ i, |toField {A.toFieldStrength ((toTimeAndSpace 𝓕.c).symm (t, x)) | + [Sum.inl 0] [Sum.inr i]}ᵀ| ^ 2 := by rw [EuclideanSpace.norm_sq_eq] conv_lhs => enter [2, i] - rw [electricField_eq_fieldStrengthMatrix A t x i hA] + rw [electricField_eq_toFieldStrength_eval A t x i hA] simp only [Fin.isValue, neg_mul, norm_neg, norm_mul, Real.norm_eq_abs, FreeSpace.c_abs] rw [mul_pow] rw [← Finset.mul_sum] @@ -286,8 +270,8 @@ lemma kineticTerm_eq_electricMatrix_magneticFieldMatrix_time_space {𝓕 : FreeS simp only [Fin.isValue, one_div, sq_abs] conv_lhs => enter [1, 2, 1, 2, 2, i] - rw [fieldStrengthMatrix_antisymm] - simp [FreeSpace.c_sq] + rw [toFieldStrength_eval_antisymm] + simp [FreeSpace.c_sq, toFieldStrength_eval_diag_eq_zero] field_simp ring @@ -326,8 +310,9 @@ lemma kineticTerm_add_const {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential lemma kineticTerm_contDiff {d} {n : WithTop ℕ∞} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (hA : ContDiff ℝ (n + 1) A) : ContDiff ℝ n (A.kineticTerm 𝓕) := by - rw [funext fun x => kineticTerm_eq_sum_fieldStrengthMatrix (𝓕 := 𝓕) A x] - have h (μν) : ContDiff ℝ n (A.fieldStrengthMatrix · μν) := fieldStrengthMatrix_contDiff hA + rw [funext fun x => kineticTerm_eq_sum (𝓕 := 𝓕) A x] + have h (μ ν) : ContDiff ℝ n (fun x => toField {A.toFieldStrength x | [μ] [ν]}ᵀ) := + toFieldStrength_eval_contDiff hA fun_prop /-! @@ -507,17 +492,17 @@ lemma gradKineticTerm_eq_sum_sum {d} {𝓕 : FreeSpace} /-! -### B.3. Variational gradient as a sums over fieldStrengthMatrix +### B.3. Variational gradient as sums over the components of the field strength tensor We rewrite the variational gradient as a simple double sum over the -fieldStrengthMatrix. +components of the field strength tensor. -/ lemma gradKineticTerm_eq_fieldStrength {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (x : SpaceTime d) (ha : ContDiff ℝ ∞ A) : A.gradKineticTerm 𝓕 x = ∑ (ν : (Fin 1 ⊕ Fin d)), (1/𝓕.μ₀ * η ν ν) • - (∑ (μ : (Fin 1 ⊕ Fin d)), (∂_ μ (A.fieldStrengthMatrix · (μ, ν)) x)) + (∑ (μ : (Fin 1 ⊕ Fin d)), (∂_ μ (fun x => toField {A.toFieldStrength x | [μ] [ν]}ᵀ) x)) • Lorentz.Vector.basis ν := by calc _ _ = ∑ (ν : (Fin 1 ⊕ Fin d)), ∑ (μ : (Fin 1 ⊕ Fin d)), @@ -533,17 +518,17 @@ lemma gradKineticTerm_eq_fieldStrength {d} {𝓕 : FreeSpace} (A : Electromagnet ring_nf simp _ = ∑ (ν : (Fin 1 ⊕ Fin d)), ∑ (μ : (Fin 1 ⊕ Fin d)), - ((1/𝓕.μ₀ * η ν ν) * (∂_ μ (A.fieldStrengthMatrix · (μ, ν)) x)) • + ((1/𝓕.μ₀ * η ν ν) * (∂_ μ (fun x => toField {A.toFieldStrength x | [μ] [ν]}ᵀ) x)) • Lorentz.Vector.basis ν := by refine Finset.sum_congr rfl fun ν _ => Finset.sum_congr rfl fun μ _ => ?_ congr 2 conv_rhs => - simp only [toFieldStrength_basis_repr_apply_eq_single] + simp only [toFieldStrength_eval_apply_eq_single] rw [SpaceTime.deriv_eq, fderiv_fun_sub (by fun_prop) (by fun_prop), fderiv_const_mul (by fun_prop), fderiv_const_mul (by fun_prop)] simp [SpaceTime.deriv_eq] _ = ∑ (ν : (Fin 1 ⊕ Fin d)), (1/𝓕.μ₀ * η ν ν) • - (∑ (μ : (Fin 1 ⊕ Fin d)), (∂_ μ (A.fieldStrengthMatrix · (μ, ν)) x)) + (∑ (μ : (Fin 1 ⊕ Fin d)), (∂_ μ (fun x => toField {A.toFieldStrength x | [μ] [ν]}ᵀ) x)) • Lorentz.Vector.basis ν := by apply Finset.sum_congr rfl (fun ν _ => ?_) rw [← Finset.sum_smul, ← Finset.mul_sum, ← smul_smul] @@ -570,7 +555,7 @@ lemma gradKineticTerm_eq_electric_magnetic {𝓕 : FreeSpace} (A : Electromagnet congr 1 · rw [smul_smul] congr 1 - rw [div_electricField_eq_fieldStrengthMatrix] + rw [div_electricField_eq_toFieldStrength_eval] simp only [one_div, Fin.isValue, inl_0_inl_0, mul_one, mul_inv_rev, toTimeAndSpace_symm_apply_time_space] field_simp @@ -578,7 +563,7 @@ lemma gradKineticTerm_eq_electric_magnetic {𝓕 : FreeSpace} (A : Electromagnet · congr funext j simp only [one_div, inr_i_inr_i, mul_neg, mul_one, neg_smul] - rw [curl_magneticFieldMatrix_eq_electricField_fieldStrengthMatrix, smul_smul, ← neg_smul] + rw [curl_magneticFieldMatrix_eq_electricField_toFieldStrength_eval, smul_smul, ← neg_smul] congr simp only [one_div, toTimeAndSpace_symm_apply_time_space, sub_add_cancel_left, mul_neg] apply ha.of_le (ENat.LEInfty.out) @@ -614,12 +599,11 @@ lemma gradKineticTerm_add {d} {𝓕 : FreeSpace} (A1 A2 : ElectromagneticPotenti rw [SpaceTime.deriv_eq, SpaceTime.deriv_eq, SpaceTime.deriv_eq] conv_lhs => enter [1, 2, x] - rw [fieldStrengthMatrix_add _ _ _ (hA1.differentiable (by simp)) + rw [toFieldStrength_eval_add _ _ _ (hA1.differentiable (by simp)) (hA2.differentiable (by simp))] - simp [Finsupp.coe_add, Pi.add_apply] rw [fderiv_fun_add - (fieldStrengthMatrix_differentiable (hA1.of_le ENat.LEInfty.out)).differentiableAt - (fieldStrengthMatrix_differentiable (hA2.of_le ENat.LEInfty.out)).differentiableAt] + (toFieldStrength_eval_differentiable (hA1.of_le ENat.LEInfty.out)).differentiableAt + (toFieldStrength_eval_differentiable (hA2.of_le ENat.LEInfty.out)).differentiableAt] rfl lemma gradKineticTerm_smul {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) @@ -638,13 +622,14 @@ lemma gradKineticTerm_smul {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential apply Finset.sum_congr rfl (fun μ _ => ?_) conv_rhs => rw [SpaceTime.deriv_eq] - change (c • fderiv ℝ (fun x => (A.fieldStrengthMatrix x) (μ, ν)) x) (Lorentz.Vector.basis μ) + change (c • fderiv ℝ (fun x => toField {A.toFieldStrength x | [μ] [ν]}ᵀ) x) + (Lorentz.Vector.basis μ) rw [← fderiv_const_smul - (fieldStrengthMatrix_differentiable <| hA.of_le (ENat.LEInfty.out)).differentiableAt, + (toFieldStrength_eval_differentiable <| hA.of_le (ENat.LEInfty.out)).differentiableAt, ← SpaceTime.deriv_eq] congr funext x - rw [fieldStrengthMatrix_smul _ _ _ (hA.differentiable (by simp))] + rw [toFieldStrength_eval_smul _ _ _ (hA.differentiable (by simp))] rfl /-! @@ -708,8 +693,7 @@ lemma gradKineticTerm_eq_tensorDeriv {d} {𝓕 : FreeSpace} enter [2, 2, 2, μ] rw [tensorDeriv_toTensor_basis_repr (by fun_prop)] enter [2, x] - rw [toFieldStrength_tensor_basis_eq_basis] - change fieldStrengthMatrix A x _ + rw [toFieldStrength_tensor_basis_repr_eq_eval] conv_lhs => rw [gradKineticTerm_eq_fieldStrength A x hA] simp [Lorentz.Vector.apply_sum] diff --git a/Physlib/Electromagnetism/Dynamics/Lagrangian.lean b/Physlib/Electromagnetism/Dynamics/Lagrangian.lean index eefd5262db..20cdf844b9 100644 --- a/Physlib/Electromagnetism/Dynamics/Lagrangian.lean +++ b/Physlib/Electromagnetism/Dynamics/Lagrangian.lean @@ -55,9 +55,8 @@ In this implementation we set `μ₀ = 1`. It is a TODO to introduce this consta ## iv. References -- https://quantummechanics.ucsd.edu/ph130a/130_notes/node452.html -- https://ph.qmul.ac.uk/sites/default/files/EMT10new.pdf - +* https://quantummechanics.ucsd.edu/ph130a/130_notes/node452.html. [ref: ucsd_ph130a_node452] +* https://ph.qmul.ac.uk/sites/default/files/EMT10new.pdf. [ref: qmul_emt10_notes] -/ @[expose] public section @@ -306,11 +305,11 @@ lemma lagrangian_hasVarGradientAt_gradLagrangian {𝓕 : FreeSpace} -/ -lemma gradLagrangian_eq_sum_fieldStrengthMatrix {𝓕 : FreeSpace} (A : ElectromagneticPotential d) +lemma gradLagrangian_eq_sum_toFieldStrength_eval {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) (hJ : ContDiff ℝ ∞ J) : A.gradLagrangian 𝓕 J = fun x => ∑ ν, - (η ν ν • (1 / 𝓕.μ₀ * ∑ μ, ∂_ μ (fun x => (A.fieldStrengthMatrix x) (μ, ν)) x - J x ν) - • Lorentz.Vector.basis ν) := by + (η ν ν • (1 / 𝓕.μ₀ * ∑ μ, ∂_ μ (fun x => toField {A.toFieldStrength x | [μ] [ν]}ᵀ) x + - J x ν) • Lorentz.Vector.basis ν) := by rw [gradLagrangian_eq_kineticTerm_sub A hA J hJ] funext x simp only [Pi.sub_apply] diff --git a/Physlib/Electromagnetism/Kinematics/Boosts.lean b/Physlib/Electromagnetism/Kinematics/Boosts.lean index 829b52aabc..14f42e21aa 100644 --- a/Physlib/Electromagnetism/Kinematics/Boosts.lean +++ b/Physlib/Electromagnetism/Kinematics/Boosts.lean @@ -38,9 +38,8 @@ boosts in the 'x' direction. We do this in full-generality for `d+1` space dimen ## iv. References -See e.g. -- https://en.wikipedia.org/wiki/Classical_electromagnetism_and_special_relativity - +* https://en.wikipedia.org/wiki/Classical_electromagnetism_and_special_relativity. + [ref: wiki_classical_em_and_sr] -/ @[expose] public section @@ -49,6 +48,9 @@ namespace Electromagnetism namespace ElectromagneticPotential open LorentzGroup +open TensorSpecies Tensor + +attribute [-simp] Fin.succAbove_zero /-! @@ -71,17 +73,17 @@ lemma electricField_apply_x_boost_zero {d : ℕ} {c : SpeedOfLight} (β : ℝ) ( electricField c (Λ • A) t x 0 = A.electricField c t' x' 0 := by dsimp - rw [electricField_eq_fieldStrengthMatrix, fieldStrengthMatrix_equivariant _ _ hA] - simp [Fintype.sum_sum_type, Fin.sum_univ_succ] - rw [electricField_eq_fieldStrengthMatrix (hA := hA)] + rw [electricField_eq_toFieldStrength_eval, toFieldStrength_eval_equivariant _ _ hA] + simp [Fintype.sum_sum_type, Fin.sum_univ_succ, toFieldStrength_eval_diag_eq_zero] + rw [electricField_eq_toFieldStrength_eval (hA := hA)] simp only [Fin.isValue, neg_mul, neg_inj, mul_eq_mul_left_iff, SpeedOfLight.val_ne_zero, or_false] conv_lhs => enter [2] - rw [fieldStrengthMatrix_antisymm] + rw [toFieldStrength_eval_antisymm] trans γ β ^ 2 * (1 - β ^ 2) * - (A.fieldStrengthMatrix - ((boost (d := d.succ) 0 β hβ)⁻¹ • (SpaceTime.toTimeAndSpace c).symm (t, x))) - (Sum.inl 0, Sum.inr 0) + toField {A.toFieldStrength + ((boost (d := d.succ) 0 β hβ)⁻¹ • (SpaceTime.toTimeAndSpace c).symm (t, x)) | + [Sum.inl 0] [Sum.inr 0]}ᵀ · ring rw [γ_sq β hβ] field_simp @@ -107,11 +109,11 @@ lemma electricField_apply_x_boost_succ {d : ℕ} {c : SpeedOfLight} (β : ℝ) ( electricField c (Λ • A) t x i.succ = γ β * (A.electricField c t' x' i.succ + c * β * A.magneticFieldMatrix c t' x' (0, i.succ)) := by dsimp - rw [electricField_eq_fieldStrengthMatrix, - fieldStrengthMatrix_equivariant _ _ hA] + rw [electricField_eq_toFieldStrength_eval, + toFieldStrength_eval_equivariant _ _ hA] simp [Fintype.sum_sum_type, boost_zero_inr_succ_inr_succ, Fin.sum_univ_succ] - rw [fieldStrengthMatrix_inl_inr_eq_electricField (c := c) (hA := hA), - fieldStrengthMatrix_inr_inr_eq_magneticFieldMatrix (c := c), + rw [toFieldStrength_eval_inl_inr_eq_electricField (c := c) (hA := hA), + toFieldStrength_eval_inr_inr_eq_magneticFieldMatrix (c := c), SpaceTime.boost_zero_apply_time_space] simp only [one_div, Nat.succ_eq_add_one, SpaceTime.time_toTimeAndSpace_symm, SpaceTime.space_toTimeAndSpace_symm, neg_mul, mul_neg] @@ -143,10 +145,10 @@ lemma magneticFieldMatrix_apply_x_boost_zero_succ {d : ℕ} {c : SpeedOfLight} ( magneticFieldMatrix c (Λ • A) t x (0, i.succ) = γ β * (A.magneticFieldMatrix c t' x' (0, i.succ) + β / c * A.electricField c t' x' i.succ) := by dsimp [magneticFieldMatrix_eq] - rw [fieldStrengthMatrix_equivariant _ _ hA] + rw [toFieldStrength_eval_equivariant _ _ hA] simp [Fintype.sum_sum_type, boost_zero_inr_succ_inr_succ, Fin.sum_univ_succ] - rw [fieldStrengthMatrix_inl_inr_eq_electricField (c := c) (hA := hA), - fieldStrengthMatrix_inr_inr_eq_magneticFieldMatrix (c := c), + rw [toFieldStrength_eval_inl_inr_eq_electricField (c := c) (hA := hA), + toFieldStrength_eval_inr_inr_eq_magneticFieldMatrix (c := c), SpaceTime.boost_zero_apply_time_space] simp only [one_div, Nat.succ_eq_add_one, SpaceTime.time_toTimeAndSpace_symm, SpaceTime.space_toTimeAndSpace_symm, neg_mul, mul_neg, neg_neg] @@ -171,7 +173,7 @@ lemma magneticFieldMatrix_apply_x_boost_succ_succ {d : ℕ} {c : SpeedOfLight} ( magneticFieldMatrix c (Λ • A) t x (i.succ, j.succ) = A.magneticFieldMatrix c t' x' (i.succ, j.succ) := by dsimp [magneticFieldMatrix_eq] - rw [fieldStrengthMatrix_equivariant _ _ hA] + rw [toFieldStrength_eval_equivariant _ _ hA] simp [Fintype.sum_sum_type, boost_zero_inr_succ_inr_succ, Fin.sum_univ_succ] rw [SpaceTime.boost_zero_apply_time_space] rfl diff --git a/Physlib/Electromagnetism/Kinematics/EMPotential.lean b/Physlib/Electromagnetism/Kinematics/EMPotential.lean index 2e68703757..7310d262a8 100644 --- a/Physlib/Electromagnetism/Kinematics/EMPotential.lean +++ b/Physlib/Electromagnetism/Kinematics/EMPotential.lean @@ -25,6 +25,10 @@ spacetime to contravariant Lorentz vectors. - `ElectromagneticPotential` : is the type of electromagnetic potentials. - `ElectromagneticPotential.deriv` : the derivative tensor `∂_μ A^ν`. +- `ElectromagneticPotential.contDiff_deriv_deriv_component` : the second derivatives + `∂_μ ∂_ν A^ρ` are `C^n` if the potential is `C^{n+2}`. +- `ElectromagneticPotential.contDiff_deriv` : the derivative tensor is `C^n` if the potential + is `C^{n+1}`. ## iii. Table of contents @@ -33,18 +37,20 @@ spacetime to contravariant Lorentz vectors. - A.2. Basic constructors of the electromagnetic potential - A.3. The group action on the ElectromagneticPotential - A.4. Differentiability - - A.5. The action on the space-time derivatives - - A.6. Variational adjoint derivative of component - - A.7. Variational adjoint derivative of derivatives of the potential + - A.4.1. Differentiability of the derivative of the potential + - A.5. Differentiability in terms of constructors + - A.6. The action on the space-time derivatives + - A.7. Variational adjoint derivative of component + - A.8. Variational adjoint derivative of derivatives of the potential - B. The derivative tensor of the electromagnetic potential - B.1. Equivariance of the derivative tensor - B.2. The elements of the derivative tensor in terms of the basis + - B.3. Differentiability of the derivative tensor ## iv. References -- https://quantummechanics.ucsd.edu/ph130a/130_notes/node452.html -- https://ph.qmul.ac.uk/sites/default/files/EMT10new.pdf - +* https://quantummechanics.ucsd.edu/ph130a/130_notes/node452.html. [ref: ucsd_ph130a_node452] +* https://ph.qmul.ac.uk/sites/default/files/EMT10new.pdf. [ref: qmul_emt10_notes] -/ @[expose] public section @@ -279,17 +285,13 @@ noncomputable instance {d} : ### A.4. Differentiability -We show that the components of field strength tensor are differentiable if the potential is. +We show that the potential and its derivatives are differentiable (or smooth) if the potential +is, in the forms `fun_prop` cannot derive on its own. Differentiability of a component +`fun x => A x μ` of a differentiable potential is found by `fun_prop` directly. -/ open ContDiff -@[fun_prop] -lemma differentiable_component {d : ℕ} - (A : ElectromagneticPotential d) (hA : Differentiable ℝ A) (μ : Fin 1 ⊕ Fin d) : - Differentiable ℝ (fun x => A x μ) := by - exact (SpaceTime.differentiable_vector _).mpr hA μ - @[fun_prop] lemma differentiable_action {d} (Λ : LorentzGroup d) (A : ElectromagneticPotential d) (hA : Differentiable ℝ A) : Differentiable ℝ (fun x => Λ • A (Λ⁻¹ • x)) := by @@ -303,35 +305,67 @@ lemma contDiff_action {d} (Λ : LorentzGroup d) (A : ElectromagneticPotential d) (hA.comp (ContinuousLinearMap.contDiff (Lorentz.Vector.actionCLM Λ⁻¹))) @[fun_prop] -lemma differentiable_deriv {d} {A : ElectromagneticPotential d} - (hA : ContDiff ℝ 2 A) (μ ν : Fin 1 ⊕ Fin d) : +lemma differentiable_deriv_component_of_smooth {d} {A : ElectromagneticPotential d} + (hA : ContDiff ℝ ∞ A) (μ ν : Fin 1 ⊕ Fin d) : Differentiable ℝ (fun x => ∂_ μ A x ν) := by - have h : ∀ ν, Differentiable ℝ fun x => (fderiv ℝ A x) (Lorentz.Vector.basis μ) ν := by - rw [SpaceTime.differentiable_vector] - fun_prop - exact h ν + have h : ContDiff ℝ 2 A := hA.of_le ENat.LEInfty.out + fun_prop @[fun_prop] -lemma differentiable_deriv_of_smooth {d} {A : ElectromagneticPotential d} +lemma contDiff_deriv_component_of_smooth {n : ℕ} {d} {A : ElectromagneticPotential d} (hA : ContDiff ℝ ∞ A) (μ ν : Fin 1 ⊕ Fin d) : - Differentiable ℝ (fun x => ∂_ μ A x ν) := by - apply differentiable_deriv (hA.of_le (ENat.LEInfty.out)) μ ν + ContDiff ℝ n (fun x => ∂_ μ A x ν) := by + have h : ContDiff ℝ (n + 1) A := hA.of_le (mod_cast le_top) + fun_prop +/-! + +#### A.4.1. Differentiability of the derivative of the potential + +The derivatives `∂_ μ A x ν` of the potential are `C^n` if the potential is `C^{n+2}`. +This is what is needed to make sense of second derivatives of the potential, as appear for +example in Maxwell's equations. Differentiability for a `C^3` potential follows by `fun_prop` +from these lemmas and `SpaceTime.differentiable_deriv`, so is not stated separately. + +A second derivative of a component can be written in two ways: as `∂_ μ (fun x => ∂_ ν A x ρ) x`, +the derivative of the real-valued component `∂_ ν A x ρ` (the `_component` lemmas), or as +`∂_ μ (∂_ ν A) x ρ`, the component of the derivative of the vector-valued `∂_ ν A` +(the `_apply` lemmas). The two agree for a `C^2` potential by `SpaceTime.deriv_apply_eq`. + +The differentiability of the first-derivative components `∂_ μ A x ν` for a `C^2` (or +`C^{n+1}`) potential is found by `fun_prop` directly, so only the smooth variants are stated. + +-/ + +/-- The second derivatives `∂_ μ ∂_ ν A^ρ` of a `C^{n+2}` potential are `C^n`. -/ @[fun_prop] -lemma contDiff_deriv {n} {d} {A : ElectromagneticPotential d} - (hA : ContDiff ℝ (n + 1) A) (μ ν : Fin 1 ⊕ Fin d) : - ContDiff ℝ n (fun x => ∂_ μ A x ν) := by - have h : ∀ ν, ContDiff ℝ n fun x => (fderiv ℝ A x) (Lorentz.Vector.basis μ) ν := by - rw [SpaceTime.contDiff_vector] - fun_prop - exact h ν +lemma contDiff_deriv_deriv_component {n} {d} {A : ElectromagneticPotential d} + (hA : ContDiff ℝ (n + 2) A) (μ ν ρ : Fin 1 ⊕ Fin d) : + ContDiff ℝ n (fun x => ∂_ μ (fun x => ∂_ ν A x ρ) x) := by + have h : ContDiff ℝ (n + 1 + 1) A := by rw [add_assoc, one_add_one_eq_two]; exact hA + fun_prop -TODO "Add results related to the differentiability of the - derivative of the Electromagnetic potential." +/-- The `ρ` component of `∂_ μ (∂_ ν A)` is `C^n` for a `C^{n+2}` potential. -/ +@[fun_prop] +lemma contDiff_deriv_deriv_apply {n} {d} {A : ElectromagneticPotential d} + (hA : ContDiff ℝ (n + 2) A) (μ ν ρ : Fin 1 ⊕ Fin d) : + ContDiff ℝ n (fun x => ∂_ μ (∂_ ν A) x ρ) := by + have h : ContDiff ℝ (n + 1 + 1) A := by rw [add_assoc, one_add_one_eq_two]; exact hA + have hd : Differentiable ℝ (∂_ ν A) := + SpaceTime.differentiable_deriv ν A (hA.of_le le_add_self) + conv => enter [3, x]; rw [SpaceTime.deriv_apply_eq μ ρ _ hd, ← SpaceTime.deriv_eq] + fun_prop + +@[fun_prop] +lemma differentiable_deriv_deriv_apply_of_smooth {d} {A : ElectromagneticPotential d} + (hA : ContDiff ℝ ∞ A) (μ ν ρ : Fin 1 ⊕ Fin d) : + Differentiable ℝ (fun x => ∂_ μ (∂_ ν A) x ρ) := by + have h : ContDiff ℝ 3 A := hA.of_le ENat.LEInfty.out + fun_prop /-! -### A.5. Differentiablity in terms of constructors +### A.5. Differentiability in terms of constructors -/ @@ -427,7 +461,7 @@ lemma contDiff_ofElectromagneticField {n : ℕ} (c : SpeedOfLight) /-! -### A.5. The action on the space-time derivatives +### A.6. The action on the space-time derivatives Given a ElectromagneticPotential `A^μ`, we can consider its derivative `∂_μ A^ν`. Under a Lorentz transformation `Λ`, this transforms as @@ -448,7 +482,7 @@ lemma spaceTime_deriv_action_eq_sum {d} {μ ν : Fin 1 ⊕ Fin d} {x : SpaceTime /-! -### A.6. Variational adjoint derivative of component +### A.7. Variational adjoint derivative of component We find the variational adjoint derivative of the components of the potential. This will be used to find e.g. the variational derivative of the kinetic term, @@ -478,7 +512,7 @@ lemma hasVarAdjDerivAt_component {d : ℕ} (μ : Fin 1 ⊕ Fin d) (A : SpaceTime /-! -### A.7. Variational adjoint derivative of derivatives of the potential +### A.8. Variational adjoint derivative of derivatives of the potential We find the variational adjoint derivative of the derivatives of the components of the potential. This will again be used to find the variational derivative of the kinetic term, @@ -623,6 +657,34 @@ lemma toTensor_deriv_basis_repr_apply {d} (A : ElectromagneticPotential d) rw [hb, Module.Basis.repr_reindex_apply, deriv_basis_repr_apply] rfl +/-! + +### B.3. Differentiability of the derivative tensor + +We show that the derivative tensor `∂_μ A^ν`, as a function on spacetime, is differentiable +(or `C^n`) if the potential is `C^2` (or `C^{n+1}`). + +-/ + +/-- The derivative tensor of a `C^2` potential is differentiable. -/ +@[fun_prop] +lemma differentiable_deriv {d} {A : ElectromagneticPotential d} (hA : ContDiff ℝ 2 A) : + Differentiable ℝ A.deriv := by + unfold deriv + fun_prop + +@[fun_prop] +lemma differentiable_deriv_of_smooth {d} {A : ElectromagneticPotential d} + (hA : ContDiff ℝ ∞ A) : Differentiable ℝ A.deriv := + differentiable_deriv (hA.of_le ENat.LEInfty.out) + +/-- The derivative tensor of a `C^{n+1}` potential is `C^n`. -/ +@[fun_prop] +lemma contDiff_deriv {n} {d} {A : ElectromagneticPotential d} (hA : ContDiff ℝ (n + 1) A) : + ContDiff ℝ n A.deriv := by + unfold deriv + fun_prop + end ElectromagneticPotential end Electromagnetism diff --git a/Physlib/Electromagnetism/Kinematics/ElectricField.lean b/Physlib/Electromagnetism/Kinematics/ElectricField.lean index 8e4bcc04a0..3b039ba582 100644 --- a/Physlib/Electromagnetism/Kinematics/ElectricField.lean +++ b/Physlib/Electromagnetism/Kinematics/ElectricField.lean @@ -22,8 +22,8 @@ In this module we define the electric field, and prove lemmas about it. ## ii. Key results - `electricField` : The electric field from the electromagnetic potential. -- `electricField_eq_fieldStrengthMatrix` : The electric field expressed in terms of the - field strength tensor. +- `electricField_eq_toFieldStrength_eval` : The electric field expressed in terms of the + components of the field strength tensor. ## iii. Table of contents @@ -36,6 +36,7 @@ In this module we define the electric field, and prove lemmas about it. ## iv. References +* None. -/ @[expose] public section @@ -145,12 +146,12 @@ The electric field can be expressed in terms of the field strength tensor as `E_i = - c * F_0^i`. -/ -lemma electricField_eq_fieldStrengthMatrix {c : SpeedOfLight} +lemma electricField_eq_toFieldStrength_eval {c : SpeedOfLight} (A : ElectromagneticPotential d) (t : Time) (x : Space d) (i : Fin d) (hA : Differentiable ℝ A) : - A.electricField c t x i = - - c * A.fieldStrengthMatrix ((toTimeAndSpace c).symm (t, x)) (Sum.inl 0, Sum.inr i) := by - rw [toFieldStrength_basis_repr_apply_eq_single] + A.electricField c t x i = - c * + toField {A.toFieldStrength ((toTimeAndSpace c).symm (t, x)) | [Sum.inl 0] [Sum.inr i]}ᵀ := by + rw [toFieldStrength_eval_apply_eq_single] simp only [Fin.isValue, inl_0_inl_0, one_mul, inr_i_inr_i, neg_mul, sub_neg_eq_add] rw [electricField] simp only [PiLp.sub_apply, PiLp.neg_apply, Fin.isValue, mul_add, neg_add_rev] @@ -166,7 +167,7 @@ lemma electricField_eq_fieldStrengthMatrix {c : SpeedOfLight} rw [Space.deriv_eq_fderiv_basis, fderiv_const_mul] simp [← Space.deriv_eq_fderiv_basis] · fun_prop - · exact differentiable_component A hA _ + · fun_prop · exact 2 · rw [SpaceTime.deriv_sum_inl c] simp only [ContinuousLinearEquiv.apply_symm_apply] @@ -185,21 +186,21 @@ lemma electricField_eq_fieldStrengthMatrix {c : SpeedOfLight} · exact hA · exact 1 -lemma fieldStrengthMatrix_inl_inr_eq_electricField {c : SpeedOfLight} +lemma toFieldStrength_eval_inl_inr_eq_electricField {c : SpeedOfLight} (A : ElectromagneticPotential d) (x : SpaceTime d) (i : Fin d) (hA : Differentiable ℝ A) : - A.fieldStrengthMatrix x (Sum.inl 0, Sum.inr i) = + toField {A.toFieldStrength x | [Sum.inl 0] [Sum.inr i]}ᵀ = - (1 /c) * A.electricField c (x.time c) x.space i := by - rw [electricField_eq_fieldStrengthMatrix A (x.time c) x.space i hA] + rw [electricField_eq_toFieldStrength_eval A (x.time c) x.space i hA] simp -lemma fieldStrengthMatrix_inr_inl_eq_electricField {c : SpeedOfLight} +lemma toFieldStrength_eval_inr_inl_eq_electricField {c : SpeedOfLight} (A : ElectromagneticPotential d) (x : SpaceTime d) (i : Fin d) (hA : Differentiable ℝ A) : - A.fieldStrengthMatrix x (Sum.inr i, Sum.inl 0) = + toField {A.toFieldStrength x | [Sum.inr i] [Sum.inl 0]}ᵀ = (1 /c) * A.electricField c (x.time c) x.space i := by - rw [fieldStrengthMatrix_antisymm A x (Sum.inr i) (Sum.inl 0), - fieldStrengthMatrix_inl_inr_eq_electricField A x i hA] + rw [toFieldStrength_eval_antisymm A x (Sum.inr i) (Sum.inl 0), + toFieldStrength_eval_inl_inr_eq_electricField A x i hA] ring /-! @@ -214,11 +215,10 @@ lemma electricField_contDiff {n} {c : SpeedOfLight} {A : ElectromagneticPotentia conv => enter [3, x]; change A.electricField c x.1 x.2 i - rw [electricField_eq_fieldStrengthMatrix (A) x.1 x.2 i (hA.differentiable (by simp))] - change - c * A.fieldStrengthMatrix ((toTimeAndSpace c).symm (x.1, x.2)) (Sum.inl 0, Sum.inr i) + rw [electricField_eq_toFieldStrength_eval (A) x.1 x.2 i (hA.differentiable (by simp))] apply ContDiff.mul · fun_prop - exact (fieldStrengthMatrix_contDiff hA).comp + exact (toFieldStrength_eval_contDiff hA).comp (ContinuousLinearEquiv.contDiff (toTimeAndSpace c).symm) lemma electricField_apply_contDiff {n} {c : SpeedOfLight} {A : ElectromagneticPotential d} @@ -305,47 +305,47 @@ lemma time_deriv_comp_vectorPotential_eq_electricField {d} {A : ElectromagneticP open Space -lemma time_deriv_electricField_eq_fieldStrengthMatrix {d} {A : ElectromagneticPotential d} +lemma time_deriv_electricField_eq_toFieldStrength_eval {d} {A : ElectromagneticPotential d} {c : SpeedOfLight} (hA : ContDiff ℝ 2 A) (t : Time) (x : Space d) (i : Fin d) : ∂ₜ (fun t => A.electricField c t x) t i = - - c ^ 2 * ∂_ (Sum.inl 0) (fun x => (A.fieldStrengthMatrix x) (Sum.inl 0, Sum.inr i)) + - c ^ 2 * ∂_ (Sum.inl 0) (fun x => toField {A.toFieldStrength x | [Sum.inl 0] [Sum.inr i]}ᵀ) ((toTimeAndSpace c).symm (t, x)) := by rw [SpaceTime.deriv_sum_inl c] simp only [one_div, ContinuousLinearEquiv.apply_symm_apply, Fin.isValue, smul_eq_mul, neg_mul] rw [← Time.deriv_euclid] conv_lhs => enter [1, t] - rw [electricField_eq_fieldStrengthMatrix (c := c) A t x i (hA.differentiable (by simp))] + rw [electricField_eq_toFieldStrength_eval (c := c) A t x i (hA.differentiable (by simp))] rw [Time.deriv_eq, fderiv_const_mul] simp [← Time.deriv_eq] field_simp - · exact (fieldStrengthMatrix_differentiable_time hA x).differentiableAt + · exact (toFieldStrength_eval_differentiable_time hA x).differentiableAt · apply electricField_differentiable_time hA x - · apply fieldStrengthMatrix_differentiable hA + · apply toFieldStrength_eval_differentiable hA -lemma div_electricField_eq_fieldStrengthMatrix{d} {A : ElectromagneticPotential d} +lemma div_electricField_eq_toFieldStrength_eval {d} {A : ElectromagneticPotential d} {c : SpeedOfLight} (hA : ContDiff ℝ 2 A) (t : Time) (x : Space d) : (∇ ⬝ A.electricField c t) x = c * ∑ (μ : (Fin 1 ⊕ Fin d)), - (∂_ μ (A.fieldStrengthMatrix · (μ, Sum.inl 0)) ((toTimeAndSpace c).symm (t, x))) := by + (∂_ μ (fun x => toField {A.toFieldStrength x | [μ] [Sum.inl 0]}ᵀ) + ((toTimeAndSpace c).symm (t, x))) := by rw [Finset.mul_sum] simp only [Fin.isValue, Fintype.sum_sum_type, Finset.univ_unique, Fin.default_eq_zero, - Finset.sum_singleton, fieldStrengthMatrix_diag_eq_zero, SpaceTime.deriv_zero, Pi.ofNat_apply, + Finset.sum_singleton, toFieldStrength_eval_diag_eq_zero, SpaceTime.deriv_zero, Pi.ofNat_apply, mul_zero, zero_add] conv_rhs => enter [2, i] - rw [SpaceTime.deriv_sum_inr c _ (fieldStrengthMatrix_differentiable hA)] - simp only [Fin.isValue] + rw [SpaceTime.deriv_sum_inr c _ (toFieldStrength_eval_differentiable hA)] rw [Space.div] congr funext i simp only [ContinuousLinearEquiv.apply_symm_apply, Fin.isValue] conv_lhs => enter [2, y] - rw [electricField_eq_fieldStrengthMatrix (c := c) A t y i (hA.differentiable (by simp))] - rw [fieldStrengthMatrix_antisymm] + rw [electricField_eq_toFieldStrength_eval (c := c) A t y i (hA.differentiable (by simp))] + rw [toFieldStrength_eval_antisymm] rw [Space.deriv_eq_fderiv_basis, fderiv_const_mul] simp [← Space.deriv_eq_fderiv_basis] - exact (fieldStrengthMatrix_differentiable_space hA t).neg.differentiableAt + exact (toFieldStrength_eval_differentiable_space hA t).neg.differentiableAt end ElectromagneticPotential end Electromagnetism diff --git a/Physlib/Electromagnetism/Kinematics/FieldStrength.lean b/Physlib/Electromagnetism/Kinematics/FieldStrength.lean index 444207614c..5124eedcba 100644 --- a/Physlib/Electromagnetism/Kinematics/FieldStrength.lean +++ b/Physlib/Electromagnetism/Kinematics/FieldStrength.lean @@ -16,13 +16,14 @@ public import Mathlib.Algebra.Order.Archimedean.Real.Hom In this module we define the field strength tensor in terms of the electromagnetic potential. -We define a tensor version and a matrix version and prover various properties of these. +We define the tensor and prove various properties of it. Its components are accessed +through index evaluation, `toField {A.toFieldStrength x | [μ] [ν]}ᵀ`. ## ii. Key results - `toFieldStrength` : The field strength tensor from an electromagnetic potential. -- `fieldStrengthMatrix` : The field strength matrix from an electromagnetic potential - (matrix representation of the field strength tensor in the standard basis). +- `toFieldStrength_eval_apply_eq_single` : The components of the field strength tensor + in terms of derivatives of the potential, `F^{μν} = η^{μμ} ∂_μ A^ν - η^{νν} ∂_ν A^μ`. ## iii. Table of contents @@ -31,16 +32,16 @@ We define a tensor version and a matrix version and prover various properties of - A.2. Vector equalities - A.3. The group action acting on the field strength tensor - A.4. Differentiability and smoothness of the field strength tensor - - A.5. Elements of the field strength tensor in terms of basis + - A.5. Components of the field strength tensor - A.5.1. Index evaluation - - A.6. The field strength matrix - - A.6.1. Differentiability of the field strength matrix - - A.7. The antisymmetry of the field strength tensor - - A.8. Equivariance of the field strength matrix - - A.9. Linearity of the field strength tensor + - A.5.2. Differentiability of the components + - A.6. The antisymmetry of the field strength tensor + - A.7. Equivariance of the components of the field strength tensor + - A.8. Linearity of the field strength tensor ## iv. References +* None. -/ @[expose] public section @@ -61,13 +62,6 @@ open Lorentz attribute [-simp] Fintype.sum_sum_type attribute [-simp] Nat.succ_eq_add_one -TODO "Currently the API for the field strength tensor has the definition - of `fieldStrengthMatrix`. This is now unneeded, and should be replaced with - `toField {A.toFieldStrength x| [μ] [ν]}ᵀ` and suitble API around that. - To undertake this TODO, it is likely easier to start building the API - around `toField {A.toFieldStrength x| [μ] [ν]}ᵀ` and then remove `fieldStrengthMatrix` - once the API is in place." - /-! ## A. The field strength tensor @@ -199,7 +193,6 @@ as taking the field strength and then transforming the resulting tensor. -/ -set_option backward.isDefEq.respectTransparency false in lemma toFieldStrength_equivariant {d} (A : ElectromagneticPotential d) (Λ : LorentzGroup d) (hf : Differentiable ℝ A) (x : SpaceTime d) : (Λ • A).toFieldStrength x = Λ • A.toFieldStrength (Λ⁻¹ • x) := by @@ -207,31 +200,6 @@ lemma toFieldStrength_equivariant {d} (A : ElectromagneticPotential d) (Λ : Lor simp only [Tensorial.toTensor_smul, prodT_equivariant, contrT_equivariant, map_neg, permT_equivariant, map_add, ← Tensorial.smul_toTensor_symm, smul_add, smul_neg] -/-- This lemma expresses the component form of the transformed field strength -tensor: when a Lorentz transformation Λ acts on the potential A, the resulting field strength -tensor's components are given by the standard tensor transformation rule involving the Lorentz -matrix elements Λ^μ_κ and Λ^ν_ρ applied to the original field components. -/ -lemma toFieldStrength_action_eq_sum {d} (A : ElectromagneticPotential d) (Λ : LorentzGroup d) - (hf : Differentiable ℝ A) (x : SpaceTime d) : - (Λ • A).toFieldStrength x = ∑ μ, ∑ ν, - (∑ κ, ∑ ρ, Λ.1 μ κ * Λ.1 ν ρ * toField {A.toFieldStrength (Λ⁻¹ • x) | [κ] [ρ]}ᵀ) • - Vector.basis μ ⊗ₜ[ℝ] Vector.basis ν := by - conv_lhs => rw [toFieldStrength_equivariant A Λ hf x, toFieldStrength_eq_sum_basis_eval] - change Tensorial.smulLinearMap _ _ = _ - simp only [map_sum, map_smul] - simp [smulLinearMap, smul_prod, Vector.smul_basis, tmul_sum, sum_tmul, - Finset.smul_sum, tmul_smul, smul_tmul, smul_smul] - conv_lhs => enter [2, μ, 2, ν]; rw [Finset.sum_comm] - conv_lhs => enter [2, μ]; rw [Finset.sum_comm] - rw [Finset.sum_comm] - refine Finset.sum_congr rfl (fun ν _ => ?_) - conv_lhs => enter [2, μ]; rw [Finset.sum_comm] - rw [Finset.sum_comm] - refine Finset.sum_congr rfl (fun μ _ => ?_) - simp [← Finset.sum_smul] - congr 1 - exact Finset.sum_congr rfl (fun κ _ => Finset.sum_congr rfl (fun κ _ => by ring)) - /-! ## A.4. Differentiability and smoothness of the field strength tensor @@ -262,107 +230,35 @@ lemma contDiff_toFieldStrength {d} {n : WithTop ℕ∞} {A : ElectromagneticPote /-! -### A.5. Elements of the field strength tensor in terms of basis - --/ - -TODO "For the electromagnetic field strength, we have lots of lemmas related - to the components of the field strength tensor in terms of the basis. For example, - `toTensor_toFieldStrength_basis_repr`, these should be removed. They are used - downstream, so there use there should be refactored." - -lemma toTensor_toFieldStrength_basis_repr {d} (A : ElectromagneticPotential d) (x : SpaceTime d) - (b : ComponentIdx (S := realLorentzTensor d) (Fin.append ![Color.up] ![Color.up])) : - (Tensor.basis _).repr (Tensorial.toTensor (toFieldStrength A x)) b = - ∑ κ, (η (b 0) κ * ∂_ κ A x (b 1) - η (b 1) κ * ∂_ κ A x (b 0)) := by - rw [toTensor_toFieldStrength] - simp only [map_sub, Finsupp.coe_sub, Pi.sub_apply] - rw [Tensor.permT_basis_repr_symm_apply, contrT_basis_repr_apply_eq_fin] - conv_lhs => - enter [1, 2, n] - rw [Tensor.prodT_basis_repr_apply, contrMetric_repr_apply_eq_minkowskiMatrix] - enter [1] - change η (b 0) (n) - conv_lhs => - enter [1, 2, n, 2] - rw [toTensor_deriv_basis_repr_apply] - change ∂_ (n) A x (b 1) - rw [Tensor.permT_basis_repr_symm_apply, contrT_basis_repr_apply_eq_fin] - conv_lhs => - enter [2, 2, n] - rw [Tensor.prodT_basis_repr_apply, contrMetric_repr_apply_eq_minkowskiMatrix] - enter [1] - change η (b 1) (n) - conv_lhs => - enter [2, 2, n, 2] - rw [toTensor_deriv_basis_repr_apply] - change ∂_ (n) A x (b 0) - rw [← Finset.sum_sub_distrib] - -lemma toFieldStrength_tensor_basis_eq_basis {d} (A : ElectromagneticPotential d) (x : SpaceTime d) - (b : ComponentIdx (S := realLorentzTensor d) (Fin.append ![Color.up] ![Color.up])) : - (Tensor.basis _).repr (Tensorial.toTensor (toFieldStrength A x)) b = - (Lorentz.Vector.basis.tensorProduct Lorentz.Vector.basis).repr (toFieldStrength A x) - (b 0, b 1) := by - rw [Tensorial.basis_toTensor_apply, Tensorial.basis_map_prod] - simp only [Nat.reduceSucc, Nat.reduceAdd, Basis.repr_reindex, Finsupp.mapDomain_equiv_apply, - Equiv.symm_symm, Fin.isValue] - rw [Lorentz.Vector.tensor_basis_map_eq_basis_reindex] - have hb : (((Lorentz.Vector.basis (d := d)).reindex Lorentz.Vector.indexEquiv.symm).tensorProduct - (Lorentz.Vector.basis.reindex Lorentz.Vector.indexEquiv.symm)) = - ((Lorentz.Vector.basis (d := d)).tensorProduct (Lorentz.Vector.basis (d := d))).reindex - (Lorentz.Vector.indexEquiv.symm.prodCongr Lorentz.Vector.indexEquiv.symm) := by - ext b - match b with - | ⟨i, j⟩ => - simp - rw [hb, Module.Basis.repr_reindex_apply] - congr 1 - -lemma toFieldStrength_basis_repr_apply {d} {μν : (Fin 1 ⊕ Fin d) × (Fin 1 ⊕ Fin d)} - (A : ElectromagneticPotential d) (x : SpaceTime d) : - (Lorentz.CoVector.basis.tensorProduct Lorentz.Vector.basis).repr (A.toFieldStrength x) μν = - ∑ κ, ((η μν.1 κ * ∂_ κ A x μν.2) - η μν.2 κ * ∂_ κ A x μν.1) := by - match μν with - | (μ, ν) => - trans (Tensor.basis _).repr (Tensorial.toTensor (toFieldStrength A x)) - (fun | 0 => μ | 1 => ν); swap - · rw [toTensor_toFieldStrength_basis_repr] - rw [toFieldStrength_tensor_basis_eq_basis] - rfl - -lemma toFieldStrength_basis_repr_apply_eq_single {d} {μν : (Fin 1 ⊕ Fin d) × (Fin 1 ⊕ Fin d)} - (A : ElectromagneticPotential d) (x : SpaceTime d) : - (Lorentz.CoVector.basis.tensorProduct Lorentz.Vector.basis).repr (A.toFieldStrength x) μν = - ((η μν.1 μν.1 * ∂_ μν.1 A x μν.2) - η μν.2 μν.2 * ∂_ μν.2 A x μν.1) := by - rw [toFieldStrength_basis_repr_apply, Finset.sum_sub_distrib, - Finset.sum_eq_single μν.1 - (fun b _ hb => by simp [minkowskiMatrix.off_diag_zero hb.symm]) (by simp), - Finset.sum_eq_single μν.2 - (fun b _ hb => by simp [minkowskiMatrix.off_diag_zero hb.symm]) (by simp)] +### A.5. Components of the field strength tensor -/-! +The components `F^{μν}` of the field strength tensor are accessed through index evaluation, +`toField {A.toFieldStrength x | [μ] [ν]}ᵀ`. This is the canonical way to refer to the +components of the field strength tensor, and is what should be used downstream. #### A.5.1. Index evaluation -These lemmas express the components of the field strength tensor using index evaluation. - -/ /-- Evaluating both tensor indices of the field strength gives the coefficient in the -standard tensor-product basis. -/ -lemma toFieldStrength_eval_eq_basis_repr {d} (A : ElectromagneticPotential d) +tensor basis. -/ +lemma toFieldStrength_eval_eq_tensor_basis_repr {d} (A : ElectromagneticPotential d) (x : SpaceTime d) (μ ν : Fin 1 ⊕ Fin d) : toField {A.toFieldStrength x | [μ] [ν]}ᵀ = - (Lorentz.CoVector.basis.tensorProduct Lorentz.Vector.basis).repr - (A.toFieldStrength x) (μ, ν) := by - trans (Lorentz.Vector.basis.tensorProduct Lorentz.Vector.basis).repr - (A.toFieldStrength x) (μ, ν) - · conv_rhs => - rw [prod_eq_sum_eval Vector.basis_eq_map_tensor_basis - Vector.basis_eq_map_tensor_basis (A.toFieldStrength x)] - simp [Basis.tensorProduct_repr_tmul_apply, Finsupp.single_apply] - · rfl + (Tensor.basis _).repr (Tensorial.toTensor (toFieldStrength A x)) (fun | 0 => μ | 1 => ν) := by + rw [Vector.toField_eval_eval_eq_tensorProduct_repr, Vector.tensor_basis_repr_toTensor_prod_apply] + +/-- The coefficient of the field strength tensor in the tensor basis is given by +index evaluation. -/ +lemma toFieldStrength_tensor_basis_repr_eq_eval {d} (A : ElectromagneticPotential d) + (x : SpaceTime d) + (b : ComponentIdx (S := realLorentzTensor d) (Fin.append ![Color.up] ![Color.up])) : + (Tensor.basis _).repr (Tensorial.toTensor (toFieldStrength A x)) b = + toField {A.toFieldStrength x | [b 0] [b 1]}ᵀ := by + rw [toFieldStrength_eval_eq_tensor_basis_repr] + congr 1 + funext i + fin_cases i <;> rfl /-- The evaluated components of the field strength tensor in terms of derivatives of the electromagnetic potential. -/ @@ -370,8 +266,12 @@ lemma toFieldStrength_eval_apply {d} (A : ElectromagneticPotential d) (x : SpaceTime d) (μ ν : Fin 1 ⊕ Fin d) : toField {A.toFieldStrength x | [μ] [ν]}ᵀ = ∑ κ, (η μ κ * ∂_ κ A x ν - η ν κ * ∂_ κ A x μ) := by - rw [toFieldStrength_eval_eq_basis_repr] - exact toFieldStrength_basis_repr_apply (μν := (μ, ν)) A x + rw [toFieldStrength_eval_eq_tensor_basis_repr, toTensor_toFieldStrength] + simp only [map_sub, Finsupp.coe_sub, Pi.sub_apply, Tensor.permT_basis_repr_symm_apply, + contrT_basis_repr_apply_eq_fin, Tensor.prodT_basis_repr_apply, + contrMetric_repr_apply_eq_minkowskiMatrix, toTensor_deriv_basis_repr_apply, + ← Finset.sum_sub_distrib] + rfl /-- The evaluated components of the field strength tensor after using diagonal form of the Minkowski metric. -/ @@ -379,238 +279,166 @@ lemma toFieldStrength_eval_apply_eq_single {d} (A : ElectromagneticPotential d) (x : SpaceTime d) (μ ν : Fin 1 ⊕ Fin d) : toField {A.toFieldStrength x | [μ] [ν]}ᵀ = η μ μ * ∂_ μ A x ν - η ν ν * ∂_ ν A x μ := by - rw [toFieldStrength_eval_eq_basis_repr] - exact toFieldStrength_basis_repr_apply_eq_single (μν := (μ, ν)) A x + rw [toFieldStrength_eval_apply, Finset.sum_sub_distrib, + Finset.sum_eq_single μ + (fun b _ hb => by simp [minkowskiMatrix.off_diag_zero hb.symm]) (by simp), + Finset.sum_eq_single ν + (fun b _ hb => by simp [minkowskiMatrix.off_diag_zero hb.symm]) (by simp)] /-! -### A.6. The field strength matrix +#### A.5.2. Differentiability of the components -We define the field strength matrix to be the matrix representation of the field strength tensor -in the standard basis. - -This is currently not used as much as it could be. -/ open ContDiff -/-- The matrix corresponding to the field strength in the standard basis. -/ -noncomputable abbrev fieldStrengthMatrix {d} (A : ElectromagneticPotential d) (x : SpaceTime d) := - (Lorentz.CoVector.basis.tensorProduct Lorentz.Vector.basis).repr (A.toFieldStrength x) - -lemma fieldStrengthMatrix_eq {d} (A : ElectromagneticPotential d) (x : SpaceTime d) : - A.fieldStrengthMatrix x = - (Lorentz.CoVector.basis.tensorProduct Lorentz.Vector.basis).repr (A.toFieldStrength x) := by rfl - -/-- Index evaluation of the field strength tensor agrees with the corresponding component of -the field strength matrix. -/ -lemma toFieldStrength_eval_eq_fieldStrengthMatrix {d} (A : ElectromagneticPotential d) - (x : SpaceTime d) (μ ν : Fin 1 ⊕ Fin d) : - toField {A.toFieldStrength x | [μ] [ν]}ᵀ = A.fieldStrengthMatrix x (μ, ν) := by - rw [toFieldStrength_eval_eq_basis_repr, fieldStrengthMatrix_eq] - -lemma fieldStrengthMatrix_eq_tensor_basis_repr {d} (A : ElectromagneticPotential d) - (x : SpaceTime d) (μ ν : (Fin 1 ⊕ Fin d)) : - A.fieldStrengthMatrix x (μ, ν) = - (Tensor.basis _).repr (Tensorial.toTensor (toFieldStrength A x)) - (fun | 0 => μ | 1 => ν) := by - rw [toFieldStrength_tensor_basis_eq_basis] - rfl - -lemma toFieldStrength_eq_fieldStrengthMatrix {d} (A : ElectromagneticPotential d) : - toFieldStrength A = fun x => ∑ μ, ∑ ν, - A.fieldStrengthMatrix x (μ, ν) • (Lorentz.Vector.basis μ) ⊗ₜ (Lorentz.Vector.basis ν) := by - ext x - apply (Lorentz.Vector.basis.tensorProduct Lorentz.Vector.basis).repr.injective - simp only [map_sum, map_smul] - ext κ - match κ with - | (μ', ν') => - simp [Finsupp.single_apply] - rfl - -/-! - -#### A.6.1. Differentiability of the field strength matrix +lemma toFieldStrength_eval_differentiable {d} {A : ElectromagneticPotential d} + {μ ν : Fin 1 ⊕ Fin d} (hA : ContDiff ℝ 2 A) : + Differentiable ℝ (fun x => toField {A.toFieldStrength x | [μ] [ν]}ᵀ) := by + simp only [toFieldStrength_eval_apply_eq_single] + fun_prop --/ +lemma toFieldStrength_eval_differentiable_space {d} {A : ElectromagneticPotential d} + {μ ν : Fin 1 ⊕ Fin d} (hA : ContDiff ℝ 2 A) (t : Time) {c : SpeedOfLight} : + Differentiable ℝ (fun x => + toField {A.toFieldStrength ((toTimeAndSpace c).symm (t, x)) | [μ] [ν]}ᵀ) := by + change Differentiable ℝ ((fun x => toField {A.toFieldStrength x | [μ] [ν]}ᵀ) ∘ + fun x => (toTimeAndSpace c).symm (t, x)) + exact (toFieldStrength_eval_differentiable hA).comp (by fun_prop) + +lemma toFieldStrength_eval_differentiable_time {d} {A : ElectromagneticPotential d} + {μ ν : Fin 1 ⊕ Fin d} (hA : ContDiff ℝ 2 A) (x : Space d) {c : SpeedOfLight} : + Differentiable ℝ (fun t => + toField {A.toFieldStrength ((toTimeAndSpace c).symm (t, x)) | [μ] [ν]}ᵀ) := by + change Differentiable ℝ ((fun x => toField {A.toFieldStrength x | [μ] [ν]}ᵀ) ∘ + fun t => (toTimeAndSpace c).symm (t, x)) + exact (toFieldStrength_eval_differentiable hA).comp (by fun_prop) + +lemma toFieldStrength_eval_contDiff {d} {n : WithTop ℕ∞} {A : ElectromagneticPotential d} + {μ ν : Fin 1 ⊕ Fin d} (hA : ContDiff ℝ (n + 1) A) : + ContDiff ℝ n (fun x => toField {A.toFieldStrength x | [μ] [ν]}ᵀ) := by + simp only [toFieldStrength_eval_apply_eq_single] + fun_prop -lemma fieldStrengthMatrix_differentiable {d} {A : ElectromagneticPotential d} - {μν} (hA : ContDiff ℝ 2 A) : - Differentiable ℝ (A.fieldStrengthMatrix · μν) := by - have diff_partial (μ) : - ∀ ν, Differentiable ℝ fun x => (fderiv ℝ A x) (Lorentz.Vector.basis μ) ν := by - rw [SpaceTime.differentiable_vector] - exact Differentiable.clm_apply - (((contDiff_succ_iff_fderiv (n := 1)).mp hA).2.2.differentiable (by simp)) (by fun_prop) - conv => enter [2, x]; rw [toFieldStrength_basis_repr_apply_eq_single, - SpaceTime.deriv_eq, SpaceTime.deriv_eq] - exact ((diff_partial _ _).const_mul _).sub ((diff_partial _ _).const_mul _) - -lemma fieldStrengthMatrix_differentiable_space {d} {A : ElectromagneticPotential d} - {μν} (hA : ContDiff ℝ 2 A) (t : Time) {c : SpeedOfLight} : - Differentiable ℝ (fun x => A.fieldStrengthMatrix ((toTimeAndSpace c).symm (t, x)) μν) := by - change Differentiable ℝ ((A.fieldStrengthMatrix · μν) ∘ fun x => (toTimeAndSpace c).symm (t, x)) - exact (fieldStrengthMatrix_differentiable hA).comp (by fun_prop) - -lemma fieldStrengthMatrix_differentiable_time {d} {A : ElectromagneticPotential d} - {μν} (hA : ContDiff ℝ 2 A) (x : Space d) {c : SpeedOfLight} : - Differentiable ℝ (fun t => A.fieldStrengthMatrix ((toTimeAndSpace c).symm (t, x)) μν) := by - change Differentiable ℝ ((A.fieldStrengthMatrix · μν) ∘ fun t => (toTimeAndSpace c).symm (t, x)) - exact (fieldStrengthMatrix_differentiable hA).comp (by fun_prop) - -lemma fieldStrengthMatrix_contDiff {d} {n : WithTop ℕ∞} {A : ElectromagneticPotential d} - {μν} (hA : ContDiff ℝ (n + 1) A) : - ContDiff ℝ n (A.fieldStrengthMatrix · μν) := by - conv => enter [3, x]; rw [toFieldStrength_basis_repr_apply_eq_single, - SpaceTime.deriv_eq, SpaceTime.deriv_eq] - apply ContDiff.sub - apply ContDiff.mul - · fun_prop - · match μν with - | (μ, ν) => - simp only - revert ν - rw [SpaceTime.contDiff_vector] - exact ContDiff.clm_apply (ContDiff.fderiv_right (m := n) hA (by rfl)) (by fun_prop) - apply ContDiff.mul - · fun_prop - · match μν with - | (μ, ν) => - simp only - revert μ - rw [SpaceTime.contDiff_vector] - exact ContDiff.clm_apply (ContDiff.fderiv_right (m := n) hA (by rfl)) (by fun_prop) - -lemma fieldStrengthMatrix_smooth {d} {A : ElectromagneticPotential d} - (hA : ContDiff ℝ ∞ A) (μν) : - ContDiff ℝ ∞ (A.fieldStrengthMatrix · μν) := - fieldStrengthMatrix_contDiff (by simpa using hA) +lemma toFieldStrength_eval_smooth {d} {A : ElectromagneticPotential d} + (hA : ContDiff ℝ ∞ A) (μ ν : Fin 1 ⊕ Fin d) : + ContDiff ℝ ∞ (fun x => toField {A.toFieldStrength x | [μ] [ν]}ᵀ) := + toFieldStrength_eval_contDiff (by simpa using hA) /-! -### A.7. The antisymmetry of the field strength tensor +### A.6. The antisymmetry of the field strength tensor We show that the field strength tensor is antisymmetric. -/ +lemma toFieldStrength_eval_antisymm {d} (A : ElectromagneticPotential d) (x : SpaceTime d) + (μ ν : Fin 1 ⊕ Fin d) : + toField {A.toFieldStrength x | [μ] [ν]}ᵀ = - toField {A.toFieldStrength x | [ν] [μ]}ᵀ := by + rw [toFieldStrength_eval_apply, toFieldStrength_eval_apply, ← Finset.sum_neg_distrib] + exact Finset.sum_congr rfl fun κ _ => by simp + +lemma toFieldStrength_eval_diag_eq_zero {d} (A : ElectromagneticPotential d) (x : SpaceTime d) + (μ : Fin 1 ⊕ Fin d) : + toField {A.toFieldStrength x | [μ] [μ]}ᵀ = 0 := by + rw [toFieldStrength_eval_apply_eq_single, sub_self] + lemma toFieldStrength_antisymmetric {d} (A : ElectromagneticPotential d) (x : SpaceTime d) : {A.toFieldStrength x | μ ν = - (A.toFieldStrength x | ν μ)}ᵀ := by apply (Tensor.basis _).repr.injective ext b - rw [toTensor_toFieldStrength_basis_repr, permT_basis_repr_symm_apply, map_neg] - simp only [Nat.reduceAdd, Fin.isValue, Nat.reduceSucc, Finsupp.coe_neg, Pi.neg_apply] - rw [toTensor_toFieldStrength_basis_repr, ← Finset.sum_neg_distrib] - refine Finset.sum_congr rfl fun κ _ => ?_ - simp only [Fin.isValue, neg_sub] + simp only [permT_basis_repr_symm_apply, map_neg, Finsupp.coe_neg, Pi.neg_apply, + toFieldStrength_tensor_basis_repr_eq_eval] + rw [toFieldStrength_eval_antisymm] rfl -lemma fieldStrengthMatrix_antisymm {d} (A : ElectromagneticPotential d) (x : SpaceTime d) - (μ ν : Fin 1 ⊕ Fin d) : - A.fieldStrengthMatrix x (μ, ν) = - A.fieldStrengthMatrix x (ν, μ) := by - rw [toFieldStrength_basis_repr_apply, toFieldStrength_basis_repr_apply, - ← Finset.sum_neg_distrib] - exact Finset.sum_congr rfl fun κ _ => by simp - -@[simp] -lemma fieldStrengthMatrix_diag_eq_zero {d} (A : ElectromagneticPotential d) (x : SpaceTime d) - (μ : Fin 1 ⊕ Fin d) : - A.fieldStrengthMatrix x (μ, μ) = 0 := by - simp [toFieldStrength_basis_repr_apply_eq_single] - /-! -### A.8. Equivariance of the field strength matrix +### A.7. Equivariance of the components of the field strength tensor -/ -set_option backward.isDefEq.respectTransparency false in -lemma fieldStrengthMatrix_equivariant {d} (A : ElectromagneticPotential d) +lemma toFieldStrength_eval_equivariant {d} (A : ElectromagneticPotential d) (Λ : LorentzGroup d) (hf : Differentiable ℝ A) (x : SpaceTime d) - (μ : (Fin 1 ⊕ Fin d)) (ν : Fin 1 ⊕ Fin d) : - fieldStrengthMatrix (Λ • A) x (μ, ν) = - ∑ κ, ∑ ρ, (Λ.1 μ κ * Λ.1 ν ρ) * A.fieldStrengthMatrix (Λ⁻¹ • x) (κ, ρ) := by - rw [fieldStrengthMatrix, toFieldStrength_equivariant A Λ hf x] - conv_rhs => - enter [2, κ, 2, ρ] - rw [fieldStrengthMatrix] + (μ ν : Fin 1 ⊕ Fin d) : + toField {(Λ • A).toFieldStrength x | [μ] [ν]}ᵀ = + ∑ κ, ∑ ρ, (Λ.1 μ κ * Λ.1 ν ρ) * toField {A.toFieldStrength (Λ⁻¹ • x) | [κ] [ρ]}ᵀ := by + simp only [Vector.toField_eval_eval_eq_tensorProduct_repr] + rw [toFieldStrength_equivariant A Λ hf x] generalize A.toFieldStrength (Λ⁻¹ • x) = F - let P (F : Lorentz.Vector d ⊗[ℝ] Lorentz.Vector d) : Prop := - ((Lorentz.CoVector.basis.tensorProduct Lorentz.Vector.basis).repr (Λ • F)) (μ, ν) = - ∑ κ, ∑ ρ, Λ.1 μ κ * Λ.1 ν ρ * - ((Lorentz.CoVector.basis.tensorProduct Lorentz.Vector.basis).repr F) (κ, ρ) - change P F - apply TensorProduct.induction_on - · simp [P] - · intro x y - dsimp [P] + induction F using TensorProduct.induction_on with + | zero => simp + | tmul v w => rw [Tensorial.smul_prod] - simp only [Basis.tensorProduct_repr_tmul_apply, Lorentz.Vector.basis_repr_apply, - Lorentz.CoVector.basis_repr_apply, smul_eq_mul] - rw [Lorentz.Vector.smul_eq_sum, Finset.sum_mul] - conv_rhs => rw [Finset.sum_comm] - apply Finset.sum_congr rfl (fun κ _ => ?_) + simp only [Basis.tensorProduct_repr_tmul_apply, Lorentz.Vector.basis_repr_apply, smul_eq_mul] + rw [Lorentz.Vector.smul_eq_sum, Finset.sum_mul, Finset.sum_comm] + refine Finset.sum_congr rfl fun κ _ => ?_ rw [Lorentz.Vector.smul_eq_sum, Finset.mul_sum] exact Finset.sum_congr rfl fun ρ _ => by ring - · intro F1 F2 h1 h2 - simp [P, h1, h2] - rw [← Finset.sum_add_distrib] - apply Finset.sum_congr rfl (fun κ _ => ?_) - rw [← Finset.sum_add_distrib] - exact Finset.sum_congr rfl fun ρ _ => by ring + | add F1 F2 h1 h2 => + simp only [smul_add, map_add, Finsupp.coe_add, Pi.add_apply, h1, h2, ← Finset.sum_add_distrib] + exact Finset.sum_congr rfl fun κ _ => Finset.sum_congr rfl fun ρ _ => by ring + +/-- This lemma expresses the component form of the transformed field strength +tensor: when a Lorentz transformation Λ acts on the potential A, the resulting field strength +tensor's components are given by the standard tensor transformation rule involving the Lorentz +matrix elements Λ^μ_κ and Λ^ν_ρ applied to the original field components. -/ +lemma toFieldStrength_action_eq_sum {d} (A : ElectromagneticPotential d) (Λ : LorentzGroup d) + (hf : Differentiable ℝ A) (x : SpaceTime d) : + (Λ • A).toFieldStrength x = ∑ μ, ∑ ν, + (∑ κ, ∑ ρ, Λ.1 μ κ * Λ.1 ν ρ * toField {A.toFieldStrength (Λ⁻¹ • x) | [κ] [ρ]}ᵀ) • + Vector.basis μ ⊗ₜ[ℝ] Vector.basis ν := by + rw [toFieldStrength_eq_sum_basis_eval] + simp only [toFieldStrength_eval_equivariant A Λ hf x] /-! -### A.9. Linearity of the field strength tensor +### A.8. Linearity of the field strength tensor We show that the field strength tensor is linear in the potential. -/ -set_option backward.isDefEq.respectTransparency false in +lemma toFieldStrength_eval_add {d} (A1 A2 : ElectromagneticPotential d) + (x : SpaceTime d) (hA1 : Differentiable ℝ A1) (hA2 : Differentiable ℝ A2) + (μ ν : Fin 1 ⊕ Fin d) : + toField {(A1 + A2).toFieldStrength x | [μ] [ν]}ᵀ = + toField {A1.toFieldStrength x | [μ] [ν]}ᵀ + toField {A2.toFieldStrength x | [μ] [ν]}ᵀ := by + simp only [toFieldStrength_eval_apply, ← Finset.sum_add_distrib] + refine Finset.sum_congr rfl fun κ _ => ?_ + simp only [SpaceTime.deriv_eq, add_val, fderiv_add hA1.differentiableAt hA2.differentiableAt, + _root_.add_apply, Lorentz.Vector.apply_add] + ring + lemma toFieldStrength_add {d} (A1 A2 : ElectromagneticPotential d) (x : SpaceTime d) (hA1 : Differentiable ℝ A1) (hA2 : Differentiable ℝ A2) : toFieldStrength (A1 + A2) x = toFieldStrength A1 x + toFieldStrength A2 x := by - apply (Lorentz.CoVector.basis.tensorProduct Lorentz.Vector.basis).repr.injective - ext μν - simp only [map_add, Finsupp.coe_add, Pi.add_apply] - repeat rw [toFieldStrength_basis_repr_apply] - rw [← Finset.sum_add_distrib] - apply Finset.sum_congr rfl (fun κ _ => ?_) - repeat rw [SpaceTime.deriv_eq] - simp only [add_val] - rw [fderiv_add hA1.differentiableAt hA2.differentiableAt] - simp only [_root_.add_apply, Lorentz.Vector.apply_add] + apply Tensorial.toTensor.injective + apply (Tensor.basis _).repr.injective + ext b + simp only [map_add, Finsupp.coe_add, Pi.add_apply, toFieldStrength_tensor_basis_repr_eq_eval] + exact toFieldStrength_eval_add A1 A2 x hA1 hA2 _ _ + +lemma toFieldStrength_eval_smul {d} (c : ℝ) (A : ElectromagneticPotential d) + (x : SpaceTime d) (hA : Differentiable ℝ A) (μ ν : Fin 1 ⊕ Fin d) : + toField {(c • A).toFieldStrength x | [μ] [ν]}ᵀ = + c * toField {A.toFieldStrength x | [μ] [ν]}ᵀ := by + simp only [toFieldStrength_eval_apply, Finset.mul_sum] + refine Finset.sum_congr rfl fun κ _ => ?_ + simp only [SpaceTime.deriv_eq, smul_val, fderiv_const_smul hA.differentiableAt, FunLike.coe_smul, + Pi.smul_apply, Lorentz.Vector.apply_smul] ring -set_option backward.isDefEq.respectTransparency false in -lemma fieldStrengthMatrix_add {d} (A1 A2 : ElectromagneticPotential d) - (x : SpaceTime d) (hA1 : Differentiable ℝ A1) (hA2 : Differentiable ℝ A2) : - (A1 + A2).fieldStrengthMatrix x = - A1.fieldStrengthMatrix x + A2.fieldStrengthMatrix x := by - simp [fieldStrengthMatrix, toFieldStrength_add A1 A2 x hA1 hA2] - -set_option backward.isDefEq.respectTransparency false in lemma toFieldStrength_smul {d} (c : ℝ) (A : ElectromagneticPotential d) (x : SpaceTime d) (hA : Differentiable ℝ A) : toFieldStrength (c • A) x = c • toFieldStrength A x := by - apply (Lorentz.CoVector.basis.tensorProduct Lorentz.Vector.basis).repr.injective - ext μν - simp only [map_smul, Finsupp.coe_smul, Pi.smul_apply, smul_eq_mul] - repeat rw [toFieldStrength_basis_repr_apply] - rw [Finset.mul_sum] - apply Finset.sum_congr rfl (fun κ _ => ?_) - repeat rw [SpaceTime.deriv_eq] - simp only [smul_val] - rw [fderiv_const_smul hA.differentiableAt] - simp only [FunLike.coe_smul, Pi.smul_apply, Lorentz.Vector.apply_smul] - ring - -set_option backward.isDefEq.respectTransparency false in -lemma fieldStrengthMatrix_smul {d} (c : ℝ) (A : ElectromagneticPotential d) - (x : SpaceTime d) (hA : Differentiable ℝ A) : - (c • A).fieldStrengthMatrix x = c • A.fieldStrengthMatrix x := by - simp [fieldStrengthMatrix, toFieldStrength_smul c A x hA] + apply Tensorial.toTensor.injective + apply (Tensor.basis _).repr.injective + ext b + simp only [map_smul, Finsupp.coe_smul, Pi.smul_apply, smul_eq_mul, + toFieldStrength_tensor_basis_repr_eq_eval] + exact toFieldStrength_eval_smul c A x hA _ _ end ElectromagneticPotential diff --git a/Physlib/Electromagnetism/Kinematics/GaugeTransformation.lean b/Physlib/Electromagnetism/Kinematics/GaugeTransformation.lean index c3c1cc6310..b386d480af 100644 --- a/Physlib/Electromagnetism/Kinematics/GaugeTransformation.lean +++ b/Physlib/Electromagnetism/Kinematics/GaugeTransformation.lean @@ -18,7 +18,7 @@ that the field strength tensor is invariant under such transformations. The raised-index gradient `∂^μ χ := η^{μν} ∂_ν χ` is necessary because the bare covariant gradient `∂_μ χ` does not make `F^{μν}` invariant. The formal witness is -`fieldStrengthMatrix_bareGradient_inl_inr` (§B.5), which computes a specific nonzero component of +`toFieldStrength_eval_bareGradient_inl_inr` (§B.5), which computes a specific nonzero component of the field strength of a bare-gradient potential. The invariance theorem `toFieldStrength_gaugeTransform` doubles as a correctness test of `ofGradient`. @@ -29,13 +29,13 @@ the field strength of a bare-gradient potential. The invariance theorem - `toFieldStrength_ofGradient` : A pure-gauge potential has vanishing field strength. - `toFieldStrength_gaugeTransform` : The field strength tensor is invariant under gauge transformations. -- `fieldStrengthMatrix_gaugeTransform` : The field strength matrix is invariant under gauge - transformations. +- `toFieldStrength_eval_gaugeTransform` : The components of the field strength tensor are + invariant under gauge transformations. - `gaugeTransform_gaugeTransform` : Composing two gauge shifts equals shifting by the sum; upgrades one-step F-invariance to invariance along any finite chain. - `ofGradient_equivariant` : `ofGradient` intertwines the Lorentz action with function composition. - `gaugeTransform_equivariant` : Gauge transformations commute with Lorentz transformations. -- `fieldStrengthMatrix_bareGradient_inl_inr` : The `(inl 0, inr i)` field-strength component of +- `toFieldStrength_eval_bareGradient_inl_inr` : The `(inl 0, inr i)` field-strength component of the bare-gradient potential `χ(x) = x⁰·xⁱ` equals `2`; in particular the bare gradient does not give a gauge-invariant field strength (necessity of the metric contraction in `ofGradient`). @@ -55,8 +55,8 @@ the field strength of a bare-gradient potential. The invariance theorem ## iv. References -- https://en.wikipedia.org/wiki/Mathematical_descriptions_of_the_electromagnetic_field#Gauge_freedom - +* https://en.wikipedia.org/wiki/Mathematical_descriptions_of_the_electromagnetic_field#Gauge_freedom. + [ref: wiki_em_field_gauge_freedom] -/ @[expose] public section @@ -76,7 +76,6 @@ open Lorentz attribute [-simp] Fintype.sum_sum_type attribute [-simp] Nat.succ_eq_add_one - /-! ## A. The pure-gauge potential @@ -161,27 +160,21 @@ lemma contDiff_ofGradient {n} {d} {χ : SpaceTime d → ℝ} (hχ : ContDiff ℝ /-- A pure-gauge potential has vanishing field strength. -/ lemma toFieldStrength_ofGradient {d} {χ : SpaceTime d → ℝ} (hχ : ContDiff ℝ 2 χ) (x : SpaceTime d) : (ofGradient χ).toFieldStrength x = 0 := by - apply (Lorentz.CoVector.basis.tensorProduct Lorentz.Vector.basis).repr.injective - apply Finsupp.ext - intro μν - simp only [toFieldStrength_basis_repr_apply_eq_single] - rw [SpaceTime.deriv_apply_eq μν.1 μν.2 (ofGradient χ) (differentiable_ofGradient hχ), - SpaceTime.deriv_apply_eq μν.2 μν.1 (ofGradient χ) (differentiable_ofGradient hχ)] + rw [congrFun (toFieldStrength_eq_sum_basis_eval (A := ofGradient χ)) x] + refine Finset.sum_eq_zero fun μ _ => Finset.sum_eq_zero fun ν _ => ?_ + rw [toFieldStrength_eval_apply_eq_single] + rw [SpaceTime.deriv_apply_eq μ ν (ofGradient χ) (differentiable_ofGradient hχ), + SpaceTime.deriv_apply_eq ν μ (ofGradient χ) (differentiable_ofGradient hχ)] simp only [ofGradient_apply] - rw [fderiv_const_mul (SpaceTime.differentiable_deriv μν.1 χ hχ).differentiableAt, - fderiv_const_mul (SpaceTime.differentiable_deriv μν.2 χ hχ).differentiableAt] + rw [fderiv_const_mul (SpaceTime.differentiable_deriv μ χ hχ).differentiableAt, + fderiv_const_mul (SpaceTime.differentiable_deriv ν χ hχ).differentiableAt] simp only [FunLike.coe_smul, Pi.smul_apply, smul_eq_mul] - -- simplify repr 0 to 0 - conv_rhs => rw [show (Lorentz.CoVector.basis.tensorProduct Lorentz.Vector.basis).repr - (0 : Lorentz.Vector d ⊗[ℝ] Lorentz.Vector d) = 0 from map_zero _] - simp only [Finsupp.zero_apply] -- use Clairaut: ∂_ μ (∂_ ν χ) x = ∂_ ν (∂_ μ χ) x, so the two terms cancel - have heq : fderiv ℝ (∂_ μν.2 χ) x (Lorentz.Vector.basis μν.1) = - fderiv ℝ (∂_ μν.1 χ) x (Lorentz.Vector.basis μν.2) := by - change ∂_ μν.1 (∂_ μν.2 χ) x = ∂_ μν.2 (∂_ μν.1 χ) x - rw [← SpaceTime.deriv_commute μν.2 μν.1 χ hχ] - rw [heq] - ring + have heq : fderiv ℝ (∂_ ν χ) x (Lorentz.Vector.basis μ) = + fderiv ℝ (∂_ μ χ) x (Lorentz.Vector.basis ν) := by + change ∂_ μ (∂_ ν χ) x = ∂_ ν (∂_ μ χ) x + rw [← SpaceTime.deriv_commute ν μ χ hχ] + rw [heq, mul_left_comm, sub_self, zero_smul] /-! @@ -270,11 +263,13 @@ lemma toFieldStrength_gaugeTransform {d} (A : ElectromagneticPotential d) rw [gaugeTransform, toFieldStrength_add A (ofGradient χ) x hA (differentiable_ofGradient hχ), toFieldStrength_ofGradient hχ, add_zero] -/-- The field strength matrix is invariant under gauge transformations. -/ -lemma fieldStrengthMatrix_gaugeTransform {d} (A : ElectromagneticPotential d) - (χ : SpaceTime d → ℝ) (hA : Differentiable ℝ A) (hχ : ContDiff ℝ 2 χ) (x : SpaceTime d) : - (gaugeTransform χ A).fieldStrengthMatrix x = A.fieldStrengthMatrix x := by - rw [fieldStrengthMatrix, toFieldStrength_gaugeTransform A χ hA hχ] +/-- The components of the field strength tensor are invariant under gauge transformations. -/ +lemma toFieldStrength_eval_gaugeTransform {d} (A : ElectromagneticPotential d) + (χ : SpaceTime d → ℝ) (hA : Differentiable ℝ A) (hχ : ContDiff ℝ 2 χ) (x : SpaceTime d) + (μ ν : Fin 1 ⊕ Fin d) : + toField {(gaugeTransform χ A).toFieldStrength x | [μ] [ν]}ᵀ = + toField {A.toFieldStrength x | [μ] [ν]}ᵀ := by + rw [toFieldStrength_gaugeTransform A χ hA hχ] /-! @@ -340,15 +335,15 @@ contraction in `ofGradient` is required for gauge invariance. -/ -/-- The `(inl 0, inr i)` component of the field strength matrix of the bare-gradient potential +/-- The `(inl 0, inr i)` component of the field strength tensor of the bare-gradient potential `B^μ := ∂_μ χ` for `χ(x) = x⁰·xⁱ` equals `2`. This witnesses that the bare covariant gradient does not produce a gauge-invariant field strength, so the raised-index contraction `η^{μν} ∂_ν χ` in `ofGradient` is necessary (see the module overview). -/ -lemma fieldStrengthMatrix_bareGradient_inl_inr {d : ℕ} (i : Fin d) +lemma toFieldStrength_eval_bareGradient_inl_inr {d : ℕ} (i : Fin d) (x : SpaceTime d) : let χ : SpaceTime d → ℝ := fun y => y (Sum.inl 0) * y (Sum.inr i) let B : ElectromagneticPotential d := ⟨fun y μ => ∂_ μ χ y⟩ - B.fieldStrengthMatrix x (Sum.inl 0, Sum.inr i) = 2 := by + toField {B.toFieldStrength x | [Sum.inl 0] [Sum.inr i]}ᵀ = 2 := by intro χ B have hχ : ContDiff ℝ 2 χ := by show ContDiff ℝ 2 (fun y : SpaceTime d => y (Sum.inl 0) * y (Sum.inr i)) @@ -356,8 +351,8 @@ lemma fieldStrengthMatrix_bareGradient_inl_inr {d : ℕ} (i : Fin d) have hB : Differentiable ℝ B := by rw [← SpaceTime.differentiable_vector]; intro μ exact SpaceTime.differentiable_deriv μ χ hχ - -- fieldStrengthMatrix (μ, ν) = η μ μ * ∂_ μ B x ν − η ν ν * ∂_ ν B x μ - rw [toFieldStrength_basis_repr_apply_eq_single] + -- F^{μν} = η μ μ * ∂_ μ B x ν − η ν ν * ∂_ ν B x μ + rw [toFieldStrength_eval_apply_eq_single] -- Expand ∂_ μ B x ν as ∂_ μ (fun y => ∂_ ν χ y) x = ∂_ μ (∂_ ν χ) x rw [SpaceTime.deriv_apply_eq (Sum.inl 0) (Sum.inr i) B hB, SpaceTime.deriv_apply_eq (Sum.inr i) (Sum.inl 0) B hB] @@ -391,19 +386,17 @@ lemma fieldStrengthMatrix_bareGradient_inl_inr {d : ℕ} (i : Fin d) norm_num /-- The field strength of the bare-gradient potential `B^μ := ∂_μ χ` for - `χ(x) = x⁰·xⁱ` is nonzero (follows from `fieldStrengthMatrix_bareGradient_inl_inr`). -/ + `χ(x) = x⁰·xⁱ` is nonzero (follows from `toFieldStrength_eval_bareGradient_inl_inr`). -/ lemma toFieldStrength_bareGradient_ne_zero {d : ℕ} (i : Fin d) (x : SpaceTime d) : let χ : SpaceTime d → ℝ := fun y => y (Sum.inl 0) * y (Sum.inr i) let B : ElectromagneticPotential d := ⟨fun y μ => ∂_ μ χ y⟩ B.toFieldStrength x ≠ 0 := by intro χ B h - have h2 := fieldStrengthMatrix_bareGradient_inl_inr i x + have h2 := toFieldStrength_eval_bareGradient_inl_inr i x dsimp only at h2 - rw [fieldStrengthMatrix_eq, h] at h2 - have h3 : ((Lorentz.CoVector.basis.tensorProduct Lorentz.Vector.basis).repr - (0 : Lorentz.CoVector d ⊗[ℝ] Lorentz.Vector d)) = 0 := map_zero _ - erw [h3, Finsupp.zero_apply] at h2 + rw [h] at h2 + simp only [map_zero] at h2 norm_num at h2 end ElectromagneticPotential diff --git a/Physlib/Electromagnetism/Kinematics/MagneticField.lean b/Physlib/Electromagnetism/Kinematics/MagneticField.lean index 1d88db0dd1..3ffc4faa10 100644 --- a/Physlib/Electromagnetism/Kinematics/MagneticField.lean +++ b/Physlib/Electromagnetism/Kinematics/MagneticField.lean @@ -46,6 +46,7 @@ field strength matrix. This is an antisymmetric matrix. ## iv. References +* None. -/ @[expose] public section @@ -64,6 +65,7 @@ open TensorProduct open minkowskiMatrix attribute [-simp] Fintype.sum_sum_type attribute [-simp] Nat.succ_eq_add_one +attribute [-simp] Fin.succAbove_zero open Space Time @@ -83,16 +85,16 @@ lemma magneticField_eq {c : SpeedOfLight} (A : ElectromagneticPotential) : /-! -### A.1. Relation between the magnetic field and the field strength matrix +### A.1. Relation between the magnetic field and the field strength tensor -/ -lemma magneticField_coord_eq_fieldStrengthMatrix {i : Fin 3} {c : SpeedOfLight} +lemma magneticField_coord_eq_toFieldStrength_eval {i : Fin 3} {c : SpeedOfLight} (A : ElectromagneticPotential) (t : Time) (x : Space) (hA : Differentiable ℝ A) : - A.magneticField c t x i = - - A.fieldStrengthMatrix ((toTimeAndSpace c).symm (t, x)) (Sum.inr (i+1), Sum.inr (i+2)) := by - rw [toFieldStrength_basis_repr_apply_eq_single] + A.magneticField c t x i = - toField {A.toFieldStrength ((toTimeAndSpace c).symm (t, x)) | + [Sum.inr (i+1)] [Sum.inr (i+2)]}ᵀ := by + rw [toFieldStrength_eval_apply_eq_single] simp only [Fin.isValue, inr_i_inr_i, neg_mul, one_mul, sub_neg_eq_add, neg_add_rev, neg_neg] rw [magneticField] simp only [curl, Fin.isValue] @@ -160,13 +162,13 @@ lemma ofElectromagneticField_magneticField {c : SpeedOfLight} /-! -## B. The field strength matrix in terms of the electric and magnetic fields +## B. The components of the field strength tensor in terms of the electric and magnetic fields -/ -lemma fieldStrengthMatrix_eq_electric_magnetic {c} (A : ElectromagneticPotential) (t : Time) +lemma toFieldStrength_eval_eq_electric_magnetic {c} (A : ElectromagneticPotential) (t : Time) (x : Space) (hA : Differentiable ℝ A) (μ ν : Fin 1 ⊕ Fin 3) : - A.fieldStrengthMatrix ((toTimeAndSpace c).symm (t, x)) (μ, ν) = + toField {A.toFieldStrength ((toTimeAndSpace c).symm (t, x)) | [μ] [ν]}ᵀ = match μ, ν with | Sum.inl 0, Sum.inl 0 => 0 | Sum.inl 0, Sum.inr i => - A.electricField c t x i / c @@ -183,22 +185,22 @@ lemma fieldStrengthMatrix_eq_electric_magnetic {c} (A : ElectromagneticPotential | 2, 1 => A.magneticField c t x 0 | 2, 2 => 0 := by match μ, ν with - | Sum.inl 0, Sum.inl 0 => simp - | Sum.inl 0, Sum.inr i => simp [electricField_eq_fieldStrengthMatrix A t x i hA] + | Sum.inl 0, Sum.inl 0 => simp [toFieldStrength_eval_diag_eq_zero] + | Sum.inl 0, Sum.inr i => simp [electricField_eq_toFieldStrength_eval A t x i hA] | Sum.inr i, Sum.inl 0 => - simp [electricField_eq_fieldStrengthMatrix A t x i hA] + simp [electricField_eq_toFieldStrength_eval A t x i hA] field_simp - rw [fieldStrengthMatrix_antisymm] + rw [toFieldStrength_eval_antisymm] | Sum.inr i, Sum.inr j => fin_cases i <;> fin_cases j <;> - simp [magneticField_coord_eq_fieldStrengthMatrix A t x hA] - repeat rw [fieldStrengthMatrix_antisymm] + simp [magneticField_coord_eq_toFieldStrength_eval A t x hA, toFieldStrength_eval_diag_eq_zero] + repeat rw [toFieldStrength_eval_antisymm] -lemma fieldStrengthMatrix_eq_electric_magnetic_of_spaceTime (c : SpeedOfLight) +lemma toFieldStrength_eval_eq_electric_magnetic_of_spaceTime (c : SpeedOfLight) (A : ElectromagneticPotential) (x : SpaceTime) (hA : Differentiable ℝ A) (μ ν : Fin 1 ⊕ Fin 3) : let tx := SpaceTime.toTimeAndSpace c x - A.fieldStrengthMatrix x (μ, ν) = + toField {A.toFieldStrength x | [μ] [ν]}ᵀ = match μ, ν with | Sum.inl 0, Sum.inl 0 => 0 | Sum.inl 0, Sum.inr i => - A.electricField c tx.1 tx.2 i / c @@ -215,7 +217,7 @@ lemma fieldStrengthMatrix_eq_electric_magnetic_of_spaceTime (c : SpeedOfLight) | 2, 1 => A.magneticField c tx.1 tx.2 0 | 2, 2 => 0 := by dsimp - rw [← fieldStrengthMatrix_eq_electric_magnetic A] + rw [← toFieldStrength_eval_eq_electric_magnetic A] simp only [Prod.mk.eta, ContinuousLinearEquiv.symm_apply_apply] exact hA @@ -229,16 +231,17 @@ lemma fieldStrengthMatrix_eq_electric_magnetic_of_spaceTime (c : SpeedOfLight) In `3` space-dimensions this reduces to a vector. -/ noncomputable def magneticFieldMatrix (c : SpeedOfLight := 1) (A : ElectromagneticPotential d) : Time → Space d → (Fin d × Fin d) → ℝ := timeSlice c <| fun x ij => - A.fieldStrengthMatrix x (Sum.inr ij.1, Sum.inr ij.2) + toField {A.toFieldStrength x | [Sum.inr ij.1] [Sum.inr ij.2]}ᵀ lemma magneticFieldMatrix_eq {c : SpeedOfLight} (A : ElectromagneticPotential d) : A.magneticFieldMatrix c = fun t x ij => - A.fieldStrengthMatrix ((toTimeAndSpace c).symm (t, x)) (Sum.inr ij.1, Sum.inr ij.2) := rfl + toField {A.toFieldStrength ((toTimeAndSpace c).symm (t, x)) | + [Sum.inr ij.1] [Sum.inr ij.2]}ᵀ := rfl -lemma fieldStrengthMatrix_inr_inr_eq_magneticFieldMatrix {c : SpeedOfLight} +lemma toFieldStrength_eval_inr_inr_eq_magneticFieldMatrix {c : SpeedOfLight} (A : ElectromagneticPotential d) (x : SpaceTime d) (i j : Fin d) : - A.fieldStrengthMatrix x (Sum.inr i, Sum.inr j) = + toField {A.toFieldStrength x | [Sum.inr i] [Sum.inr j]}ᵀ = A.magneticFieldMatrix c (x.time c) x.space (i, j) := by simp [magneticFieldMatrix_eq] @@ -252,14 +255,14 @@ lemma magneticFieldMatrix_antisymm {c : SpeedOfLight} (A : ElectromagneticPotential d) (t : Time) (x : Space d) (i j : Fin d) : A.magneticFieldMatrix c t x (i, j) = - A.magneticFieldMatrix c t x (j, i) := - fieldStrengthMatrix_antisymm A ((toTimeAndSpace c).symm (t, x)) (Sum.inr i) (Sum.inr j) + toFieldStrength_eval_antisymm A ((toTimeAndSpace c).symm (t, x)) (Sum.inr i) (Sum.inr j) @[simp] lemma magneticFieldMatrix_diag_eq_zero {c : SpeedOfLight} (A : ElectromagneticPotential d) (t : Time) (x : Space d) (i : Fin d) : A.magneticFieldMatrix c t x (i, i) = 0 := - fieldStrengthMatrix_diag_eq_zero A ((toTimeAndSpace c).symm (t, x)) (Sum.inr i) + toFieldStrength_eval_diag_eq_zero A ((toTimeAndSpace c).symm (t, x)) (Sum.inr i) /-! @@ -272,7 +275,7 @@ lemma magneticField_eq_magneticFieldMatrix {c : SpeedOfLight} (A : Electromagnet A.magneticField c = fun t x => WithLp.toLp 2 fun i => - A.magneticFieldMatrix c t x ((i+1), (i+2)) := by ext t x - simp [magneticFieldMatrix_eq, magneticField_coord_eq_fieldStrengthMatrix A t x hA] + simp [magneticFieldMatrix_eq, magneticField_coord_eq_toFieldStrength_eval A t x hA] lemma magneticField_curl_eq_magneticFieldMatrix{c : SpeedOfLight} (A : ElectromagneticPotential) (hA : ContDiff ℝ 2 A) (t : Time) : @@ -300,7 +303,7 @@ lemma magneticFieldMatrix_eq_vectorPotential {c : SpeedOfLight} (A : Electromagn A.magneticFieldMatrix c t x (i, j) = Space.deriv j (A.vectorPotential c t · i) x - Space.deriv i (A.vectorPotential c t · j) x := by simp only [magneticFieldMatrix_eq] - rw [toFieldStrength_basis_repr_apply_eq_single] + rw [toFieldStrength_eval_apply_eq_single] simp only [inr_i_inr_i, neg_mul, one_mul, sub_neg_eq_add] rw [SpaceTime.deriv_sum_inr c _ hA, SpaceTime.deriv_sum_inr c _ hA] simp [vectorPotential] @@ -320,7 +323,7 @@ lemma magneticFieldMatrix_eq_vectorPotential {c : SpeedOfLight} (A : Electromagn lemma magneticFieldMatrix_contDiff {n} {c : SpeedOfLight} (A : ElectromagneticPotential d) (hA : ContDiff ℝ (n + 1) A) (ij) : ContDiff ℝ n ↿(fun t x => A.magneticFieldMatrix c t x ij) := by - exact (fieldStrengthMatrix_contDiff hA).comp (toTimeAndSpace c).symm.contDiff + exact (toFieldStrength_eval_contDiff hA).comp (toTimeAndSpace c).symm.contDiff lemma magneticFieldMatrix_space_contDiff {n} {c : SpeedOfLight} (A : ElectromagneticPotential d) (hA : ContDiff ℝ (n + 1) A) (t : Time) (ij) : @@ -340,7 +343,7 @@ lemma magneticFieldMatrix_time_contDiff {n} {c : SpeedOfLight} (A : Electromagne lemma magneticFieldMatrix_differentiable {c : SpeedOfLight} (A : ElectromagneticPotential d) (hA : ContDiff ℝ 2 A) (ij) : Differentiable ℝ ↿(fun t x => A.magneticFieldMatrix c t x ij) := by - exact (fieldStrengthMatrix_differentiable hA).comp (toTimeAndSpace c).symm.differentiable + exact (toFieldStrength_eval_differentiable hA).comp (toTimeAndSpace c).symm.differentiable lemma magneticFieldMatrix_differentiable_space {c : SpeedOfLight} (A : ElectromagneticPotential d) (hA : ContDiff ℝ 2 A) (t : Time) (ij) : @@ -456,12 +459,12 @@ lemma time_deriv_time_deriv_magneticFieldMatrix {d : ℕ} {c : SpeedOfLight} -/ -lemma curl_magneticFieldMatrix_eq_electricField_fieldStrengthMatrix {d : ℕ} {c : SpeedOfLight} +lemma curl_magneticFieldMatrix_eq_electricField_toFieldStrength_eval {d : ℕ} {c : SpeedOfLight} (A : ElectromagneticPotential d) (hA : ContDiff ℝ 2 A) (t : Time) (x : Space d) (i : Fin d) : ∑ j, Space.deriv j (A.magneticFieldMatrix c t · (j, i)) x = (1/c^2) * ∂ₜ (fun t => A.electricField c t x) t i + - (∑ (μ : (Fin 1 ⊕ Fin d)), (∂_ μ (A.fieldStrengthMatrix · (μ, Sum.inr i)) + (∑ (μ : (Fin 1 ⊕ Fin d)), (∂_ μ (fun x => toField {A.toFieldStrength x | [μ] [Sum.inr i]}ᵀ) ((toTimeAndSpace c).symm (t, x)))) := by trans (1/c^2) * ∂ₜ (fun t => A.electricField c t x) t i + (- (1/c^2) * ∂ₜ (fun t => A.electricField c t x) t i + @@ -471,13 +474,13 @@ lemma curl_magneticFieldMatrix_eq_electricField_fieldStrengthMatrix {d : ℕ} {c rw [Fintype.sum_sum_type] congr · simp - rw [time_deriv_electricField_eq_fieldStrengthMatrix hA t x i] + rw [time_deriv_electricField_eq_toFieldStrength_eval hA t x i] field_simp · funext j rw [SpaceTime.deriv_sum_inr c] simp rfl - · apply fieldStrengthMatrix_differentiable hA + · apply toFieldStrength_eval_differentiable hA end ElectromagneticPotential diff --git a/Physlib/Electromagnetism/Kinematics/ScalarPotential.lean b/Physlib/Electromagnetism/Kinematics/ScalarPotential.lean index ba274ba3df..718b9e4197 100644 --- a/Physlib/Electromagnetism/Kinematics/ScalarPotential.lean +++ b/Physlib/Electromagnetism/Kinematics/ScalarPotential.lean @@ -35,6 +35,7 @@ the scalar potential is non-relativistic and is therefore a function of `Time` a ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/Electromagnetism/Kinematics/VectorPotential.lean b/Physlib/Electromagnetism/Kinematics/VectorPotential.lean index b5edd33d0f..04c32604ba 100644 --- a/Physlib/Electromagnetism/Kinematics/VectorPotential.lean +++ b/Physlib/Electromagnetism/Kinematics/VectorPotential.lean @@ -35,6 +35,7 @@ the vector potential is non-relativistic and is therefore a function of `Time` a ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/Electromagnetism/PointParticle/OneDimension.lean b/Physlib/Electromagnetism/PointParticle/OneDimension.lean index 127faf8deb..0a2c154ec9 100644 --- a/Physlib/Electromagnetism/PointParticle/OneDimension.lean +++ b/Physlib/Electromagnetism/PointParticle/OneDimension.lean @@ -38,6 +38,7 @@ sitting at the origin in 1d space. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/Electromagnetism/PointParticle/ThreeDimension.lean b/Physlib/Electromagnetism/PointParticle/ThreeDimension.lean index ac69848c27..55151d0a6f 100644 --- a/Physlib/Electromagnetism/PointParticle/ThreeDimension.lean +++ b/Physlib/Electromagnetism/PointParticle/ThreeDimension.lean @@ -40,6 +40,7 @@ sitting at the origin in 3d space. ## iv. References +* None. -/ @[expose] public section @@ -289,7 +290,7 @@ lemma threeDimPointParticle_div_electricField {𝓕} (q : ℝ) (r₀ : Space 3) (IsDistBounded.zpow_smul_repr_self (- 3 : ℤ) (by omega)))) · ext η simp [distTranslate_ofFunction] - simp only [Int.reduceNeg, zpow_neg, one_div] + simp only [Int.reduceNeg, zpow_neg, zpow_ofNat, one_div] rw [constantTime_distSpaceDiv, distDiv_distTranslate, h1] simp only [map_smul, smul_smul] ext η diff --git a/Physlib/Electromagnetism/Vacuum/Constant.lean b/Physlib/Electromagnetism/Vacuum/Constant.lean index 4bbfd58b19..78dd0f51d5 100644 --- a/Physlib/Electromagnetism/Vacuum/Constant.lean +++ b/Physlib/Electromagnetism/Vacuum/Constant.lean @@ -34,6 +34,7 @@ electromagnetic action. ## iv. References +* None. -/ @[expose] public section @@ -138,7 +139,7 @@ lemma constantEB_vectorPotential {c : SpeedOfLight} (constantEB c E₀ B₀ B₀_antisymm).vectorPotential c = fun _ x => WithLp.toLp 2 fun i => (1 / 2) * ∑ j, B₀ (i, j) * x j := by ext t x i - simp [vectorPotential, timeSlice, constantEB, space_toCoord_symm, Equiv.coe_fn_mk, + simp [vectorPotential, timeSlice, constantEB, Equiv.coe_fn_mk, Function.curry_apply, Function.comp_apply] /-! diff --git a/Physlib/Electromagnetism/Vacuum/HarmonicWave.lean b/Physlib/Electromagnetism/Vacuum/HarmonicWave.lean index dafcdaeee4..1203371fb5 100644 --- a/Physlib/Electromagnetism/Vacuum/HarmonicWave.lean +++ b/Physlib/Electromagnetism/Vacuum/HarmonicWave.lean @@ -50,6 +50,7 @@ form of a matrix rather than a vector. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/Electromagnetism/Vacuum/IsPlaneWave.lean b/Physlib/Electromagnetism/Vacuum/IsPlaneWave.lean index aceb3a626a..2868a8940f 100644 --- a/Physlib/Electromagnetism/Vacuum/IsPlaneWave.lean +++ b/Physlib/Electromagnetism/Vacuum/IsPlaneWave.lean @@ -51,6 +51,7 @@ in general dimensions. ## iv. References +* None. -/ @[expose] public section @@ -481,23 +482,23 @@ lemma space_deriv_electricField_eq_magneticFieldMatrix {d : ℕ} simp [← Time.deriv_eq] field_simp any_goals apply Differentiable.differentiableAt - · exact fieldStrengthMatrix_differentiable_space hA2 t + · exact toFieldStrength_eval_differentiable_space hA2 t · apply Differentiable.mul_const - exact fieldStrengthMatrix_differentiable_space hA2 t - · exact fieldStrengthMatrix_differentiable_time hA2 x + exact toFieldStrength_eval_differentiable_space hA2 t + · exact toFieldStrength_eval_differentiable_time hA2 x · intro i _ apply Differentiable.differentiableAt apply Differentiable.const_mul apply Differentiable.mul_const - exact fieldStrengthMatrix_differentiable_space hA2 t + exact toFieldStrength_eval_differentiable_space hA2 t · intro i _ apply Differentiable.differentiableAt apply Differentiable.mul_const - exact fieldStrengthMatrix_differentiable_time hA2 x + exact toFieldStrength_eval_differentiable_time hA2 x · apply Differentiable.fun_sum intro i _ apply Differentiable.mul_const - exact fieldStrengthMatrix_differentiable_time hA2 x + exact toFieldStrength_eval_differentiable_time hA2 x /-! diff --git a/Physlib/FluidDynamics/Basic.lean b/Physlib/FluidDynamics/Basic.lean index 618b0f3c5a..944629af96 100644 --- a/Physlib/FluidDynamics/Basic.lean +++ b/Physlib/FluidDynamics/Basic.lean @@ -32,6 +32,7 @@ The structure-specific APIs are organized in the corresponding `FluidFlow`, `Cau ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/FluidDynamics/CauchyFlow/Basic.lean b/Physlib/FluidDynamics/CauchyFlow/Basic.lean index 96cf572b4c..5004afa1ec 100644 --- a/Physlib/FluidDynamics/CauchyFlow/Basic.lean +++ b/Physlib/FluidDynamics/CauchyFlow/Basic.lean @@ -37,6 +37,7 @@ for momentum balance alone. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/FluidDynamics/CauchyFlow/BodyForce.lean b/Physlib/FluidDynamics/CauchyFlow/BodyForce.lean index 2ae8a5a64c..9a88bc43b1 100644 --- a/Physlib/FluidDynamics/CauchyFlow/BodyForce.lean +++ b/Physlib/FluidDynamics/CauchyFlow/BodyForce.lean @@ -28,6 +28,7 @@ This module defines predicates for conservative specific body forces on `CauchyF ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/FluidDynamics/CauchyFlow/Inviscid.lean b/Physlib/FluidDynamics/CauchyFlow/Inviscid.lean index af0547ef09..954148f4b3 100644 --- a/Physlib/FluidDynamics/CauchyFlow/Inviscid.lean +++ b/Physlib/FluidDynamics/CauchyFlow/Inviscid.lean @@ -28,6 +28,7 @@ matrix-divergence identity for pressure stress. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/FluidDynamics/CauchyFlow/Momentum.lean b/Physlib/FluidDynamics/CauchyFlow/Momentum.lean index 1e734f1ae0..2bd41c2270 100644 --- a/Physlib/FluidDynamics/CauchyFlow/Momentum.lean +++ b/Physlib/FluidDynamics/CauchyFlow/Momentum.lean @@ -33,6 +33,7 @@ Navier-Stokes. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/FluidDynamics/CauchyFlow/NavierStokes.lean b/Physlib/FluidDynamics/CauchyFlow/NavierStokes.lean index 57150a4593..a2cb9ff36c 100644 --- a/Physlib/FluidDynamics/CauchyFlow/NavierStokes.lean +++ b/Physlib/FluidDynamics/CauchyFlow/NavierStokes.lean @@ -36,6 +36,7 @@ stress law. The Cauchy momentum equation supplies the balance-law layer, while ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/FluidDynamics/CauchyFlow/Newtonian.lean b/Physlib/FluidDynamics/CauchyFlow/Newtonian.lean index 73d793e6f7..b670dac740 100644 --- a/Physlib/FluidDynamics/CauchyFlow/Newtonian.lean +++ b/Physlib/FluidDynamics/CauchyFlow/Newtonian.lean @@ -25,6 +25,7 @@ This module defines the Newtonian constitutive stress law for `CauchyFlow`. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/FluidDynamics/Euler/Basic.lean b/Physlib/FluidDynamics/Euler/Basic.lean index 93d70b0c97..e23739459a 100644 --- a/Physlib/FluidDynamics/Euler/Basic.lean +++ b/Physlib/FluidDynamics/Euler/Basic.lean @@ -31,6 +31,7 @@ the Cauchy stress tensor rather than as a field of the flow data. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/FluidDynamics/FluidFlow/Basic.lean b/Physlib/FluidDynamics/FluidFlow/Basic.lean index f96e1e3465..24202c480b 100644 --- a/Physlib/FluidDynamics/FluidFlow/Basic.lean +++ b/Physlib/FluidDynamics/FluidFlow/Basic.lean @@ -33,6 +33,7 @@ only at the layer where it becomes necessary. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/FluidDynamics/FluidFlow/Continuity.lean b/Physlib/FluidDynamics/FluidFlow/Continuity.lean index af461afdb2..b0fd99f14c 100644 --- a/Physlib/FluidDynamics/FluidFlow/Continuity.lean +++ b/Physlib/FluidDynamics/FluidFlow/Continuity.lean @@ -32,6 +32,7 @@ equation, so they can be reused by Navier-Stokes, Euler, and other fluid models. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/FluidDynamics/FluidFlow/Incompressible.lean b/Physlib/FluidDynamics/FluidFlow/Incompressible.lean index 0a76699b98..dfa192294f 100644 --- a/Physlib/FluidDynamics/FluidFlow/Incompressible.lean +++ b/Physlib/FluidDynamics/FluidFlow/Incompressible.lean @@ -31,6 +31,7 @@ Navier-Stokes, incompressible Euler, and Bernoulli-style developments. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/FluidDynamics/FluidFlow/Kinematics.lean b/Physlib/FluidDynamics/FluidFlow/Kinematics.lean index 009b3d0821..dc0d6f62d0 100644 --- a/Physlib/FluidDynamics/FluidFlow/Kinematics.lean +++ b/Physlib/FluidDynamics/FluidFlow/Kinematics.lean @@ -27,6 +27,7 @@ This module defines basic kinematic scalar quantities associated to `FluidFlow`. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/FluidDynamics/FluidFlow/Momentum.lean b/Physlib/FluidDynamics/FluidFlow/Momentum.lean index 469a3b9fa6..923b2eb877 100644 --- a/Physlib/FluidDynamics/FluidFlow/Momentum.lean +++ b/Physlib/FluidDynamics/FluidFlow/Momentum.lean @@ -33,6 +33,7 @@ force law or stress model, so they can be reused by Navier-Stokes, Euler, and re ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/FluidDynamics/FluidFlow/Newtonian.lean b/Physlib/FluidDynamics/FluidFlow/Newtonian.lean index c34033acd8..8659b4f60e 100644 --- a/Physlib/FluidDynamics/FluidFlow/Newtonian.lean +++ b/Physlib/FluidDynamics/FluidFlow/Newtonian.lean @@ -28,6 +28,7 @@ This module defines the velocity gradient and Newtonian stress tensor associated ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/FluidDynamics/ThermodynamicCauchyFlow/Basic.lean b/Physlib/FluidDynamics/ThermodynamicCauchyFlow/Basic.lean index b63bc45964..01713aa547 100644 --- a/Physlib/FluidDynamics/ThermodynamicCauchyFlow/Basic.lean +++ b/Physlib/FluidDynamics/ThermodynamicCauchyFlow/Basic.lean @@ -31,6 +31,7 @@ unrelated to their statements. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/FluidDynamics/ThermodynamicCauchyFlow/Bernoulli.lean b/Physlib/FluidDynamics/ThermodynamicCauchyFlow/Bernoulli.lean index 4ee5bcc26f..7883b47a61 100644 --- a/Physlib/FluidDynamics/ThermodynamicCauchyFlow/Bernoulli.lean +++ b/Physlib/FluidDynamics/ThermodynamicCauchyFlow/Bernoulli.lean @@ -31,6 +31,7 @@ than defining a separate Bernoulli-flow structure. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/FluidDynamics/ThermodynamicCauchyFlow/Isentropic.lean b/Physlib/FluidDynamics/ThermodynamicCauchyFlow/Isentropic.lean index 0d371c7e90..caf45d45c4 100644 --- a/Physlib/FluidDynamics/ThermodynamicCauchyFlow/Isentropic.lean +++ b/Physlib/FluidDynamics/ThermodynamicCauchyFlow/Isentropic.lean @@ -26,6 +26,7 @@ This module defines the isentropic predicate for thermodynamic Cauchy flows. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/LatticeQFT/Basic.lean b/Physlib/LatticeQFT/Basic.lean new file mode 100644 index 0000000000..ed1ac6bb8c --- /dev/null +++ b/Physlib/LatticeQFT/Basic.lean @@ -0,0 +1,22 @@ +/- +Copyright (c) 2026 Rahul Pamula. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rahul Pamula +-/ +module + +/-! + +# A. Lattice QFT + +This module is a stub and a starting point for lattice QFT. + +## A.1 References + +- External repositories looking at lattice QFT. +- `Physlib.QFT` +- `Physlib.CondensedMatter.LatticeModels` + +-/ + +@[expose] public section diff --git a/Physlib/Mathematics/Calculus/Divergence.lean b/Physlib/Mathematics/Calculus/Divergence.lean index a538a0e6bd..b3ca9890de 100644 --- a/Physlib/Mathematics/Calculus/Divergence.lean +++ b/Physlib/Mathematics/Calculus/Divergence.lean @@ -94,9 +94,9 @@ lemma divergence_prodMk [FiniteDimensional 𝕜 E] [FiniteDimensional 𝕜 F] + divergence 𝕜 (fun y' => g (xy.1,y')) xy.2 := by obtain ⟨s, ⟨bX⟩⟩ := Basis.exists_basis 𝕜 E - haveI : Fintype s := FiniteDimensional.fintypeBasisIndex bX + have : Fintype s := FiniteDimensional.fintypeBasisIndex bX obtain ⟨sY, ⟨bY⟩⟩ := Basis.exists_basis 𝕜 F - haveI : Fintype sY := FiniteDimensional.fintypeBasisIndex bY + have : Fintype sY := FiniteDimensional.fintypeBasisIndex bY let bXY := bX.prod bY rw[divergence_eq_sum_fderiv' bX] rw[divergence_eq_sum_fderiv' bY] @@ -138,5 +138,5 @@ lemma divergence_smul [InnerProductSpace' 𝕜 E] {f : E → 𝕜} {g : E → E} [FiniteDimensional 𝕜 E] : divergence 𝕜 (fun x => f x • g x) x = f x * divergence 𝕜 g x + ⟪adjFDeriv 𝕜 f x 1, g x⟫_𝕜 := by - haveI : CompleteSpace E := FiniteDimensional.complete 𝕜 E + have : CompleteSpace E := FiniteDimensional.complete 𝕜 E simp [divergence, fderiv_fun_smul hf hg, hf.hasAdjFDerivAt.hasAdjoint_fderiv.adjoint_inner_left] diff --git a/Physlib/Mathematics/Calculus/Gradient.lean b/Physlib/Mathematics/Calculus/Gradient.lean new file mode 100644 index 0000000000..ece9e748e6 --- /dev/null +++ b/Physlib/Mathematics/Calculus/Gradient.lean @@ -0,0 +1,139 @@ +/- +Copyright (c) 2026 Aadarsh Agarwal. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Aadarsh Agarwal +-/ +module + +public import Mathlib.Analysis.Calculus.Gradient.Basic +public import Mathlib.Analysis.InnerProductSpace.Calculus +/-! + +# Elementary rules for the gradient + +## i. Overview + +Mathlib defines the gradient `∇ f x` of a real-valued function on a real Hilbert space as the +Riesz representative of its Fréchet derivative, but records no rules for the algebraic operations +on `f` beyond constants. This file collects the elementary rules used throughout the classical +mechanics of Physlib: a gradient is unchanged by adding a constant, it commutes with +multiplication by a constant, the gradient of the quadratic form `⟪y, y⟫` is `2 • y`, and the +gradient of a coordinate functional on Euclidean space is the corresponding basis vector. + +These are the rules needed to differentiate Lagrangians and Hamiltonians of the form +`kinetic − potential` with respect to positions and velocities. + +These are rules for Mathlib's `gradient` on an abstract real Hilbert space. They are distinct from +`Physlib.SpaceAndTime.Space.Derivatives.Grad`, whose `Space.grad` is a coordinate-valued operator on +the structure `Space d`; nothing there applies to `EuclideanSpace ℝ (Fin 1)` or to a general inner +product space. The file is deliberately real: two of its rules (`gradient_const_mul` and +`gradient_inner_self`) are specific to real scalars, so the remaining ones are stated over +`ℝ` as well. + +## ii. Key results + +- `gradient_add_const` : `∇ (f + c) = ∇ f`. +- `gradient_const_mul` : `∇ (c * f) = c • ∇ f` for differentiable `f`. +- `gradient_inner_self` : `∇ (fun y => ⟪y, y⟫) x = 2 • x`. +- `gradient_const_mul_inner_self` : `∇ (fun y => c * ⟪y, y⟫) x = (2 * c) • x`. +- `gradient_coord` : `∇ (fun y => y i) x = EuclideanSpace.single i 1`. +- `gradient_comp_coord` : `∇ (fun y => f (y i)) x = f' • EuclideanSpace.single i 1` when + `HasDerivAt f f' (x i)`. + +## iii. Table of contents + +- A. Gradients and constants +- B. Gradients of quadratic forms +- C. Coordinate functionals on Euclidean space + +## iv. References + +* Mathlib, `Mathlib.Analysis.Calculus.Gradient.Basic`. +-/ + +@[expose] public section + +noncomputable section + +open InnerProductSpace + +variable {F : Type*} [NormedAddCommGroup F] [InnerProductSpace ℝ F] [CompleteSpace F] + +/-! + +## A. Gradients and constants + +Adding a constant does not change the Fréchet derivative, hence not the gradient; multiplying by a +constant scales both. + +-/ + +/-- Adding a constant to a function does not change its gradient. -/ +lemma gradient_add_const {f : F → ℝ} (c : ℝ) (x : F) : + gradient (fun y => f y + c) x = gradient f x := by + unfold gradient + rw [fderiv_add_const] + +/-- The gradient of a constant multiple of a differentiable function is the constant multiple of +the gradient. -/ +lemma gradient_const_mul {f : F → ℝ} {x : F} (c : ℝ) (hf : DifferentiableAt ℝ f x) : + gradient (fun y => c * f y) x = c • gradient f x := by + unfold gradient + rw [fderiv_const_mul hf, map_smul] + +/-! + +## B. Gradients of quadratic forms + +The quadratic form `y ↦ ⟪y, y⟫` has derivative `v ↦ 2 ⟪x, v⟫` at `x`, whose Riesz representative +is `2 • x`. + +-/ + +/-- The gradient of `y ↦ ⟪y, y⟫` at `x` is `2 • x`. -/ +lemma gradient_inner_self (x : F) : gradient (fun y : F => ⟪y, y⟫_ℝ) x = (2 : ℝ) • x := by + refine ext_inner_right (𝕜 := ℝ) fun y => ?_ + unfold gradient + rw [toDual_symm_apply, + fderiv_inner_apply (𝕜 := ℝ) differentiableAt_fun_id differentiableAt_fun_id] + simp [real_inner_comm, inner_smul_right, two_mul] + +/-- The gradient of `y ↦ c * ⟪y, y⟫` at `x` is `(2 * c) • x`. -/ +lemma gradient_const_mul_inner_self (c : ℝ) (x : F) : + gradient (fun y : F => c * ⟪y, y⟫_ℝ) x = (2 * c) • x := by + rw [gradient_const_mul c (differentiableAt_fun_id.inner ℝ differentiableAt_fun_id), + gradient_inner_self, smul_smul, mul_comm] + +/-! + +## C. Coordinate functionals on Euclidean space + +The coordinate functional `y ↦ y i` on `EuclideanSpace ℝ ι` is the continuous linear map +`EuclideanSpace.proj i`, whose Riesz representative is the basis vector `EuclideanSpace.single i 1`. + +-/ + +/-- The gradient of the `i`-th coordinate functional on Euclidean space is the `i`-th basis +vector. -/ +lemma gradient_coord {ι : Type*} [Fintype ι] [DecidableEq ι] (i : ι) (x : EuclideanSpace ℝ ι) : + gradient (fun y : EuclideanSpace ℝ ι => y i) x = EuclideanSpace.single i 1 := by + have h : HasFDerivAt (fun y : EuclideanSpace ℝ ι => y i) + (innerSL ℝ (EuclideanSpace.single i (1 : ℝ))) x := + (EuclideanSpace.proj (𝕜 := ℝ) i).hasFDerivAt.congr_fderiv + (by ext y; simp [EuclideanSpace.inner_single_left]) + exact h.hasGradientAt.gradient.trans ((toDual ℝ _).symm_apply_apply _) + +/-- Chain rule for a function of one coordinate: the gradient of `y ↦ f (y i)` at `x` is +`f' • EuclideanSpace.single i 1`, where `f'` is the derivative of `f` at `x i`. -/ +lemma gradient_comp_coord {ι : Type*} [Fintype ι] [DecidableEq ι] {f : ℝ → ℝ} {f' : ℝ} + (i : ι) (x : EuclideanSpace ℝ ι) (hf : HasDerivAt f f' (x i)) : + gradient (fun y : EuclideanSpace ℝ ι => f (y i)) x = f' • EuclideanSpace.single i 1 := by + have h : HasFDerivAt (fun y : EuclideanSpace ℝ ι => f (y i)) + (innerSL ℝ (f' • EuclideanSpace.single i (1 : ℝ))) x := + (hf.comp_hasFDerivAt x (EuclideanSpace.proj (𝕜 := ℝ) i).hasFDerivAt).congr_fderiv + (by ext y; simp [EuclideanSpace.inner_single_left, smul_eq_mul]) + exact h.hasGradientAt.gradient.trans ((toDual ℝ _).symm_apply_apply _) + +end + +end diff --git a/Physlib/Mathematics/Calculus/Wirtinger/Basic.lean b/Physlib/Mathematics/Calculus/Wirtinger/Basic.lean index 6ba3e9dcc3..31826f3a20 100644 --- a/Physlib/Mathematics/Calculus/Wirtinger/Basic.lean +++ b/Physlib/Mathematics/Calculus/Wirtinger/Basic.lean @@ -132,19 +132,18 @@ of §G. ## iv. References -- Kreutz-Delgado, *The Complex Gradient Operator and the CR-Calculus*, - arXiv:0906.4835 — directional/multivariable formulation and two-term chain - rule (§D); second-order theory behind §G–I. -- Mortini & Rupp, *The Clairaut–Schwarz Theorem for Mixed Wirtinger - Derivatives*, Bull. Iranian Math. Soc. 48 (2022), 2643–2647 — the mixed - holomorphic/anti-holomorphic symmetry of §I under the same `C²` hypothesis, - with the same reduction to real Schwarz used here. -- Koor, Qiu, Kwek & Rebentrost, *A short tutorial on Wirtinger Calculus with - applications in quantum information*, arXiv:2312.04858 — companion - exposition of the scalar single/multivariable calculus and sign conventions. -- *Complex differential form*, Wikipedia (section "The Dolbeault operators") — the - `d = ∂ + ∂̄` splitting and the `∂`/`∂̄` notation this module's operators are named after. - +* Kreutz-Delgado, The Complex Gradient Operator and the CR-Calculus, arXiv:0906.4835 — + directional/multivariable formulation and two-term chain rule (§D); second-order theory behind + §G–I. [ref: kreutz_delgado_cr_calculus] +* Mortini & Rupp, The Clairaut–Schwarz Theorem for Mixed Wirtinger Derivatives, Bull. Iranian + Math. Soc. 48 (2022), 2643–2647 — the mixed holomorphic/anti-holomorphic symmetry of §I under the + same `C²` hypothesis, with the same reduction to real Schwarz used here. [ref: mortini_rupp_2022] +* Koor, Qiu, Kwek & Rebentrost, A short tutorial on Wirtinger Calculus with applications in quantum + information, arXiv:2312.04858 — companion exposition of the scalar single/multivariable calculus + and sign conventions. [ref: koor_et_al_2023_wirtinger] +* Complex differential form, Wikipedia (section "The Dolbeault operators") — the `d = ∂ + ∂̄` + splitting and the `∂`/`∂̄` notation this module's operators are named after. + [ref: wiki_complex_differential_form] -/ @[expose] public section diff --git a/Physlib/Mathematics/DataStructures/Matrix/LieTrace.lean b/Physlib/Mathematics/DataStructures/Matrix/LieTrace.lean index 5abed796b6..537f4b33c9 100644 --- a/Physlib/Mathematics/DataStructures/Matrix/LieTrace.lean +++ b/Physlib/Mathematics/DataStructures/Matrix/LieTrace.lean @@ -153,7 +153,7 @@ lemma det_exp_of_blockTriangular_id {A : Matrix m m 𝕂} (hA : BlockTriangular (NormedSpace.exp A).det = NormedSpace.exp A.trace := by have h_exp_upper : BlockTriangular (NormedSpace.exp A) id := blockTriangular_exp_of_blockTriangular_id hA - rw [det_of_upperTriangular h_exp_upper] + rw [det_of_isUpperTriangular h_exp_upper] have h_diag_exp : (NormedSpace.exp A).diag = fun i => NormedSpace.exp (A i i) := diag_exp_of_blockTriangular_id hA simp_rw [← diag_apply] @@ -229,18 +229,17 @@ end Matrix namespace NormedSpace -set_option backward.isDefEq.respectTransparency false in lemma exp_map_algebraMap {n : Type*} [Fintype n] [DecidableEq n] (A : Matrix n n ℝ) : (exp A).map (algebraMap ℝ ℂ) = exp (A.map (algebraMap ℝ ℂ)) := by - letI : SeminormedRing (Matrix n n ℝ) := Matrix.linftyOpSemiNormedRing - letI : NormedRing (Matrix n n ℝ) := Matrix.linftyOpNormedRing - letI : NormedAlgebra ℝ (Matrix n n ℝ) := Matrix.linftyOpNormedAlgebra - letI : CompleteSpace (Matrix n n ℝ) := inferInstance - letI : SeminormedRing (Matrix n n ℂ) := Matrix.linftyOpSemiNormedRing - letI : NormedRing (Matrix n n ℂ) := Matrix.linftyOpNormedRing - letI : NormedAlgebra ℂ (Matrix n n ℂ) := Matrix.linftyOpNormedAlgebra - letI : CompleteSpace (Matrix n n ℂ) := inferInstance + let : SeminormedRing (Matrix n n ℝ) := Matrix.linftyOpSemiNormedRing + let : NormedRing (Matrix n n ℝ) := Matrix.linftyOpNormedRing + let : NormedAlgebra ℝ (Matrix n n ℝ) := Matrix.linftyOpNormedAlgebra + let : CompleteSpace (Matrix n n ℝ) := inferInstance + let : SeminormedRing (Matrix n n ℂ) := Matrix.linftyOpSemiNormedRing + let : NormedRing (Matrix n n ℂ) := Matrix.linftyOpNormedRing + let : NormedAlgebra ℂ (Matrix n n ℂ) := Matrix.linftyOpNormedAlgebra + let : CompleteSpace (Matrix n n ℂ) := inferInstance simp only [exp_eq_tsum ℝ] have hs : Summable (fun k => (k.factorial : ℝ)⁻¹ • A ^ k) := by exact NormedSpace.expSeries_summable' A @@ -262,7 +261,7 @@ theorem det_exp_real {n : Type*} [Fintype n] [LinearOrder n] (A : Matrix n n ℝ) : (NormedSpace.exp A).det = Real.exp A.trace := by let A_ℂ := A.map (algebraMap ℝ ℂ) have h_complex : (NormedSpace.exp A_ℂ).det = Complex.exp A_ℂ.trace := by - haveI : IsAlgClosed ℂ := Complex.isAlgClosed + have : IsAlgClosed ℂ := Complex.isAlgClosed rw [Complex.exp_eq_exp_ℂ, ← Matrix.det_exp] have h_trace_comm : A_ℂ.trace = (algebraMap ℝ ℂ) A.trace := by simp only [A_ℂ, trace, diag_map, map_sum];rfl diff --git a/Physlib/Mathematics/Distribution/Basic.lean b/Physlib/Mathematics/Distribution/Basic.lean index 6188fc9877..80cbd1a014 100644 --- a/Physlib/Mathematics/Distribution/Basic.lean +++ b/Physlib/Mathematics/Distribution/Basic.lean @@ -486,8 +486,8 @@ private lemma integral_boundedContinuous_eq_of_forall_schwartz_integral_eq (f : BoundedContinuousFunction E ℂ) : ∫ x, f x ∂μ = ∫ x, f x ∂ν := by let ρ : Measure E := μ + ν - haveI : IsFiniteMeasure ρ := inferInstance - haveI : ρ.HasTemperateGrowth := inferInstance + have : IsFiniteMeasure ρ := inferInstance + have : ρ.HasTemperateGrowth := inferInstance let L : 𝓢(E, ℂ) →L[ℝ] Lp ℂ 1 ρ := SchwartzMap.toLpCLM ℝ ℂ 1 ρ let toL1 : BoundedContinuousFunction E ℂ →L[ℝ] Lp ℂ 1 ρ := @@ -624,7 +624,7 @@ def heavisideStep (d : ℕ) : (EuclideanSpace ℝ (Fin d.succ)) →d[ℝ] ℝ := · intro a η simp only [smul_apply, RingHom.id_apply] rw [MeasureTheory.integral_smul] - haveI hμ : (volume (α := EuclideanSpace ℝ (Fin d.succ))).HasTemperateGrowth := by + have hμ : (volume (α := EuclideanSpace ℝ (Fin d.succ))).HasTemperateGrowth := by infer_instance rcases hμ.exists_integrable with ⟨n, h⟩ let m := (n, 0) diff --git a/Physlib/Mathematics/Distribution/PowMul.lean b/Physlib/Mathematics/Distribution/PowMul.lean index 2feed10a9f..8a631828e9 100644 --- a/Physlib/Mathematics/Distribution/PowMul.lean +++ b/Physlib/Mathematics/Distribution/PowMul.lean @@ -43,7 +43,6 @@ lemma norm_iteratedFDeriv_ofRealCLM {x} (i : ℕ) : rw [← norm_iteratedFDeriv_fderiv, h, iteratedFDeriv_const_of_ne n.succ_ne_zero] simp -set_option backward.isDefEq.respectTransparency false in /-- The continuous linear map `𝓢(ℝ, 𝕜) →L[𝕜] 𝓢(ℝ, 𝕜)` taking a Schwartz map `η` to `x * η`. -/ def powOneMul : 𝓢(ℝ, 𝕜) →L[𝕜] 𝓢(ℝ, 𝕜) := by diff --git a/Physlib/Mathematics/Fin.lean b/Physlib/Mathematics/Fin.lean index e89b8d3a52..d78163eadb 100644 --- a/Physlib/Mathematics/Fin.lean +++ b/Physlib/Mathematics/Fin.lean @@ -22,7 +22,7 @@ in Mathlib. @[expose] public section namespace Physlib.Fin -open Fin +open _root_.Physlib.Fin variable {n : Nat} /-- Given a `i` and `x` in `Fin n.succ.succ` returns an element of `Fin n.succ` @@ -86,7 +86,7 @@ def finExtractOne {n : ℕ} (i : Fin (n + 1)) : Fin (n + 1) ≃ Fin 1 ⊕ Fin n @[simp] lemma finExtractOne_apply_eq {n : ℕ} (i : Fin n.succ) : finExtractOne i i = Sum.inl 0 := by - rw [Equiv.apply_eq_iff_eq_symm_apply] + rw [← Equiv.eq_symm_apply] rfl lemma finExtractOne_symm_inr {n : ℕ} (i : Fin n.succ) : diff --git a/Physlib/Mathematics/Geometry/Metric/PseudoRiemannian/Defs.lean b/Physlib/Mathematics/Geometry/Metric/PseudoRiemannian/Defs.lean index 3d4ee282cb..aa6de38d2a 100644 --- a/Physlib/Mathematics/Geometry/Metric/PseudoRiemannian/Defs.lean +++ b/Physlib/Mathematics/Geometry/Metric/PseudoRiemannian/Defs.lean @@ -44,11 +44,12 @@ on tangent spaces, varying smoothly over the manifold. This pragmatic choice all development while acknowledging that a more abstract ideal would involve defining metrics as sections of a tensor bundle (e.g., `Hom(TM ⊗ TM, ℝ)` or `TM →L[ℝ] TM →L[ℝ] ℝ`. -## Reference +## References -* Barrett O'Neill, "Semi-Riemannian Geometry With Applications to Relativity" (Academic Press, 1983) -* [Discussion on Zulip about (Pseudo) Riemannian metrics] https. -leanprover.zulipchat.com/#narrow/channel/113488-general/topic/.28Pseudo.29.20Riemannian.20metric +* Barrett O'Neill, Semi-Riemannian Geometry With Applications to Relativity, Academic Press, 1983. + [ref: oneill_1983_semi_riemannian] +* Discussion on Zulip about (Pseudo) Riemannian metrics: + https://leanprover.zulipchat.com/#narrow/channel/113488-general/topic/.28Pseudo.29.20Riemannian.20metric -/ @[expose] public section @@ -144,7 +145,7 @@ lemma posDef_no_neg_weights {E : Type*} [AddCommGroup E] [Module ℝ E] theorem rankNeg_eq_zero {E : Type*} [AddCommGroup E] [Module ℝ E] [FiniteDimensional ℝ E] {q : QuadraticForm ℝ E} (hq : q.PosDef) : q.negDim = 0 := by - haveI : Invertible (2 : ℝ) := inferInstance + have : Invertible (2 : ℝ) := inferInstance unfold QuadraticForm.negDim have h_exists := equivalent_signType_weighted_sum_squared q let w := Classical.choose h_exists @@ -347,8 +348,8 @@ lemma flatL_inj (g : PseudoRiemannianMetric E H M n I) (x : M) : lemma flatL_surj (g : PseudoRiemannianMetric E H M n I) (x : M) : Function.Surjective (g.flatL x) := by - haveI : FiniteDimensional ℝ (TangentSpace I x) := inst_tangent_findim x - haveI : T2Space (TangentSpace I x) := inferInstanceAs (T2Space E) + have : FiniteDimensional ℝ (TangentSpace I x) := inst_tangent_findim x + have : T2Space (TangentSpace I x) := inferInstanceAs (T2Space E) have h_finrank_eq : finrank ℝ (TangentSpace I x) = finrank ℝ (TangentSpace I x →L[ℝ] ℝ) := Subspace.dual_finrank_eq.symm.trans (LinearMap.toContinuousLinearMap (𝕜 := ℝ) (E := TangentSpace I x) (F' := ℝ)).finrank_eq diff --git a/Physlib/Mathematics/Geometry/Metric/Riemannian/Defs.lean b/Physlib/Mathematics/Geometry/Metric/Riemannian/Defs.lean index 0e46651d26..a588dc5b3e 100644 --- a/Physlib/Mathematics/Geometry/Metric/Riemannian/Defs.lean +++ b/Physlib/Mathematics/Geometry/Metric/Riemannian/Defs.lean @@ -171,7 +171,7 @@ example (g : RiemannianMetric I n M) (x : M) (v : TangentSpace I x) : -- Example showing how to use the metric inner product space example (g : RiemannianMetric I n M) (x : M) (v w : TangentSpace I x) : (TangentSpace.metricInnerProductSpace g x).inner v w = g.inner x v w := by - letI := TangentSpace.metricInnerProductSpace g x + let := TangentSpace.metricInnerProductSpace g x rfl /-- Helper function to compute the norm on a tangent space from a Riemannian metric, diff --git a/Physlib/Mathematics/HasTemperateGrowth.lean b/Physlib/Mathematics/HasTemperateGrowth.lean new file mode 100644 index 0000000000..5ab893702e --- /dev/null +++ b/Physlib/Mathematics/HasTemperateGrowth.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2026 Gregory J. Loges. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gregory J. Loges +-/ +module + +public import Mathlib.Analysis.Distribution.TemperateGrowth +/-! + +# Functions of temperate growth + +This file is intended to collect useful general properties of `HasTemperateGrowth` which are not +(yet) in Mathlib. + +-/ +@[expose] public section + +namespace Function.HasTemperateGrowth + +open Finset + +/-- The finite product of functions of temperate growth is again of temperate growth. -/ +@[to_fun (attr := fun_prop)] +lemma prod {ι : Type*} {s : Finset ι} {E F : Type*} [NormedAddCommGroup E] + [NormedSpace ℝ E] [NormedCommRing F] [NormedAlgebra ℝ F] {f : ι → E → F} + (hf : ∀ i ∈ s, HasTemperateGrowth (f i)) : HasTemperateGrowth (∏ i ∈ s, f i) := by + classical + induction s using Finset.induction_on with + | empty => exact const _ + | insert j t hjt ih => + simp_rw [insert_eq, prod_union (disjoint_singleton_left.mpr hjt), prod_singleton] + exact fun_mul (hf j <| mem_insert_self j t) (ih fun i h ↦ hf i <| mem_insert_of_mem h) + +end Function.HasTemperateGrowth diff --git a/Physlib/Mathematics/InnerProductSpace/Gaussian.lean b/Physlib/Mathematics/InnerProductSpace/Gaussian.lean index e75ad8d4b2..ff9e3f1fe2 100644 --- a/Physlib/Mathematics/InnerProductSpace/Gaussian.lean +++ b/Physlib/Mathematics/InnerProductSpace/Gaussian.lean @@ -47,6 +47,7 @@ For some relevant Gaussian integrals see ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/Mathematics/KroneckerDelta/Basic.lean b/Physlib/Mathematics/KroneckerDelta/Basic.lean index d9bcb36703..c4ef1e23a1 100644 --- a/Physlib/Mathematics/KroneckerDelta/Basic.lean +++ b/Physlib/Mathematics/KroneckerDelta/Basic.lean @@ -36,6 +36,7 @@ determinant of a matrix of Kronecker deltas. ## iv. References +* None. -/ @[expose] public section @@ -195,11 +196,22 @@ This is one row transposition of the underlying determinant. -/ lemma generalizedKroneckerDelta_swap {α ι : Type} [DecidableEq α] [DecidableEq ι] [Fintype ι] (μ ν : ι → α) {i j : ι} (hij : i ≠ j) : generalizedKroneckerDelta (μ ∘ Equiv.swap i j) ν = - generalizedKroneckerDelta μ ν := by - rw [show generalizedKroneckerDelta (μ ∘ Equiv.swap i j) ν - = (Matrix.submatrix (fun a b => ((kroneckerDelta (μ a) (ν b) : ℕ) : ℤ)) - (Equiv.swap i j) id).det from rfl, - Matrix.det_permute, Equiv.Perm.sign_swap hij] - simp [generalizedKroneckerDelta] + show (Matrix.submatrix (Matrix.of fun a b => ((kroneckerDelta (μ a) (ν b) : ℕ) : ℤ)) + (Equiv.swap i j) id).det + = -(Matrix.of fun a b => ((kroneckerDelta (μ a) (ν b) : ℕ) : ℤ)).det + rw [Matrix.det_permute, Equiv.Perm.sign_swap hij] + simp + +/-- Simultaneously reindexing the upper and lower slots of a generalized Kronecker delta by the +same permutation leaves it unchanged. -/ +@[simp] +lemma generalizedKroneckerDelta_comp_perm {α ι : Type} [DecidableEq α] [DecidableEq ι] + [Fintype ι] (μ ν : ι → α) (e : Equiv.Perm ι) : + generalizedKroneckerDelta (μ ∘ e) (ν ∘ e) = generalizedKroneckerDelta μ ν := by + show (Matrix.submatrix + (Matrix.of fun i j => ((kroneckerDelta (μ i) (ν j) : ℕ) : ℤ)) e e).det = + (Matrix.of fun i j => ((kroneckerDelta (μ i) (ν j) : ℕ) : ℤ)).det + exact Matrix.det_submatrix_equiv_self e _ end Generalized diff --git a/Physlib/Mathematics/KroneckerDelta/Contraction.lean b/Physlib/Mathematics/KroneckerDelta/Contraction.lean index 881fc0ef09..fed4e3ddda 100644 --- a/Physlib/Mathematics/KroneckerDelta/Contraction.lean +++ b/Physlib/Mathematics/KroneckerDelta/Contraction.lean @@ -36,8 +36,8 @@ matrix determinant lemma when `det A` is a unit and Kronecker-delta matrices are - `generalizedKroneckerDelta_sum_snoc` : summing over one shared index lowers the rank by one. - `sum_generalizedKroneckerDelta_mul_self`, `sum_generalizedKroneckerDelta_mul_cons`, - `sum_generalizedKroneckerDelta_mul_cons₂` : the fully-, singly-, and doubly-free symbol-level - contractions over `Fin 4`. + `sum_generalizedKroneckerDelta_mul_snoc`, `sum_generalizedKroneckerDelta_mul_cons₂` : the + fully-, singly-, and doubly-free symbol-level contractions over `Fin 4`. ## iii. Table of contents @@ -46,6 +46,7 @@ matrix determinant lemma when `det A` is a unit and Kronecker-delta matrices are ## iv. References +* None. -/ @[expose] public section @@ -309,6 +310,23 @@ lemma sum_generalizedKroneckerDelta_mul_cons (σ τ : Fin 4) : sum_generalizedKroneckerDelta_cons σ τ 3] norm_num [Finset.prod_range_succ] +/-- Symbol-level triple contraction with the free index in the last slot. -/ +lemma sum_generalizedKroneckerDelta_mul_snoc (σ τ : Fin 4) : + ∑ h : Fin 3 → Fin 4, + generalizedKroneckerDelta (Fin.snoc h σ) id * generalizedKroneckerDelta (Fin.snoc h τ) id = + 6 * ((kroneckerDelta σ τ : ℕ) : ℤ) := by + rw [Finset.sum_congr rfl fun h _ => generalizedKroneckerDelta_mul (Fin.snoc h σ) (Fin.snoc h τ)] + have hrotate (h : Fin 3 → Fin 4) : + generalizedKroneckerDelta (Fin.snoc h σ) (Fin.snoc h τ) = + generalizedKroneckerDelta (Fin.cons σ h) (Fin.cons τ h) := by + rw [Fin.snoc_eq_cons_rotate, Fin.snoc_eq_cons_rotate] + change generalizedKroneckerDelta ((Fin.cons σ h) ∘ finRotate (3 + 1)) + ((Fin.cons τ h) ∘ finRotate (3 + 1)) = + generalizedKroneckerDelta (Fin.cons σ h) (Fin.cons τ h) + exact generalizedKroneckerDelta_comp_perm _ _ _ + rw [Finset.sum_congr rfl fun h _ => hrotate h, sum_generalizedKroneckerDelta_cons σ τ 3] + norm_num [Finset.prod_range_succ] + /-- Symbol-level double contraction, two free pairs. -/ lemma sum_generalizedKroneckerDelta_mul_cons₂ (ρ σ τ ω : Fin 4) : ∑ h : Fin 2 → Fin 4, diff --git a/Physlib/Mathematics/LeviCivita/Basic.lean b/Physlib/Mathematics/LeviCivita/Basic.lean index 90aa1925b8..d92afc37cc 100644 --- a/Physlib/Mathematics/LeviCivita/Basic.lean +++ b/Physlib/Mathematics/LeviCivita/Basic.lean @@ -42,8 +42,7 @@ permutation via `Matrix.det_permutation`. ## iv. References -- https://en.wikipedia.org/wiki/Levi-Civita_symbol - +* https://en.wikipedia.org/wiki/Levi-Civita_symbol. [ref: wiki_levi_civita_symbol] -/ @[expose] public section @@ -109,6 +108,7 @@ lemma leviCivitaSymbol_comp_swap (g : ι → ι) {i j : ι} (hij : i ≠ j) : leviCivitaSymbol (g ∘ Equiv.swap i j) = - leviCivitaSymbol g := generalizedKroneckerDelta_swap g id hij +set_option backward.isDefEq.respectTransparency false in /-- The Levi-Civita symbol is antisymmetric under transposition of two index values: postcomposing with the swap of two distinct values exchanges those two values wherever they occur and negates it. -/ diff --git a/Physlib/Mathematics/LinearPMap.lean b/Physlib/Mathematics/LinearPMap.lean index 5c7bf3ee08..c28b8e2079 100644 --- a/Physlib/Mathematics/LinearPMap.lean +++ b/Physlib/Mathematics/LinearPMap.lean @@ -41,6 +41,7 @@ composition of partial linear maps while having the domain implicitly accounted ## iv. References +* None. -/ @[expose] public section @@ -157,8 +158,8 @@ lemma sum_domain : (sum f).domain = ⨅ a, (f a).domain := rfl lemma sum_domain_le (a : α) : (sum f).domain ≤ (f a).domain := fun _ _ ↦ by simp_all [sum, mem_iInf] @[simp] -lemma sum_apply (ψ : (sum f).domain) : sum f ψ = ∑ a, f a ⟨ψ, sum_domain_le f a ψ.2⟩ := by - simp [sum, inclusion_apply] +lemma sum_apply (ψ : (sum f).domain) : sum f ψ = ∑ a, f a ⟨ψ, sum_domain_le f a ψ.2⟩ := + LinearMap.sum_apply Finset.univ (fun a ↦ (f a).toFun ∘ₗ inclusion (sum_domain_le f a)) ψ end Sums @@ -176,9 +177,9 @@ variable {v : F →ₗ.[R] G} {u : E →ₗ.[R] F} `x : f.domain` for which `f x ∈ g.domain`. -/ def compRestricted : E →ₗ.[R] G := g.comp (f.domRestrict <| (g.domain.comap f.toFun).map f.domain.subtype) (by - intro ⟨x, h, _⟩ - simp only [map_coe, subtype_apply, comap_coe, Set.mem_image, Set.mem_preimage, - toFun_eq_coe, SetLike.mem_coe] at h + intro x + have h : (x : E) ∈ (g.domain.comap f.toFun).map f.domain.subtype := x.2.1 + simp only [mem_map, mem_comap, toFun_eq_coe, subtype_apply] at h obtain ⟨y, hy, hy'⟩ := h rw [domRestrict_apply hy'.symm] exact hy) diff --git a/Physlib/Mathematics/List.lean b/Physlib/Mathematics/List.lean index a127fde8c2..741ef44a0d 100644 --- a/Physlib/Mathematics/List.lean +++ b/Physlib/Mathematics/List.lean @@ -16,7 +16,7 @@ public section namespace Physlib.List -open Fin +open _root_.Physlib.Fin open Physlib variable {n : Nat} @@ -143,7 +143,6 @@ lemma orderedInsertPos_sigma {I : Type} {f : I → Type} simp_all only split <;> simp_all -set_option backward.isDefEq.respectTransparency false in lemma orderedInsert_get_lt {I : Type} (le1 : I → I → Prop) [DecidableRel le1] (r : List I) (r0 : I) (i : ℕ) (hi : i < orderedInsertPos le1 r r0) : @@ -321,7 +320,8 @@ lemma orderedInsertEquiv_succ {I : Type} (le1 : I → I → Prop) [DecidableRel simp only [List.length_cons, orderedInsertEquiv, Nat.succ_eq_add_one, Equiv.trans_apply] match r with | [] => - simp + simp only [List.length_cons, List.length_nil] at hn + omega | r1 :: r => simp only [List.length_cons] rw [finExtractOne_apply_neq] @@ -338,7 +338,7 @@ lemma orderedInsertEquiv_fin_succ {I : Type} (le1 : I → I → Prop) [Decidable simp only [orderedInsertEquiv, Equiv.trans_apply] match r with | [] => - simp + exact n.elim0 | r1 :: r => simp only [List.length_cons, Fin.eta] rw [finExtractOne_apply_neq] @@ -567,15 +567,13 @@ lemma insertionSortEquiv_order {α : Type} {r : α → α → Prop} [DecidableRe simp only [List.length_cons, Fin.zero_eta, Fin.getElem_fin, Fin.val_zero, List.getElem_cons_zero, List.getElem_cons_succ] nth_rewrite 2 [insertionSortEquiv] at hij' - simp only [List.length_cons, Nat.succ_eq_add_one, Fin.zero_eta, - Equiv.trans_apply, equivCons_zero] at hij' + simp only [List.length_cons, Nat.succ_eq_add_one, Fin.zero_eta] at hij' convert lt_orderedInsertPos_rel_fin r a (List.insertionSort r as) _ hij' change _ = ((List.insertionSort r (a :: as))).get ((insertionSortEquiv r (a :: as)) ⟨j + 1, hj⟩) rw [← insertionSortEquiv_get] simp | a :: as, ⟨i + 1, hi⟩, ⟨j + 1, hj⟩, hij, hij' => by - simp only [List.length_cons, insertionSortEquiv, Nat.succ_eq_add_one, Equiv.trans_apply, - equivCons_succ] at hij' + simp only [List.length_cons, insertionSortEquiv, Nat.succ_eq_add_one] at hij' simpa using insertionSortEquiv_order as ⟨i, Nat.succ_lt_succ_iff.mp hi⟩ ⟨j, Nat.succ_lt_succ_iff.mp hj⟩ (by simpa using hij) (orderedInsertEquiv_monotone_fin_succ _ _ _ _ _ hij') diff --git a/Physlib/Mathematics/List/InsertionSort.lean b/Physlib/Mathematics/List/InsertionSort.lean index 2e298e4a8b..0eda43b814 100644 --- a/Physlib/Mathematics/List/InsertionSort.lean +++ b/Physlib/Mathematics/List/InsertionSort.lean @@ -15,7 +15,7 @@ import all Physlib.Mathematics.List namespace Physlib.List -open Fin +open _root_.Physlib.Fin open Physlib variable {n : Nat} @@ -51,10 +51,11 @@ lemma insertionSortEquiv_gt_zero_of_ne_insertionSortMinPos {α : Type} (r : α ⟨0, by simp [List.orderedInsert_length]⟩ < insertionSortEquiv r (a :: l) k := by by_contra hn simp only [List.length_cons, not_lt] at hn - refine hk ((Equiv.apply_eq_iff_eq_symm_apply (insertionSortEquiv r (a :: l))).mp ?_) + refine hk ((Equiv.eq_symm_apply (insertionSortEquiv r (a :: l))).mpr ?_) simp_all only [List.length_cons, ne_eq, Fin.le_def, nonpos_iff_eq_zero] exact Fin.ext hn +set_option backward.isDefEq.respectTransparency false in lemma insertionSortMin_lt_mem_insertionSortDropMinPos_of_lt {α : Type} (r : α → α → Prop) [DecidableRel r] (a : α) (l : List α) (i : Fin (insertionSortDropMinPos r a l).length) diff --git a/Physlib/Mathematics/OneParameterSubgroups/Basic.lean b/Physlib/Mathematics/OneParameterSubgroups/Basic.lean new file mode 100644 index 0000000000..3b9ae59a6c --- /dev/null +++ b/Physlib/Mathematics/OneParameterSubgroups/Basic.lean @@ -0,0 +1,186 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Mathlib.Analysis.Calculus.Deriv.Shift +public import Mathlib.Analysis.Calculus.MeanValue +public import Mathlib.Analysis.SpecialFunctions.Exponential +public import Mathlib.MeasureTheory.Integral.IntervalIntegral.FundThmCalculus + +/-! + +# One-parameter subgroups of real Banach algebras + +## i. Overview + +Let `E` be a real Banach algebra. This file proves that every continuous additive character +`U : AddChar ℝ E` has the form `U(t) = exp (t • A)`, where `A = deriv U 0`. + +This is the Banach-algebra argument underlying the correspondence between norm-continuous unitary +one-parameter groups and bounded self-adjoint generators. See +`Physlib.Mathematics.OneParameterSubgroups.Unitary` for that correspondence. + +**Proof outline.** Continuity at zero implies that, for sufficiently small `d > 0`, the integral of +`U` over `[0, d]` is close to `d • 1` and therefore invertible. If `I` is the indefinite integral of +`U`, the homomorphism law gives `U(t) * I(d) = I(t + d) - I(t)`. This identity proves that `U` is +differentiable. Setting `A` to the derivative at zero then gives the differential equation +`U'(t) = U(t)A`. Consequently `U(t) * exp (-tA)` has zero derivative and is constant. Uniqueness +follows by differentiating two exponential representations at zero. + +## ii. Key results + +* `OneParameterSubgroup.apply_eq_exp_smul_deriv`: A continuous one-parameter subgroup is the + exponential of its derivative at zero. +* `OneParameterSubgroup.generator_unique`: Any exponential generator equals the derivative at zero. + +## iii. References + +* None. +-/ + +@[expose] public section + +open Filter Topology + +noncomputable section + +namespace OneParameterSubgroup + +variable {E : Type*} [NormedRing E] [NormedAlgebra ℝ E] [CompleteSpace E] + +/-- `NormedSpace.exp`'s API wants a `ℚ`-algebra structure (for the `1/n!` coefficients), which +isn't automatic from `NormedAlgebra ℝ E` alone; derive it once here rather than at each use site. -/ +local instance : NormedAlgebra ℚ E := .restrictScalars ℚ ℝ E + +lemma exists_isUnit_intervalIntegral [Nontrivial E] (U : AddChar ℝ E) (hU : Continuous U) : + ∃ d : ℝ, 0 < d ∧ IsUnit (∫ x in (0 : ℝ)..d, U x) := by + have hone : 0 < ‖(1 : E)‖ := norm_pos_iff.mpr one_ne_zero + have hevent : ∀ᶠ x : ℝ in 𝓝 0, ‖U x - 1‖ < ‖(1 : E)‖⁻¹ / 2 := by + have hmem : Set.Iio (‖(1 : E)‖⁻¹ / 2) ∈ 𝓝 ‖U 0 - 1‖ := by + simpa using Iio_mem_nhds (by positivity : 0 < ‖(1 : E)‖⁻¹ / 2) + exact (continuous_norm.comp (hU.sub continuous_const)).continuousAt hmem + obtain ⟨r, hr, hrU⟩ := Metric.eventually_nhds_iff.mp hevent + let d := r / 2 + have hd : 0 < d := by positivity + let q : Eˣ := { + val := d • 1 + inv := d⁻¹ • 1 + val_inv := by rw [smul_mul_smul_comm, mul_inv_cancel₀ hd.ne', one_smul, one_mul] + inv_val := by rw [smul_mul_smul_comm, inv_mul_cancel₀ hd.ne', one_smul, one_mul] } + refine ⟨d, hd, (Units.ofNearby q _ ?_).isUnit⟩ + calc + _ = ‖(∫ x in (0 : ℝ)..d, U x) - d • (1 : E)‖ := rfl + _ = ‖(∫ x in (0 : ℝ)..d, U x) - ∫ _x in (0 : ℝ)..d, (1 : E)‖ := by + rw [intervalIntegral.integral_const, sub_zero] + _ = ‖∫ x in (0 : ℝ)..d, (U x - 1)‖ := by + rw [intervalIntegral.integral_sub (hU.intervalIntegrable 0 d) + (continuous_const.intervalIntegrable 0 d)] + _ ≤ (‖(1 : E)‖⁻¹ / 2) * |d - 0| := + intervalIntegral.norm_integral_le_of_norm_le_const (fun x hx => by + apply le_of_lt + apply hrU + rw [Real.dist_0_eq_abs] + rw [Set.uIoc_of_le hd.le] at hx + rw [abs_of_nonneg hx.1.le] + exact hx.2.trans_lt (by dsimp [d]; linarith)) + _ = (‖(1 : E)‖⁻¹ / 2) * d := by rw [sub_zero, abs_of_pos hd] + _ < d * ‖(1 : E)‖⁻¹ := by nlinarith [inv_pos.mpr hone] + _ = ‖q.inv‖⁻¹ := by simp [q, norm_smul, mul_comm, abs_of_pos hd] + + +/-- Translating a one-parameter subgroup translates its interval integral. -/ +lemma mul_intervalIntegral_eq_sub (U : AddChar ℝ E) (hU : Continuous U) (s t : ℝ) : + U s * ∫ x in (0 : ℝ)..t, U x = + (∫ x in (0 : ℝ)..(s + t), U x) - ∫ x in (0 : ℝ)..s, U x := by + let L : E →L[ℝ] E := + (LinearMap.mulLeft ℝ (U s)).mkContinuous ‖U s‖ (fun x => norm_mul_le _ _) + calc + _ = L (∫ x in (0 : ℝ)..t, U x) := rfl + _ = ∫ x in (0 : ℝ)..t, L (U x) := + (L.intervalIntegral_comp_comm (hU.intervalIntegrable 0 t)).symm + _ = ∫ x in (0 : ℝ)..t, U (s + x) := by + apply intervalIntegral.integral_congr + intro x _ + exact (U.map_add_eq_mul s x).symm + _ = ∫ x in s..(s + t), U x := by + rw [intervalIntegral.integral_comp_add_left, add_zero] + _ = (∫ x in (0 : ℝ)..(s + t), U x) - ∫ x in (0 : ℝ)..s, U x := by + rw [eq_sub_iff_add_eq, add_comm] + exact intervalIntegral.integral_add_adjacent_intervals + (hU.intervalIntegrable 0 s) (hU.intervalIntegrable s (s + t)) + +lemma differentiable [Nontrivial E] (U : AddChar ℝ E) (hU : Continuous U) : + Differentiable ℝ U := by + obtain ⟨d, _, hV⟩ := exists_isUnit_intervalIntegral U hU + let V : E := ∫ x in (0 : ℝ)..d, U x + let v : Eˣ := hV.unit + have hv : (v : E) = V := hV.unit_spec + let F : ℝ → E := fun t => ∫ x in (0 : ℝ)..t, U x + have hF (t : ℝ) : HasDerivAt F (U t) t := + (hU.integral_hasStrictDerivAt 0 t).hasDerivAt + have htranslate (t : ℝ) : U t * V = F (t + d) - F t := + mul_intervalIntegral_eq_sub U hU t d + intro t + have hR : HasDerivAt (fun s : ℝ => F (s + d) - F s) + (U (t + d) - U t) t := by + exact (HasDerivAt.comp_add_const t d (hF (t + d))).sub (hF t) + have heq : U = fun s : ℝ => (F (s + d) - F s) * (↑v⁻¹ : E) := by + funext s + calc + U s = (U s * (v : E)) * (↑v⁻¹ : E) := by simp + _ = (F (s + d) - F s) * (↑v⁻¹ : E) := by rw [hv, htranslate] + rw [heq] + exact (hR.mul_const (↑v⁻¹ : E)).differentiableAt + +lemma apply_eq_exp_smul_deriv (U : AddChar ℝ E) (hU : Continuous U) (t : ℝ) : + U t = NormedSpace.exp (t • deriv U 0) := by + cases subsingleton_or_nontrivial E with + | inl _ => exact Subsingleton.elim _ _ + | inr _ => + have hdiff : Differentiable ℝ U := differentiable U hU + let A : E := deriv U 0 + have hUderiv (t : ℝ) : HasDerivAt U (U t * A) t := by + have ht : HasDerivAt U (deriv U t) t := + hdiff.differentiableAt.hasDerivAt + have h0 : HasDerivAt U (deriv U 0) 0 := + hdiff.differentiableAt.hasDerivAt + have hleft : HasDerivAt (fun s : ℝ => U (t + s)) (deriv U t) 0 := + HasDerivAt.comp_const_add t 0 (by simpa using ht) + have hright : HasDerivAt (fun s : ℝ => U t * U s) (U t * A) 0 := by + dsimp only [A] + exact HasDerivAt.const_mul (U t) h0 + have heq : (fun s : ℝ => U (t + s)) = fun s : ℝ => U t * U s := by + funext s + exact U.map_add_eq_mul t s + have hder : deriv U t = U t * A := hleft.unique (heq ▸ hright) + rwa [← hder] + let G : ℝ → E := fun t => U t * NormedSpace.exp (t • (-A)) + have hG : Differentiable ℝ G := fun t => + ((hUderiv t).mul (hasDerivAt_exp_smul_const (-A) t)).differentiableAt + have hGder (t : ℝ) : deriv G t = 0 := by + apply ((hUderiv t).mul (hasDerivAt_exp_smul_const (-A) t)).deriv.trans + have hcomm : Commute A (NormedSpace.exp (t • (-A))) := by + exact ((Commute.refl A).neg_right.smul_right t).exp_right + rw [mul_assoc, hcomm.eq] + noncomm_ring + have hconst (t : ℝ) : G t = G 0 := is_const_of_deriv_eq_zero hG hGder t 0 + have hone : U t * Ring.inverse (NormedSpace.exp (t • A)) = 1 := by + simpa [G, ← Ring.inverse_exp] using hconst t + have hexp : IsUnit (NormedSpace.exp (t • A)) := NormedSpace.isUnit_exp (t • A) + let e : Eˣ := hexp.unit + have he : (e : E) = NormedSpace.exp (t • A) := hexp.unit_spec + rw [← he, Ring.inverse_unit] at hone + calc + U t = (U t * (↑e⁻¹ : E)) * (e : E) := by simp + _ = NormedSpace.exp (t • A) := by + rw [hone, one_mul, he] + +/-- Any exponential generator of a one-parameter subgroup is its derivative at zero. -/ +lemma generator_unique (U : AddChar ℝ E) (A : E) + (h : ∀ t : ℝ, U t = NormedSpace.exp (t • A)) : A = deriv U 0 := by + simp [funext h, (hasDerivAt_exp_smul_const A (0 : ℝ)).deriv] + +end OneParameterSubgroup diff --git a/Physlib/Mathematics/OneParameterSubgroups/Unitary.lean b/Physlib/Mathematics/OneParameterSubgroups/Unitary.lean new file mode 100644 index 0000000000..110fc3e180 --- /dev/null +++ b/Physlib/Mathematics/OneParameterSubgroups/Unitary.lean @@ -0,0 +1,218 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Mathlib.Analysis.InnerProductSpace.Adjoint +public import Mathlib.Analysis.Calculus.Deriv.Star +public import Physlib.Mathematics.OneParameterSubgroups.Basic + +/-! + +# Unitary one-parameter groups + +A norm-continuous unitary one-parameter group on a complex Hilbert space has a unique bounded +self-adjoint generator. With the convention used here, the group generated by `A` is +`U(t) = exp (-itA)`. + +The same correspondence describes bounded generators of time translations, spatial translations, +rotations, and other norm-continuous unitary one-parameter groups. The general theorem for strongly +continuous groups and unbounded generators requires spectral theory that is not yet available in +Physlib. + +## Main results + +* `UnitaryOneParameterGroup.generator`: The canonical bounded self-adjoint generator. +* `UnitaryOneParameterGroup.apply_eq_exp_generator`: The formula `U(t) = exp (-itA)`. +* `UnitaryOneParameterGroup.ofSelfAdjoint`: The group generated by a bounded self-adjoint operator. +* `UnitaryOneParameterGroup.stoneEquiv`: Stone's correspondence for bounded generators. + +## References + +* M. H. Stone, Linear Transformations in Hilbert Space III. Operational Methods and Group Theory, + Proc. Natl. Acad. Sci. 16 (1930), 172-175. [ref: stone_1930] +-/ + +@[expose] public section + +noncomputable section + +/-- A norm-continuous unitary one-parameter group on a complex Hilbert space. -/ +structure UnitaryOneParameterGroup (H : Type*) [NormedAddCommGroup H] [InnerProductSpace ℂ H] + [CompleteSpace H] where + /-- The additive character from the real parameter to unitary operators. -/ + toAddChar : AddChar ℝ (H →L[ℂ] H) + /-- The group is valued in the unitary operators on `H`. -/ + mem_unitary : ∀ t, toAddChar t ∈ unitary (H →L[ℂ] H) + /-- The group is continuous in the operator norm. -/ + continuous : Continuous toAddChar + +namespace UnitaryOneParameterGroup + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +attribute [coe] UnitaryOneParameterGroup.toAddChar + +instance : CoeFun (UnitaryOneParameterGroup H) fun _ => ℝ → (H →L[ℂ] H) := ⟨fun U => U.toAddChar⟩ + +@[ext] +lemma ext {U V : UnitaryOneParameterGroup H} (h : ∀ t, U t = V t) : U = V := by + cases U + cases V + congr + exact AddChar.ext _ _ h + +lemma apply_eq_exp_deriv (U : UnitaryOneParameterGroup H) (t : ℝ) : + U t = NormedSpace.exp ((t : ℂ) • deriv U 0) := + OneParameterSubgroup.apply_eq_exp_smul_deriv U.toAddChar U.continuous t + +@[simp] +lemma adjoint_eq (U : UnitaryOneParameterGroup H) (t : ℝ) : (U t).adjoint = U (-t) := by + apply left_inv_eq_right_inv (Unitary.star_mul_self_of_mem (U.mem_unitary t)) + simp [← AddChar.map_add_eq_mul] + +/-- The bounded self-adjoint generator of `U`, in the convention `U(t) = exp (-itA)`. -/ +noncomputable def generator (U : UnitaryOneParameterGroup H) : H →L[ℂ] H := + Complex.I • deriv U 0 + +lemma apply_eq_exp_generator (U : UnitaryOneParameterGroup H) (t : ℝ) : + U t = NormedSpace.exp ((-(t : ℂ) * Complex.I) • U.generator) := by + rw [U.apply_eq_exp_deriv] + apply congrArg NormedSpace.exp + rw [generator, smul_smul] + apply congrArg (fun z : ℂ => z • deriv U 0) + rw [mul_assoc, Complex.I_mul_I] + simp + +/-- Any exponential generator of a unitary one-parameter group equals `U.generator`; the +uniqueness of the derivative at zero (`OneParameterSubgroup.generator_unique`) is the underlying +fact, restated here in terms of the physics convention. -/ +lemma generator_unique (U : UnitaryOneParameterGroup H) (A : H →L[ℂ] H) + (h : ∀ t : ℝ, U t = NormedSpace.exp ((-(t : ℂ) * Complex.I) • A)) : + A = U.generator := by + have hrep : ∀ t : ℝ, U t = + NormedSpace.exp ((t : ℂ) • ((-Complex.I) • A)) := by + intro t + rw [h t] + congr 1 + rw [smul_smul] + congr 1 + ring + have hderiv : (-Complex.I) • A = deriv U 0 := + OneParameterSubgroup.generator_unique U.toAddChar ((-Complex.I) • A) + (fun t => by simpa only [Complex.coe_smul] using hrep t) + calc + A = Complex.I • ((-Complex.I) • A) := by rw [smul_smul]; simp + _ = Complex.I • deriv U 0 := by rw [hderiv] + _ = U.generator := rfl + +lemma adjoint_deriv_eq_neg (U : UnitaryOneParameterGroup H) : + (deriv U 0).adjoint = -deriv U 0 := by + let A : H →L[ℂ] H := deriv U 0 + refine (neg_eq_iff_eq_neg.mpr ?_).symm + refine (OneParameterSubgroup.generator_unique U.toAddChar (-A.adjoint) fun t ↦ ?_).symm + calc + _ = (U (-t)).adjoint := by simp + _ = (NormedSpace.exp (((-t : ℝ) : ℂ) • A)).adjoint := by simp [A, U.apply_eq_exp_deriv] + _ = NormedSpace.exp (((-t : ℝ) : ℂ) • A).adjoint := NormedSpace.star_exp _ + _ = NormedSpace.exp (t • -A.adjoint) := by + simp [← ContinuousLinearMap.star_eq_adjoint, Complex.coe_smul] + +/-- The generator of a unitary one-parameter group is self-adjoint. -/ +lemma generator_isSelfAdjoint (U : UnitaryOneParameterGroup H) : IsSelfAdjoint U.generator := by + apply IsSelfAdjoint.I_smul_of_mem_skewAdjoint + rw [skewAdjoint.mem_iff] + exact U.adjoint_deriv_eq_neg + +/-- The generator commutes with every member of its one-parameter group. -/ +lemma commute_generator (U : UnitaryOneParameterGroup H) (t : ℝ) : + Commute U.generator (U t) := by + rw [U.apply_eq_exp_generator] + exact ((Commute.refl U.generator).smul_right (-(t : ℂ) * Complex.I)).exp_right + +/-- The derivative of a unitary one-parameter group in terms of its self-adjoint generator. -/ +lemma hasDerivAt (U : UnitaryOneParameterGroup H) (t : ℝ) : + HasDerivAt U (U t * (-(Complex.I • U.generator))) t := by + rw [show (U : ℝ → H →L[ℂ] H) = + fun s : ℝ => NormedSpace.exp ((s : ℂ) • deriv U 0) by + funext s + exact U.apply_eq_exp_deriv s] + simpa [generator, smul_smul] using + hasDerivAt_exp_smul_const (deriv U 0) t + +/-- The derivative of the adjoint unitary path. -/ +lemma hasDerivAt_star (U : UnitaryOneParameterGroup H) (t : ℝ) : + HasDerivAt (fun s => star (U s)) (star (U t) * (Complex.I • U.generator)) t := by + have heq : + star (U t * (-(Complex.I • U.generator))) = + star (U t) * (Complex.I • U.generator) := by + calc + star (U t * (-(Complex.I • U.generator))) = + (Complex.I • U.generator) * star (U t) := by + rw [star_mul, star_neg, star_smul, U.generator_isSelfAdjoint.star_eq] + simp + _ = star (U t) * (Complex.I • U.generator) := by + have hcomm := (U.commute_generator (-t)).smul_left Complex.I + rw [ContinuousLinearMap.star_eq_adjoint, U.adjoint_eq] + exact hcomm.eq + rw [← heq] + exact (U.hasDerivAt t).star + +/-- The unitary one-parameter group generated by a bounded self-adjoint operator. -/ +def ofSelfAdjoint {A : H →L[ℂ] H} (hA : IsSelfAdjoint A) : + UnitaryOneParameterGroup H := by + letI : NormedAlgebra ℚ (H →L[ℂ] H) := .restrictScalars ℚ ℂ (H →L[ℂ] H) + exact { + toAddChar := { + toFun t := NormedSpace.exp ((t : ℂ) • (-Complex.I • A)) + map_zero_eq_one' := by simp + map_add_eq_mul' s t := by + have hcomm : Commute ((s : ℂ) • (-Complex.I • A)) ((t : ℂ) • (-Complex.I • A)) := + ((Commute.refl (-Complex.I • A)).smul_left _).smul_right _ + rw [← NormedSpace.exp_add_of_commute hcomm] + simp [add_smul, add_comm] + } + mem_unitary t := by + apply NormedSpace.exp_mem_unitary_of_mem_skewAdjoint + simp [skewAdjoint.mem_iff, hA.star_eq] + continuous := by + change Continuous (fun t : ℝ => NormedSpace.exp ((t : ℂ) • (-Complex.I • A))) + fun_prop + } + +@[simp] +lemma ofSelfAdjoint_apply {A : H →L[ℂ] H} (hA : IsSelfAdjoint A) (t : ℝ) : + ofSelfAdjoint hA t = NormedSpace.exp ((-(t : ℂ) * Complex.I) • A) := by + simp only [ofSelfAdjoint] + change NormedSpace.exp ((t : ℂ) • ((-Complex.I) • A)) = _ + rw [smul_smul] + ring_nf + +/-- `ofSelfAdjoint` recovers `U` from its own generator: this is the defining property used to +show `stoneEquiv` is a left inverse. -/ +@[simp] +lemma ofSelfAdjoint_generator (U : UnitaryOneParameterGroup H) : + ofSelfAdjoint U.generator_isSelfAdjoint = U := by + apply ext + intro t + rw [ofSelfAdjoint_apply, U.apply_eq_exp_generator] + +/-- The generator of `ofSelfAdjoint hA` is `A` itself: this is the defining property used to show +`stoneEquiv` is a right inverse. -/ +@[simp] +lemma generator_ofSelfAdjoint {A : H →L[ℂ] H} (hA : IsSelfAdjoint A) : + (ofSelfAdjoint hA).generator = A := + ((ofSelfAdjoint hA).generator_unique A (ofSelfAdjoint_apply hA)).symm + +/-- Stone's correspondence between norm-continuous unitary one-parameter groups and bounded +self-adjoint generators. -/ +noncomputable def stoneEquiv : + UnitaryOneParameterGroup H ≃ {A : H →L[ℂ] H // IsSelfAdjoint A} where + toFun U := ⟨U.generator, U.generator_isSelfAdjoint⟩ + invFun A := ofSelfAdjoint A.2 + left_inv _ := by simp + right_inv _ := by simp + +end UnitaryOneParameterGroup diff --git a/Physlib/Mathematics/PiTensorProduct.lean b/Physlib/Mathematics/PiTensorProduct.lean index 41e5a9bfba..045a5e8735 100644 --- a/Physlib/Mathematics/PiTensorProduct.lean +++ b/Physlib/Mathematics/PiTensorProduct.lean @@ -107,6 +107,7 @@ section variable [DecidableEq (ι1 ⊕ ι2)] omit inst1 inst2 +set_option backward.isDefEq.respectTransparency false in lemma pureInl_update_left [DecidableEq ι1] (f : (i : ι1 ⊕ ι2) → Sum.elim s1 s2 i) (x : ι1) (v1 : s1 x) : pureInl (Function.update f (Sum.inl x) v1) = Function.update (pureInl f) x v1 := by @@ -118,12 +119,14 @@ lemma pureInl_update_left [DecidableEq ι1] (f : (i : ι1 ⊕ ι2) → Sum.elim rfl · rfl +set_option backward.isDefEq.respectTransparency false in lemma pureInr_update_left (f : (i : ι1 ⊕ ι2) → Sum.elim s1 s2 i) (x : ι1) (v2 : s1 x) : pureInr (Function.update f (Sum.inl x) v2) = (pureInr f) := by funext y simp [pureInr, Function.update] +set_option backward.isDefEq.respectTransparency false in lemma pureInr_update_right [DecidableEq ι2] (f : (i : ι1 ⊕ ι2) → Sum.elim s1 s2 i) (x : ι2) (v2 : s2 x) : pureInr (Function.update f (Sum.inr x) v2) = Function.update (pureInr f) x v2 := by @@ -135,6 +138,7 @@ lemma pureInr_update_right [DecidableEq ι2] (f : (i : ι1 ⊕ ι2) → Sum.elim rfl · rfl +set_option backward.isDefEq.respectTransparency false in lemma pureInl_update_right (f : (i : ι1 ⊕ ι2) → Sum.elim s1 s2 i) (x : ι2) (v1 : s2 x) : pureInl (Function.update f (Sum.inr x) v1) = (pureInl f) := by @@ -151,10 +155,10 @@ def domCoprod : toFun f := (PiTensorProduct.tprod R (pureInl f)) ⊗ₜ (PiTensorProduct.tprod R (pureInr f)) map_update_add' f xy v1 v2 := by - haveI : DecidableEq (ι1 ⊕ ι2) := inferInstance - haveI : DecidableEq ι1 := + have : DecidableEq (ι1 ⊕ ι2) := inferInstance + have : DecidableEq ι1 := @Function.Injective.decidableEq ι1 (ι1 ⊕ ι2) Sum.inl _ Sum.inl_injective - haveI : DecidableEq ι2 := + have : DecidableEq ι2 := @Function.Injective.decidableEq ι2 (ι1 ⊕ ι2) Sum.inr _ Sum.inr_injective match xy with | Sum.inl xy => @@ -164,10 +168,10 @@ def domCoprod : simp only [Sum.elim_inr, pureInl_update_right, pureInr_update_right, MultilinearMap.map_update_add, ← tmul_add] map_update_smul' f xy r p := by - haveI : DecidableEq (ι1 ⊕ ι2) := inferInstance - haveI : DecidableEq ι1 := + have : DecidableEq (ι1 ⊕ ι2) := inferInstance + have : DecidableEq ι1 := @Function.Injective.decidableEq ι1 (ι1 ⊕ ι2) Sum.inl _ Sum.inl_injective - haveI : DecidableEq ι2 := + have : DecidableEq ι2 := @Function.Injective.decidableEq ι2 (ι1 ⊕ ι2) Sum.inr _ Sum.inr_injective match xy with | Sum.inl x => @@ -194,6 +198,7 @@ section variable [DecidableEq ι1] [DecidableEq ι2] omit inst1 inst2 +set_option backward.isDefEq.respectTransparency false in lemma elimPureTensor_update_right (p : (i : ι1) → s1 i) (q : (i : ι2) → s2 i) (y : ι2) (r : s2 y) : elimPureTensor p (Function.update q y r) = Function.update (elimPureTensor p q) (Sum.inr y) r := by @@ -210,6 +215,7 @@ lemma elimPureTensor_update_right (p : (i : ι1) → s1 i) (q : (i : ι2) → s2 rfl · rfl +set_option backward.isDefEq.respectTransparency false in @[simp] lemma elimPureTensor_update_left (p : (i : ι1) → s1 i) (q : (i : ι2) → s2 i) (x : ι1) (r : s1 x) : elimPureTensor (Function.update p x r) q = @@ -237,22 +243,22 @@ def elimPureTensorMulLin : MultilinearMap R s1 toFun p := { toFun := fun q => PiTensorProduct.tprod R (elimPureTensor p q) map_update_add' := fun m x v1 v2 => by - haveI : DecidableEq ι2 := inferInstance - haveI := Classical.decEq ι1 + have : DecidableEq ι2 := inferInstance + have := Classical.decEq ι1 simp only [elimPureTensor_update_right, MultilinearMap.map_update_add] map_update_smul' := fun m x r v => by - haveI : DecidableEq ι2 := inferInstance - haveI := Classical.decEq ι1 + have : DecidableEq ι2 := inferInstance + have := Classical.decEq ι1 simp only [elimPureTensor_update_right, MultilinearMap.map_update_smul]} map_update_add' p x v1 v2 := by - haveI : DecidableEq ι1 := inferInstance - haveI := Classical.decEq ι2 + have : DecidableEq ι1 := inferInstance + have := Classical.decEq ι2 apply MultilinearMap.ext intro y simp map_update_smul' p x r v := by - haveI : DecidableEq ι1 := inferInstance - haveI := Classical.decEq ι2 + have : DecidableEq ι1 := inferInstance + have := Classical.decEq ι2 apply MultilinearMap.ext intro y simp @@ -269,7 +275,7 @@ def tmul : ((⨂[R] i : ι1, s1 i) ⊗[R] (⨂[R] i : ι2, s2 i)) →ₗ[R] /-- The equivalence formed by combining a `TensorProduct` into a `PiTensorProduct`. -/ def tmulEquiv : ((⨂[R] i : ι1, s1 i) ⊗[R] (⨂[R] i : ι2, s2 i)) ≃ₗ[R] ⨂[R] i : ι1 ⊕ ι2, (Sum.elim s1 s2) i := - LinearEquiv.ofLinear tmul tmulSymm + LinearEquiv.ofLinearMap tmul tmulSymm (by apply PiTensorProduct.ext apply MultilinearMap.ext @@ -295,7 +301,7 @@ def tmulEquiv : ((⨂[R] i : ι1, s1 i) ⊗[R] (⨂[R] i : ι2, s2 i)) ≃ₗ[R] lemma tmulEquiv_tmul_tprod (p : (i : ι1) → s1 i) (q : (i : ι2) → s2 i) : tmulEquiv ((PiTensorProduct.tprod R) p ⊗ₜ[R] (PiTensorProduct.tprod R) q) = (PiTensorProduct.tprod R) (elimPureTensor p q) := by - simp only [tmulEquiv, tmul, elimPureTensorMulLin, LinearEquiv.ofLinear_apply, lift.tmul, + simp only [tmulEquiv, tmul, elimPureTensorMulLin, LinearEquiv.coe_ofLinearMap, lift.tmul, LinearMap.coe_mk, AddHom.coe_mk, PiTensorProduct.lift.tprod, MultilinearMap.coe_mk] end tmulEquiv diff --git a/Physlib/Mathematics/RatComplexNum.lean b/Physlib/Mathematics/RatComplexNum.lean index 51dbbf1234..cec9872631 100644 --- a/Physlib/Mathematics/RatComplexNum.lean +++ b/Physlib/Mathematics/RatComplexNum.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joseph Tooby-Smith +Authors: Robert Sneiderman, Joseph Tooby-Smith -/ module @@ -238,6 +238,11 @@ lemma I_mul_toComplexNum (a : RatComplexNum) : I * toComplexNum a = toComplexNum simp only [I_sq, neg_mul, one_mul] ring +/-- Multiplication by `-I` under the inclusion of `RatComplexNum` into the complex numbers. -/ +lemma neg_I_mul_toComplexNum (a : RatComplexNum) : + (-I) * toComplexNum a = toComplexNum (- (⟨0, 1⟩ * a)) := by + rw [neg_mul, I_mul_toComplexNum, ← map_neg] + lemma ofNat_mul_toComplexNum (n : ℕ) (a : RatComplexNum) : n * toComplexNum a = toComplexNum (n * a) := by simp only [map_mul, map_natCast] @@ -252,5 +257,13 @@ lemma toComplexNum_injective : Function.Injective toComplexNum := by · exact ha.1 · exact ha.2 +/-- Equality with a four-term sum of rational complex numbers can be checked before their +inclusion into the complex numbers. -/ +lemma toComplexNum_eq_add_neg_add_add_iff {a b c d e : RatComplexNum} : + (toComplexNum a = toComplexNum b + -toComplexNum c + toComplexNum d + toComplexNum e) ↔ + a = b + -c + d + e := by + rw [← map_neg, ← map_add, ← map_add, ← map_add] + exact Function.Injective.eq_iff toComplexNum_injective + end RatComplexNum end Physlib diff --git a/Physlib/Mathematics/Resolvent.lean b/Physlib/Mathematics/Resolvent.lean index 5556691d44..8141070f6b 100644 --- a/Physlib/Mathematics/Resolvent.lean +++ b/Physlib/Mathematics/Resolvent.lean @@ -43,6 +43,7 @@ affine reciprocal `t ↦ (z + a·t)⁻¹ = resolvent (-z) (a·t)` follow at call ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/Mathematics/SO3/Basic.lean b/Physlib/Mathematics/SO3/Basic.lean index 69b497e9ce..47e4440cc8 100644 --- a/Physlib/Mathematics/SO3/Basic.lean +++ b/Physlib/Mathematics/SO3/Basic.lean @@ -75,8 +75,8 @@ lemma toProd_eq_transpose : toProd A = (A.1, ⟨A.1ᵀ⟩) := rfl lemma toProd_injective : Function.Injective toProd := by intro A B h - rw [toProd_eq_transpose, toProd_eq_transpose, Prod.mk_inj] at h - exact Subtype.ext h.1 + rw [toProd_eq_transpose, toProd_eq_transpose] at h + exact Subtype.ext (congrArg Prod.fst h) lemma toProd_continuous : Continuous toProd := continuous_prodMk.mpr ⟨continuous_iff_le_induced.mpr fun _ a ↦ a, @@ -160,7 +160,7 @@ lemma one_is_eigenvalue (A : SO(3)) : A.toEnd.HasEigenvalue 1 := by action of that `SO(3)` element. -/ lemma exists_stationary_vec (A : SO(3)) : ∃ (v : EuclideanSpace ℝ (Fin 3)), - Orthonormal ℝ (({0} : Set (Fin 3)).restrict (fun _ => v)) + Orthonormal ℝ (({0} : Set (Fin 3)).domRestrict (fun _ => v)) ∧ A.toEnd v = v := by obtain ⟨v, hv⟩ := End.HasEigenvalue.exists_hasEigenvector $ one_is_eigenvalue A have hvn : ‖v‖ ≠ 0 := norm_ne_zero_iff.mpr hv.2 @@ -171,7 +171,8 @@ lemma exists_stationary_vec (A : SO(3)) : simp only [one_div] have hveq : v1 = v2 := by aesop subst hveq - rw [Set.restrict_apply, inner_smul_right, inner_smul_left, real_inner_self_eq_norm_sq v] + show inner ℝ (‖v‖⁻¹ • v) (‖v‖⁻¹ • v) = if v1 = v1 then 1 else 0 + rw [inner_smul_right, inner_smul_left, real_inner_self_eq_norm_sq v] simp only [map_inv₀, conj_trivial, Fin.isValue, ↓reduceIte] field_simp · simp [End.mem_eigenspace_iff.mp hv.1] diff --git a/Physlib/Mathematics/SchurTriangulation.lean b/Physlib/Mathematics/SchurTriangulation.lean index 0ec7fb8e3a..cbb05dade5 100644 --- a/Physlib/Mathematics/SchurTriangulation.lean +++ b/Physlib/Mathematics/SchurTriangulation.lean @@ -65,7 +65,6 @@ end Equiv /-- The type family parameterized by `Bool` is finite if each type variant is finite. -/ instance [M : Fintype m] [N : Fintype n] (b : Bool) : Fintype (cond b m n) := b.rec N M -set_option backward.isDefEq.respectTransparency false in /-- The type family parameterized by `Bool` has decidable equality if each type variant is decidable. -/ instance [DecidableEq m] [DecidableEq n] : DecidableEq (Σ b, cond b m n) @@ -77,9 +76,6 @@ instance [DecidableEq m] [DecidableEq n] : DecidableEq (Σ b, cond b m n) namespace Matrix -/-- The property of a matrix being upper triangular. See also `Matrix.det_of_upperTriangular`. -/ -abbrev IsUpperTriangular [LT n] [CommRing R] (A : Matrix n n R) := A.BlockTriangular id - /-- The subtype of upper triangular matrices. -/ abbrev UpperTriangular (n R) [LT n] [CommRing R] := { A : Matrix n n R // A.IsUpperTriangular } @@ -137,7 +133,6 @@ variable [IsAlgClosed 𝕜] set_option maxHeartbeats 800000 in set_option maxRecDepth 2000 in -set_option backward.isDefEq.respectTransparency false in /-- **Don't use this definition directly.** This is the key algorithm behind `Matrix.schur_triangulation`. -/ protected noncomputable def SchurTriangulationAux.of diff --git a/Physlib/Mathematics/SpecialFunctions/EllipticIntegral.lean b/Physlib/Mathematics/SpecialFunctions/EllipticIntegral.lean new file mode 100644 index 0000000000..b94c73be3f --- /dev/null +++ b/Physlib/Mathematics/SpecialFunctions/EllipticIntegral.lean @@ -0,0 +1,250 @@ +/- +Copyright (c) 2026 Aadarsh Agarwal. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Aadarsh Agarwal +-/ +module + +public import Mathlib.MeasureTheory.Integral.DominatedConvergence +/-! + +# The complete elliptic integral of the first kind + +This file may eventually be upstreamed to Mathlib. + +## i. Overview + +Legendre's complete elliptic integral of the first kind is, in the parameter convention, + +`K(m) = ∫ φ in 0..π/2, (1 - m sin² φ) ^ (-1/2)` + +(Abramowitz & Stegun 17.3.1). The physics literature more often uses the modulus convention and +writes `K(k)`, as Landau & Lifshitz do, for what is here `completeEllipticK (k ^ 2)`; the two +conventions are related by `m = k²`. Mathlib knows the Weierstrass elliptic function `℘` +(`PeriodPair.weierstrassP`) but has no Legendre-form elliptic integrals; this file defines the +complete integral of the first kind and develops its basic theory on the domain `m < 1`, where +the radicand `1 - m sin² φ` is positive and the integrand continuous. + +The integral enters physics wherever a period or a potential is computed exactly rather than in a +small-parameter expansion. Physlib's use of it so far is the simple pendulum: released from rest +at amplitude `θ₀`, the pendulum has period `4 √(ℓ / g) K(sin² (θ₀ / 2))` (Landau & Lifshitz §11, +Problem 1), the consumer being `Physlib.ClassicalMechanics.Pendulum.SimplePendulum.PeriodFormula`. +More broadly, the complete integrals of the first and second kind give the magnetic field of a +circular current loop and the potential of a uniformly charged ring, and the second kind, `E`, +gives the arc length of an ellipse. This file defines `K` so that such results can be stated. + +For `m ≥ 1` the definition still elaborates, but its value is not Legendre's. At `m = 1` the +integrand is `1 / cos φ`, which is not interval integrable on `[0, π/2]`, so the integral is `0` +by `intervalIntegral.integral_undef`, whereas `K(1) = ∞`. For `m > 1` the radicand is negative on +`(arcsin (1/√m), π/2]`, where the real power at exponent `-(1/2)` of a negative base vanishes +(`Real.rpow_def_of_neg` supplies the factor `cos (-(1 / 2) * π) = 0`), so the Lean value is the +finite positive integral over `[0, arcsin (1/√m)]`; by the reciprocal-modulus transformation this +is `K(1/m) / √m`, the real part of the complex Legendre integral (DLMF §19.7(ii)) — not proved +here. Every lemma of this file about a general parameter therefore carries its domain hypothesis +`m < 1` explicitly. + +## ii. Key results + +- `completeEllipticK` : the complete elliptic integral of the first kind, as a function of + the parameter `m`. +- `completeEllipticK_zero` : `K 0 = π / 2`. +- `completeEllipticK_pos` : for `m < 1` the integral is positive. +- `completeEllipticK_mono` : for `m₁ ≤ m₂ < 1`, `K m₁ ≤ K m₂`. +- `completeEllipticK_strictMono` : for `m₁ < m₂ < 1`, `K m₁ < K m₂`. +- `pi_div_two_le_completeEllipticK` : for `0 ≤ m < 1`, `π / 2 ≤ K m`. +- `completeEllipticK_le` : for `0 ≤ m < 1`, `K m ≤ π / 2 * (1 - m) ^ (-1/2)`. +- `continuousOn_completeEllipticK` : `K` is continuous on `(-∞, 1)`. +- `continuousAt_completeEllipticK` : `K` is continuous at every `m < 1`. + +## iii. Table of contents + +- A. Definition and the integrand +- B. Value at zero and positivity +- C. Monotonicity and bounds in the parameter +- D. Continuity on the domain + +## iv. References + +* M. Abramowitz, I. A. Stegun, Handbook of Mathematical Functions, §17.3 (the parameter convention, + 17.3.1). [ref: abramowitz_stegun_1964] +* NIST DLMF §19.7(ii) (the reciprocal-modulus transformation). [ref: nist_dlmf] +* Landau & Lifshitz, Mechanics, 3rd ed., §11, Problem 1 (the pendulum period as `K(k)`, modulus + convention). [ref: landau_mechanics] +-/ + +@[expose] public section + +open MeasureTheory + +namespace Real + +/-! + +## A. Definition and the integrand + +The integral is defined for every real parameter `m`; on the domain `m < 1` the radicand is +positive, so the integrand is continuous and interval integrable. + +-/ + +/-- The complete elliptic integral of the first kind in the parameter convention, +`K(m) = ∫ φ in 0..π/2, (1 - m sin² φ) ^ (-1/2)`. The physics literature often writes `K(k)` +with `m = k²`. The integrand is written as a real power rather than `1 / √(…)` so that +continuity, positivity and monotonicity in `m` come from the `rpow` API (`Continuous.rpow_const`, +`Real.rpow_pos_of_pos`, `Real.rpow_le_rpow_of_nonpos`); the two forms agree by +`Real.sqrt_eq_rpow` and `Real.rpow_neg`. For `m ≥ 1` see the module docstring. -/ +@[pp_nodot] +noncomputable def completeEllipticK (m : ℝ) : ℝ := + ∫ φ in (0 : ℝ)..π / 2, (1 - m * sin φ ^ 2) ^ (-(1 / 2 : ℝ)) + +/-- Unfolding lemma: `completeEllipticK m` is the interval integral of its integrand over +`[0, π/2]`. -/ +lemma completeEllipticK_def (m : ℝ) : + completeEllipticK m = ∫ φ in (0 : ℝ)..π / 2, (1 - m * sin φ ^ 2) ^ (-(1 / 2 : ℝ)) := + rfl + +/-- For `m < 1` the radicand `1 - m sin² φ` of the integrand of `completeEllipticK m` is +positive at every angle `φ`. -/ +lemma completeEllipticK_radicand_pos {m : ℝ} (hm : m < 1) (φ : ℝ) : + 0 < 1 - m * sin φ ^ 2 := by + nlinarith [sq_nonneg (sin φ), sin_sq_le_one φ, + mul_nonneg (sub_nonneg.2 hm.le) (sq_nonneg (sin φ))] + +/-- For `m < 1` the integrand of `completeEllipticK m` is continuous, the real power being +taken at a positive base. -/ +lemma continuous_completeEllipticK_integrand {m : ℝ} (hm : m < 1) : + Continuous fun φ : ℝ => (1 - m * sin φ ^ 2) ^ (-(1 / 2 : ℝ)) := by + refine Continuous.rpow_const ?_ fun φ => Or.inl (completeEllipticK_radicand_pos hm φ).ne' + fun_prop + +/-- For `m < 1` the integrand of `completeEllipticK m` is interval integrable on `[0, π/2]`. -/ +lemma intervalIntegrable_completeEllipticK_integrand {m : ℝ} (hm : m < 1) : + IntervalIntegrable (fun φ : ℝ => (1 - m * sin φ ^ 2) ^ (-(1 / 2 : ℝ))) volume 0 (π / 2) := + (continuous_completeEllipticK_integrand hm).intervalIntegrable 0 (π / 2) + +/-! + +## B. Value at zero and positivity + +At `m = 0` the integrand is the constant `1` and the integral is elementary; for `m < 1` the +integral is positive, being the integral of a positive continuous function. + +-/ + +/-- `K 0 = π / 2`: at parameter zero the integrand of `completeEllipticK` is the constant `1`. -/ +@[simp] +lemma completeEllipticK_zero : completeEllipticK 0 = π / 2 := by + simp [completeEllipticK] + +/-- For `m < 1` the complete elliptic integral `completeEllipticK m` is positive. -/ +lemma completeEllipticK_pos {m : ℝ} (hm : m < 1) : 0 < completeEllipticK m := by + refine intervalIntegral.intervalIntegral_pos_of_pos_on + (intervalIntegrable_completeEllipticK_integrand hm) (fun φ _ => ?_) pi_div_two_pos + exact rpow_pos_of_pos (completeEllipticK_radicand_pos hm φ) _ + +/-! + +## C. Monotonicity and bounds in the parameter + +For fixed `φ` the radicand `1 - m sin² φ` decreases in `m`, so the integrand, a negative power of +the radicand, increases in `m` on the domain; integrating the pointwise inequality over +`[0, π/2]` gives monotonicity of `K`, and since the inequality is strict at `φ = π/2` the +monotonicity is strict. Together with `K 0 = π / 2` this bounds `K` below on `[0, 1)`; bounding +the radicand below by `1 - m` bounds `K` above by `π / 2 * (1 - m) ^ (-1/2)` there. + +-/ + +/-- `completeEllipticK` is monotone on its domain: for `m₁ ≤ m₂ < 1`, `K m₁ ≤ K m₂`. The +integrand is pointwise monotone in the parameter, the radicand being positive for both +parameters. -/ +@[gcongr] +lemma completeEllipticK_mono {m₁ m₂ : ℝ} (h12 : m₁ ≤ m₂) (h2 : m₂ < 1) : + completeEllipticK m₁ ≤ completeEllipticK m₂ := by + have h1 : m₁ < 1 := h12.trans_lt h2 + refine intervalIntegral.integral_mono_on pi_div_two_pos.le + (intervalIntegrable_completeEllipticK_integrand h1) + (intervalIntegrable_completeEllipticK_integrand h2) + fun φ _ => ?_ + exact rpow_le_rpow_of_nonpos (completeEllipticK_radicand_pos h2 φ) + (sub_le_sub_left (mul_le_mul_of_nonneg_right h12 (sq_nonneg _)) 1) (by norm_num) + +/-- `completeEllipticK` is monotone on its domain `(-∞, 1)`, as a `MonotoneOn` statement. -/ +lemma monotoneOn_completeEllipticK : MonotoneOn completeEllipticK (Set.Iio 1) := + fun _ _ _ hm₂ h => completeEllipticK_mono h hm₂ + +/-- `completeEllipticK` is strictly monotone on its domain: for `m₁ < m₂ < 1`, `K m₁ < K m₂`. +The pointwise inequality between the integrands is strict at `φ = π / 2`, where `sin² φ = 1`. -/ +@[gcongr] +lemma completeEllipticK_strictMono {m₁ m₂ : ℝ} (h12 : m₁ < m₂) (h2 : m₂ < 1) : + completeEllipticK m₁ < completeEllipticK m₂ := by + have h1 : m₁ < 1 := h12.trans h2 + refine intervalIntegral.integral_lt_integral_of_continuousOn_of_le_of_exists_lt pi_div_two_pos + (continuous_completeEllipticK_integrand h1).continuousOn + (continuous_completeEllipticK_integrand h2).continuousOn + (fun φ _ => ?_) ⟨π / 2, Set.right_mem_Icc.2 pi_div_two_pos.le, ?_⟩ + · exact rpow_le_rpow_of_nonpos (completeEllipticK_radicand_pos h2 φ) + (sub_le_sub_left (mul_le_mul_of_nonneg_right h12.le (sq_nonneg _)) 1) (by norm_num) + · simp only [sin_pi_div_two, one_pow, mul_one] + exact rpow_lt_rpow_of_neg (by linarith) (by linarith) (by norm_num) + +/-- `completeEllipticK` is strictly increasing on `(-∞, 1)`, as a bundled `StrictMonoOn`. -/ +lemma strictMonoOn_completeEllipticK : StrictMonoOn completeEllipticK (Set.Iio 1) := + fun _ _ _ hm₂ h => completeEllipticK_strictMono h hm₂ + +/-- For `0 ≤ m < 1` the complete elliptic integral `completeEllipticK m` is at least its value +`π / 2` at `m = 0`. -/ +lemma pi_div_two_le_completeEllipticK {m : ℝ} (hm0 : 0 ≤ m) (hm1 : m < 1) : + π / 2 ≤ completeEllipticK m := by + rw [← completeEllipticK_zero] + exact completeEllipticK_mono hm0 hm1 + +/-- For `0 ≤ m < 1` the complete elliptic integral `completeEllipticK m` is at most +`π / 2 * (1 - m) ^ (-1/2)`: the radicand is at least `1 - m`, `sin² φ` being at most `1`, so the +integrand is at most the constant `(1 - m) ^ (-1/2)`. With `pi_div_two_le_completeEllipticK` this +sandwiches `K` on `[0, 1)`; for the pendulum, where `m = sin² (θ₀ / 2)`, it bounds the period by +`T ≤ 2π √(ℓ / g) / cos (θ₀ / 2)`. -/ +lemma completeEllipticK_le {m : ℝ} (hm0 : 0 ≤ m) (hm1 : m < 1) : + completeEllipticK m ≤ π / 2 * (1 - m) ^ (-(1 / 2 : ℝ)) := by + have h : completeEllipticK m ≤ ∫ _ in (0 : ℝ)..π / 2, (1 - m) ^ (-(1 / 2 : ℝ)) := by + refine intervalIntegral.integral_mono_on pi_div_two_pos.le + (intervalIntegrable_completeEllipticK_integrand hm1) intervalIntegrable_const + fun φ _ => ?_ + exact rpow_le_rpow_of_nonpos (by linarith) + (sub_le_sub_left (mul_le_of_le_one_right hm0 (sin_sq_le_one φ)) 1) (by norm_num) + rwa [intervalIntegral.integral_const, sub_zero, smul_eq_mul] at h + +/-! + +## D. Continuity on the domain + +The integrand is jointly continuous in `(m, φ)` on `(-∞, 1) × ℝ`, where the radicand is +positive, but not on all of `ℝ × ℝ`. Restricting the parameter to the subtype `Set.Iio 1` makes +the joint continuity global, so Mathlib's continuity of a parametric interval integral with +fixed endpoints (`intervalIntegral.continuous_parametric_intervalIntegral_of_continuous'`) +applies and gives continuity of `K` on the domain. Continuity at each point `m < 1` follows, +`(-∞, 1)` being a neighbourhood of `m`. + +-/ + +/-- `completeEllipticK` is continuous on its domain `(-∞, 1)`. -/ +lemma continuousOn_completeEllipticK : ContinuousOn completeEllipticK (Set.Iio 1) := by + rw [continuousOn_iff_continuous_domRestrict] + have hf : Continuous fun p : Set.Iio (1 : ℝ) × ℝ => + (1 - p.1.1 * sin p.2 ^ 2) ^ (-(1 / 2 : ℝ)) := by + refine Continuous.rpow_const ?_ fun p => Or.inl (completeEllipticK_radicand_pos p.1.2 p.2).ne' + fun_prop + exact intervalIntegral.continuous_parametric_intervalIntegral_of_continuous' + -- `f` must be named: higher-order unification cannot recover it from `Continuous f.uncurry`. + (f := fun (m : Set.Iio (1 : ℝ)) (φ : ℝ) => (1 - m.1 * sin φ ^ 2) ^ (-(1 / 2 : ℝ))) + hf 0 (π / 2) + +/-- `completeEllipticK` is continuous at every point `m < 1` of its domain, `(-∞, 1)` being a +neighbourhood of `m`. -/ +lemma continuousAt_completeEllipticK {m : ℝ} (hm : m < 1) : ContinuousAt completeEllipticK m := + continuousOn_completeEllipticK.continuousAt (Iio_mem_nhds hm) + +/-- `completeEllipticK` is continuous at `m = 0`, an interior point of its domain `(-∞, 1)`. -/ +lemma continuousAt_completeEllipticK_zero : ContinuousAt completeEllipticK 0 := + continuousAt_completeEllipticK zero_lt_one + +end Real diff --git a/Physlib/Mathematics/SpecialFunctions/PhysHermite.lean b/Physlib/Mathematics/SpecialFunctions/PhysHermite.lean index e7a10046e2..b2ffbe2f24 100644 --- a/Physlib/Mathematics/SpecialFunctions/PhysHermite.lean +++ b/Physlib/Mathematics/SpecialFunctions/PhysHermite.lean @@ -41,6 +41,7 @@ and, up to numerical factors, satisfy all of the same properties. ## iv. References +* None. -/ @[expose] public section @@ -431,7 +432,6 @@ lemma physHermite_norm_cons (n : ℕ) (c : ℝ) : rw [physHermite_norm] at h simpa [mul_pow, neg_mul] using h -set_option backward.isDefEq.respectTransparency false in lemma polynomial_mem_physHermite_span_induction (P : Polynomial ℤ) : (n : ℕ) → (hn : P.natDegree = n) → (P : ℝ → ℝ) ∈ Submodule.span ℝ (Set.range (fun n => (physHermite n : ℝ → ℝ))) diff --git a/Physlib/Mathematics/Trigonometry/SinSq.lean b/Physlib/Mathematics/Trigonometry/SinSq.lean new file mode 100644 index 0000000000..98aee8286d --- /dev/null +++ b/Physlib/Mathematics/Trigonometry/SinSq.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 Aadarsh Agarwal. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Aadarsh Agarwal +-/ +module + +public import Mathlib.Analysis.SpecialFunctions.Trigonometric.Basic +/-! + +# Strict bounds on the square of the sine + +This file may eventually be upstreamed to Mathlib. + +## i. Overview + +Mathlib bounds the square of the sine by `sin x ^ 2 ≤ 1` for every real `x` (`Real.sin_sq_le_one`), +with equality exactly at the odd multiples of `π / 2`. This file records the strict form of that +bound, `sin x ^ 2 < 1` on the open interval `|x| < π / 2`, where the cosine is positive and +`1 - sin² x = cos² x`, together with its half-angle form `sin (θ / 2) ^ 2 < 1` for `|θ| < π`. + +Physlib uses the half-angle form for the simple pendulum: the parameter `sin² (θ₀ / 2)` of the +period formula lies in the domain `m < 1` of the complete elliptic integral `Real.completeEllipticK` +for every libration amplitude `|θ₀| < π`. + +## ii. Key results + +- `Real.sin_sq_lt_one` : `sin x ^ 2 < 1` for `|x| < π / 2`. +- `Real.sin_half_sq_lt_one` : `sin (θ / 2) ^ 2 < 1` for `|θ| < π`. + +## iii. Table of contents + +- A. Strict bounds on the square of the sine + +## iv. References + +* Landau & Lifshitz, Mechanics, 3rd ed., §11, Problem 1 (the pendulum period, whose parameter is + `sin² (θ₀ / 2)`). [ref: landau_mechanics] +-/ + +@[expose] public section + +namespace Real + +/-! + +## A. Strict bounds on the square of the sine + +On `|x| < π / 2` the cosine is positive, so `1 - sin² x = cos² x` is positive; the half-angle form +follows by applying this at `x = θ / 2`. + +-/ + +/-- `sin x ^ 2 < 1` for `|x| < π / 2`: the cosine is positive there, and `1 - sin² x = cos² x`. -/ +lemma sin_sq_lt_one {x : ℝ} (h : |x| < π / 2) : sin x ^ 2 < 1 := by + obtain ⟨h₁, h₂⟩ := abs_lt.1 h + rw [← sub_pos, ← cos_sq'] + exact pow_pos (cos_pos_of_mem_Ioo ⟨by linarith, h₂⟩) 2 + +/-- The half-angle form of `sin_sq_lt_one`: `sin (θ / 2) ^ 2 < 1` for `|θ| < π`. For the pendulum +this says that the parameter `sin² (θ₀ / 2)` of the period formula lies in the domain of +`completeEllipticK` for every libration amplitude `|θ₀| < π`. -/ +lemma sin_half_sq_lt_one {θ : ℝ} (h : |θ| < π) : sin (θ / 2) ^ 2 < 1 := by + refine sin_sq_lt_one ?_ + rw [abs_div, abs_two] + linarith [abs_nonneg θ] + +end Real diff --git a/Physlib/Mathematics/Trigonometry/Tanh.lean b/Physlib/Mathematics/Trigonometry/Tanh.lean index 9f17baa830..5cc886c4b0 100644 --- a/Physlib/Mathematics/Trigonometry/Tanh.lean +++ b/Physlib/Mathematics/Trigonometry/Tanh.lean @@ -206,6 +206,7 @@ lemma iteratedDeriv_tanh_const_mul (n : ℕ) (κ : ℝ) : ∀ x : ℝ, fun_prop /-- tanh(κx) has temperate growth -/ +@[fun_prop] lemma tanh_const_mul_hasTemperateGrowth (κ : ℝ) : Function.HasTemperateGrowth (fun x => Real.tanh (κ * x)) := by constructor diff --git a/Physlib/Mathematics/VariationalCalculus/Basic.lean b/Physlib/Mathematics/VariationalCalculus/Basic.lean index 7244f8f22d..57c4c57704 100644 --- a/Physlib/Mathematics/VariationalCalculus/Basic.lean +++ b/Physlib/Mathematics/VariationalCalculus/Basic.lean @@ -71,8 +71,7 @@ configuration space, or a local chart thereof. ## References -- https://leanprover.zulipchat.com/#narrow/channel/479953-Physlib/topic/Variational.20Calculus/with/529022834 - +* https://leanprover.zulipchat.com/#narrow/channel/479953-Physlib/topic/Variational.20Calculus/with/529022834. -/ @[expose] public section @@ -149,7 +148,7 @@ lemma fundamental_theorem_of_variational_calculus' {f : Y → V} Function.support φ ⊆ Metric.ball x₀ (δ₂/2) ∧ (∀ x ∈ Metric.closedBall x₀ (δ₂/4), 0 < φ x) := by -- use `hasContDiffBump_of_innerProductSpace`, leveraging `[innerProductSpace Y]` - haveI : HasContDiffBump Y := hasContDiffBump_of_innerProductSpace Y + have : HasContDiffBump Y := hasContDiffBump_of_innerProductSpace Y let φ1 : ContDiffBump x₀ := ⟨δ₂ / 4, δ₂ / 2, by positivity, by linarith⟩ refine ⟨φ1.toFun, ⟨φ1.contDiff, φ1.hasCompactSupport⟩, diff --git a/Physlib/Mathematics/VariationalCalculus/HasVarAdjoint.lean b/Physlib/Mathematics/VariationalCalculus/HasVarAdjoint.lean index a45c2e2aa6..a00ea621fd 100644 --- a/Physlib/Mathematics/VariationalCalculus/HasVarAdjoint.lean +++ b/Physlib/Mathematics/VariationalCalculus/HasVarAdjoint.lean @@ -451,7 +451,7 @@ lemma adjFDeriv_apply rw [Filter.EventuallyEq.fderiv_eq heq] adjoint φ ψ hφ hψ := by obtain ⟨s, ⟨bX⟩⟩ := Basis.exists_basis ℝ X - haveI : Fintype s := FiniteDimensional.fintypeBasisIndex bX + have : Fintype s := FiniteDimensional.fintypeBasisIndex bX let f (i : s) : X →ₗ[ℝ] ℝ := { toFun := (bX.repr · i) map_add' := by simp diff --git a/Physlib/Mathematics/VariationalCalculus/IsTestFunction.lean b/Physlib/Mathematics/VariationalCalculus/IsTestFunction.lean index dd3e9fbcb3..f4c9a89a59 100644 --- a/Physlib/Mathematics/VariationalCalculus/IsTestFunction.lean +++ b/Physlib/Mathematics/VariationalCalculus/IsTestFunction.lean @@ -281,7 +281,7 @@ lemma IsTestFunction.adjFDeriv {f : X → U} [InnerProductSpace' ℝ X] lemma IsTestFunction.divergence {f : X → X} [FiniteDimensional ℝ X] (hf : IsTestFunction f) : IsTestFunction (fun x => divergence ℝ f x) := by obtain ⟨s, ⟨bX⟩⟩ := Basis.exists_basis ℝ X - haveI : Fintype s := FiniteDimensional.fintypeBasisIndex bX + have : Fintype s := FiniteDimensional.fintypeBasisIndex bX conv_rhs => enter [x] rw [divergence_eq_sum_fderiv' bX] diff --git a/Physlib/Meta/AllFilePaths.lean b/Physlib/Meta/AllFilePaths.lean index b4aa856194..091a737c41 100644 --- a/Physlib/Meta/AllFilePaths.lean +++ b/Physlib/Meta/AllFilePaths.lean @@ -27,6 +27,10 @@ partial def allFilePaths.go (prev : Array FilePath) pure (acc.push (root ++ "/" ++ entry.fileName)) pure result +/-- Gets an array of all file paths in the supplied directory. -/ +partial def getFilePaths (moduleName : String) : IO (Array FilePath) := do + allFilePaths.go (#[] : Array FilePath) moduleName moduleName + /-- Gets an array of all file paths in `Physlib`. -/ partial def allFilePaths : IO (Array FilePath) := do allFilePaths.go (#[] : Array FilePath) "./Physlib" ("./Physlib" : FilePath) diff --git a/Physlib/Meta/Sorry.lean b/Physlib/Meta/Sorry.lean index e6d78dbd36..384ab32bc3 100644 --- a/Physlib/Meta/Sorry.lean +++ b/Physlib/Meta/Sorry.lean @@ -36,9 +36,8 @@ are correctly attributed `sorryful` and `pseudo` respectively. ## iv. References -Some of the code here is adapted from from the file: `Lean.Util.CollectAxioms` -copyright (c) 2020 Microsoft Corporation. Authored by Leonardo de Moura. - +* Adapted from `Lean.Util.CollectAxioms`, copyright (c) 2020 Microsoft + Corporation, authored by Leonardo de Moura. -/ @[expose] public meta section diff --git a/Physlib/Meta/TransverseTactics.lean b/Physlib/Meta/TransverseTactics.lean index e857eeea46..735d292037 100644 --- a/Physlib/Meta/TransverseTactics.lean +++ b/Physlib/Meta/TransverseTactics.lean @@ -12,15 +12,15 @@ public import Physlib.Meta.TODO.Basic This file enables us to transverse tactics and test for conditions. ## References -The content of this file is based on the following sources (released under the Apache 2.0 license). -- https://github.com/dwrensha/tryAtEachStep/blob/main/tryAtEachStep.lean -- https://github.com/lean-dojo/LeanDojo/blob/main/src/lean_dojo/data_extraction/ExtractData.lean +The content of this file is based on the following sources (released under the Apache 2.0 +license), with modifications made to the original content here. -Modifications have been made to the original content of these files here. - -See also: -- https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/Memory.20increase.20in.20loops.2E +* https://github.com/dwrensha/tryAtEachStep/blob/main/tryAtEachStep.lean. + [ref: github_tryateachstep] +* https://github.com/lean-dojo/LeanDojo/blob/main/src/lean_dojo/data_extraction/ExtractData.lean. + [ref: github_leandojo_extractdata] +* See also: https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/Memory.20increase.20in.20loops.2E. -/ @[expose] public section diff --git a/Physlib/Particles/BeyondTheStandardModel/GeorgiGlashow/Basic.lean b/Physlib/Particles/BeyondTheStandardModel/GeorgiGlashow/Basic.lean index fabbdaba8a..3598b5a3f5 100644 --- a/Physlib/Particles/BeyondTheStandardModel/GeorgiGlashow/Basic.lean +++ b/Physlib/Particles/BeyondTheStandardModel/GeorgiGlashow/Basic.lean @@ -15,6 +15,10 @@ The Georgi-Glashow model is a grand unified theory that unifies the Standard Mod This file currently contains informal-results about the Georgi-Glashow group. +## References + +* Baez's Grand Unified Theories notes, cited throughout below. [ref: baez_guts_notes] + -/ @[expose] public section @@ -30,7 +34,7 @@ informal_definition GaugeGroupI where the group homomorphism `SU(3) × SU(2) × U(1) → SU(5)` taking `(h, g, α)` to `blockdiag (α ^ 3 g, α ^ (-2) h)`. -See page 34 of https://math.ucr.edu/home/baez/guts.pdf +See page 34 of https://math.ucr.edu/home/baez/guts.pdf [ref: baez_guts_notes] -/ informal_definition inclSM where deps := [``GaugeGroupI, ``StandardModel.GaugeGroupI] @@ -38,7 +42,7 @@ informal_definition inclSM where /-- The kernel of the map `inclSM` is equal to the subgroup `StandardModel.gaugeGroupℤ₆SubGroup`. -See page 34 of https://math.ucr.edu/home/baez/guts.pdf +See page 34 of https://math.ucr.edu/home/baez/guts.pdf [ref: baez_guts_notes] -/ informal_lemma inclSM_ker where deps := [``inclSM] diff --git a/Physlib/Particles/BeyondTheStandardModel/PatiSalam/Basic.lean b/Physlib/Particles/BeyondTheStandardModel/PatiSalam/Basic.lean index 1ccc37b164..990392e4aa 100644 --- a/Physlib/Particles/BeyondTheStandardModel/PatiSalam/Basic.lean +++ b/Physlib/Particles/BeyondTheStandardModel/PatiSalam/Basic.lean @@ -15,6 +15,11 @@ The Pati-Salam model is a petite unified theory that unifies the Standard Model This file currently contains informal-results about the Pati-Salam group. +## References + +* Baez's Grand Unified Theories notes, cited throughout below. [ref: baez_guts_notes] +* A reference for the kernel of `inclSM`, cited below. [ref: arxiv_2201_07245] + -/ @[expose] public section @@ -35,7 +40,7 @@ informal_definition GaugeGroupI where group homomorphism `SU(3) × SU(2) × U(1) → SU(4) × SU(2) × SU(2)` taking `(h, g, α)` to `(blockdiag (α h, α ^ (-3)), g, diag (α ^ 3, α ^(-3))`. -See page 54 of https://math.ucr.edu/home/baez/guts.pdf +See page 54 of https://math.ucr.edu/home/baez/guts.pdf [ref: baez_guts_notes] -/ informal_definition inclSM where deps := [``GaugeGroupI, ``StandardModel.GaugeGroupI] @@ -43,7 +48,7 @@ informal_definition inclSM where /-- The kernel of the map `inclSM` is equal to the subgroup `StandardModel.gaugeGroupℤ₃SubGroup`. -See footnote 10 of https://arxiv.org/pdf/2201.07245 +See footnote 10 of https://arxiv.org/pdf/2201.07245 [ref: arxiv_2201_07245] -/ informal_lemma inclSM_ker where deps := [``inclSM, ``StandardModel.gaugeGroupℤ₃SubGroup] @@ -64,7 +69,7 @@ informal_definition gaugeGroupISpinEquiv where /-- The ℤ₂-subgroup of the un-quotiented gauge group which acts trivially on all particles in the standard model, i.e., the ℤ₂-subgroup of `GaugeGroupI` with the non-trivial element `(-1, -1, -1)`. -See https://math.ucr.edu/home/baez/guts.pdf +See https://math.ucr.edu/home/baez/guts.pdf [ref: baez_guts_notes] -/ informal_definition gaugeGroupℤ₂SubGroup where deps := [``GaugeGroupI] @@ -73,7 +78,7 @@ informal_definition gaugeGroupℤ₂SubGroup where /-- The gauge group of the Pati-Salam model with a ℤ₂ quotient, i.e., the quotient of `GaugeGroupI` by the ℤ₂-subgroup `gaugeGroupℤ₂SubGroup`. -See https://math.ucr.edu/home/baez/guts.pdf +See https://math.ucr.edu/home/baez/guts.pdf [ref: baez_guts_notes] -/ informal_definition GaugeGroupℤ₂ where deps := [``GaugeGroupI, ``gaugeGroupℤ₂SubGroup] diff --git a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Basic.lean b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Basic.lean index e7c3086079..ad8ba4a745 100644 --- a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Basic.lean +++ b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Basic.lean @@ -32,6 +32,7 @@ namespace SMνCharges variable {n : ℕ} +set_option backward.isDefEq.respectTransparency false in lemma sum_one [AddCommMonoid M] (f : Fin (SMνSpecies 1).numberCharges → M) : ∑ i, f i = f ⟨0, by simp⟩ := by change ∑ (i : Fin 1), f i = _ @@ -94,6 +95,7 @@ open SMνCharges variable {n : ℕ} +set_option backward.isDefEq.respectTransparency false in /-- The gravitational anomaly equation. -/ def accGrav : (SMνCharges n).Charges →ₗ[ℚ] ℚ where toFun S := ∑ i, (6 * Q S i + 3 * U S i + 3 * D S i + 2 * L S i + E S i + N S i) @@ -112,6 +114,7 @@ def accGrav : (SMνCharges n).Charges →ₗ[ℚ] ℚ where -- rw [show Rat.cast a = a from rfl] ring +set_option backward.isDefEq.respectTransparency false in lemma accGrav_decomp (S : (SMνCharges n).Charges) : accGrav S = 6 * ∑ i, Q S i + 3 * ∑ i, U S i + 3 * ∑ i, D S i + 2 * ∑ i, L S i + ∑ i, E S i + ∑ i, N S i := by @@ -127,6 +130,7 @@ lemma accGrav_ext {S T : (SMνCharges n).Charges} rw [accGrav_decomp, accGrav_decomp] repeat rw [hj] +set_option backward.isDefEq.respectTransparency false in /-- The `SU(2)` anomaly equation. -/ def accSU2 : (SMνCharges n).Charges →ₗ[ℚ] ℚ where toFun S := ∑ i, (3 * Q S i + L S i) @@ -145,6 +149,7 @@ def accSU2 : (SMνCharges n).Charges →ₗ[ℚ] ℚ where -- rw [show Rat.cast a = a from rfl] ring +set_option backward.isDefEq.respectTransparency false in lemma accSU2_decomp (S : (SMνCharges n).Charges) : accSU2 S = 3 * ∑ i, Q S i + ∑ i, L S i := by simp only [accSU2, toSpecies_apply, Fin.isValue, LinearMap.coe_mk, @@ -159,6 +164,7 @@ lemma accSU2_ext {S T : (SMνCharges n).Charges} rw [accSU2_decomp, accSU2_decomp] repeat rw [hj] +set_option backward.isDefEq.respectTransparency false in /-- The `SU(3)` anomaly equations. -/ def accSU3 : (SMνCharges n).Charges →ₗ[ℚ] ℚ where toFun S := ∑ i, (2 * Q S i + U S i + D S i) @@ -177,6 +183,7 @@ def accSU3 : (SMνCharges n).Charges →ₗ[ℚ] ℚ where -- rw [show Rat.cast a = a from rfl] ring +set_option backward.isDefEq.respectTransparency false in lemma accSU3_decomp (S : (SMνCharges n).Charges) : accSU3 S = 2 * ∑ i, Q S i + ∑ i, U S i + ∑ i, D S i := by simp only [accSU3, toSpecies_apply, Fin.isValue, LinearMap.coe_mk, @@ -191,6 +198,7 @@ lemma accSU3_ext {S T : (SMνCharges n).Charges} rw [accSU3_decomp, accSU3_decomp] repeat rw [hj] +set_option backward.isDefEq.respectTransparency false in /-- The `Y²` anomaly equation. -/ def accYY : (SMνCharges n).Charges →ₗ[ℚ] ℚ where toFun S := ∑ i, (Q S i + 8 * U S i + 2 * D S i + 3 * L S i @@ -210,6 +218,7 @@ def accYY : (SMνCharges n).Charges →ₗ[ℚ] ℚ where -- rw [show Rat.cast a = a from rfl] ring +set_option backward.isDefEq.respectTransparency false in lemma accYY_decomp (S : (SMνCharges n).Charges) : accYY S = ∑ i, Q S i + 8 * ∑ i, U S i + 2 * ∑ i, D S i + 3 * ∑ i, L S i + 6 * ∑ i, E S i := by simp only [accYY, toSpecies_apply, Fin.isValue, LinearMap.coe_mk, @@ -224,6 +233,7 @@ lemma accYY_ext {S T : (SMνCharges n).Charges} rw [accYY_decomp, accYY_decomp] repeat rw [hj] +set_option backward.isDefEq.respectTransparency false in /-- The quadratic bilinear map. -/ @[simps!] def quadBiLin : BiLinearSymm (SMνCharges n).Charges := BiLinearSymm.mk₂ @@ -277,6 +287,7 @@ lemma accQuad_decomp (S : (SMνCharges n).Charges) : rw [quadBiLin_decomp] ring_nf +set_option backward.isDefEq.respectTransparency false in /-- Extensionality lemma for `accQuad`. -/ lemma accQuad_ext {S T : (SMνCharges n).Charges} (h : ∀ j, ∑ i, ((fun a => a^2) ∘ toSpecies j S) i = @@ -285,6 +296,7 @@ lemma accQuad_ext {S T : (SMνCharges n).Charges} rw [accQuad_decomp, accQuad_decomp] simp_all +set_option backward.isDefEq.respectTransparency false in /-- The symmetric trilinear form used to define the cubic acc. -/ @[simps!] def cubeTriLin : TriLinearSymm (SMνCharges n).Charges := TriLinearSymm.mk₃ @@ -341,6 +353,7 @@ lemma accCube_decomp (S : (SMνCharges n).Charges) : rw [cubeTriLin_decomp] ring_nf +set_option backward.isDefEq.respectTransparency false in /-- Extensionality lemma for `accCube`. -/ lemma accCube_ext {S T : (SMνCharges n).Charges} (h : ∀ j, ∑ i, ((fun a => a^3) ∘ toSpecies j S) i = diff --git a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/FamilyMaps.lean b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/FamilyMaps.lean index a9725b5459..2b79906aac 100644 --- a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/FamilyMaps.lean +++ b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/FamilyMaps.lean @@ -19,6 +19,7 @@ open SMνCharges open SMνACCs open BigOperators +set_option backward.isDefEq.respectTransparency false in /-- Given a map of for a generic species, the corresponding map for charges. -/ @[simps!] def chargesMapOfSpeciesMap {n m : ℕ} (f : (SMνSpecies n).Charges →ₗ[ℚ] (SMνSpecies m).Charges) : @@ -53,6 +54,7 @@ def speciesFamilyProj {m n : ℕ} (h : n ≤ m) : def familyProjection {m n : ℕ} (h : n ≤ m) : (SMνCharges m).Charges →ₗ[ℚ] (SMνCharges n).Charges := chargesMapOfSpeciesMap (speciesFamilyProj h) +set_option backward.isDefEq.respectTransparency false in /-- For species, the embedding of the `m`-family charges onto the `n`-family charges, with all other charges zero. -/ @[simps!] @@ -117,6 +119,7 @@ lemma sum_familyUniversal {n : ℕ} (m : ℕ) (S : (SMνCharges 1).Charges) (j : refine Finset.sum_congr rfl (fun i _ => ?_) erw [toSpecies_familyUniversal] +set_option backward.isDefEq.respectTransparency false in lemma sum_familyUniversal_one {n : ℕ} (S : (SMνCharges 1).Charges) (j : Fin 6) : ∑ i, toSpecies j (familyUniversal n S) i = n * (toSpecies j S ⟨0, by simp⟩) := by simpa using @sum_familyUniversal n 1 S j @@ -148,6 +151,7 @@ lemma sum_familyUniversal_three {n : ℕ} (S : (SMνCharges 1).Charges) simp only [toSpecies_apply, toSpeciesEquiv_apply, Fin.zero_eta, Fin.isValue, Nat.reduceMul] ring +set_option backward.isDefEq.respectTransparency false in lemma familyUniversal_accGrav (S : (SMνCharges 1).Charges) : accGrav (familyUniversal n S) = n * (accGrav S) := by rw [accGrav_decomp, accGrav_decomp] @@ -156,6 +160,7 @@ lemma familyUniversal_accGrav (S : (SMνCharges 1).Charges) : Equiv.arrowCongr_symm, Equiv.refl_symm, Equiv.symm_symm, sum_one] ring +set_option backward.isDefEq.respectTransparency false in lemma familyUniversal_accSU2 (S : (SMνCharges 1).Charges) : accSU2 (familyUniversal n S) = n * (accSU2 S) := by rw [accSU2_decomp, accSU2_decomp] @@ -163,6 +168,7 @@ lemma familyUniversal_accSU2 (S : (SMνCharges 1).Charges) : simp only [Fin.isValue, toSpecies_apply, sum_one] ring +set_option backward.isDefEq.respectTransparency false in lemma familyUniversal_accSU3 (S : (SMνCharges 1).Charges) : accSU3 (familyUniversal n S) = n * (accSU3 S) := by rw [accSU3_decomp, accSU3_decomp] @@ -170,6 +176,7 @@ lemma familyUniversal_accSU3 (S : (SMνCharges 1).Charges) : simp only [Fin.isValue, toSpecies_apply, sum_one] ring +set_option backward.isDefEq.respectTransparency false in lemma familyUniversal_accYY (S : (SMνCharges 1).Charges) : accYY (familyUniversal n S) = n * (accYY S) := by rw [accYY_decomp, accYY_decomp] diff --git a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Ordinary/DimSevenPlane.lean b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Ordinary/DimSevenPlane.lean index 98ecad4bdb..e6db5a1e07 100644 --- a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Ordinary/DimSevenPlane.lean +++ b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Ordinary/DimSevenPlane.lean @@ -198,6 +198,7 @@ lemma Bi_Bj_ne_cubic {i j : Fin 7} (h : i ≠ j) (S : (SM 3).Charges) : · exact B₅_Bi_cubic h S · exact B₆_Bi_cubic h S +set_option backward.isDefEq.respectTransparency false in lemma Bi_Bi_Bj_cubic (i j : Fin 7) : cubeTriLin (B i) (B i) (B j) = 0 := by rcases eq_or_ne i j with rfl | hij diff --git a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Ordinary/FamilyMaps.lean b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Ordinary/FamilyMaps.lean index 213ac58bde..4d5ffc3bcd 100644 --- a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Ordinary/FamilyMaps.lean +++ b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Ordinary/FamilyMaps.lean @@ -25,6 +25,7 @@ open BigOperators variable {n : ℕ} +set_option backward.isDefEq.respectTransparency false in /-- The family universal maps on `LinSols`. -/ def familyUniversalLinear (n : ℕ) : (SM 1).LinSols →ₗ[ℚ] (SM n).LinSols where @@ -35,6 +36,7 @@ def familyUniversalLinear (n : ℕ) : map_add' S T := ACCSystemLinear.LinSols.ext ((familyUniversal n).map_add' _ _) map_smul' a S := ACCSystemLinear.LinSols.ext ((familyUniversal n).map_smul' _ _) +set_option backward.isDefEq.respectTransparency false in /-- The family universal maps on `QuadSols`. -/ def familyUniversalQuad (n : ℕ) : (SM 1).QuadSols → (SM n).QuadSols := fun S => @@ -43,6 +45,7 @@ def familyUniversalQuad (n : ℕ) : (by rw [familyUniversal_accSU2, SU2Sol S.1, mul_zero]) (by rw [familyUniversal_accSU3, SU3Sol S.1, mul_zero]) +set_option backward.isDefEq.respectTransparency false in /-- The family universal maps on `Sols`. -/ def familyUniversalAF (n : ℕ) : (SM 1).Sols → (SM n).Sols := fun S => diff --git a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Permutations.lean b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Permutations.lean index b9cfeea19f..9dc6c157de 100644 --- a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Permutations.lean +++ b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/Permutations.lean @@ -41,6 +41,7 @@ def chargeMap (f : PermGroup n) : (SMνCharges n).Charges →ₗ[ℚ] (SMνCharg map_add' _ _ := rfl map_smul' _ _ := rfl +set_option backward.isDefEq.respectTransparency false in /-- The representation of `(permGroup n)` acting on the vector space of charges. -/ @[simp] def repCharges {n : ℕ} : Representation ℚ (PermGroup n) (SMνCharges n).Charges where @@ -70,18 +71,22 @@ lemma toSpecies_sum_invariant (m : ℕ) (f : PermGroup n) (S : (SMνCharges n).C rw [repCharges_toSpecies] exact Equiv.sum_comp (f⁻¹ j) ((fun a => a ^ m) ∘ toSpecies j S) +set_option backward.isDefEq.respectTransparency false in lemma accGrav_invariant (f : PermGroup n) (S : (SMνCharges n).Charges) : accGrav (repCharges f S) = accGrav S := accGrav_ext (by simpa using toSpecies_sum_invariant 1 f S) +set_option backward.isDefEq.respectTransparency false in lemma accSU2_invariant (f : PermGroup n) (S : (SMνCharges n).Charges) : accSU2 (repCharges f S) = accSU2 S := accSU2_ext (by simpa using toSpecies_sum_invariant 1 f S) +set_option backward.isDefEq.respectTransparency false in lemma accSU3_invariant (f : PermGroup n) (S : (SMνCharges n).Charges) : accSU3 (repCharges f S) = accSU3 S := accSU3_ext (by simpa using toSpecies_sum_invariant 1 f S) +set_option backward.isDefEq.respectTransparency false in lemma accYY_invariant (f : PermGroup n) (S : (SMνCharges n).Charges) : accYY (repCharges f S) = accYY S := accYY_ext (by simpa using toSpecies_sum_invariant 1 f S) diff --git a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/BMinusL.lean b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/BMinusL.lean index a3f4f6a30a..c2b5017c28 100644 --- a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/BMinusL.lean +++ b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/BMinusL.lean @@ -57,6 +57,7 @@ namespace BL variable {n : ℕ} +set_option backward.isDefEq.respectTransparency false in lemma on_quadBiLin (S : (PlusU1 n).Charges) : quadBiLin (BL n).val S = 1/2 * accYY S + 3/2 * accSU2 S - 2 * accSU3 S := by erw [familyUniversal_quadBiLin] @@ -90,6 +91,7 @@ lemma addQuad_zero (S : (PlusU1 n).QuadSols) (a : ℚ) : addQuad S a 0 = a • S simp only [addQuad, linearToQuad, zero_smul, add_zero] rfl +set_option backward.isDefEq.respectTransparency false in lemma on_cubeTriLin (S : (PlusU1 n).Charges) : cubeTriLin (BL n).val (BL n).val S = 9 * accGrav S - 24 * accSU3 S := by erw [familyUniversal_cubeTriLin'] diff --git a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/Basic.lean b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/Basic.lean index 8fb0b8bcd1..230332eea1 100644 --- a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/Basic.lean +++ b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/Basic.lean @@ -41,26 +41,31 @@ namespace PlusU1 variable {n : ℕ} +set_option backward.isDefEq.respectTransparency false in lemma gravSol (S : (PlusU1 n).LinSols) : accGrav S.val = 0 := by have hS := S.linearSol simp only [PlusU1_linearACCs] at hS exact hS ⟨0, by simp⟩ +set_option backward.isDefEq.respectTransparency false in lemma SU2Sol (S : (PlusU1 n).LinSols) : accSU2 S.val = 0 := by have hS := S.linearSol simp only [PlusU1_linearACCs] at hS exact hS ⟨1, by simp⟩ +set_option backward.isDefEq.respectTransparency false in lemma SU3Sol (S : (PlusU1 n).LinSols) : accSU3 S.val = 0 := by have hS := S.linearSol simp only [PlusU1_linearACCs] at hS exact hS ⟨2, by simp⟩ +set_option backward.isDefEq.respectTransparency false in lemma YYsol (S : (PlusU1 n).LinSols) : accYY S.val = 0 := by have hS := S.linearSol simp only [PlusU1_linearACCs] at hS exact hS ⟨3, by simp⟩ +set_option backward.isDefEq.respectTransparency false in lemma quadSol (S : (PlusU1 n).QuadSols) : accQuad S.val = 0 := by have hS := S.quadSol simp only [PlusU1_quadraticACCs] at hS diff --git a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/FamilyMaps.lean b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/FamilyMaps.lean index 2817de9d0c..a2b287e4a4 100644 --- a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/FamilyMaps.lean +++ b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/FamilyMaps.lean @@ -25,6 +25,7 @@ open BigOperators variable {n : ℕ} +set_option backward.isDefEq.respectTransparency false in /-- The family universal maps on `LinSols`. -/ def familyUniversalLinear (n : ℕ) : (PlusU1 1).LinSols →ₗ[ℚ] (PlusU1 n).LinSols where @@ -36,6 +37,7 @@ def familyUniversalLinear (n : ℕ) : map_add' S T := rfl map_smul' a S := rfl +set_option backward.isDefEq.respectTransparency false in /-- The family universal maps on `QuadSols`. -/ def familyUniversalQuad (n : ℕ) : (PlusU1 1).QuadSols → (PlusU1 n).QuadSols := fun S => @@ -46,6 +48,7 @@ def familyUniversalQuad (n : ℕ) : (by rw [familyUniversal_accYY, YYsol S.1, mul_zero]) (by rw [familyUniversal_accQuad, quadSol S, mul_zero]) +set_option backward.isDefEq.respectTransparency false in /-- The family universal maps on `Sols`. -/ def familyUniversalAF (n : ℕ) : (PlusU1 1).Sols → (PlusU1 n).Sols := fun S => diff --git a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/HyperCharge.lean b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/HyperCharge.lean index a7be87e52a..6263c73ee2 100644 --- a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/HyperCharge.lean +++ b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/HyperCharge.lean @@ -55,6 +55,7 @@ namespace Y variable {n : ℕ} +set_option backward.isDefEq.respectTransparency false in lemma on_quadBiLin (S : (PlusU1 n).Charges) : quadBiLin (Y n).val S = accYY S := by erw [familyUniversal_quadBiLin] @@ -86,6 +87,7 @@ def addQuad (S : (PlusU1 n).QuadSols) (a b : ℚ) : (PlusU1 n).QuadSols := lemma addQuad_zero (S : (PlusU1 n).QuadSols) (a : ℚ) : addQuad S a 0 = a • S := by simp only [addQuad, linearToQuad, zero_smul, add_zero]; rfl +set_option backward.isDefEq.respectTransparency false in lemma on_cubeTriLin (S : (PlusU1 n).Charges) : cubeTriLin (Y n).val (Y n).val S = 6 * accYY S := by erw [familyUniversal_cubeTriLin'] @@ -99,6 +101,7 @@ lemma on_cubeTriLin_AFL (S : (PlusU1 n).LinSols) : rw [on_cubeTriLin, YYsol S] with_unfolding_all rfl +set_option backward.isDefEq.respectTransparency false in lemma on_cubeTriLin' (S : (PlusU1 n).Charges) : cubeTriLin (Y n).val S S = 6 * accQuad S := by erw [familyUniversal_cubeTriLin] @@ -123,6 +126,7 @@ lemma add_AFL_cube (S : (PlusU1 n).LinSols) (a b : ℚ) : add_zero, Y_val, mul_zero] ring +set_option backward.isDefEq.respectTransparency false in lemma add_AFQ_cube (S : (PlusU1 n).QuadSols) (a b : ℚ) : accCube (a • S.val + b • (Y n).val) = a ^ 3 * accCube S.val := by rw [add_AFL_cube, cubeTriLin.swap₃, on_cubeTriLin'_ALQ] diff --git a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/QuadSol.lean b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/QuadSol.lean index ce70e492c2..7aac19a8c4 100644 --- a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/QuadSol.lean +++ b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/QuadSol.lean @@ -12,10 +12,11 @@ public import Physlib.Particles.BeyondTheStandardModel.RHN.AnomalyCancellation.P We give a series of properties held by solutions to the quadratic equation. In particular given a quad solution we define a map from linear solutions to quadratic solutions -and show that it is a surjection. The main reference for this is: +and show that it is a surjection. -- https://arxiv.org/abs/2006.03588 +## References +* The main reference for this is https://arxiv.org/abs/2006.03588. [ref: arxiv_2006_03588] -/ @[expose] public section @@ -57,7 +58,7 @@ lemma accQuad_α₁_α₂ (S : (PlusU1 n).LinSols) : lemma accQuad_α₁_α₂_zero (S : (PlusU1 n).LinSols) (h1 : α₁ C S = 0) (h2 : α₂ S = 0) (a b : ℚ) : accQuad (a • S + b • C.1).val = 0 := by erw [add_AFL_quad] - simp only [α₁, quadBiLin_toFun_apply, Fin.isValue, neg_mul, neg_eq_zero, mul_eq_zero, + simp only [α₁, neg_mul, neg_eq_zero, mul_eq_zero, OfNat.ofNat_ne_zero, false_or, α₂, HomogeneousQuadratic, accQuad] at h1 h2 simp [h1, h2] diff --git a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/QuadSolToSol.lean b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/QuadSolToSol.lean index 594c080cec..bfe589ce2d 100644 --- a/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/QuadSolToSol.lean +++ b/Physlib/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/QuadSolToSol.lean @@ -9,11 +9,11 @@ public import Physlib.Particles.BeyondTheStandardModel.RHN.AnomalyCancellation.P /-! # Solutions from quad solutions -We use $B-L$ to form a surjective map from quad solutions to solutions. The main reference -for this material is: +We use $B-L$ to form a surjective map from quad solutions to solutions. -- https://arxiv.org/abs/2006.03588 +## References +* The main reference for this material is https://arxiv.org/abs/2006.03588. [ref: arxiv_2006_03588] -/ @[expose] public section @@ -102,7 +102,7 @@ def quadSolToSolInv {n : ℕ} : (PlusU1 n).Sols → (PlusU1 n).QuadSols × ℚ lemma quadSolToSolInv_1 (S : (PlusU1 n).Sols) : (quadSolToSolInv S).1 = S.1 := by - simp only [quadSolToSolInv, α₁, BL_val, SMνACCs.cubeTriLin_toFun_apply_apply, Fin.isValue, + simp only [quadSolToSolInv, α₁, BL_val, neg_mul, neg_eq_zero, mul_eq_zero, OfNat.ofNat_ne_zero, false_or] split <;> rfl diff --git a/Physlib/Particles/BeyondTheStandardModel/Spin10/Basic.lean b/Physlib/Particles/BeyondTheStandardModel/Spin10/Basic.lean index 0e4f443287..fb344982b9 100644 --- a/Physlib/Particles/BeyondTheStandardModel/Spin10/Basic.lean +++ b/Physlib/Particles/BeyondTheStandardModel/Spin10/Basic.lean @@ -14,6 +14,10 @@ public import Physlib.Particles.BeyondTheStandardModel.GeorgiGlashow.Basic Note: By physicists this is usually called SO(10). However, the true gauge group involved is Spin(10). +## References + +* Baez's Grand Unified Theories notes, cited throughout below. [ref: baez_guts_notes] + -/ @[expose] public section @@ -30,7 +34,7 @@ informal_definition GaugeGroupI where Precomposed with the isomorphism, `PatiSalam.gaugeGroupISpinEquiv`, between `SU(4) × SU(2) × SU(2)` and `Spin(6) × Spin(4)`. -See page 56 of https://math.ucr.edu/home/baez/guts.pdf +See page 56 of https://math.ucr.edu/home/baez/guts.pdf [ref: baez_guts_notes] -/ informal_definition inclPatiSalam where deps := [``GaugeGroupI, ``PatiSalam.GaugeGroupI, ``PatiSalam.gaugeGroupISpinEquiv] @@ -39,7 +43,7 @@ informal_definition inclPatiSalam where /-- The inclusion of the Standard Model gauge group into Spin(10), i.e., the composition of `embedPatiSalam` and `PatiSalam.inclSM`. -See page 56 of https://math.ucr.edu/home/baez/guts.pdf +See page 56 of https://math.ucr.edu/home/baez/guts.pdf [ref: baez_guts_notes] -/ informal_definition inclSM where deps := [``inclPatiSalam, ``PatiSalam.inclSM] @@ -47,6 +51,7 @@ informal_definition inclSM where /-- The inclusion of the Georgi-Glashow gauge group into Spin(10), i.e., the Lie group homomorphism from `SU(n) → Spin(2n)` discussed on page 46 of https://math.ucr.edu/home/baez/guts.pdf for `n = 5`. +[ref: baez_guts_notes] -/ informal_definition inclGeorgiGlashow where deps := [``GaugeGroupI, ``GeorgiGlashow.GaugeGroupI] diff --git a/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean b/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean index 03983b715c..ef667f3922 100644 --- a/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean +++ b/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean @@ -19,9 +19,8 @@ doublet. ## References -- https://arxiv.org/abs/hep-ph/0605184 -- https://arxiv.org/abs/1605.03237 - +* https://arxiv.org/abs/hep-ph/0605184. [ref: arxiv_hep_ph_0605184] +* https://arxiv.org/abs/1605.03237. [ref: arxiv_1605_03237] -/ @[expose] public section diff --git a/Physlib/Particles/BeyondTheStandardModel/TwoHDM/GramMatrix.lean b/Physlib/Particles/BeyondTheStandardModel/TwoHDM/GramMatrix.lean index e065eb1f6a..5a78bcb4b3 100644 --- a/Physlib/Particles/BeyondTheStandardModel/TwoHDM/GramMatrix.lean +++ b/Physlib/Particles/BeyondTheStandardModel/TwoHDM/GramMatrix.lean @@ -10,11 +10,13 @@ public import Physlib.Particles.BeyondTheStandardModel.TwoHDM.Basic # The gram matrix for the two Higgs doublet model -The main reference for material in this section is https://arxiv.org/pdf/hep-ph/0605184. - We will show that the gram matrix of the two Higgs doublet model describes the gauge orbits of the configuration space. +## References + +* The main reference for material in this section is https://arxiv.org/pdf/hep-ph/0605184. [ref: arxiv_hep_ph_0605184] + -/ @[expose] public section @@ -30,7 +32,7 @@ open StandardModel -/ /-- The Gram matrix of the two Higgs doublet. - This matrix is used in https://arxiv.org/abs/hep-ph/0605184. -/ + This matrix is used in https://arxiv.org/abs/hep-ph/0605184. [ref: arxiv_hep_ph_0605184] -/ noncomputable def gramMatrix (H : TwoHiggsDoublet) : Matrix (Fin 2) (Fin 2) ℂ := !![⟪H.Φ1, H.Φ1⟫_ℂ, ⟪H.Φ2, H.Φ1⟫_ℂ; ⟪H.Φ1, H.Φ2⟫_ℂ, ⟪H.Φ2, H.Φ2⟫_ℂ] diff --git a/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Potential.lean b/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Potential.lean index 3583671c1a..7c57899f1d 100644 --- a/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Potential.lean +++ b/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Potential.lean @@ -43,13 +43,11 @@ give stability properties of the potential. ## iv. References -For the parameterization of the potential we follow the convention of -- https://arxiv.org/pdf/1605.03237 - -Stability arguments of the potential follow, in part, those from -- https://arxiv.org/abs/hep-ph/0605184 -Although we note that we explicitly prove that one of the steps in this paper is not valid. - +* For the parameterization of the potential we follow the convention of + https://arxiv.org/pdf/1605.03237. [ref: arxiv_1605_03237] +* Stability arguments of the potential follow, in part, those from + https://arxiv.org/abs/hep-ph/0605184, although we note that we explicitly prove that one of + the steps in this paper is not valid. [ref: arxiv_hep_ph_0605184] -/ @[expose] public section @@ -63,16 +61,16 @@ open StandardModel We define a type for the parameters of the Higgs potential in the 2HDM. -We follow the convention of `1605.03237`, which is highlighted in the explicit construction -of the potential itself. +We follow the convention of `1605.03237` [ref: arxiv_1605_03237], which is highlighted in the +explicit construction of the potential itself. We relate these parameters to the `ξ` and `η` parameters used in the gram vector formalism -given in arXiv:hep-ph/0605184. +given in arXiv:hep-ph/0605184 [ref: arxiv_hep_ph_0605184]. -/ /-- The parameters of the Two Higgs doublet model potential. - Following the convention of https://arxiv.org/pdf/1605.03237. -/ + Following the convention of https://arxiv.org/pdf/1605.03237 [ref: arxiv_1605_03237]. -/ structure PotentialParameters where /-- The parameter corresponding to `m₁₁²` in the 2HDM potential. -/ m₁₁2 : ℝ @@ -144,7 +142,7 @@ instance : Zero PotentialParameters where ### A.2. Gram parameters A reparameterization of the potential parameters corresponding to `ξ` and `η` in -arXiv:hep-ph/0605184. +arXiv:hep-ph/0605184 [ref: arxiv_hep_ph_0605184]. -/ @@ -198,7 +196,7 @@ lemma η_zero : (0 : PotentialParameters).η = 0 := by -/ /-- An example of potential parameters that serve as a counterexample to the stability - condition given in arXiv:hep-ph/0605184. + condition given in arXiv:hep-ph/0605184 [ref: arxiv_hep_ph_0605184]. This corresponds to the potential: `2 * (⟪H.Φ1, H.Φ2⟫_ℂ).im + ‖H.Φ1 - H.Φ2‖ ^ 4` which has the property that the quartic term is non-negative and only zero if @@ -531,13 +529,13 @@ lemma stabilityCounterExample_not_potentialIsStable : ### E.3. The reduced mass term The reduced mass term is a function that helps express the stability condition. -It is the function `J2` in https://arxiv.org/abs/hep-ph/0605184. +It is the function `J2` in https://arxiv.org/abs/hep-ph/0605184 [ref: arxiv_hep_ph_0605184]. -/ /-- A function related to the mass term of the potential, used in the stableness condition and equivalent to the term `J2` in - https://arxiv.org/abs/hep-ph/0605184. -/ + https://arxiv.org/abs/hep-ph/0605184 [ref: arxiv_hep_ph_0605184]. -/ noncomputable def massTermReduced (P : PotentialParameters) (k : EuclideanSpace ℝ (Fin 3)) : ℝ := P.ξ (Sum.inl 0) + ∑ μ, P.ξ (Sum.inr μ) * k μ @@ -577,13 +575,13 @@ lemma massTermReduced_stabilityCounterExample (k : EuclideanSpace ℝ (Fin 3)) : ### E.4. The reduced quartic term The reduced quartic term is a function that helps express the stability condition. -It is the function `J4` in https://arxiv.org/abs/hep-ph/0605184. +It is the function `J4` in https://arxiv.org/abs/hep-ph/0605184 [ref: arxiv_hep_ph_0605184]. -/ /-- A function related to the quartic term of the potential, used in the stableness condition and equivalent to the term `J4` in - https://arxiv.org/abs/hep-ph/0605184. -/ + https://arxiv.org/abs/hep-ph/0605184 [ref: arxiv_hep_ph_0605184]. -/ noncomputable def quarticTermReduced (P : PotentialParameters) (k : EuclideanSpace ℝ (Fin 3)) : ℝ := P.η (Sum.inl 0) (Sum.inl 0) + 2 * ∑ b, k b * P.η (Sum.inl 0) (Sum.inr b) + ∑ a, ∑ b, k a * k b * P.η (Sum.inr a) (Sum.inr b) @@ -611,7 +609,7 @@ lemma quarticTermReduced_stabilityCounterExample_nonneg (k : EuclideanSpace ℝ We give some necessary and sufficient conditions for the potential to be stable in terms of the gram vectors. -This follows the analysis in https://arxiv.org/abs/hep-ph/0605184. +This follows the analysis in https://arxiv.org/abs/hep-ph/0605184 [ref: arxiv_hep_ph_0605184]. We also give some necessary conditions. @@ -884,8 +882,8 @@ lemma potentialIsStable_of_strong (P : PotentialParameters) -/ -/-- A lemma invalidating the step in https://arxiv.org/pdf/hep-ph/0605184 leading to - equation (4.4). -/ +/-- A lemma invalidating the step in https://arxiv.org/pdf/hep-ph/0605184 + [ref: arxiv_hep_ph_0605184] leading to equation (4.4). -/ lemma forall_reduced_exists_not_potentialIsStable : ∃ P, ¬ PotentialIsStable P ∧ (∀ k : EuclideanSpace ℝ (Fin 3), ‖k‖ ^ 2 ≤ 1 → 0 ≤ quarticTermReduced P k ∧ (quarticTermReduced P k = 0 → 0 ≤ massTermReduced P k)) := by diff --git a/Physlib/Particles/FlavorPhysics/CKMMatrix/Basic.lean b/Physlib/Particles/FlavorPhysics/CKMMatrix/Basic.lean index 19b29ee183..33caba6bf0 100644 --- a/Physlib/Particles/FlavorPhysics/CKMMatrix/Basic.lean +++ b/Physlib/Particles/FlavorPhysics/CKMMatrix/Basic.lean @@ -37,6 +37,7 @@ lemma phaseShiftMatrix_one : phaseShiftMatrix 0 0 0 = 1 := by ext i j fin_cases i <;> fin_cases j <;> simp [phaseShiftMatrix, one_apply] +set_option backward.isDefEq.respectTransparency false in /-- The conjugate transpose of the phase shift matrix is the phase-shift matrix with negated phases. -/ lemma phaseShiftMatrix_star (a b c : ℝ) : @@ -45,6 +46,7 @@ lemma phaseShiftMatrix_star (a b c : ℝ) : fin_cases i <;> fin_cases j <;> simp [phaseShiftMatrix, conjTranspose_apply, ← exp_conj, conj_I, conj_ofReal] +set_option backward.isDefEq.respectTransparency false in /-- The multiple of two phase shift matrices is equal to the phase shift matrix with added phases. -/ lemma phaseShiftMatrix_mul (a b c d e f : ℝ) : @@ -53,6 +55,7 @@ lemma phaseShiftMatrix_mul (a b c d e f : ℝ) : fin_cases i <;> fin_cases j <;> simp [phaseShiftMatrix, mul_apply, Fin.sum_univ_three, ← exp_add, mul_add] +set_option backward.isDefEq.respectTransparency false in /-- Given three real numbers `a b c` the unitary matrix with `exp (I * a)` etc on the leading diagonal. -/ @[simps!] @@ -152,73 +155,85 @@ lemma equiv (V : CKMMatrix) (a b c d e f : ℝ) : symm exact ⟨a, b, c, d, e, f, rfl⟩ +set_option backward.isDefEq.respectTransparency false in /-- The `ud` component of the CKM matrix obtained after applying a phase shift. -/ lemma ud (V : CKMMatrix) (a b c d e f : ℝ) : (phaseShiftApply V a b c d e f).1 0 0 = cexp (a * I + d * I) * V.1 0 0 := by - simp only [Fin.isValue, phaseShiftApply_coe, mul_apply, cons_val', cons_val_fin_one, - cons_val_zero, Fin.sum_univ_three, cons_val_one, zero_mul, add_zero, cons_val, mul_zero, - exp_add] + simp only [Fin.isValue, phaseShiftApply_coe, Submonoid.coe_mul, phaseShift_coe_matrix, + phaseShiftMatrix, mul_apply, cons_val', cons_val_fin_one, cons_val_zero, Fin.sum_univ_three, + cons_val_one, zero_mul, add_zero, cons_val, mul_zero, exp_add] ring_nf +set_option backward.isDefEq.respectTransparency false in /-- The `us` component of the CKM matrix obtained after applying a phase shift. -/ lemma us (V : CKMMatrix) (a b c d e f : ℝ) : (phaseShiftApply V a b c d e f).1 0 1 = cexp (a * I + e * I) * V.1 0 1 := by - simp only [Fin.isValue, phaseShiftApply_coe, mul_apply, cons_val', cons_val_fin_one, - cons_val_zero, Fin.sum_univ_three, cons_val_one, zero_mul, add_zero, cons_val, mul_zero, - zero_add, exp_add] + simp only [Fin.isValue, phaseShiftApply_coe, Submonoid.coe_mul, phaseShift_coe_matrix, + phaseShiftMatrix, mul_apply, cons_val', cons_val_fin_one, cons_val_zero, Fin.sum_univ_three, + cons_val_one, zero_mul, add_zero, cons_val, mul_zero, zero_add, exp_add] ring_nf +set_option backward.isDefEq.respectTransparency false in /-- The `ub` component of the CKM matrix obtained after applying a phase shift. -/ lemma ub (V : CKMMatrix) (a b c d e f : ℝ) : (phaseShiftApply V a b c d e f).1 0 2 = cexp (a * I + f * I) * V.1 0 2 := by - simp only [Fin.isValue, phaseShiftApply_coe, mul_apply, cons_val', cons_val_fin_one, - cons_val_zero, Fin.sum_univ_three, cons_val_one, zero_mul, add_zero, cons_val, mul_zero, - zero_add, exp_add] + simp only [Fin.isValue, phaseShiftApply_coe, Submonoid.coe_mul, phaseShift_coe_matrix, + phaseShiftMatrix, mul_apply, cons_val', cons_val_fin_one, cons_val_zero, Fin.sum_univ_three, + cons_val_one, zero_mul, add_zero, cons_val, mul_zero, zero_add, exp_add] ring_nf +set_option backward.isDefEq.respectTransparency false in /-- The `cd` component of the CKM matrix obtained after applying a phase shift. -/ lemma cd (V : CKMMatrix) (a b c d e f : ℝ) : (phaseShiftApply V a b c d e f).1 1 0= cexp (b * I + d * I) * V.1 1 0 := by - simp only [Fin.isValue, phaseShiftApply_coe, mul_apply, cons_val', cons_val_fin_one, cons_val_one, - cons_val_zero, Fin.sum_univ_three, zero_mul, zero_add, cons_val, add_zero, mul_zero, exp_add] + simp only [Fin.isValue, phaseShiftApply_coe, Submonoid.coe_mul, phaseShift_coe_matrix, + phaseShiftMatrix, mul_apply, cons_val', cons_val_fin_one, cons_val_one, cons_val_zero, + Fin.sum_univ_three, zero_mul, zero_add, cons_val, add_zero, mul_zero, exp_add] ring_nf +set_option backward.isDefEq.respectTransparency false in /-- The `cs` component of the CKM matrix obtained after applying a phase shift. -/ lemma cs (V : CKMMatrix) (a b c d e f : ℝ) : (phaseShiftApply V a b c d e f).1 1 1 = cexp (b * I + e * I) * V.1 1 1 := by - simp only [Fin.isValue, phaseShiftApply_coe, mul_apply, cons_val', cons_val_fin_one, cons_val_one, - cons_val_zero, Fin.sum_univ_three, zero_mul, zero_add, cons_val, add_zero, mul_zero, exp_add] + simp only [Fin.isValue, phaseShiftApply_coe, Submonoid.coe_mul, phaseShift_coe_matrix, + phaseShiftMatrix, mul_apply, cons_val', cons_val_fin_one, cons_val_one, cons_val_zero, + Fin.sum_univ_three, zero_mul, zero_add, cons_val, add_zero, mul_zero, exp_add] ring_nf +set_option backward.isDefEq.respectTransparency false in /-- The `cb` component of the CKM matrix obtained after applying a phase shift. -/ lemma cb (V : CKMMatrix) (a b c d e f : ℝ) : (phaseShiftApply V a b c d e f).1 1 2 = cexp (b * I + f * I) * V.1 1 2 := by - simp only [Fin.isValue, phaseShiftApply_coe, mul_apply, cons_val', cons_val_fin_one, cons_val_one, - cons_val_zero, Fin.sum_univ_three, zero_mul, zero_add, cons_val, add_zero, mul_zero, exp_add] + simp only [Fin.isValue, phaseShiftApply_coe, Submonoid.coe_mul, phaseShift_coe_matrix, + phaseShiftMatrix, mul_apply, cons_val', cons_val_fin_one, cons_val_one, cons_val_zero, + Fin.sum_univ_three, zero_mul, zero_add, cons_val, add_zero, mul_zero, exp_add] ring_nf +set_option backward.isDefEq.respectTransparency false in /-- The `td` component of the CKM matrix obtained after applying a phase shift. -/ lemma td (V : CKMMatrix) (a b c d e f : ℝ) : (phaseShiftApply V a b c d e f).1 2 0= cexp (c * I + d * I) * V.1 2 0 := by - simp only [Fin.isValue, phaseShiftApply_coe, mul_apply, cons_val', cons_val_fin_one, cons_val, - cons_val_one, Fin.sum_univ_three, cons_val_zero, zero_mul, add_zero, zero_add, mul_zero, - exp_add] + simp only [Fin.isValue, phaseShiftApply_coe, Submonoid.coe_mul, phaseShift_coe_matrix, + phaseShiftMatrix, mul_apply, cons_val', cons_val_fin_one, cons_val, cons_val_one, + Fin.sum_univ_three, cons_val_zero, zero_mul, add_zero, zero_add, mul_zero, exp_add] ring_nf +set_option backward.isDefEq.respectTransparency false in /-- The `ts` component of the CKM matrix obtained after applying a phase shift. -/ lemma ts (V : CKMMatrix) (a b c d e f : ℝ) : (phaseShiftApply V a b c d e f).1 2 1 = cexp (c * I + e * I) * V.1 2 1 := by - simp only [Fin.isValue, phaseShiftApply_coe, mul_apply, cons_val', cons_val_fin_one, cons_val, - cons_val_one, Fin.sum_univ_three, cons_val_zero, zero_mul, add_zero, zero_add, mul_zero, - exp_add] + simp only [Fin.isValue, phaseShiftApply_coe, Submonoid.coe_mul, phaseShift_coe_matrix, + phaseShiftMatrix, mul_apply, cons_val', cons_val_fin_one, cons_val, cons_val_one, + Fin.sum_univ_three, cons_val_zero, zero_mul, add_zero, zero_add, mul_zero, exp_add] ring_nf +set_option backward.isDefEq.respectTransparency false in /-- The `tb` component of the CKM matrix obtained after applying a phase shift. -/ lemma tb (V : CKMMatrix) (a b c d e f : ℝ) : (phaseShiftApply V a b c d e f).1 2 2 = cexp (c * I + f * I) * V.1 2 2 := by - simp only [Fin.isValue, phaseShiftApply_coe, mul_apply, cons_val', cons_val_fin_one, cons_val, - cons_val_one, Fin.sum_univ_three, cons_val_zero, zero_mul, add_zero, zero_add, mul_zero, - exp_add] + simp only [Fin.isValue, phaseShiftApply_coe, Submonoid.coe_mul, phaseShift_coe_matrix, + phaseShiftMatrix, mul_apply, cons_val', cons_val_fin_one, cons_val, cons_val_one, + Fin.sum_univ_three, cons_val_zero, zero_mul, add_zero, zero_add, mul_zero, exp_add] ring_nf end phaseShiftApply @@ -227,6 +242,7 @@ end phaseShiftApply @[simp] def VAbs' (V : unitaryGroup (Fin 3) ℂ) (i j : Fin 3) : ℝ := norm (V i j) +set_option backward.isDefEq.respectTransparency false in /-- If two CKM matrices are equivalent (under phase shifts), then their absolute values are the same. -/ lemma VAbs'_equiv (i j : Fin 3) (V U : CKMMatrix) (h : V ≈ U) : diff --git a/Physlib/Particles/FlavorPhysics/CKMMatrix/Relations.lean b/Physlib/Particles/FlavorPhysics/CKMMatrix/Relations.lean index 18358a9bcd..555b7ce939 100644 --- a/Physlib/Particles/FlavorPhysics/CKMMatrix/Relations.lean +++ b/Physlib/Particles/FlavorPhysics/CKMMatrix/Relations.lean @@ -38,7 +38,7 @@ lemma VAbs_sum_sq_row_eq_one (V : Quotient CKMMatrixSetoid) (i : Fin 3) : rw [mul_conj, mul_conj, mul_conj] at ht repeat rw [← Complex.sq_norm] at ht rw [← ofReal_inj] - simp_all only [SetLike.coe_mem, Unitary.mul_star_self_of_mem, Fin.isValue, ofReal_pow, ofReal_add, + simp_all only [Fin.isValue, ofReal_pow, ofReal_add, ofReal_one] exact ht @@ -296,8 +296,7 @@ lemma VAbs_sum_sq_col_eq_one (V : Quotient CKMMatrixSetoid) (i : Fin 3) : rw [mul_comm, mul_conj, mul_comm, mul_conj, mul_comm, mul_conj] at ht repeat rw [← Complex.sq_norm] at ht rw [← ofReal_inj] - simp_all only [SetLike.coe_mem, Unitary.star_mul_self_of_mem, Fin.isValue, ofReal_pow, ofReal_add, - ofReal_one] + simp_all only [Fin.isValue, ofReal_pow, ofReal_add, ofReal_one] exact ht lemma thd_col_normalized_abs (V : CKMMatrix) : diff --git a/Physlib/Particles/FlavorPhysics/CKMMatrix/Rows.lean b/Physlib/Particles/FlavorPhysics/CKMMatrix/Rows.lean index 8c8998beb0..c091f2e019 100644 --- a/Physlib/Particles/FlavorPhysics/CKMMatrix/Rows.lean +++ b/Physlib/Particles/FlavorPhysics/CKMMatrix/Rows.lean @@ -181,6 +181,7 @@ noncomputable def rowBasis (V : CKMMatrix) : Basis (Fin 3) ℂ (Fin 3 → ℂ) : basisOfLinearIndependentOfCardEqFinrank (rows_linearly_independent V) (Module.finrank_fin_fun ℂ).symm +set_option backward.isDefEq.respectTransparency false in lemma cRow_cross_tRow_eq_uRow (V : CKMMatrix) : ∃ (κ : ℝ), [V]u = cexp (κ * I) • (conj [V]c ⨯₃ conj [V]t) := by obtain ⟨g, hg⟩ := (Submodule.mem_span_range_iff_exists_fun ℂ).mp (Basis.mem_span (rowBasis V) @@ -223,6 +224,7 @@ lemma cRow_cross_tRow_eq_uRow (V : CKMMatrix) : have h4 : (0 : ℝ) < 1 := by norm_num exact False.elim (lt_iff_not_ge.mp h4 h3) +set_option backward.isDefEq.respectTransparency false in lemma uRow_cross_cRow_eq_tRow (V : CKMMatrix) : ∃ (τ : ℝ), [V]t = cexp (τ * I) • (conj ([V]u) ⨯₃ conj ([V]c)) := by obtain ⟨g, hg⟩ := (Submodule.mem_span_range_iff_exists_fun ℂ).mp (Basis.mem_span (rowBasis V) diff --git a/Physlib/Particles/FlavorPhysics/CKMMatrix/StandardParameterization/Basic.lean b/Physlib/Particles/FlavorPhysics/CKMMatrix/StandardParameterization/Basic.lean index 8de5ad4f58..b9fd3cc373 100644 --- a/Physlib/Particles/FlavorPhysics/CKMMatrix/StandardParameterization/Basic.lean +++ b/Physlib/Particles/FlavorPhysics/CKMMatrix/StandardParameterization/Basic.lean @@ -39,6 +39,7 @@ def standParamAsMatrix (θ₁₂ θ₁₃ θ₂₃ δ₁₃ : ℝ) : Matrix (Fin open CKMMatrix +set_option backward.isDefEq.respectTransparency false in /-- The standard parameterization forms a unitary matrix. -/ lemma standParamAsMatrix_unitary (θ₁₂ θ₁₃ θ₂₃ δ₁₃ : ℝ) : ((standParamAsMatrix θ₁₂ θ₁₃ θ₂₃ δ₁₃)ᴴ * standParamAsMatrix θ₁₂ θ₁₃ θ₂₃ δ₁₃) = 1 := by @@ -88,6 +89,7 @@ lemma eq_rows (U : CKMMatrix) {θ₁₂ θ₁₃ θ₂₃ δ₁₃ : ℝ} (hu : apply ext_Rows hu hc rw [hU, cross_product_t, hu, hc] +set_option backward.isDefEq.respectTransparency false in /-- Two standard parameterisations of CKM matrices are the same matrix if they have the same angles and the exponential of their faces is equal. -/ lemma eq_exp_of_phases (θ₁₂ θ₁₃ θ₂₃ δ₁₃ δ₁₃' : ℝ) (h : cexp (δ₁₃ * I) = cexp (δ₁₃' * I)) : @@ -97,6 +99,7 @@ lemma eq_exp_of_phases (θ₁₂ θ₁₃ θ₂₃ δ₁₃ δ₁₃' : ℝ) (h apply CKMMatrix_ext simp only [exp_neg, he] +set_option backward.isDefEq.respectTransparency false in open Invariant in lemma VusVubVcdSq_eq (θ₁₂ θ₁₃ θ₂₃ δ₁₃ : ℝ) (h1 : 0 ≤ Real.sin θ₁₂) (h2 : 0 ≤ Real.cos θ₁₃) (h3 : 0 ≤ Real.sin θ₂₃) (h4 : 0 ≤ Real.cos θ₁₂) : @@ -123,6 +126,7 @@ lemma VusVubVcdSq_eq (θ₁₂ θ₁₃ θ₂₃ δ₁₃ : ℝ) (h1 : 0 ≤ Rea · simp only [ne_eq, Decidable.not_not] at hx simp [hx] +set_option backward.isDefEq.respectTransparency false in open Invariant in lemma mulExpδ₁₃_eq (θ₁₂ θ₁₃ θ₂₃ δ₁₃ : ℝ) (h1 : 0 ≤ Real.sin θ₁₂) (h2 : 0 ≤ Real.cos θ₁₃) (h3 : 0 ≤ Real.sin θ₂₃) (h4 : 0 ≤ Real.cos θ₁₂) : diff --git a/Physlib/Particles/FlavorPhysics/CKMMatrix/StandardParameterization/StandardParameters.lean b/Physlib/Particles/FlavorPhysics/CKMMatrix/StandardParameterization/StandardParameters.lean index f7d2ceb7e1..fd28c332be 100644 --- a/Physlib/Particles/FlavorPhysics/CKMMatrix/StandardParameterization/StandardParameters.lean +++ b/Physlib/Particles/FlavorPhysics/CKMMatrix/StandardParameterization/StandardParameters.lean @@ -319,6 +319,7 @@ lemma mulExpδ₁₃_on_param_ne_zero_arg (V : CKMMatrix) (δ₁₃ : ℝ) simpa only [ne_eq, ofReal_eq_zero, norm_eq_zero] using h1 rw [← mul_right_inj' habs_ne_zero, ← h2] +set_option backward.isDefEq.respectTransparency false in lemma on_param_cos_θ₁₃_eq_zero {V : CKMMatrix} (δ₁₃ : ℝ) (h : Real.cos (θ₁₃ ⟦V⟧) = 0) : standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃ ≈ standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) 0 := by have hub := VubAbs_of_cos_θ₁₃_zero h @@ -329,6 +330,7 @@ lemma on_param_cos_θ₁₃_eq_zero {V : CKMMatrix} (δ₁₃ : ℝ) (h : Real.c Fin.sum_univ_three, ofReal_cos, ofReal_sin, S₁₃_eq_ℂsin_θ₁₃, C₁₂_eq_ℂcos_θ₁₂, S₁₂_eq_ℂsin_θ₁₂, S₁₃_of_Vub_one hub, C₁₂_of_Vub_one hub, S₁₂_of_Vub_one hub, h, exp_neg] +set_option backward.isDefEq.respectTransparency false in lemma on_param_cos_θ₁₂_eq_zero {V : CKMMatrix} (δ₁₃ : ℝ) (h : Real.cos (θ₁₂ ⟦V⟧) = 0) : standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃ ≈ standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) 0 := by use 0, δ₁₃, δ₁₃, -δ₁₃, 0, - δ₁₃ @@ -338,6 +340,7 @@ lemma on_param_cos_θ₁₂_eq_zero {V : CKMMatrix} (δ₁₃ : ℝ) (h : Real.c Fin.sum_univ_three, h, exp_neg] <;> field_simp +set_option backward.isDefEq.respectTransparency false in lemma on_param_cos_θ₂₃_eq_zero {V : CKMMatrix} (δ₁₃ : ℝ) (h : Real.cos (θ₂₃ ⟦V⟧) = 0) : standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃ ≈ standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) 0 := by use 0, δ₁₃, 0, 0, 0, - δ₁₃ @@ -347,6 +350,7 @@ lemma on_param_cos_θ₂₃_eq_zero {V : CKMMatrix} (δ₁₃ : ℝ) (h : Real.c Fin.sum_univ_three, h, exp_neg] <;> field_simp +set_option backward.isDefEq.respectTransparency false in lemma on_param_sin_θ₁₃_eq_zero {V : CKMMatrix} (δ₁₃ : ℝ) (h : Real.sin (θ₁₃ ⟦V⟧) = 0) : standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃ ≈ standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) 0 := by use 0, 0, 0, 0, 0, 0 @@ -355,6 +359,7 @@ lemma on_param_sin_θ₁₃_eq_zero {V : CKMMatrix} (δ₁₃ : ℝ) (h : Real.s simp [standParam, standParamAsMatrix, phaseShift, phaseShiftMatrix, mul_apply, Fin.sum_univ_three, h, exp_neg] +set_option backward.isDefEq.respectTransparency false in lemma on_param_sin_θ₁₂_eq_zero {V : CKMMatrix} (δ₁₃ : ℝ) (h : Real.sin (θ₁₂ ⟦V⟧) = 0) : standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃ ≈ standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) 0 := by use 0, δ₁₃, δ₁₃, 0, -δ₁₃, - δ₁₃ @@ -364,6 +369,7 @@ lemma on_param_sin_θ₁₂_eq_zero {V : CKMMatrix} (δ₁₃ : ℝ) (h : Real.s Fin.sum_univ_three, h, exp_neg] <;> field_simp +set_option backward.isDefEq.respectTransparency false in lemma on_param_sin_θ₂₃_eq_zero {V : CKMMatrix} (δ₁₃ : ℝ) (h : Real.sin (θ₂₃ ⟦V⟧) = 0) : standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃ ≈ standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) 0 := by use 0, 0, δ₁₃, 0, 0, - δ₁₃ diff --git a/Physlib/Particles/StandardModel/AnomalyCancellation/Basic.lean b/Physlib/Particles/StandardModel/AnomalyCancellation/Basic.lean index bfddec06fc..da86f49894 100644 --- a/Physlib/Particles/StandardModel/AnomalyCancellation/Basic.lean +++ b/Physlib/Particles/StandardModel/AnomalyCancellation/Basic.lean @@ -31,6 +31,7 @@ namespace SMCharges variable {n : ℕ} +set_option backward.isDefEq.respectTransparency false in lemma sum_SMSpecies_numberCharges_one {M} [AddCommMonoid M] (f : Fin (SMSpecies 1).numberCharges → M) : ∑ i, f i = f ⟨0, by simp⟩ := by @@ -61,6 +62,7 @@ lemma charges_eq_toSpecies_eq (S T : (SMCharges n).Charges) : apply toSpeciesEquiv.injective exact (Set.eqOn_univ (toSpeciesEquiv S) (toSpeciesEquiv T)).mp fun ⦃x⦄ _ => h x +set_option backward.isDefEq.respectTransparency false in lemma toSMSpecies_toSpecies_inv (i : Fin 5) (f : Fin 5 → Fin n → ℚ) : (toSpecies i) (toSpeciesEquiv.symm f) = f i := by change (toSpeciesEquiv ∘ toSpeciesEquiv.symm) _ i= f i @@ -89,6 +91,7 @@ open SMCharges variable {n : ℕ} +set_option backward.isDefEq.respectTransparency false in /-- The gravitational anomaly equation. -/ def accGrav : (SMCharges n).Charges →ₗ[ℚ] ℚ where toFun S := ∑ i, (6 * Q S i + 3 * U S i + 3 * D S i + 2 * L S i + E S i) @@ -107,6 +110,7 @@ def accGrav : (SMCharges n).Charges →ₗ[ℚ] ℚ where --rw [show Rat.cast a = a from rfl] ring +set_option backward.isDefEq.respectTransparency false in /-- Extensionality lemma for `accGrav`. -/ lemma accGrav_ext {S T : (SMCharges n).Charges} (hj : ∀ (j : Fin 5), ∑ i, (toSpecies j) S i = ∑ i, (toSpecies j) T i) : @@ -117,6 +121,7 @@ lemma accGrav_ext {S T : (SMCharges n).Charges} repeat rw [← Finset.mul_sum] simp_all +set_option backward.isDefEq.respectTransparency false in /-- The `SU(2)` anomaly equation. -/ def accSU2 : (SMCharges n).Charges →ₗ[ℚ] ℚ where toFun S := ∑ i, (3 * Q S i + L S i) @@ -135,6 +140,7 @@ def accSU2 : (SMCharges n).Charges →ₗ[ℚ] ℚ where --rw [show Rat.cast a = a from rfl] ring +set_option backward.isDefEq.respectTransparency false in /-- Extensionality lemma for `accSU2`. -/ lemma accSU2_ext {S T : (SMCharges n).Charges} (hj : ∀ (j : Fin 5), ∑ i, (toSpecies j) S i = ∑ i, (toSpecies j) T i) : @@ -145,6 +151,7 @@ lemma accSU2_ext {S T : (SMCharges n).Charges} repeat rw [← Finset.mul_sum] exact Mathlib.Tactic.LinearCombination.add_eq_eq (congrArg (HMul.hMul 3) (hj 0)) (hj 3) +set_option backward.isDefEq.respectTransparency false in /-- The `SU(3)` anomaly equations. -/ def accSU3 : (SMCharges n).Charges →ₗ[ℚ] ℚ where toFun S := ∑ i, (2 * Q S i + U S i + D S i) @@ -163,6 +170,7 @@ def accSU3 : (SMCharges n).Charges →ₗ[ℚ] ℚ where --rw [show Rat.cast a = a from rfl] ring +set_option backward.isDefEq.respectTransparency false in /-- Extensionality lemma for `accSU3`. -/ lemma accSU3_ext {S T : (SMCharges n).Charges} (hj : ∀ (j : Fin 5), ∑ i, (toSpecies j) S i = ∑ i, (toSpecies j) T i) : @@ -173,6 +181,7 @@ lemma accSU3_ext {S T : (SMCharges n).Charges} repeat rw [← Finset.mul_sum] simp_all +set_option backward.isDefEq.respectTransparency false in /-- The `Y²` anomaly equation. -/ def accYY : (SMCharges n).Charges →ₗ[ℚ] ℚ where toFun S := ∑ i, (Q S i + 8 * U S i + 2 * D S i + 3 * L S i @@ -191,6 +200,7 @@ def accYY : (SMCharges n).Charges →ₗ[ℚ] ℚ where repeat rw [← Finset.mul_sum] ring +set_option backward.isDefEq.respectTransparency false in /-- Extensionality lemma for `accYY`. -/ lemma accYY_ext {S T : (SMCharges n).Charges} (hj : ∀ (j : Fin 5), ∑ i, (toSpecies j) S i = ∑ i, (toSpecies j) T i) : @@ -201,6 +211,7 @@ lemma accYY_ext {S T : (SMCharges n).Charges} repeat rw [← Finset.mul_sum] simp_all +set_option backward.isDefEq.respectTransparency false in /-- The quadratic bilinear map. -/ @[simps!] def quadBiLin : BiLinearSymm (SMCharges n).Charges := BiLinearSymm.mk₂ @@ -253,6 +264,7 @@ lemma accQuad_ext {S T : (SMCharges n).Charges} ring_nf simp_all +set_option backward.isDefEq.respectTransparency false in /-- The trilinear function defining the cubic. -/ @[simps!] def cubeTriLin : TriLinearSymm (SMCharges n).Charges := TriLinearSymm.mk₃ diff --git a/Physlib/Particles/StandardModel/AnomalyCancellation/FamilyMaps.lean b/Physlib/Particles/StandardModel/AnomalyCancellation/FamilyMaps.lean index a0730be03e..0ab7eb2385 100644 --- a/Physlib/Particles/StandardModel/AnomalyCancellation/FamilyMaps.lean +++ b/Physlib/Particles/StandardModel/AnomalyCancellation/FamilyMaps.lean @@ -20,6 +20,7 @@ open SMCharges open SMACCs open BigOperators +set_option backward.isDefEq.respectTransparency false in /-- Given a map of for a generic species, the corresponding map for charges. -/ @[simps!] def chargesMapOfSpeciesMap {n m : ℕ} (f : (SMSpecies n).Charges →ₗ[ℚ] (SMSpecies m).Charges) : @@ -51,6 +52,7 @@ def speciesFamilyProj {m n : ℕ} (h : n ≤ m) : def familyProjection {m n : ℕ} (h : n ≤ m) : (SMCharges m).Charges →ₗ[ℚ] (SMCharges n).Charges := chargesMapOfSpeciesMap (speciesFamilyProj h) +set_option backward.isDefEq.respectTransparency false in /-- For species, the embedding of the `m`-family charges onto the `n`-family charges, with all other charges zero. -/ @[simps!] diff --git a/Physlib/Particles/StandardModel/AnomalyCancellation/NoGrav/Basic.lean b/Physlib/Particles/StandardModel/AnomalyCancellation/NoGrav/Basic.lean index d7da16d488..1a5bbf58ba 100644 --- a/Physlib/Particles/StandardModel/AnomalyCancellation/NoGrav/Basic.lean +++ b/Physlib/Particles/StandardModel/AnomalyCancellation/NoGrav/Basic.lean @@ -40,12 +40,14 @@ namespace SMNoGrav variable {n : ℕ} +set_option backward.isDefEq.respectTransparency false in /-- The charges in `(SMNoGrav n).LinSols` satisfy the `SU(2)` anomaly-equation. -/ lemma SU2Sol (S : (SMNoGrav n).LinSols) : accSU2 S.val = 0 := by have hS := S.linearSol simp only [SMNoGrav_linearACCs] at hS exact hS ⟨0, by simp⟩ +set_option backward.isDefEq.respectTransparency false in /-- The charges in `(SMNoGrav n).LinSols` satisfy the `SU(3)` anomaly-equation. -/ lemma SU3Sol (S : (SMNoGrav n).LinSols) : accSU3 S.val = 0 := by have hS := S.linearSol diff --git a/Physlib/Particles/StandardModel/AnomalyCancellation/NoGrav/One/Lemmas.lean b/Physlib/Particles/StandardModel/AnomalyCancellation/NoGrav/One/Lemmas.lean index 44a8d06438..4f3e74ddcc 100644 --- a/Physlib/Particles/StandardModel/AnomalyCancellation/NoGrav/One/Lemmas.lean +++ b/Physlib/Particles/StandardModel/AnomalyCancellation/NoGrav/One/Lemmas.lean @@ -10,9 +10,13 @@ public import Physlib.Particles.StandardModel.AnomalyCancellation.NoGrav.One.Lin # Lemmas for 1 family SM Accs The main result of this file is the conclusion of this paper: - [Lohitsiri and Tong][Lohitsiri:2019fuu] + [Lohitsiri and Tong][Lohitsiri:2019fuu] [ref: Lohitsiri:2019fuu] That every solution to the ACCs without gravity satisfies for free the gravitational anomaly. + +## References + +* The main result of this file is the conclusion of this paper. [ref: Lohitsiri:2019fuu] -/ @[expose] public section @@ -36,6 +40,7 @@ lemma E_zero_iff_Q_zero {S : (SMNoGrav 1).Sols} : Q S.val (0 : Fin 1) = 0 ↔ rw [← hS'] at hC exact ⟨S'.cubic_zero_Q'_zero hC, S'.cubic_zero_E'_zero hC⟩ +set_option backward.isDefEq.respectTransparency false in /-- For a set of 1-family SM charges satisfying all ACCs except the gravitational, if the `Q` charge is zero then the charges satisfy the gravitational ACCs. -/ lemma accGrav_Q_zero {S : (SMNoGrav 1).Sols} (hQ : Q S.val (0 : Fin 1) = 0) : diff --git a/Physlib/Particles/StandardModel/AnomalyCancellation/NoGrav/One/LinearParameterization.lean b/Physlib/Particles/StandardModel/AnomalyCancellation/NoGrav/One/LinearParameterization.lean index efb447d2f4..24bf3cb20e 100644 --- a/Physlib/Particles/StandardModel/AnomalyCancellation/NoGrav/One/LinearParameterization.lean +++ b/Physlib/Particles/StandardModel/AnomalyCancellation/NoGrav/One/LinearParameterization.lean @@ -14,8 +14,10 @@ In this file we give two parameterizations - `linearParameters` of solutions to the linear ACCs for 1 family - `linearParametersQENeqZero` of solutions to the linear ACCs for 1 family with Q and E non-zero -These parameterizations are based on: -https://arxiv.org/abs/1907.00514 +## References + +* These parameterizations are based on https://arxiv.org/abs/1907.00514. + [ref: Lohitsiri:2019fuu] -/ @[expose] public section @@ -66,6 +68,7 @@ lemma speciesVal (S : linearParameters) : | 3 => rfl | 4 => rfl +set_option backward.isDefEq.respectTransparency false in lemma toSpecies_apply_asCharges (S : linearParameters) (i : Fin 5) : toSpecies i S.asCharges = fun _ => S.asCharges i := by funext j diff --git a/Physlib/Particles/StandardModel/AnomalyCancellation/Permutations.lean b/Physlib/Particles/StandardModel/AnomalyCancellation/Permutations.lean index 0c3267d4dc..ab03e770d6 100644 --- a/Physlib/Particles/StandardModel/AnomalyCancellation/Permutations.lean +++ b/Physlib/Particles/StandardModel/AnomalyCancellation/Permutations.lean @@ -54,7 +54,7 @@ def repCharges {n : ℕ} : Representation ℚ (PermGroup n) (SMCharges n).Charge intro S rw [charges_eq_toSpecies_eq] intro i - simp only [chargeMap_apply, Pi.inv_apply, Module.End.mul_apply] + simp only [Module.End.mul_apply] erw [toSMSpecies_toSpecies_inv, toSMSpecies_toSpecies_inv, toSMSpecies_toSpecies_inv] rfl map_one' := by @@ -78,22 +78,26 @@ lemma toSpecies_sum_invariant (m : ℕ) (f : PermGroup n) (S : (SMCharges n).Cha rw [repCharges_toSpecies] exact Equiv.sum_comp (f⁻¹ j) ((fun a => a ^ m) ∘ toSpecies j S) +set_option backward.isDefEq.respectTransparency false in /-- The gravitational anomaly equations is invariant under family permutations. -/ lemma accGrav_invariant (f : PermGroup n) (S : (SMCharges n).Charges) : accGrav (repCharges f S) = accGrav S := accGrav_ext (by simpa using toSpecies_sum_invariant 1 f S) +set_option backward.isDefEq.respectTransparency false in /-- The `SU(2)` anomaly equation is invariant under family permutations. -/ lemma accSU2_invariant (f : PermGroup n) (S : (SMCharges n).Charges) : accSU2 (repCharges f S) = accSU2 S := accSU2_ext (by simpa using toSpecies_sum_invariant 1 f S) +set_option backward.isDefEq.respectTransparency false in /-- The `SU(3)` anomaly equation is invariant under family permutations. -/ lemma accSU3_invariant (f : PermGroup n) (S : (SMCharges n).Charges) : accSU3 (repCharges f S) = accSU3 S := accSU3_ext (by simpa using toSpecies_sum_invariant 1 f S) +set_option backward.isDefEq.respectTransparency false in /-- The `Y²` anomaly equation is invariant under family permutations. -/ lemma accYY_invariant (f : PermGroup n) (S : (SMCharges n).Charges) : accYY (repCharges f S) = accYY S := diff --git a/Physlib/Particles/StandardModel/Basic.lean b/Physlib/Particles/StandardModel/Basic.lean index d1a8993ddd..246f77a1d5 100644 --- a/Physlib/Particles/StandardModel/Basic.lean +++ b/Physlib/Particles/StandardModel/Basic.lean @@ -13,6 +13,10 @@ public import Mathlib.RingTheory.RootsOfUnity.Complex This file defines the basic properties of the standard model in particle physics. +## References + +* Baez's Grand Unified Theories notes, cited throughout below. [ref: baez_guts_notes] + -/ @[expose] public section @@ -281,7 +285,7 @@ lemma gaugeGroupℤ₆Hom_toU1 (α : rootsOfUnity 6 ℂ) : standard model, i.e., the ℤ₆-subgroup of `GaugeGroupI` with elements `(α^2 * I₃, α^(-3) * I₂, α)`, where `α` is a sixth complex root of unity. -See https://math.ucr.edu/home/baez/guts.pdf +See https://math.ucr.edu/home/baez/guts.pdf [ref: baez_guts_notes] -/ noncomputable def gaugeGroupℤ₆SubGroup : Subgroup GaugeGroupI := gaugeGroupℤ₆Hom.range @@ -307,7 +311,7 @@ instance gaugeGroupℤ₆SubGroup_normal : gaugeGroupℤ₆SubGroup.Normal where /-- The smallest possible gauge group of the Standard Model, i.e., the quotient of `GaugeGroupI` by the ℤ₆-subgroup `gaugeGroupℤ₆SubGroup`. -See https://math.ucr.edu/home/baez/guts.pdf +See https://math.ucr.edu/home/baez/guts.pdf [ref: baez_guts_notes] -/ def GaugeGroupℤ₆ : Type := GaugeGroupI ⧸ gaugeGroupℤ₆SubGroup @@ -388,7 +392,7 @@ lemma gaugeGroupℤ₂Hom_toU1 (α : rootsOfUnity 2 ℂ) : standard model, i.e., the ℤ₂-subgroup of `GaugeGroupI` derived from the ℤ₂ subgroup of `gaugeGroupℤ₆SubGroup`. -See https://math.ucr.edu/home/baez/guts.pdf +See https://math.ucr.edu/home/baez/guts.pdf [ref: baez_guts_notes] -/ noncomputable def gaugeGroupℤ₂SubGroup : Subgroup GaugeGroupI := gaugeGroupℤ₂Hom.range @@ -418,7 +422,7 @@ instance gaugeGroupℤ₂SubGroup_normal : gaugeGroupℤ₂SubGroup.Normal where /-- The gauge group of the Standard Model with a ℤ₂ quotient, i.e., the quotient of `GaugeGroupI` by the ℤ₂-subgroup `gaugeGroupℤ₂SubGroup`. -See https://math.ucr.edu/home/baez/guts.pdf +See https://math.ucr.edu/home/baez/guts.pdf [ref: baez_guts_notes] -/ def GaugeGroupℤ₂ : Type := GaugeGroupI ⧸ gaugeGroupℤ₂SubGroup @@ -499,7 +503,7 @@ lemma gaugeGroupℤ₃Hom_toU1 (α : rootsOfUnity 3 ℂ) : standard model, i.e., the ℤ₃-subgroup of `GaugeGroupI` derived from the ℤ₃ subgroup of `gaugeGroupℤ₆SubGroup`. -See https://math.ucr.edu/home/baez/guts.pdf +See https://math.ucr.edu/home/baez/guts.pdf [ref: baez_guts_notes] -/ noncomputable def gaugeGroupℤ₃SubGroup : Subgroup GaugeGroupI := gaugeGroupℤ₃Hom.range @@ -529,7 +533,7 @@ instance gaugeGroupℤ₃SubGroup_normal : gaugeGroupℤ₃SubGroup.Normal where /-- The gauge group of the Standard Model with a ℤ₃-quotient, i.e., the quotient of `GaugeGroupI` by the ℤ₃-subgroup `gaugeGroupℤ₃SubGroup`. -See https://math.ucr.edu/home/baez/guts.pdf +See https://math.ucr.edu/home/baez/guts.pdf [ref: baez_guts_notes] -/ def GaugeGroupℤ₃ : Type := GaugeGroupI ⧸ gaugeGroupℤ₃SubGroup @@ -556,6 +560,7 @@ end GaugeGroupℤ₃ -/ +set_option backward.isDefEq.respectTransparency false in /-- Specifies the allowed quotients of `SU(3) x SU(2) x U(1)` which give a valid gauge group of the Standard Model. -/ inductive GaugeGroupQuot : Type @@ -576,7 +581,7 @@ deriving Fintype, DecidableEq `GaugeGroupQuot` to `Type` which gives the gauge group of the Standard Model for a given choice of quotient. -See https://math.ucr.edu/home/baez/guts.pdf +See https://math.ucr.edu/home/baez/guts.pdf [ref: baez_guts_notes] -/ def GaugeGroup : GaugeGroupQuot → Type | .ℤ₆ => GaugeGroupℤ₆ diff --git a/Physlib/Particles/StandardModel/HiggsBoson/Basic.lean b/Physlib/Particles/StandardModel/HiggsBoson/Basic.lean index 11791b1b20..af6111aac1 100644 --- a/Physlib/Particles/StandardModel/HiggsBoson/Basic.lean +++ b/Physlib/Particles/StandardModel/HiggsBoson/Basic.lean @@ -64,9 +64,8 @@ In this module we define the Higgs field and prove some basic properties. ## iv. References -- The particle data group has properties of the Higgs boson - [Review of Particle Physics, PDG][ParticleDataGroup:2018ovx] - +* The particle data group has properties of the Higgs boson Review of Particle Physics, PDG. + [ref: ParticleDataGroup:2018ovx] -/ @[expose] public section diff --git a/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/B3.lean b/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/B3.lean index 2cba2d097a..4d42de88f2 100644 --- a/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/B3.lean +++ b/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/B3.lean @@ -14,10 +14,7 @@ We define `B₃` and show that it is a double point of the cubic. # References -The main reference for the material in this file is: - -[Allanach, Madigan and Tooby-Smith][Allanach:2021yjy] - +* The main reference for the material in this file. [ref: Allanach:2021yjy] -/ @[expose] public section diff --git a/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Basic.lean b/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Basic.lean index 01d37a111c..b3a1d21f34 100644 --- a/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Basic.lean +++ b/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Basic.lean @@ -125,6 +125,7 @@ namespace MSSMACCs open MSSMCharges +set_option backward.isDefEq.respectTransparency false in /-- The gravitational anomaly equation. -/ def accGrav : MSSMCharges.Charges →ₗ[ℚ] ℚ where toFun S := ∑ i, (6 * Q S i + 3 * U S i + 3 * D S i @@ -138,6 +139,7 @@ def accGrav : MSSMCharges.Charges →ₗ[ℚ] ℚ where simp only [HSMul.hSMul, SMul.smul, sum_MSSMSpecies_numberCharges_eq_expand] ring +set_option backward.isDefEq.respectTransparency false in /-- Extensionality lemma for `accGrav`. -/ lemma accGrav_ext {S T : MSSMCharges.Charges} (hj : ∀ (j : Fin 6), ∑ i, (toSMSpecies j) S i = ∑ i, (toSMSpecies j) T i) @@ -146,6 +148,7 @@ lemma accGrav_ext {S T : MSSMCharges.Charges} simp only [accGrav, LinearMap.coe_mk, AddHom.coe_mk, Finset.sum_add_distrib, ← Finset.mul_sum, hj, hd, hu] +set_option backward.isDefEq.respectTransparency false in /-- The anomaly cancellation condition for SU(2) anomaly. -/ def accSU2 : MSSMCharges.Charges →ₗ[ℚ] ℚ where toFun S := ∑ i, (3 * Q S i + L S i) + Hd S + Hu S @@ -158,6 +161,7 @@ def accSU2 : MSSMCharges.Charges →ₗ[ℚ] ℚ where simp only [HSMul.hSMul, SMul.smul, sum_MSSMSpecies_numberCharges_eq_expand] ring +set_option backward.isDefEq.respectTransparency false in /-- Extensionality lemma for `accSU2`. -/ lemma accSU2_ext {S T : MSSMCharges.Charges} (hj : ∀ (j : Fin 6), ∑ i, (toSMSpecies j) S i = ∑ i, (toSMSpecies j) T i) @@ -166,6 +170,7 @@ lemma accSU2_ext {S T : MSSMCharges.Charges} simp only [accSU2, LinearMap.coe_mk, AddHom.coe_mk, Finset.sum_add_distrib, ← Finset.mul_sum, hj, hd, hu] +set_option backward.isDefEq.respectTransparency false in /-- The anomaly cancellation condition for SU(3) anomaly. -/ def accSU3 : MSSMCharges.Charges →ₗ[ℚ] ℚ where toFun S := ∑ i, (2 * (Q S i) + (U S i) + (D S i)) @@ -178,6 +183,7 @@ def accSU3 : MSSMCharges.Charges →ₗ[ℚ] ℚ where simp only [HSMul.hSMul, SMul.smul, sum_MSSMSpecies_numberCharges_eq_expand] ring +set_option backward.isDefEq.respectTransparency false in /-- Extensionality lemma for `accSU3`. -/ lemma accSU3_ext {S T : MSSMCharges.Charges} (hj : ∀ (j : Fin 6), ∑ i, (toSMSpecies j) S i = ∑ i, (toSMSpecies j) T i) : @@ -185,6 +191,7 @@ lemma accSU3_ext {S T : MSSMCharges.Charges} simp only [accSU3, LinearMap.coe_mk, AddHom.coe_mk, Finset.sum_add_distrib, ← Finset.mul_sum, hj] +set_option backward.isDefEq.respectTransparency false in /-- The ACC for `Y²`. -/ def accYY : MSSMCharges.Charges →ₗ[ℚ] ℚ where toFun S := ∑ i, ((Q S) i + 8 * (U S) i + 2 * (D S) i + 3 * (L S) i @@ -198,6 +205,7 @@ def accYY : MSSMCharges.Charges →ₗ[ℚ] ℚ where simp only [HSMul.hSMul, SMul.smul, sum_MSSMSpecies_numberCharges_eq_expand] ring +set_option backward.isDefEq.respectTransparency false in /-- Extensionality lemma for `accGrav`. -/ lemma accYY_ext {S T : MSSMCharges.Charges} (hj : ∀ (j : Fin 6), ∑ i, (toSMSpecies j) S i = ∑ i, (toSMSpecies j) T i) @@ -206,6 +214,7 @@ lemma accYY_ext {S T : MSSMCharges.Charges} simp only [accYY, LinearMap.coe_mk, AddHom.coe_mk, Finset.sum_add_distrib, ← Finset.mul_sum, hj, hd, hu] +set_option backward.isDefEq.respectTransparency false in /-- The symmetric bilinear function used to define the quadratic ACC. -/ @[simps!] def quadBiLin : BiLinearSymm MSSMCharges.Charges := BiLinearSymm.mk₂ @@ -284,6 +293,7 @@ lemma cubeTriLinToFun_map_smul₁ (a : ℚ) (S T R : MSSMCharges.Charges) : simp only [HSMul.hSMul, SMul.smul, sum_MSSMSpecies_numberCharges_eq_expand] ring +set_option backward.isDefEq.respectTransparency false in lemma cubeTriLinToFun_map_add₁ (S T R L : MSSMCharges.Charges) : cubeTriLinToFun (S + T, R, L) = cubeTriLinToFun (S, R, L) + cubeTriLinToFun (T, R, L) := by simp only [cubeTriLinToFun, map_add, ACCSystemCharges.chargesAddCommMonoid_add, @@ -420,8 +430,8 @@ def dot : BiLinearSymm MSSMCharges.Charges := BiLinearSymm.mk₂ ring) (by intro S1 S2 T - simp only [toSMSpecies_apply, Fin.isValue, - ACCSystemCharges.chargesAddCommMonoid_add, map_add, Hd_apply, Fin.reduceFinMk, Hu_apply] + simp only [map_add, ACCSystemCharges.chargesAddCommMonoid_add] + simp only [toSMSpecies_apply, Fin.isValue, Hd_apply, Fin.reduceFinMk, Hu_apply] simp only [reduceMul, Fin.isValue, sum_MSSMSpecies_numberCharges_eq_expand, Fin.zero_eta, Fin.mk_one] simp only [Fin.isValue, Prod.mk_zero_zero, Prod.mk_one_one] diff --git a/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/LineY3B3.lean b/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/LineY3B3.lean index 8bbce90b0c..7543f1cdfe 100644 --- a/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/LineY3B3.lean +++ b/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/LineY3B3.lean @@ -16,9 +16,7 @@ is a solution to the quadratic `lineY₃B₃Charges_quad` and a double point of # References -The main reference for the material in this file is: -[Allanach, Madigan and Tooby-Smith][Allanach:2021yjy] - +* The main reference for the material in this file. [ref: Allanach:2021yjy] -/ @[expose] public section diff --git a/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/OrthogY3B3/Basic.lean b/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/OrthogY3B3/Basic.lean index 2c038fff98..0074b53a78 100644 --- a/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/OrthogY3B3/Basic.lean +++ b/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/OrthogY3B3/Basic.lean @@ -14,10 +14,8 @@ about them. # References -The main reference for the material in this file is: - -- https://arxiv.org/pdf/2107.07926.pdf - +* The main reference for the material in this file is https://arxiv.org/pdf/2107.07926.pdf. + [ref: Allanach:2021yjy] -/ @[expose] public section diff --git a/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/OrthogY3B3/PlaneWithY3B3.lean b/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/OrthogY3B3/PlaneWithY3B3.lean index dae9178f85..82b18a4a65 100644 --- a/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/OrthogY3B3/PlaneWithY3B3.lean +++ b/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/OrthogY3B3/PlaneWithY3B3.lean @@ -13,8 +13,7 @@ The plane spanned by Y₃, B₃ and third orthogonal point. # References -- https://arxiv.org/pdf/2107.07926.pdf - +* https://arxiv.org/pdf/2107.07926.pdf. [ref: Allanach:2021yjy] -/ @[expose] public section diff --git a/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/OrthogY3B3/ToSols.lean b/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/OrthogY3B3/ToSols.lean index f1d2b34699..94bd16b821 100644 --- a/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/OrthogY3B3/ToSols.lean +++ b/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/OrthogY3B3/ToSols.lean @@ -19,10 +19,8 @@ surjection on certain subtypes of `MSSMACC.Sols`. # References -The main reference for the material in this file is: - -- https://arxiv.org/pdf/2107.07926.pdf - +* The main reference for the material in this file is https://arxiv.org/pdf/2107.07926.pdf. + [ref: Allanach:2021yjy] -/ @[expose] public section @@ -264,6 +262,7 @@ lemma inLineEqTo_smul (R : InLineEq) (c₁ c₂ c₃ d : ℚ) : rw [lineQuad_smul] rfl +set_option backward.isDefEq.respectTransparency false in lemma inLineEqToSol_proj (T : InLineEqSol) : inLineEqToSol (inLineEqProj T) = T.val := by rw [inLineEqProj, inLineEqTo_smul] apply ACCSystem.Sols.ext @@ -307,6 +306,7 @@ def inQuadProj (T : InQuadSol) : InQuad × ℚ × ℚ × ℚ := - cubeTriLin T.val.val T.val.val Y₃.val * (dot Y₃.val T.val.val - 2 * dot B₃.val T.val.val))) +set_option backward.isDefEq.respectTransparency false in lemma inQuadToSol_proj (T : InQuadSol) : inQuadToSol (inQuadProj T) = T.val := by rw [inQuadProj, inQuadToSol_smul] apply ACCSystem.Sols.ext @@ -345,6 +345,7 @@ def inQuadCubeProj (T : InQuadCubeSol) : InQuadCube × ℚ × ℚ × ℚ := (dot Y₃.val B₃.val)⁻¹ * (2 * dot B₃.val T.val.val - dot Y₃.val T.val.val), (dot Y₃.val B₃.val)⁻¹ * 1) +set_option backward.isDefEq.respectTransparency false in lemma inQuadCubeToSol_proj (T : InQuadCubeSol) : inQuadCubeToSol (inQuadCubeProj T) = T.val := by rw [inQuadCubeProj, inQuadCubeToSol_smul] diff --git a/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Permutations.lean b/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Permutations.lean index 9e648b0e31..93f812d294 100644 --- a/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Permutations.lean +++ b/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Permutations.lean @@ -56,6 +56,7 @@ lemma chargeMap_toSpecies (f : PermGroup) (S : MSSMCharges.Charges) (j : Fin 6) toSMSpecies j (chargeMap f S) = toSMSpecies j S ∘ f j := toSMSpecies_toSpecies_inv _ _ +set_option backward.isDefEq.respectTransparency false in /-- The representation of `permGroup` acting on the vector space of charges. -/ @[simp] def repCharges : Representation ℚ PermGroup (MSSMCharges).Charges where @@ -96,6 +97,7 @@ lemma Hd_invariant (f : PermGroup) (S : MSSMCharges.Charges) : lemma Hu_invariant (f : PermGroup) (S : MSSMCharges.Charges) : Hu (repCharges f S) = Hu S := rfl +set_option backward.isDefEq.respectTransparency false in lemma accGrav_invariant (f : PermGroup) (S : MSSMCharges.Charges) : accGrav (repCharges f S) = accGrav S := accGrav_ext @@ -103,6 +105,7 @@ lemma accGrav_invariant (f : PermGroup) (S : MSSMCharges.Charges) : (Hd_invariant f S) (Hu_invariant f S) +set_option backward.isDefEq.respectTransparency false in lemma accSU2_invariant (f : PermGroup) (S : MSSMCharges.Charges) : accSU2 (repCharges f S) = accSU2 S := accSU2_ext @@ -110,11 +113,13 @@ lemma accSU2_invariant (f : PermGroup) (S : MSSMCharges.Charges) : (Hd_invariant f S) (Hu_invariant f S) +set_option backward.isDefEq.respectTransparency false in lemma accSU3_invariant (f : PermGroup) (S : MSSMCharges.Charges) : accSU3 (repCharges f S) = accSU3 S := accSU3_ext (by simpa using toSpecies_sum_invariant 1 f S) +set_option backward.isDefEq.respectTransparency false in lemma accYY_invariant (f : PermGroup) (S : MSSMCharges.Charges) : accYY (repCharges f S) = accYY S := accYY_ext diff --git a/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Y3.lean b/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Y3.lean index 87a0f57c44..b3740aada4 100644 --- a/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Y3.lean +++ b/Physlib/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Y3.lean @@ -14,10 +14,8 @@ We define $Y_3$ and show that it is a double point of the cubic. # References -The main reference for the material in this file is: - -- https://arxiv.org/pdf/2107.07926.pdf - +* The main reference for the material in this file is https://arxiv.org/pdf/2107.07926.pdf. + [ref: Allanach:2021yjy] -/ @[expose] public section diff --git a/Physlib/Particles/SuperSymmetry/N1/Basic.lean b/Physlib/Particles/SuperSymmetry/N1/Basic.lean index 2593d8f7bf..e36ed003ba 100644 --- a/Physlib/Particles/SuperSymmetry/N1/Basic.lean +++ b/Physlib/Particles/SuperSymmetry/N1/Basic.lean @@ -82,6 +82,7 @@ is real. The species can express none of these alone. ## iv. References +* None. -/ @[expose] public section @@ -410,6 +411,7 @@ def conjChiralCovector permT ![0] ⟨by decide, fun i => by fin_cases i; rfl⟩ ((chiralTensor (ι := ι)).conjT t) +set_option backward.isDefEq.respectTransparency false in /-- For scalar tensors, `toField` of the normalized tensor conjugate is the complex conjugate of `toField`. -/ lemma toField_conjScalar (t : (chiralTensor (ι := ι)).Tensor ![]) : @@ -422,6 +424,7 @@ lemma toField_conjScalar (t : (chiralTensor (ι := ι)).Tensor ![]) : erw [ConjTensorSpecies.componentMap_conjT (S := chiralTensor (ι := ι))] rfl +set_option backward.isDefEq.respectTransparency false in /-- Component formula for the holomorphic covector conjugate: the `![I]` basis component of `conjChiralCovector t` is the complex conjugate of the `![I]` component of `t`. -/ lemma repr_conjChiralCovector diff --git a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/AllowsTerm.lean b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/AllowsTerm.lean index 44d333bc4b..7088ade366 100644 --- a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/AllowsTerm.lean +++ b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/AllowsTerm.lean @@ -70,8 +70,7 @@ charge spectrum `x`, leads to a zero charge in the charges of potential term `T` ## iv. References -There are no known references for the results in this file. - +* None. -/ @[expose] public section diff --git a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/Basic.lean b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/Basic.lean index a5cb1404aa..8bb28c3509 100644 --- a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/Basic.lean +++ b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/Basic.lean @@ -52,9 +52,8 @@ of the charge spectrum, which can help in searching for viable theories. ## iv. References -There are no known references for charge spectra in the literature. -They were created specifically for the purpose of Physlib. - +* None — these charge spectra were created specifically for the purpose of + Physlib; there is no external reference. -/ @[expose] public section diff --git a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/Completions.lean b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/Completions.lean index 29aadf48a7..3d489d14fe 100644 --- a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/Completions.lean +++ b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/Completions.lean @@ -49,8 +49,7 @@ are complete, and have their charges in the given subsets. ## iv. References -There are no known references for the material in this module. - +* None. -/ @[expose] public section diff --git a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/Map.lean b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/Map.lean index 78e62cd0bd..bf20366f4c 100644 --- a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/Map.lean +++ b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/Map.lean @@ -65,8 +65,7 @@ a computationally efficient way. ## iv. References -There are no known references for the material in this module. - +* None. -/ @[expose] public section diff --git a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimalSuperSet.lean b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimalSuperSet.lean index 15604132a0..ec8daccf59 100644 --- a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimalSuperSet.lean +++ b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimalSuperSet.lean @@ -42,8 +42,7 @@ In this file we define the minimal super set and prove some basic properties of ## iv. References -There are no known references for the material in this file. - +* None. -/ @[expose] public section diff --git a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/Basic.lean b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/Basic.lean index 18c82be285..eef368fc4a 100644 --- a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/Basic.lean +++ b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/Basic.lean @@ -49,7 +49,7 @@ We show that every charge spectrum which minimally allows `T` is of the form ## iv. References -There are no known references for this material. +* None. -/ @[expose] public section diff --git a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/FinsetTerms.lean b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/FinsetTerms.lean index ae698b6a93..2df57567be 100644 --- a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/FinsetTerms.lean +++ b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/FinsetTerms.lean @@ -43,8 +43,7 @@ We have special focus on those charge spectra which minimally allow a top and bo ## iv. References -There are no references for this module. - +* None. -/ @[expose] public section diff --git a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/OfFinset.lean b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/OfFinset.lean index ddb4dd7cda..37d8e5340f 100644 --- a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/OfFinset.lean +++ b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/OfFinset.lean @@ -51,8 +51,7 @@ from a finset. ## iv. References -There are no known references for the material in this module. - +* None. -/ @[expose] public section diff --git a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/OfFieldLabel.lean b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/OfFieldLabel.lean index 5856b9a6c9..4d3471ff25 100644 --- a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/OfFieldLabel.lean +++ b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/OfFieldLabel.lean @@ -38,8 +38,7 @@ terms in the potential. ## iv. References -There are no known references for the results in this file. - +* None. -/ @[expose] public section diff --git a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/OfPotentialTerm.lean b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/OfPotentialTerm.lean index e8c9432aa7..2f9708b837 100644 --- a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/OfPotentialTerm.lean +++ b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/OfPotentialTerm.lean @@ -47,8 +47,7 @@ We will show that these two multisets have the same elements. ## iv. References -There are no known references for this material. - +* None. -/ @[expose] public section diff --git a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/PhenoClosed.lean b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/PhenoClosed.lean index 50135936be..8f47f20bae 100644 --- a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/PhenoClosed.lean +++ b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/PhenoClosed.lean @@ -61,8 +61,7 @@ which include three which are defined in this file: `IsPhenoClosedQ5`, `IsPhenoC ## iv. References -There are no known references for the material in this module. - +* None. -/ @[expose] public section diff --git a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/PhenoConstrained.lean b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/PhenoConstrained.lean index bfd14fa6bd..c77006b80b 100644 --- a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/PhenoConstrained.lean +++ b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/PhenoConstrained.lean @@ -51,8 +51,7 @@ We define some variations of this result. ## iv. References -There are no known references for the material in this file. - +* None. -/ @[expose] public section diff --git a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/Yukawa.lean b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/Yukawa.lean index 18c56f7fc1..674a56cced 100644 --- a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/Yukawa.lean +++ b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/Yukawa.lean @@ -44,8 +44,7 @@ this module. ## iv. References -There are no known references for this module. - +* None. -/ @[expose] public section diff --git a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/ZMod.lean b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/ZMod.lean index 4dd3ee52d0..86a3bf0424 100644 --- a/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/ZMod.lean +++ b/Physlib/Particles/SuperSymmetry/SU5/ChargeSpectrum/ZMod.lean @@ -52,8 +52,7 @@ In other files we usually just consider one. ## iv. References -There are no known references for the material in this module. - +* None. -/ @[expose] public section diff --git a/Physlib/Particles/SuperSymmetry/SU5/FieldLabels.lean b/Physlib/Particles/SuperSymmetry/SU5/FieldLabels.lean index a9b8fd5c78..95dc060524 100644 --- a/Physlib/Particles/SuperSymmetry/SU5/FieldLabels.lean +++ b/Physlib/Particles/SuperSymmetry/SU5/FieldLabels.lean @@ -32,6 +32,7 @@ The key results are ## iv. References +* None. -/ @[expose] public section @@ -59,7 +60,11 @@ inductive FieldLabel | fiveBarMatter | fiveMatter | tenMatter -deriving DecidableEq, Fintype +deriving DecidableEq + +instance : Fintype FieldLabel where + elems := {.fiveBarHu, .fiveHu, .fiveBarHd, .fiveHd, .fiveBarMatter, .fiveMatter, .tenMatter} + complete := fun x => by cases x <;> decide /-! diff --git a/Physlib/Particles/SuperSymmetry/SU5/Potential.lean b/Physlib/Particles/SuperSymmetry/SU5/Potential.lean index 1954ab245d..eaedbe317c 100644 --- a/Physlib/Particles/SuperSymmetry/SU5/Potential.lean +++ b/Physlib/Particles/SuperSymmetry/SU5/Potential.lean @@ -45,9 +45,8 @@ The terms of the Kahler potential are: ## iv. References -- The main reference for the terms, and notation used in this module is: arXiv:0912.0853 -A previous version of this code was replaced in PR#569. - +* The main reference for the terms, and notation used in this module is: arXiv:0912.0853 A previous + version of this code was replaced in PR#569. [ref: arxiv_0912_0853] -/ @[expose] public section @@ -65,6 +64,7 @@ present in both the super-potential and Kahler potential. -/ +set_option backward.isDefEq.respectTransparency false in /-- Relevant terms part of the superpotential and Kahler potential of the `SU(5)` SUSY GUT. -/ inductive PotentialTerm /-- The term `μ 5Hu 5̄Hd` appearing in the super-potential. -/ diff --git a/Physlib/QFT/AnomalyCancellation/Basic.lean b/Physlib/QFT/AnomalyCancellation/Basic.lean index 195bcf00ba..4653d24369 100644 --- a/Physlib/QFT/AnomalyCancellation/Basic.lean +++ b/Physlib/QFT/AnomalyCancellation/Basic.lean @@ -70,12 +70,10 @@ Related to these are the different types of spaces of charges: ## iv. References -Some references on anomaly cancellation conditions are: -- Alvarez-Gaume, L. and Ginsparg, P. H. (1985). The Structure of Gauge and -Gravitational Anomalies. -- Bilal, A. (2008). Lectures on Anomalies. arXiv preprint. -- Nash, C. (1991). Differential topology and quantum field theory. Elsevier. - +* Alvarez-Gaume, L. and Ginsparg, P. H. (1985). The Structure of Gauge and Gravitational Anomalies. + [ref: alvarez_gaume_ginsparg_1985] +* Bilal, A. (2008). Lectures on Anomalies. arXiv preprint. [ref: bilal_2008_anomalies] +* Nash, C. (1991). Differential topology and quantum field theory. Elsevier. [ref: nash_1991_dtqft] -/ @[expose] public section diff --git a/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/Basic.lean b/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/Basic.lean index 4cbec23d7c..d77c1e0f12 100644 --- a/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/Basic.lean +++ b/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/Basic.lean @@ -125,6 +125,7 @@ lemma ofFieldOpListF_append (φs φs' : List 𝓕.FieldOp) : dsimp only [ofFieldOpListF] rw [List.map_append, List.prod_append] +set_option backward.isDefEq.respectTransparency false in lemma ofFieldOpListF_sum (φs : List 𝓕.FieldOp) : ofFieldOpListF φs = ∑ (s : CrAnSection φs), ofCrAnListF s.1 := by induction φs with @@ -194,6 +195,7 @@ lemma anPartF_posAsymp (φ : (Σ f, 𝓕.AsymptoticLabel f) × Momentum) : anPartF (FieldOp.outAsymp φ) = ofCrAnOpF ⟨FieldOp.outAsymp φ, ()⟩ := by simp [anPartF] +set_option backward.isDefEq.respectTransparency false in lemma ofFieldOpF_eq_crPartF_add_anPartF (φ : 𝓕.FieldOp) : ofFieldOpF φ = crPartF φ + anPartF φ := by rw [ofFieldOpF] diff --git a/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/Grading.lean b/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/Grading.lean index 40f76ac7dd..b8e8d75e72 100644 --- a/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/Grading.lean +++ b/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/Grading.lean @@ -68,7 +68,7 @@ lemma bosonicProjF_of_mem_bosonic (a : 𝓕.FieldOpFreeAlgebra) (h : a ∈ stati change p a h apply Submodule.span_induction · intro x hx - simp only [Set.mem_setOf_eq] at hx + simp only [Set.mem_ofPred_eq] at hx obtain ⟨φs, rfl, h⟩ := hx simp [p, bosonicProjF_ofCrAnListF, h] · simp only [map_zero, p] @@ -86,7 +86,7 @@ lemma bosonicProjF_of_mem_fermionic (a : 𝓕.FieldOpFreeAlgebra) change p a h apply Submodule.span_induction · intro x hx - simp only [Set.mem_setOf_eq] at hx + simp only [Set.mem_ofPred_eq] at hx obtain ⟨φs, rfl, h⟩ := hx simp [p, bosonicProjF_ofCrAnListF, h] · simp [p] @@ -142,7 +142,7 @@ lemma fermionicProjF_of_mem_fermionic (a : 𝓕.FieldOpFreeAlgebra) change p a h apply Submodule.span_induction · intro x hx - simp only [Set.mem_setOf_eq] at hx + simp only [Set.mem_ofPred_eq] at hx obtain ⟨φs, rfl, h⟩ := hx simp [p, fermionicProjF_ofCrAnListF, h] · simp only [map_zero, p] @@ -159,7 +159,7 @@ lemma fermionicProjF_of_mem_bosonic (a : 𝓕.FieldOpFreeAlgebra) change p a h apply Submodule.span_induction · intro x hx - simp only [Set.mem_setOf_eq] at hx + simp only [Set.mem_ofPred_eq] at hx obtain ⟨φs, rfl, h⟩ := hx simp [p, fermionicProjF_ofCrAnListF, h] · simp [p] @@ -254,7 +254,7 @@ instance fieldOpFreeAlgebraGrade : one_mem := by simp only [statisticSubmodule] refine Submodule.mem_span.mpr fun p a => a ?_ - simp only [Set.mem_setOf_eq] + simp only [Set.mem_ofPred_eq] use [] simp only [ofCrAnListF_nil, ofList_empty, true_and] rfl @@ -264,7 +264,7 @@ instance fieldOpFreeAlgebraGrade : change p a2 h2 apply Submodule.span_induction (p := p) · intro x hx - simp only [Set.mem_setOf_eq] at hx + simp only [Set.mem_ofPred_eq] at hx obtain ⟨φs, rfl, h⟩ := hx simp only [p] let p (a1 : 𝓕.FieldOpFreeAlgebra) (hx : a1 ∈ statisticSubmodule f1) : Prop := @@ -276,7 +276,7 @@ instance fieldOpFreeAlgebraGrade : simp only [p] rw [← ofCrAnListF_append] refine Submodule.mem_span.mpr fun p a => a ?_ - simp only [Set.mem_setOf_eq] + simp only [Set.mem_ofPred_eq] use φs' ++ φs simp only [ofList_append, h', h, true_and] cases f1 <;> cases f2 <;> rfl diff --git a/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/NormalOrder.lean b/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/NormalOrder.lean index 488e93a945..b0a2ace0c7 100644 --- a/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/NormalOrder.lean +++ b/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/NormalOrder.lean @@ -509,6 +509,7 @@ lemma ofCrAnOpF_mul_normalOrderF_ofFieldOpListF_eq_superCommuteF (φ : 𝓕.CrAn + [ofCrAnOpF φ, 𝓝ᶠ(ofFieldOpListF φs')]ₛF := by simp [← ofCrAnListF_singleton, ofCrAnListF_mul_normalOrderF_ofFieldOpListF_eq_superCommuteF] +set_option backward.isDefEq.respectTransparency false in lemma anPartF_mul_normalOrderF_ofFieldOpListF_eq_superCommuteF (φ : 𝓕.FieldOp) (φs' : List 𝓕.FieldOp) : anPartF φ * 𝓝ᶠ(ofFieldOpListF φs') = diff --git a/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/SuperCommute.lean b/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/SuperCommute.lean index e0eab7d298..0d9ef4a60a 100644 --- a/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/SuperCommute.lean +++ b/Physlib/QFT/PerturbationTheory/FieldOpFreeAlgebra/SuperCommute.lean @@ -100,6 +100,7 @@ lemma superCommuteF_ofFieldOpListF_ofFieldOpF (φs : List 𝓕.FieldOp) (φ : ofFieldOpListF_singleton] simp +set_option backward.isDefEq.respectTransparency false in lemma superCommuteF_anPartF_crPartF (φ φ' : 𝓕.FieldOp) : [anPartF φ, crPartF φ']ₛF = anPartF φ * crPartF φ' - 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • crPartF φ' * anPartF φ := by @@ -122,6 +123,7 @@ lemma superCommuteF_anPartF_crPartF (φ φ' : 𝓕.FieldOp) : simp [anPartF_posAsymp, crPartF_negAsymp, ← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofCrAnListF, crAnStatistics, ← ofCrAnListF_append] +set_option backward.isDefEq.respectTransparency false in lemma superCommuteF_crPartF_anPartF (φ φ' : 𝓕.FieldOp) : [crPartF φ, anPartF φ']ₛF = crPartF φ * anPartF φ' - 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • anPartF φ' * crPartF φ := by @@ -144,6 +146,7 @@ lemma superCommuteF_crPartF_anPartF (φ φ' : 𝓕.FieldOp) : simp [crPartF_negAsymp, anPartF_posAsymp, ← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofCrAnListF, crAnStatistics, ← ofCrAnListF_append] +set_option backward.isDefEq.respectTransparency false in lemma superCommuteF_crPartF_crPartF (φ φ' : 𝓕.FieldOp) : [crPartF φ, crPartF φ']ₛF = crPartF φ * crPartF φ' - 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • crPartF φ' * crPartF φ := by @@ -166,6 +169,7 @@ lemma superCommuteF_crPartF_crPartF (φ φ' : 𝓕.FieldOp) : simp [crPartF_negAsymp, ← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofCrAnListF, crAnStatistics, ← ofCrAnListF_append] +set_option backward.isDefEq.respectTransparency false in lemma superCommuteF_anPartF_anPartF (φ φ' : 𝓕.FieldOp) : [anPartF φ, anPartF φ']ₛF = anPartF φ * anPartF φ' - 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • anPartF φ' * anPartF φ := by @@ -187,6 +191,7 @@ lemma superCommuteF_anPartF_anPartF (φ φ' : 𝓕.FieldOp) : simp [anPartF_posAsymp, ← ofCrAnListF_singleton, superCommuteF_ofCrAnListF_ofCrAnListF, crAnStatistics, ← ofCrAnListF_append] +set_option backward.isDefEq.respectTransparency false in lemma superCommuteF_crPartF_ofFieldOpListF (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) : [crPartF φ, ofFieldOpListF φs]ₛF = crPartF φ * ofFieldOpListF φs - 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φs) • ofFieldOpListF φs * @@ -201,6 +206,7 @@ lemma superCommuteF_crPartF_ofFieldOpListF (φ : 𝓕.FieldOp) (φs : List 𝓕. | FieldOp.outAsymp φ => simp +set_option backward.isDefEq.respectTransparency false in lemma superCommuteF_anPartF_ofFieldOpListF (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) : [anPartF φ, ofFieldOpListF φs]ₛF = anPartF φ * ofFieldOpListF φs - 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φs) • diff --git a/Physlib/QFT/PerturbationTheory/FieldSpecification/Basic.lean b/Physlib/QFT/PerturbationTheory/FieldSpecification/Basic.lean index fcac680a66..069fbae6c3 100644 --- a/Physlib/QFT/PerturbationTheory/FieldSpecification/Basic.lean +++ b/Physlib/QFT/PerturbationTheory/FieldSpecification/Basic.lean @@ -23,9 +23,10 @@ From each field we can create three different types of `FieldOp`. These states carry the same field statistic as the field they are derived from. -## Some references +## References -- https://particle.physics.ucdavis.edu/modernsusy/slides/slideimages/spinorfeynrules.pdf +* https://particle.physics.ucdavis.edu/modernsusy/slides/slideimages/spinorfeynrules.pdf. + [ref: ucdavis_spinorfeynrules] -/ diff --git a/Physlib/QFT/PerturbationTheory/FieldSpecification/CrAnSection.lean b/Physlib/QFT/PerturbationTheory/FieldSpecification/CrAnSection.lean index 6067efcf68..6f458c7485 100644 --- a/Physlib/QFT/PerturbationTheory/FieldSpecification/CrAnSection.lean +++ b/Physlib/QFT/PerturbationTheory/FieldSpecification/CrAnSection.lean @@ -94,6 +94,7 @@ lemma eq_head_cons_tail {φ : 𝓕.FieldOp} {ψs : CrAnSection (φ :: φs)} : subst h2 rfl +set_option backward.isDefEq.respectTransparency false in /-- The creation of a section from for `φ : φs` from a section for `φs` and a element of `𝓕.fieldOpToCreateAnnihilateType φ`. -/ def cons {φ : 𝓕.FieldOp} (ψ : 𝓕.fieldOpToCrAnType φ) (ψs : CrAnSection φs) : @@ -112,6 +113,7 @@ def nilEquiv : CrAnSection (𝓕 := 𝓕) [] ≃ Unit where right_inv _ := by simp +set_option backward.isDefEq.respectTransparency false in /-- The creation and annihilation sections for a singleton list is given by a choice of `𝓕.fieldOpToCreateAnnihilateType φ`. If `φ` is a asymptotic state there is no choice here, else there are two choices. -/ @@ -165,6 +167,7 @@ lemma card_cons_eq {φ : 𝓕.FieldOp} {φs : List 𝓕.FieldOp} : rw [Fintype.ofEquiv_card consEquiv.symm] simp +set_option backward.isDefEq.respectTransparency false in lemma card_eq_mul : {φs : List 𝓕.FieldOp} → Fintype.card (CrAnSection φs) = 2 ^ (List.countP 𝓕.statesIsPosition φs) | [] => by @@ -264,18 +267,21 @@ def append {φs φs' : List 𝓕.FieldOp} (ψs : CrAnSection φs) (ψs' : CrAnSection φs') : CrAnSection (φs ++ φs') := ⟨ψs.1 ++ ψs'.1, by simp [ψs.2, ψs'.2]⟩ +set_option backward.isDefEq.respectTransparency false in lemma append_assoc {φs φs' φs'' : List 𝓕.FieldOp} (ψs : CrAnSection φs) (ψs' : CrAnSection φs') (ψs'' : CrAnSection φs'') : append ψs (append ψs' ψs'') = congr (by simp) (append (append ψs ψs') ψs'') := by apply Subtype.ext simp [append] +set_option backward.isDefEq.respectTransparency false in lemma append_assoc' {φs φs' φs'' : List 𝓕.FieldOp} (ψs : CrAnSection φs) (ψs' : CrAnSection φs') (ψs'' : CrAnSection φs'') : (append (append ψs ψs') ψs'') = congr (by simp) (append ψs (append ψs' ψs'')) := by apply Subtype.ext simp [append] +set_option backward.isDefEq.respectTransparency false in lemma singletonEquiv_append_eq_cons {φs : List 𝓕.FieldOp} {φ : 𝓕.FieldOp} (ψs : CrAnSection φs) (ψ : 𝓕.fieldOpToCrAnType φ) : append (singletonEquiv.symm ψ) ψs = cons ψ ψs := by @@ -364,6 +370,7 @@ def eraseIdxEquiv (n : ℕ) (φs : List 𝓕.FieldOp) (hn : n < φs.length) : appendEquiv.symm.trans <| congr (List.eraseIdx_eq_take_drop_succ φs n).symm +set_option backward.isDefEq.respectTransparency false in @[simp] lemma eraseIdxEquiv_apply_snd {n : ℕ} (ψs : CrAnSection φs) (hn : n < φs.length) : (eraseIdxEquiv n φs hn ψs).snd = eraseIdx n ψs := by @@ -376,7 +383,6 @@ lemma eraseIdxEquiv_apply_snd {n : ℕ} (ψs : CrAnSection φs) (hn : n < φs.le simp only [Nat.succ_eq_add_one, le_add_iff_nonneg_right, zero_le, inf_of_le_left] exact Eq.symm (List.eraseIdx_eq_take_drop_succ ψs.1 n) -set_option backward.isDefEq.respectTransparency false in lemma eraseIdxEquiv_symm_eq_take_cons_drop {n : ℕ} (φs : List 𝓕.FieldOp) (hn : n < φs.length) (a : 𝓕.fieldOpToCrAnType φs[n]) (s : CrAnSection (φs.eraseIdx n)) : (eraseIdxEquiv n φs hn).symm ⟨a, s⟩ = @@ -398,6 +404,7 @@ lemma eraseIdxEquiv_symm_eq_take_cons_drop {n : ℕ} (φs : List 𝓕.FieldOp) ( exact Nat.le_of_succ_le hn rw [hn] +set_option backward.isDefEq.respectTransparency false in @[simp] lemma eraseIdxEquiv_symm_getElem {n : ℕ} (φs : List 𝓕.FieldOp) (hn : n < φs.length) (a : 𝓕.fieldOpToCrAnType φs[n]) (s : CrAnSection (φs.eraseIdx n)) : diff --git a/Physlib/QFT/PerturbationTheory/FieldSpecification/TimeOrder.lean b/Physlib/QFT/PerturbationTheory/FieldSpecification/TimeOrder.lean index fa0f9b990f..36dd039b85 100644 --- a/Physlib/QFT/PerturbationTheory/FieldSpecification/TimeOrder.lean +++ b/Physlib/QFT/PerturbationTheory/FieldSpecification/TimeOrder.lean @@ -339,6 +339,7 @@ lemma crAnTimeOrderSign_crAnSection : {φs : List 𝓕.FieldOp} → (ψs : CrAnS exact congrArg₂ (· * ·) (koszulSignInsert_crAnTimeOrderRel_crAnSection h.1 ⟨ψs, h.2⟩) (crAnTimeOrderSign_crAnSection ⟨ψs, h.2⟩) +set_option backward.isDefEq.respectTransparency false in lemma orderedInsert_crAnTimeOrderRel_crAnSection {φ : 𝓕.FieldOp} {ψ : 𝓕.CrAnFieldOp} (h : ψ.1 = φ) : {φs : List 𝓕.FieldOp} → (ψs : CrAnSection φs) → (List.orderedInsert 𝓕.crAnTimeOrderRel ψ ψs.1).map 𝓕.crAnFieldOpToFieldOp = diff --git a/Physlib/QFT/PerturbationTheory/Koszul/KoszulSign.lean b/Physlib/QFT/PerturbationTheory/Koszul/KoszulSign.lean index 5de3325d73..da5ccf2cb8 100644 --- a/Physlib/QFT/PerturbationTheory/Koszul/KoszulSign.lean +++ b/Physlib/QFT/PerturbationTheory/Koszul/KoszulSign.lean @@ -254,7 +254,6 @@ lemma koszulSign_eraseIdx_insertionSortMinPos [Std.Total le] [IsTrans 𝓕 le] ( rhs rhs lhs - simp [insertionSortMinPos] erw [Equiv.apply_symm_apply] simp only [List.get_eq_getElem, List.length_cons, List.insertionSort, List.take_zero, ofList_empty, exchangeSign_bosonic, mul_one, mul_eq_mul_left_iff] diff --git a/Physlib/QFT/PerturbationTheory/Koszul/KoszulSignInsert.lean b/Physlib/QFT/PerturbationTheory/Koszul/KoszulSignInsert.lean index 96add368d7..d71545cddd 100644 --- a/Physlib/QFT/PerturbationTheory/Koszul/KoszulSignInsert.lean +++ b/Physlib/QFT/PerturbationTheory/Koszul/KoszulSignInsert.lean @@ -107,6 +107,7 @@ lemma koszulSignInsert_eq_cons [Std.Total le] (φ : 𝓕) (φs : List 𝓕) : simpa only [or_self] using Std.Total.total (r := le) φ φ simp [h1] +set_option backward.isDefEq.respectTransparency false in lemma koszulSignInsert_eq_grade (φ : 𝓕) (φs : List 𝓕) : koszulSignInsert q le φ φs = if ofList q [φ] = fermionic ∧ ofList q (List.filter (fun i => decide (¬ le φ i)) φs) = fermionic then -1 else 1 := by diff --git a/Physlib/QFT/PerturbationTheory/WickAlgebra/Basic.lean b/Physlib/QFT/PerturbationTheory/WickAlgebra/Basic.lean index 10995dfdd0..e9eaf8a61e 100644 --- a/Physlib/QFT/PerturbationTheory/WickAlgebra/Basic.lean +++ b/Physlib/QFT/PerturbationTheory/WickAlgebra/Basic.lean @@ -159,7 +159,7 @@ lemma ι_superCommuteF_ofCrAnOpF_ofCrAnOpF_bosonic_or_zero (φ ψ : 𝓕.CrAnFie lemma ι_superCommuteF_ofCrAnOpF_superCommuteF_ofCrAnOpF_ofCrAnOpF (φ1 φ2 φ3 : 𝓕.CrAnFieldOp) : ι [ofCrAnOpF φ1, [ofCrAnOpF φ2, ofCrAnOpF φ3]ₛF]ₛF = 0 := by apply ι_of_mem_fieldOpIdealSet - simp only [fieldOpIdealSet, exists_prop, exists_and_left, Set.mem_setOf_eq] + simp only [fieldOpIdealSet, exists_prop, exists_and_left, Set.mem_ofPred_eq] aesop lemma ι_superCommuteF_superCommuteF_ofCrAnOpF_ofCrAnOpF_ofCrAnOpF (φ1 φ2 φ3 : 𝓕.CrAnFieldOp) : @@ -231,7 +231,7 @@ lemma bosonicProjF_mem_fieldOpIdealSet_or_zero (x : FieldOpFreeAlgebra 𝓕) (hx : x ∈ 𝓕.fieldOpIdealSet) : x.bosonicProjF.1 ∈ 𝓕.fieldOpIdealSet ∨ x.bosonicProjF = 0 := by have hx' := hx - simp only [fieldOpIdealSet, exists_prop, Set.mem_setOf_eq] at hx + simp only [fieldOpIdealSet, exists_prop, Set.mem_ofPred_eq] at hx rcases hx with ⟨φ1, φ2, φ3, rfl⟩ | ⟨φc, φc', hφc, hφc', rfl⟩ | ⟨φa, φa', hφa, hφa', rfl⟩ | ⟨φ, φ', hdiff, rfl⟩ · rcases superCommuteF_superCommuteF_ofCrAnOpF_bosonic_or_fermionic φ1 φ2 φ3 with h | h @@ -263,7 +263,7 @@ lemma fermionicProjF_mem_fieldOpIdealSet_or_zero (x : FieldOpFreeAlgebra 𝓕) (hx : x ∈ 𝓕.fieldOpIdealSet) : x.fermionicProjF.1 ∈ 𝓕.fieldOpIdealSet ∨ x.fermionicProjF = 0 := by have hx' := hx - simp only [fieldOpIdealSet, exists_prop, Set.mem_setOf_eq] at hx + simp only [fieldOpIdealSet, exists_prop, Set.mem_ofPred_eq] at hx rcases hx with ⟨φ1, φ2, φ3, rfl⟩ | ⟨φc, φc', hφc, hφc', rfl⟩ | ⟨φa, φa', hφa, hφa', rfl⟩ | ⟨φ, φ', hdiff, rfl⟩ · rcases superCommuteF_superCommuteF_ofCrAnOpF_bosonic_or_fermionic φ1 φ2 φ3 with h | h diff --git a/Physlib/QFT/PerturbationTheory/WickAlgebra/Grading.lean b/Physlib/QFT/PerturbationTheory/WickAlgebra/Grading.lean index 077cdd961b..c0d9b7f691 100644 --- a/Physlib/QFT/PerturbationTheory/WickAlgebra/Grading.lean +++ b/Physlib/QFT/PerturbationTheory/WickAlgebra/Grading.lean @@ -41,7 +41,7 @@ lemma mem_bosonic_of_mem_free_bosonic (a : 𝓕.FieldOpFreeAlgebra) change p a h apply Submodule.span_induction · intro x hx - simp only [Set.mem_setOf_eq] at hx + simp only [Set.mem_ofPred_eq] at hx obtain ⟨φs, rfl, h⟩ := hx simp [p] apply ofCrAnList_mem_statSubmodule_of_eq @@ -62,7 +62,7 @@ lemma mem_fermionic_of_mem_free_fermionic (a : 𝓕.FieldOpFreeAlgebra) change p a h apply Submodule.span_induction · intro x hx - simp only [Set.mem_setOf_eq] at hx + simp only [Set.mem_ofPred_eq] at hx obtain ⟨φs, rfl, h⟩ := hx simp [p] apply ofCrAnList_mem_statSubmodule_of_eq @@ -399,7 +399,7 @@ instance WickAlgebraGrade : GradedAlgebra (A := 𝓕.WickAlgebra) statSubmodule one_mem := by simp only [statSubmodule] refine Submodule.mem_span.mpr fun p a => a ?_ - simp only [Set.mem_setOf_eq] + simp only [Set.mem_ofPred_eq] use [] simp only [ofCrAnList, ofCrAnListF_nil, map_one, ofList_empty, true_and] rfl @@ -409,7 +409,7 @@ instance WickAlgebraGrade : GradedAlgebra (A := 𝓕.WickAlgebra) statSubmodule change p a2 h2 apply Submodule.span_induction · intro x hx - simp only [Set.mem_setOf_eq] at hx + simp only [Set.mem_ofPred_eq] at hx obtain ⟨φs, rfl, h⟩ := hx simp only [p] let p (a1 : 𝓕.WickAlgebra) (hx : a1 ∈ statSubmodule f1) : Prop := @@ -421,7 +421,7 @@ instance WickAlgebraGrade : GradedAlgebra (A := 𝓕.WickAlgebra) statSubmodule simp only [p] rw [← ofCrAnList_append] refine Submodule.mem_span.mpr fun p a => a ?_ - simp only [Set.mem_setOf_eq] + simp only [Set.mem_ofPred_eq] use φs' ++ φs simp only [ofList_append, h', h, true_and] cases f1 <;> cases f2 <;> rfl diff --git a/Physlib/QFT/PerturbationTheory/WickAlgebra/NormalOrder/Basic.lean b/Physlib/QFT/PerturbationTheory/WickAlgebra/NormalOrder/Basic.lean index 81412c81b1..9042240892 100644 --- a/Physlib/QFT/PerturbationTheory/WickAlgebra/NormalOrder/Basic.lean +++ b/Physlib/QFT/PerturbationTheory/WickAlgebra/NormalOrder/Basic.lean @@ -194,7 +194,7 @@ lemma ι_normalOrderF_zero_of_mem_ideal (a : 𝓕.FieldOpFreeAlgebra) obtain ⟨a, ha, b, hb, rfl⟩ := Set.mem_mul.mp hx obtain ⟨a, ha, c, hc, rfl⟩ := ha simp only [p] - simp only [fieldOpIdealSet, exists_prop, exists_and_left, Set.mem_setOf_eq] at hc + simp only [fieldOpIdealSet, exists_prop, exists_and_left, Set.mem_ofPred_eq] at hc match hc with | Or.inl hc => obtain ⟨φa, φa', hφa, hφa', rfl⟩ := hc @@ -222,6 +222,7 @@ lemma ι_normalOrderF_eq_of_equiv (a b : 𝓕.FieldOpFreeAlgebra) (h : a ≈ b) rw [← sub_eq_zero, ← map_sub, ← LinearMap.map_sub] exact ι_normalOrderF_zero_of_mem_ideal (a - b) h +set_option backward.isDefEq.respectTransparency false in /-- For a field specification `𝓕`, `normalOrder` is the linear map `WickAlgebra 𝓕 →ₗ[ℂ] WickAlgebra 𝓕` diff --git a/Physlib/QFT/PerturbationTheory/WickAlgebra/NormalOrder/Lemmas.lean b/Physlib/QFT/PerturbationTheory/WickAlgebra/NormalOrder/Lemmas.lean index c7d41c4c17..5a2b02a07c 100644 --- a/Physlib/QFT/PerturbationTheory/WickAlgebra/NormalOrder/Lemmas.lean +++ b/Physlib/QFT/PerturbationTheory/WickAlgebra/NormalOrder/Lemmas.lean @@ -184,6 +184,7 @@ lemma normalOrder_ofCrAnOp_ofFieldOpList_swap (φ : 𝓕.CrAnFieldOp) (φ' : Lis rw [← ofCrAnList_singleton, ofCrAnList_mul_ofFieldOpList_eq_superCommute] simp +set_option backward.isDefEq.respectTransparency false in lemma normalOrder_anPart_ofFieldOpList_swap (φ : 𝓕.FieldOp) (φ' : List 𝓕.FieldOp) : 𝓝(anPart φ * ofFieldOpList φ') = 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • 𝓝(ofFieldOpList φ' * anPart φ) := by match φ with @@ -288,6 +289,7 @@ lemma ofCrAnOp_superCommute_normalOrder_ofFieldOpList_sum (φ : 𝓕.CrAnFieldOp rw [← Finset.mul_sum] rw [← Finset.sum_mul, ← map_sum, ← map_sum, ← ofFieldOp_eq_sum, ← ofFieldOpList_eq_sum] +set_option backward.isDefEq.respectTransparency false in /-- The commutator of the annihilation part of a field operator with a normal ordered list of field operators can be decomposed into the sum of the commutators of the annihilation part with each diff --git a/Physlib/QFT/PerturbationTheory/WickAlgebra/StaticWickTerm.lean b/Physlib/QFT/PerturbationTheory/WickAlgebra/StaticWickTerm.lean index 5c1211c78c..2eb7992866 100644 --- a/Physlib/QFT/PerturbationTheory/WickAlgebra/StaticWickTerm.lean +++ b/Physlib/QFT/PerturbationTheory/WickAlgebra/StaticWickTerm.lean @@ -36,6 +36,7 @@ noncomputable section def staticWickTerm {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length) : 𝓕.WickAlgebra := φsΛ.sign • φsΛ.staticContract * 𝓝(ofFieldOpList [φsΛ]ᵘᶜ) +set_option backward.isDefEq.respectTransparency false in /-- For the empty list `[]` of `𝓕.FieldOp`, the `staticWickTerm` of the Wick contraction corresponding to the empty set `∅` (the only Wick contraction of `[]`) is `1`. -/ @[simp] diff --git a/Physlib/QFT/PerturbationTheory/WickAlgebra/SuperCommute.lean b/Physlib/QFT/PerturbationTheory/WickAlgebra/SuperCommute.lean index 4f97eb25b8..f080508d74 100644 --- a/Physlib/QFT/PerturbationTheory/WickAlgebra/SuperCommute.lean +++ b/Physlib/QFT/PerturbationTheory/WickAlgebra/SuperCommute.lean @@ -47,6 +47,7 @@ lemma ι_superCommuteF_eq_of_equiv_right (a b1 b2 : 𝓕.FieldOpFreeAlgebra) (h rw [← sub_eq_zero, ← map_sub, ← map_sub] exact ι_superCommuteF_right_zero_of_mem_ideal a _ ((equiv_iff_sub_mem_ideal _ _).mp h) +set_option backward.isDefEq.respectTransparency false in /-- The super commutator on the `WickAlgebra` defined as a linear map `[a,_]ₛ`. -/ noncomputable def superCommuteRight (a : 𝓕.FieldOpFreeAlgebra) : WickAlgebra 𝓕 →ₗ[ℂ] WickAlgebra 𝓕 where @@ -79,6 +80,7 @@ lemma superCommuteRight_eq_of_equiv (a1 a2 : 𝓕.FieldOpFreeAlgebra) (h : a1 ι_superCommuteF_eq_zero_of_ι_left_zero (a1 - a2) b ((ι_eq_zero_iff_mem_ideal _).mpr ((equiv_iff_sub_mem_ideal _ _).mp h)) +set_option backward.isDefEq.respectTransparency false in /-- For a field specification `𝓕`, `superCommute` is the linear map `WickAlgebra 𝓕 →ₗ[ℂ] WickAlgebra 𝓕 →ₗ[ℂ] WickAlgebra 𝓕` @@ -145,12 +147,14 @@ lemma superCommute_diff_statistic {φ φ' : 𝓕.CrAnFieldOp} (h : (𝓕 |>ₛ [ofCrAnOp φ, ofCrAnOp φ']ₛ = 0 := ι_superCommuteF_of_diff_statistic h +set_option backward.isDefEq.respectTransparency false in lemma superCommute_ofCrAnOp_ofFieldOp_diff_stat_zero (φ : 𝓕.CrAnFieldOp) (ψ : 𝓕.FieldOp) (h : (𝓕 |>ₛ φ) ≠ (𝓕 |>ₛ ψ)) : [ofCrAnOp φ, ofFieldOp ψ]ₛ = 0 := by rw [ofFieldOp_eq_sum, map_sum] refine Finset.sum_eq_zero fun x _ => superCommute_diff_statistic ?_ simpa [crAnStatistics] using h +set_option backward.isDefEq.respectTransparency false in lemma superCommute_anPart_ofFieldOpF_diff_grade_zero (φ ψ : 𝓕.FieldOp) (h : (𝓕 |>ₛ φ) ≠ (𝓕 |>ₛ ψ)) : [anPart φ, ofFieldOp ψ]ₛ = 0 := by cases φ @@ -230,11 +234,13 @@ lemma superCommute_crPart_anPart (φ φ' : 𝓕.FieldOp) : 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φ') • anPart φ' * crPart φ := congrArg ι (superCommuteF_crPartF_anPartF φ φ') +set_option backward.isDefEq.respectTransparency false in @[simp] lemma superCommute_crPart_crPart (φ φ' : 𝓕.FieldOp) : [crPart φ, crPart φ']ₛ = 0 := by cases φ <;> cases φ' <;> simp [superCommute_create_create, crAnFieldOpToCreateAnnihilate] +set_option backward.isDefEq.respectTransparency false in @[simp] lemma superCommute_anPart_anPart (φ φ' : 𝓕.FieldOp) : [anPart φ, anPart φ']ₛ = 0 := by cases φ <;> cases φ' <;> diff --git a/Physlib/QFT/PerturbationTheory/WickAlgebra/TimeOrder.lean b/Physlib/QFT/PerturbationTheory/WickAlgebra/TimeOrder.lean index 31e3484e8c..b665e74193 100644 --- a/Physlib/QFT/PerturbationTheory/WickAlgebra/TimeOrder.lean +++ b/Physlib/QFT/PerturbationTheory/WickAlgebra/TimeOrder.lean @@ -288,7 +288,7 @@ lemma ι_timeOrderF_superCommuteF_ne_time {φ ψ : 𝓕.CrAnFieldOp} /-! -## Defining time order for `FiedOpAlgebra`. +## Defining time order for `FieldOpFreeAlgebra`. -/ @@ -301,7 +301,7 @@ lemma ι_timeOrderF_zero_of_mem_ideal (a : 𝓕.FieldOpFreeAlgebra) apply AddSubgroup.closure_induction · rintro x ⟨_, ⟨a, ha, c, hc, rfl⟩, b, hb, rfl⟩ simp only [p] - simp only [fieldOpIdealSet, exists_prop, exists_and_left, Set.mem_setOf_eq] at hc + simp only [fieldOpIdealSet, exists_prop, exists_and_left, Set.mem_ofPred_eq] at hc rcases hc with ⟨φa, φa', hφa, hφa', rfl⟩ | ⟨φa, hφa, φb, hφb, rfl⟩ | ⟨φa, hφa, φb, hφb, rfl⟩ | ⟨φa, φb, hdiff, rfl⟩ · simp @@ -328,6 +328,7 @@ lemma ι_timeOrderF_eq_of_equiv (a b : 𝓕.FieldOpFreeAlgebra) (h : a ≈ b) : rw [← sub_eq_zero, ← map_sub, ← map_sub] exact ι_timeOrderF_zero_of_mem_ideal _ ((equiv_iff_sub_mem_ideal a b).mp h) +set_option backward.isDefEq.respectTransparency false in /-- For a field specification `𝓕`, `timeOrder` is the linear map `WickAlgebra 𝓕 →ₗ[ℂ] WickAlgebra 𝓕` diff --git a/Physlib/QFT/PerturbationTheory/WickContraction/Basic.lean b/Physlib/QFT/PerturbationTheory/WickContraction/Basic.lean index 729ca13042..a5fffc6dbb 100644 --- a/Physlib/QFT/PerturbationTheory/WickContraction/Basic.lean +++ b/Physlib/QFT/PerturbationTheory/WickContraction/Basic.lean @@ -119,6 +119,7 @@ lemma congrLift_bijective {n m : ℕ} {c : WickContraction n} (h : n = m) : def congrLiftInv {n m : ℕ} (h : n = m) {c : WickContraction n} (a : (congr h c).1) : c.1 := ⟨a.1.map (finCongr h.symm).toEmbedding, by aesop⟩ +set_option backward.isDefEq.respectTransparency false in lemma congrLiftInv_rfl {n : ℕ} {c : WickContraction n} : c.congrLiftInv rfl = id := by funext a diff --git a/Physlib/QFT/PerturbationTheory/WickContraction/Erase.lean b/Physlib/QFT/PerturbationTheory/WickContraction/Erase.lean index 97c5768040..f531191414 100644 --- a/Physlib/QFT/PerturbationTheory/WickContraction/Erase.lean +++ b/Physlib/QFT/PerturbationTheory/WickContraction/Erase.lean @@ -35,6 +35,7 @@ def erase (c : WickContraction n.succ) (i : Fin n.succ) : WickContraction n := b rw [← Finset.disjoint_map i.succAboveEmb, ← (Finset.map_injective i.succAboveEmb).eq_iff] exact c.2.2 _ ha _ hb +set_option backward.isDefEq.respectTransparency false in lemma mem_erase_uncontracted_iff (c : WickContraction n.succ) (i : Fin n.succ) (j : Fin n) : j ∈ (c.erase i).uncontracted ↔ i.succAbove j ∈ c.uncontracted ∨ c.getDual? (i.succAbove j) = some i := by diff --git a/Physlib/QFT/PerturbationTheory/WickContraction/InsertAndContractNat.lean b/Physlib/QFT/PerturbationTheory/WickContraction/InsertAndContractNat.lean index 4b8716aed9..6133977cd5 100644 --- a/Physlib/QFT/PerturbationTheory/WickContraction/InsertAndContractNat.lean +++ b/Physlib/QFT/PerturbationTheory/WickContraction/InsertAndContractNat.lean @@ -161,6 +161,7 @@ lemma self_not_mem_uncontracted_of_insertAndContractNat_some (c : WickContractio rw [mem_uncontracted_iff_not_contracted] simp [insertAndContractNat] +set_option backward.isDefEq.respectTransparency false in lemma insertAndContractNat_succAbove_mem_uncontracted_iff (c : WickContraction n) (i : Fin n.succ) (j : Fin n) : (i.succAbove j) ∈ (insertAndContractNat c i none).uncontracted ↔ j ∈ c.uncontracted := by @@ -246,17 +247,16 @@ lemma insertAndContractNat_some_uncontracted (c : WickContraction n) (i : Fin n. -/ -set_option backward.isDefEq.respectTransparency false in lemma insertAndContractNat_none_getDual?_isNone (c : WickContraction n) (i : Fin n.succ) : ((insertAndContractNat c i none).getDual? i).isNone := by simp [Option.isNone_iff_eq_none, getDual?_eq_none_iff_mem_uncontracted] -set_option backward.isDefEq.respectTransparency false in @[simp] lemma insertAndContractNat_none_getDual?_eq_none (c : WickContraction n) (i : Fin n.succ) : (insertAndContractNat c i none).getDual? i = none := by simp [getDual?_eq_none_iff_mem_uncontracted] +set_option backward.isDefEq.respectTransparency false in @[simp] lemma insertAndContractNat_succAbove_getDual?_eq_none_iff (c : WickContraction n) (i : Fin n.succ) (j : Fin n) : @@ -334,8 +334,7 @@ lemma insertAndContractNat_some_getDual?_of_neq (c : WickContraction n) (i : Fin lemma insertAndContractNat_erase (c : WickContraction n) (i : Fin n.succ) (j : Option c.uncontracted) : erase (insertAndContractNat c i j) i = c := by refine Subtype.ext (Finset.ext fun a => ?_) - simp only [erase, Nat.succ_eq_add_one, insertAndContractNat, Finset.mem_filter, Finset.mem_univ, - true_and] + simp only [erase, Nat.succ_eq_add_one, insertAndContractNat] match j with | none => simp [Finset.mapEmbedding_apply, Finset.map_inj] @@ -345,7 +344,6 @@ lemma insertAndContractNat_erase (c : WickContraction n) (i : Fin n.succ) simp [Fin.succAbove_ne] at hi simp [Finset.mapEmbedding_apply, Finset.map_inj, hn] -set_option backward.isDefEq.respectTransparency false in lemma insertAndContractNat_getDualErase (c : WickContraction n) (i : Fin n.succ) (j : Option c.uncontracted) : (insertAndContractNat c i j).getDualErase i = uncontractedCongr (c := c) (c' := (c.insertAndContractNat i j).erase i) (by simp) j := by @@ -501,7 +499,6 @@ lemma insertLiftSome_bijective {c : WickContraction n} (i : Fin n.succ) (j : c.u -/ -set_option backward.isDefEq.respectTransparency false in lemma insertAndContractNat_injective (i : Fin n.succ) : Function.Injective (fun c => insertAndContractNat c i none) := fun _ _ hc => Subtype.ext (by simpa [insertAndContractNat] using Subtype.ext_iff.mp hc) diff --git a/Physlib/QFT/PerturbationTheory/WickContraction/Involutions.lean b/Physlib/QFT/PerturbationTheory/WickContraction/Involutions.lean index 822f77b542..65831c5a7a 100644 --- a/Physlib/QFT/PerturbationTheory/WickContraction/Involutions.lean +++ b/Physlib/QFT/PerturbationTheory/WickContraction/Involutions.lean @@ -111,6 +111,7 @@ lemma fromInvolution_getDual?_get (f : {f : Fin n → Fin n // Function.Involuti ((fromInvolution f).getDual? i).get h = (f.1 i) := Option.get_of_mem h (fromInvolution_getDual?_eq_some f i h) +set_option backward.isDefEq.respectTransparency false in lemma toInvolution_fromInvolution : fromInvolution c.toInvolution = c := by apply Subtype.ext simp only [fromInvolution, toInvolution] diff --git a/Physlib/QFT/PerturbationTheory/WickContraction/Join.lean b/Physlib/QFT/PerturbationTheory/WickContraction/Join.lean index 1aba21507b..74b6327fcb 100644 --- a/Physlib/QFT/PerturbationTheory/WickContraction/Join.lean +++ b/Physlib/QFT/PerturbationTheory/WickContraction/Join.lean @@ -574,7 +574,7 @@ lemma exists_contraction_pair_of_card_ge_zero {φs : List 𝓕.FieldOp} Finset.card_pos.mp h set_option backward.isDefEq.respectTransparency false in -set_option maxHeartbeats 400000 in +set_option maxHeartbeats 800000 in lemma exists_join_singleton_of_card_ge_zero {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length) (h : 0 < φsΛ.1.card) (hc : φsΛ.GradingCompliant) : ∃ (i j : Fin φs.length) (h : i < j) (φsucΛ : WickContraction [singleton h]ᵘᶜ.length), diff --git a/Physlib/QFT/PerturbationTheory/WickContraction/Sign/Basic.lean b/Physlib/QFT/PerturbationTheory/WickContraction/Sign/Basic.lean index c128c5c08f..5a8282fddd 100644 --- a/Physlib/QFT/PerturbationTheory/WickContraction/Sign/Basic.lean +++ b/Physlib/QFT/PerturbationTheory/WickContraction/Sign/Basic.lean @@ -50,6 +50,7 @@ def sign (φs : List 𝓕.FieldOp) (φsΛ : WickContraction φs.length) : ℂ := ∏ (a : φsΛ.1), 𝓢(𝓕 |>ₛ φs[φsΛ.sndFieldOfContract a], 𝓕 |>ₛ ⟨φs.get, φsΛ.signFinset (φsΛ.fstFieldOfContract a) (φsΛ.sndFieldOfContract a)⟩) +set_option backward.isDefEq.respectTransparency false in lemma sign_empty (φs : List 𝓕.FieldOp) : sign φs empty = 1 := by rw [sign] diff --git a/Physlib/QFT/PerturbationTheory/WickContraction/Sign/InsertSome.lean b/Physlib/QFT/PerturbationTheory/WickContraction/Sign/InsertSome.lean index 6fc18edf4d..6f30cc673d 100644 --- a/Physlib/QFT/PerturbationTheory/WickContraction/Sign/InsertSome.lean +++ b/Physlib/QFT/PerturbationTheory/WickContraction/Sign/InsertSome.lean @@ -32,6 +32,7 @@ open FieldStatistic -/ +set_option backward.isDefEq.respectTransparency false in lemma stat_ofFinset_eq_one_of_gradingCompliant (φs : List 𝓕.FieldOp) (a : Finset (Fin φs.length)) (φsΛ : WickContraction φs.length) (hg : GradingCompliant φs φsΛ) (hnon : ∀ i, φsΛ.getDual? i = none → i ∉ a) diff --git a/Physlib/QFT/PerturbationTheory/WickContraction/Sign/Join.lean b/Physlib/QFT/PerturbationTheory/WickContraction/Sign/Join.lean index bb834f7b1c..3b504a4f46 100644 --- a/Physlib/QFT/PerturbationTheory/WickContraction/Sign/Join.lean +++ b/Physlib/QFT/PerturbationTheory/WickContraction/Sign/Join.lean @@ -300,6 +300,7 @@ lemma joinSignRightExtra_eq_i_j_finset_eq_if {φs : List 𝓕.FieldOp} Option.get_some, forall_const, false_or, true_and] omega +set_option backward.isDefEq.respectTransparency false in lemma joinSignLeftExtra_eq_joinSignRightExtra {φs : List 𝓕.FieldOp} {i j : Fin φs.length} (h : i < j) (hs : (𝓕 |>ₛ φs[i]) = (𝓕 |>ₛ φs[j])) (φsucΛ : WickContraction [singleton h]ᵘᶜ.length) : diff --git a/Physlib/QFT/PerturbationTheory/WickContraction/Singleton.lean b/Physlib/QFT/PerturbationTheory/WickContraction/Singleton.lean index 103fd57af6..8fcd5c3fc9 100644 --- a/Physlib/QFT/PerturbationTheory/WickContraction/Singleton.lean +++ b/Physlib/QFT/PerturbationTheory/WickContraction/Singleton.lean @@ -53,10 +53,12 @@ lemma of_singleton_eq {i j : Fin n} (hij : i < j) (a : (singleton hij).1) : rw [@mem_singleton_iff] at ha2 exact Subtype.coe_eq_of_eq_mk ha2 +set_option backward.isDefEq.respectTransparency false in lemma singleton_prod {φs : List 𝓕.FieldOp} {i j : Fin φs.length} (hij : i < j) (f : (singleton hij).1 → M) [CommMonoid M] : ∏ a, f a = f ⟨{i,j}, mem_singleton hij⟩:= by - simp [singleton, of_singleton_eq] + simp [singleton] + exact congrArg f (of_singleton_eq hij _) @[simp] lemma singleton_fstFieldOfContract {i j : Fin n} (hij : i < j) : diff --git a/Physlib/QFT/PerturbationTheory/WickContraction/TimeCond.lean b/Physlib/QFT/PerturbationTheory/WickContraction/TimeCond.lean index c8ff802912..c75784d638 100644 --- a/Physlib/QFT/PerturbationTheory/WickContraction/TimeCond.lean +++ b/Physlib/QFT/PerturbationTheory/WickContraction/TimeCond.lean @@ -112,6 +112,7 @@ lemma quotContraction_eqTimeOnly {φs : List 𝓕.FieldOp} {φsΛ : WickContract apply h set_option backward.isDefEq.respectTransparency false in +set_option maxHeartbeats 800000 in lemma exists_join_singleton_of_card_ge_zero {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length) (h : 0 < φsΛ.1.card) (h1 : φsΛ.EqTimeOnly) : ∃ (i j : Fin φs.length) (h : i < j) (φsucΛ : WickContraction [singleton h]ᵘᶜ.length), @@ -452,6 +453,7 @@ lemma hasEqTimeEquiv_ext_sigma {φs : List 𝓕.FieldOp} {x1 x2 : simp only [ne_eq, congr_refl] at h2 simp [h2] +set_option backward.isDefEq.respectTransparency false in /-- The equivalence which separates a Wick contraction which has an equal time contraction into a non-empty contraction only between equal-time fields and a Wick contraction which does not have equal time contractions. -/ diff --git a/Physlib/QFT/PerturbationTheory/WickContraction/Uncontracted.lean b/Physlib/QFT/PerturbationTheory/WickContraction/Uncontracted.lean index 5f4a8ebf1b..7d28827947 100644 --- a/Physlib/QFT/PerturbationTheory/WickContraction/Uncontracted.lean +++ b/Physlib/QFT/PerturbationTheory/WickContraction/Uncontracted.lean @@ -48,6 +48,7 @@ lemma uncontractedCongr_some {c c': WickContraction n} (h : c = c') (i : c.uncon (uncontractedCongr h) (some i) = some (Equiv.subtypeEquivRight (by rw [h]; simp) i) := by simp [uncontractedCongr] +set_option backward.isDefEq.respectTransparency false in lemma mem_uncontracted_iff_not_contracted (i : Fin n) : i ∈ c.uncontracted ↔ ∀ p ∈ c.1, i ∉ p := by simp only [uncontracted, getDual?, Finset.mem_filter, Finset.mem_univ, true_and] diff --git a/Physlib/QFT/PerturbationTheory/WickContraction/UncontractedList.lean b/Physlib/QFT/PerturbationTheory/WickContraction/UncontractedList.lean index b05a20c6fd..bc772e837d 100644 --- a/Physlib/QFT/PerturbationTheory/WickContraction/UncontractedList.lean +++ b/Physlib/QFT/PerturbationTheory/WickContraction/UncontractedList.lean @@ -536,6 +536,7 @@ lemma take_uncontractedListOrderPos_eq_filter_sort (c : WickContraction n) (i : rw [take_uncontractedListOrderPos_eq_filter] exact filter_uncontractedList c fun x => x.1 < i.1 +set_option backward.isDefEq.respectTransparency false in lemma orderedInsert_succAboveEmb_uncontractedList_eq_insertIdx (c : WickContraction n) (i : Fin n.succ) : (List.orderedInsert (· ≤ ·) i (List.map i.succAboveEmb c.uncontractedList)) = diff --git a/Physlib/QFT/QED/AnomalyCancellation/Basic.lean b/Physlib/QFT/QED/AnomalyCancellation/Basic.lean index 2b7ab3bd86..a8b51c241f 100644 --- a/Physlib/QFT/QED/AnomalyCancellation/Basic.lean +++ b/Physlib/QFT/QED/AnomalyCancellation/Basic.lean @@ -41,6 +41,7 @@ TODO "The implementation of pure U(1) anomaly cancellation conditions is done def PureU1Charges (n : ℕ) : ACCSystemCharges := ⟨n⟩ open BigOperators in +set_option backward.isDefEq.respectTransparency false in /-- The gravitational anomaly. -/ def accGrav (n : ℕ) : ((PureU1Charges n).Charges →ₗ[ℚ] ℚ) where toFun S := ∑ i : Fin n, S i @@ -49,6 +50,7 @@ def accGrav (n : ℕ) : ((PureU1Charges n).Charges →ₗ[ℚ] ℚ) where simp only [HSMul.hSMul, SMul.smul, eq_ratCast, Rat.cast_eq_id, id_eq] rw [← Finset.mul_sum] +set_option backward.isDefEq.respectTransparency false in /-- The symmetric trilinear form used to define the cubic anomaly. -/ @[simps!] def accCubeTriLinSymm {n : ℕ} : TriLinearSymm (PureU1Charges n).Charges := TriLinearSymm.mk₃ @@ -119,6 +121,7 @@ def pureU1EqCharges {n m : ℕ} (h : n = m) : open BigOperators +set_option backward.isDefEq.respectTransparency false in /-- A solution to the pure U(1) accs satisfies the linear ACCs. -/ lemma pureU1_linear {n : ℕ} (S : (PureU1 n).LinSols) : ∑ (i : Fin n), S.val i = 0 := by @@ -126,12 +129,14 @@ lemma pureU1_linear {n : ℕ} (S : (PureU1 n).LinSols) : simp only [PureU1_linearACCs] at hS exact hS ⟨0, by simp⟩ +set_option backward.isDefEq.respectTransparency false in /-- A solution to the pure U(1) accs satisfies the cubic ACCs. -/ lemma pureU1_cube {n : ℕ} (S : (PureU1 n).Sols) : ∑ i, (S.val i) ^ 3 = 0 := by rw [← PureU1.accCube_explicit] exact S.cubicSol +set_option backward.isDefEq.respectTransparency false in /-- The last charge of a solution to the linear ACCs is equal to the negation of the sum of the other charges. -/ lemma pureU1_last {n : ℕ} (S : (PureU1 n.succ).LinSols) : diff --git a/Physlib/QFT/QED/AnomalyCancellation/BasisLinear.lean b/Physlib/QFT/QED/AnomalyCancellation/BasisLinear.lean index 4b9f954aea..7357439b36 100644 --- a/Physlib/QFT/QED/AnomalyCancellation/BasisLinear.lean +++ b/Physlib/QFT/QED/AnomalyCancellation/BasisLinear.lean @@ -23,6 +23,7 @@ open BigOperators Module variable {n : ℕ} namespace BasisLinear +set_option backward.isDefEq.respectTransparency false in /-- The basis elements as charges, defined to have a `1` in the `j`th position and a `-1` in the last position. -/ def asCharges (j : Fin n) : (PureU1 n.succ).Charges := @@ -32,10 +33,12 @@ def asCharges (j : Fin n) : (PureU1 n.succ).Charges := - 1 else 0) +set_option backward.isDefEq.respectTransparency false in lemma asCharges_eq_castSucc (j : Fin n) : asCharges j (Fin.castSucc j) = 1 := by simp [asCharges] +set_option backward.isDefEq.respectTransparency false in lemma asCharges_ne_castSucc {k j : Fin n} (h : k ≠ j) : asCharges k ⟨j, by simp⟩= 0 := by simp [asCharges, Fin.ext_iff] @@ -68,6 +71,7 @@ lemma sum_of_vectors {n : ℕ} (f : Fin k → (PureU1 n).LinSols) (j : Fin n) : (∑ i : Fin k, (f i)).1 j = (∑ i : Fin k, (f i).1 j) := sum_of_anomaly_free_linear (fun i => f i) j +set_option backward.isDefEq.respectTransparency false in /-- The coordinate map for the basis. -/ noncomputable def coordinateMap : (PureU1 n.succ).LinSols ≃ₗ[ℚ] Fin n →₀ ℚ where diff --git a/Physlib/QFT/QED/AnomalyCancellation/ConstAbs.lean b/Physlib/QFT/QED/AnomalyCancellation/ConstAbs.lean index 13008404cf..950c8cbe84 100644 --- a/Physlib/QFT/QED/AnomalyCancellation/ConstAbs.lean +++ b/Physlib/QFT/QED/AnomalyCancellation/ConstAbs.lean @@ -37,7 +37,8 @@ lemma constAbs_perm (S : (PureU1 n).Charges) (M :(FamilyPermutations n).group) : MonoidHom.coe_mk, OneHom.coe_mk, chargeMap_apply] refine Iff.intro (fun h i j => ?_) (fun h i j => h (M.invFun i) (M.invFun j)) have h2 := h (M.toFun i) (M.toFun j) - simp only [Equiv.toFun_as_coe, Equiv.Perm.coe_inv, Equiv.symm_apply_apply] at h2 + simp only [Equiv.toFun_as_coe, Equiv.Perm.coe_inv, Function.comp_apply, + Equiv.symm_apply_apply] at h2 exact h2 lemma constAbs_sort {S : (PureU1 n).Charges} (CA : ConstAbs S) : ConstAbs (sort S) := by @@ -244,6 +245,7 @@ lemma AFL_even_below (A : (PureU1 (2 * n.succ)).LinSols) (h : ConstAbsSorted A.v rfl · exact AFL_even_below' h hA i +set_option backward.isDefEq.respectTransparency false in lemma AFL_even_above' {A : (PureU1 (2 * n.succ)).LinSols} (h : ConstAbsSorted A.val) (hA : A.val (0 : Fin (2*n.succ)) ≠ 0) (i : Fin n.succ) : A.val (Fin.cast (split_equal n.succ) (Fin.natAdd n.succ i)) = diff --git a/Physlib/QFT/QED/AnomalyCancellation/Even/BasisLinear.lean b/Physlib/QFT/QED/AnomalyCancellation/Even/BasisLinear.lean index 0b1f941382..6108ab09fe 100644 --- a/Physlib/QFT/QED/AnomalyCancellation/Even/BasisLinear.lean +++ b/Physlib/QFT/QED/AnomalyCancellation/Even/BasisLinear.lean @@ -19,10 +19,12 @@ conditions. ## ii. Key results -- `P'` : The inclusion of the first plane into linear solutions -- `P_accCube` : The statement that chares from the first plane satisfy the cubic ACC -- `P!'` : The inclusion of the second plane. -- `P!_accCube` : The statement that charges from the second plane satisfy the cubic ACC +- `Unshifted.planeLinSols` : The inclusion of the unshifted plane into linear solutions +- `Unshifted.planeCharges_accCube` : The statement that charges from the unshifted plane + satisfy the cubic ACC +- `Shifted.planeLinSols` : The inclusion of the shifted plane. +- `Shifted.planeCharges_accCube` : The statement that charges from the shifted plane + satisfy the cubic ACC - `span_basis` : Every linear solution is the sum of a point from each plane. ## iii. Table of contents @@ -31,29 +33,29 @@ conditions. - A.1. The even split: Spltting the charges up via `n.succ + n.succ` - A.2. The shifted even split: Spltting the charges up via `1 + (n + n + 1)` - A.3. Lemmas relating the two splittings -- B. The first plane - - B.1. The basis vectors of the first plane as charges +- B. The unshifted plane + - B.1. The basis vectors of the unshifted plane as charges - B.2. Components of the basis vectors - B.3. The basis vectors satisfy the linear ACCs - B.4. The basis vectors satisfy the cubic ACC - B.5. The basis vectors as linear solutions - - B.6. The inclusion of the first plane into charges + - B.6. The inclusion of the unshifted plane into charges - B.7. Components of the inclusion into charges - B.8. The inclusion into charges satisfies the linear and cubic ACCs - B.9. Kernel of the inclusion into charges - B.10. The inclusion of the plane into linear solutions - B.11. The basis vectors are linearly independent - - B.12. Every vector-like even solution is in the span of the basis of the first plane -- C. The vectors of the basis spanning the second plane, via the shifted even split + - B.12. Every vector-like even solution is in the span of the basis of the unshifted plane +- C. The shifted plane - C.2. Components of the vectors - C.3. The vectors satisfy the linear ACCs - C.4. The vectors satisfy the cubic ACC - C.6. The vectors as linear solutions - - C.7. The inclusion of the second plane into charges + - C.7. The inclusion of the shifted plane into charges - C.8. Components of the inclusion into charges - C.9. The inclusion into charges satisfies the cubic ACC - C.10. Kernel of the inclusion into charges - - C.11. The inclusion of the second plane into the span of the basis + - C.11. The inclusion of the shifted plane into the span of the basis - C.12. The inclusion of the plane into linear solutions - C.13. The basis vectors are linearly independent - C.14. Properties of the basis vectors relating to the span @@ -74,8 +76,7 @@ conditions. ## iv. References -- https://arxiv.org/pdf/1912.04804.pdf - +* https://arxiv.org/pdf/1912.04804.pdf. [ref: arxiv_1912_04804] -/ @[expose] public section @@ -200,17 +201,20 @@ lemma evenShiftSnd_eq_evenSnd_castSucc (j : Fin n) : evenShiftSnd j = evenSnd j. /-! -## B. The first plane +## B. The unshifted plane -/ +namespace Unshifted + /-! -### B.1. The basis vectors of the first plane as charges +### B.1. The basis vectors of the unshifted plane as charges -/ -/-- The first part of the basis as charges. -/ +set_option backward.isDefEq.respectTransparency false in +/-- The unshifted part of the basis as charges. -/ def basisAsCharges (j : Fin n.succ) : (PureU1 (2 * n.succ)).Charges := fun i => if i = evenFst j then @@ -227,6 +231,7 @@ def basisAsCharges (j : Fin n.succ) : (PureU1 (2 * n.succ)).Charges := -/ +set_option backward.isDefEq.respectTransparency false in lemma basis_on_evenFst_self (j : Fin n.succ) : basisAsCharges j (evenFst j) = 1 := by simp [basisAsCharges] @@ -286,6 +291,7 @@ lemma basis_on_evenSnd_other {k j : Fin n.succ} (h : k ≠ j) : basisAsCharges k -/ +set_option backward.isDefEq.respectTransparency false in lemma basis_linearACC (j : Fin n.succ) : (accGrav (2 * n.succ)) (basisAsCharges j) = 0 := by simp [accGrav, sum_even, basis_evenSnd_eq_neg_evenFst] /-! @@ -293,6 +299,7 @@ lemma basis_linearACC (j : Fin n.succ) : (accGrav (2 * n.succ)) (basisAsCharges ### B.4. The basis vectors satisfy the cubic ACC -/ +set_option backward.isDefEq.respectTransparency false in lemma basis_accCube (j : Fin n.succ) : accCube (2 * n.succ) (basisAsCharges j) = 0 := by rw [accCube_explicit, sum_even] @@ -306,7 +313,7 @@ lemma basis_accCube (j : Fin n.succ) : -/ -/-- The first part of the basis as `LinSols`. -/ +/-- The unshifted part of the basis as `LinSols`. -/ @[simps!] def basis (j : Fin n.succ) : (PureU1 (2 * n.succ)).LinSols := ⟨basisAsCharges j, by @@ -316,12 +323,12 @@ def basis (j : Fin n.succ) : (PureU1 (2 * n.succ)).LinSols := /-! -### B.6. The inclusion of the first plane into charges +### B.6. The inclusion of the unshifted plane into charges -/ -/-- A point in the span of the first part of the basis as a charge. -/ -def P (f : Fin n.succ → ℚ) : (PureU1 (2 * n.succ)).Charges := ∑ i, f i • basisAsCharges i +/-- A point in the span of the unshifted part of the basis as a charge. -/ +def planeCharges (f : Fin n.succ → ℚ) : (PureU1 (2 * n.succ)).Charges := ∑ i, f i • basisAsCharges i /-! @@ -329,23 +336,27 @@ def P (f : Fin n.succ → ℚ) : (PureU1 (2 * n.succ)).Charges := ∑ i, f i • -/ -lemma P_evenFst (f : Fin n.succ → ℚ) (j : Fin n.succ) : P f (evenFst j) = f j := by - rw [P, sum_of_charges] +lemma planeCharges_evenFst (f : Fin n.succ → ℚ) (j : Fin n.succ) : + planeCharges f (evenFst j) = f j := by + rw [planeCharges, sum_of_charges] simp only [succ_eq_add_one, HSMul.hSMul, SMul.smul] rw [Fintype.sum_eq_single j] · simp [basis_on_evenFst_self] · exact fun k hkj => mul_eq_zero_of_right (f k) (basis_on_evenFst_other hkj) -lemma P_evenSnd (f : Fin n.succ → ℚ) (j : Fin n.succ) : P f (evenSnd j) = - f j := by - rw [P, sum_of_charges] +lemma planeCharges_evenSnd (f : Fin n.succ → ℚ) (j : Fin n.succ) : + planeCharges f (evenSnd j) = - f j := by + rw [planeCharges, sum_of_charges] simp only [succ_eq_add_one, HSMul.hSMul, SMul.smul] rw [Fintype.sum_eq_single j] · simp [basis_on_evenSnd_self] · exact fun k hkj => mul_eq_zero_of_right (f k) (basis_on_evenSnd_other hkj) -lemma P_evenSnd_evenFst (f : Fin n.succ → ℚ) : P f ∘ evenSnd = - P f ∘ evenFst := by +set_option backward.isDefEq.respectTransparency false in +lemma planeCharges_evenSnd_evenFst (f : Fin n.succ → ℚ) : + planeCharges f ∘ evenSnd = - planeCharges f ∘ evenFst := by funext j - simp [P_evenFst, P_evenSnd] + simp [planeCharges_evenFst, planeCharges_evenSnd] /-! @@ -353,13 +364,16 @@ lemma P_evenSnd_evenFst (f : Fin n.succ → ℚ) : P f ∘ evenSnd = - P f ∘ e -/ -lemma P_linearACC (f : Fin n.succ → ℚ) : (accGrav (2 * n.succ)) (P f) = 0 := by - simp [accGrav, sum_even, P_evenSnd, P_evenFst] +set_option backward.isDefEq.respectTransparency false in +lemma planeCharges_linearACC (f : Fin n.succ → ℚ) : + (accGrav (2 * n.succ)) (planeCharges f) = 0 := by + simp [accGrav, sum_even, planeCharges_evenSnd, planeCharges_evenFst] -lemma P_accCube (f : Fin n.succ → ℚ) : accCube (2 * n.succ) (P f) = 0 := by +set_option backward.isDefEq.respectTransparency false in +lemma planeCharges_accCube (f : Fin n.succ → ℚ) : accCube (2 * n.succ) (planeCharges f) = 0 := by rw [accCube_explicit, sum_even] refine Finset.sum_eq_zero fun i _ => ?_ - simp only [succ_eq_add_one, Function.comp_apply, P_evenFst, P_evenSnd] + simp only [succ_eq_add_one, Function.comp_apply, planeCharges_evenFst, planeCharges_evenSnd] ring /-! @@ -368,8 +382,8 @@ lemma P_accCube (f : Fin n.succ → ℚ) : accCube (2 * n.succ) (P f) = 0 := by -/ -lemma P_zero (f : Fin n.succ → ℚ) (h : P f = 0) : ∀ i, f i = 0 := by - exact fun i => (P_evenFst f i).symm.trans (congr_fun h (evenFst i)) +lemma planeCharges_zero (f : Fin n.succ → ℚ) (h : planeCharges f = 0) : ∀ i, f i = 0 := by + exact fun i => (planeCharges_evenFst f i).symm.trans (congr_fun h (evenFst i)) /-! @@ -377,11 +391,12 @@ lemma P_zero (f : Fin n.succ → ℚ) (h : P f = 0) : ∀ i, f i = 0 := by -/ -/-- A point in the span of the first part of the basis. -/ -def P' (f : Fin n.succ → ℚ) : (PureU1 (2 * n.succ)).LinSols := ∑ i, f i • basis i +/-- A point in the span of the unshifted part of the basis. -/ +def planeLinSols (f : Fin n.succ → ℚ) : (PureU1 (2 * n.succ)).LinSols := ∑ i, f i • basis i -lemma P'_val (f : Fin n.succ → ℚ) : (P' f).val = P f := by - simp only [succ_eq_add_one, P', P] +set_option backward.isDefEq.respectTransparency false in +lemma planeLinSols_val (f : Fin n.succ → ℚ) : (planeLinSols f).val = planeCharges f := by + simp only [succ_eq_add_one, planeLinSols, planeCharges] funext i rw [sum_of_anomaly_free_linear, sum_of_charges] rfl @@ -395,12 +410,12 @@ lemma P'_val (f : Fin n.succ → ℚ) : (P' f).val = P f := by theorem basis_linear_independent : LinearIndependent ℚ (@basis n) := by apply Fintype.linearIndependent_iff.mpr intro f h - change P' f = 0 at h - exact P_zero f ((P'_val f).symm.trans (congrArg _ h)) + change planeLinSols f = 0 at h + exact planeCharges_zero f ((planeLinSols_val f).symm.trans (congrArg _ h)) /-! -### B.12. Every vector-like even solution is in the span of the basis of the first plane +### B.12. Every vector-like even solution is in the span of the basis of the unshifted plane -/ @@ -414,13 +429,13 @@ lemma vectorLikeEven_in_span (S : (PureU1 (2 * n.succ)).LinSols) use f apply ACCSystemLinear.LinSols.ext rw [sortAFL_val] - erw [P'_val] + erw [planeLinSols_val] apply ext_even · intro i - rw [P_evenFst] + rw [planeCharges_evenFst] rfl · intro i - rw [P_evenSnd] + rw [planeCharges_evenSnd] have ht := hS i change sort S.val (evenFst i) = - sort S.val (evenSnd i) at ht have h : sort S.val (evenSnd i) = - sort S.val (evenFst i) := by @@ -429,14 +444,21 @@ lemma vectorLikeEven_in_span (S : (PureU1 (2 * n.succ)).LinSols) rw [h] rfl + + +end Unshifted + /-! -## C. The vectors of the basis spanning the second plane, via the shifted even split +## C. The shifted plane -/ -/-- The second part of the basis as charges. -/ -def basis!AsCharges (j : Fin n) : (PureU1 (2 * n.succ)).Charges := +namespace Shifted + +set_option backward.isDefEq.respectTransparency false in +/-- The shifted part of the basis as charges. -/ +def basisAsCharges (j : Fin n) : (PureU1 (2 * n.succ)).Charges := fun i => if i = evenShiftFst j then 1 @@ -451,27 +473,27 @@ def basis!AsCharges (j : Fin n) : (PureU1 (2 * n.succ)).Charges := -/ -lemma basis!_on_evenShiftFst_self (j : Fin n) : basis!AsCharges j (evenShiftFst j) = 1 := by - simp [basis!AsCharges] - set_option backward.isDefEq.respectTransparency false in -lemma basis!_on_other {k : Fin n} {j : Fin (2 * n.succ)} (h1 : j ≠ evenShiftFst k) - (h2 : j ≠ evenShiftSnd k) : basis!AsCharges k j = 0 := by - simp only [basis!AsCharges, if_neg h1, if_neg h2] +lemma basis_on_evenShiftFst_self (j : Fin n) : basisAsCharges j (evenShiftFst j) = 1 := by + simp [basisAsCharges] set_option backward.isDefEq.respectTransparency false in -lemma basis!_on_evenShiftFst_other {k j : Fin n} (h : k ≠ j) : - basis!AsCharges k (evenShiftFst j) = 0 := by +lemma basis_on_other {k : Fin n} {j : Fin (2 * n.succ)} (h1 : j ≠ evenShiftFst k) + (h2 : j ≠ evenShiftSnd k) : basisAsCharges k j = 0 := by + simp only [basisAsCharges, if_neg h1, if_neg h2] + +lemma basis_on_evenShiftFst_other {k j : Fin n} (h : k ≠ j) : + basisAsCharges k (evenShiftFst j) = 0 := by rw [ne_eq, Fin.ext_iff] at h - refine basis!_on_other ?_ ?_ <;> + refine basis_on_other ?_ ?_ <;> simp only [ne_eq, Fin.ext_iff, evenShiftFst, evenShiftSnd, Fin.val_cast, Fin.val_castAdd, Fin.val_natAdd] <;> omega set_option backward.isDefEq.respectTransparency false in -lemma basis!_evenShftSnd_eq_neg_evenShiftFst (j i : Fin n) : - basis!AsCharges j (evenShiftSnd i) = - basis!AsCharges j (evenShiftFst i) := by - simp only [basis!AsCharges, succ_eq_add_one, evenShiftSnd, evenShiftFst] +lemma basis_evenShiftSnd_eq_neg_evenShiftFst (j i : Fin n) : + basisAsCharges j (evenShiftSnd i) = - basisAsCharges j (evenShiftFst i) := by + simp only [basisAsCharges, succ_eq_add_one, evenShiftSnd, evenShiftFst] split <;> split any_goals split any_goals split @@ -490,24 +512,22 @@ lemma basis!_evenShftSnd_eq_neg_evenShiftFst (j i : Fin n) : all_goals omega -lemma basis!_on_evenShiftSnd_self (j : Fin n) : basis!AsCharges j (evenShiftSnd j) = - 1 := by - rw [basis!_evenShftSnd_eq_neg_evenShiftFst, basis!_on_evenShiftFst_self] +lemma basis_on_evenShiftSnd_self (j : Fin n) : basisAsCharges j (evenShiftSnd j) = - 1 := by + rw [basis_evenShiftSnd_eq_neg_evenShiftFst, basis_on_evenShiftFst_self] -lemma basis!_on_evenShiftSnd_other {k j : Fin n} (h : k ≠ j) : - basis!AsCharges k (evenShiftSnd j) = 0 := by - rw [basis!_evenShftSnd_eq_neg_evenShiftFst, basis!_on_evenShiftFst_other h] +lemma basis_on_evenShiftSnd_other {k j : Fin n} (h : k ≠ j) : + basisAsCharges k (evenShiftSnd j) = 0 := by + rw [basis_evenShiftSnd_eq_neg_evenShiftFst, basis_on_evenShiftFst_other h] rfl -set_option backward.isDefEq.respectTransparency false in -lemma basis!_on_evenShiftZero (j : Fin n) : basis!AsCharges j evenShiftZero = 0 := by - refine basis!_on_other ?_ ?_ <;> +lemma basis_on_evenShiftZero (j : Fin n) : basisAsCharges j evenShiftZero = 0 := by + refine basis_on_other ?_ ?_ <;> simp only [ne_eq, Fin.ext_iff, evenShiftZero, evenShiftFst, evenShiftSnd, Fin.val_cast, Fin.val_castAdd, Fin.val_natAdd, Fin.val_eq_zero] <;> omega -set_option backward.isDefEq.respectTransparency false in -lemma basis!_on_evenShiftLast (j : Fin n) : basis!AsCharges j evenShiftLast = 0 := by - refine basis!_on_other ?_ ?_ <;> +lemma basis_on_evenShiftLast (j : Fin n) : basisAsCharges j evenShiftLast = 0 := by + refine basis_on_other ?_ ?_ <;> simp only [ne_eq, Fin.ext_iff, evenShiftLast, evenShiftFst, evenShiftSnd, Fin.val_cast, Fin.val_castAdd, Fin.val_natAdd, Fin.val_eq_zero, add_zero] <;> omega @@ -518,9 +538,10 @@ lemma basis!_on_evenShiftLast (j : Fin n) : basis!AsCharges j evenShiftLast = 0 -/ -lemma basis!_linearACC (j : Fin n) : (accGrav (2 * n.succ)) (basis!AsCharges j) = 0 := by - simp [accGrav, sum_evenShift, basis!_on_evenShiftZero, basis!_on_evenShiftLast, - basis!_evenShftSnd_eq_neg_evenShiftFst] +set_option backward.isDefEq.respectTransparency false in +lemma basis_linearACC (j : Fin n) : (accGrav (2 * n.succ)) (basisAsCharges j) = 0 := by + simp [accGrav, sum_evenShift, basis_on_evenShiftZero, basis_on_evenShiftLast, + basis_evenShiftSnd_eq_neg_evenShiftFst] /-! @@ -528,14 +549,15 @@ lemma basis!_linearACC (j : Fin n) : (accGrav (2 * n.succ)) (basis!AsCharges j) -/ -lemma basis!_accCube (j : Fin n) : - accCube (2 * n.succ) (basis!AsCharges j) = 0 := by +set_option backward.isDefEq.respectTransparency false in +lemma basis_accCube (j : Fin n) : + accCube (2 * n.succ) (basisAsCharges j) = 0 := by rw [accCube_explicit, sum_evenShift] - rw [basis!_on_evenShiftLast, basis!_on_evenShiftZero] + rw [basis_on_evenShiftLast, basis_on_evenShiftZero] simp only [ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, add_zero, Function.comp_apply, zero_add] refine Finset.sum_eq_zero fun i _ => ?_ - simp only [basis!_evenShftSnd_eq_neg_evenShiftFst] + simp only [basis_evenShiftSnd_eq_neg_evenShiftFst] ring /-! @@ -544,22 +566,22 @@ lemma basis!_accCube (j : Fin n) : -/ -/-- The second part of the basis as `LinSols`. -/ +/-- The shifted part of the basis as `LinSols`. -/ @[simps!] -def basis! (j : Fin n) : (PureU1 (2 * n.succ)).LinSols := - ⟨basis!AsCharges j, by +def basis (j : Fin n) : (PureU1 (2 * n.succ)).LinSols := + ⟨basisAsCharges j, by intro i match i with - | ⟨0, _⟩ => exact basis!_linearACC j⟩ + | ⟨0, _⟩ => exact basis_linearACC j⟩ /-! -### C.7. The inclusion of the second plane into charges +### C.7. The inclusion of the shifted plane into charges -/ -/-- A point in the span of the second part of the basis as a charge. -/ -def P! (f : Fin n → ℚ) : (PureU1 (2 * n.succ)).Charges := ∑ i, f i • basis!AsCharges i +/-- A point in the span of the shifted part of the basis as a charge. -/ +def planeCharges (f : Fin n → ℚ) : (PureU1 (2 * n.succ)).Charges := ∑ i, f i • basisAsCharges i /-! @@ -567,25 +589,29 @@ def P! (f : Fin n → ℚ) : (PureU1 (2 * n.succ)).Charges := ∑ i, f i • bas -/ -lemma P!_evenShiftFst (f : Fin n → ℚ) (j : Fin n) : P! f (evenShiftFst j) = f j := by - rw [P!, sum_of_charges] +lemma planeCharges_evenShiftFst (f : Fin n → ℚ) (j : Fin n) : + planeCharges f (evenShiftFst j) = f j := by + rw [planeCharges, sum_of_charges] simp only [HSMul.hSMul, SMul.smul] rw [Fintype.sum_eq_single j] - · simp [basis!_on_evenShiftFst_self] - · exact fun k hkj => mul_eq_zero_of_right (f k) (basis!_on_evenShiftFst_other hkj) + · simp [basis_on_evenShiftFst_self] + · exact fun k hkj => mul_eq_zero_of_right (f k) (basis_on_evenShiftFst_other hkj) -lemma P!_evenShiftSnd (f : Fin n → ℚ) (j : Fin n) : P! f (evenShiftSnd j) = - f j := by - rw [P!, sum_of_charges] +lemma planeCharges_evenShiftSnd (f : Fin n → ℚ) (j : Fin n) : + planeCharges f (evenShiftSnd j) = - f j := by + rw [planeCharges, sum_of_charges] simp only [HSMul.hSMul, SMul.smul] rw [Fintype.sum_eq_single j] - · simp [basis!_on_evenShiftSnd_self] - · exact fun k hkj => mul_eq_zero_of_right (f k) (basis!_on_evenShiftSnd_other hkj) + · simp [basis_on_evenShiftSnd_self] + · exact fun k hkj => mul_eq_zero_of_right (f k) (basis_on_evenShiftSnd_other hkj) -lemma P!_evenShiftZero (f : Fin n → ℚ) : P! f (evenShiftZero) = 0 := by - simp [P!, sum_of_charges, HSMul.hSMul, SMul.smul, basis!_on_evenShiftZero] +set_option backward.isDefEq.respectTransparency false in +lemma planeCharges_evenShiftZero (f : Fin n → ℚ) : planeCharges f (evenShiftZero) = 0 := by + simp [planeCharges, sum_of_charges, HSMul.hSMul, SMul.smul, basis_on_evenShiftZero] -lemma P!_evenShiftLast (f : Fin n → ℚ) : P! f evenShiftLast = 0 := by - simp [P!, sum_of_charges, HSMul.hSMul, SMul.smul, basis!_on_evenShiftLast] +set_option backward.isDefEq.respectTransparency false in +lemma planeCharges_evenShiftLast (f : Fin n → ℚ) : planeCharges f evenShiftLast = 0 := by + simp [planeCharges, sum_of_charges, HSMul.hSMul, SMul.smul, basis_on_evenShiftLast] /-! @@ -593,12 +619,13 @@ lemma P!_evenShiftLast (f : Fin n → ℚ) : P! f evenShiftLast = 0 := by -/ -lemma P!_accCube (f : Fin n → ℚ) : accCube (2 * n.succ) (P! f) = 0 := by - rw [accCube_explicit, sum_evenShift, P!_evenShiftZero, P!_evenShiftLast] +set_option backward.isDefEq.respectTransparency false in +lemma planeCharges_accCube (f : Fin n → ℚ) : accCube (2 * n.succ) (planeCharges f) = 0 := by + rw [accCube_explicit, sum_evenShift, planeCharges_evenShiftZero, planeCharges_evenShiftLast] simp only [ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, add_zero, Function.comp_apply, zero_add] refine Finset.sum_eq_zero fun i _ => ?_ - simp only [P!_evenShiftFst, P!_evenShiftSnd] + simp only [planeCharges_evenShiftFst, planeCharges_evenShiftSnd] ring /-! @@ -607,16 +634,17 @@ lemma P!_accCube (f : Fin n → ℚ) : accCube (2 * n.succ) (P! f) = 0 := by -/ -lemma P!_zero (f : Fin n → ℚ) (h : P! f = 0) : ∀ i, f i = 0 := by - exact fun i => (P!_evenShiftFst f i).symm.trans (congr_fun h (evenShiftFst i)) +lemma planeCharges_zero (f : Fin n → ℚ) (h : planeCharges f = 0) : ∀ i, f i = 0 := by + exact fun i => (planeCharges_evenShiftFst f i).symm.trans (congr_fun h (evenShiftFst i)) /-! -### C.11. The inclusion of the second plane into the span of the basis +### C.11. The inclusion of the shifted plane into the span of the basis -/ -lemma P!_in_span (f : Fin n → ℚ) : P! f ∈ Submodule.span ℚ (Set.range basis!AsCharges) := by +lemma planeCharges_in_span (f : Fin n → ℚ) : + planeCharges f ∈ Submodule.span ℚ (Set.range basisAsCharges) := by exact (Submodule.mem_span_range_iff_exists_fun ℚ).mpr ⟨f, rfl⟩ /-! @@ -625,11 +653,12 @@ lemma P!_in_span (f : Fin n → ℚ) : P! f ∈ Submodule.span ℚ (Set.range ba -/ -/-- A point in the span of the second part of the basis. -/ -def P!' (f : Fin n → ℚ) : (PureU1 (2 * n.succ)).LinSols := ∑ i, f i • basis! i +/-- A point in the span of the shifted part of the basis. -/ +def planeLinSols (f : Fin n → ℚ) : (PureU1 (2 * n.succ)).LinSols := ∑ i, f i • basis i -lemma P!'_val (f : Fin n → ℚ) : (P!' f).val = P! f := by - simp only [succ_eq_add_one, P!', P!] +set_option backward.isDefEq.respectTransparency false in +lemma planeLinSols_val (f : Fin n → ℚ) : (planeLinSols f).val = planeCharges f := by + simp only [succ_eq_add_one, planeLinSols, planeCharges] funext i rw [sum_of_anomaly_free_linear, sum_of_charges] rfl @@ -640,11 +669,11 @@ lemma P!'_val (f : Fin n → ℚ) : (P!' f).val = P! f := by -/ -theorem basis!_linear_independent : LinearIndependent ℚ (@basis! n) := by +theorem basis_linear_independent : LinearIndependent ℚ (@basis n) := by apply Fintype.linearIndependent_iff.mpr intro f h - change P!' f = 0 at h - exact P!_zero f ((P!'_val f).symm.trans (congrArg _ h)) + change planeLinSols f = 0 at h + exact planeCharges_zero f ((planeLinSols_val f).symm.trans (congrArg _ h)) /-! @@ -652,9 +681,9 @@ theorem basis!_linear_independent : LinearIndependent ℚ (@basis! n) := by -/ -lemma smul_basis!AsCharges_in_span (S : (PureU1 (2 * n.succ)).LinSols) (j : Fin n) : - (S.val (evenShiftSnd j) - S.val (evenShiftFst j)) • basis!AsCharges j ∈ - Submodule.span ℚ (Set.range basis!AsCharges) := by +lemma smul_basisAsCharges_in_span (S : (PureU1 (2 * n.succ)).LinSols) (j : Fin n) : + (S.val (evenShiftSnd j) - S.val (evenShiftFst j)) • basisAsCharges j ∈ + Submodule.span ℚ (Set.range basisAsCharges) := by exact Submodule.smul_mem _ _ (Submodule.subset_span ⟨j, rfl⟩) /-! @@ -663,56 +692,65 @@ lemma smul_basis!AsCharges_in_span (S : (PureU1 (2 * n.succ)).LinSols) (j : Fin -/ +set_option backward.isDefEq.respectTransparency false in /-- Swapping the elements evenShiftFst j and evenShiftSnd j is equivalent to - adding a vector basis!AsCharges j. -/ -lemma swap!_as_add {S S' : (PureU1 (2 * n.succ)).LinSols} (j : Fin n) + adding a vector basisAsCharges j. -/ +lemma swap_as_add {S S' : (PureU1 (2 * n.succ)).LinSols} (j : Fin n) (hS : ((FamilyPermutations (2 * n.succ)).linSolRep (Equiv.swap (evenShiftFst j) (evenShiftSnd j))) S = S') : - S'.val = S.val + (S.val (evenShiftSnd j) - S.val (evenShiftFst j)) • basis!AsCharges j := by + S'.val = S.val + (S.val (evenShiftSnd j) - S.val (evenShiftFst j)) • basisAsCharges j := by funext i rw [← hS, FamilyPermutations_anomalyFreeLinear_apply] by_cases hi : i = evenShiftFst j · subst hi - simp [HSMul.hSMul, basis!_on_evenShiftFst_self, Equiv.swap_apply_left] + simp [HSMul.hSMul, basis_on_evenShiftFst_self, Equiv.swap_apply_left] · by_cases hi2 : i = evenShiftSnd j - · simp [HSMul.hSMul, hi2, basis!_on_evenShiftSnd_self, Equiv.swap_apply_right] + · simp [HSMul.hSMul, hi2, basis_on_evenShiftSnd_self, Equiv.swap_apply_right] · simp only [succ_eq_add_one, Equiv.invFun_as_coe, HSMul.hSMul, ACCSystemCharges.chargesAddCommMonoid_add, ACCSystemCharges.chargesModule_smul] - rw [basis!_on_other hi hi2] + rw [basis_on_other hi hi2] aesop + + +end Shifted + /-! ## D. Mixed cubic ACCs involving points from both planes -/ -lemma P_P_P!_accCube (g : Fin n.succ → ℚ) (j : Fin n) : - accCubeTriLinSymm (P g) (P g) (basis!AsCharges j) +set_option backward.isDefEq.respectTransparency false in +lemma unshifted_unshifted_shifted_accCube (g : Fin n.succ → ℚ) (j : Fin n) : + accCubeTriLinSymm (Unshifted.planeCharges g) (Unshifted.planeCharges g) + (Shifted.basisAsCharges j) = g (j.succ) ^ 2 - g (j.castSucc) ^ 2 := by simp only [succ_eq_add_one, accCubeTriLinSymm, TriLinearSymm.mk₃_toFun_apply_apply] - erw [sum_evenShift, basis!_on_evenShiftZero, basis!_on_evenShiftLast] + erw [sum_evenShift, Shifted.basis_on_evenShiftZero, Shifted.basis_on_evenShiftLast] simp only [mul_zero, add_zero, Function.comp_apply, zero_add] - rw [Fintype.sum_eq_single j, basis!_on_evenShiftFst_self, basis!_on_evenShiftSnd_self] + rw [Fintype.sum_eq_single j, Shifted.basis_on_evenShiftFst_self, + Shifted.basis_on_evenShiftSnd_self] · simp only [evenShiftFst_eq_evenFst_succ, mul_one, evenShiftSnd_eq_evenSnd_castSucc, mul_neg] - rw [P_evenFst, P_evenSnd] + rw [Unshifted.planeCharges_evenFst, Unshifted.planeCharges_evenSnd] ring · intro k hkj - erw [basis!_on_evenShiftFst_other hkj.symm, basis!_on_evenShiftSnd_other hkj.symm] + erw [Shifted.basis_on_evenShiftFst_other hkj.symm, Shifted.basis_on_evenShiftSnd_other hkj.symm] simp only [mul_zero, add_zero] -lemma P_P!_P!_accCube (g : Fin n → ℚ) (j : Fin n.succ) : - accCubeTriLinSymm (P! g) (P! g) (basisAsCharges j) - = (P! g (evenFst j))^2 - (P! g (evenSnd j))^2 := by +set_option backward.isDefEq.respectTransparency false in +lemma shifted_shifted_unshifted_accCube (g : Fin n → ℚ) (j : Fin n.succ) : + accCubeTriLinSymm (Shifted.planeCharges g) (Shifted.planeCharges g) (Unshifted.basisAsCharges j) + = (Shifted.planeCharges g (evenFst j))^2 - (Shifted.planeCharges g (evenSnd j))^2 := by simp only [succ_eq_add_one, accCubeTriLinSymm, TriLinearSymm.mk₃_toFun_apply_apply] erw [sum_even] simp only [Function.comp_apply] - rw [Fintype.sum_eq_single j, basis_on_evenFst_self, basis_on_evenSnd_self] + rw [Fintype.sum_eq_single j, Unshifted.basis_on_evenFst_self, Unshifted.basis_on_evenSnd_self] · simp only [mul_one, mul_neg] ring · intro k hkj - erw [basis_on_evenFst_other hkj.symm, basis_on_evenSnd_other hkj.symm] + erw [Unshifted.basis_on_evenFst_other hkj.symm, Unshifted.basis_on_evenSnd_other hkj.symm] simp only [mul_zero, add_zero] /-! @@ -729,8 +767,8 @@ lemma P_P!_P!_accCube (g : Fin n → ℚ) (j : Fin n.succ) : /-- The whole basis as `LinSols`. -/ def basisa : (Fin n.succ) ⊕ (Fin n) → (PureU1 (2 * n.succ)).LinSols := fun i => match i with - | .inl i => basis i - | .inr i => basis! i + | .inl i => Unshifted.basis i + | .inr i => Shifted.basis i /-! @@ -739,7 +777,8 @@ def basisa : (Fin n.succ) ⊕ (Fin n) → (PureU1 (2 * n.succ)).LinSols := fun i -/ /-- A point in the span of the basis as a charge. -/ -def Pa (f : Fin n.succ → ℚ) (g : Fin n → ℚ) : (PureU1 (2 * n.succ)).Charges := P f + P! g +def Pa (f : Fin n.succ → ℚ) (g : Fin n → ℚ) : (PureU1 (2 * n.succ)).Charges := + Unshifted.planeCharges f + Shifted.planeCharges g /-! @@ -747,29 +786,37 @@ def Pa (f : Fin n.succ → ℚ) (g : Fin n → ℚ) : (PureU1 (2 * n.succ)).Char -/ +set_option backward.isDefEq.respectTransparency false in lemma Pa_evenShiftFst (f : Fin n.succ → ℚ) (g : Fin n → ℚ) (j : Fin n) : Pa f g (evenShiftFst j) = f j.succ + g j := by rw [Pa] simp only [ACCSystemCharges.chargesAddCommMonoid_add] - rw [P!_evenShiftFst, evenShiftFst_eq_evenFst_succ, P_evenFst] + rw [Shifted.planeCharges_evenShiftFst, evenShiftFst_eq_evenFst_succ, + Unshifted.planeCharges_evenFst] +set_option backward.isDefEq.respectTransparency false in lemma Pa_evenShiftSnd (f : Fin n.succ → ℚ) (g : Fin n → ℚ) (j : Fin n) : Pa f g (evenShiftSnd j) = - f j.castSucc - g j := by rw [Pa] simp only [ACCSystemCharges.chargesAddCommMonoid_add] - rw [P!_evenShiftSnd, evenShiftSnd_eq_evenSnd_castSucc, P_evenSnd] + rw [Shifted.planeCharges_evenShiftSnd, evenShiftSnd_eq_evenSnd_castSucc, + Unshifted.planeCharges_evenSnd] ring +set_option backward.isDefEq.respectTransparency false in lemma Pa_evenShitZero (f : Fin n.succ → ℚ) (g : Fin n → ℚ) : Pa f g (evenShiftZero) = f 0 := by rw [Pa] simp only [ACCSystemCharges.chargesAddCommMonoid_add] - rw [P!_evenShiftZero, evenShiftZero_eq_evenFst_zero, P_evenFst, add_zero] + rw [Shifted.planeCharges_evenShiftZero, evenShiftZero_eq_evenFst_zero, + Unshifted.planeCharges_evenFst, add_zero] +set_option backward.isDefEq.respectTransparency false in lemma Pa_evenShiftLast (f : Fin n.succ → ℚ) (g : Fin n → ℚ) : Pa f g (evenShiftLast) = - f (Fin.last n) := by rw [Pa] simp only [ACCSystemCharges.chargesAddCommMonoid_add] - rw [P!_evenShiftLast, evenShiftLast_eq_evenSnd_last, P_evenSnd, add_zero] + rw [Shifted.planeCharges_evenShiftLast, evenShiftLast_eq_evenSnd_last, + Unshifted.planeCharges_evenSnd, add_zero] /-! @@ -803,9 +850,9 @@ lemma Pa_zero (f : Fin n.succ → ℚ) (g : Fin n → ℚ) (h : Pa f g = 0) : lemma Pa_zero! (f : Fin n.succ → ℚ) (g : Fin n → ℚ) (h : Pa f g = 0) : ∀ i, g i = 0 := by have hf := Pa_zero f g h - rw [Pa, P] at h + rw [Pa, Unshifted.planeCharges] at h simp only [succ_eq_add_one, hf, zero_smul, sum_const_zero, zero_add] at h - exact P!_zero g h + exact Shifted.planeCharges_zero g h /-! @@ -817,7 +864,7 @@ def Pa' (f : (Fin n.succ) ⊕ (Fin n) → ℚ) : (PureU1 (2 * n.succ)).LinSols : ∑ i, f i • basisa i lemma Pa'_P'_P!' (f : (Fin n.succ) ⊕ (Fin n) → ℚ) : - Pa' f = P' (f ∘ Sum.inl) + P!' (f ∘ Sum.inr) := by + Pa' f = Unshifted.planeLinSols (f ∘ Sum.inl) + Shifted.planeLinSols (f ∘ Sum.inr) := by exact Fintype.sum_sum_type _ /-! @@ -832,7 +879,8 @@ theorem basisa_linear_independent : LinearIndependent ℚ (@basisa n) := by change Pa' f = 0 at h have h1 : (Pa' f).val = 0 := congrArg _ h rw [Pa'_P'_P!'] at h1 - simp only [ACCSystemLinear.linSolsAddCommMonoid_add_val, P'_val, P!'_val] at h1 + simp only [ACCSystemLinear.linSolsAddCommMonoid_add_val, Unshifted.planeLinSols_val, + Shifted.planeLinSols_val] at h1 have hf := Pa_zero (f ∘ Sum.inl) (f ∘ Sum.inr) h1 have hg := Pa_zero! (f ∘ Sum.inl) (f ∘ Sum.inr) h1 rintro (i | i) @@ -864,7 +912,8 @@ lemma Pa'_elim_eq_iff (g g' : Fin n.succ → ℚ) (f f' : Fin n → ℚ) : rw [h.left, h.right] · apply ACCSystemLinear.LinSols.ext rw [Pa'_P'_P!', Pa'_P'_P!'] - simp only [succ_eq_add_one, ACCSystemLinear.linSolsAddCommMonoid_add_val, P'_val, P!'_val] + simp only [succ_eq_add_one, ACCSystemLinear.linSolsAddCommMonoid_add_val, + Unshifted.planeLinSols_val, Shifted.planeLinSols_val] exact h lemma Pa_eq (g g' : Fin n.succ → ℚ) (f f' : Fin n → ℚ) : @@ -902,16 +951,18 @@ noncomputable def basisaAsBasis : -/ lemma span_basis (S : (PureU1 (2 * n.succ)).LinSols) : - ∃ (g : Fin n.succ → ℚ) (f : Fin n → ℚ), S.val = P g + P! f := by + ∃ (g : Fin n.succ → ℚ) (f : Fin n → ℚ), + S.val = Unshifted.planeCharges g + Shifted.planeCharges f := by have h := (Submodule.mem_span_range_iff_exists_fun ℚ).mp (Basis.mem_span basisaAsBasis S) obtain ⟨f, hf⟩ := h simp only [succ_eq_add_one, basisaAsBasis, coe_basisOfLinearIndependentOfCardEqFinrank, Fintype.sum_sum_type] at hf - change P' _ + P!' _ = S at hf + change Unshifted.planeLinSols _ + Shifted.planeLinSols _ = S at hf use f ∘ Sum.inl use f ∘ Sum.inr rw [← hf] - simp only [succ_eq_add_one, ACCSystemLinear.linSolsAddCommMonoid_add_val, P'_val, P!'_val] + simp only [succ_eq_add_one, ACCSystemLinear.linSolsAddCommMonoid_add_val, + Unshifted.planeLinSols_val, Shifted.planeLinSols_val] rfl /-! @@ -922,23 +973,26 @@ lemma span_basis (S : (PureU1 (2 * n.succ)).LinSols) : lemma span_basis_swap! {S : (PureU1 (2 * n.succ)).LinSols} (j : Fin n) (hS : ((FamilyPermutations (2 * n.succ)).linSolRep (Equiv.swap (evenShiftFst j) (evenShiftSnd j))) S = S') (g : Fin n.succ → ℚ) (f : Fin n → ℚ) - (h : S.val = P g + P! f) : ∃ (g' : Fin n.succ → ℚ) (f' : Fin n → ℚ), - S'.val = P g' + P! f' ∧ P! f' = P! f + - (S.val (evenShiftSnd j) - S.val (evenShiftFst j)) • basis!AsCharges j ∧ g' = g := by - let X := P! f + (S.val (evenShiftSnd j) - S.val (evenShiftFst j)) • basis!AsCharges j - have hX : X ∈ Submodule.span ℚ (Set.range (basis!AsCharges)) := by + (h : S.val = Unshifted.planeCharges g + Shifted.planeCharges f) : + ∃ (g' : Fin n.succ → ℚ) (f' : Fin n → ℚ), + S'.val = Unshifted.planeCharges g' + Shifted.planeCharges f' ∧ + Shifted.planeCharges f' = Shifted.planeCharges f + + (S.val (evenShiftSnd j) - S.val (evenShiftFst j)) • Shifted.basisAsCharges j ∧ g' = g := by + let X := Shifted.planeCharges f + + (S.val (evenShiftSnd j) - S.val (evenShiftFst j)) • Shifted.basisAsCharges j + have hX : X ∈ Submodule.span ℚ (Set.range (Shifted.basisAsCharges)) := by apply Submodule.add_mem - exact (P!_in_span f) - exact (smul_basis!AsCharges_in_span S j) + exact (Shifted.planeCharges_in_span f) + exact (Shifted.smul_basisAsCharges_in_span S j) have hXsum := (Submodule.mem_span_range_iff_exists_fun ℚ).mp hX obtain ⟨f', hf'⟩ := hXsum use g use f' - change P! f' = _ at hf' + change Shifted.planeCharges f' = _ at hf' erw [hf'] simp only [and_self, and_true, X] rw [← add_assoc, ← h] - apply swap!_as_add at hS + apply Shifted.swap_as_add at hS exact hS end VectorLikeEvenPlane diff --git a/Physlib/QFT/QED/AnomalyCancellation/Even/LineInCubic.lean b/Physlib/QFT/QED/AnomalyCancellation/Even/LineInCubic.lean index cdec63a4e0..29e3acdcf0 100644 --- a/Physlib/QFT/QED/AnomalyCancellation/Even/LineInCubic.lean +++ b/Physlib/QFT/QED/AnomalyCancellation/Even/LineInCubic.lean @@ -16,11 +16,11 @@ if the line through that point and through the two different planes formed by th `LinSols` lies in the cubic. We show that for a solution all its permutations satisfy this property, then there exists -a permutation for which it lies in the plane spanned by the first part of the basis. +a permutation for which it lies in the unshifted plane. -The main reference for this file is: +## References -- https://arxiv.org/pdf/1912.04804.pdf +* The main reference for this file is https://arxiv.org/pdf/1912.04804.pdf. [ref: arxiv_1912_04804] -/ @[expose] public section @@ -37,30 +37,40 @@ open VectorLikeEvenPlane in the basis through that point is in the cubic. -/ def LineInCubic (S : (PureU1 (2 * n.succ)).LinSols) : Prop := ∀ (g : Fin n.succ → ℚ) (f : Fin n → ℚ) (_ : S.val = Pa g f) (a b : ℚ), - accCube (2 * n.succ) (a • P g + b • P! f) = 0 + accCube (2 * n.succ) (a • Unshifted.planeCharges g + b • Shifted.planeCharges f) = 0 set_option backward.isDefEq.respectTransparency false in lemma lineInCubic_expand {S : (PureU1 (2 * n.succ)).LinSols} (h : LineInCubic S) : ∀ (g : Fin n.succ → ℚ) (f : Fin n → ℚ) (_ : S.val = Pa g f) (a b : ℚ), - 3 * a * b * (a * accCubeTriLinSymm (P g) (P g) (P! f) - + b * accCubeTriLinSymm (P! f) (P! f) (P g)) = 0 := by + 3 * a * b * + (a * accCubeTriLinSymm (Unshifted.planeCharges g) + (Unshifted.planeCharges g) (Shifted.planeCharges f) + + b * accCubeTriLinSymm (Shifted.planeCharges f) + (Shifted.planeCharges f) (Unshifted.planeCharges g)) = 0 := by intro g f hS a b have h1 := h g f hS a b - change accCubeTriLinSymm.toCubic (a • P g + b • P! f) = 0 at h1 + change accCubeTriLinSymm.toCubic + (a • Unshifted.planeCharges g + b • Shifted.planeCharges f) = 0 at h1 simp only [TriLinearSymm.toCubic_add, HomogeneousCubic.map_smul, accCubeTriLinSymm.map_smul₁, accCubeTriLinSymm.map_smul₂, accCubeTriLinSymm.map_smul₃] at h1 - erw [P_accCube, P!_accCube] at h1 + erw [Unshifted.planeCharges_accCube, Shifted.planeCharges_accCube] at h1 linear_combination h1 /-- This lemma states that for a given `S` of type `(PureU1 (2 * n.succ)).AnomalyFreeLinear` and a proof `h` that the line through `S` lies on a cubic curve, -for any functions `g : Fin n.succ → ℚ` and `f : Fin n → ℚ`, if `S.val = P g + P! f`, -then `accCubeTriLinSymm.toFun (P g, P g, P! f) = 0`. +for any functions `g : Fin n.succ → ℚ` and `f : Fin n → ℚ`, if +`S.val = Unshifted.planeCharges g + Shifted.planeCharges f`, +then +`accCubeTriLinSymm.toFun (Unshifted.planeCharges g, Unshifted.planeCharges g, + Shifted.planeCharges f) = 0`. -/ -lemma line_in_cubic_P_P_P! {S : (PureU1 (2 * n.succ)).LinSols} (h : LineInCubic S) : - ∀ (g : Fin n.succ → ℚ) (f : Fin n → ℚ) (_ : S.val = P g + P! f), - accCubeTriLinSymm (P g) (P g) (P! f) = 0 := by +lemma line_in_cubic_unshifted_unshifted_shifted + {S : (PureU1 (2 * n.succ)).LinSols} (h : LineInCubic S) : + ∀ (g : Fin n.succ → ℚ) (f : Fin n → ℚ) + (_ : S.val = Unshifted.planeCharges g + Shifted.planeCharges f), + accCubeTriLinSymm (Unshifted.planeCharges g) (Unshifted.planeCharges g) + (Shifted.planeCharges f) = 0 := by intro g f hS linear_combination 2 / 3 * (lineInCubic_expand h g f hS 1 1) - (lineInCubic_expand h g f hS 1 2) / 6 @@ -88,24 +98,26 @@ lemma lineInCubicPerm_swap {S : (PureU1 (2 * n.succ)).LinSols} (LIC : LineInCubicPerm S) : ∀ (j : Fin n) (g : Fin n.succ → ℚ) (f : Fin n → ℚ) (_ : S.val = Pa g f), (S.val (evenShiftSnd j) - S.val (evenShiftFst j)) - * accCubeTriLinSymm (P g) (P g) (basis!AsCharges j) = 0 := by + * accCubeTriLinSymm (Unshifted.planeCharges g) (Unshifted.planeCharges g) + (Shifted.basisAsCharges j) = 0 := by intro j g f h obtain ⟨g', f', hall⟩ := span_basis_swap! j rfl g f h - have h1 := line_in_cubic_P_P_P! (lineInCubicPerm_self LIC) g f h - have h2 := line_in_cubic_P_P_P! + have h1 := line_in_cubic_unshifted_unshifted_shifted (lineInCubicPerm_self LIC) g f h + have h2 := line_in_cubic_unshifted_unshifted_shifted (lineInCubicPerm_self (lineInCubicPerm_permute LIC (Equiv.swap (evenShiftFst j) (evenShiftSnd j)))) g' f' hall.1 rw [hall.2.1, hall.2.2, accCubeTriLinSymm.map_add₃, h1, accCubeTriLinSymm.map_smul₃] at h2 simpa using h2 -lemma P_P_P!_accCube' {S : (PureU1 (2 * n.succ.succ)).LinSols} +lemma unshifted_unshifted_shifted_accCube' {S : (PureU1 (2 * n.succ.succ)).LinSols} (f : Fin n.succ.succ → ℚ) (g : Fin n.succ → ℚ) (hS : S.val = Pa f g) : - accCubeTriLinSymm (P f) (P f) (basis!AsCharges (Fin.last n)) = + accCubeTriLinSymm (Unshifted.planeCharges f) (Unshifted.planeCharges f) + (Shifted.basisAsCharges (Fin.last n)) = - (S.val (evenShiftSnd (Fin.last n)) + S.val (evenShiftFst (Fin.last n))) * (2 * S.val evenShiftLast + S.val (evenShiftSnd (Fin.last n)) + S.val (evenShiftFst (Fin.last n))) := by - rw [P_P_P!_accCube f (Fin.last n), hS, Pa_evenShiftSnd, Pa_evenShiftFst, Pa_evenShiftLast, - Fin.succ_last] + rw [unshifted_unshifted_shifted_accCube f (Fin.last n), hS, Pa_evenShiftSnd, + Pa_evenShiftFst, Pa_evenShiftLast, Fin.succ_last] ring lemma lineInCubicPerm_last_cond {S : (PureU1 (2 * n.succ.succ)).LinSols} @@ -115,7 +127,7 @@ lemma lineInCubicPerm_last_cond {S : (PureU1 (2 * n.succ.succ)).LinSols} (S.val evenShiftLast))) := by obtain ⟨g, f, hfg⟩ := span_basis S have h1 := lineInCubicPerm_swap LIC (Fin.last n) g f hfg - rw [P_P_P!_accCube' g f hfg] at h1 + rw [unshifted_unshifted_shifted_accCube' g f hfg] at h1 simp only [Nat.succ_eq_add_one, neg_add_rev, mul_eq_zero] at h1 rcases h1 with h1 | h1 | h1 · exact Or.inl (by linear_combination h1) @@ -144,8 +156,8 @@ theorem lineInCubicPerm_vectorLike {S : (PureU1 (2 * n.succ.succ)).Sols} theorem lineInCubicPerm_in_plane (S : (PureU1 (2 * n.succ.succ)).Sols) (LIC : LineInCubicPerm S.1.1) : ∃ (M : (FamilyPermutations (2 * n.succ.succ)).group), (FamilyPermutations (2 * n.succ.succ)).linSolRep M S.1.1 - ∈ Submodule.span ℚ (Set.range basis) := - vectorLikeEven_in_span S.1.1 (lineInCubicPerm_vectorLike LIC) + ∈ Submodule.span ℚ (Set.range Unshifted.basis) := + Unshifted.vectorLikeEven_in_span S.1.1 (lineInCubicPerm_vectorLike LIC) end Even end PureU1 diff --git a/Physlib/QFT/QED/AnomalyCancellation/Even/Parameterization.lean b/Physlib/QFT/QED/AnomalyCancellation/Even/Parameterization.lean index 5c469ac084..1269ddef61 100644 --- a/Physlib/QFT/QED/AnomalyCancellation/Even/Parameterization.lean +++ b/Physlib/QFT/QED/AnomalyCancellation/Even/Parameterization.lean @@ -11,11 +11,11 @@ public import Physlib.QFT.QED.AnomalyCancellation.Even.LineInCubic Given maps `g : Fin n.succ → ℚ`, `f : Fin n → ℚ` and `a : ℚ` we form a solution to the anomaly equations. We show that every solution can be got in this way, up to permutation, unless it, up to -permutation, lives in the plane spanned by the first part of the basis vector. +permutation, lives in the unshifted plane. -The main reference is: +## References -- https://arxiv.org/pdf/1912.04804.pdf +* The main reference is https://arxiv.org/pdf/1912.04804.pdf. [ref: arxiv_1912_04804] -/ @@ -29,22 +29,29 @@ open BigOperators variable {n : ℕ} open VectorLikeEvenPlane -/-- Given coefficients `g` of a point in `P` and `f` of a point in `P!`, and a rational, we get a +/-- Given coefficients `g` of a point in the unshifted plane and `f` of a point in the +shifted plane, and a rational, we get a rational `a ∈ ℚ`, we get a point in `(PureU1 (2 * n.succ)).AnomalyFreeLinear`, which we will later show extends to an anomaly free point. -/ def parameterizationAsLinear (g : Fin n.succ → ℚ) (f : Fin n → ℚ) (a : ℚ) : (PureU1 (2 * n.succ)).LinSols := - a • ((accCubeTriLinSymm (P! f) (P! f) (P g)) • P' g + - (- accCubeTriLinSymm (P g) (P g) (P! f)) • P!' f) + a • + ((accCubeTriLinSymm (Shifted.planeCharges f) (Shifted.planeCharges f) + (Unshifted.planeCharges g)) • Unshifted.planeLinSols g + + (- accCubeTriLinSymm (Unshifted.planeCharges g) (Unshifted.planeCharges g) + (Shifted.planeCharges f)) • Shifted.planeLinSols f) lemma parameterizationAsLinear_val (g : Fin n.succ → ℚ) (f : Fin n → ℚ) (a : ℚ) : (parameterizationAsLinear g f a).val = - a • ((accCubeTriLinSymm (P! f) (P! f) (P g)) • P g + - (- accCubeTriLinSymm (P g) (P g) (P! f)) • P! f) := by + a • + ((accCubeTriLinSymm (Shifted.planeCharges f) (Shifted.planeCharges f) + (Unshifted.planeCharges g)) • Unshifted.planeCharges g + + (- accCubeTriLinSymm (Unshifted.planeCharges g) (Unshifted.planeCharges g) + (Shifted.planeCharges f)) • Shifted.planeCharges f) := by rw [parameterizationAsLinear] - change a • (_ • (P' g).val + _ • (P!' f).val) = _ - rw [P'_val, P!'_val] + change a • (_ • (Unshifted.planeLinSols g).val + _ • (Shifted.planeLinSols f).val) = _ + rw [Unshifted.planeLinSols_val, Shifted.planeLinSols_val] set_option backward.isDefEq.respectTransparency false in lemma parameterizationCharge_cube (g : Fin n.succ → ℚ) (f : Fin n → ℚ) (a : ℚ) : @@ -52,7 +59,7 @@ lemma parameterizationCharge_cube (g : Fin n.succ → ℚ) (f : Fin n → ℚ) ( change accCubeTriLinSymm.toCubic _ = 0 rw [parameterizationAsLinear_val, HomogeneousCubic.map_smul, TriLinearSymm.toCubic_add, HomogeneousCubic.map_smul, HomogeneousCubic.map_smul] - erw [P_accCube, P!_accCube] + erw [Unshifted.planeCharges_accCube, Shifted.planeCharges_accCube] rw [accCubeTriLinSymm.map_smul₁, accCubeTriLinSymm.map_smul₂, accCubeTriLinSymm.map_smul₃, accCubeTriLinSymm.map_smul₁, accCubeTriLinSymm.map_smul₂, accCubeTriLinSymm.map_smul₃] @@ -65,23 +72,34 @@ def parameterization (g : Fin n.succ → ℚ) (f : Fin n → ℚ) (a : ℚ) : parameterizationCharge_cube g f a⟩ lemma anomalyFree_param {S : (PureU1 (2 * n.succ)).Sols} - (g : Fin n.succ → ℚ) (f : Fin n → ℚ) (hS : S.val = P g + P! f) : - accCubeTriLinSymm (P g) (P g) (P! f) = - accCubeTriLinSymm (P! f) (P! f) (P g) := by + (g : Fin n.succ → ℚ) (f : Fin n → ℚ) + (hS : S.val = Unshifted.planeCharges g + Shifted.planeCharges f) : + accCubeTriLinSymm (Unshifted.planeCharges g) (Unshifted.planeCharges g) + (Shifted.planeCharges f) = + - accCubeTriLinSymm (Shifted.planeCharges f) (Shifted.planeCharges f) + (Unshifted.planeCharges g) := by have hC := S.cubicSol rw [hS] at hC - change (accCube (2 * n.succ)) (P g + P! f) = 0 at hC - erw [TriLinearSymm.toCubic_add, P_accCube, P!_accCube] at hC + change (accCube (2 * n.succ)) (Unshifted.planeCharges g + Shifted.planeCharges f) = 0 at hC + erw [TriLinearSymm.toCubic_add, Unshifted.planeCharges_accCube, + Shifted.planeCharges_accCube] at hC linear_combination hC / 3 -/-- A proposition on a solution which is true if `accCubeTriLinSymm (P g, P g, P! f) ≠ 0`. +/-- A proposition on a solution which is true if +`accCubeTriLinSymm (Unshifted.planeCharges g, Unshifted.planeCharges g, + Shifted.planeCharges f) ≠ 0`. In this case our parameterization above will be able to recover this point. -/ def GenericCase (S : (PureU1 (2 * n.succ)).Sols) : Prop := - ∀ (g : Fin n.succ → ℚ) (f : Fin n → ℚ) (_ : S.val = P g + P! f), - accCubeTriLinSymm (P g) (P g) (P! f) ≠ 0 + ∀ (g : Fin n.succ → ℚ) (f : Fin n → ℚ) + (_ : S.val = Unshifted.planeCharges g + Shifted.planeCharges f), + accCubeTriLinSymm (Unshifted.planeCharges g) (Unshifted.planeCharges g) + (Shifted.planeCharges f) ≠ 0 lemma genericCase_exists (S : (PureU1 (2 * n.succ)).Sols) - (hs : ∃ (g : Fin n.succ → ℚ) (f : Fin n → ℚ), S.val = P g + P! f ∧ - accCubeTriLinSymm (P g) (P g) (P! f) ≠ 0) : GenericCase S := by + (hs : ∃ (g : Fin n.succ → ℚ) (f : Fin n → ℚ), + S.val = Unshifted.planeCharges g + Shifted.planeCharges f ∧ + accCubeTriLinSymm (Unshifted.planeCharges g) (Unshifted.planeCharges g) + (Shifted.planeCharges f) ≠ 0) : GenericCase S := by intro g f hS hC obtain ⟨g', f', hS', hC'⟩ := hs rw [hS] at hS' @@ -89,14 +107,20 @@ lemma genericCase_exists (S : (PureU1 (2 * n.succ)).Sols) rw [hS'.1, hS'.2] at hC exact hC' hC -/-- A proposition on a solution which is true if `accCubeTriLinSymm (P g, P g, P! f) = 0`. -/ +/-- A proposition on a solution which is true if +`accCubeTriLinSymm (Unshifted.planeCharges g, Unshifted.planeCharges g, + Shifted.planeCharges f) = 0`. -/ def SpecialCase (S : (PureU1 (2 * n.succ)).Sols) : Prop := - ∀ (g : Fin n.succ → ℚ) (f : Fin n → ℚ) (_ : S.val = P g + P! f), - accCubeTriLinSymm (P g) (P g) (P! f) = 0 + ∀ (g : Fin n.succ → ℚ) (f : Fin n → ℚ) + (_ : S.val = Unshifted.planeCharges g + Shifted.planeCharges f), + accCubeTriLinSymm (Unshifted.planeCharges g) (Unshifted.planeCharges g) + (Shifted.planeCharges f) = 0 lemma specialCase_exists (S : (PureU1 (2 * n.succ)).Sols) - (hs : ∃ (g : Fin n.succ → ℚ) (f : Fin n → ℚ), S.val = P g + P! f ∧ - accCubeTriLinSymm (P g) (P g) (P! f) = 0) : SpecialCase S := by + (hs : ∃ (g : Fin n.succ → ℚ) (f : Fin n → ℚ), + S.val = Unshifted.planeCharges g + Shifted.planeCharges f ∧ + accCubeTriLinSymm (Unshifted.planeCharges g) (Unshifted.planeCharges g) + (Shifted.planeCharges f) = 0) : SpecialCase S := by intro g f hS obtain ⟨g', f', hS', hC'⟩ := hs rw [hS] at hS' @@ -107,8 +131,10 @@ lemma specialCase_exists (S : (PureU1 (2 * n.succ)).Sols) lemma generic_or_special (S : (PureU1 (2 * n.succ)).Sols) : GenericCase S ∨ SpecialCase S := by obtain ⟨g, f, h⟩ := span_basis S.1.1 - have h1 : accCubeTriLinSymm (P g) (P g) (P! f) ≠ 0 ∨ - accCubeTriLinSymm (P g) (P g) (P! f) = 0 := by + have h1 : accCubeTriLinSymm (Unshifted.planeCharges g) (Unshifted.planeCharges g) + (Shifted.planeCharges f) ≠ 0 ∨ + accCubeTriLinSymm (Unshifted.planeCharges g) (Unshifted.planeCharges g) + (Shifted.planeCharges f) = 0 := by exact ne_or_eq _ _ rcases h1 with h1 | h1 · exact Or.inl (genericCase_exists S ⟨g, f, h, h1⟩) @@ -117,7 +143,9 @@ lemma generic_or_special (S : (PureU1 (2 * n.succ)).Sols) : theorem generic_case {S : (PureU1 (2 * n.succ)).Sols} (h : GenericCase S) : ∃ g f a, S = parameterization g f a := by obtain ⟨g, f, hS⟩ := span_basis S.1.1 - use g, f, (accCubeTriLinSymm (P! f) (P! f) (P g))⁻¹ + use g, f, + (accCubeTriLinSymm (Shifted.planeCharges f) (Shifted.planeCharges f) + (Unshifted.planeCharges g))⁻¹ rw [parameterization] apply ACCSystem.Sols.ext rw [parameterizationAsLinear_val] @@ -126,7 +154,7 @@ theorem generic_case {S : (PureU1 (2 * n.succ)).Sols} (h : GenericCase S) : · exact hS · have h := h g f hS rw [anomalyFree_param _ _ hS] at h - simp only [Nat.succ_eq_add_one, accCubeTriLinSymm_toFun_apply_apply, ne_eq, neg_eq_zero] at h + simp only [Nat.succ_eq_add_one, ne_eq, neg_eq_zero] at h exact h set_option backward.isDefEq.respectTransparency false in @@ -135,14 +163,15 @@ lemma special_case_lineInCubic {S : (PureU1 (2 * n.succ)).Sols} intro g f hS a b erw [TriLinearSymm.toCubic_add] rw [HomogeneousCubic.map_smul, HomogeneousCubic.map_smul] - erw [P_accCube, P!_accCube] + erw [Unshifted.planeCharges_accCube, Shifted.planeCharges_accCube] have h := h g f hS rw [accCubeTriLinSymm.map_smul₁, accCubeTriLinSymm.map_smul₂, accCubeTriLinSymm.map_smul₃, accCubeTriLinSymm.map_smul₁, accCubeTriLinSymm.map_smul₂, accCubeTriLinSymm.map_smul₃, h] rw [anomalyFree_param _ _ hS] at h simp only [Nat.succ_eq_add_one, accCubeTriLinSymm_toFun_apply_apply, neg_eq_zero] at h - change accCubeTriLinSymm (P! f) (P! f) (P g) = 0 at h + change accCubeTriLinSymm (Shifted.planeCharges f) (Shifted.planeCharges f) + (Unshifted.planeCharges g) = 0 at h erw [h] simp @@ -157,7 +186,7 @@ theorem special_case {S : (PureU1 (2 * n.succ.succ)).Sols} SpecialCase ((FamilyPermutations (2 * n.succ.succ)).solAction.toFun _ _ S M)) : ∃ (M : (FamilyPermutations (2 * n.succ.succ)).group), ((FamilyPermutations (2 * n.succ.succ)).solAction.toFun _ _ S M).1.1 - ∈ Submodule.span ℚ (Set.range basis) := + ∈ Submodule.span ℚ (Set.range Unshifted.basis) := lineInCubicPerm_in_plane S (special_case_lineInCubic_perm h) end Even diff --git a/Physlib/QFT/QED/AnomalyCancellation/LineInPlaneCond.lean b/Physlib/QFT/QED/AnomalyCancellation/LineInPlaneCond.lean index cf4896e36b..b7cccc51c8 100644 --- a/Physlib/QFT/QED/AnomalyCancellation/LineInPlaneCond.lean +++ b/Physlib/QFT/QED/AnomalyCancellation/LineInPlaneCond.lean @@ -16,7 +16,7 @@ We say a `LinSol` satisfies the `line in plane` condition if for all distinct `i We look at various consequences of this. The main reference for this material is -- https://arxiv.org/pdf/1912.04804.pdf +- https://arxiv.org/pdf/1912.04804.pdf [ref: arxiv_1912_04804] We will show that `n ≥ 4` the `line in plane` condition on solutions implies the `constAbs` condition. @@ -40,6 +40,7 @@ def LineInPlaneCond (S : (PureU1 n).LinSols) : Prop := ∀ (i1 i2 i3 : Fin n) (_ : i1 ≠ i2) (_ : i2 ≠ i3) (_ : i1 ≠ i3), LineInPlaneProp (S.val i1, (S.val i2, S.val i3)) +set_option backward.isDefEq.respectTransparency false in lemma lineInPlaneCond_perm {S : (PureU1 n).LinSols} (hS : LineInPlaneCond S) (M : (FamilyPermutations n).group) : LineInPlaneCond ((FamilyPermutations n).linSolRep M S) := by diff --git a/Physlib/QFT/QED/AnomalyCancellation/LowDim/Three.lean b/Physlib/QFT/QED/AnomalyCancellation/LowDim/Three.lean index 6cc9aa7d94..c6a868fe90 100644 --- a/Physlib/QFT/QED/AnomalyCancellation/LowDim/Three.lean +++ b/Physlib/QFT/QED/AnomalyCancellation/LowDim/Three.lean @@ -23,6 +23,7 @@ namespace PureU1 variable {n : ℕ} namespace Three +set_option backward.isDefEq.respectTransparency false in lemma cube_for_linSol' (S : (PureU1 3).LinSols) : 3 * S.val (0 : Fin 3) * S.val (1 : Fin 3) * S.val (2 : Fin 3) = 0 ↔ (PureU1 3).cubicACC S.val = 0 := by diff --git a/Physlib/QFT/QED/AnomalyCancellation/LowDim/Two.lean b/Physlib/QFT/QED/AnomalyCancellation/LowDim/Two.lean index 374b3dd4ae..55b6c8bc86 100644 --- a/Physlib/QFT/QED/AnomalyCancellation/LowDim/Two.lean +++ b/Physlib/QFT/QED/AnomalyCancellation/LowDim/Two.lean @@ -23,6 +23,7 @@ variable {n : ℕ} namespace Two +set_option backward.isDefEq.respectTransparency false in /-- An equivalence between `LinSols` and `Sols`. -/ def equiv : (PureU1 2).LinSols ≃ (PureU1 2).Sols where toFun S := ⟨⟨S, fun i => Fin.elim0 i⟩, by diff --git a/Physlib/QFT/QED/AnomalyCancellation/Odd/BasisLinear.lean b/Physlib/QFT/QED/AnomalyCancellation/Odd/BasisLinear.lean index ae018398cd..29120794ac 100644 --- a/Physlib/QFT/QED/AnomalyCancellation/Odd/BasisLinear.lean +++ b/Physlib/QFT/QED/AnomalyCancellation/Odd/BasisLinear.lean @@ -71,8 +71,7 @@ conditions. ## iv. References -- https://arxiv.org/pdf/1912.04804.pdf - +* https://arxiv.org/pdf/1912.04804.pdf. [ref: arxiv_1912_04804] -/ @[expose] public section @@ -271,6 +270,7 @@ namespace Unshifted -/ +set_option backward.isDefEq.respectTransparency false in /-- The unshifted part of the basis as charge assignments. -/ def basisAsCharges (j : Fin n) : (PureU1 (2 * n + 1)).Charges := fun i => @@ -288,6 +288,7 @@ def basisAsCharges (j : Fin n) : (PureU1 (2 * n + 1)).Charges := -/ +set_option backward.isDefEq.respectTransparency false in lemma basis_on_oddFst_self (j : Fin n) : basisAsCharges j (oddFst j) = 1 := by simp [basisAsCharges] @@ -338,6 +339,7 @@ lemma basis_on_oddMid (j : Fin n) : basisAsCharges j oddMid = 0 := by -/ +set_option backward.isDefEq.respectTransparency false in lemma basis_linearACC (j : Fin n) : (accGrav (2 * n + 1)) (basisAsCharges j) = 0 := by rw [accGrav] simp [sum_odd, basis_oddSnd_eq_minus_oddFst, basis_on_oddMid] @@ -397,10 +399,12 @@ lemma planeCharges_oddMid (f : Fin n → ℚ) : planeCharges f oddMid = 0 := by -/ +set_option backward.isDefEq.respectTransparency false in lemma planeCharges_linearACC (f : Fin n → ℚ) : (accGrav (2 * n + 1)) (planeCharges f) = 0 := by rw [accGrav] simp [sum_odd, planeCharges_oddSnd, planeCharges_oddFst, planeCharges_oddMid] +set_option backward.isDefEq.respectTransparency false in lemma planeCharges_accCube (f : Fin n → ℚ) : accCube (2 * n +1) (planeCharges f) = 0 := by rw [accCube_explicit, sum_odd, planeCharges_oddMid] simp only [ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, Function.comp_apply, zero_add] @@ -420,6 +424,7 @@ lemma planeCharges_zero (f : Fin n → ℚ) (h : planeCharges f = 0) : ∀ i, f /-- A point in the span of the unshifted part of the basis. -/ def planeLinSols (f : Fin n → ℚ) : (PureU1 (2 * n + 1)).LinSols := ∑ i, f i • basis i +set_option backward.isDefEq.respectTransparency false in lemma planeLinSols_val (f : Fin n → ℚ) : (planeLinSols f).val = planeCharges f := by simp only [planeLinSols, planeCharges] funext i @@ -454,6 +459,7 @@ namespace Shifted -/ +set_option backward.isDefEq.respectTransparency false in /-- The shifted part of the basis as charge assignments. -/ def basisAsCharges (j : Fin n) : (PureU1 (2 * n + 1)).Charges := fun i => @@ -471,6 +477,7 @@ def basisAsCharges (j : Fin n) : (PureU1 (2 * n + 1)).Charges := -/ +set_option backward.isDefEq.respectTransparency false in lemma basis_on_oddShiftFst_self (j : Fin n) : basisAsCharges j (oddShiftFst j) = 1 := by simp [basisAsCharges] @@ -523,6 +530,7 @@ lemma basis_on_oddShiftZero (j : Fin n) : basisAsCharges j oddShiftZero = 0 := b -/ +set_option backward.isDefEq.respectTransparency false in lemma basis_linearACC (j : Fin n) : (accGrav (2 * n + 1)) (basisAsCharges j) = 0 := by rw [accGrav] simp [sum_oddShift, basis_on_oddShiftZero, basis_oddShiftSnd_eq_minus_oddShiftFst] @@ -547,6 +555,7 @@ def basis (j : Fin n) : (PureU1 (2 * n + 1)).LinSols := -/ +set_option backward.isDefEq.respectTransparency false in /-- Swapping the elements oddShiftFst j and oddShiftSnd j is equivalent to adding a vector basisAsCharges j. -/ lemma swap_as_add {S S' : (PureU1 (2 * n + 1)).LinSols} (j : Fin n) @@ -609,10 +618,12 @@ lemma planeCharges_oddShiftZero (f : Fin n → ℚ) : planeCharges f oddShiftZer -/ +set_option backward.isDefEq.respectTransparency false in lemma planeCharges_linearACC (f : Fin n → ℚ) : (accGrav (2 * n + 1)) (planeCharges f) = 0 := by rw [accGrav] simp [sum_oddShift, planeCharges_oddShiftSnd, planeCharges_oddShiftFst, planeCharges_oddShiftZero] +set_option backward.isDefEq.respectTransparency false in lemma planeCharges_accCube (f : Fin n → ℚ) : accCube (2 * n +1) (planeCharges f) = 0 := by rw [accCube_explicit, sum_oddShift, planeCharges_oddShiftZero] simp only [ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, Function.comp_apply, zero_add] @@ -638,6 +649,7 @@ lemma planeCharges_zero (f : Fin n → ℚ) (h : planeCharges f = 0) : ∀ i, f /-- A point in the span of the shifted part of the basis. -/ def planeLinSols (f : Fin n → ℚ) : (PureU1 (2 * n + 1)).LinSols := ∑ i, f i • basis i +set_option backward.isDefEq.respectTransparency false in lemma planeLinSols_val (f : Fin n → ℚ) : (planeLinSols f).val = planeCharges f := by simp only [planeLinSols, planeCharges] funext i @@ -664,6 +676,7 @@ end Shifted -/ +set_option backward.isDefEq.respectTransparency false in lemma P_P_P!_accCube (g : Fin n → ℚ) (j : Fin n) : accCubeTriLinSymm (Unshifted.planeCharges g) (Unshifted.planeCharges g) (Shifted.basisAsCharges j) @@ -712,6 +725,7 @@ def Pa (f : Fin n → ℚ) (g : Fin n → ℚ) : (PureU1 (2 * n + 1)).Charges := -/ +set_option backward.isDefEq.respectTransparency false in lemma Pa_oddShiftShiftZero (f g : Fin n.succ → ℚ) : Pa f g oddShiftShiftZero = f 0 := by rw [Pa] simp only [ACCSystemCharges.chargesAddCommMonoid_add] @@ -720,6 +734,7 @@ lemma Pa_oddShiftShiftZero (f g : Fin n.succ → ℚ) : Pa f g oddShiftShiftZero rw [Shifted.planeCharges_oddShiftZero, oddShiftZero_eq_oddFst, Unshifted.planeCharges_oddFst, add_zero] +set_option backward.isDefEq.respectTransparency false in lemma Pa_oddShiftShiftFst (f g : Fin n.succ → ℚ) (j : Fin n) : Pa f g (oddShiftShiftFst j) = f j.succ + g j.castSucc := by rw [Pa] @@ -729,6 +744,7 @@ lemma Pa_oddShiftShiftFst (f g : Fin n.succ → ℚ) (j : Fin n) : rw [Shifted.planeCharges_oddShiftFst, oddShiftFst_castSucc_eq_oddFst_succ, Unshifted.planeCharges_oddFst] +set_option backward.isDefEq.respectTransparency false in lemma Pa_oddShiftShiftMid (f g : Fin n.succ → ℚ) : Pa f g oddShiftShiftMid = g (Fin.last n) := by rw [Pa] simp only [ACCSystemCharges.chargesAddCommMonoid_add] @@ -737,6 +753,7 @@ lemma Pa_oddShiftShiftMid (f g : Fin n.succ → ℚ) : Pa f g oddShiftShiftMid = rw [Shifted.planeCharges_oddShiftFst, oddShiftFst_last_eq_oddMid, Unshifted.planeCharges_oddMid, zero_add] +set_option backward.isDefEq.respectTransparency false in lemma Pa_oddShiftShiftSnd (f g : Fin n.succ → ℚ) (j : Fin n.succ) : Pa f g (oddShiftShiftSnd j) = - f j - g j := by rw [Pa] diff --git a/Physlib/QFT/QED/AnomalyCancellation/Odd/LineInCubic.lean b/Physlib/QFT/QED/AnomalyCancellation/Odd/LineInCubic.lean index 696608d1b0..6ebd0b4ead 100644 --- a/Physlib/QFT/QED/AnomalyCancellation/Odd/LineInCubic.lean +++ b/Physlib/QFT/QED/AnomalyCancellation/Odd/LineInCubic.lean @@ -18,9 +18,9 @@ if the line through that point and through the two different planes formed by th We show that for a solution all its permutations satisfy this property, then the charge must be zero. -The main reference for this file is: +## References -- https://arxiv.org/pdf/1912.04804.pdf +* The main reference for this file is https://arxiv.org/pdf/1912.04804.pdf. [ref: arxiv_1912_04804] -/ @[expose] public section diff --git a/Physlib/QFT/QED/AnomalyCancellation/Odd/Parameterization.lean b/Physlib/QFT/QED/AnomalyCancellation/Odd/Parameterization.lean index 41085efba9..e24b6ec1fc 100644 --- a/Physlib/QFT/QED/AnomalyCancellation/Odd/Parameterization.lean +++ b/Physlib/QFT/QED/AnomalyCancellation/Odd/Parameterization.lean @@ -12,9 +12,9 @@ public import Physlib.QFT.QED.AnomalyCancellation.Odd.LineInCubic Given maps `g : Fin n → ℚ`, `f : Fin n → ℚ` and `a : ℚ` we form a solution to the anomaly equations. We show that every solution can be got in this way, up to permutation, unless it is zero. -The main reference is: +## References -- https://arxiv.org/pdf/1912.04804.pdf +* The main reference is https://arxiv.org/pdf/1912.04804.pdf. [ref: arxiv_1912_04804] -/ diff --git a/Physlib/QFT/QED/AnomalyCancellation/Permutations.lean b/Physlib/QFT/QED/AnomalyCancellation/Permutations.lean index 221f1e0bc4..7eb9aff61e 100644 --- a/Physlib/QFT/QED/AnomalyCancellation/Permutations.lean +++ b/Physlib/QFT/QED/AnomalyCancellation/Permutations.lean @@ -53,6 +53,7 @@ lemma accGrav_invariant {n : ℕ} (f : (PermGroup n)) (S : (PureU1 n).Charges) : simp open BigOperators +set_option backward.isDefEq.respectTransparency false in lemma accCube_invariant {n : ℕ} (f : (PermGroup n)) (S : (PureU1 n).Charges) : accCube n (permCharges f S) = accCube n S := by rw [accCube_explicit, accCube_explicit] @@ -224,6 +225,7 @@ lemma permThree_thd : (permThree hij hjk hik hij' hjk' hik').toFun k' = k := by end permThree +set_option backward.isDefEq.respectTransparency false in lemma Prop_two (P : ℚ × ℚ → Prop) {S : (PureU1 n).LinSols} {a b : Fin n} (hab : a ≠ b) (h : ∀ (f : (FamilyPermutations n).group), @@ -240,6 +242,7 @@ lemma Prop_two (P : ℚ × ℚ → Prop) {S : (PureU1 n).LinSols} erw [permTwo_fst,permTwo_snd] at h1 exact h1 +set_option backward.isDefEq.respectTransparency false in lemma Prop_three (P : ℚ × ℚ × ℚ → Prop) {S : (PureU1 n).LinSols} {a b c : Fin n} (hab : a ≠ b) (hac : a ≠ c) (hbc : b ≠ c) (h : ∀ (f : (FamilyPermutations n).group), diff --git a/Physlib/QFT/QED/AnomalyCancellation/Sorts.lean b/Physlib/QFT/QED/AnomalyCancellation/Sorts.lean index e28cd3136d..225b9d78b3 100644 --- a/Physlib/QFT/QED/AnomalyCancellation/Sorts.lean +++ b/Physlib/QFT/QED/AnomalyCancellation/Sorts.lean @@ -46,6 +46,7 @@ lemma sort_apply {n : ℕ} (S : (PureU1 n).Charges) (j : Fin n) : sort S j = S ((Tuple.sort S) j) := by rfl +set_option backward.isDefEq.respectTransparency false in lemma sort_zero {n : ℕ} (S : (PureU1 n).Charges) (hS : sort S = 0) : S = 0 := by funext i have hj : ∀ j, sort S j = 0 := by diff --git a/Physlib/QuantumMechanics/FiniteTarget.lean b/Physlib/QuantumMechanics/FiniteTarget.lean index 886ed02519..86c87d5273 100644 --- a/Physlib/QuantumMechanics/FiniteTarget.lean +++ b/Physlib/QuantumMechanics/FiniteTarget.lean @@ -5,16 +5,15 @@ Authors: Joseph Tooby-Smith -/ module -public import Mathlib.Analysis.InnerProductSpace.Adjoint -public import Mathlib.Analysis.Normed.Algebra.Exponential +public import Physlib.Mathematics.OneParameterSubgroups.Unitary public import Physlib.Meta.TODO.Basic public import Physlib.QuantumMechanics.PlanckConstant /-! -# Finite target quantum mechanics +# Finite-dimensional quantum systems -The phrase 'finite target' is used to describe quantum mechanical systems where the -Hilbert space is finite. +A `FiniteTarget` consists of a finite-dimensional Hilbert space together with a self-adjoint +Hamiltonian. Its Hamiltonian determines a unitary time evolution through Stone's correspondence. Physical examples of such systems include: - Spin systems. @@ -28,42 +27,56 @@ open Constants Module namespace QuantumMechanics -/-- A `FiniteTarget` structure that is basis independent, i.e. use a linear map for - the hamiltonian instead of a matrix."-/ +/-- A finite-dimensional quantum system with a self-adjoint Hamiltonian. -/ structure FiniteTarget (H : Type*) [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] [FiniteDimensional ℂ H] (n : ℕ) where - /-- the Hilbert space has the provided (finite) dimension. -/ + /-- The Hilbert space has dimension `n`. -/ hdim: Module.finrank ℂ H = n - /-- The Hamiltonian, written now as a continuous linear map. -/ + /-- The Hamiltonian. -/ Ham : H →L[ℂ] H - -- The →L[ℂ]s has a Star algebra structure enabling `timeEvolution` definition below. /-- The Hamiltonian is self-adjoint. -/ Ham_selfAdjoint: IsSelfAdjoint Ham namespace FiniteTarget variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] [FiniteDimensional ℂ H] -- a Hilbert Space with finite dimension -variable {n : ℕ}(A : FiniteTarget H n) - -/-- Given a finite target QM system `A`, the time evolution operator for a `t : ℝ`, - `A.timeEvolution t` is defined as `exp(- I t /ℏ * A.Ham)`. Still a map. -/ -noncomputable def timeEvolution (t : ℝ) : H →L[ℂ] H := - NormedSpace.exp (-(Complex.I * t / ℏ) • A.Ham) - -- Note that the `H →L[ℂ] H`s make an algebra over 𝕂 := ℂ, so [Algebra 𝕂 𝔸] is satisfied. - -/-- The matrix representation of the time evolution operator in a given basis. Given a -Planck constant `ℏ`, the matrix is a self-adjoint `n × n` matrix describing the timeEvolution. -/ +variable {n : ℕ} (A : FiniteTarget H n) + +/-- The unitary time evolution generated by the Hamiltonian of `A`. -/ +noncomputable def unitaryTimeEvolution : UnitaryOneParameterGroup H := + UnitaryOneParameterGroup.ofSelfAdjoint (A := ((ℏ : ℂ)⁻¹) • A.Ham) (by + have hℏself : IsSelfAdjoint (ℏ : ℂ) := by + rw [isSelfAdjoint_iff, Complex.star_def, Complex.conj_ofReal] + exact hℏself.inv₀.smul A.Ham_selfAdjoint) + +/-- The generator of time evolution is the Hamiltonian divided by `ℏ`. -/ +@[simp] +lemma unitaryTimeEvolution_generator : + A.unitaryTimeEvolution.generator = ((ℏ : ℂ)⁻¹) • A.Ham := by + apply Eq.symm + apply UnitaryOneParameterGroup.generator_unique + intro t + rw [unitaryTimeEvolution, UnitaryOneParameterGroup.ofSelfAdjoint_apply] + +/-- The operator implementing the time evolution of `A` at time `t`. -/ +noncomputable def timeEvolution (t : ℝ) : H →L[ℂ] H := A.unitaryTimeEvolution t + +@[simp] lemma timeEvolution_eq_exp (t : ℝ) : + A.timeEvolution t = NormedSpace.exp ((-(t : ℂ) * Complex.I / ℏ) • A.Ham) := by + rw [timeEvolution, UnitaryOneParameterGroup.apply_eq_exp_generator, + unitaryTimeEvolution_generator, smul_smul] + congr 1 + +/-- The matrix of the time-evolution operator at time `t` in the basis `b`. -/ noncomputable def timeEvolutionMatrix (t : ℝ) (b : Basis (Fin n) ℂ H) : Matrix (Fin n) (Fin n) ℂ := LinearMap.toMatrix b b (A.timeEvolution t).toLinearMap - -- For `LinearMap.toMatrix`, both `M₁`, `M₂` are H. -/-- An instance of timeEvolutionmatrix over the standard basis. -/ +/-- The matrix of the time-evolution operator in a chosen basis indexed by `Fin n`. -/ noncomputable def timeEvolutionMatrixStandard (t : ℝ) : Matrix (Fin n) (Fin n) ℂ := - -- Use the fact that H ≃ ℂ^n to get a basis - let b : Basis (Fin n) ℂ H := Module.finBasisOfFinrankEq ℂ H A.hdim - (timeEvolutionMatrix A t b) + let b : Basis (Fin n) ℂ H := Module.finBasisOfFinrankEq ℂ H A.hdim + timeEvolutionMatrix A t b TODO "Define a smooth structure on `FiniteTarget`." diff --git a/Physlib/QuantumMechanics/FreeParticle/Basic.lean b/Physlib/QuantumMechanics/FreeParticle/Basic.lean index 657ba42b37..decd44ec99 100644 --- a/Physlib/QuantumMechanics/FreeParticle/Basic.lean +++ b/Physlib/QuantumMechanics/FreeParticle/Basic.lean @@ -29,6 +29,7 @@ to the Hamiltonian `p²/2m` with no potential. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/QuantumMechanics/HarmonicOscillator/Basic.lean b/Physlib/QuantumMechanics/HarmonicOscillator/Basic.lean index d756ac890e..6c60052d52 100644 --- a/Physlib/QuantumMechanics/HarmonicOscillator/Basic.lean +++ b/Physlib/QuantumMechanics/HarmonicOscillator/Basic.lean @@ -32,6 +32,7 @@ in `d` dimensions. - A.1. Positive mass - A.2. Positive natural frequencies - B. Characteristic lengths + - B.1. Coordinate rescaling - C. The quadratic potential function - C.1. Positive-definite matrix - C.2. Quadratic form @@ -46,19 +47,11 @@ in `d` dimensions. ## iv. References +* None. -/ @[expose] public section -TODO "Determine the spectrum of the quantum harmonic oscillator in terms of - the natural frequencies and integer quantum numbers." - -TODO "Determine the energy eigenstates of the quantum harmonic oscillator - in the 'Cartesian basis' in terms of Hermite polynomials." - -TODO "Determine the energy eigenstates of the isotropic quantum harmonic oscillator - in the 'spherical basis' in terms of spherical harmonics." - noncomputable section namespace QuantumMechanics @@ -131,6 +124,25 @@ lemma ξ_inv : (Q.ξ i)⁻¹ = √Q.m * √(Q.ω i) / √ℏ := by simp [ξ_eq] lemma ξ_inv' : (Q.ξ i)⁻¹ = Q.m * Q.ω i * Q.ξ i / ℏ := by field_simp; simp [ξ_sq, mul_assoc] +/-! +### B.1. Coordinate rescaling +-/ + +/-- The continuous linear equivalence which rescales `xᵢ` to `ξᵢxᵢ`. -/ +def ξEquiv : Space d ≃L[ℝ] Space d where + toFun x := ⟨fun i ↦ Q.ξ i * x i⟩ + invFun x := ⟨fun i ↦ (Q.ξ i)⁻¹ * x i⟩ + map_add' _ _ := by ext; simp [mul_add] + map_smul' _ _ := by ext; simp [mul_left_comm] + left_inv _ := by simp + right_inv _ := by simp + +@[simp] +lemma ξEquiv_apply (x : Space d) (i : Fin d) : Q.ξEquiv x i = Q.ξ i * x i := rfl + +@[simp] +lemma ξEquiv_symm_apply (x : Space d) (i : Fin d) : Q.ξEquiv.symm x i = (Q.ξ i)⁻¹ * x i := rfl + /-! ## C. The quadratic potential function -/ diff --git a/Physlib/QuantumMechanics/HarmonicOscillator/Eigenstates.lean b/Physlib/QuantumMechanics/HarmonicOscillator/Eigenstates.lean new file mode 100644 index 0000000000..0361e81d44 --- /dev/null +++ b/Physlib/QuantumMechanics/HarmonicOscillator/Eigenstates.lean @@ -0,0 +1,136 @@ +/- +Copyright (c) 2026 Gregory J. Loges. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gregory J. Loges +-/ +module + +public import Physlib.Mathematics.InnerProductSpace.Gaussian +public import Physlib.Mathematics.HasTemperateGrowth +public import Physlib.Mathematics.KroneckerDelta.Basic +public import Physlib.Mathematics.SpecialFunctions.PhysHermite +public import Physlib.QuantumMechanics.HarmonicOscillator.Basic +public import Physlib.Meta.Sorry +/-! + +# Energy eigenstates of the quantum harmonic oscillator + +## i. Overview + +The quantum harmonic oscillator in `d` dimensions is exactly solvable - the energy eigenvalues +and eigenfunction can be computed analytically. + +The ground-state wavefunction is a normalized Gaussian with covariance controlled +by the harmonic oscillator's characteristic lengths. A general state is then obtained by acting +on the ground state with the raising operators and is labelled by `d` integer quantum numbers. +Their wavefunctions are given by products of (physicist's) Hermite polynomials multiplying +the ground-state Gaussian. + +When the potential is isotropic another description of the energy eigenstates is possible; +energy eigenspaces carry SO(d) representations and eigenfunctions can be written in terms of +hyperspherical harmonics. In such cases the energies only depend on the radial quantum number. + +## ii. Key results + +## iii. Table of contents + +- A. Cartesian basis + - A.1. Energy eigenvalues + - A.2. Eigenfunctions + - A.3. Eigenstates + +## iv. References + +* None. +-/ +@[expose] public section + +TODO "Prove that the QHO eigenstates in the Cartesian basis (Hermite polynomials) are orthonormal." + +TODO "Prove that acting on the QHO eigenstates with the ladder operators shifts the integer quantum + numbers by one." + +TODO "Prove that the QHO eigenstates in the Cartesian basis (Hermite polynomials) satisfy the TISE." + +TODO "Prove that the (point) spectrum of the self-adjoint Hamiltonian is `Set.range Q.eigenEnergy`." + +TODO "Prove that the ground-state of the QHO is non-degenerate." + +TODO "Determine the energy eigenstates of the isotropic quantum harmonic oscillator + in the 'spherical basis' in terms of spherical harmonics." + +noncomputable section +namespace QuantumMechanics +namespace HarmonicOscillator + +open Complex Constants Finset InnerProductSpace Polynomial SchwartzMap Space SpaceDHilbertSpace +open scoped Nat Real ComplexConjugate + +variable {d : ℕ} (Q : HarmonicOscillator d) (n n' : Fin d → ℕ) (x : Space d) + +/-! +## A. Cartesian basis +-/ + +/-! +## A.1. Energy eigenvalues +-/ + +/-- The energy eigenvalues, `∑ i, ℏ ωᵢ (nᵢ + ½)`. -/ +def eigenEnergy : ℝ := ∑ i, ℏ * Q.ω i * (n i + 1 / 2) + +lemma eigenEnergy_eq : Q.eigenEnergy n = ∑ i, ℏ * Q.ω i * (n i + 1 / 2) := rfl + +lemma eigenEnergy_strictMono : StrictMono Q.eigenEnergy := by + intro n n' h + obtain ⟨h, i, hi⟩ := Pi.lt_def.mp h + exact sum_lt_sum (fun i _ ↦ by simp [h i]) ⟨i, mem_univ i, by simp [hi]⟩ + +/-! +### A.2. Eigenfunctions +-/ + +/-- The `i`th normalization constant for `Q.eigenfunction n`, `1 / √(2 ^ nᵢ * nᵢ! * √π * ξᵢ)`. -/ +def eigenCoeff (i : Fin d) : ℝ := 1 / √(2 ^ n i * (n i)! * √π * Q.ξ i) + +lemma eigenCoeff_eq (i : Fin d) : Q.eigenCoeff n i = 1 / √(2 ^ n i * (n i)! * √π * Q.ξ i) := rfl + +/-- The eigenfunction labelled by the integer quantum numbers `n : Fin d → ℕ`, defined as a product + of (physicist's) Hermite polynomials multiplying a Gaussian with covariance controlled + by the characteristic lengths, `Q.ξ`. -/ +def eigenfunction : 𝓢(Space d, ℂ) := + compCLMOfContinuousLinearEquiv ℂ Q.ξEquiv.symm <| smulLeftCLM ℂ + (fun x ↦ ∏ i, Q.eigenCoeff n i * physHermite (n i) (x i)) (stdGaussian (Space d) ℂ) + +lemma eigenfunction_eq : + Q.eigenfunction n = compCLMOfContinuousLinearEquiv ℂ Q.ξEquiv.symm (smulLeftCLM ℂ + (fun x ↦ ∏ i, Q.eigenCoeff n i * physHermite (n i) (x i)) (stdGaussian (Space d) ℂ)) := rfl + +lemma eigenfunction_apply : + Q.eigenfunction n x = + ∏ i, Q.eigenCoeff n i * + physHermite (n i) (x i / Q.ξ i) * cexp (-2⁻¹ * (x i / Q.ξ i) ^ 2) := by + rw [eigenfunction_eq, compCLMOfContinuousLinearEquiv_apply, Function.comp_apply, + smulLeftCLM_apply_apply (by fun_prop)] + simp [div_eq_mul_inv, prod_mul_distrib, exp_neg, norm_sq_eq, mul_sum, mul_comm, exp_sum] + +/-! +### A.3. Eigenstates +-/ + +/-- `Q.eigenfunction n` as an element of the Schwartz submodule of the Hilbert space. -/ +def eigenstate : SchwartzSubmodule d := schwartzEquiv _ (Q.eigenfunction n) + +lemma eigenstate_eq : Q.eigenstate n = schwartzEquiv _ (Q.eigenfunction n) := rfl + +/-- The energy eigenstates are orthonormal. -/ +@[simp, sorryful] +lemma eigenstates_orthonormal : ⟪(Q.eigenstate n : Q.HS), Q.eigenstate n'⟫_ℂ = δ[n,n'] := + -- It might help to first prove an analogue of + -- `MeasureTheory.integral_fin_nat_prod_(volume_)eq_prod` for `Space d` in order to split + -- `∫ x : Space d, Π i : Fin d, fᵢ (x i) = ∏ i : Fin d, ∫ xᵢ : ℝ, fᵢ xᵢ`, using `Space.equivPi`. + sorry + +end HarmonicOscillator +end QuantumMechanics +end diff --git a/Physlib/QuantumMechanics/HarmonicOscillator/OneDimension/Basic.lean b/Physlib/QuantumMechanics/HarmonicOscillator/OneDimension/Basic.lean index c2960cd8d5..b7318f7025 100644 --- a/Physlib/QuantumMechanics/HarmonicOscillator/OneDimension/Basic.lean +++ b/Physlib/QuantumMechanics/HarmonicOscillator/OneDimension/Basic.lean @@ -70,7 +70,7 @@ structure HarmonicOscillator where namespace HarmonicOscillator open Constants -open HilbertSpace +open _root_.QuantumMechanics.OneDimension.HilbertSpace open MeasureTheory variable (Q : HarmonicOscillator) diff --git a/Physlib/QuantumMechanics/HarmonicOscillator/OneDimension/Completeness.lean b/Physlib/QuantumMechanics/HarmonicOscillator/OneDimension/Completeness.lean index 6078eeaa45..0925b653b6 100644 --- a/Physlib/QuantumMechanics/HarmonicOscillator/OneDimension/Completeness.lean +++ b/Physlib/QuantumMechanics/HarmonicOscillator/OneDimension/Completeness.lean @@ -32,7 +32,9 @@ variable (Q : HarmonicOscillator) open Module Nat open Polynomial -open MeasureTheory HilbertSpace InnerProductSpace +open MeasureTheory +open _root_.QuantumMechanics.OneDimension.HilbertSpace +open InnerProductSpace /- @@ -359,6 +361,7 @@ lemma orthogonal_exp_of_mem_orthogonal (f : ℝ → ℂ) (hf : MemHS f) open FourierTransform MeasureTheory Real Lp MemLp Filter Complex Topology ComplexInnerProductSpace ComplexConjugate +set_option backward.isDefEq.respectTransparency false in /-- If `f` is a function `ℝ → ℂ` satisfying `MemHS f` such that it is orthogonal to all `eigenfunction n` then the fourier transform of diff --git a/Physlib/QuantumMechanics/HarmonicOscillator/OneDimension/Eigenfunction.lean b/Physlib/QuantumMechanics/HarmonicOscillator/OneDimension/Eigenfunction.lean index e9d1f70810..b0106e26ad 100644 --- a/Physlib/QuantumMechanics/HarmonicOscillator/OneDimension/Eigenfunction.lean +++ b/Physlib/QuantumMechanics/HarmonicOscillator/OneDimension/Eigenfunction.lean @@ -11,6 +11,9 @@ public import Physlib.Mathematics.SpecialFunctions.PhysHermite # Eigenfunction of the Harmonic Oscillator +Note: These eigenfunctions have been generalized to `d` dimensions in +`QuantumMechanics/HarmonicOscillator/Eigenstates.lean`. + -/ @[expose] public section @@ -22,7 +25,9 @@ namespace HarmonicOscillator variable (Q : HarmonicOscillator) -open Nat Polynomial HilbertSpace MeasureTheory Constants +open Nat Polynomial +open _root_.QuantumMechanics.OneDimension.HilbertSpace +open MeasureTheory Constants /-- The `n`th eigenfunction of the Harmonic oscillator is defined as the function `ℝ → ℂ` taking `x : ℝ` to diff --git a/Physlib/QuantumMechanics/HarmonicOscillator/OneDimension/TISE.lean b/Physlib/QuantumMechanics/HarmonicOscillator/OneDimension/TISE.lean index f1876c522d..ca6cb7b41c 100644 --- a/Physlib/QuantumMechanics/HarmonicOscillator/OneDimension/TISE.lean +++ b/Physlib/QuantumMechanics/HarmonicOscillator/OneDimension/TISE.lean @@ -21,7 +21,9 @@ namespace HarmonicOscillator variable (Q : HarmonicOscillator) -open Nat Polynomial HilbertSpace Constants +open Nat Polynomial +open _root_.QuantumMechanics.OneDimension.HilbertSpace +open Constants /-- The `n`th eigenvalues for a Harmonic oscillator is defined as `(n + 1/2) * ℏ * ω`. -/ noncomputable def eigenValue (n : ℕ) : ℝ := (n + 1/2) * ℏ * Q.ω diff --git a/Physlib/QuantumMechanics/HilbertSpaces/OneDimension/PlaneWaves.lean b/Physlib/QuantumMechanics/HilbertSpaces/OneDimension/PlaneWaves.lean index b4ee9ae2e8..2843462f6a 100644 --- a/Physlib/QuantumMechanics/HilbertSpaces/OneDimension/PlaneWaves.lean +++ b/Physlib/QuantumMechanics/HilbertSpaces/OneDimension/PlaneWaves.lean @@ -6,17 +6,16 @@ Authors: Joseph Tooby-Smith module public import Mathlib.Analysis.Distribution.TemperedDistribution -public import Physlib.Meta.TODO.Basic /-! # Plane waves -We define plane waves as a member of the dual of the -Schwartz submodule of the Hilbert space. +We define plane waves as a member of the dual of the Schwartz submodule of the 1d Hilbert space. --/ +This module has been generalized to d-dimensions in +`QuantumMechanics/HilbertSpaces/SpaceD/MomentumStates.lean` and will be removed in the near future. -TODO "Generalize plane waves to d dimensions and SpaceDHilbertSpace." +-/ @[expose] public section diff --git a/Physlib/QuantumMechanics/HilbertSpaces/OneDimension/PositionStates.lean b/Physlib/QuantumMechanics/HilbertSpaces/OneDimension/PositionStates.lean index 1d8801661e..eda69e810f 100644 --- a/Physlib/QuantumMechanics/HilbertSpaces/OneDimension/PositionStates.lean +++ b/Physlib/QuantumMechanics/HilbertSpaces/OneDimension/PositionStates.lean @@ -6,17 +6,16 @@ Authors: Joseph Tooby-Smith module public import Mathlib.Analysis.Distribution.TemperedDistribution -public import Physlib.Meta.TODO.Basic /-! # Position states -We define plane waves as a member of the dual of the -Schwartz submodule of the Hilbert space. +We define position state as a member of the dual of the Schwartz submodule of the 1d Hilbert space. --/ +This module has been generalized to d-dimensions in +`QuantumMechanics/HilbertSpaces/SpaceD/PositionStates.lean` and will be removed in the near future. -TODO "Generalize position states to d dimensions and SpaceDHilbertSpace." +-/ @[expose] public section namespace QuantumMechanics diff --git a/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/Basic.lean b/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/Basic.lean index 8d027fe804..068d226e0d 100644 --- a/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/Basic.lean +++ b/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/Basic.lean @@ -62,6 +62,7 @@ equivalence classes, essentially dropping information about the functions on the ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/DirichletSubmodule.lean b/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/DirichletSubmodule.lean index 01372710c8..8acd841e52 100644 --- a/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/DirichletSubmodule.lean +++ b/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/DirichletSubmodule.lean @@ -32,6 +32,7 @@ homogeneous Dirichlet boundary conditions on `Ω`. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/Fourier.lean b/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/Fourier.lean index 3521ade516..f056d12432 100644 --- a/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/Fourier.lean +++ b/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/Fourier.lean @@ -35,6 +35,7 @@ equivalence of `Lp ℂ 2 volume`, hence of `SpaceDHilbertSpace d`, onto itself; ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/MomentumStates.lean b/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/MomentumStates.lean new file mode 100644 index 0000000000..773d7e4d42 --- /dev/null +++ b/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/MomentumStates.lean @@ -0,0 +1,64 @@ +/- +Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +module + +public import Mathlib.Analysis.Distribution.TemperedDistribution +public import Physlib.SpaceAndTime.Space.Module +/-! + +# Momentum states + +## i. Overview + +Informally, the momentum "state" corresponding to momentum `p` is the non-normalizable +plane wave `exp (I p ⬝ᵥ x)`. More precisely, the momentum "state" lives in the _rigged_ Hilbert +space `𝓢(Space d, ℂ) < SpaceDHilbertSpace d μ < StrongDual ℂ 𝓢(Space d, ℂ)` as the element +of the dual of `𝓢(Space d, ℂ)` defined by evaluation of the Fourier transform at `p`. + +## ii. Key results + +## iii. Table of contents + +## iv. References + +* https://en.wikipedia.org/wiki/Rigged_Hilbert_space. [ref: wiki_rigged_hilbert_space] +-/ + +@[expose] public section + +TODO "Prove that momentum states are generalized eigenvectors of every derivative operator." + +namespace QuantumMechanics + +namespace SpaceDHilbertSpace + +noncomputable section + +open scoped Real SchwartzMap +open FourierTransform + +variable {d : ℕ} + +/-- Momentum state as a member of the strong dual of the Schwartz space. + + For a given `p` this corresponds to the non-normalizable plane wave `exp (I p ⬝ᵥ x)`. -/ +def momentumState (p : Space d) : StrongDual ℂ 𝓢(Space d, ℂ) := + TemperedDistribution.delta ((2 * π)⁻¹ • p) ∘L fourierCLM ℂ 𝓢(Space d, ℂ) + +/-- The defining property of momentum states. -/ +@[simp] +lemma momentumState_apply (p : Space d) (ψ : 𝓢(Space d, ℂ)) : + momentumState p ψ = 𝓕 ψ ((2 * π)⁻¹ • p) := rfl + +/-- Two Schwartz maps are equal if they are equal on all momentum states. -/ +lemma eq_of_eq_momentumState {ψ φ : 𝓢(Space d, ℂ)} + (h : ∀ p, momentumState p ψ = momentumState p φ) : ψ = φ := + fourierCLE ℂ 𝓢(Space d, ℂ) |>.injective <| SchwartzMap.ext + fun k ↦ by simpa [smul_smul, ← mul_rotate] using h ((2 * π) • k) + +end +end SpaceDHilbertSpace +end QuantumMechanics diff --git a/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/PolyBddSchwartzSubmodule.lean b/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/PolyBddSchwartzSubmodule.lean index 605e798235..d6c517cfca 100644 --- a/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/PolyBddSchwartzSubmodule.lean +++ b/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/PolyBddSchwartzSubmodule.lean @@ -49,6 +49,7 @@ their being dense in `SpaceDHilbertSpace 0 ≅ ℂ`). ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/PositionStates.lean b/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/PositionStates.lean new file mode 100644 index 0000000000..a2a61b2d42 --- /dev/null +++ b/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/PositionStates.lean @@ -0,0 +1,60 @@ +/- +Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +module + +public import Mathlib.Analysis.Distribution.TemperedDistribution +public import Physlib.SpaceAndTime.Space.Module +/-! + +# Position states + +## i. Overview + +Informally, the position "state" at `x : Space d` has a non-normalizable wavefunction which is +a Dirac-delta function centered at `x`. More precisely, the position "state" lives in the _rigged_ +Hilbert space `𝓢(Space d, ℂ) < SpaceDHilbertSpace d μ < StrongDual ℂ 𝓢(Space d, ℂ)` as the element +of the dual of `𝓢(Space d, ℂ)` defined by evaluation at `x`. + +## ii. Key results + +## iii. Table of contents + +## iv. References + +* https://en.wikipedia.org/wiki/Rigged_Hilbert_space. [ref: wiki_rigged_hilbert_space] +-/ + +@[expose] public section + +TODO "Prove that position states are generalized eigenvectors of every multiplication operator." + +namespace QuantumMechanics +namespace SpaceDHilbertSpace + +noncomputable section + +open scoped SchwartzMap + +variable {d : ℕ} + +/-- Position state as a member of the strong dual of the Schwartz space. + + For a given `x` this corresponds to the non-normalizable wavefunction `ψ(y) = δᵈ(y - x) -/ +def positionState (x : Space d) : StrongDual ℂ 𝓢(Space d, ℂ) := TemperedDistribution.delta x + +/-- The defining property of position states. -/ +@[simp] +lemma positionState_apply (x : Space d) (f : 𝓢(Space d, ℂ)) : positionState x f = f x := rfl + +/-- Two Schwartz maps are equal if they are equal on all position states. -/ +lemma eq_of_eq_positionState {f g : 𝓢(Space d, ℂ)} + (h : ∀ x, positionState x f = positionState x g) : f = g := by + ext x + exact h x + +end +end SpaceDHilbertSpace +end QuantumMechanics diff --git a/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/SchwartzSubmodule.lean b/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/SchwartzSubmodule.lean index f490912e38..e6789f6b43 100644 --- a/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/SchwartzSubmodule.lean +++ b/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/SchwartzSubmodule.lean @@ -36,6 +36,7 @@ submodule into itself. It also is a convenient dense domain on which to define d ## iv. References +* None. -/ @[expose] public section @@ -82,6 +83,7 @@ variable (f g : 𝓢(Space d, ℂ)) (ψ : SchwartzSubmodule d μ) instance : CoeFun (SchwartzSubmodule d μ) fun _ ↦ Space d → ℂ := ⟨fun ψ ↦ ψ.val⟩ +set_option backward.isDefEq.respectTransparency false in lemma schwartzEquiv_apply_coe : ↑(schwartzEquiv μ f) = schwartzIncl μ f := by simp [schwartzEquiv] lemma schwartzEquiv_coe_ae : schwartzEquiv μ f =ᵐ[μ] f := coeFn_toLp f 2 μ diff --git a/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/SobolevSubmodule.lean b/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/SobolevSubmodule.lean index d38d3c6612..baa79dc082 100644 --- a/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/SobolevSubmodule.lean +++ b/Physlib/QuantumMechanics/HilbertSpaces/SpaceD/SobolevSubmodule.lean @@ -28,6 +28,7 @@ In this module we define the Sobolev submodules of `SpaceDHilbertSpace`. ## iv. References +* None. -/ @[expose] public section @@ -48,9 +49,9 @@ variable {d : ℕ} {μ : Measure (Space d)} [μ.HasTemperateGrowth] associated tempered distribution satisfies `MemSobolev s 2`. -/ def SobolevSubmodule (d : ℕ) (s : ℝ) : Submodule ℂ (SpaceDHilbertSpace d) where carrier := {ψ | MemSobolev s 2 (toTemperedDistributionCLM d volume ψ)} - add_mem' {ψ φ} hψ hφ := by simpa only [Set.mem_setOf_eq, map_add] using hψ.add hφ - zero_mem' := by simpa only [Set.mem_setOf_eq, map_zero] using memSobolev_fun_zero (Space d) ℂ s 2 - smul_mem' c ψ hψ := by simpa only [Set.mem_setOf_eq, map_smul] using hψ.smul c + add_mem' {ψ φ} hψ hφ := by simpa only [Set.mem_ofPred_eq, map_add] using hψ.add hφ + zero_mem' := by simpa only [Set.mem_ofPred_eq, map_zero] using memSobolev_fun_zero (Space d) ℂ s 2 + smul_mem' c ψ hψ := by simpa only [Set.mem_ofPred_eq, map_smul] using hψ.smul c /-- Membership in `H^s` is the Sobolev condition on the associated tempered distribution. -/ lemma mem_sobolevSubmodule_iff {s : ℝ} {ψ : SpaceDHilbertSpace d} : diff --git a/Physlib/QuantumMechanics/HilbertSpaces/TensorProducts/API-map.yaml b/Physlib/QuantumMechanics/HilbertSpaces/TensorProducts/API-map.yaml new file mode 100644 index 0000000000..58d00a478c --- /dev/null +++ b/Physlib/QuantumMechanics/HilbertSpaces/TensorProducts/API-map.yaml @@ -0,0 +1,53 @@ +version: v0.1 + +Title: Hilbert space tensor products + +Overview: | + A common way to construct Hilbert spaces for composite quantum systems is through tensor products + of simpler constituent Hilbert spaces and taking completions. The key definitions of this API are + `CompleteTensorProduct` and `CompletePiTensorProduct`, the _completions_ of the tensor products + of a pair and indexed family of Hilbert spaces, respectively. + +ParentAPIs: + +References: + +Requirements: + + - description: + Defines the complete tensor product of a pair of Hilbert spaces. + done: true + location: Physlib/QuantumMechanics/HilbertSpaces/TensorProducts/CompleteTensorProduct.lean (CompleteTensorProduct) + + - description: + Provides a linear isometry equivalence expressing the commutativity of the complete tensor + product of a pair of Hilbert spaces. + done: true + location: Physlib/QuantumMechanics/HilbertSpaces/TensorProducts/CompleteTensorProduct.lean (CompleteTensorProduct.comm) + + - description: + Provides a linear isometry equivalence expressing the associativity of the complete tensor + product of pairs of Hilbert spaces. + done: true + location: Physlib/QuantumMechanics/HilbertSpaces/TensorProducts/CompleteTensorProduct.lean (CompleteTensorProduct.assoc) + + - description: + Proves that the complete tensor product is isometrically equivalent to the tensor product + when either factor is finite-dimensional. + done: false + location: N/A + + - description: + Defines the complete tensor product of an indexed family of Hilbert spaces. + done: false + location: N/A + + - description: + Defines the complete tensor power of a Hilbert space. + done: false + location: N/A + + - description: + Defines the Fock space of a seed Hilbert space. + done: false + location: N/A diff --git a/Physlib/QuantumMechanics/HilbertSpaces/CompleteTensorProduct.lean b/Physlib/QuantumMechanics/HilbertSpaces/TensorProducts/CompleteTensorProduct.lean similarity index 99% rename from Physlib/QuantumMechanics/HilbertSpaces/CompleteTensorProduct.lean rename to Physlib/QuantumMechanics/HilbertSpaces/TensorProducts/CompleteTensorProduct.lean index d4f7a72b38..aeb984803d 100644 --- a/Physlib/QuantumMechanics/HilbertSpaces/CompleteTensorProduct.lean +++ b/Physlib/QuantumMechanics/HilbertSpaces/TensorProducts/CompleteTensorProduct.lean @@ -50,6 +50,7 @@ and prove that `⊗ₕ` is commutative and associative (up to linear isometric e ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/QuantumMechanics/Hydrogen/Basic.lean b/Physlib/QuantumMechanics/Hydrogen/Basic.lean index 1ed9dd6842..5c776ac6ab 100644 --- a/Physlib/QuantumMechanics/Hydrogen/Basic.lean +++ b/Physlib/QuantumMechanics/Hydrogen/Basic.lean @@ -20,7 +20,11 @@ The standard hydrogen atom has `d=3`, `m = mₑmₚ/(mₑ + mₚ) ≈ mₑ` and The potential `V = -k/r` is singular at the origin. To address this we define a regularized Hamiltonian in which the potential is replaced by `-k·r(ε)⁻¹`, where `r(ε)² = ‖x‖² + ε²`. This goes by several names including "soft-core" and "truncated" Coulomb potential. -e.g. see https://doi.org/10.1103/PhysRevA.80.032507 and https://doi.org/10.1063/1.3290740. + +## References + +* https://doi.org/10.1103/PhysRevA.80.032507. [ref: doi_physreva_80_032507] +* https://doi.org/10.1063/1.3290740. [ref: doi_1063_1_3290740] -/ diff --git a/Physlib/QuantumMechanics/Hydrogen/LaplaceRungeLenzVector.lean b/Physlib/QuantumMechanics/Hydrogen/LaplaceRungeLenzVector.lean index 91f9609ccf..8475ecc761 100644 --- a/Physlib/QuantumMechanics/Hydrogen/LaplaceRungeLenzVector.lean +++ b/Physlib/QuantumMechanics/Hydrogen/LaplaceRungeLenzVector.lean @@ -7,7 +7,6 @@ module public import Physlib.QuantumMechanics.Hydrogen.Basic public import Physlib.QuantumMechanics.Operators.Commutation -public import Physlib.Meta.Linters.Sorry /-! # Laplace-Runge-Lenz vector @@ -94,14 +93,32 @@ lemma lrlOperator_eq'' (ε : ℝˣ) (i : Fin H.d) : H.lrlOperator ε i = ## Angular momentum / LRL vector commutators -/ +/-- A supporting piece of `angularMomentum_commutation_lrl`: how `𝐋ᵢⱼ` commutes with the +dot-product term `𝐋ₖ⬝ᵥ𝐩` appearing in `H.lrlOperator`'s expanded form (`lrlOperator_eq'`). -/ +lemma angularMomentum_commutation_Ldot_p (i j k : Fin H.d) : + ⁅𝐋[H.d] i j, 𝐋 k ⬝ᵥ 𝐩⁆ = + (I * ℏ) • (δ[i,k] • (𝐋 j ⬝ᵥ 𝐩) - δ[j,k] • (𝐋 i ⬝ᵥ 𝐩)) := by + simp only [dotProduct, mul_def, lie_sum, lie_leibniz, + angularMomentum_commutation_angularMomentum, angularMomentum_commutation_momentum, + comp_smul, smul_comp, comp_sub, sub_comp, add_comp] + simp only [Finset.sum_add_distrib, Finset.sum_sub_distrib, ← Finset.smul_sum, + KroneckerDelta.sum_smul] + rw [angularMomentumOperator_antisymm k i, angularMomentumOperator_antisymm k j] + simp only [neg_comp] + module + /-- `⁅𝐋ᵢⱼ, 𝐀(ε)ₖ⁆ = iℏ(δᵢₖ𝐀(ε)ⱼ - δⱼₖ𝐀(ε)ᵢ)` -/ -@[sorryful] lemma angularMomentum_commutation_lrl (ε : ℝˣ) (i j k : Fin H.d) : ⁅𝐋 i j, H.lrlOperator ε k⁆ = (I * ℏ) • (δ[i,k] • H.lrlOperator ε j - δ[j,k] • H.lrlOperator ε i) := by - sorry + simp_rw [H.lrlOperator_eq'] + rw [lie_sub, lie_add, angularMomentum_commutation_Ldot_p H i j k, lie_smul, + angularMomentum_commutation_momentum, lie_smul, lie_leibniz, + angularMomentum_commutation_radiusRegPow, angularMomentum_commutation_position] + simp only [zero_comp, comp_sub, comp_smul, smul_sub] + module /-- `⁅𝐋ᵢⱼ, 𝐀(ε)²⁆ = 0` -/ -@[sorryful, simp] +@[simp] lemma angularMomentum_commutation_lrlSqr (ε : ℝˣ) (i j : Fin H.d) : ⁅𝐋 i j, H.lrlOperator ε ⬝ᵥ H.lrlOperator ε⁆ = 0 := by simp only [dotProduct, mul_def, lie_sum, lie_leibniz, H.angularMomentum_commutation_lrl, @@ -109,7 +126,7 @@ lemma angularMomentum_commutation_lrlSqr (ε : ℝˣ) (i j : Fin H.d) : Finset.sum_sub_distrib, sum_smul, sub_add_sub_cancel, sub_self, smul_zero] /-- `⁅𝐋², 𝐀(ε)²⁆ = 0` -/ -@[sorryful, simp] +@[simp] lemma angularMomentumSqr_commutation_lrlSqr (ε : ℝˣ) : ⁅𝐋²[H.d], H.lrlOperator ε ⬝ᵥ H.lrlOperator ε⁆ = 0 := by simp [angularMomentumOperatorSqr, sum_lie, leibniz_lie] @@ -494,6 +511,7 @@ private lemma sum_rxrx (d : ℕ) (ε : ℝˣ) : ∑ i, 𝐫₀[d] ε (-1) ∘L ring_nf simp +set_option backward.isDefEq.respectTransparency false in /-- The square of the (regularized) LRL vector operator is related to the (regularized) Hamiltonian `𝐇(ε)` of the hydrogen atom, square of the angular momentum `𝐋²` and powers of `𝐫(ε)` as `𝐀(ε)² = 2m·𝐇(ε)(𝐋² + ¼ℏ²(d-1)²) + m²k²(𝟙 - ε²·𝐫(ε)⁻²) - ½(d-1)mkℏ²ε²𝐫(ε)⁻³`. -/ diff --git a/Physlib/QuantumMechanics/InfiniteSquareWell/Basic.lean b/Physlib/QuantumMechanics/InfiniteSquareWell/Basic.lean index 57ab7c6d1b..fe3ff960e4 100644 --- a/Physlib/QuantumMechanics/InfiniteSquareWell/Basic.lean +++ b/Physlib/QuantumMechanics/InfiniteSquareWell/Basic.lean @@ -30,6 +30,7 @@ trigonometric functions satisfying appropriate boundary conditions. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/QuantumMechanics/Operators/API-map.yaml b/Physlib/QuantumMechanics/Operators/API-map.yaml new file mode 100644 index 0000000000..6475f635e4 --- /dev/null +++ b/Physlib/QuantumMechanics/Operators/API-map.yaml @@ -0,0 +1,170 @@ +version: v0.1 + +Title: Operator algebra + +Overview: | + An observable of a quantum system is a self-adjoint operator on the Hilbert space of + states. The observables of interest are almost never defined on the whole space: + position multiplies a wavefunction by a coordinate and momentum differentiates it, and + both send square-integrable functions out of the space unless the wavefunction decays + or is smooth enough. The object to work with is therefore an operator defined on a + dense subspace, a partially defined linear map, together with the conditions that make + it a legitimate observable, namely a dense domain, symmetry of the inner-product + pairing on that domain, and self-adjointness, which is strictly stronger than symmetry + once the domain is a proper subspace. + + This API builds that framework and then the standard observables of non-relativistic + quantum mechanics on `Space d`. Multiplication by a real function of position gives + the potential energy and, componentwise, the position operator; powers of the radius + give the multipliers used for central potentials. Differentiation gives the momentum + operator -iℏ∂ᵢ. The two do not commute, and the canonical commutation relation + [xᵢ, pⱼ] = iℏ δᵢⱼ is proved on Schwartz maps, alongside the commutators of the + angular momenta 𝐋ᵢⱼ = xᵢpⱼ - xⱼpᵢ, which close into the Lie algebra of rotations and + commute with 𝐋², with the momentum squared, and with every regularized power of the + radius. + + The statistics of an observable T in a state ψ are the expectation value + ⟨T⟩ = re ⟪ψ, T ψ⟫, the variance ‖T ψ - ⟨T⟩ψ‖², and the standard deviation. The API + proves that the product of the standard deviations of two observables is bounded below + by half the size of the expected commutator, in both the Robertson and the + Robertson-Schrödinger forms. + + The modules work with `LinearPMap` on any complex Hilbert space and are applied to + `SpaceDHilbertSpace d`. The spectrum, the resolvent, the numerical range and spectral + measures are in the spectral theory API. No module in the directory carries a proof + gap; the open items below are recorded as TODO entries in the source or are absent + from it. + +ParentAPIs: + - "Hilbert spaces on Space (Physlib/QuantumMechanics/HilbertSpaces/SpaceD)" + - "Space (Physlib/SpaceAndTime/Space)" + - "Planck constant (Physlib/QuantumMechanics/PlanckConstant.lean)" + - "Partially defined linear maps (Physlib/Mathematics/LinearPMap.lean)" + - "Inner product spaces (Physlib/Mathematics/InnerProductSpace)" + +References: + - "B. C. Hall, Quantum Theory for Mathematicians, Springer (2013), Chapters 9 and 10 (unbounded self-adjoint operators) and Chapter 12 (position, momentum, expectation values and the uncertainty principle)" + - "M. Reed and B. Simon, Methods of Modern Mathematical Physics I. Functional Analysis, Academic Press (1980), Chapter VIII (unbounded operators)" + - "K. Schmüdgen, Unbounded Self-Adjoint Operators on Hilbert Space, Springer (2012), Chapters 1 to 3 (closed, symmetric and self-adjoint operators, and examples 1.3 and 3.8 on multiplication operators)" + - "J. J. Sakurai and J. Napolitano, Modern Quantum Mechanics, 2nd ed., Cambridge University Press (2017), Chapter 1 (observables, expectation values, the canonical commutation relation, the uncertainty relation) and Chapter 3 (angular momentum)" + - "D. J. Griffiths and D. F. Schroeter, Introduction to Quantum Mechanics, 3rd ed., Cambridge University Press (2018), Chapter 3 (observables, eigenfunctions of hermitian operators, the generalized uncertainty principle) and Chapter 4 (angular momentum)" + - "H. P. Robertson, The Uncertainty Principle, Phys. Rev. 34, 163 (1929)" + - "E. Schrödinger, Zum Heisenbergschen Unschärfeprinzip, Sitzungsberichte der Preussischen Akademie der Wissenschaften 19, 296 (1930)" + +Requirements: + + - description: "A dense domain and the unbounded operators, those that are densely defined and closable, are defined." + done: true + location: "Physlib/QuantumMechanics/Operators/Unbounded.lean (HasDenseDomain, IsUnbounded, isClosable_of_continuous, IsClosed.continuous_of_isClosed_domain)" + + - description: "Symmetry of the inner-product pairing on the domain is defined and characterized by the pairing of a vector with its own image being real." + done: true + location: "Physlib/QuantumMechanics/Operators/Unbounded.lean (IsSymmetric, isSymmetric_iff_inner_map_self_real)" + + - description: "Symmetry is stable under sums, powers and closures, and a self-adjoint operator is symmetric and closed." + done: true + location: "Physlib/QuantumMechanics/Operators/Unbounded.lean (IsSymmetric.isClosable, IsSymmetric.closure, IsSymmetric.add, IsSymmetric.pow, IsSelfAdjoint.isSymmetric, IsSelfAdjoint.isClosed)" + + - description: "Essential self-adjointness is defined, an essentially self-adjoint operator is unbounded, and its closure is its only self-adjoint extension." + done: true + location: "Physlib/QuantumMechanics/Operators/Unbounded.lean (IsEssentiallySelfAdjoint, IsEssentiallySelfAdjoint.isUnbounded, IsEssentiallySelfAdjoint.unique_self_adjoint_extension)" + + - description: "The adjoint calculus is developed, in particular that the adjoint of an unbounded operator is again unbounded and that the second adjoint is the closure." + done: true + location: "Physlib/QuantumMechanics/Operators/Unbounded.lean (adjoint_smul, adjoint_neg, adjoint_antitone, adjoint_add_le_add_adjoint, adjoint_compRestricted_le_compRestricted_adjoint, IsUnbounded.adjoint, IsUnbounded.adjoint_closure_eq_adjoint, IsUnbounded.adjoint_adjoint_eq_closure)" + + - description: "A symmetric densely defined operator whose ranges of T + i and T - i are the whole space is self-adjoint." + done: true + location: "Physlib/QuantumMechanics/Operators/Unbounded.lean (IsSymmetric.isSelfAdjoint_of_range_eq_top, IsSymmetric.isSelfAdjoint_iff, IsSymmetric.isEssentiallySelfAdjoint_iff)" + + - description: "Conjugation by a unitary is defined and preserves formal adjoints, dense domains and surjectivity of T - z." + done: true + location: "Physlib/QuantumMechanics/Operators/Unbounded.lean (unitaryConj, mem_unitaryConj_domain_iff, unitaryConj_apply, IsFormalAdjoint.unitaryConj, HasDenseDomain.unitaryConj_dense_domain, unitaryConj_sub_smul_surjective)" + + - description: "The multiplication operator of a complex function is defined with its maximal domain, and is densely defined for an almost everywhere strongly measurable multiplier." + done: true + location: "Physlib/QuantumMechanics/Operators/Multiplication.lean (mulOperator, notation 𝓜, mem_mulOperator_domain_iff, mulOperator_apply_ae, mulOperator_hasDenseDomain)" + + - description: "The domain of a multiplication operator is everything for a bounded multiplier and contains the Schwartz maps for one of temperate growth." + done: true + location: "Physlib/QuantumMechanics/Operators/Multiplication.lean (mulOperator_domain_eq_top, mulOperator_domain_antitone, mulOperator_conj_domain, mulOperator_domain_ge_of_hasTemperateGrowth)" + + - description: "The adjoint of a multiplication operator is multiplication by the conjugate, so a real multiplier gives a self-adjoint operator, and the operator is closed and unbounded." + done: true + location: "Physlib/QuantumMechanics/Operators/Multiplication.lean (mulOperator_adjoint_eq_conj, mulOperator_isSelfAdjoint_ofReal, mulOperator_isClosable, mulOperator_isUnbounded, mulOperator_isClosed)" + + - description: "Multiplication operators behave predictably under scalar multiples, sums and composition." + done: true + location: "Physlib/QuantumMechanics/Operators/Multiplication.lean (mulOperator_const_smul_eq, mulOperator_add_ge, mulOperator_add_eq, mulOperator_sub_ge, mulOperator_smul_ge)" + + - description: "Each component of the position operator is defined as multiplication by a coordinate, first on Schwartz maps and then as a partially defined operator, and is densely defined, self-adjoint and unbounded." + done: true + location: "Physlib/QuantumMechanics/Operators/Position.lean (positionCLM, notation 𝐱, positionCLM_apply, positionSqCLM_eq, positionOperator, notation 𝓧, positionOperator_hasDenseDomain, positionOperator_isSelfAdjoint, positionOperator_isUnbounded)" + + - description: "Multiplication by a power of the radius and by its smooth regularization supplies the multipliers of central potentials, with the condition for the product to stay square-integrable and the limit of the regularized operators." + done: true + location: "Physlib/QuantumMechanics/Operators/Position.lean (radiusRegPowCLM, notation 𝐫₀, radiusRegPowCLM_comp_eq, radiusPowLM, notation 𝐫, radiusPowLM_apply_memHS, radiusRegPow_tendsto_radiusPow, radiusRegPowOperator, radiusRegPowOperator_isSelfAdjoint, radiusPowOperator, radiusPowOperator_isSelfAdjoint, radiusPowOperator_domain_ge)" + + - description: "Each component of the momentum operator is defined as -iℏ∂ᵢ, first on Schwartz maps and then as a partially defined operator, and is densely defined, symmetric and unbounded on the Schwartz submodule, together with the momentum squared." + done: true + location: "Physlib/QuantumMechanics/Operators/Momentum.lean (momentumCLM, notation 𝐩, momentumCLM_apply, momentumOperator, notation 𝓟, momentumOperator_apply, momentumOperator_hasDenseDomain, momentumOperator_isSymmetric, momentumOperator_isUnbounded, momentumSqOperator, momentumSqOperator_domain_eq)" + + - description: "The API shall prove that the momentum operator is self-adjoint, and not merely symmetric, on the Sobolev space H¹ rather than the Schwartz submodule, and likewise for the momentum squared operator on H², both recorded as TODO items in Momentum.lean." + done: false + location: N/A + + - description: "The canonical commutation relation [xᵢ, pⱼ] = iℏ δᵢⱼ is proved on Schwartz maps, with the Leibniz rules used to reduce a commutator of products." + done: true + location: "Physlib/QuantumMechanics/Operators/Commutation.lean (leibniz_lie, lie_leibniz, comp_eq_comp_add_commute, comp_eq_comp_sub_commute, position_commutation_momentum, momentum_comp_position_eq, position_position_commutation_momentum, position_commutation_momentum_momentum)" + + - description: "The position components commute among themselves, the momentum components among themselves, and the API contains the commutator of a position component with the momentum squared." + done: true + location: "Physlib/QuantumMechanics/Operators/Commutation.lean (position_commutation_position, position_comp_commute, momentum_commutation_momentum, momentumSqr_commutation_momentum, position_commutation_momentumSqr)" + + - description: "The API contains the commutators of a regularized power of the radius with itself, with a position component, with a momentum component and with the momentum squared." + done: true + location: "Physlib/QuantumMechanics/Operators/Commutation.lean (position_commutation_radiusRegPow, radiusRegPow_commutation_radiusRegPow, radiusRegPow_commutation_momentum, momentum_comp_radiusRegPow_eq, radiusRegPow_commutation_momentumSqr)" + + - description: "The components 𝐋ᵢⱼ = xᵢpⱼ - xⱼpᵢ of the angular momentum operator and the scalar 𝐋² are defined on Schwartz maps, with antisymmetry in the two indices and the vanishing of a repeated index, and the one-, two- and three-dimensional cases are treated separately." + done: true + location: "Physlib/QuantumMechanics/Operators/AngularMomentum.lean (angularMomentumOperator, notation 𝐋, angularMomentumOperator_apply, angularMomentumOperator_antisymm, angularMomentumOperator_eq_zero, angularMomentumOperatorSqr, notation 𝐋², angularMomentumOperatorSqr_apply, angularMomentumOperator1D_trivial, angularMomentumOperator2D, angularMomentumOperator3D)" + + - description: "Position and momentum transform as vectors under the angular momenta, which close into the Lie algebra of rotations." + done: true + location: "Physlib/QuantumMechanics/Operators/Commutation.lean (angularMomentum_commutation_position, angularMomentum_commutation_momentum, angularMomentum_commutation_angularMomentum)" + + - description: "The scalar 𝐋² commutes with every angular momentum component, with the momentum squared and with any regularized power of the radius." + done: true + location: "Physlib/QuantumMechanics/Operators/Commutation.lean (angularMomentumSqr_commutation_angularMomentum, angularMomentumSqr_commutation_momentumSqr, angularMomentumSqr_commutation_radiusRegPow, angularMomentum_commutation_momentumSqr, angularMomentum_commutation_radiusRegPow)" + + - description: "The API shall carry angular momentum over from Schwartz maps, where it currently lives only as continuous linear maps, to the Hilbert space as a self-adjoint partially defined operator, with its spectrum, the raising and lowering operators, the eigenvalues ℏ² l (l + 1) of 𝐋² and ℏ m of a chosen component, and the spherical harmonics as the corresponding eigenfunctions." + done: false + location: N/A + + - description: "The expectation value of an observable in a state is defined as the real part of the pairing of the state with its image, together with the centered vector, and the pairing is already real for a symmetric operator." + done: true + location: "Physlib/QuantumMechanics/Operators/StateObservables/ExpectedValue.lean (expectedValue, expectedValue_eq_inner, centered, centered_eq_zero_iff, inner_state_centered_eq_zero, inner_centered_state_eq_zero)" + + - description: "The variance and the standard deviation are defined, with the second-order formula for the variance, and vanishing variance for a unit vector is exactly the eigenvector condition." + done: true + location: "Physlib/QuantumMechanics/Operators/StateObservables/Variance.lean (variance, variance_eq_centered_norm_sq, variance_eq_norm_sq_sub_expectedValue_sq, variance_eq_re_inner_sub_expectedValue_sq, variance_nonneg, variance_eq_zero_iff_isEigenvector, standardDeviation, standardDeviation_eq_zero_iff_isEigenvector)" + + - description: "The eigenvector condition for a partially defined operator is defined." + done: true + location: "Physlib/QuantumMechanics/Operators/StateObservables/IsEigenvector.lean (IsEigenvector, IsEigenvector.apply_eq, IsEigenvector.ne_zero)" + + - description: "The covariance of two observables in a state is defined, is symmetric, and reduces to the variance on a single observable." + done: true + location: "Physlib/QuantumMechanics/Operators/Covariance.lean (covariance, covariance_comm, covariance_eq_re_symm_centered, covariance_self_eq_variance)" + + - description: "The Robertson and Robertson-Schrödinger uncertainty bounds are proved, in which the product of two standard deviations is at least half the size of the expected commutator, stated for both a centered and a raw commutator identity." + done: true + location: "Physlib/QuantumMechanics/Operators/Uncertainty.lean (centeredCommutatorExpectation, rawCommutatorExpectation, inner_centered_commutator_of_raw_commutator, state_uncertainty_squared_of_centered_commutator, state_uncertainty_squared_with_covariance_of_centered_commutator, state_uncertainty_of_centered_commutator, state_uncertainty_squared_of_raw_commutator, state_uncertainty_squared_with_covariance_of_raw_commutator, state_uncertainty_of_raw_commutator)" + + - description: "The API shall contain the Heisenberg uncertainty relation for position and momentum, that the product of the standard deviations of xᵢ and pᵢ in any unit state of a common domain is at least ℏ/2, which needs the position and momentum operators on a common domain before the present commutator can be fed into the present Robertson bound." + done: false + location: N/A + + - description: "The API shall contain the standard examples that separate the classes of operators, since the distinction between symmetry and self-adjointness is otherwise invisible, recorded as TODO items in Examples.lean with no declarations yet." + done: false + location: N/A diff --git a/Physlib/QuantumMechanics/Operators/AngularMomentum.lean b/Physlib/QuantumMechanics/Operators/AngularMomentum.lean index aac1ecea7b..12618b686b 100644 --- a/Physlib/QuantumMechanics/Operators/AngularMomentum.lean +++ b/Physlib/QuantumMechanics/Operators/AngularMomentum.lean @@ -38,6 +38,7 @@ Notation: ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/QuantumMechanics/Operators/Commutation.lean b/Physlib/QuantumMechanics/Operators/Commutation.lean index 4bdbda525d..e1c5520db0 100644 --- a/Physlib/QuantumMechanics/Operators/Commutation.lean +++ b/Physlib/QuantumMechanics/Operators/Commutation.lean @@ -45,6 +45,7 @@ Commutator lemmas come in three flavors: ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/QuantumMechanics/Operators/Covariance.lean b/Physlib/QuantumMechanics/Operators/Covariance.lean index e6207e22b7..6294d719b5 100644 --- a/Physlib/QuantumMechanics/Operators/Covariance.lean +++ b/Physlib/QuantumMechanics/Operators/Covariance.lean @@ -29,8 +29,7 @@ In this module we define the covariance of two partial linear maps `A` and `B` i ## iv. References -- [B. C. Hall, *Quantum Theory for Mathematicians*, Chapter 12][hall2013quantum]. - +* B. C. Hall, Quantum Theory for Mathematicians, Chapter 12. [ref: hall2013quantum] -/ @[expose] public section diff --git a/Physlib/QuantumMechanics/Operators/Momentum.lean b/Physlib/QuantumMechanics/Operators/Momentum.lean index 2663d22cec..9adece071d 100644 --- a/Physlib/QuantumMechanics/Operators/Momentum.lean +++ b/Physlib/QuantumMechanics/Operators/Momentum.lean @@ -36,6 +36,7 @@ Notation: ## iv. References +* None. -/ TODO "Extend the domain of the momentum operator to the Sobolev space `H¹`." @@ -152,7 +153,7 @@ lemma momentumSqOperator_domain_eq : momentumSqOperator.domain = SchwartzSubmodu rw [momentumSqOperator_eq, sum_domain] rcases eq_zero_or_pos d with rfl | hd · simp [SchwartzSubmodule.zero_eq_top] - · letI := Fin.pos_iff_nonempty.mp hd + · let := Fin.pos_iff_nonempty.mp hd rw [← iInf_const (a := SchwartzSubmodule d) (ι := Fin d)] congr diff --git a/Physlib/QuantumMechanics/Operators/Multiplication.lean b/Physlib/QuantumMechanics/Operators/Multiplication.lean index 7dff04e130..5ed8a5bb4b 100644 --- a/Physlib/QuantumMechanics/Operators/Multiplication.lean +++ b/Physlib/QuantumMechanics/Operators/Multiplication.lean @@ -57,9 +57,8 @@ through multiplication in the Fourier domain: see `Operators/Derivative.lean`. ## iv. References -See examples 1.3 and 3.8 in -- [Konrad Schmüdgen, *Unbounded Self-Adjoint Operators on Hilbert Space*][Schmudgen2012] - +* Konrad Schmüdgen, Unbounded Self-Adjoint Operators on Hilbert Space, examples 1.3 and 3.8. + [ref: Schmudgen2012] -/ @[expose] public section diff --git a/Physlib/QuantumMechanics/Operators/OneDimension/Commutation.lean b/Physlib/QuantumMechanics/Operators/OneDimension/Commutation.lean index 0353ce24b8..ea8c108a2d 100644 --- a/Physlib/QuantumMechanics/Operators/OneDimension/Commutation.lean +++ b/Physlib/QuantumMechanics/Operators/OneDimension/Commutation.lean @@ -22,7 +22,8 @@ namespace QuantumMechanics namespace OneDimension noncomputable section open Constants -open HilbertSpace SchwartzMap +open _root_.QuantumMechanics.OneDimension.HilbertSpace +open SchwartzMap /-! diff --git a/Physlib/QuantumMechanics/Operators/OneDimension/Momentum.lean b/Physlib/QuantumMechanics/Operators/OneDimension/Momentum.lean index a904c0cbc0..6a4e6cac2d 100644 --- a/Physlib/QuantumMechanics/Operators/OneDimension/Momentum.lean +++ b/Physlib/QuantumMechanics/Operators/OneDimension/Momentum.lean @@ -29,7 +29,8 @@ namespace QuantumMechanics namespace OneDimension noncomputable section open Constants -open HilbertSpace SchwartzMap +open _root_.QuantumMechanics.OneDimension.HilbertSpace +open SchwartzMap /-! diff --git a/Physlib/QuantumMechanics/Operators/OneDimension/Parity.lean b/Physlib/QuantumMechanics/Operators/OneDimension/Parity.lean index a1b8b9ba4b..5745724306 100644 --- a/Physlib/QuantumMechanics/Operators/OneDimension/Parity.lean +++ b/Physlib/QuantumMechanics/Operators/OneDimension/Parity.lean @@ -89,7 +89,8 @@ def parityOperatorUnbounded : UnboundedOperator schwartzIncl schwartzIncl_inject lemma parityOperatorSchwartz_parityOperatorSchwartz (ψ : 𝓢(ℝ, ℂ)) : parityOperatorSchwartz (parityOperatorSchwartz ψ) = ψ := by ext x - simp [parityOperatorSchwartz] + show ψ (- - x) = ψ x + rw [neg_neg] /-! diff --git a/Physlib/QuantumMechanics/Operators/OneDimension/Position.lean b/Physlib/QuantumMechanics/Operators/OneDimension/Position.lean index e028935dce..18f9b26135 100644 --- a/Physlib/QuantumMechanics/Operators/OneDimension/Position.lean +++ b/Physlib/QuantumMechanics/Operators/OneDimension/Position.lean @@ -29,7 +29,7 @@ namespace QuantumMechanics namespace OneDimension noncomputable section -open HilbertSpace +open _root_.QuantumMechanics.OneDimension.HilbertSpace /-! @@ -80,7 +80,7 @@ def positionOperatorUnbounded : UnboundedOperator schwartzIncl schwartzIncl_inje /-! -## Generalized eigenvectors of the momentum operator +## Generalized eigenvectors of the position operator -/ diff --git a/Physlib/QuantumMechanics/Operators/OneDimension/Unbounded.lean b/Physlib/QuantumMechanics/Operators/OneDimension/Unbounded.lean index f2f1409758..add7fd1bc9 100644 --- a/Physlib/QuantumMechanics/Operators/OneDimension/Unbounded.lean +++ b/Physlib/QuantumMechanics/Operators/OneDimension/Unbounded.lean @@ -23,7 +23,7 @@ namespace QuantumMechanics namespace OneDimension noncomputable section -open HilbertSpace +open _root_.QuantumMechanics.OneDimension.HilbertSpace /-- An unbounded operator on the one-dimensional Hilbert space, corresponds to a subobject `ι : S →L[ℂ] HilbertSpace` of the Hilbert diff --git a/Physlib/QuantumMechanics/Operators/Position.lean b/Physlib/QuantumMechanics/Operators/Position.lean index 97b461be4b..a2ecc83789 100644 --- a/Physlib/QuantumMechanics/Operators/Position.lean +++ b/Physlib/QuantumMechanics/Operators/Position.lean @@ -46,6 +46,7 @@ Notation: ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/QuantumMechanics/Operators/SpectralTheory/API-map.yaml b/Physlib/QuantumMechanics/Operators/SpectralTheory/API-map.yaml new file mode 100644 index 0000000000..15a16f8fde --- /dev/null +++ b/Physlib/QuantumMechanics/Operators/SpectralTheory/API-map.yaml @@ -0,0 +1,105 @@ +version: v0.1 + +Title: Spectral theory of unbounded operators + +Overview: | + The measured values of an observable are the points of the spectrum of the operator + representing it, so the spectral theory of an unbounded operator is what connects the + formalism to an experiment. This API develops that theory for partially defined + operators on a complex Hilbert space: the resolvent and the resolvent set, the + spectrum with its point, residual and continuous parts, the regularity domain with the + deficiency subspace and the defect number, and the numerical range. + + Two results carry the physical content. For a symmetric operator the numerical range + is real, so every point off the real axis is a point of regularity, and the defect + numbers at i and -i decide essential self-adjointness. For a self-adjoint operator the + resolvent set and the regularity domain coincide, the spectrum lies in the real axis + and the residual spectrum is empty, which is the statement that a measurement returns + a real number. + + Spectral measures are defined here as projection-valued measures. The spectral theorem + that attaches one to each self-adjoint operator, and the functional calculus and time + evolution that follow from it, are open; nothing currently connects `SpectralMeasure` + to a self-adjoint operator. The algebraic theory of the operators themselves, and the + standard observables of non-relativistic quantum mechanics, are in the operator + algebra API. + +ParentAPIs: + - "Operator algebra (Physlib/QuantumMechanics/Operators)" + - "Partially defined linear maps (Physlib/Mathematics/LinearPMap.lean)" + - "Inner product spaces (Physlib/Mathematics/InnerProductSpace)" + +References: + - "B. C. Hall, Quantum Theory for Mathematicians, Springer (2013), Chapters 9 and 10 (unbounded self-adjoint operators, the spectral theorem)" + - "M. Reed and B. Simon, Methods of Modern Mathematical Physics I. Functional Analysis, Academic Press (1980), Chapters VII and VIII (the spectral theorem, unbounded operators)" + - "K. Schmüdgen, Unbounded Self-Adjoint Operators on Hilbert Space, Springer (2012), Chapters 1 to 3 (closed, symmetric and self-adjoint operators, defect numbers, the spectrum)" + +Requirements: + + - description: "The resolvent and the resolvent set are defined, the resolvent set is open, and it is characterized for a closed operator." + done: true + location: "Physlib/QuantumMechanics/Operators/SpectralTheory/Basic.lean (resolvent, notation 𝑅, resolventSet, notation ρ, resolventSet_isOpen, resolventSet_eq_empty, IsClosed.resolventSet_eq, IsClosed.resolventSet_eq')" + + - description: "The spectrum is defined with its point, residual and continuous parts, and is closed." + done: true + location: "Physlib/QuantumMechanics/Operators/SpectralTheory/Basic.lean (spectrum, notation σ, spectrum_isClosed, spectrum_eq_univ, pointSpectrum, residualSpectrum, continuousSpectrum, IsClosed.spectrum_eq, pointSpectrum_inter_residualSpectrum)" + + - description: "The two resolvent identities are proved." + done: true + location: "Physlib/QuantumMechanics/Operators/SpectralTheory/Basic.lean (resolvent_sub, resolvent_sub')" + + - description: "The regularity domain, the deficiency subspace and the defect number are defined, the regularity domain is open, and the defect number is constant on its connected components." + done: true + location: "Physlib/QuantumMechanics/Operators/SpectralTheory/Basic.lean (regularityDomain, regularityDomain_isOpen, regularityDomain_closure, deficiencySubspace, defectNumber, IsClosed.defectNumber_eq_zero_iff, IsClosable.defectNumber_const, IsClosable.closure_range_sub_eq_range_closure_sub)" + + - description: "The numerical range is defined, is convex by the Toeplitz-Hausdorff theorem, and the exterior of its closure consists of points of regularity." + done: true + location: "Physlib/QuantumMechanics/Operators/SpectralTheory/Basic.lean (numericalRange, notation Θ, mem_numericalRange, numericalRange_sub_const, numericalRange_convex, compl_closure_numericalRange_subset_regularityDomain)" + + - description: "The numerical range of a symmetric operator is real, and the API contains its projection to the real axis." + done: true + location: "Physlib/QuantumMechanics/Operators/SpectralTheory/Symmetric.lean (realNumericalRange, im_eq_zero_of_mem_numericalRange, numericalRange_subset, numericalRange_eq, closure_numericalRange_subset)" + + - description: "For a symmetric operator every point off the real axis is a point of regularity, and the regularity domain is connected when the operator is bounded above or below." + done: true + location: "Physlib/QuantumMechanics/Operators/SpectralTheory/Symmetric.lean (mem_regularityDomain_of_im_ne_zero, compl_ofReal_subset_regularityDomain, Iio_subset_regularityDomain, Ioi_subset_regularityDomain, regularityDomain_isConnected_iff, regularityDomain_isConnected_of_bddBelow, regularityDomain_isConnected_of_bddAbove)" + + - description: "A symmetric operator whose defect numbers at i and -i both vanish is essentially self-adjoint." + done: true + location: "Physlib/QuantumMechanics/Operators/SpectralTheory/Symmetric.lean (isEssentiallySelfAdjoint_of_defectNumber_eq_zero)" + + - description: "The eigenvalues of a symmetric operator are real." + done: true + location: "Physlib/QuantumMechanics/Operators/SpectralTheory/Symmetric.lean (pointSpectrum_real)" + + - description: "For a self-adjoint operator the resolvent set and the regularity domain coincide, and every complex number with non-zero imaginary part lies in the resolvent set with T - z onto." + done: true + location: "Physlib/QuantumMechanics/Operators/SpectralTheory/SelfAdjoint.lean (resolventSet_eq_regularityDomain, mem_resolventSet_of_im_ne_zero, sub_smul_surjective, mem_resolventSet_of_range_eq_top)" + + - description: "The spectrum of a self-adjoint operator lies in the real axis and its residual spectrum is empty." + done: true + location: "Physlib/QuantumMechanics/Operators/SpectralTheory/SelfAdjoint.lean (spectrum_real, residualSpectrum_eq_empty)" + + - description: "Conjugation by a unitary preserves self-adjointness, so an observable keeps its status under a change of representation." + done: true + location: "Physlib/QuantumMechanics/Operators/SpectralTheory/SelfAdjoint.lean (unitaryConj_isSelfAdjoint)" + + - description: "A spectral measure is defined as a vector measure valued in the bounded operators whose values are star projections and which sends the whole outcome space to the identity." + done: true + location: "Physlib/QuantumMechanics/Operators/SpectralTheory/SpectralMeasure.lean (SpectralMeasure, isStarProjection, univ)" + + - description: "The projections of two measurable sets compose to the projection of their intersection, disjoint sets give orthogonal projections, and all of them commute." + done: true + location: "Physlib/QuantumMechanics/Operators/SpectralTheory/SpectralMeasure.lean (comp_self, comp_of_disjoint, comp_eq_of_inter, commute)" + + - description: "The API shall contain the spectral theorem, that every self-adjoint operator is the integral of the identity against a spectral measure supported on its spectrum, equivalently that it is unitarily equivalent to multiplication by a real function on an L² space." + done: false + location: N/A + + - description: "The API shall contain the functional calculus that follows from the spectral theorem, and Stone's theorem giving the unitary time evolution generated by a self-adjoint Hamiltonian." + done: false + location: N/A + + - description: "The API shall describe the spectrum of a multiplication operator as the essential range of its multiplier, recorded as a TODO in Multiplication.lean." + done: false + location: N/A diff --git a/Physlib/QuantumMechanics/Operators/SpectralTheory/Basic.lean b/Physlib/QuantumMechanics/Operators/SpectralTheory/Basic.lean index 8f5b874b04..5e4cb80466 100644 --- a/Physlib/QuantumMechanics/Operators/SpectralTheory/Basic.lean +++ b/Physlib/QuantumMechanics/Operators/SpectralTheory/Basic.lean @@ -18,8 +18,8 @@ which are of central importance in quantum mechanics. Definitions for subsets of ℂ associated to an operator `T : H →ₗ.[ℂ] H` vary by author. Here we adopt those used in -[Konrad Schmüdgen, *Unbounded Self-Adjoint Operators on Hilbert Space*][Schmudgen2012], -summarized in the following table: +[Konrad Schmüdgen, Unbounded Self-Adjoint Operators on Hilbert Space][Schmudgen2012] +[ref: Schmudgen2012], summarized in the following table: | Subset of ℂ | abbrev. | `D(T - z)` | `R(T - z)` | `(T - z)⁻¹` | | :---------- | :-----: | :--------: | :--------: | :---------: | @@ -81,8 +81,7 @@ Main results ## iv. References -- [Konrad Schmüdgen, *Unbounded Self-Adjoint Operators on Hilbert Space*][Schmudgen2012] - +* Konrad Schmüdgen, Unbounded Self-Adjoint Operators on Hilbert Space. [ref: Schmudgen2012] -/ TODO "Move spectral theory definitions and lemmas over to Mathlib equivalents if/when available." @@ -324,7 +323,7 @@ lemma defectNumber_eq (T : H →ₗ.[ℂ] H) (z : ℂ) : lemma IsClosed.defectNumber_eq_zero_iff [CompleteSpace H] {T : H →ₗ.[ℂ] H} (hT : T.IsClosed) {z : ℂ} (hz : z ∈ T.regularityDomain) : T.defectNumber z = 0 ↔ (T - z • 1).toFun.range = ⊤ := by - haveI := hT.sub_range_isClosed hz -- needed for HasOrthogonalProjection + have := hT.sub_range_isClosed hz -- needed for HasOrthogonalProjection exact rank_eq_zero.trans orthogonal_eq_bot_iff /-- `T` and `T.closure` have the same defect number at points in their regularity domain. -/ @@ -355,7 +354,7 @@ lemma IsClosed.exists_inner_eq_zero_of_defectNumber_lt [CompleteSpace H] ∃ x : T.domain, x ≠ 0 ∧ ⟪T x - z₁ • x, T x - z₂ • x⟫_ℂ = 0 := by obtain ⟨y, h_inf, hy⟩ := (Submodule.ne_bot_iff _).mp (inf_ne_bot_of_rank_lt h) obtain ⟨hy₁, hy₂⟩ := mem_inf.mp h_inf - haveI := hT.sub_range_isClosed hz₁ -- needed for `orthogonal_orthogonal` + have := hT.sub_range_isClosed hz₁ -- needed for `orthogonal_orthogonal` simp only [deficiencySubspace_coe, orthogonal_orthogonal] at hy₁ hy₂ obtain ⟨⟨x, hx⟩, hxy⟩ := hy₁ refine ⟨⟨x, hx.1⟩, fun h ↦ hy ?_, ?_⟩ @@ -397,7 +396,7 @@ lemma IsClosable.defectNumber_const [CompleteSpace H] T.defectNumber z₁ = T.defectNumber z₂ := by by_cases hz₁ : z₁ ∈ T.regularityDomain · have h_joined : JoinedIn T.regularityDomain z₁ z₂ := by - haveI := T.regularityDomain_isOpen.locallyPathConnectedSpace + have := T.regularityDomain_isOpen.locallyPathConnectedSpace have hz₂ : z₂ ∈ T.regularityDomain := connectedComponentIn_subset _ _ hz apply (joinedIn_iff_joined hz₁ hz₂).mpr rw [← mem_pathComponent_iff, pathComponent_eq_connectedComponent] @@ -599,7 +598,7 @@ theorem numericalRange_convex (T : H →ₗ.[ℂ] H) : Convex ℝ (Θ T) := by obtain ⟨r, hr, hrt⟩ := (hg₀ ▸ hg₁ ▸ intermediate_value_Icc zero_le_one hg_cont.continuousOn) ht rw [← htc, ← hrt] refine ⟨‖f r‖⁻¹ • f r, ?_, ?_⟩ - · simp only [mem_setOf_eq, norm_smul, norm_inv, norm_norm] + · simp only [Set.mem_ofPred_eq, norm_smul, norm_inv, norm_norm] exact inv_mul_cancel₀ (norm_ne_zero_iff.mpr (hf r)) · have hf_sq : ofReal (‖f r‖ ^ 2) ≠ 0 := by simp [hf] simp_rw [← Complex.coe_smul, map_smul, SetLike.val_smul, inner_smul_left,inner_smul_right, @@ -659,7 +658,7 @@ lemma resolventSet_subset_regularityDomain (T : H →ₗ.[ℂ] H) : ρ T ⊆ T.r lemma IsClosed.resolventSet_eq [CompleteSpace H] {T : H →ₗ.[ℂ] H} (hT : T.IsClosed) : ρ T = {z : ℂ | (T - z • 1).toFun.ker = ⊥ ∧ (T - z • 1).toFun.range = ⊤} := by ext z - rw [mem_resolventSet_iff, mem_setOf_eq, and_congr_right_iff, and_iff_left_iff_imp] + rw [mem_resolventSet_iff, Set.mem_ofPred_eq, and_congr_right_iff, and_iff_left_iff_imp] intro h_ker h_range refine continuous_of_isClosed_domain ?_ ?_ · apply (inverse_closed_iff h_ker).mpr diff --git a/Physlib/QuantumMechanics/Operators/SpectralTheory/SelfAdjoint.lean b/Physlib/QuantumMechanics/Operators/SpectralTheory/SelfAdjoint.lean index 19b14ec2e4..f004b86de4 100644 --- a/Physlib/QuantumMechanics/Operators/SpectralTheory/SelfAdjoint.lean +++ b/Physlib/QuantumMechanics/Operators/SpectralTheory/SelfAdjoint.lean @@ -33,6 +33,7 @@ In this module we develop the spectral theory for self-adjoint operators. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/QuantumMechanics/Operators/SpectralTheory/SpectralMeasure.lean b/Physlib/QuantumMechanics/Operators/SpectralTheory/SpectralMeasure.lean index ca653f883d..d65384f337 100644 --- a/Physlib/QuantumMechanics/Operators/SpectralTheory/SpectralMeasure.lean +++ b/Physlib/QuantumMechanics/Operators/SpectralTheory/SpectralMeasure.lean @@ -34,6 +34,7 @@ For each `x : H` there is an associated measure `μₓ` given by `μₓ A = ‖ ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/QuantumMechanics/Operators/SpectralTheory/Symmetric.lean b/Physlib/QuantumMechanics/Operators/SpectralTheory/Symmetric.lean index 8e03c66617..2da0e3bce2 100644 --- a/Physlib/QuantumMechanics/Operators/SpectralTheory/Symmetric.lean +++ b/Physlib/QuantumMechanics/Operators/SpectralTheory/Symmetric.lean @@ -39,6 +39,7 @@ simply reinterprets the numerical range as a subset of ℝ. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/QuantumMechanics/Operators/StateObservables/ExpectedValue.lean b/Physlib/QuantumMechanics/Operators/StateObservables/ExpectedValue.lean index d960f82c8a..c6c4656c4f 100644 --- a/Physlib/QuantumMechanics/Operators/StateObservables/ExpectedValue.lean +++ b/Physlib/QuantumMechanics/Operators/StateObservables/ExpectedValue.lean @@ -24,8 +24,7 @@ defines the expectation value and the centered vector `Tψ - ⟨T⟩_ψ ψ`. ## References -- [B. C. Hall, *Quantum Theory for Mathematicians*, Chapter 12][hall2013quantum]. - +* B. C. Hall, Quantum Theory for Mathematicians, Chapter 12. [ref: hall2013quantum] -/ @[expose] public section diff --git a/Physlib/QuantumMechanics/Operators/StateObservables/Variance.lean b/Physlib/QuantumMechanics/Operators/StateObservables/Variance.lean index f593942184..de9faea890 100644 --- a/Physlib/QuantumMechanics/Operators/StateObservables/Variance.lean +++ b/Physlib/QuantumMechanics/Operators/StateObservables/Variance.lean @@ -32,8 +32,7 @@ When `T` is symmetric, `‖ψ‖ = 1`, and `Tψ ∈ T.domain`, it also equals ` ## References -- [B. C. Hall, *Quantum Theory for Mathematicians*, Chapter 12][hall2013quantum]. - +* B. C. Hall, Quantum Theory for Mathematicians, Chapter 12. [ref: hall2013quantum] -/ @[expose] public section diff --git a/Physlib/QuantumMechanics/Operators/Unbounded.lean b/Physlib/QuantumMechanics/Operators/Unbounded.lean index 058a65a2a4..82cabec42b 100644 --- a/Physlib/QuantumMechanics/Operators/Unbounded.lean +++ b/Physlib/QuantumMechanics/Operators/Unbounded.lean @@ -82,9 +82,9 @@ Results ## iv. References -- [Reed and Simon, *Methods of Modern Mathematical Physics, Vol. I: Functional Analysis*][Reed1972] -- [Konrad Schmüdgen, *Unbounded Self-Adjoint Operators on Hilbert Space*][Schmudgen2012] - +* Reed and Simon, Methods of Modern Mathematical Physics, Vol. I: Functional Analysis. + [ref: Reed1972] +* Konrad Schmüdgen, Unbounded Self-Adjoint Operators on Hilbert Space. [ref: Schmudgen2012] -/ TODO "Prove that `IsStarNormal (T : H →ₗ.[ℂ] H)` is equivalent @@ -486,7 +486,7 @@ lemma IsClosed.isClosed_toFun_graph (hU : U.IsClosed) : lemma IsClosed.continuous_of_isClosed_domain [CompleteSpace H] [CompleteSpace H'] (hU : U.IsClosed) (h : _root_.IsClosed (U.domain : Set H)) : Continuous U := by - haveI : CompleteSpace U.domain := instCompleteSpaceSubtypeMemSubmoduleOfIsClosedCoe U.domain + have : CompleteSpace U.domain := instCompleteSpaceSubtypeMemSubmoduleOfIsClosedCoe U.domain exact LinearMap.continuous_of_isClosed_graph U.toFun hU.isClosed_toFun_graph /-- Closability is preserved upon adding a continuous operator. -/ diff --git a/Physlib/QuantumMechanics/Operators/Uncertainty.lean b/Physlib/QuantumMechanics/Operators/Uncertainty.lean index dc546a1c1c..051a45f26b 100644 --- a/Physlib/QuantumMechanics/Operators/Uncertainty.lean +++ b/Physlib/QuantumMechanics/Operators/Uncertainty.lean @@ -45,10 +45,9 @@ to `Bψ` and `B` to `Aψ`. ## iv. References -- [H. P. Robertson, *The Uncertainty Principle* (1929)][robertson1929uncertainty]. -- [E. Schrodinger, *Zum Heisenbergschen Unscharfeprinzip* (1930)][schrodinger1930heisenberg]. -- [B. C. Hall, *Quantum Theory for Mathematicians*, Chapter 12][hall2013quantum]. - +* H. P. Robertson, The Uncertainty Principle (1929). [ref: robertson1929uncertainty] +* E. Schrodinger, Zum Heisenbergschen Unscharfeprinzip (1930). [ref: schrodinger1930heisenberg] +* B. C. Hall, Quantum Theory for Mathematicians, Chapter 12. [ref: hall2013quantum] -/ @[expose] public section diff --git a/Physlib/QuantumMechanics/PoschlTeller/Basic.lean b/Physlib/QuantumMechanics/PoschlTeller/Basic.lean new file mode 100644 index 0000000000..e5606e43ba --- /dev/null +++ b/Physlib/QuantumMechanics/PoschlTeller/Basic.lean @@ -0,0 +1,148 @@ +/- +Copyright (c) 2025 Afiq Hatta. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Afiq Hatta +-/ +module + +public import Physlib.QuantumMechanics.Operators.Momentum +public import Physlib.QuantumMechanics.Operators.Multiplication +public import Physlib.Mathematics.Trigonometry.Tanh +public import Physlib.Meta.TODO.Basic +/-! + +# 1d Pöschl-Teller + +## i. Overview + +The Pöschl-Teller potential, `$V(x) \propto -\mathrm{sech}^2{(\kappa x)}$`, gives rise +to a one-dimensional quantum system for which the energy eigenvalues, energy eigenstates and +scattering data can be computed exactly. Notably, the potential is _reflectionless_ when +the parameter controlling its depth is a positive integer. + +## ii. Key results + +## iii. Table of contents + +- A. Potential function +- B. Hilbert space +- C. Operators + - C.1. Kinetic energy + - C.2. Potential energy + - C.3. Hamiltonian + - C.4. Creation and annihilation operators + - C.4.1. On Schwartz functions + - C.4.2. As unbounded operators +- D. As a quantum system + +## iv. References + +* https://arxiv.org/pdf/2411.14941. [ref: arxiv_2411_14941] +-/ +@[expose] public section + +TODO "Define the Hamiltonian and related operators for the Pöschl-Teller quantum system." + +TODO "Develop the eigensystem of the Hamiltonian for the Pöschl-Teller quantum system + using properties of the creation/annihilation operators + (e.g. following https://arxiv.org/pdf/2411.14941 [ref: arxiv_2411_14941])." + +TODO "Prove that the Pöschl-Teller potential is reflectionless." + +noncomputable section + +namespace QuantumMechanics + +open Complex Constants Real SchwartzMap + +/-- A Pöschl-Teller system is specified by the particle mass `m`, the width parameter `κ`, + and family number `N` (all positive). --/ +structure PoschlTeller where + /-- mass of the particle -/ + m : ℝ + /-- width parameter of the potential -/ + κ : ℝ + /-- family number, positive integer -/ + N : ℕ + m_pos : 0 < m -- mass of the particle is positive + κ_pos : 0 < κ -- width parameter of the potential is positive + N_pos : 0 < N -- family number is positive + +namespace PoschlTeller + +variable (Q : PoschlTeller) + +/-! +## A. Potential function +-/ + +/-- The Pöschl-Teller potential is `-(ℏ^2 * κ^2 * N * (N + 1)) / (2 * m * (cosh (κ * x)) ^ 2)`. --/ +def potential (x : Space 1) : ℝ := + -(ℏ^2 * Q.κ^2 * Q.N * (Q.N + 1)) / (2 * Q.m * Real.cosh (Q.κ * x 0) ^ 2) + +/-! +## B. Hilbert space +-/ + +/-- The Hilbert space for the Pöschl-Teller system is `SpaceDHilbertSpace 1`. -/ +@[nolint unusedArguments] +abbrev HS (_ : PoschlTeller) : Type _ := SpaceDHilbertSpace 1 + +/-! +## C. Operators +-/ + +/-! +### C.1. Kinetic energy +-/ + +/-! +### C.2. Potential energy +-/ + +/-! +### C.3. Hamiltonian +-/ + +/-! +### C.4. Creation and annihilation operators +-/ + +/-! +#### C.4.1. On Schwartz functions +-/ + +/-- Pointwise multiplication of Schwartz maps by `tanh(κx)`. -/ +def tanhCLM : 𝓢(Space 1, ℂ) →L[ℂ] 𝓢(Space 1, ℂ) := + smulLeftCLM ℂ (ofReal ∘ fun x => tanh (Q.κ * x 0)) + +/-- The creation operator, `1/√(2m) (P + iℏκ tanh(κX))` -/ +def creationCLM : 𝓢(Space 1, ℂ) →L[ℂ] 𝓢(Space 1, ℂ) := + (1 / sqrt (2 * Q.m)) • momentumCLM 0 + (I * ℏ * Q.κ / sqrt (2 * Q.m)) • Q.tanhCLM + +/-- The annihilation operator, `1/√(2m) (P - iℏκ tanh(κX))` -/ +def annihilationCLM : 𝓢(Space 1, ℂ) →L[ℂ] 𝓢(Space 1, ℂ) := + (1 / sqrt (2 * Q.m)) • momentumCLM 0 + (-I * ℏ * Q.κ / sqrt (2 * Q.m)) • Q.tanhCLM + +/-! +#### C.4.2. As unbounded operators +-/ + +/-- The unbounded operator defined by pointwise multiplication by `tanh(κx)`. -/ +def tanhOperator : Q.HS →ₗ.[ℂ] Q.HS := 𝓜 _ (ofReal ∘ fun x => Real.tanh (Q.κ * x 0)) + +/-- The creation unbounded operator, `1/√(2m) (P + iℏκ tanh(κX))` -/ +def creationOperator : Q.HS →ₗ.[ℂ] Q.HS := + (1 / sqrt (2 * Q.m)) • momentumOperator 0 + (I * ℏ * Q.κ / sqrt (2 * Q.m)) • Q.tanhOperator + +/-- The annihilation unbounded operator, `1/√(2m) (P - iℏκ tanh(κX))` -/ +def annihilationOperator : Q.HS →ₗ.[ℂ] Q.HS := + (1 / sqrt (2 * Q.m)) • momentumOperator 0 + (-I * ℏ * Q.κ / sqrt (2 * Q.m)) • Q.tanhOperator + +/-! +## D. As a quantum system +-/ + +end PoschlTeller +end QuantumMechanics +end diff --git a/Physlib/QuantumMechanics/QuantumSystem/Basic.lean b/Physlib/QuantumMechanics/QuantumSystem/Basic.lean index d917f828ee..85c8a601b7 100644 --- a/Physlib/QuantumMechanics/QuantumSystem/Basic.lean +++ b/Physlib/QuantumMechanics/QuantumSystem/Basic.lean @@ -37,6 +37,7 @@ Definitions ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/QuantumMechanics/Qubit/API-map.yaml b/Physlib/QuantumMechanics/Qubit/API-map.yaml new file mode 100644 index 0000000000..1602b38269 --- /dev/null +++ b/Physlib/QuantumMechanics/Qubit/API-map.yaml @@ -0,0 +1,112 @@ +version: v0.1 + +Title: Qubits + +Overview: | + The key data structure is `Qubit`, the two element type labelling the computational + basis of a two-level quantum system. The content specific to qubits is the standard + single-qubit gates, the controlled version of a unitary with a qubit as control + register, and the Bloch sphere with its angular parameterization. Qubit states are + not built separately: a pure state of a qubit is a ket on `Qubit`, defined for an + arbitrary finite index type in `QuantumInfo/States/Pure/Braket.lean`, and a general + state is a density matrix on `Qubit`. The ambient theory of a finite dimensional + system, in particular density matrices with their evolution, measurements and + distinguishability measures, is left to a separate API map. Two modules of the + source directory, `BlochSphere.lean` and `BargmannInvariant.lean`, are not + imported by `QuantumInfo.lean` and so are not built with the library; the two + requirements that point at them record that. + +ParentAPIs: + - "Kets and bras of a finite dimensional system (QuantumInfo/States/Pure)" + - "Mixed states (QuantumInfo/States/Mixed)" + +References: + - "M. A. Nielsen and I. L. Chuang, Quantum Computation and Quantum Information, Chapters 1, 2, 4 and 9" + - "S. Pancharatnam, Generalized theory of interference, and its applications, Proc. Indian Acad. Sci. A 44, 247 (1956)" + - "M. V. Berry, Quantal phase factors accompanying adiabatic changes, Proc. R. Soc. London A 392, 45 (1984)" + +Requirements: + + - description: "The key data structure `Qubit`, the two element type labelling the computational basis of a two-level quantum system, is defined." + done: true + location: "QuantumInfo/States/Pure/Qubit.lean (Qubit)" + + - description: "Kets and bras of a finite dimensional system are defined, carrying coercions to functions and to each other, and the API contains the bra-ket pairing, the normalization condition in both its componentwise and its inner product form, the computational basis states and the uniform superposition." + done: true + location: "QuantumInfo/States/Pure/Braket.lean (Ket, Bra, FunLike (Ket d) d ℂ, FunLike (Bra d) d ℂ, Coe (Ket d) (Bra d), Coe (Bra d) (Ket d), FunLike (Bra d) (Ket d) ℂ, dot, Ket.normalized, Ket.basis, uniform_superposition, Braket.dot_self_eq_one)" + + - description: "The API contains the standard single-qubit gates `Z`, `X`, `Y`, `H`, `S` and `T`, each as an element of the unitary group on `Qubit`." + done: true + location: "QuantumInfo/States/Pure/Qubit.lean (Z, X, Y, H, S, T)" + + - description: "The API contains the squares of the standard single-qubit gates, the anticommutation relations of the three Pauli gates, the commutation of the phase gates `S` and `T` with `Z` and with each other, and the exchange of `X` and `Z` under conjugation by the Hadamard gate." + done: true + location: "QuantumInfo/States/Pure/Qubit.lean (Z_sq, X_sq, Y_sq, H_sq, S_sq, T_sq, X_Y_anticomm, Y_Z_anticomm, Z_X_anticomm, H_mul_X_eq_Z_mul_H, H_mul_Z_eq_X_mul_H, S_Z_comm, T_Z_comm, S_T_comm)" + + - description: "The API contains the controlled version of a unitary on an arbitrary register, with a qubit as the control, its entries on the block where the control is one, the controlled-NOT gate and its matrix, the composition rules for controlled gates, and the effect of conjugating the control by `X`." + done: true + location: "QuantumInfo/States/Pure/Qubit.lean (controllize, CNOT, CNOT_matrix, controllize_apply_one_one, controllize_mul, controllize_one, controllize_mul_inv, X_controllize_X)" + + - description: "The API shall contain the Bloch sphere as the unit sphere of three-dimensional Euclidean space, with its parameterization by a polar and an azimuthal angle and the dot product of two of its points in terms of those angles. Stated as `BlochSphere`, `blochPoint`, `blochPoint_val` and `dot_blochPoint` in `QuantumInfo/States/Pure/BlochSphere.lean`, a module that `QuantumInfo.lean` does not import and that is therefore not built with the library." + done: false + location: "N/A" + + - description: "The API shall contain the solid angle of a geodesic triangle on the Bloch sphere, together with the Bargmann invariant of three pure states, its phase, the invariance of that phase under cyclic permutation of the three, its negation under reversal of their order as an equation of angles, and the bound of one on the norm of the invariant. Stated as `solidAngle` in `QuantumInfo/States/Pure/BlochSphere.lean` and as `bargmannInvariantThree`, `bargmannPhaseThree`, `bargmannPhaseThree_cyclic`, `bargmannPhaseThree_reverse` and `norm_bargmannInvariantThree_le_one` in `QuantumInfo/States/Pure/BargmannInvariant.lean`, two modules that `QuantumInfo.lean` does not import and that are therefore not built with the library." + done: false + location: "N/A" + + - description: "The product of two systems carries product and entangled kets and the maximally entangled state, so that Bell-type states of a pair of qubits can be written." + done: true + location: "QuantumInfo/States/Pure/Braket.lean (Ket.prod, Ket.IsProd, Ket.IsEntangled, Ket.MES, Ket.MES_isEntangled)" + + - description: "States up to a global phase are defined, as the quotient of kets by the relation of differing by a unit complex number." + done: true + location: "QuantumInfo/States/Pure/Braket.lean (Ket.PhaseEquiv, KetUpToPhase, KetUpToPhase.mk, KetUpToPhase.lift)" + + - description: "The API shall contain the Bloch vector of a state of a qubit, the triple of expectation values of the Pauli gates, and shall show that it is a bijection from states onto the closed unit ball of three-dimensional Euclidean space." + done: false + location: N/A + + - description: "The API shall show that the Bloch vector restricts to a bijection from pure states up to a global phase onto the Bloch sphere, so that `blochPoint` presents the pure state with the given polar and azimuthal angles." + done: false + location: N/A + + - description: "The API shall contain the decomposition of a state of a qubit as one half of the identity plus a real combination of the Pauli gates, and shall show that the identity together with the three Pauli gates is a basis of the self-adjoint two by two complex matrices." + done: false + location: N/A + + - description: "The API shall contain the rotation gates about the three coordinate axes, the decomposition of an arbitrary single-qubit unitary into such rotations and a phase, and the identification of conjugation by a single-qubit unitary with a rotation of the Bloch sphere." + done: false + location: N/A + + - description: "The API shall contain the measurement of a qubit in the computational basis, with the Born rule giving the two outcome probabilities as the squared norms of the components of the state." + done: false + location: N/A + + - description: "The API shall contain the Bell basis of the states of a pair of qubits, its orthonormality, and the action of the standard gates on it." + done: false + location: N/A + + - description: "The API shall contain the singlet and triplet states of a pair of qubits, and the splitting of their state space into an antisymmetric line and a symmetric plane." + done: false + location: N/A + + - description: "The API shall contain a closed form for the fidelity of two states of a qubit in terms of their traces and determinants." + done: false + location: N/A + + - description: "The API shall contain the completeness of the positive partial transpose test for a pair of qubits, that a state is separable if and only if its partial transpose is positive semidefinite." + done: false + location: N/A + + - description: "The API shall contain registers of several qubits, with the state space of a register given by an iterated product, and the extension of a single-qubit gate to a gate acting on one component of a register." + done: false + location: N/A + + - description: "The API shall show that the Hadamard, `T` and controlled-NOT gates generate a dense subgroup of the special unitary group of a register, so that they are universal for quantum computation." + done: false + location: N/A + + - description: "The API shall relate `Qubit` to the finite dimensional Hilbert space of a two element target in Physlib, identifying kets on `Qubit` with the unit vectors of that Hilbert space." + done: false + location: N/A diff --git a/Physlib/QuantumMechanics/RectangularBarrier/Basic.lean b/Physlib/QuantumMechanics/RectangularBarrier/Basic.lean index f4a0c75f04..50f9b85838 100644 --- a/Physlib/QuantumMechanics/RectangularBarrier/Basic.lean +++ b/Physlib/QuantumMechanics/RectangularBarrier/Basic.lean @@ -34,6 +34,7 @@ on a closed interval and zero elsewhere. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/QuantumMechanics/ReflectionlessPotential/Basic.lean b/Physlib/QuantumMechanics/ReflectionlessPotential/Basic.lean deleted file mode 100644 index afd36aa5d5..0000000000 --- a/Physlib/QuantumMechanics/ReflectionlessPotential/Basic.lean +++ /dev/null @@ -1,133 +0,0 @@ -/- -Copyright (c) 2025 Afiq Hatta. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Afiq Hatta --/ -module - -public import Physlib.QuantumMechanics.Operators.OneDimension.Momentum -public import Physlib.Mathematics.Trigonometry.Tanh -public import Physlib.Meta.TODO.Basic -/-! - -# 1d Reflectionless Potential - -The quantum reflectionless potential in 1d. -This file contains -- the definition of the reflectionless potential as defined https://arxiv.org/pdf/2411.14941 -- properties of reflectionless potentials - -## TODO -- Define creation and annihilation operators for reflectionless potentials -- Write the proof of the general solution of the reflectionless potential using the creation and -annihilation operators -- Show reflectionless properties --/ - -TODO "Refactor to use `SpaceDHilbertSpace 1`." - -TODO "Refactor to use `QuantumMechanics.PlanckConstant`." - -@[expose] public section - -namespace QuantumMechanics -open Real -open SchwartzMap -open HilbertSpace -open NNReal -open Field - -namespace OneDimension - -/-- A reflectionless potential is specified by three - real parameters: the mass of the particle `m`, a value of Planck's constant `ℏ`, the - parameter `κ`, as well as a positive integer family number `N`. - All of these parameters are assumed to be positive. --/ -structure ReflectionlessPotential where - /-- mass of the particle -/ - m : ℝ - /-- parameter of the reflectionless potential -/ - κ : ℝ - /-- Planck's constant -/ - ℏ : ℝ - /-- family number, positive integer -/ - N : ℕ - m_pos : 0 < m -- mass of the particle is positive - κ_pos : 0 < κ -- parameter of the reflectionless potential is positive - N_pos : 0 < N -- family number is positive - ℏ_pos : 0 < ℏ -- Planck's constant is positive - -namespace ReflectionlessPotential - -variable (Q : ReflectionlessPotential) - -/-! -## Theorems -TODO: Add theorems about reflectionless potential - the main result is the actual 1d solution --/ - -/-- Define the reflectionless potential as - V(x) = - (ℏ^2 * κ^2 * N * (N + 1)) / (2 * m * (cosh (κ * x)) ^ 2) --/ -noncomputable def reflectionlessPotential (x : ℝ) : ℝ := - - (Q.ℏ^2 * Q.κ^2 * Q.N * (Q.N + 1)) / ((2 : ℝ) * Q.m * (Real.cosh (Q.κ * x)) ^ 2) - -/-- Define tanh(κ X) operator -/ -noncomputable def tanhOperator (ψ : ℝ → ℂ) : ℝ → ℂ := - fun x => Real.tanh (Q.κ * x) * ψ x - -/-- Pointwise multiplication by a function of temperate growth -/ -noncomputable def mulByTemperateGrowth {g : ℝ → ℂ} (hg : g.HasTemperateGrowth) : - 𝓢(ℝ, ℂ) →L[ℂ] 𝓢(ℝ, ℂ) := - bilinLeftCLM (ContinuousLinearMap.mul ℂ ℂ) hg - --- First, you need a theorem that the scaled tanh has temperate growth -lemma scaled_tanh_hasTemperateGrowth (κ : ℝ) : - Function.HasTemperateGrowth (fun x => (Real.tanh (κ * x))) := - tanh_const_mul_hasTemperateGrowth κ - -/-- This is a helper lemma to show that the embedding of a real function with temperate growth in ℂ - also has temperate growth -/ -private lemma complex_embedding_of_temperate_growth (f : ℝ → ℝ) - (h : Function.HasTemperateGrowth f) : Function.HasTemperateGrowth (fun x => (f x : ℂ)) := - Function.Complex.hasTemperateGrowth_ofReal.comp h - --- Scaled tanh embedded into the complex numbers has temperate growth -lemma scaled_tanh_complex_hasTemperateGrowth (κ : ℝ) : - Function.HasTemperateGrowth (fun x => (Real.tanh (κ * x) : ℂ)) := - complex_embedding_of_temperate_growth _ (scaled_tanh_hasTemperateGrowth κ) - -/-- Define tanh(κ X) multiplication pointwise as a Schwartz map -/ -noncomputable def tanhOperatorSchwartz (Q : ReflectionlessPotential) : - 𝓢(ℝ, ℂ) →L[ℂ] 𝓢(ℝ, ℂ) := - -- We need to handle the Real → Complex coercion - let scaled_tanh_complex : ℝ → ℂ := fun x => (Real.tanh (Q.κ * x) : ℂ) - have h2 : Function.HasTemperateGrowth scaled_tanh_complex := - scaled_tanh_complex_hasTemperateGrowth Q.κ - bilinLeftCLM (ContinuousLinearMap.mul ℂ ℂ) h2 - -/-- Creation operator: a† as defined in https://arxiv.org/pdf/2411.14941 - a† = 1/√(2m) (P + iℏκ tanh(κX)) -/ -noncomputable def creationOperator (ψ : ℝ → ℂ) : ℝ → ℂ := - let factor : ℝ := 1 / Real.sqrt (2 * Q.m) - fun x => factor * (momentumOperator ψ x + Complex.I * Q.ℏ * Q.κ * Q.tanhOperator ψ x) - -/-- Annihilation operator: a as defined in https://arxiv.org/pdf/2411.14941 - a = 1/√(2m) (P - iℏκ tanh(κX)) -/ -noncomputable def annihilationOperator (ψ : ℝ → ℂ) : ℝ → ℂ := - let factor : ℝ := 1 / Real.sqrt (2 * Q.m) - fun x => factor * (momentumOperator ψ x - Complex.I * Q.ℏ * Q.κ * Q.tanhOperator ψ x) - -/-- creation operator defined as a Schwartz map -/ -noncomputable def creationOperatorSchwartz (Q : ReflectionlessPotential) : 𝓢(ℝ, ℂ) →L[ℂ] 𝓢(ℝ, ℂ) := -(1 / Real.sqrt (2 * Q.m)) • momentumOperatorSchwartz + - ((Complex.I * Q.ℏ * Q.κ) / Real.sqrt (2 * Q.m)) • Q.tanhOperatorSchwartz - -/-- annihilation operator defined as a Schwartz map -/ -noncomputable def annihilationOperatorSchwartz (Q : ReflectionlessPotential) : - 𝓢(ℝ, ℂ) →L[ℂ] 𝓢(ℝ, ℂ) := -(1 / Real.sqrt (2 * Q.m)) • momentumOperatorSchwartz + - ((-Complex.I * Q.ℏ * Q.κ) / Real.sqrt (2 * Q.m)) • Q.tanhOperatorSchwartz - -end ReflectionlessPotential -end OneDimension -end QuantumMechanics diff --git a/Physlib/QuantumMechanics/SpaceDQuantumSystem.lean b/Physlib/QuantumMechanics/SpaceDQuantumSystem.lean index 551efb4263..2bbbd0062a 100644 --- a/Physlib/QuantumMechanics/SpaceDQuantumSystem.lean +++ b/Physlib/QuantumMechanics/SpaceDQuantumSystem.lean @@ -30,6 +30,7 @@ namely the number of spatial dimensions, the particle's mass and the potential f ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/Relativity/Fermions/Dirac/Basic.lean b/Physlib/Relativity/Fermions/Dirac/Basic.lean index ee38828fa1..65dfb7c819 100644 --- a/Physlib/Relativity/Fermions/Dirac/Basic.lean +++ b/Physlib/Relativity/Fermions/Dirac/Basic.lean @@ -19,8 +19,7 @@ That is a LeftHandedWeyl and a DualRightHandedWeyl. ## References -- arXiv:0812.1594 page 197. - +* arXiv:0812.1594 page 197. [ref: Dreiner:2008tw] -/ @[expose] public section diff --git a/Physlib/Relativity/Fermions/Weyl/DualLeftHanded.lean b/Physlib/Relativity/Fermions/Weyl/DualLeftHanded.lean index 6884f71db6..0e7c57656a 100644 --- a/Physlib/Relativity/Fermions/Weyl/DualLeftHanded.lean +++ b/Physlib/Relativity/Fermions/Weyl/DualLeftHanded.lean @@ -21,10 +21,8 @@ and we consider them to have down indices `ψ_α` with `α = 1,2`. ### References -A good reference for the material in this file is: -https://particle.physics.ucdavis.edu/modernsusy/slides/slideimages/spinorfeynrules.pdf -Although a different index convention is used there. - +* A good reference for the material in this file, although it uses a different + index convention: https://particle.physics.ucdavis.edu/modernsusy/slides/slideimages/spinorfeynrules.pdf. [ref: ucdavis_spinorfeynrules] -/ @[expose] public section diff --git a/Physlib/Relativity/Fermions/Weyl/Metric.lean b/Physlib/Relativity/Fermions/Weyl/Metric.lean index 6e6ae5df8e..9d7d075f0d 100644 --- a/Physlib/Relativity/Fermions/Weyl/Metric.lean +++ b/Physlib/Relativity/Fermions/Weyl/Metric.lean @@ -73,7 +73,6 @@ lemma metricRaw_comm_star (M : SL(2,ℂ)) : metricRaw * M.1.map star = ((M.1)⁻ def leftMetricVal : LeftHandedWeyl ⊗[ℂ] LeftHandedWeyl := leftLeftToMatrix.symm (- metricRaw) -set_option backward.isDefEq.respectTransparency false in /-- Expansion of `leftMetricVal` into the left basis. -/ lemma leftMetricVal_expand_tmul : leftMetricVal = - LeftHandedWeyl.basis 0 ⊗ₜ[ℂ] LeftHandedWeyl.basis 1 + @@ -122,7 +121,6 @@ lemma leftMetric_apply_one : leftMetric (1 : ℂ) = leftMetricVal := by def dualLeftMetricVal : (DualLeftHandedWeyl ⊗[ℂ] DualLeftHandedWeyl) := dualLeftdualLeftToMatrix.symm metricRaw -set_option backward.isDefEq.respectTransparency false in /-- Expansion of `dualLeftMetricVal` into the left basis. -/ lemma dualLeftMetricVal_expand_tmul : dualLeftMetricVal = DualLeftHandedWeyl.basis 0 ⊗ₜ[ℂ] DualLeftHandedWeyl.basis 1 - @@ -167,7 +165,6 @@ lemma dualLeftMetric_apply_one : dualLeftMetric (1 : ℂ) = dualLeftMetricVal := def rightMetricVal : (RightHandedWeyl ⊗[ℂ] RightHandedWeyl) := rightRightToMatrix.symm (- metricRaw) -set_option backward.isDefEq.respectTransparency false in /-- Expansion of `rightMetricVal` into the left basis. -/ lemma rightMetricVal_expand_tmul : rightMetricVal = - RightHandedWeyl.basis 0 ⊗ₜ[ℂ] RightHandedWeyl.basis 1 + @@ -225,7 +222,6 @@ lemma rightMetric_apply_one : rightMetric (1 : ℂ) = rightMetricVal := by def dualRightMetricVal : DualRightHandedWeyl ⊗[ℂ] DualRightHandedWeyl := dualRightDualRightToMatrix.symm (metricRaw) -set_option backward.isDefEq.respectTransparency false in /-- Expansion of `rightMetricVal` into the left basis. -/ lemma dualRightMetricVal_expand_tmul : dualRightMetricVal = DualRightHandedWeyl.basis 0 ⊗ₜ[ℂ] DualRightHandedWeyl.basis 1 - @@ -282,7 +278,6 @@ lemma dualRightMetric_apply_one : dualRightMetric (1 : ℂ) = dualRightMetricVal -/ -set_option backward.isDefEq.respectTransparency false in lemma leftDualContraction_apply_metric : (TensorProduct.comm ℂ _ _ <| (TensorProduct.lid ℂ _).lTensor _ <| @@ -320,7 +315,6 @@ lemma dualLeftContraction_apply_metric : zero_ne_one, zero_smul, sub_zero, one_ne_zero, zero_sub, sub_neg_eq_add] rw [leftDualLeftUnit_apply_one, leftDualLeftUnitVal_expand_tmul] -set_option backward.isDefEq.respectTransparency false in lemma rightDualContraction_apply_metric : (TensorProduct.comm ℂ _ _ <| (TensorProduct.lid ℂ _).lTensor _ <| diff --git a/Physlib/Relativity/Fermions/Weyl/Two.lean b/Physlib/Relativity/Fermions/Weyl/Two.lean index ca8e4636dd..5dd1e72417 100644 --- a/Physlib/Relativity/Fermions/Weyl/Two.lean +++ b/Physlib/Relativity/Fermions/Weyl/Two.lean @@ -38,6 +38,7 @@ def leftLeftToMatrix : (LeftHandedWeyl ⊗[ℂ] LeftHandedWeyl) ≃ₗ[ℂ] Matr Finsupp.linearEquivFunOnFinite ℂ ℂ (Fin 2 × Fin 2) ≪≫ₗ LinearEquiv.curry ℂ ℂ (Fin 2) (Fin 2) +set_option backward.isDefEq.respectTransparency false in /-- Expanding `leftLeftToMatrix` in terms of the standard basis. -/ lemma leftLeftToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : leftLeftToMatrix.symm M = ∑ i, ∑ j, M i j • @@ -57,6 +58,7 @@ def dualLeftdualLeftToMatrix : (DualLeftHandedWeyl ⊗[ℂ] DualLeftHandedWeyl) Finsupp.linearEquivFunOnFinite ℂ ℂ (Fin 2 × Fin 2) ≪≫ₗ LinearEquiv.curry ℂ ℂ (Fin 2) (Fin 2) +set_option backward.isDefEq.respectTransparency false in /-- Expanding `dualLeftdualLeftToMatrix` in terms of the standard basis. -/ lemma dualLeftdualLeftToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : dualLeftdualLeftToMatrix.symm M = ∑ i, ∑ j, M i j • @@ -77,6 +79,7 @@ def leftDualLeftToMatrix : (LeftHandedWeyl ⊗[ℂ] DualLeftHandedWeyl) ≃ₗ[ Finsupp.linearEquivFunOnFinite ℂ ℂ (Fin 2 × Fin 2) ≪≫ₗ LinearEquiv.curry ℂ ℂ (Fin 2) (Fin 2) +set_option backward.isDefEq.respectTransparency false in /-- Expanding `leftDualLeftToMatrix` in terms of the standard basis. -/ lemma leftDualLeftToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : leftDualLeftToMatrix.symm M = ∑ i, ∑ j, M i j • @@ -96,6 +99,7 @@ def dualLeftLeftToMatrix : (DualLeftHandedWeyl ⊗[ℂ] LeftHandedWeyl) ≃ₗ[ Finsupp.linearEquivFunOnFinite ℂ ℂ (Fin 2 × Fin 2) ≪≫ₗ LinearEquiv.curry ℂ ℂ (Fin 2) (Fin 2) +set_option backward.isDefEq.respectTransparency false in /-- Expanding `dualLeftLeftToMatrix` in terms of the standard basis. -/ lemma dualLeftLeftToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : dualLeftLeftToMatrix.symm M = ∑ i, ∑ j, M i j • @@ -115,6 +119,7 @@ def rightRightToMatrix : (RightHandedWeyl ⊗[ℂ] RightHandedWeyl) ≃ₗ[ℂ] Finsupp.linearEquivFunOnFinite ℂ ℂ (Fin 2 × Fin 2) ≪≫ₗ LinearEquiv.curry ℂ ℂ (Fin 2) (Fin 2) +set_option backward.isDefEq.respectTransparency false in /-- Expanding `rightRightToMatrix` in terms of the standard basis. -/ lemma rightRightToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : rightRightToMatrix.symm M = ∑ i, ∑ j, M i j • @@ -134,6 +139,7 @@ def dualRightDualRightToMatrix : (DualRightHandedWeyl ⊗[ℂ] DualRightHandedWe Finsupp.linearEquivFunOnFinite ℂ ℂ (Fin 2 × Fin 2) ≪≫ₗ LinearEquiv.curry ℂ ℂ (Fin 2) (Fin 2) +set_option backward.isDefEq.respectTransparency false in /-- Expanding `dualRightDualRightToMatrix` in terms of the standard basis. -/ lemma dualRightDualRightToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : dualRightDualRightToMatrix.symm M = @@ -154,6 +160,7 @@ def rightDualRightToMatrix : (RightHandedWeyl ⊗[ℂ] DualRightHandedWeyl) ≃ Finsupp.linearEquivFunOnFinite ℂ ℂ (Fin 2 × Fin 2) ≪≫ₗ LinearEquiv.curry ℂ ℂ (Fin 2) (Fin 2) +set_option backward.isDefEq.respectTransparency false in /-- Expanding `rightDualRightToMatrix` in terms of the standard basis. -/ lemma rightDualRightToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : rightDualRightToMatrix.symm M = ∑ i, ∑ j, M i j • @@ -173,6 +180,7 @@ def dualRightRightToMatrix : (DualRightHandedWeyl ⊗[ℂ] RightHandedWeyl) ≃ Finsupp.linearEquivFunOnFinite ℂ ℂ (Fin 2 × Fin 2) ≪≫ₗ LinearEquiv.curry ℂ ℂ (Fin 2) (Fin 2) +set_option backward.isDefEq.respectTransparency false in /-- Expanding `dualRightRightToMatrix` in terms of the standard basis. -/ lemma dualRightRightToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : dualRightRightToMatrix.symm M = ∑ i, ∑ j, M i j • @@ -192,6 +200,7 @@ def dualLeftDualRightToMatrix : (DualLeftHandedWeyl ⊗[ℂ] DualRightHandedWeyl Finsupp.linearEquivFunOnFinite ℂ ℂ (Fin 2 × Fin 2) ≪≫ₗ LinearEquiv.curry ℂ ℂ (Fin 2) (Fin 2) +set_option backward.isDefEq.respectTransparency false in /-- Expanding `dualLeftDualRightToMatrix` in terms of the standard basis. -/ lemma dualLeftDualRightToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : dualLeftDualRightToMatrix.symm M = ∑ i, ∑ j, M i j • @@ -211,6 +220,7 @@ def leftRightToMatrix : (LeftHandedWeyl ⊗[ℂ] RightHandedWeyl) ≃ₗ[ℂ] Ma Finsupp.linearEquivFunOnFinite ℂ ℂ (Fin 2 × Fin 2) ≪≫ₗ LinearEquiv.curry ℂ ℂ (Fin 2) (Fin 2) +set_option backward.isDefEq.respectTransparency false in /-- Expanding `leftRightToMatrix` in terms of the standard basis. -/ lemma leftRightToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : leftRightToMatrix.symm M = ∑ i, ∑ j, M i j • diff --git a/Physlib/Relativity/LorentzAlgebra/Basis.lean b/Physlib/Relativity/LorentzAlgebra/Basis.lean index d40c2a6674..9f8322e8a5 100644 --- a/Physlib/Relativity/LorentzAlgebra/Basis.lean +++ b/Physlib/Relativity/LorentzAlgebra/Basis.lean @@ -33,9 +33,8 @@ block, while rotation generators are antisymmetric matrices acting only on spati ## References -- Weinberg, *The Quantum Theory of Fields*, Vol 1, Section 2.7 -- Peskin & Schroeder, *An Introduction to QFT*, Appendix A - +* Weinberg, The Quantum Theory of Fields, Vol 1, Section 2.7. [ref: weinberg_qft1] +* Peskin & Schroeder, An Introduction to QFT, Appendix A. [ref: peskin_schroeder_qft] ## Future Work TODO can be completed by proving linear independence and spanning of these diff --git a/Physlib/Relativity/LorentzGroup/Basic.lean b/Physlib/Relativity/LorentzGroup/Basic.lean index 7ae8ca1059..7c11825e13 100644 --- a/Physlib/Relativity/LorentzGroup/Basic.lean +++ b/Physlib/Relativity/LorentzGroup/Basic.lean @@ -18,9 +18,9 @@ We define the Lorentz group. ## References -- *Lorentz Transformations, Rotations, and Boosts*, Jaffe. - - +* Lorentz Transformations, Rotations, and Boosts, Jaffe. + . + [ref: jaffe_lorentz_notes] -/ @[expose] public section diff --git a/Physlib/Relativity/LorentzGroup/Boosts/Axis.lean b/Physlib/Relativity/LorentzGroup/Boosts/Axis.lean new file mode 100644 index 0000000000..d626b69534 --- /dev/null +++ b/Physlib/Relativity/LorentzGroup/Boosts/Axis.lean @@ -0,0 +1,215 @@ +/- +Copyright (c) 2026 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jinzheng Li, Nathaneal Sajan, Joseph Tooby-Smith +-/ +module + +public import Physlib.Relativity.SL2C.AxisRotations +/-! +# Coordinate-axis boosts in `SL(2,ℂ)` and the Lorentz group + +## i. Overview + +We define the axis-indexed lift `Lorentz.SL2C.boostAxis` in `SL(2,ℂ)` and its image +`LorentzGroup.boostAxis` in the Lorentz group. + +The parameter `t ≠ 0` is multiplicative; replacing `t` by `t⁻¹` reverses the boost. For +`t > 0`, its rapidity is `2 * log t`; negative values retain the action of the central +element `-1 : SL(2,ℂ)`. + +For the `z`-axis, `LorentzGroup.boostAxis 2 t ht` agrees with the velocity-parameterized boost +`LorentzGroup.boost 2 β` at `β = (t² - t⁻²) / (t² + t⁻²)`. + +The lift is Hermitian along every axis, and the `x`- and `y`-axis lifts are conjugates of +the diagonal `z`-axis lift. + +The index `Sum.inl 0` is the time coordinate, while `Sum.inr 0`, `Sum.inr 1`, and +`Sum.inr 2` are the `x`, `y`, and `z` coordinates. Accordingly, axis indices `0`, `1`, and +`2` select the `x`-, `y`-, and `z`-axis boosts. The covering map uses the action +`X ↦ M X Mᴴ` on self-adjoint matrices. + +## ii. Key results + +- `Lorentz.SL2C.boostAxis` defines the axis-boost lifts. +- `Lorentz.SL2C.boostAxis_inv` and `Lorentz.SL2C.boostAxis_conjTranspose` give their + inverses and Hermiticity. +- `LorentzGroup.boostAxis` defines the induced Lorentz transformations, with entries given by + `LorentzGroup.boostAxis_apply`. +- `Lorentz.SL2C.exists_conj_boostAxis` proves that every lift is conjugate to the `z`-boost. + +## iii. Table of contents + +- A. The axis-boost lift +- B. Axis conjugation +- C. The induced Lorentz transformation + +-/ + +@[expose] public section + +open scoped minkowskiMatrix PauliMatrix +open Matrix MatrixGroups + +namespace Lorentz.SL2C + +/-! + +## A. The axis-boost lift + +-/ + +/-- The `SL(2,ℂ)` lift of the boost along spatial axis `i`, with `0 = x`, `1 = y`, and +`2 = z`. The parameter `t` is multiplicative, and for `t > 0` the rapidity is `2 * log t`. -/ +noncomputable def boostAxis : Fin 3 → (t : ℝ) → t ≠ 0 → SL(2,ℂ) + | 0, t, ht => + ⟨!![((t : ℂ) + (t : ℂ)⁻¹) / 2, ((t : ℂ) - (t : ℂ)⁻¹) / 2; + ((t : ℂ) - (t : ℂ)⁻¹) / 2, ((t : ℂ) + (t : ℂ)⁻¹) / 2], by + have htc : (t : ℂ) ≠ 0 := Complex.ofReal_ne_zero.mpr ht + rw [Matrix.det_fin_two_of] + field_simp + ring⟩ + | 1, t, ht => + ⟨!![((t : ℂ) + (t : ℂ)⁻¹) / 2, -Complex.I * ((t : ℂ) - (t : ℂ)⁻¹) / 2; + Complex.I * ((t : ℂ) - (t : ℂ)⁻¹) / 2, ((t : ℂ) + (t : ℂ)⁻¹) / 2], by + have htc : (t : ℂ) ≠ 0 := Complex.ofReal_ne_zero.mpr ht + have h2 : -Complex.I * ((t : ℂ) - (t : ℂ)⁻¹) / 2 * + (Complex.I * ((t : ℂ) - (t : ℂ)⁻¹) / 2) = + ((t : ℂ) - (t : ℂ)⁻¹) / 2 * (((t : ℂ) - (t : ℂ)⁻¹) / 2) := by + have hI : -Complex.I * Complex.I = 1 := by + rw [neg_mul, Complex.I_mul_I, neg_neg] + calc -Complex.I * ((t : ℂ) - (t : ℂ)⁻¹) / 2 * + (Complex.I * ((t : ℂ) - (t : ℂ)⁻¹) / 2) + = (-Complex.I * Complex.I) * + (((t : ℂ) - (t : ℂ)⁻¹) / 2 * (((t : ℂ) - (t : ℂ)⁻¹) / 2)) := by + ring + _ = ((t : ℂ) - (t : ℂ)⁻¹) / 2 * (((t : ℂ) - (t : ℂ)⁻¹) / 2) := by + rw [hI, one_mul] + rw [Matrix.det_fin_two_of, h2] + field_simp + ring⟩ + | 2, t, ht => + ⟨!![(t : ℂ), 0; 0, (t : ℂ)⁻¹], by + have htc : (t : ℂ) ≠ 0 := Complex.ofReal_ne_zero.mpr ht + rw [Matrix.det_fin_two_of] + simp [mul_inv_cancel₀ htc]⟩ + +/-- The matrix entries of the `SL(2,ℂ)` boost lift along the `x`-axis. -/ +@[simp] lemma boostAxis_zero_apply (t : ℝ) (ht : t ≠ 0) (j k : Fin 2) : + (boostAxis 0 t ht).1 j k = + (!![((t : ℂ) + (t : ℂ)⁻¹) / 2, ((t : ℂ) - (t : ℂ)⁻¹) / 2; + ((t : ℂ) - (t : ℂ)⁻¹) / 2, ((t : ℂ) + (t : ℂ)⁻¹) / 2]) j k := rfl + +/-- The matrix entries of the `SL(2,ℂ)` boost lift along the `y`-axis. -/ +@[simp] lemma boostAxis_one_apply (t : ℝ) (ht : t ≠ 0) (j k : Fin 2) : + (boostAxis 1 t ht).1 j k = + (!![((t : ℂ) + (t : ℂ)⁻¹) / 2, + -Complex.I * ((t : ℂ) - (t : ℂ)⁻¹) / 2; + Complex.I * ((t : ℂ) - (t : ℂ)⁻¹) / 2, + ((t : ℂ) + (t : ℂ)⁻¹) / 2]) j k := rfl + +/-- The matrix entries of the diagonal `SL(2,ℂ)` boost lift along the `z`-axis. -/ +@[simp] lemma boostAxis_two_apply (t : ℝ) (ht : t ≠ 0) (j k : Fin 2) : + (boostAxis 2 t ht).1 j k = (!![(t : ℂ), 0; 0, (t : ℂ)⁻¹]) j k := rfl + +/-- Inverting an axis boost replaces its multiplicative parameter `t` by `t⁻¹`. -/ +lemma boostAxis_inv (i : Fin 3) (t : ℝ) (ht : t ≠ 0) : + (boostAxis i t ht)⁻¹ = boostAxis i t⁻¹ (inv_ne_zero ht) := by + fin_cases i + · ext j k + rw [Matrix.SpecialLinearGroup.SL2_inv_expl] + fin_cases j <;> fin_cases k <;> + simp [boostAxis, Complex.ofReal_inv, inv_inv] <;> + ring + · ext j k + rw [Matrix.SpecialLinearGroup.SL2_inv_expl] + fin_cases j <;> fin_cases k <;> + simp [boostAxis, Complex.ofReal_inv, inv_inv] <;> + ring + · ext j k + rw [Matrix.SpecialLinearGroup.SL2_inv_expl] + fin_cases j <;> fin_cases k <;> + simp [boostAxis, Complex.ofReal_inv, inv_inv] + +/-- The matrix underlying an axis-boost lift is Hermitian. -/ +lemma boostAxis_conjTranspose (i : Fin 3) (t : ℝ) (ht : t ≠ 0) : + (boostAxis i t ht).1ᴴ = (boostAxis i t ht).1 := by + fin_cases i <;> ext j k <;> fin_cases j <;> fin_cases k <;> simp [boostAxis] + +/-! + +## B. Axis conjugation + +-/ + +/-- Every axis boost is obtained by conjugating the `z`-axis boost by `rotationZToAxis`. -/ +lemma boostAxis_eq_conj (i : Fin 3) (t : ℝ) (ht : t ≠ 0) : + boostAxis i t ht = + rotationZToAxis i * boostAxis 2 t ht * (rotationZToAxis i)⁻¹ := by + fin_cases i + · refine Subtype.ext ?_ + change !![((t : ℂ) + (t : ℂ)⁻¹) / 2, ((t : ℂ) - (t : ℂ)⁻¹) / 2; + ((t : ℂ) - (t : ℂ)⁻¹) / 2, ((t : ℂ) + (t : ℂ)⁻¹) / 2] = + (rotationZToAxis 0).1 * !![(t : ℂ), 0; 0, (t : ℂ)⁻¹] * + ((rotationZToAxis 0)⁻¹).1 + rw [rotationZToAxis_zero_mul_diagonal_mul_inv] + · refine Subtype.ext ?_ + change !![((t : ℂ) + (t : ℂ)⁻¹) / 2, + -Complex.I * ((t : ℂ) - (t : ℂ)⁻¹) / 2; + Complex.I * ((t : ℂ) - (t : ℂ)⁻¹) / 2, + ((t : ℂ) + (t : ℂ)⁻¹) / 2] = + (rotationZToAxis 1).1 * !![(t : ℂ), 0; 0, (t : ℂ)⁻¹] * + ((rotationZToAxis 1)⁻¹).1 + rw [rotationZToAxis_one_mul_diagonal_mul_inv] + · refine Subtype.ext ?_ + change !![(t : ℂ), 0; 0, (t : ℂ)⁻¹] = + (rotationZToAxis 2).1 * !![(t : ℂ), 0; 0, (t : ℂ)⁻¹] * + ((rotationZToAxis 2)⁻¹).1 + rw [rotationZToAxis_two_mul_diagonal_mul_inv] + +/-- Every coordinate-axis boost is conjugate to the `z`-axis boost. -/ +lemma exists_conj_boostAxis (i : Fin 3) : + ∃ R : SL(2,ℂ), ∀ (t : ℝ) (ht : t ≠ 0), + boostAxis i t ht = R * boostAxis 2 t ht * R⁻¹ := by + exact ⟨rotationZToAxis i, fun t ht => boostAxis_eq_conj i t ht⟩ + +end Lorentz.SL2C + +namespace LorentzGroup + +/-! + +## C. The induced Lorentz transformation + +-/ + +/-- The Lorentz transformation induced by the multiplicatively parameterized `SL(2,ℂ)` boost +along spatial axis `i`. -/ +noncomputable def boostAxis (i : Fin 3) (t : ℝ) (ht : t ≠ 0) : LorentzGroup 3 := + Lorentz.SL2C.toLorentzGroup (Lorentz.SL2C.boostAxis i t ht) + +/-- The entries of an axis boost in the Lorentz group. -/ +lemma boostAxis_apply (i : Fin 3) (t : ℝ) (ht : t ≠ 0) (a b : Fin 1 ⊕ Fin 3) : + (boostAxis i t ht).1 a b = + if a = Sum.inl 0 ∧ b = Sum.inl 0 then (t ^ 2 + (t⁻¹) ^ 2) / 2 + else if a = Sum.inl 0 ∧ b = Sum.inr i then -((t ^ 2 - (t⁻¹) ^ 2) / 2) + else if a = Sum.inr i ∧ b = Sum.inl 0 then -((t ^ 2 - (t⁻¹) ^ 2) / 2) + else if a = Sum.inr i ∧ b = Sum.inr i then (t ^ 2 + (t⁻¹) ^ 2) / 2 + else if a = b then 1 else 0 := by + have htc : (t : ℂ) ≠ 0 := Complex.ofReal_ne_zero.mpr ht + refine Complex.ofReal_injective ?_ + rw [boostAxis, Lorentz.SL2C.toLorentzGroup_eq_trace, + PauliMatrix.trace_pauliSelfAdjoint'_mul_apply, Lorentz.SL2C.boostAxis_conjTranspose] + fin_cases i + all_goals + rcases a with a | a <;> rcases b with b | b <;> fin_cases a <;> fin_cases b <;> + simp [Lorentz.SL2C.boostAxis, PauliMatrix.pauliSelfAdjoint', PauliMatrix.pauliMatrix, + Matrix.mul_apply, Fin.sum_univ_two] <;> + field_simp <;> + ring_nf + all_goals simp only [Complex.I_sq, Complex.I_pow_four] + all_goals ring + +end LorentzGroup + +end diff --git a/Physlib/Relativity/LorentzGroup/Boosts/Basic.lean b/Physlib/Relativity/LorentzGroup/Boosts/Basic.lean index a45850ad4f..297c143427 100644 --- a/Physlib/Relativity/LorentzGroup/Boosts/Basic.lean +++ b/Physlib/Relativity/LorentzGroup/Boosts/Basic.lean @@ -47,6 +47,7 @@ lemma γ_det_not_zero (β : ℝ) (hβ : |β| < 1) : (1 - β^2) ≠ 0 := by simp at h1 aesop +set_option backward.isDefEq.respectTransparency false in /-- The Lorentz boost with in the space direction `i` with speed `β` with `|β| < 1`. -/ def boost (i : Fin d) (β : ℝ) (hβ : |β| < 1) : LorentzGroup d := @@ -143,6 +144,7 @@ where · simp [hb'] · simp +set_option backward.isDefEq.respectTransparency false in @[simp] lemma boost_transpose_eq_self (i : Fin d) {β : ℝ} (hβ : |β| < 1) : transpose (boost i β hβ) = boost i β hβ := by diff --git a/Physlib/Relativity/LorentzGroup/Boosts/Generalized.lean b/Physlib/Relativity/LorentzGroup/Boosts/Generalized.lean index 55c9e94572..fe129e9860 100644 --- a/Physlib/Relativity/LorentzGroup/Boosts/Generalized.lean +++ b/Physlib/Relativity/LorentzGroup/Boosts/Generalized.lean @@ -21,9 +21,8 @@ A boost is the special case of a generalised boost when `u = basis 0`. ## References -- The main argument follows: Guillem Cobos, The Lorentz Group, 2015: - https://diposit.ub.edu/dspace/bitstream/2445/68763/2/memoria.pdf - +* The main argument follows: Guillem Cobos, The Lorentz Group, 2015: + https://diposit.ub.edu/dspace/bitstream/2445/68763/2/memoria.pdf. [ref: cobos_2015_lorentz_group] -/ @[expose] public section @@ -216,6 +215,7 @@ def generalizedBoost (u v : Velocity d) : LorentzGroup d := genBoostAux₁_add_genBoostAux₂_minkowskiProduct] ring⟩ +set_option backward.isDefEq.respectTransparency false in lemma generalizedBoost_apply (u v : Velocity d) (x : Vector d) : generalizedBoost u v • x = x + genBoostAux₁ u v x + genBoostAux₂ u v x:= by rw [smul_eq_mulVec] @@ -383,11 +383,7 @@ lemma generalizedBoost_inv (u v : Velocity d) : minkowskiProduct_symm v.1 u.1] match_scalars <;> field_simp <;> ring -/-- The time component of a generalised boost. - -A proof of this result can be found at the below link: -https://leanprover.zulipchat.com/#narrow/channel/479953-Physlib/topic/Lorentz.20group/near/523249684 --/ +/-- The time component of a generalised boost. -/ lemma generalizedBoost_timeComponent_eq (u v : Velocity d) : (generalizedBoost u v).1 (Sum.inl 0) (Sum.inl 0) = 1 + ‖u.1.timeComponent • v.1.spatialPart - diff --git a/Physlib/Relativity/LorentzGroup/Orthochronous/Basic.lean b/Physlib/Relativity/LorentzGroup/Orthochronous/Basic.lean index 1a9a3add90..b3a185cf40 100644 --- a/Physlib/Relativity/LorentzGroup/Orthochronous/Basic.lean +++ b/Physlib/Relativity/LorentzGroup/Orthochronous/Basic.lean @@ -195,6 +195,7 @@ lemma isOrthochronous_mul_iff {Λ Λ' : LorentzGroup d} : rw [← hnn] refine isOrthochronous_mul ?_ ?_ <;> rwa [neg_isOrthochronous_iff_not] +set_option backward.isDefEq.respectTransparency false in /-- The homomorphism from `LorentzGroup` to `ℤ₂`. -/ def orthchroRep : LorentzGroup d →* ℤ₂ where toFun := orthchroMap @@ -241,7 +242,7 @@ lemma isOrthochronous_on_connected_component {Λ Λ' : LorentzGroup d} (h : Λ' ∈ connectedComponent Λ) : IsOrthochronous Λ ↔ IsOrthochronous Λ' := by obtain ⟨s, hs, hΛ'⟩ := h let f : ContinuousMap s ℤ₂ := ContinuousMap.restrict s orthchroMap - haveI : PreconnectedSpace s := isPreconnected_iff_preconnectedSpace.mp hs.1 + have : PreconnectedSpace s := isPreconnected_iff_preconnectedSpace.mp hs.1 have h_eq : orthchroMap Λ = orthchroMap Λ' := by apply IsPreconnected.subsingleton (isPreconnected_range f.continuous_toFun) · exact Set.mem_range_self (⟨Λ, hs.2⟩ : {x : LorentzGroup d | x ∈ s}) diff --git a/Physlib/Relativity/LorentzGroup/Proper.lean b/Physlib/Relativity/LorentzGroup/Proper.lean index 98bbc12019..9abb111596 100644 --- a/Physlib/Relativity/LorentzGroup/Proper.lean +++ b/Physlib/Relativity/LorentzGroup/Proper.lean @@ -66,6 +66,7 @@ def detContinuous : C(𝓛 d, ℤ₂) := Continuous.comp' (continuous_iff_le_induced.mpr fun U a => a) continuous_id' } +set_option backward.isDefEq.respectTransparency false in lemma detContinuous_eq_one (Λ : LorentzGroup d) : detContinuous Λ = Additive.toMul 0 ↔ Λ.1.det = 1 := by simp only [detContinuous, ContinuousMap.comp_apply, ContinuousMap.coe_mk, coeForℤ₂_apply, @@ -79,6 +80,7 @@ lemma detContinuous_eq_one (Λ : LorentzGroup d) : · intro h' exact False.elim (h' h) +set_option backward.isDefEq.respectTransparency false in lemma detContinuous_eq_zero (Λ : LorentzGroup d) : detContinuous Λ = Additive.toMul (1 : ZMod 2) ↔ Λ.1.det = - 1 := by simp only [detContinuous, ContinuousMap.comp_apply, ContinuousMap.coe_mk, coeForℤ₂_apply, @@ -98,6 +100,7 @@ lemma detContinuous_eq_zero (Λ : LorentzGroup d) : linarith · linarith +set_option backward.isDefEq.respectTransparency false in lemma detContinuous_eq_iff_det_eq (Λ Λ' : LorentzGroup d) : detContinuous Λ = detContinuous Λ' ↔ Λ.1.det = Λ'.1.det := by match det_eq_one_or_neg_one Λ, det_eq_one_or_neg_one Λ' with @@ -154,11 +157,12 @@ lemma det_on_connected_component {Λ Λ' : LorentzGroup d} (h : Λ' ∈ connecte Λ.1.det = Λ'.1.det := by obtain ⟨s, hs, hΛ'⟩ := h let f : ContinuousMap s ℤ₂ := ContinuousMap.restrict s detContinuous - haveI : PreconnectedSpace s := isPreconnected_iff_preconnectedSpace.mp hs.1 + have : PreconnectedSpace s := isPreconnected_iff_preconnectedSpace.mp hs.1 simpa [f, detContinuous_eq_iff_det_eq] using (@IsPreconnected.subsingleton ℤ₂ _ _ _ (isPreconnected_range f.2)) (Set.mem_range_self ⟨Λ, hs.2⟩) (Set.mem_range_self ⟨Λ', hΛ'⟩) +set_option backward.isDefEq.respectTransparency false in /-- Two Lorentz transformations which are in the same connected component have the same image under `detRep`, the determinant representation. -/ lemma detRep_on_connected_component {Λ Λ' : LorentzGroup d} (h : Λ' ∈ connectedComponent Λ) : diff --git a/Physlib/Relativity/LorentzGroup/Rotations.lean b/Physlib/Relativity/LorentzGroup/Rotations.lean index f476e2c641..b3164e7738 100644 --- a/Physlib/Relativity/LorentzGroup/Rotations.lean +++ b/Physlib/Relativity/LorentzGroup/Rotations.lean @@ -19,6 +19,7 @@ noncomputable section namespace LorentzGroup +set_option backward.isDefEq.respectTransparency false in /-- The subgroup of rotations of the Lorentz group. -/ def Rotations (d) : Subgroup (LorentzGroup d) where carrier Λ := Λ.1 (Sum.inl 0) (Sum.inl 0) = 1 ∧ IsProper Λ @@ -54,6 +55,7 @@ lemma transpose_mem_rotations {d} (Λ : LorentzGroup d) : transpose Λ ∈ Rotations d ↔ Λ ∈ Rotations d := by simp [mem_rotations_iff, LorentzGroup.transpose_val, IsProper] +set_option backward.isDefEq.respectTransparency false in /-- The group homomorphism from the special orthogonal group to the Lorentz group. -/ def ofSpecialOrthogonal {d} : Matrix.specialOrthogonalGroup (Fin d) ℝ ≃* Rotations d where diff --git a/Physlib/Relativity/MinkowskiMatrix.lean b/Physlib/Relativity/MinkowskiMatrix.lean index d06f5350ec..001a13b274 100644 --- a/Physlib/Relativity/MinkowskiMatrix.lean +++ b/Physlib/Relativity/MinkowskiMatrix.lean @@ -51,8 +51,7 @@ This will be used to help define the Lorentz group in later files. ## iv. References -No references are given here. - +* None. -/ @[expose] public section @@ -129,6 +128,13 @@ lemma off_diag_zero {μ ν : Fin 1 ⊕ Fin d} (h : μ ≠ ν) : η μ ν = 0 := lemma η_diag_ne_zero {μ : Fin 1 ⊕ Fin d} : η μ μ ≠ 0 := by aesop (add safe forward as_diagonal) +/-- Right multiplication of a row vector by the Minkowski matrix multiplies each component by +the corresponding diagonal sign. -/ +lemma vecMul_apply (v : (Fin 1 ⊕ Fin d) → ℝ) (μ : Fin 1 ⊕ Fin d) : + (v ᵥ* minkowskiMatrix) μ = v μ * minkowskiMatrix μ μ := by + rw [as_diagonal, Matrix.vecMul_diagonal] + simp + /-! ### A.4. Squaring the Minkowski matrix @@ -180,6 +186,25 @@ We show the determinant of the Minkowski matrix is equal to `(-1)^d` where lemma det_eq_neg_one_pow_d : (@minkowskiMatrix d).det = (- 1) ^ d := by simp [as_diagonal] +/-- The product of all diagonal entries of the Minkowski matrix is `(-1) ^ d`. -/ +lemma prod_diagonal : ∏ μ : Fin 1 ⊕ Fin d, minkowskiMatrix μ μ = (-1) ^ d := by + rw [as_diagonal] + simp only [Matrix.diagonal_apply_eq] + rw [Fintype.prod_sum_type] + simp + +/-- Reindexing all diagonal entries injectively does not change their product. -/ +lemma prod_diagonal_comp_of_injective {v : Fin (d + 1) → Fin 1 ⊕ Fin d} + (hv : Function.Injective v) : + ∏ i, minkowskiMatrix (v i) (v i) = (-1) ^ d := by + have hcard : Fintype.card (Fin (d + 1)) = Fintype.card (Fin 1 ⊕ Fin d) := by + simp [Nat.add_comm] + have hbij : Function.Bijective v := + (Fintype.bijective_iff_injective_and_card v).mpr ⟨hv, hcard⟩ + let e : Fin (d + 1) ≃ Fin 1 ⊕ Fin d := Equiv.ofBijective v hbij + change ∏ i, minkowskiMatrix (e i) (e i) = (-1) ^ d + exact (Equiv.prod_comp e (fun μ => minkowskiMatrix μ μ)).trans prod_diagonal + /-! ### A.7. Injective properties of multiplying diagonal components diff --git a/Physlib/Relativity/PauliMatrices/AsTensor.lean b/Physlib/Relativity/PauliMatrices/AsTensor.lean index c2d84e1f4f..34ad5cb901 100644 --- a/Physlib/Relativity/PauliMatrices/AsTensor.lean +++ b/Physlib/Relativity/PauliMatrices/AsTensor.lean @@ -66,7 +66,6 @@ lemma leftRightToMatrix_σSA_inr_1_expand : leftRightToMatrix.symm (pauliBasis ( simp [leftRightToMatrix_symm_expand_tmul, pauliBasis, pauliSelfAdjoint, pauliMatrix] module -set_option backward.isDefEq.respectTransparency false in /-- The expansion of the pauli matrix `σ₃` in terms of a basis of tensor product vectors. -/ lemma leftRightToMatrix_σSA_inr_2_expand : leftRightToMatrix.symm (pauliBasis (Sum.inr 2)) = LeftHandedWeyl.basis 0 ⊗ₜ RightHandedWeyl.basis 0 - diff --git a/Physlib/Relativity/PauliMatrices/Basic.lean b/Physlib/Relativity/PauliMatrices/Basic.lean index 471937671a..7f2a7c0b63 100644 --- a/Physlib/Relativity/PauliMatrices/Basic.lean +++ b/Physlib/Relativity/PauliMatrices/Basic.lean @@ -7,6 +7,8 @@ module public import Mathlib.Analysis.Complex.Basic public import Mathlib.LinearAlgebra.Matrix.Trace +public import Physlib.Mathematics.KroneckerDelta.Basic +public import Physlib.Mathematics.CrossProduct /-! ## Pauli matrices @@ -16,15 +18,7 @@ The pauli matrices are defined ultimately through The notation `σ` can be used as short hand. A tensorial structure is put on `Fin 1 ⊕ Fin 3 → Matrix (Fin 2) (Fin 2) ℂ` to allow the -use of index notation. We then define the following notation: - -- `σ^^^` is the tensorial version of the Pauli matrices, which is a complex Lorentz tensor - of type `ℂT[.up, .upL, .upR]`. - -and the following abbreviations: -- `σ_^^` is the Pauli matrices as a complex Lorentz tensor of type `ℂT[.down, .upL, .upR]`. -- `σ___` is the Pauli matrices as a complex Lorentz tensor of type `ℂT[.down, .downR, .downL]`. -- `σ^__` is the Pauli matrices as a complex Lorentz tensor of type `ℂT[.up, .downR, .downL]`. +use of index notation. -/ @@ -33,6 +27,7 @@ and the following abbreviations: open Matrix open Complex open TensorProduct +open KroneckerDelta noncomputable section @@ -142,12 +137,10 @@ lemma σ1_σ0_trace : Matrix.trace (σ1 * σ0) = 0 := by simp [pauliMatrix] lemma σ1_σ1_trace : Matrix.trace (σ1 * σ1) = 2 := by simp /-- The trace of `σ1` multiplied by `σ2` is equal to `0`. -/ -@[simp] lemma σ1_σ2_trace : Matrix.trace (σ1 * σ2) = 0 := by simp [pauliMatrix] /-- The trace of `σ1` multiplied by `σ3` is equal to `0`. -/ -@[simp] lemma σ1_σ3_trace : Matrix.trace (σ1 * σ3) = 0 := by simp [pauliMatrix] @@ -162,7 +155,6 @@ lemma σ2_σ1_trace : Matrix.trace (σ2 * σ1) = 0 := by lemma σ2_σ2_trace : Matrix.trace (σ2 * σ2) = 2 := by simp /-- The trace of `σ2` multiplied by `σ3` is equal to `0`. -/ -@[simp] lemma σ2_σ3_trace : Matrix.trace (σ2 * σ3) = 0 := by simp [pauliMatrix] @@ -170,10 +162,10 @@ lemma σ2_σ3_trace : Matrix.trace (σ2 * σ3) = 0 := by lemma σ3_σ0_trace : Matrix.trace (σ3 * σ0) = 0 := by simp [pauliMatrix] /-- The trace of `σ3` multiplied by `σ1` is equal to `0`. -/ -lemma σ3_σ1_trace : Matrix.trace (σ3 * σ1) = 0 := by simp +lemma σ3_σ1_trace : Matrix.trace (σ3 * σ1) = 0 := by simp [pauliMatrix] /-- The trace of `σ3` multiplied by `σ2` is equal to `0`. -/ -lemma σ3_σ2_trace : Matrix.trace (σ3 * σ2) = 0 := by simp +lemma σ3_σ2_trace : Matrix.trace (σ3 * σ2) = 0 := by simp [pauliMatrix] /-- The trace of `σ3` multiplied by `σ3` is equal to `2`. -/ lemma σ3_σ3_trace : Matrix.trace (σ3 * σ3) = 2 := by simp @@ -221,4 +213,102 @@ lemma σ3_σ2_commutator : σ3 * σ2 - σ2 * σ3 = -(2 * I) • σ1 := by simp only [true_and] exact List.ofFn_inj.mp rfl +/-- Pauli matrices satisfy `{σᵢ, σⱼ} = 2 δᵢⱼ I`. -/ +lemma pauliMatrix_anticommutator (i j : Fin 3) : + pauliMatrix (Sum.inr i) * pauliMatrix (Sum.inr j) + + pauliMatrix (Sum.inr j) * pauliMatrix (Sum.inr i) = + ((2 * kroneckerDelta i j : ℕ) : ℂ) • + (1 : Matrix (Fin 2) (Fin 2) ℂ) := by + fin_cases i <;> fin_cases j <;> + simp [kroneckerDelta, pauliMatrix] <;> + ext a b <;> fin_cases a <;> fin_cases b <;> + norm_num + +/-- The matrix `a · σ` associated to a real three-vector `a`. -/ +noncomputable def vectorMatrix (a : Fin 3 → ℝ) : + Matrix (Fin 2) (Fin 2) ℂ := + ∑ i : Fin 3, (a i : ℂ) • pauliMatrix (Sum.inr i) + +/-- The anticommutator of two Pauli vectors is twice their Euclidean dot product +times the identity. -/ +lemma vectorMatrix_anticommutator (a b : Fin 3 → ℝ) : + vectorMatrix a * vectorMatrix b + vectorMatrix b * vectorMatrix a = + ((2 * (a ⬝ᵥ b) : ℝ) : ℂ) • + (1 : Matrix (Fin 2) (Fin 2) ℂ) := by + have h : + vectorMatrix a * vectorMatrix b + vectorMatrix b * vectorMatrix a = + ((a 0 : ℂ) * b 0) • (σ1 * σ1 + σ1 * σ1) + + ((a 1 : ℂ) * b 1) • (σ2 * σ2 + σ2 * σ2) + + ((a 2 : ℂ) * b 2) • (σ3 * σ3 + σ3 * σ3) + + ((a 0 : ℂ) * b 1 + (a 1 : ℂ) * b 0) • (σ1 * σ2 + σ2 * σ1) + + ((a 0 : ℂ) * b 2 + (a 2 : ℂ) * b 0) • (σ1 * σ3 + σ3 * σ1) + + ((a 1 : ℂ) * b 2 + (a 2 : ℂ) * b 1) • (σ2 * σ3 + σ3 * σ2) := by + simp only [vectorMatrix, Fin.sum_univ_three, add_mul, mul_add, Algebra.smul_mul_assoc, + Algebra.mul_smul_comm] + module + rw [h] + rw [pauliMatrix_anticommutator 0 0, + pauliMatrix_anticommutator 1 1, + pauliMatrix_anticommutator 2 2, + pauliMatrix_anticommutator 0 1, + pauliMatrix_anticommutator 0 2, + pauliMatrix_anticommutator 1 2] + norm_num [kroneckerDelta] + simp only [dotProduct, Fin.sum_univ_three] + push_cast + module + +/-- The commutator of two Pauli vectors is twice `i` times the Pauli vector +associated to their cross product. -/ +lemma vectorMatrix_commutator (a b : Fin 3 → ℝ) : + vectorMatrix a * vectorMatrix b - vectorMatrix b * vectorMatrix a = + (2 * Complex.I) • vectorMatrix (a ⨯₃ b) := by + have h : + vectorMatrix a * vectorMatrix b - vectorMatrix b * vectorMatrix a = + ((a 0 : ℂ) * b 1 - (a 1 : ℂ) * b 0) • (σ1 * σ2 - σ2 * σ1) + + ((a 0 : ℂ) * b 2 - (a 2 : ℂ) * b 0) • (σ1 * σ3 - σ3 * σ1) + + ((a 1 : ℂ) * b 2 - (a 2 : ℂ) * b 1) • (σ2 * σ3 - σ3 * σ2) := by + simp only [vectorMatrix, Fin.sum_univ_three, add_mul, mul_add, Algebra.smul_mul_assoc, + Algebra.mul_smul_comm] + module + rw [h] + rw [σ1_σ2_commutator, σ1_σ3_commutator, σ2_σ3_commutator] + simp only [vectorMatrix, Fin.sum_univ_three, cross_apply, Fin.isValue, neg_smul, smul_neg, + Nat.succ_eq_add_one, Nat.reduceAdd, cons_val_zero, ofReal_sub, ofReal_mul, cons_val_one, + cons_val, smul_add] + module + +/-- Product formula for Pauli vectors: +`(a · σ)(b · σ) = (a · b) I + i (a × b) · σ`. -/ +lemma vectorMatrix_mul_vectorMatrix (a b : Fin 3 → ℝ) : + vectorMatrix a * vectorMatrix b = + ((a ⬝ᵥ b : ℝ) : ℂ) • + (1 : Matrix (Fin 2) (Fin 2) ℂ) + + Complex.I • vectorMatrix (a ⨯₃ b) := by + have hcomm := vectorMatrix_commutator a b + have hanti := vectorMatrix_anticommutator a b + refine smul_right_injective _ (two_ne_zero (α := ℂ)) ?_ + simp only + have h2 : (2 : ℂ) • (vectorMatrix a * vectorMatrix b) = + (vectorMatrix a * vectorMatrix b + vectorMatrix b * vectorMatrix a) + + (vectorMatrix a * vectorMatrix b - vectorMatrix b * vectorMatrix a) := by + rw [two_smul]; abel + rw [h2, hanti, hcomm] + module + +/-- The square of `a · σ` is `|a|² I`. -/ +lemma vectorMatrix_sq (a : Fin 3 → ℝ) : + vectorMatrix a * vectorMatrix a = + (∑ i : Fin 3, a i ^ 2 : ℝ) • 1 := by + have hcross : a ⨯₃ a = 0 := by + rw [cross_apply] + ext i + fin_cases i <;> simp <;> ring + have hdot : a ⬝ᵥ a = ∑ i : Fin 3, a i ^ 2 := by simp [dotProduct, pow_two] + rw [vectorMatrix_mul_vectorMatrix, hcross, hdot] + simp only [vectorMatrix, Pi.zero_apply, Complex.ofReal_zero, zero_smul, Finset.sum_const_zero, + smul_zero, add_zero] + push_cast + module + end PauliMatrix diff --git a/Physlib/Relativity/PauliMatrices/Relations.lean b/Physlib/Relativity/PauliMatrices/Relations.lean index 4d4acd7da7..806a460977 100644 --- a/Physlib/Relativity/PauliMatrices/Relations.lean +++ b/Physlib/Relativity/PauliMatrices/Relations.lean @@ -1,18 +1,19 @@ /- Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joseph Tooby-Smith +Authors: Robert Sneiderman, Joseph Tooby-Smith -/ module public import Physlib.Relativity.PauliMatrices.ToTensor public import Physlib.Relativity.Tensors.ComplexTensor.Units.Basic +public import Physlib.Relativity.Tensors.LeviCivita.Complex /-! ## Contraction of indices of Pauli matrix. -The main result of this file is `pauliMatrix_contract_pauliMatrix` which states that -`η_{μν} σ^{μ α dot β} σ^{ν α' dot β'} = 2 ε^{αα'} ε^{dot β dot β'}`. +The results in this file include contractions, anticommutators, and triple-product identities +for the Pauli four-vectors. The current way this result is proved is by using tensor tree manipulations. There is likely a more direct path to this result. @@ -129,4 +130,92 @@ lemma auliContrDown_pauliContr_mul_add : apply (Function.Injective.eq_iff Physlib.RatComplexNum.toComplexNum_injective).mpr decide +revert +kernel +/-! + +## Triple products + +-/ + +/-- Rational-complex components of a contraction of `σ^^^` with a copy whose Weyl indices +are dualized. -/ +lemma pauliContr_mul_dualWeyl_eq_ofRat : + {σ^^^ | μ α β ⊗ σ^^^ | ν τ(α') τ(β)}ᵀ = ofRat (fun b => + ∑ x : Fin 2, pauliContrComponent (b 0) (b 1) x * + pauliContrDownComponent (b 2) x (b 3)) := by + rw [toTensor_dualWeyl_eq_ofRat, toTensor_eq_ofRat, prodT_ofRat_ofRat, contrT_ofRat] + congr + +/-- Rational-complex components of the reverse contraction of a Weyl-dualized `σ^^^` with +`σ^^^`. -/ +lemma dualWeyl_mul_pauliContr_eq_ofRat : + {σ^^^ | μ τ(α) τ(β) ⊗ σ^^^ | ν α β'}ᵀ = ofRat (fun b => + ∑ x : Fin 2, pauliContrDownComponent (b 0) (b 1) x * + pauliContrComponent (b 2) x (b 3)) := by + rw [toTensor_dualWeyl_eq_ofRat, toTensor_eq_ofRat, prodT_ofRat_ofRat, contrT_ofRat] + congr + +/-- Contracting `ε4ℂ` with a Lorentz-dualized `σ^^^` agrees with contracting it with +`pauliCo`. -/ +lemma leviCivita_mul_pauliDual : + ({ε4ℂ | μ ν ρ κ ⊗ σ^^^ | τ(κ) α β = + ε4ℂ | μ ν ρ κ ⊗ σ_^^ | κ α β}ᵀ : Prop) := by + rw [pauliDual_eq_pauliCo, prodT_permT_right, contrT_permT] + apply permT_congr + · decide + · rfl + +/-- Equation (2.26), the three-Pauli identity +`σ^μ barσ^ν σ^ρ = g^{μν} σ^ρ - g^{μρ} σ^ν + g^{νρ} σ^μ + + i ε^{μνρκ} σ_κ`, with barred and lowered forms expressed through index dualization `τ`. -/ +lemma pauliContr_mul_pauliContrDown_mul_pauliContr : ({ + σ^^^ | μ α β ⊗ σ^^^ | ν τ(α') τ(β) ⊗ σ^^^ | ρ α' β' = + ((((η | μ ν ⊗ σ^^^ | ρ α β') + (-((η | μ ρ ⊗ σ^^^ | ν α β')))) + + (η | ν ρ ⊗ σ^^^ | μ α β')) + + (Complex.I •ₜ (ε4ℂ | μ ν ρ κ ⊗ σ^^^ | τ(κ) α β'))) + }ᵀ : Prop) := by + conv_lhs => + rw [pauliContr_mul_dualWeyl_eq_ofRat, toTensor_eq_ofRat, + prodT_ofRat_ofRat, contrT_ofRat] + conv_rhs => + rw [leviCivita_mul_pauliDual] + simp only [contrMetric_eq_ofRat, toTensor_eq_ofRat, prodT_ofRat_ofRat] + simp only [leviCivita_eq_ofRat, pauliCo_eq_ofRat] + rw [prodT_ofRat_ofRat, contrT_ofRat, permT_ofRat] + apply (Tensor.basis _).repr.injective + ext b + rw [ofRat_basis_repr_apply, permT_basis_repr_symm_apply] + simp only [map_add, Finsupp.coe_add, Pi.add_apply] + simp only [permT_basis_repr_symm_apply, map_neg, Finsupp.coe_neg, Pi.neg_apply, + map_smul, Finsupp.coe_smul, Pi.smul_apply, smul_eq_mul, ofRat_basis_repr_apply] + rw [Physlib.RatComplexNum.I_mul_toComplexNum] + apply Physlib.RatComplexNum.toComplexNum_eq_add_neg_add_add_iff.mpr + decide +revert +kernel + +/-- Equation (2.27), the conjugate three-Pauli identity +`barσ^μ σ^ν barσ^ρ = g^{μν} barσ^ρ - g^{μρ} barσ^ν + g^{νρ} barσ^μ + - i ε^{μνρκ} barσ_κ`, with barred and lowered forms expressed through index dualization `τ`. -/ +lemma pauliContrDown_mul_pauliContr_mul_pauliContrDown : ({ + σ^^^ | μ τ(α) τ(β) ⊗ σ^^^ | ν α β' ⊗ σ^^^ | ρ τ(α') τ(β') = + ((((η | μ ν ⊗ σ^^^ | ρ τ(α') τ(β)) + + (-((η | μ ρ ⊗ σ^^^ | ν τ(α') τ(β))))) + + (η | ν ρ ⊗ σ^^^ | μ τ(α') τ(β))) + + ((-Complex.I) •ₜ (ε4ℂ | μ ν ρ κ ⊗ σ^^^ | τ(κ) τ(α') τ(β)))) + }ᵀ : Prop) := by + conv_lhs => + rw [dualWeyl_mul_pauliContr_eq_ofRat, toTensor_dualWeyl_eq_ofRat, + prodT_ofRat_ofRat, contrT_ofRat] + conv_rhs => + simp only [contrMetric_eq_ofRat, toTensor_dualWeyl_eq_ofRat, prodT_ofRat_ofRat] + simp only [leviCivita_eq_ofRat, toTensor_dualAll_eq_ofRat] + rw [prodT_ofRat_ofRat, contrT_ofRat, permT_ofRat] + apply (Tensor.basis _).repr.injective + ext b + rw [ofRat_basis_repr_apply, permT_basis_repr_symm_apply] + simp only [map_add, Finsupp.coe_add, Pi.add_apply] + simp only [permT_basis_repr_symm_apply, map_neg, Finsupp.coe_neg, Pi.neg_apply, + map_smul, Finsupp.coe_smul, Pi.smul_apply, smul_eq_mul, ofRat_basis_repr_apply] + rw [Physlib.RatComplexNum.neg_I_mul_toComplexNum] + apply Physlib.RatComplexNum.toComplexNum_eq_add_neg_add_add_iff.mpr + decide +revert +kernel + end PauliMatrix diff --git a/Physlib/Relativity/PauliMatrices/SelfAdjoint.lean b/Physlib/Relativity/PauliMatrices/SelfAdjoint.lean index 41748ad774..9a3ceab64b 100644 --- a/Physlib/Relativity/PauliMatrices/SelfAdjoint.lean +++ b/Physlib/Relativity/PauliMatrices/SelfAdjoint.lean @@ -7,6 +7,7 @@ module public import Physlib.Relativity.PauliMatrices.Basic public import Physlib.Relativity.MinkowskiMatrix +public import Mathlib.Analysis.CStarAlgebra.Matrix /-! ## Interaction of Pauli matrices with self-adjoint matrices @@ -14,8 +15,11 @@ public import Physlib.Relativity.MinkowskiMatrix -/ @[expose] public section + +noncomputable section + namespace PauliMatrix -open Matrix Module +open Matrix Module KroneckerDelta /-- The trace of a pauli-matrix multiplied by a self-adjoint `2×2` matrix is real. -/ lemma trace_pauliMatrix_mul_selfAdjoint_re (μ : Fin 1 ⊕ Fin 3) @@ -75,11 +79,10 @@ lemma selfAdjoint_ext {A B : selfAdjoint (Matrix (Fin 2) (Fin 2) ℂ)} trace_pauliMatrix_mul_selfAdjoint_re _ B] at h0' h1' h2' h3' exact selfAdjoint_ext_complex h0' h1' h2' h3' -noncomputable section - /-- An auxiliary function which on `i : Fin 1 ⊕ Fin 3` returns the corresponding - Pauli-matrix as a self-adjoint matrix. -/ -def pauliSelfAdjoint (i : Fin 1 ⊕ Fin 3) : selfAdjoint (Matrix (Fin 2) (Fin 2) ℂ) := +Pauli matrix as a self-adjoint matrix. -/ +def pauliSelfAdjoint (i : Fin 1 ⊕ Fin 3) : + selfAdjoint (Matrix (Fin 2) (Fin 2) ℂ) := ⟨pauliMatrix i, pauliMatrix_selfAdjoint i⟩ /-- The Pauli matrices are linearly independent. -/ @@ -91,54 +94,169 @@ lemma pauliSelfAdjoint_linearly_independent : LinearIndependent ℝ pauliSelfAdj rw [Fin.sum_univ_three] at hg simp only [Fin.isValue, pauliSelfAdjoint] at hg intro i - have h1 := congrArg (fun A => (Matrix.trace (pauliMatrix i * A.1))) hg - simp only [Fin.isValue, AddSubgroup.coe_add, selfAdjoint.val_smul, mul_add, Algebra.mul_smul_comm, - trace_add, trace_smul, ZeroMemClass.coe_zero, mul_zero, trace_zero] at h1 - fin_cases i <;> simpa [pauliMatrix] using h1 + have h1 := congrArg (fun A => Matrix.trace (pauliMatrix i * A.1)) hg + simp only [Fin.isValue, AddSubgroup.coe_add, selfAdjoint.val_smul, mul_add, + Algebra.mul_smul_comm, trace_add, trace_smul, ZeroMemClass.coe_zero, mul_zero, + trace_zero] at h1 + fin_cases i <;> simpa [pauliMatrix, kroneckerDelta] using h1 -/-- The Pauli matrices span all self-adjoint matrices. -/ -lemma pauliSelfAdjoint_span : ⊤ ≤ Submodule.span ℝ (Set.range pauliSelfAdjoint) := by - refine (Submodule.top_le_span_range_iff_forall_exists_fun ℝ).mpr ?_ - intro A - let c : Fin 1 ⊕ Fin 3 → ℝ := fun i => - match i with - | Sum.inl 0 => 1/2 * (Matrix.trace (σ0 * A.1)).re - | Sum.inr 0 => 1/2 * (Matrix.trace (σ1 * A.1)).re - | Sum.inr 1 => 1/2 * (Matrix.trace (σ2 * A.1)).re - | Sum.inr 2 => 1/2 * (Matrix.trace (σ3 * A.1)).re - use c - simp only [one_div, Fintype.sum_sum_type, Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, - Finset.sum_singleton, Fin.sum_univ_three, c] +/-- Pauli matrices are orthogonal with respect to the trace pairing: `tr(σ_μ σ_ν) = 2 δ_μν`. -/ +@[simp] +lemma trace_pauliMatrix_mul_pauliMatrix (μ ν : Fin 1 ⊕ Fin 3) : + Matrix.trace (pauliMatrix μ * pauliMatrix ν) = ((2 * kroneckerDelta μ ν : ℕ) : ℂ) := by + fin_cases μ <;> fin_cases ν <;> simp [kroneckerDelta, pauliMatrix] <;> norm_num + +/-- The four real Pauli coefficients of a self-adjoint `2 × 2` matrix. -/ +noncomputable def pauliCoeff + (A : selfAdjoint (Matrix (Fin 2) (Fin 2) ℂ)) : + Fin 1 ⊕ Fin 3 → ℝ + | Sum.inl 0 => 1 / 2 * (Matrix.trace (σ0 * A.1)).re + | Sum.inr 0 => 1 / 2 * (Matrix.trace (σ1 * A.1)).re + | Sum.inr 1 => 1 / 2 * (Matrix.trace (σ2 * A.1)).re + | Sum.inr 2 => 1 / 2 * (Matrix.trace (σ3 * A.1)).re + +/-- Every self-adjoint `2 × 2` matrix is its Pauli decomposition. -/ +lemma sum_pauliCoeff + (A : selfAdjoint (Matrix (Fin 2) (Fin 2) ℂ)) : + ∑ i, pauliCoeff A i • pauliSelfAdjoint i = A := by + simp only [Fintype.sum_sum_type, Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, + Finset.sum_singleton, Fin.sum_univ_three, pauliCoeff] apply selfAdjoint_ext · simp only [pauliSelfAdjoint, AddSubgroup.coe_add, selfAdjoint.val_smul, mul_add, - Algebra.mul_smul_comm, trace_add, trace_smul, σ0_σ0_trace, real_smul, ofReal_mul, ofReal_inv, - ofReal_ofNat, σ0_σ1_trace, smul_zero, σ0_σ2_trace, add_zero, σ0_σ3_trace, mul_re, inv_re, - re_ofNat, normSq_ofNat, div_self_mul_self', ofReal_re, inv_im, im_ofNat, neg_zero, zero_div, - ofReal_im, mul_zero, sub_zero, mul_im, zero_mul] + Algebra.mul_smul_comm, trace_add, trace_smul, σ0_σ0_trace, real_smul, ofReal_mul, + σ0_σ1_trace, smul_zero, σ0_σ2_trace, add_zero, + σ0_σ3_trace, mul_re, re_ofNat, + ofReal_re, im_ofNat, ofReal_im, mul_zero, sub_zero, + mul_im, zero_mul] ring · simp only [pauliSelfAdjoint, AddSubgroup.coe_add, selfAdjoint.val_smul, mul_add, - Algebra.mul_smul_comm, trace_add, trace_smul, σ1_σ0_trace, smul_zero, σ1_σ1_trace, real_smul, - ofReal_mul, ofReal_inv, ofReal_ofNat, σ1_σ2_trace, add_zero, σ1_σ3_trace, zero_add, mul_re, - inv_re, re_ofNat, normSq_ofNat, div_self_mul_self', ofReal_re, inv_im, im_ofNat, neg_zero, - zero_div, ofReal_im, mul_zero, sub_zero, mul_im, zero_mul] + Algebra.mul_smul_comm, trace_add, trace_smul, σ1_σ0_trace, smul_zero, + σ1_σ1_trace, real_smul, ofReal_mul, σ1_σ2_trace, + add_zero, σ1_σ3_trace, zero_add, mul_re, re_ofNat, + ofReal_re, im_ofNat, ofReal_im, + mul_zero, sub_zero, mul_im, zero_mul] ring · simp only [pauliSelfAdjoint, AddSubgroup.coe_add, selfAdjoint.val_smul, mul_add, - Algebra.mul_smul_comm, trace_add, trace_smul, σ2_σ0_trace, smul_zero, σ2_σ1_trace, σ2_σ2_trace, - real_smul, ofReal_mul, ofReal_inv, ofReal_ofNat, zero_add, σ2_σ3_trace, add_zero, mul_re, - inv_re, re_ofNat, normSq_ofNat, div_self_mul_self', ofReal_re, inv_im, im_ofNat, neg_zero, - zero_div, ofReal_im, mul_zero, sub_zero, mul_im, zero_mul] + Algebra.mul_smul_comm, trace_add, trace_smul, σ2_σ0_trace, smul_zero, + σ2_σ1_trace, σ2_σ2_trace, real_smul, ofReal_mul, + zero_add, σ2_σ3_trace, add_zero, mul_re, re_ofNat, + ofReal_re, im_ofNat, ofReal_im, + mul_zero, sub_zero, mul_im, zero_mul] ring · simp only [pauliSelfAdjoint, AddSubgroup.coe_add, selfAdjoint.val_smul, mul_add, - Algebra.mul_smul_comm, trace_add, trace_smul, σ3_σ0_trace, smul_zero, σ3_σ1_trace, σ3_σ2_trace, - add_zero, σ3_σ3_trace, real_smul, ofReal_mul, ofReal_inv, ofReal_ofNat, zero_add, mul_re, - inv_re, re_ofNat, normSq_ofNat, div_self_mul_self', ofReal_re, inv_im, im_ofNat, neg_zero, - zero_div, ofReal_im, mul_zero, sub_zero, mul_im, zero_mul] + Algebra.mul_smul_comm, trace_add, trace_smul, σ3_σ0_trace, smul_zero, + σ3_σ1_trace, σ3_σ2_trace, add_zero, σ3_σ3_trace, real_smul, ofReal_mul, + zero_add, mul_re, re_ofNat, + ofReal_re, im_ofNat, ofReal_im, + mul_zero, sub_zero, mul_im, zero_mul] ring +/-- Every self-adjoint `2 × 2` matrix is a real linear combination of the Pauli matrices. -/ +lemma eq_sum_pauli + (A : selfAdjoint (Matrix (Fin 2) (Fin 2) ℂ)) : + A = ∑ i, pauliCoeff A i • pauliSelfAdjoint i := + (sum_pauliCoeff A).symm + +/-- The Pauli matrices span all self-adjoint matrices. -/ +lemma pauliSelfAdjoint_span : + ⊤ ≤ Submodule.span ℝ (Set.range pauliSelfAdjoint) := by + refine (Submodule.top_le_span_range_iff_forall_exists_fun ℝ).mpr ?_ + intro A + exact ⟨pauliCoeff A, sum_pauliCoeff A⟩ + /-- The basis of `selfAdjoint (Matrix (Fin 2) (Fin 2) ℂ)` formed by Pauli matrices. -/ -def pauliBasis : Basis (Fin 1 ⊕ Fin 3) ℝ (selfAdjoint (Matrix (Fin 2) (Fin 2) ℂ)) := +def pauliBasis : + Basis (Fin 1 ⊕ Fin 3) ℝ (selfAdjoint (Matrix (Fin 2) (Fin 2) ℂ)) := Basis.mk pauliSelfAdjoint_linearly_independent pauliSelfAdjoint_span +/-! ### Pauli coordinates of self-adjoint `2 × 2` matrices -/ + +/-- The coefficient of the identity in the Pauli decomposition. -/ +noncomputable def scalarCoeff + (A : selfAdjoint (Matrix (Fin 2) (Fin 2) ℂ)) : ℝ := + pauliCoeff A (Sum.inl 0) + +/-- The three spatial Pauli coefficients. -/ +noncomputable def vectorCoeff + (A : selfAdjoint (Matrix (Fin 2) (Fin 2) ℂ)) : Fin 3 → ℝ := + fun i => pauliCoeff A (Sum.inr i) + +/-- The traceless Pauli-vector part `a · σ`. -/ +noncomputable def vectorPart + (A : selfAdjoint (Matrix (Fin 2) (Fin 2) ℂ)) : + Matrix (Fin 2) (Fin 2) ℂ := + vectorMatrix (vectorCoeff A) + +/-- The Euclidean length of the spatial Pauli coefficients. -/ +noncomputable def pauliRadius + (A : selfAdjoint (Matrix (Fin 2) (Fin 2) ℂ)) : ℝ := + Real.sqrt (∑ i : Fin 3, vectorCoeff A i ^ 2) + +/-- The Pauli radius is the square root of the squared Euclidean length of the +spatial Pauli coefficients. -/ +lemma pauliRadius_sq + (A : selfAdjoint (Matrix (Fin 2) (Fin 2) ℂ)) : + pauliRadius A ^ 2 = + ∑ i : Fin 3, vectorCoeff A i ^ 2 := by + rw [pauliRadius, Real.sq_sqrt] + positivity + +@[simp] +lemma pauliRadius_nonneg + (A : selfAdjoint (Matrix (Fin 2) (Fin 2) ℂ)) : + 0 ≤ pauliRadius A := + Real.sqrt_nonneg _ + +/-! ### Explicit coefficients -/ + +/-- A self-adjoint matrix is its scalar part plus its Pauli-vector part. -/ +lemma matrix_eq_scalar_add_vector + (A : selfAdjoint (Matrix (Fin 2) (Fin 2) ℂ)) : + A.val = (scalarCoeff A : ℂ) • 1 + vectorPart A := by + have h := congrArg + (fun B : selfAdjoint (Matrix (Fin 2) (Fin 2) ℂ) => B.val) + (sum_pauliCoeff A) + simp only [Fintype.sum_sum_type, Finset.univ_unique, Fin.default_eq_zero, + Finset.sum_singleton, Fin.sum_univ_three, pauliSelfAdjoint, + AddSubgroup.coe_add, selfAdjoint.val_smul] at h + rw [← h] + simp [scalarCoeff, vectorPart, vectorMatrix, vectorCoeff, + Fin.sum_univ_three, pauliMatrix_inl_zero_eq_one] + +/-- The trace of a self-adjoint matrix is twice its scalar Pauli coefficient. -/ +lemma trace_eq_two_mul_scalarCoeff + (A : selfAdjoint (Matrix (Fin 2) (Fin 2) ℂ)) : + Matrix.trace A.1 = 2 * scalarCoeff A := by + have htrace : + ((Matrix.trace A.1).re : ℂ) = Matrix.trace A.1 := by + simpa [pauliMatrix_inl_zero_eq_one] using + trace_pauliMatrix_mul_selfAdjoint_re (Sum.inl 0) A + rw [scalarCoeff, pauliCoeff] + simp only [pauliMatrix_inl_zero_eq_one, one_mul] + calc + Matrix.trace A.1 = ((Matrix.trace A.1).re : ℂ) := htrace.symm + _ = 2 * ((1 / 2 * (Matrix.trace A.1).re : ℝ) : ℂ) := by + push_cast + ring + +/-- The Pauli-vector part has zero trace. -/ +@[simp] +lemma trace_vectorPart + (A : selfAdjoint (Matrix (Fin 2) (Fin 2) ℂ)) : + Matrix.trace (vectorPart A) = 0 := by + have h := congrArg Matrix.trace (matrix_eq_scalar_add_vector A) + simp only [trace_add, trace_smul, smul_eq_mul, Matrix.trace_one, Fintype.card_fin, + Nat.cast_ofNat, trace_eq_two_mul_scalarCoeff A] at h + linear_combination -h + +/-- The square of the vector part of a self-adjoint matrix is its squared +Pauli radius times the identity. -/ +lemma vectorPart_sq + (A : selfAdjoint (Matrix (Fin 2) (Fin 2) ℂ)) : + vectorPart A * vectorPart A = + (pauliRadius A ^ 2 : ℝ) • 1 := by + rw [vectorPart, vectorMatrix_sq, ← pauliRadius_sq] + /-- An auxiliary function which on `i : Fin 1 ⊕ Fin 3` returns the corresponding Pauli-matrix as a self-adjoint matrix with a minus sign for `Sum.inr _`. -/ def pauliSelfAdjoint' (i : Fin 1 ⊕ Fin 3) : selfAdjoint (Matrix (Fin 2) (Fin 2) ℂ) := @@ -148,6 +266,33 @@ def pauliSelfAdjoint' (i : Fin 1 ⊕ Fin 3) : selfAdjoint (Matrix (Fin 2) (Fin 2 | Sum.inr 1 => ⟨-σ2, by rw [AddSubgroup.neg_mem_iff]; exact pauliMatrix_selfAdjoint _⟩ | Sum.inr 2 => ⟨-σ3, by rw [AddSubgroup.neg_mem_iff]; exact pauliMatrix_selfAdjoint _⟩ +/-- Trace orthogonality of the covariant Pauli basis: + `tr (σ'_a σ'_b) = 2 δ_{a b}`. -/ +lemma trace_pauliSelfAdjoint'_mul (a b : Fin 1 ⊕ Fin 3) : + Matrix.trace ((pauliSelfAdjoint' a).1 * (pauliSelfAdjoint' b).1) = + if a = b then 2 else 0 := by + rcases a with a | a <;> rcases b with b | b <;> + fin_cases a <;> fin_cases b <;> + simp only [pauliSelfAdjoint', Matrix.neg_mul, Matrix.mul_neg, + Matrix.trace_neg, neg_neg, trace_pauliMatrix_mul_pauliMatrix, + KroneckerDelta.kroneckerDelta] <;> + simp + +/-- The trace pairing of a covariant Pauli matrix with an arbitrary matrix, expressed through the +matrix entries. -/ +lemma trace_pauliSelfAdjoint'_mul_apply (l : Fin 1 ⊕ Fin 3) + (N : Matrix (Fin 2) (Fin 2) ℂ) : + Matrix.trace ((pauliSelfAdjoint' l).1 * N) = + match l with + | Sum.inl 0 => N 0 0 + N 1 1 + | Sum.inr 0 => -(N 0 1 + N 1 0) + | Sum.inr 1 => -(Complex.I * (N 0 1 - N 1 0)) + | Sum.inr 2 => -(N 0 0 - N 1 1) := by + rcases l with l | l <;> fin_cases l <;> + simp [pauliSelfAdjoint', pauliMatrix, Matrix.trace, Matrix.mul_apply, + Fin.sum_univ_two, Matrix.diag] <;> + ring + /-- The Pauli matrices where `σi` are negated are linearly independent. -/ lemma pauliSelfAdjoint'_linearly_independent : LinearIndependent ℝ pauliSelfAdjoint' := by apply Fintype.linearIndependent_iff.mpr @@ -159,7 +304,7 @@ lemma pauliSelfAdjoint'_linearly_independent : LinearIndependent ℝ pauliSelfAd intro i have h1 := congrArg (fun A => (Matrix.trace (pauliMatrix i * A.1))) hg simp [-real_smul, mul_add] at h1 - fin_cases i <;> simpa [pauliMatrix] using h1 + fin_cases i <;> simpa [pauliMatrix, kroneckerDelta] using h1 /-- The Pauli matrices where `σi` are negated span all Self-adjoint matrices. -/ lemma pauliSelfAdjoint'_span : ⊤ ≤ Submodule.span ℝ (Set.range pauliSelfAdjoint') := by @@ -325,5 +470,4 @@ lemma pauliBasis_minkowskiMetric_pauliBasis' (i : Fin 1 ⊕ Fin 3) : simp [pauliSelfAdjoint', pauliSelfAdjoint, pauliBasis, pauliBasis', minkowskiMatrix.inr_i_inr_i, Subtype.ext_iff, NegMemClass.coe_neg, neg_neg] -end end PauliMatrix diff --git a/Physlib/Relativity/PauliMatrices/ToTensor.lean b/Physlib/Relativity/PauliMatrices/ToTensor.lean index d4acc127f1..4f432b9a99 100644 --- a/Physlib/Relativity/PauliMatrices/ToTensor.lean +++ b/Physlib/Relativity/PauliMatrices/ToTensor.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joseph Tooby-Smith +Authors: Robert Sneiderman, Joseph Tooby-Smith -/ module @@ -40,6 +40,7 @@ and properties thereof. -/ +set_option backward.isDefEq.respectTransparency false in /-- The equivalence between the type of indices of a [.up, .upL, .upR] tensor and `(Fin 1 ⊕ Fin 3) × Fin 2 × Fin 2`. -/ def indexEquiv : ComponentIdx (S := complexLorentzTensor) ![.up, .upL, .upR] ≃ @@ -159,31 +160,141 @@ lemma toTensor_eq_asConsTensor : simp only [fromTripleT_apply_basis] rfl +/-- Rational-complex components of the contravariant Pauli four-vector. -/ +def pauliContrComponent (mu : Fin 4) (a b : Fin 2) : Physlib.RatComplexNum := + if mu.val = 0 ∧ a.val = b.val then ⟨1, 0⟩ else + if mu.val = 1 ∧ a.val ≠ b.val then ⟨1, 0⟩ else + if mu.val = 2 ∧ a.val = 0 ∧ b.val = 1 then ⟨0, -1⟩ else + if mu.val = 2 ∧ a.val = 1 ∧ b.val = 0 then ⟨0, 1⟩ else + if mu.val = 3 ∧ a.val = 0 ∧ b.val = 0 then ⟨1, 0⟩ else + if mu.val = 3 ∧ a.val = 1 ∧ b.val = 1 then ⟨-1, 0⟩ else 0 + +/-- Rational-complex components of the contravariant conjugate Pauli four-vector. -/ +def pauliContrDownComponent (mu : Fin 4) (a b : Fin 2) : Physlib.RatComplexNum := + if mu.val = 0 ∧ a.val = b.val then ⟨1, 0⟩ else + if mu.val = 1 ∧ a.val ≠ b.val then ⟨-1, 0⟩ else + if mu.val = 2 ∧ a.val = 0 ∧ b.val = 1 then ⟨0, 1⟩ else + if mu.val = 2 ∧ a.val = 1 ∧ b.val = 0 then ⟨0, -1⟩ else + if mu.val = 3 ∧ a.val = 0 ∧ b.val = 0 then ⟨-1, 0⟩ else + if mu.val = 3 ∧ a.val = 1 ∧ b.val = 1 then ⟨1, 0⟩ else 0 + +set_option backward.isDefEq.respectTransparency false in lemma toTensor_eq_ofRat : σ^^^ = ofRat (fun b => - if b 0 = Fin.cast (by rfl) (0 : Fin 4) ∧ b 1 = b 2 then ⟨1, 0⟩ else - if b 0 = Fin.cast (by rfl) (1 : Fin 4) ∧ b 1 ≠ b 2 then ⟨1, 0⟩ else - if b 0 = Fin.cast (by rfl) (2 : Fin 4) ∧ b 1 = Fin.cast (by rfl) (0 : Fin 2) ∧ - b 2 = Fin.cast (by rfl) (1 : Fin 2) then ⟨0, -1⟩ else - if b 0 = Fin.cast (by rfl) (2 : Fin 4) ∧ b 1 = Fin.cast (by rfl) (1 : Fin 2) ∧ - b 2 = Fin.cast (by rfl) (0 : Fin 2) then ⟨0, 1⟩ else - if b 0 = Fin.cast (by rfl) (3 : Fin 4) ∧ b 1 = Fin.cast (by rfl) (0 : Fin 2) ∧ - b 2 = Fin.cast (by rfl) (0 : Fin 2) then ⟨1, 0⟩ else - if b 0 = Fin.cast (by rfl) (3 : Fin 4) ∧ b 1 = Fin.cast (by rfl) (1 : Fin 2) ∧ - b 2 = Fin.cast (by rfl) (1 : Fin 2) then ⟨-1, 0⟩ else 0) := by + pauliContrComponent (b 0) (b 1) (b 2)) := by apply (Tensor.basis _).repr.injective ext b rw [toTensor_basis_expand] - simp only [Nat.succ_eq_add_one, Nat.reduceAdd, Fin.isValue, cons_val_zero, cons_val_one] + simp only [Nat.succ_eq_add_one, Nat.reduceAdd, Fin.isValue] repeat rw [basis_eq_ofRat] simp only [Fin.isValue, map_sub, map_add, _root_.map_smul, Finsupp.coe_sub, Finsupp.coe_add, Finsupp.coe_smul, Pi.sub_apply, Pi.add_apply, ofRat_basis_repr_apply, Pi.smul_apply, - smul_eq_mul, Physlib.RatComplexNum.I_mul_toComplexNum, mul_ite, ne_eq, cons_val_two, + smul_eq_mul, Physlib.RatComplexNum.I_mul_toComplexNum, mul_ite, Nat.succ_eq_add_one, Nat.reduceAdd] simp only [Fin.isValue, ← map_add, ← map_sub] apply (Function.Injective.eq_iff Physlib.RatComplexNum.toComplexNum_injective).mpr revert b decide +kernel +set_option backward.isDefEq.respectTransparency false in +/-- Rational-complex components of `σ^^^` after dualizing its left-handed Weyl index. -/ +lemma toTensor_dualLeft_eq_ofRat : + {σ^^^ | μ τ(α) β}ᵀ = + ofRat (fun b => + ∑ x : Fin 2, pauliContrComponent (b 0) x (b 2) * + (if x.val = 0 ∧ (b 1).val = 1 then 1 else + if (b 1).val = 0 ∧ x.val = 1 then -1 else 0)) := by + let M : ℂT[.downL, .downL] := εL' + conv_lhs => + rw [toTensor_eq_ofRat, toDualMapAtIndex] + change crossToSlot 1 0 (by rfl) M (ofRat _) + erw [crossToSlot_eq_crossToEnd, crossToEnd] + simp only [LinearMap.compr₂_apply, LinearMap.comp_apply] + dsimp only [M] + rw [dualLeftMetric_eq_ofRat, prodT_ofRat_ofRat, permT_ofRat, contrT_ofRat, + permT_ofRat, permT_ofRat] + congr + funext b + decide +revert +kernel + +set_option backward.isDefEq.respectTransparency false in +/-- Rational-complex components of `σ^^^` after dualizing both Weyl indices. -/ +lemma toTensor_dualWeyl_eq_ofRat : + {σ^^^ | μ τ(α) τ(β)}ᵀ = + ofRat (fun b => + pauliContrDownComponent (b 0) (b 2) (b 1)) := by + rw [toTensor_dualLeft_eq_ofRat] + let M : ℂT[.downR, .downR] := εR' + conv_lhs => + rw [toDualMapAtIndex] + change crossToSlot 2 0 (by rfl) M (ofRat _) + erw [crossToSlot_eq_crossToEnd, crossToEnd] + simp only [LinearMap.compr₂_apply, LinearMap.comp_apply] + dsimp only [M] + rw [dualRightMetric_eq_ofRat, prodT_ofRat_ofRat, permT_ofRat, contrT_ofRat, + permT_ofRat, permT_ofRat] + congr + funext b + decide +revert +kernel + +set_option backward.isDefEq.respectTransparency false in +/-- Rational-complex components of `σ^^^` after dualizing its Lorentz index. -/ +lemma toTensor_dualLorentz_eq_ofRat : + {σ^^^ | τ(μ) α β}ᵀ = + ofRat (fun b => pauliContrDownComponent (b 0) (b 1) (b 2)) := by + let M : ℂT[.down, .down] := η' + conv_lhs => + rw [toTensor_eq_ofRat, toDualMapAtIndex] + change crossToSlot 0 0 (by rfl) M (ofRat _) + erw [crossToSlot_eq_crossToEnd, crossToEnd] + simp only [LinearMap.compr₂_apply, LinearMap.comp_apply] + dsimp only [M] + rw [coMetric_eq_ofRat, prodT_ofRat_ofRat, permT_ofRat, contrT_ofRat, + permT_ofRat, permT_ofRat] + congr + funext b + decide +revert +kernel + +set_option backward.isDefEq.respectTransparency false in +/-- Rational-complex components of `σ^^^` after dualizing its Lorentz and left-handed Weyl +indices. -/ +lemma toTensor_dualLorentzLeft_eq_ofRat : + {σ^^^ | τ(μ) τ(α) β}ᵀ = ofRat (fun b => + ∑ x : Fin 2, pauliContrDownComponent (b 0) x (b 2) * + (if x.val = 0 ∧ (b 1).val = 1 then 1 else + if (b 1).val = 0 ∧ x.val = 1 then -1 else 0)) := by + rw [toTensor_dualLorentz_eq_ofRat] + let M : ℂT[.downL, .downL] := εL' + conv_lhs => + rw [toDualMapAtIndex] + change crossToSlot 1 0 (by rfl) M (ofRat _) + erw [crossToSlot_eq_crossToEnd, crossToEnd] + simp only [LinearMap.compr₂_apply, LinearMap.comp_apply] + dsimp only [M] + rw [dualLeftMetric_eq_ofRat, prodT_ofRat_ofRat, permT_ofRat, contrT_ofRat, + permT_ofRat, permT_ofRat] + congr + funext b + decide +revert +kernel + +set_option backward.isDefEq.respectTransparency false in +/-- Rational-complex components of `σ^^^` after dualizing all three indices. -/ +lemma toTensor_dualAll_eq_ofRat : + {σ^^^ | τ(μ) τ(α) τ(β)}ᵀ = + ofRat (fun b => pauliContrComponent (b 0) (b 2) (b 1)) := by + rw [toTensor_dualLorentzLeft_eq_ofRat] + let M : ℂT[.downR, .downR] := εR' + conv_lhs => + rw [toDualMapAtIndex] + change crossToSlot 2 0 (by rfl) M (ofRat _) + erw [crossToSlot_eq_crossToEnd, crossToEnd] + simp only [LinearMap.compr₂_apply, LinearMap.comp_apply] + dsimp only [M] + rw [dualRightMetric_eq_ofRat, prodT_ofRat_ofRat, permT_ofRat, contrT_ofRat, + permT_ofRat, permT_ofRat] + congr + funext b + decide +revert +kernel + set_option backward.isDefEq.respectTransparency false in @[simp] lemma smul_eq_self (Λ : SL(2,ℂ)) : Λ • pauliMatrix = pauliMatrix := by @@ -229,17 +340,9 @@ scoped[PauliMatrix] notation "σ^__" => PauliMatrix.pauliContrDown -/ open Lorentz +set_option backward.isDefEq.respectTransparency false in lemma pauliCo_eq_ofRat : pauliCo = ofRat (fun b => - if b 0 = Fin.cast (by rfl) (0 : Fin 4) ∧ b 1 = b 2 then ⟨1, 0⟩ else - if b 0 = Fin.cast (by rfl) (1 : Fin 4) ∧ b 1 ≠ b 2 then ⟨-1, 0⟩ else - if b 0 = Fin.cast (by rfl) (2 : Fin 4) ∧ b 1 = Fin.cast (by rfl) (0 : Fin 2) ∧ - b 2 = Fin.cast (by rfl) (1 : Fin 2) then ⟨0, 1⟩ else - if b 0 = Fin.cast (by rfl) (2 : Fin 4) ∧ b 1 = Fin.cast (by rfl) (1 : Fin 2) ∧ - b 2 = Fin.cast (by rfl) (0 : Fin 2) then ⟨0, -1⟩ else - if b 0 = Fin.cast (by rfl) (3 : Fin 4) ∧ b 1 = Fin.cast (by rfl) (0 : Fin 2) ∧ - b 2 = Fin.cast (by rfl) (0 : Fin 2) then ⟨-1, 0⟩ else - if b 0 = Fin.cast (by rfl) (3 : Fin 4) ∧ b 1 = Fin.cast (by rfl) (1 : Fin 2) ∧ - b 2 = Fin.cast (by rfl) (1 : Fin 2) then ⟨1, 0⟩ else ⟨0, 0⟩) := by + pauliContrDownComponent (b 0) (b 1) (b 2)) := by apply (Tensor.basis _).repr.injective ext b rw [pauliCo] @@ -258,17 +361,9 @@ lemma pauliCo_eq_ofRat : pauliCo = ofRat (fun b => revert b decide +kernel +set_option backward.isDefEq.respectTransparency false in lemma pauliCoDown_eq_ofRat : pauliCoDown = ofRat (fun b => - if b 0 = Fin.cast (by rfl) (0 : Fin 4) ∧ b 1 = b 2 then ⟨1, 0⟩ else - if b 0 = Fin.cast (by rfl) (1 : Fin 4) ∧ b 1 ≠ b 2 then ⟨1, 0⟩ else - if b 0 = Fin.cast (by rfl) (2 : Fin 4) ∧ b 1 = Fin.cast (by rfl) (0 : Fin 2) ∧ - b 2 = Fin.cast (by rfl) (1 : Fin 2) then ⟨0, -1⟩ else - if b 0 = Fin.cast (by rfl) (2 : Fin 4) ∧ b 1 = Fin.cast (by rfl) (1 : Fin 2) ∧ - b 2 = Fin.cast (by rfl) (0 : Fin 2) then ⟨0, 1⟩ else - if b 0 = Fin.cast (by rfl) (3 : Fin 4) ∧ b 1 = Fin.cast (by rfl) (1 : Fin 2) ∧ - b 2 = Fin.cast (by rfl) (1 : Fin 2) then ⟨-1, 0⟩ else - if b 0 = Fin.cast (by rfl) (3 : Fin 4) ∧ b 1 = Fin.cast (by rfl) (0 : Fin 2) ∧ - b 2 = Fin.cast (by rfl) (0 : Fin 2) then ⟨1, 0⟩ else ⟨0, 0⟩) := by + pauliContrComponent (b 0) (b 1) (b 2)) := by apply (Tensor.basis _).repr.injective ext b rw [pauliCoDown] @@ -299,17 +394,9 @@ lemma pauliCoDown_eq_ofRat : pauliCoDown = ofRat (fun b => revert b decide +kernel +set_option backward.isDefEq.respectTransparency false in lemma pauliContrDown_ofRat : pauliContrDown = ofRat (fun b => - if b 0 = Fin.cast (by rfl) (0 : Fin 4) ∧ b 1 = b 2 then ⟨1, 0⟩ else - if b 0 = Fin.cast (by rfl) (1 : Fin 4) ∧ b 1 ≠ b 2 then ⟨-1, 0⟩ else - if b 0 = Fin.cast (by rfl) (2 : Fin 4) ∧ b 1 = Fin.cast (by rfl) (0 : Fin 2) ∧ - b 2 = Fin.cast (by rfl) (1 : Fin 2) then ⟨0, 1⟩ else - if b 0 = Fin.cast (by rfl) (2 : Fin 4) ∧ b 1 = Fin.cast (by rfl) (1 : Fin 2) ∧ - b 2 = Fin.cast (by rfl) (0 : Fin 2) then ⟨0, -1⟩ else - if b 0 = Fin.cast (by rfl) (3 : Fin 4) ∧ b 1 = Fin.cast (by rfl) (1 : Fin 2) ∧ - b 2 = Fin.cast (by rfl) (1 : Fin 2) then ⟨1, 0⟩ else - if b 0 = Fin.cast (by rfl) (3 : Fin 4) ∧ b 1 = Fin.cast (by rfl) (0 : Fin 2) ∧ - b 2 = Fin.cast (by rfl) (0 : Fin 2) then ⟨-1, 0⟩ else 0) := by + pauliContrDownComponent (b 0) (b 1) (b 2)) := by apply (Tensor.basis _).repr.injective ext b rw [pauliContrDown] @@ -342,6 +429,71 @@ lemma pauliContrDown_ofRat : pauliContrDown = ofRat (fun b => /-! +## Index dualization + +-/ + +/-- Dualizing both Weyl indices of `σ^^^` gives `σ^__`. -/ +lemma toTensor_dualWeyl_eq_pauliContrDown : + ({σ^^^ | μ τ(α) τ(β) = σ^__ | μ β α}ᵀ : Prop) := by + rw [toTensor_dualWeyl_eq_ofRat] + rw [pauliContrDown_ofRat, permT_ofRat] + congr + +/-- Dualizing all three indices of `σ^^^` gives `σ___`. -/ +lemma toTensor_dualAll_eq_pauliCoDown : + ({σ^^^ | τ(μ) τ(α) τ(β) = σ___ | μ β α}ᵀ : Prop) := by + rw [toTensor_dualAll_eq_ofRat] + rw [pauliCoDown_eq_ofRat, permT_ofRat] + congr + +set_option backward.isDefEq.respectTransparency false in +/-- Lowering the Lorentz index of `σ^^^` with `τ` gives `σ_^^`. -/ +lemma pauliDual_eq_pauliCo : + ({σ^^^ | τ(μ) α β = σ_^^ | μ α β}ᵀ : Prop) := by + rw [toTensor_dualLorentz_eq_ofRat, pauliCo_eq_ofRat, permT_ofRat] + congr + +set_option backward.isDefEq.respectTransparency false in +/-- Lowering the Lorentz index of `σ^__` with `τ` gives `σ___`. -/ +lemma pauliContrDownDual_eq_pauliCoDown : + ({σ^__ | τ(μ) β α = σ___ | μ β α}ᵀ : Prop) := by + let h : IsReindexing ![Color.down, Color.downR, Color.downL] + (Function.update ![Color.up, Color.downR, Color.downL] 0 + (![Color.down, Color.down] (Fin.succAbove 0 0))) id := + IsReindexing.auto + have hDual : + (toDualMapAtIndex (S := complexLorentzTensor) 0) pauliContrDown = + permT (id : Fin 3 → Fin 3) h pauliCoDown := by + change (toDualMapAtIndex (S := complexLorentzTensor) 0) pauliContrDown = + permT id h pauliCoDown + conv_lhs => + rw [pauliContrDown_ofRat] + rw [toDualMapAtIndex] + change crossToSlot (S := complexLorentzTensor) 0 0 rfl η' (ofRat _) + rw [crossToSlot_eq_crossToEnd, crossToEnd] + simp only [LinearMap.compr₂_apply, LinearMap.comp_apply] + rw [coMetric_eq_ofRat] + rw [prodT_ofRat_ofRat, permT_ofRat, contrT_ofRat, permT_ofRat, permT_ofRat] + conv_rhs => + rw [pauliCoDown_eq_ofRat] + apply (Tensor.basis _).repr.injective + ext b + conv_rhs => + rw [permT_basis_repr_symm_apply h] + rw [ofRat_basis_repr_apply] + conv_lhs => + rw [ofRat_basis_repr_apply] + apply (Function.Injective.eq_iff Physlib.RatComplexNum.toComplexNum_injective).mpr + revert b + decide +kernel + rw [hDual] + apply permT_congr + · decide + · rfl + +/-! + ## Group actions -/ diff --git a/Physlib/Relativity/SL2C/AxisRotations.lean b/Physlib/Relativity/SL2C/AxisRotations.lean new file mode 100644 index 0000000000..a4b8022ff6 --- /dev/null +++ b/Physlib/Relativity/SL2C/AxisRotations.lean @@ -0,0 +1,127 @@ +/- +Copyright (c) 2026 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jinzheng Li, Nathaneal Sajan, Joseph Tooby-Smith +-/ +module + +public import Physlib.Relativity.SL2C.Basic +/-! +# Coordinate-axis rotations in `SL(2,ℂ)` + +This file defines chosen `SL(2,ℂ)` rotations carrying the `z`-axis to a selected coordinate axis. +The spatial-axis convention is `0 = x`, `1 = y`, and `2 = z`; consequently, the rotation associated +with axis `2` is the identity. + +Conjugation by these rotations transports a matrix written in the diagonal `z`-axis basis to +the corresponding coordinate-axis basis. This provides the common change of basis used by +coordinate-axis boosts and later constructions based on diagonal representatives. + +The main declarations are: + +- `rotationZToAxis`, the indexed family of rotations; +- `rotationZToAxis_zero_apply` and its companions, their matrix entries; +- `rotationZToAxis_zero_mul_diagonal_mul_inv` and its companions, their action on a + diagonal matrix. +-/ + +@[expose] public section + +namespace Lorentz.SL2C + +open Matrix MatrixGroups + +/-- The `SL(2,ℂ)` rotation carrying the `z`-axis to axis `i`. -/ +noncomputable def rotationZToAxis : Fin 3 → SL(2,ℂ) + | 0 => + ⟨(((Real.sqrt 2 : ℝ) : ℂ))⁻¹ • !![1, -1; 1, 1], by + rw [Matrix.det_smul, Matrix.det_fin_two_of, Fintype.card_fin, inv_pow] + norm_num [← Complex.ofReal_pow, Real.sq_sqrt]⟩ + | 1 => + ⟨(((Real.sqrt 2 : ℝ) : ℂ))⁻¹ • !![1, Complex.I; Complex.I, 1], by + rw [Matrix.det_smul, Matrix.det_fin_two_of, Fintype.card_fin, inv_pow, + Complex.I_mul_I] + norm_num [← Complex.ofReal_pow, Real.sq_sqrt]⟩ + | 2 => 1 + +/-- The matrix entries of the rotation carrying the `z`-axis to the `x`-axis. -/ +@[simp] lemma rotationZToAxis_zero_apply (j k : Fin 2) : + (rotationZToAxis 0).1 j k = + ((((Real.sqrt 2 : ℝ) : ℂ))⁻¹ • !![1, -1; 1, 1]) j k := rfl + +/-- The matrix entries of the rotation carrying the `z`-axis to the `y`-axis. -/ +@[simp] lemma rotationZToAxis_one_apply (j k : Fin 2) : + (rotationZToAxis 1).1 j k = + ((((Real.sqrt 2 : ℝ) : ℂ))⁻¹ • !![1, Complex.I; Complex.I, 1]) j k := rfl + +/-- The rotation carrying the `z`-axis to itself is the identity matrix. -/ +@[simp] lemma rotationZToAxis_two_apply (j k : Fin 2) : + (rotationZToAxis 2).1 j k = (1 : Matrix (Fin 2) (Fin 2) ℂ) j k := rfl + +/-- The matrix entries of the inverse rotation from the `x`-axis to the `z`-axis. -/ +@[simp] lemma rotationZToAxis_zero_inv_apply (j k : Fin 2) : + ((rotationZToAxis 0)⁻¹).1 j k = + ((((Real.sqrt 2 : ℝ) : ℂ))⁻¹ • !![1, 1; -1, 1]) j k := by + rw [Matrix.SpecialLinearGroup.SL2_inv_expl] + fin_cases j <;> fin_cases k <;> simp [rotationZToAxis] + +/-- The matrix entries of the inverse rotation from the `y`-axis to the `z`-axis. -/ +@[simp] lemma rotationZToAxis_one_inv_apply (j k : Fin 2) : + ((rotationZToAxis 1)⁻¹).1 j k = + ((((Real.sqrt 2 : ℝ) : ℂ))⁻¹ • !![1, -Complex.I; -Complex.I, 1]) j k := by + rw [Matrix.SpecialLinearGroup.SL2_inv_expl] + fin_cases j <;> fin_cases k <;> simp [rotationZToAxis] + +/-- The inverse rotation from the `z`-axis to itself is the identity matrix. -/ +@[simp] lemma rotationZToAxis_two_inv_apply (j k : Fin 2) : + ((rotationZToAxis 2)⁻¹).1 j k = (1 : Matrix (Fin 2) (Fin 2) ℂ) j k := by + rw [Matrix.SpecialLinearGroup.SL2_inv_expl] + fin_cases j <;> fin_cases k <;> simp [rotationZToAxis] + +/-- Conjugating `diag(a, b)` by the rotation to the `x`-axis expresses it in the `x`-axis +basis. -/ +lemma rotationZToAxis_zero_mul_diagonal_mul_inv (a b : ℂ) : + (rotationZToAxis 0).1 * !![a, 0; 0, b] * ((rotationZToAxis 0)⁻¹).1 = + !![(a + b) / 2, (a - b) / 2; (a - b) / 2, (a + b) / 2] := by + have hsqrt_ne : (((Real.sqrt 2 : ℝ) : ℂ)) ≠ 0 := by simp + ext j k + fin_cases j <;> fin_cases k <;> + simp only [Matrix.mul_apply, Fin.sum_univ_two, rotationZToAxis_zero_apply, + rotationZToAxis_zero_inv_apply] <;> + simp <;> + field_simp <;> + norm_num [← Complex.ofReal_pow, Real.sq_sqrt] <;> + ring + +/-- Conjugating `diag(a, b)` by the rotation to the `y`-axis expresses it in the `y`-axis +basis. -/ +lemma rotationZToAxis_one_mul_diagonal_mul_inv (a b : ℂ) : + (rotationZToAxis 1).1 * !![a, 0; 0, b] * ((rotationZToAxis 1)⁻¹).1 = + !![(a + b) / 2, -Complex.I * (a - b) / 2; + Complex.I * (a - b) / 2, (a + b) / 2] := by + have hsqrt_ne : (((Real.sqrt 2 : ℝ) : ℂ)) ≠ 0 := by simp + ext j k + fin_cases j <;> fin_cases k + all_goals + simp only [Matrix.mul_apply, Fin.sum_univ_two, rotationZToAxis_one_apply, + rotationZToAxis_one_inv_apply] + simp only [Fin.zero_eta, Fin.isValue, Matrix.smul_apply, of_apply, cons_val', + cons_val_zero, cons_val_fin_one, smul_eq_mul, mul_one, cons_val_one, mul_zero, + add_zero, zero_add, mul_neg, neg_mul, Fin.mk_one] + field_simp + norm_num [← Complex.ofReal_pow, Real.sq_sqrt] + all_goals ring + +/-- Conjugating `diag(a, b)` by the identity rotation leaves it unchanged. -/ +lemma rotationZToAxis_two_mul_diagonal_mul_inv (a b : ℂ) : + (rotationZToAxis 2).1 * !![a, 0; 0, b] * ((rotationZToAxis 2)⁻¹).1 = + !![a, 0; 0, b] := by + ext j k + fin_cases j <;> fin_cases k <;> + simp only [Matrix.mul_apply, Fin.sum_univ_two, rotationZToAxis_two_apply, + rotationZToAxis_two_inv_apply] <;> + simp [Matrix.one_apply] + +end Lorentz.SL2C + +end diff --git a/Physlib/Relativity/SL2C/Basic.lean b/Physlib/Relativity/SL2C/Basic.lean index 3f7ba29f26..f6a872760f 100644 --- a/Physlib/Relativity/SL2C/Basic.lean +++ b/Physlib/Relativity/SL2C/Basic.lean @@ -203,6 +203,23 @@ lemma toSelfAdjointMap_pauliBasis (i : Fin 1 ⊕ Fin 3) : apply congrArg exact Eq.symm (minkowskiMatrix.dual_apply_minkowskiMatrix ((toLorentzGroup M).1) i j) +/-- The matrix elements of the covering map through the trace pairing: + `L(M)_{i j} = ½ tr (σ'_i · M σ'_j M†)`. -/ +lemma toLorentzGroup_eq_trace (M : SL(2,ℂ)) (i j : Fin 1 ⊕ Fin 3) : + (((toLorentzGroup M).1 i j : ℝ) : ℂ) = + Matrix.trace ((PauliMatrix.pauliSelfAdjoint' i).1 * + (M.1 * (PauliMatrix.pauliSelfAdjoint' j).1 * M.1ᴴ)) / 2 := by + have h := congrArg (fun A : selfAdjoint (Matrix (Fin 2) (Fin 2) ℂ) => + Matrix.trace ((PauliMatrix.pauliSelfAdjoint' i).1 * A.1)) + (toSelfAdjointMap_basis (M := M) j) + simp only [toSelfAdjointMap_apply_coe, PauliMatrix.pauliBasis', + Module.Basis.coe_mk, AddSubmonoidClass.coe_finsetSum, selfAdjoint.val_smul, + Matrix.mul_sum, Matrix.trace_sum, Matrix.mul_smul, Matrix.trace_smul, + PauliMatrix.trace_pauliSelfAdjoint'_mul, smul_ite, smul_zero, Finset.sum_ite_eq, + Finset.mem_univ, if_true] at h + rw [h, real_smul] + ring + /-- The first column of the Lorentz matrix formed from an element of `SL(2, ℂ)`. -/ lemma toLorentzGroup_fst_col (M : SL(2, ℂ)) : (fun μ => (toLorentzGroup M).1 μ (Sum.inl 0)) = fun μ => diff --git a/Physlib/Relativity/Special/TwinParadox/Basic.lean b/Physlib/Relativity/Special/TwinParadox/Basic.lean index a681f7350d..a5760b0c9f 100644 --- a/Physlib/Relativity/Special/TwinParadox/Basic.lean +++ b/Physlib/Relativity/Special/TwinParadox/Basic.lean @@ -79,6 +79,7 @@ informal_lemma ageGap_nonneg where -/ +set_option backward.isDefEq.respectTransparency false in /-- The twin paradox in which: - Twin A starts at `0` and travels at constant speed to `[15, 0, 0, 0]`. @@ -96,7 +97,7 @@ def example1 : InstantaneousTwinParadox where endPoint_causallyFollows_startPoint := by simp [causallyFollows] left - simp only [interiorFutureLightCone, sub_zero, Fin.isValue, Set.mem_setOf_eq, Nat.ofNat_pos, + simp only [interiorFutureLightCone, sub_zero, Fin.isValue, Set.mem_ofPred_eq, Nat.ofNat_pos, and_true] refine (timeLike_iff_norm_sq_pos _).mpr ?_ rw [minkowskiProduct_toCoord] @@ -104,7 +105,7 @@ def example1 : InstantaneousTwinParadox where twinBMid_causallyFollows_startPoint := by simp only [causallyFollows] left - simp only [interiorFutureLightCone, sub_zero, Fin.isValue, Set.mem_setOf_eq] + simp only [interiorFutureLightCone, sub_zero, Fin.isValue, Set.mem_ofPred_eq] norm_num refine (timeLike_iff_norm_sq_pos _).mpr ?_ rw [minkowskiProduct_toCoord] @@ -120,10 +121,12 @@ def example1 : InstantaneousTwinParadox where simp [Fin.sum_univ_three] norm_num +set_option backward.isDefEq.respectTransparency false in @[simp] lemma example1_properTimeTwinA : example1.properTimeTwinA = 15 := by simp [properTimeTwinA, example1, properTime, minkowskiProduct_toCoord] +set_option backward.isDefEq.respectTransparency false in @[simp] lemma example1_properTimeTwinB : example1.properTimeTwinB = 9 := by simp [properTimeTwinB, properTime, example1, minkowskiProduct_toCoord, Fin.sum_univ_three] diff --git a/Physlib/Relativity/SpeedOfLight.lean b/Physlib/Relativity/SpeedOfLight.lean index 5dbb140e3e..1c58820b75 100644 --- a/Physlib/Relativity/SpeedOfLight.lean +++ b/Physlib/Relativity/SpeedOfLight.lean @@ -29,6 +29,7 @@ and should be thought of as the speed of light in some chosen but arbitrary syst ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/Relativity/Tensors/API-map.yaml b/Physlib/Relativity/Tensors/API-map.yaml index e9639a925f..67438323c8 100644 --- a/Physlib/Relativity/Tensors/API-map.yaml +++ b/Physlib/Relativity/Tensors/API-map.yaml @@ -41,7 +41,7 @@ Requirements: - description: "The API contains the type `Tensor` of tensors with a given list of index colors, the type `Pure` of pure tensors, the type `ComponentIdx` of component labels, the passage between a tensor and its components, the component basis, and the identification of rank-zero tensors with the base field." done: true location: | - Physlib/Relativity/Tensors/Basic.lean (Tensor, Pure, Pure.toTensor, Pure.component, Pure.basisVector, Tensor.componentMap, ofComponents, basis, basis_repr_pure, toField); Physlib/Relativity/Tensors/ComponentIdx/Basic.lean (ComponentIdx, ComponentIdx.congr_right, ComponentIdx.cast); Physlib/Relativity/Tensors/ComponentIdx/Single.lean (ComponentIdx.single); Physlib/Relativity/Tensors/ComponentIdx/Product.lean (ComponentIdx.prod); Physlib/Relativity/Tensors/ComponentIdx/Contraction.lean (ComponentIdx.dropPair, ComponentIdx.DropPairSection, ComponentIdx.DropPairSection.ofFinEquiv) + Physlib/Relativity/Tensors/Basic.lean (Tensor, Pure, Pure.toTensor, Pure.component, Pure.basisVector, Tensor.componentMap, ofComponents, basis, basis_repr_pure, toField); Physlib/Relativity/Tensors/ComponentIdx/Basic.lean (ComponentIdx, ComponentIdx.congr_right, ComponentIdx.cast); Physlib/Relativity/Tensors/ComponentIdx/Single.lean (ComponentIdx.single); Physlib/Relativity/Tensors/ComponentIdx/Product.lean (ComponentIdx.prod); Physlib/Relativity/Tensors/ComponentIdx/Contraction.lean (ComponentIdx.dropPair, ComponentIdx.DropPairSection, ComponentIdx.DropPairSection.ofFinEquiv, ComponentIdx.DropPairSection.ofFinEquiv_dropPair) - description: "The API contains the action of the symmetry group on pure tensors and on tensors, the permutation of indices along a color-preserving map, and the notion `IsReindexing` of such a map together with its closure under inverse, composition and the index maps used by products, evaluation and contraction." done: true @@ -55,16 +55,16 @@ Requirements: - description: "The API contains the contraction of a pair of indices of dual color, on pure tensors and on tensors, with its equivariance, its components in the basis, its interaction with permutations and products, and the slot-addressed contraction of one tensor against another in both the result-to-end and result-to-slot conventions." done: true location: | - Physlib/Relativity/Tensors/Contraction/SuccSuccAbove.lean (Fin.succSuccAbove, Fin.predPredAbove, Fin.funPredPredAbove); Physlib/Relativity/Tensors/Contraction/Pure.lean (Pure.dropPair, Pure.contrPCoeff, Pure.contrP, Pure.contrPMultilinear); Physlib/Relativity/Tensors/Contraction/Basic.lean (contrT, contrT_pure, contrT_equivariant, contrT_permT, contrT_symm, contrT_comm); Physlib/Relativity/Tensors/Contraction/Basis.lean (contrT_basis_repr_apply, contrT_basis_repr_apply_eq_sum_fin, contrT_basis); Physlib/Relativity/Tensors/Contraction/Products.lean (prodT_contrT_snd, contrT_prodT_snd, prodT_contrT_fst); Physlib/Relativity/Tensors/Contraction/CrossToEnd.lean (crossToEnd, crossToEnd_two, crossToEnd_equivariant, crossToEnd_assoc_rankTwo, crossToEnd_permT_left, crossToEnd_permT_right); Physlib/Relativity/Tensors/Contraction/CrossToSlot.lean (crossToSlot, crossToSlot_eq_crossToEnd, crossToSlotInv, crossToSlot_equivariant) + Physlib/Relativity/Tensors/Contraction/SuccSuccAbove.lean (Fin.succSuccAbove, Fin.predPredAbove, Fin.funPredPredAbove); Physlib/Relativity/Tensors/Contraction/Pure.lean (Pure.dropPair, Pure.contrPCoeff, Pure.contrP, Pure.contrPMultilinear); Physlib/Relativity/Tensors/Contraction/Basic.lean (contrT, contrT_pure, contrT_equivariant, contrT_permT, contrT_symm, contrT_comm); Physlib/Relativity/Tensors/Contraction/Basis.lean (contrT_basis_repr_apply, contrT_basis_repr_apply_eq_sum_fin, contrT_basis); Physlib/Relativity/Tensors/Contraction/Products.lean (prodT_contrT_snd, contrT_prodT_snd, prodT_contrT_fst); Physlib/Relativity/Tensors/Contraction/CrossToEnd.lean (crossToEnd, crossToEnd_two, crossToEnd_equivariant, crossToEnd_assoc_rankTwo, crossToEnd_permT_left, crossToEnd_permT_right); Physlib/Relativity/Tensors/Contraction/CrossToSlot.lean (crossToSlot, crossToSlot_eq_crossToEnd, crossToSlot_basis_repr_apply, crossToSlotInv, crossToSlot_equivariant); Physlib/Relativity/Tensors/RealTensor/Contraction/CrossToEnd.lean (crossToEnd_basis_repr_apply_eq_fin) - description: "The API contains the unit tensor and the metric tensor of a color, their invariance under the group action, the collapse of a metric contracted against the metric at the dual color, the unit tensor as an identity for slot contraction, and the raising and lowering of a named index as a linear equivalence." done: true location: | - Physlib/Relativity/Tensors/UnitTensor.lean (unitTensor, unitTensor_eq_permT_dual, contrT_single_unitTensor, unitTensor_invariant); Physlib/Relativity/Tensors/MetricTensor.lean (metricTensor, metricTensor_invariant, contrT_metricTensor_metricTensor, contrT_metricTensor_metricTensor_eq_dual_unit); Physlib/Relativity/Tensors/Contraction/UnitTensorContraction.lean (crossToEnd_unitTensor, crossToEnd_round_trip_of_unit_slot, crossToSlot_raise_lower_round_trip, crossToSlotEquiv); Physlib/Relativity/Tensors/Dual.lean (toDualMapAtIndex, fromDualMapAtIndex, toDualMapAtIndex_toDualMapAtIndex, toDualMapAtIndex_equivariant, toDualAtIndex) + Physlib/Relativity/Tensors/UnitTensor.lean (unitTensor, unitTensor_basis_repr, unitTensor_eq_permT_dual, contrT_single_unitTensor, unitTensor_invariant); Physlib/Relativity/Tensors/MetricTensor.lean (metricTensor, metricTensor_basis_repr, metricTensor_invariant, contrT_metricTensor_metricTensor, contrT_metricTensor_metricTensor_eq_dual_unit); Physlib/Relativity/Tensors/Contraction/UnitTensorContraction.lean (crossToEnd_unitTensor, crossToEnd_round_trip_of_unit_slot, crossToSlot_raise_lower_round_trip, crossToSlotEquiv); Physlib/Relativity/Tensors/Dual.lean (toDualMapAtIndex, fromDualMapAtIndex, toDualMapAtIndex_toDualMapAtIndex, toDualMapAtIndex_equivariant, toDualAtIndex) - - description: "The API contains the evaluation of one index of a tensor at a fixed basis label, its components in the basis, its commutation with permutations, contractions and products, and the reconstruction of a tensor as the sum over basis labels of the evaluations of its last index, each tensored with the matching rank-one basis tensor and permuted back into the last slot." + - description: "The API contains the evaluation of one index of a tensor at a fixed basis label, its components in the basis, its commutation with permutations, other evaluations, contractions and products, and the reconstruction of a tensor as the sum over basis labels of the evaluations of its last index, each tensored with the matching rank-one basis tensor and permuted back into the last slot." done: true - location: "Physlib/Relativity/Tensors/Evaluation.lean (Pure.evalPCoeff, Pure.evalP, Pure.evalPMultilinear, evalT, evalT_basis, evalT_permT, contrT_evalT, evalT_prodT_right, eq_sum_evalT, ext_of_evalT)" + location: "Physlib/Relativity/Tensors/Evaluation.lean (Pure.evalPCoeff, Pure.evalP, Pure.evalPMultilinear, evalT, evalT_basis, evalT_permT, evalT_evalT, contrT_evalT, evalT_prodT_right, eq_sum_evalT, ext_of_evalT)" - description: "The API contains explicit constructors of tensors from vectors, from elements of a tensor product of two or three carriers, and from invariant maps, together with tensors specified by integer or rational components in the standard basis." done: true @@ -83,7 +83,7 @@ Requirements: - description: "The API contains the tensor species `realLorentzTensor d` of real Lorentz tensors, with colors `up` and `down`, built from the contravariant and covariant modules, their representations of the Lorentz group, their bases, and the contraction, metric and unit maps; the metric tensors of the species are computed in the standard basis, and the pairwise tensor products of the contravariant and covariant modules are identified with square matrices." done: true location: | - Physlib/Relativity/Tensors/RealTensor/Basic.lean (realLorentzTensor, realLorentzTensor.Color, τ_up_eq_down, τ_down_eq_up, contrPCoeff_basis, contrT_eq_sum_evalT, contrT_toField); Physlib/Relativity/Tensors/RealTensor/Vector/Pre/Modules.lean (ContrMod, CoMod, AddCommGroup (ContrMod d), Module ℝ (ContrMod d), AddCommGroup (CoMod d), Module ℝ (CoMod d), ContrMod.rep, CoMod.rep, ContrMod.stdBasis, CoMod.stdBasis); Physlib/Relativity/Tensors/RealTensor/Vector/Pre/Basic.lean (contrBasis, coBasis, contrIsoCo); Physlib/Relativity/Tensors/RealTensor/Vector/Pre/Contraction.lean (contrCoContract, coContrContract, contrContrContractField); Physlib/Relativity/Tensors/RealTensor/Metrics/Pre.lean (preContrMetric, preCoMetric); Physlib/Relativity/Tensors/RealTensor/Units/Pre.lean (preContrCoUnit, preCoContrUnit); Physlib/Relativity/Tensors/RealTensor/Metrics/Basic.lean (coMetric, contrMetric, actionT_coMetric, actionT_contrMetric, coMetric_repr_apply_eq_minkowskiMatrix, contrMetric_repr_apply_eq_minkowskiMatrix); Physlib/Relativity/Tensors/RealTensor/Matrix/Pre.lean (contrContrToMatrixRe, coCoToMatrixRe, contrCoToMatrixRe, coContrToMatrixRe) + Physlib/Relativity/Tensors/RealTensor/Basic.lean (realLorentzTensor, realLorentzTensor.Color, τ_up_eq_down, τ_down_eq_up, contrPCoeff_basis, contrT_eq_sum_evalT, contrT_toField); Physlib/Relativity/Tensors/RealTensor/Vector/Pre/Modules.lean (ContrMod, CoMod, AddCommGroup (ContrMod d), Module ℝ (ContrMod d), AddCommGroup (CoMod d), Module ℝ (CoMod d), ContrMod.rep, CoMod.rep, ContrMod.stdBasis, CoMod.stdBasis); Physlib/Relativity/Tensors/RealTensor/Vector/Pre/Basic.lean (contrBasis, coBasis, contrIsoCo); Physlib/Relativity/Tensors/RealTensor/Vector/Pre/Contraction.lean (contrCoContract, coContrContract, contrContrContractField); Physlib/Relativity/Tensors/RealTensor/Metrics/Pre.lean (preContrMetric, preCoMetric); Physlib/Relativity/Tensors/RealTensor/Units/Pre.lean (preContrCoUnit, preCoContrUnit); Physlib/Relativity/Tensors/RealTensor/Metrics/Basic.lean (coMetric, contrMetric, actionT_coMetric, actionT_contrMetric, coMetric_repr_apply_eq_minkowskiMatrix, contrMetric_repr_apply_eq_minkowskiMatrix, metricTensor_repr_apply_eq_minkowskiMatrix, toDualMapAtIndex_basis_repr_apply, toDualMapAtIndex_basis_repr_apply_eq_mul); Physlib/Relativity/Tensors/RealTensor/Units/Basic.lean (unitTensor_repr_apply); Physlib/Relativity/Tensors/RealTensor/Matrix/Pre.lean (contrContrToMatrixRe, coCoToMatrixRe, contrCoToMatrixRe, coContrToMatrixRe) - description: "The API contains Lorentz vectors and covectors as functions on `Fin 1 ⊕ Fin d`, with their module, norm and inner-product structures, their charted-space structures, their standard bases, their representations of the Lorentz group, their tensorial instances and the invariant contraction between them, together with the coordinate maps and the time and spatial parts of a vector, and the model with corners under which vectors are treated as a manifold." done: true @@ -98,12 +98,12 @@ Requirements: - description: "The API contains the rank-four Levi-Civita tensor as a real Lorentz tensor in three spatial dimensions, its components in the standard basis as a Levi-Civita symbol, its antisymmetry under each adjacent transposition of indices, and the epsilon-epsilon contraction identities at the level of the Euclidean Levi-Civita symbol, summed over all four index slots, over the last three, and over the last two." done: true location: | - Physlib/Relativity/Tensors/LeviCivita/Basic.lean (leviCivita, notation ε4, euclidLeviCivita, leviCivita_basis_repr_apply, leviCivita_basis_repr_eq_leviCivitaSymbol, leviCivita_antisymm, leviCivita_antisymm_mid, leviCivita_antisymm_last); Physlib/Relativity/Tensors/LeviCivita/Contractions.lean (euclidLeviCivita_symbol_contract_zero, euclidLeviCivita_symbol_contract_one, euclidLeviCivita_symbol_contract_two) + Physlib/Relativity/Tensors/LeviCivita/Basic.lean (leviCivita, notation ε4, euclidLeviCivita, leviCivita_basis_repr_apply, leviCivita_basis_repr_eq_leviCivitaSymbol, leviCivita_antisymm, leviCivita_antisymm_mid, leviCivita_antisymm_last); Physlib/Relativity/Tensors/LeviCivita/Contractions.lean (euclidLeviCivita_symbol_contract_zero, euclidLeviCivita_symbol_contract_one, euclidLeviCivita_symbol_contract_one_last, euclidLeviCivita_symbol_contract_two, leviCivita_lowered_basis_repr_apply, leviCivita_basis_contract_self, leviCivita_basis_contract_three, leviCivita_contract_three_basis_repr_apply, leviCivita_contract_self_eq_sum, leviCivita_contract_self, leviCivita_contract_three) - description: "The API contains the tensor species `complexLorentzTensor` of complex Lorentz tensors, with the left- and right-handed Weyl colors, their duals and the two Lorentz vector colors over SL(2, ℂ), together with the metric and unit tensors of each color in several equivalent forms and the identification of pairwise products of complex Lorentz vectors with matrices." done: true location: | - Physlib/Relativity/Tensors/ComplexTensor/Basic.lean (complexLorentzTensor, complexLorentzTensor.Color, repDim, basis, rep, contrPCoeff_basis); Physlib/Relativity/Tensors/ComplexTensor/Vector/Pre/Modules.lean (ContrℂModule, CoℂModule, ContrℂModule.SL2CRep, CoℂModule.SL2CRep); Physlib/Relativity/Tensors/ComplexTensor/Vector/Pre/Contraction.lean (contrCoContraction, coContrContraction); Physlib/Relativity/Tensors/ComplexTensor/Metrics/Basic.lean (coMetric, contrMetric, leftMetric, rightMetric, dualLeftMetric, dualRightMetric, coMetric_eq_ofRat, leftMetric_eq_ofRat); Physlib/Relativity/Tensors/ComplexTensor/Units/Basic.lean (coContrUnit, contrCoUnit, dualLeftLeftUnit, leftDualLeftUnit, dualRightRightUnit, rightDualRightUnit); Physlib/Relativity/Tensors/ComplexTensor/Units/Symm.lean (coContrUnit_symm, dualLeftLeftUnit_symm); Physlib/Relativity/Tensors/ComplexTensor/Matrix/Pre.lean (contrContrToMatrix, coCoToMatrix, contrCoToMatrix, coContrToMatrix); Physlib/Relativity/Tensors/ComplexTensor/Lemmas.lean (antiSymm_contr_symm) + Physlib/Relativity/Tensors/ComplexTensor/Basic.lean (complexLorentzTensor, complexLorentzTensor.Color, repDim, basis, rep, contrPCoeff_basis); Physlib/Relativity/Tensors/ComplexTensor/Vector/Pre/Modules.lean (ContrℂModule, CoℂModule, ContrℂModule.SL2CRep, CoℂModule.SL2CRep); Physlib/Relativity/Tensors/ComplexTensor/Vector/Pre/Contraction.lean (contrCoContraction, coContrContraction); Physlib/Relativity/Tensors/ComplexTensor/Metrics/Basic.lean (coMetric, contrMetric, leftMetric, rightMetric, dualLeftMetric, dualRightMetric, coMetric_eq_ofRat, leftMetric_eq_ofRat); Physlib/Relativity/Tensors/ComplexTensor/Units/Basic.lean (coContrUnit, contrCoUnit, dualLeftLeftUnit, leftDualLeftUnit, dualRightRightUnit, rightDualRightUnit); Physlib/Relativity/Tensors/ComplexTensor/Units/Symm.lean (coContrUnit_symm, dualLeftLeftUnit_symm); Physlib/Relativity/Tensors/ComplexTensor/Matrix/Pre.lean (contrContrToMatrix, coCoToMatrix, contrCoToMatrix, coContrToMatrix); Physlib/Relativity/Tensors/ComplexTensor/Lemmas.lean (antiSymm_contr_symm); Physlib/Relativity/Tensors/LeviCivita/Complex.lean (leviCivita, notation ε4ℂ, leviCivita_eq_ofRat) - description: "The API contains a canonical injective semilinear map from real Lorentz tensors to complex Lorentz tensors, equivariant for the complexified Lorentz group and commuting with permutations, products, contractions and evaluations of indices." done: true @@ -121,9 +121,9 @@ Requirements: done: false location: N/A - - description: "The tensor-level epsilon-epsilon identities for the Levi-Civita tensor: contracting it with itself over all four index pairs gives the field element `-24`, and contracting it with itself over the first three gives `-6` times the unit tensor of color `down`. Stated as `leviCivita_contract_self` and `leviCivita_contract_three`, both carrying the repository's marker for a result that is not yet proved." - done: false - location: N/A + - description: "The tensor-level epsilon-epsilon identities for the Levi-Civita tensor: contracting it with itself over all four index pairs gives the field element `-24`, and contracting it with itself over the first three gives `-6` times the unit tensor of color `down`." + done: true + location: "Physlib/Relativity/Tensors/LeviCivita/Contractions.lean (leviCivita_lowered_basis_repr_apply, leviCivita_contract_self, leviCivita_contract_three); Physlib/Relativity/Tensors/RealTensor/Metrics/Basic.lean (toDualMapAtIndex_basis_repr_apply, toDualMapAtIndex_basis_repr_apply_eq_mul); Physlib/Relativity/Tensors/RealTensor/Units/Basic.lean (unitTensor_repr_apply)" - description: "The API shall contain a Euclidean Levi-Civita tensor to carry the epsilon-epsilon contraction identities, which at present are stated for the Euclidean Levi-Civita symbol `euclidLeviCivita` alone." done: false diff --git a/Physlib/Relativity/Tensors/Basic.lean b/Physlib/Relativity/Tensors/Basic.lean index 2b73a5e67a..eced9f4894 100644 --- a/Physlib/Relativity/Tensors/Basic.lean +++ b/Physlib/Relativity/Tensors/Basic.lean @@ -426,13 +426,16 @@ end Pure -/ -noncomputable instance : SMul G (S.Tensor c) where +/- The action on `S.Tensor c` is given priority above `Tensorial.smulAction` (which has + `priority := high` so that it beats Mathlib's left action on tensor products), so that for a + bare tensor `g • t` elaborates to this instance, as used in the `*_equivariant` lemmas. -/ +noncomputable instance (priority := high + 1) instSMul : SMul G (S.Tensor c) where smul g t := PiTensorProduct.map (fun i => rep (c i) g) t lemma actionT_eq {g : G} {t : S.Tensor c} : g • t = PiTensorProduct.map (fun i => rep (c i) g) t := rfl -noncomputable instance actionT : MulAction G (S.Tensor c) where +noncomputable instance (priority := high + 1) actionT : MulAction G (S.Tensor c) where one_smul t := by simp [actionT_eq] mul_smul g g' t := by @@ -464,10 +467,16 @@ lemma actionT_neg {g : G} {t : S.Tensor c} : simp only [map_neg, neg_inj] rfl -noncomputable instance : DistribMulAction G (S.Tensor c) where +noncomputable instance (priority := high + 1) : DistribMulAction G (S.Tensor c) where smul_zero g := by simp [actionT_zero] smul_add g t1 t2 := by simp [actionT_add] +instance : SMulCommClass k G (S.Tensor c) where + smul_comm _ _ _ := actionT_smul.symm + +-- `SMulCommClass.symm` is not registered as an instance, as it would cause a loop +instance : SMulCommClass G k (S.Tensor c) := SMulCommClass.symm _ _ _ + /-! @@ -515,7 +524,6 @@ lemma permT_pure {n m : ℕ} {c : Fin n → C} {c1 : Fin m → C} PiTensorProduct.reindex_tprod, PiTensorProduct.map_tprod] rfl -set_option backward.isDefEq.respectTransparency false in @[simp] lemma Pure.permP_id_self {n : ℕ} {c : Fin n → C} (p : Pure S c) : Pure.permP (id : Fin n → Fin n) (by simp : IsReindexing c c id) p = p := by @@ -567,7 +575,6 @@ lemma permT_congr {n m : ℕ} {c : Fin n → C} {c1 : Fin m → C} subst hmap htensor rfl -set_option backward.isDefEq.respectTransparency false in @[simp] lemma Pure.permP_permP {n m1 m2 : ℕ} {c : Fin n → C} {c1 : Fin m1 → C} {c2 : Fin m2 → C} {σ : Fin m1 → Fin n} {σ2 : Fin m2 → Fin m1} (h : IsReindexing c c1 σ) diff --git a/Physlib/Relativity/Tensors/ComplexTensor/Basic.lean b/Physlib/Relativity/Tensors/ComplexTensor/Basic.lean index 153a3c17c6..5d798fa1c9 100644 --- a/Physlib/Relativity/Tensors/ComplexTensor/Basic.lean +++ b/Physlib/Relativity/Tensors/ComplexTensor/Basic.lean @@ -22,6 +22,7 @@ open TensorProduct namespace complexLorentzTensor +set_option backward.isDefEq.respectTransparency false in /-- The colors associated with complex representations of SL(2, ℂ) of interest to physics. -/ inductive Color /-- The color associated with Left handed fermions. -/ @@ -284,7 +285,7 @@ lemma contrPCoeff_basis {n : ℕ} {c : Fin n → complexLorentzTensor.Color} (i generalize c j = cj at * subst h2 cases ci - all_goals simp only [complexLorentzTensor, Fin.cast_refl, id_eq] + all_goals simp only [complexLorentzTensor] · erw [Fermion.leftDualContraction_basis] exact if_congr Fin.ext_iff.symm rfl rfl · erw [Fermion.dualLeftContraction_basis] diff --git a/Physlib/Relativity/Tensors/ComplexTensor/Matrix/Pre.lean b/Physlib/Relativity/Tensors/ComplexTensor/Matrix/Pre.lean index d0175eb439..cd70c45df4 100644 --- a/Physlib/Relativity/Tensors/ComplexTensor/Matrix/Pre.lean +++ b/Physlib/Relativity/Tensors/ComplexTensor/Matrix/Pre.lean @@ -30,6 +30,7 @@ def contrContrToMatrix : (ContrℂModule ⊗[ℂ] ContrℂModule) ≃ₗ[ℂ] Finsupp.linearEquivFunOnFinite ℂ ℂ ((Fin 1 ⊕ Fin 3) × (Fin 1 ⊕ Fin 3)) ≪≫ₗ LinearEquiv.curry ℂ ℂ (Fin 1 ⊕ Fin 3) (Fin 1 ⊕ Fin 3) +set_option backward.isDefEq.respectTransparency false in /-- Expanding `contrContrToMatrix` in terms of the standard basis. -/ lemma contrContrToMatrix_symm_expand_tmul (M : Matrix (Fin 1 ⊕ Fin 3) (Fin 1 ⊕ Fin 3) ℂ) : contrContrToMatrix.symm M = @@ -49,6 +50,7 @@ def coCoToMatrix : (CoℂModule ⊗[ℂ] CoℂModule) ≃ₗ[ℂ] Finsupp.linearEquivFunOnFinite ℂ ℂ ((Fin 1 ⊕ Fin 3) × (Fin 1 ⊕ Fin 3)) ≪≫ₗ LinearEquiv.curry ℂ ℂ (Fin 1 ⊕ Fin 3) (Fin 1 ⊕ Fin 3) +set_option backward.isDefEq.respectTransparency false in /-- Expanding `coCoToMatrix` in terms of the standard basis. -/ lemma coCoToMatrix_symm_expand_tmul (M : Matrix (Fin 1 ⊕ Fin 3) (Fin 1 ⊕ Fin 3) ℂ) : coCoToMatrix.symm M = ∑ i, ∑ j, M i j • (complexCoBasis i ⊗ₜ[ℂ] complexCoBasis j) := by @@ -66,6 +68,7 @@ def contrCoToMatrix : (ContrℂModule ⊗[ℂ] CoℂModule) ≃ₗ[ℂ] Finsupp.linearEquivFunOnFinite ℂ ℂ ((Fin 1 ⊕ Fin 3) × (Fin 1 ⊕ Fin 3)) ≪≫ₗ LinearEquiv.curry ℂ ℂ (Fin 1 ⊕ Fin 3) (Fin 1 ⊕ Fin 3) +set_option backward.isDefEq.respectTransparency false in /-- Expansion of `contrCoToMatrix` in terms of the standard basis. -/ lemma contrCoToMatrix_symm_expand_tmul (M : Matrix (Fin 1 ⊕ Fin 3) (Fin 1 ⊕ Fin 3) ℂ) : contrCoToMatrix.symm M = ∑ i, ∑ j, M i j • (complexContrBasis i ⊗ₜ[ℂ] complexCoBasis j) := by @@ -84,6 +87,7 @@ def coContrToMatrix : (CoℂModule ⊗[ℂ] ContrℂModule) ≃ₗ[ℂ] Finsupp.linearEquivFunOnFinite ℂ ℂ ((Fin 1 ⊕ Fin 3) × (Fin 1 ⊕ Fin 3)) ≪≫ₗ LinearEquiv.curry ℂ ℂ (Fin 1 ⊕ Fin 3) (Fin 1 ⊕ Fin 3) +set_option backward.isDefEq.respectTransparency false in /-- Expansion of `coContrToMatrix` in terms of the standard basis. -/ lemma coContrToMatrix_symm_expand_tmul (M : Matrix (Fin 1 ⊕ Fin 3) (Fin 1 ⊕ Fin 3) ℂ) : coContrToMatrix.symm M = ∑ i, ∑ j, M i j • (complexCoBasis i ⊗ₜ[ℂ] complexContrBasis j) := by diff --git a/Physlib/Relativity/Tensors/ComplexTensor/Metrics/Basic.lean b/Physlib/Relativity/Tensors/ComplexTensor/Metrics/Basic.lean index e1cb5a8735..a8e043342d 100644 --- a/Physlib/Relativity/Tensors/ComplexTensor/Metrics/Basic.lean +++ b/Physlib/Relativity/Tensors/ComplexTensor/Metrics/Basic.lean @@ -364,6 +364,7 @@ lemma dualRightMetric_eq_basis : εR' = -/ +set_option backward.isDefEq.respectTransparency false in lemma coMetric_eq_ofRat : η' = ofRat fun f => if f 0 = Fin.cast (by rfl) (0 : Fin 4) ∧ f 1 = Fin.cast (by rfl) (0 : Fin 4) then 1 else if f 0 = f 1 then - 1 else 0 := by @@ -374,6 +375,7 @@ lemma coMetric_eq_ofRat : η' = ofRat fun f => congr with_unfolding_all decide +set_option backward.isDefEq.respectTransparency false in lemma contrMetric_eq_ofRat : η = ofRat fun f => if f 0 = Fin.cast (by rfl) (0 : Fin 4) ∧ f 1 = Fin.cast (by rfl) (0 : Fin 4) then 1 else if f 0 = f 1 then - 1 else 0 := by @@ -435,32 +437,26 @@ lemma dualRightMetric_eq_ofRat : εR' = ofRat fun f => open TensorSpecies -set_option backward.isDefEq.respectTransparency false in /-- The tensor `coMetric` is invariant under the action of `SL(2,ℂ)`. -/ lemma actionT_coMetric (g : SL(2,ℂ)) : g • η' = η' := by rw [metricTensor_invariant] -set_option backward.isDefEq.respectTransparency false in /-- The tensor `contrMetric` is invariant under the action of `SL(2,ℂ)`. -/ lemma actionT_contrMetric (g : SL(2,ℂ)) : g • η = η := by rw [metricTensor_invariant] -set_option backward.isDefEq.respectTransparency false in /-- The tensor `leftMetric` is invariant under the action of `SL(2,ℂ)`. -/ lemma actionT_leftMetric (g : SL(2,ℂ)) : g • εL = εL := by rw [metricTensor_invariant] -set_option backward.isDefEq.respectTransparency false in /-- The tensor `rightMetric` is invariant under the action of `SL(2,ℂ)`. -/ lemma actionT_rightMetric (g : SL(2,ℂ)) : g • εR = εR := by rw [metricTensor_invariant] -set_option backward.isDefEq.respectTransparency false in /-- The tensor `dualLeftMetric` is invariant under the action of `SL(2,ℂ)`. -/ lemma actionT_dualLeftMetric (g : SL(2,ℂ)) : g • εL' = εL' := by rw [metricTensor_invariant] -set_option backward.isDefEq.respectTransparency false in /-- The tensor `dualRightMetric` is invariant under the action of `SL(2,ℂ)`. -/ lemma actionT_dualRightMetric (g : SL(2,ℂ)) : g • εR' = εR' := by rw [metricTensor_invariant] diff --git a/Physlib/Relativity/Tensors/ComplexTensor/Metrics/Pre.lean b/Physlib/Relativity/Tensors/ComplexTensor/Metrics/Pre.lean index 0be7cec119..b830d64093 100644 --- a/Physlib/Relativity/Tensors/ComplexTensor/Metrics/Pre.lean +++ b/Physlib/Relativity/Tensors/ComplexTensor/Metrics/Pre.lean @@ -27,7 +27,6 @@ namespace Lorentz def contrMetricVal : (ContrℂModule ⊗[ℂ] ContrℂModule) := contrContrToMatrix.symm ((@minkowskiMatrix 3).map ofRealHom) -set_option backward.isDefEq.respectTransparency false in /-- The expansion of `contrMetricVal` into basis vectors. -/ lemma contrMetricVal_expand_tmul : contrMetricVal = complexContrBasis (Sum.inl 0) ⊗ₜ[ℂ] complexContrBasis (Sum.inl 0) @@ -77,7 +76,6 @@ lemma contrMetric_apply_one : contrMetric (1 : ℂ) = contrMetricVal := by def coMetricVal : (CoℂModule ⊗[ℂ] CoℂModule) := coCoToMatrix.symm ((@minkowskiMatrix 3).map ofRealHom) -set_option backward.isDefEq.respectTransparency false in /-- The expansion of `coMetricVal` into basis vectors. -/ lemma coMetricVal_expand_tmul : coMetricVal = complexCoBasis (Sum.inl 0) ⊗ₜ[ℂ] complexCoBasis (Sum.inl 0) diff --git a/Physlib/Relativity/Tensors/ComplexTensor/OfRat.lean b/Physlib/Relativity/Tensors/ComplexTensor/OfRat.lean index b9c9c9ef0a..2cd33676de 100644 --- a/Physlib/Relativity/Tensors/ComplexTensor/OfRat.lean +++ b/Physlib/Relativity/Tensors/ComplexTensor/OfRat.lean @@ -67,6 +67,7 @@ lemma basis_eq_ofRat {n : ℕ} {c : Fin n → complexLorentzTensor.Color} simp only [Rat.cast_one, Rat.cast_zero, zero_mul, add_zero] simp +set_option backward.isDefEq.respectTransparency false in lemma contr_basis_ratComplexNum {c : complexLorentzTensor.Color} (i : Fin (complexLorentzTensor.repDim c)) (j : Fin (complexLorentzTensor.repDim (complexLorentzTensor.τ c))) : diff --git a/Physlib/Relativity/Tensors/ComplexTensor/Units/Basic.lean b/Physlib/Relativity/Tensors/ComplexTensor/Units/Basic.lean index e24c59d2a3..b420b58ccf 100644 --- a/Physlib/Relativity/Tensors/ComplexTensor/Units/Basic.lean +++ b/Physlib/Relativity/Tensors/ComplexTensor/Units/Basic.lean @@ -278,6 +278,7 @@ lemma rightDualRightUnit_eq_tensor_basis : δR = -/ +set_option backward.isDefEq.respectTransparency false in lemma coContrUnit_eq_ofRat : δ' = ofRat fun f => if f 0 = f 1 then 1 else 0 := by rw [coContrUnit_eq_basis] @@ -288,6 +289,7 @@ lemma coContrUnit_eq_ofRat : δ' = ofRat fun f => congr with_unfolding_all decide +set_option backward.isDefEq.respectTransparency false in lemma contrCoUnit_eq_ofRat : δ = ofRat fun f => if f 0 = f 1 then 1 else 0 := by rw [contrCoUnit_eq_basis] @@ -298,6 +300,7 @@ lemma contrCoUnit_eq_ofRat : δ = ofRat fun f => congr with_unfolding_all decide +set_option backward.isDefEq.respectTransparency false in lemma dualLeftLeftUnit_eq_ofRat : δL' = ofRat fun f => if f 0 = f 1 then 1 else 0 := by rw [dualLeftLeftUnit_eq_tensor_basis] @@ -308,6 +311,7 @@ lemma dualLeftLeftUnit_eq_ofRat : δL' = ofRat fun f => congr with_unfolding_all decide +set_option backward.isDefEq.respectTransparency false in lemma leftDualLeftUnit_eq_ofRat : δL = ofRat fun f => if f 0 = f 1 then 1 else 0 := by rw [leftDualLeftUnit_eq_tensor_basis] @@ -318,6 +322,7 @@ lemma leftDualLeftUnit_eq_ofRat : δL = ofRat fun f => congr with_unfolding_all decide +set_option backward.isDefEq.respectTransparency false in lemma dualRightRightUnit_eq_ofRat : δR' = ofRat fun f => if f 0 = f 1 then 1 else 0 := by rw [dualRightRightUnit_eq_tensor_basis] @@ -328,6 +333,7 @@ lemma dualRightRightUnit_eq_ofRat : δR' = ofRat fun f => congr with_unfolding_all decide +set_option backward.isDefEq.respectTransparency false in lemma rightDualRightUnit_eq_ofRat : δR = ofRat fun f => if f 0 = f 1 then 1 else 0 := by rw [rightDualRightUnit_eq_tensor_basis] diff --git a/Physlib/Relativity/Tensors/ComponentIdx/Basic.lean b/Physlib/Relativity/Tensors/ComponentIdx/Basic.lean index 0dc461f994..a238cb8269 100644 --- a/Physlib/Relativity/Tensors/ComponentIdx/Basic.lean +++ b/Physlib/Relativity/Tensors/ComponentIdx/Basic.lean @@ -33,8 +33,7 @@ component indices induced by tensor products and contractions live in sibling fi ## iv. References -There are no known references for the material in this module. - +* None. -/ @[expose] public section diff --git a/Physlib/Relativity/Tensors/ComponentIdx/Contraction.lean b/Physlib/Relativity/Tensors/ComponentIdx/Contraction.lean index b09c2f539b..2b3ab25495 100644 --- a/Physlib/Relativity/Tensors/ComponentIdx/Contraction.lean +++ b/Physlib/Relativity/Tensors/ComponentIdx/Contraction.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joseph Tooby-Smith +Authors: Robert Sneiderman, Joseph Tooby-Smith -/ module @@ -36,8 +36,7 @@ component choices at the contracted positions. ## iv. References -There are no known references for the material in this module. - +* None. -/ @[expose] public section @@ -180,6 +179,15 @@ lemma ofFinEquiv_apply_snd {n : ℕ} {c : Fin (n + 1 + 1) → C} (ofFinEquiv (S := S) hij b x).1 j = x.2 := by simp [ofFinEquiv] +/-- Restoring the two entries dropped from a component index recovers that component index. -/ +@[simp] +lemma ofFinEquiv_dropPair {n : ℕ} {c : Fin (n + 1 + 1) → C} + {i j : Fin (n + 1 + 1)} (hij : i ≠ j) (r : ComponentIdx (S := S) c) : + (ofFinEquiv (S := S) hij (r.dropPair i j) (r i, r j)).1 = r := by + exact congrArg Subtype.val <| + (ofFinEquiv (S := S) hij (r.dropPair i j)).apply_symm_apply + ⟨r, mem_self_of_dropPair r⟩ + end DropPairSection end ComponentIdx diff --git a/Physlib/Relativity/Tensors/ComponentIdx/Product.lean b/Physlib/Relativity/Tensors/ComponentIdx/Product.lean index 60f2d2dde4..e91dca52ec 100644 --- a/Physlib/Relativity/Tensors/ComponentIdx/Product.lean +++ b/Physlib/Relativity/Tensors/ComponentIdx/Product.lean @@ -28,8 +28,7 @@ of component indices for each side of the append. ## iv. References -There are no known references for the material in this module. - +* None. -/ @[expose] public section diff --git a/Physlib/Relativity/Tensors/ComponentIdx/Single.lean b/Physlib/Relativity/Tensors/ComponentIdx/Single.lean index cb521a7ada..344b0eed84 100644 --- a/Physlib/Relativity/Tensors/ComponentIdx/Single.lean +++ b/Physlib/Relativity/Tensors/ComponentIdx/Single.lean @@ -29,8 +29,7 @@ color and the basis indices of that color. ## iv. References -There are no known references for the material in this module. - +* None. -/ @[expose] public section diff --git a/Physlib/Relativity/Tensors/Constructors.lean b/Physlib/Relativity/Tensors/Constructors.lean index b7d4acba0d..0b526f01ed 100644 --- a/Physlib/Relativity/Tensors/Constructors.lean +++ b/Physlib/Relativity/Tensors/Constructors.lean @@ -128,6 +128,7 @@ lemma fromPairT_tmul {c1 c2 : C} (x : V c1) (prodT (fromSingleT (S := S) x) (fromSingleT y)) := by rfl +set_option backward.isDefEq.respectTransparency false in lemma fromPairT_eq_pure {c1 c2 : C} (x : V c1) (y : V c2) : fromPairT (S := S) (x ⊗ₜ[k] y) = Pure.toTensor (fun | 0 => x | 1 => y) := by rw [fromPairT_tmul, fromSingleT_eq_pureT, fromSingleT_eq_pureT, prodT_pure, permT_pure] @@ -135,6 +136,7 @@ lemma fromPairT_eq_pure {c1 c2 : C} (x : V c1) (y : V c2) : funext i fin_cases i <;> rfl +set_option backward.isDefEq.respectTransparency false in lemma actionT_fromPairT {c1 c2 : C} (x : V c1 ⊗[k]V c2) (g : G) : @@ -149,6 +151,7 @@ lemma actionT_fromPairT {c1 c2 : C} rfl | add x y hx hy => simp [hx, hy] +set_option backward.isDefEq.respectTransparency false in lemma fromPairT_map_right {c1 c2 c2' : C} (h :c2 = c2') (x : V c1 ⊗[k] V c2) : fromPairT (TensorProduct.map LinearMap.id @@ -166,6 +169,7 @@ lemma fromPairT_map_right {c1 c2 c2' : C} (h :c2 = c2') exact List.ofFn_inj.mp rfl · simp [h1, h2] +set_option backward.isDefEq.respectTransparency false in lemma fromPairT_comm {c1 c2 : C} (x : V c1 ⊗[k] V c2) : fromPairT (TensorProduct.comm k _ _ x) = @@ -203,6 +207,7 @@ lemma fromSingleTContrFromPairT_tmul {c c2 : C} S.contr c (x ⊗ₜ[k] y1) • fromSingleT y2 := by simp [fromSingleTContrFromPairT] +set_option backward.isDefEq.respectTransparency false in lemma fromSingleT_contr_fromPairT_tmul {c c2 : C} (x : V c) (y1 : V (S.τ c)) (y2 : V c2) : contrT 1 0 1 (by simp; rfl) @@ -327,6 +332,7 @@ lemma fromPairT_contr_fromPairT_eq_fromPairTContr (c c1 c2 : C) rw [← ha, ← hb] simp +set_option backward.isDefEq.respectTransparency false in lemma fromPairT_basis_repr {c c1 : C} (x : V c ⊗[k] V c1) (φ : ComponentIdx ![c, c1]) : @@ -349,6 +355,7 @@ lemma fromPairT_basis_repr {c c1 : C} rfl | add x y hx hy => simp_all +set_option backward.isDefEq.respectTransparency false in lemma fromPairT_apply_basis_repr {c c1 : C} (b0 : basisIdx c) (b1 : basisIdx c1) : fromPairT (S := S) (b c b0 ⊗ₜ[k] b c1 b1) = @@ -419,6 +426,7 @@ lemma fromTripleT_tmul {c1 c2 c3 : C} (x : V c1) (prodT (fromSingleT (S := S) x) (prodT (fromSingleT y) (fromSingleT z))) := by rfl +set_option backward.isDefEq.respectTransparency false in lemma actionT_fromTripleT {c1 c2 c3 : C} (x : V c1 ⊗[k] (V c2 ⊗[k] V c3)) (g : G) : g • fromTripleT (S := S) x = fromTripleT (TensorProduct.map (rep c1 g) @@ -436,6 +444,7 @@ lemma actionT_fromTripleT {c1 c2 c3 : C} | add a b ha hb => simp [ha, hb, tmul_add] | add a b ha hb => simp [ha, hb] +set_option backward.isDefEq.respectTransparency false in lemma fromTripleT_basis_repr {c c1 c2 : C} (x : V c ⊗[k] (V c1 ⊗[k] V c2)) (φ : ComponentIdx ![c, c1, c2]) : @@ -469,6 +478,7 @@ lemma fromTripleT_basis_repr {c c1 c2 : C} rw [hx, hy] | add a b ha hb => simp_all +set_option backward.isDefEq.respectTransparency false in lemma fromTripleT_apply_basis {c c1 c2 : C} (b0 : basisIdx c) (b1 : basisIdx c1) (b2 : basisIdx c2) : diff --git a/Physlib/Relativity/Tensors/Contraction/Basic.lean b/Physlib/Relativity/Tensors/Contraction/Basic.lean index a6e6e03e89..cfbfee573a 100644 --- a/Physlib/Relativity/Tensors/Contraction/Basic.lean +++ b/Physlib/Relativity/Tensors/Contraction/Basic.lean @@ -78,7 +78,7 @@ open Fin -/ -open Pure +open _root_.TensorSpecies.Tensor.Pure lemma contrT_decide {n : ℕ} {c : Fin (n + 1 + 1) → C} {i j : Fin (n + 1 + 1)} (hx : S.τ (c i) = c j) (hij : i ≠ j := by decide) : diff --git a/Physlib/Relativity/Tensors/Contraction/Basis.lean b/Physlib/Relativity/Tensors/Contraction/Basis.lean index 164dcab2c2..914a3511af 100644 --- a/Physlib/Relativity/Tensors/Contraction/Basis.lean +++ b/Physlib/Relativity/Tensors/Contraction/Basis.lean @@ -29,7 +29,6 @@ namespace Tensor open ComponentIdx -set_option backward.isDefEq.respectTransparency false in lemma Pure.dropPair_basisVector {n : ℕ} {c : Fin (n + 1 + 1) → C} {i j : Fin (n + 1 + 1)} (hij : i ≠ j) (b : ComponentIdx c) : Pure.dropPair i j hij (basisVector c b) = diff --git a/Physlib/Relativity/Tensors/Contraction/CrossToEnd.lean b/Physlib/Relativity/Tensors/Contraction/CrossToEnd.lean index 2878a66b6a..a0ca001a61 100644 --- a/Physlib/Relativity/Tensors/Contraction/CrossToEnd.lean +++ b/Physlib/Relativity/Tensors/Contraction/CrossToEnd.lean @@ -49,6 +49,7 @@ The complementary convention keeps the replacement index in place. Contracting s ## iv. References +* None. -/ @[expose] public section @@ -100,6 +101,7 @@ noncomputable def crossToEnd {nA nB : ℕ} {cA : Fin (nA + 1) → C} {cB : Fin ( permT (Fin.cast (show (nA + nB) + 1 + 1 = (nA + 1) + (nB + 1) by omega)) (IsReindexing.fin_cast_isReindexing _ _ (by omega)) +set_option backward.isDefEq.respectTransparency false in /-- Cross-contracting the last slot of a rank-2 tensor `A` with the `0`-slot of a rank-2 tensor `B` is a plain `contrT` of their product on the middle slots `1, 2`, up to a color recast. Discharging the slot arithmetic once lets a `contrT`-level identity lift to `crossToEnd` by one rewrite. -/ diff --git a/Physlib/Relativity/Tensors/Contraction/CrossToSlot.lean b/Physlib/Relativity/Tensors/Contraction/CrossToSlot.lean index c91c257638..0a5bc790fa 100644 --- a/Physlib/Relativity/Tensors/Contraction/CrossToSlot.lean +++ b/Physlib/Relativity/Tensors/Contraction/CrossToSlot.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2026 Andrea Pari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Andrea Pari +Authors: Andrea Pari, Robert Sneiderman -/ module @@ -27,6 +27,8 @@ operation live with the unit-tensor collapse theory in - `TensorSpecies.Tensor.crossToSlot` : contract slot `i` against slot `j` of a rank-2 tensor and rotate the survivor back into position `i`; raising and lowering a named index. - `TensorSpecies.Tensor.crossToSlot_eq_crossToEnd` : the bridge to the result-to-end convention. +- `TensorSpecies.Tensor.crossToSlot_basis_repr_apply` : the component bridge from result-to-slot + to result-to-end contraction. - `TensorSpecies.Tensor.crossToSlotInv` : the returning half of a round trip, the contraction against the second factor with the round trip's color cast absorbed. - `TensorSpecies.Tensor.crossToSlot_permT_right_id` : an identity reindexing of the rank-2 tensor @@ -39,6 +41,7 @@ operation live with the unit-tensor collapse theory in ## iv. References +* None. -/ @[expose] public section @@ -100,6 +103,19 @@ lemma crossToSlot_eq_crossToEnd {nA : ℕ} {c : Fin (nA + 1) → C} {cM : Fin 2 permT ⇑(Fin.cycleIcc i (Fin.last nA)).symm (IsReindexing.crossToSlot_cycle i j) (crossToEnd i j hc t M) := rfl +/-- A component of `crossToSlot` is the corresponding component of `crossToEnd`, with the +surviving indices rotated back into the contracted slot. -/ +lemma crossToSlot_basis_repr_apply {nA : ℕ} {c : Fin (nA + 1) → C} {cM : Fin 2 → C} + (i : Fin (nA + 1)) (j : Fin 2) (hc : S.τ (c i) = cM j) (M : Tensor S cM) + (t : Tensor S c) + (φ : ComponentIdx (S := S) (Function.update c i (cM (j.succAbove 0)))) : + (basis _).repr (crossToSlot i j hc M t) φ = + (basis _).repr (crossToEnd i j hc t M) (fun m => + basisIdxCongr ((IsReindexing.crossToSlot_cycle i j).inv_perserve_color m) + (φ ((IsReindexing.crossToSlot_cycle i j).inv + ⇑(Fin.cycleIcc i (Fin.last nA)).symm m))) := by + rw [crossToSlot_eq_crossToEnd, permT_basis_repr_symm_apply] + /-- Contract slot `i` of a tensor whose color there is `d` against `M'`, then absorb the color cast the two `Function.update`s generate, landing back on `c`. This is the returning half of a raise-then-lower round trip; absorbing the cast here is what keeps the round trip cast-free at diff --git a/Physlib/Relativity/Tensors/Contraction/Pure.lean b/Physlib/Relativity/Tensors/Contraction/Pure.lean index 8bd7bae9bd..24d7a89cdd 100644 --- a/Physlib/Relativity/Tensors/Contraction/Pure.lean +++ b/Physlib/Relativity/Tensors/Contraction/Pure.lean @@ -349,7 +349,6 @@ noncomputable def contrP {n : ℕ} {c : Fin (n + 1 + 1) → C} S.Tensor (c ∘ succSuccAbove i j) := (p.contrPCoeff i j hij) • (p.dropPair i j hij.1).toTensor -set_option backward.isDefEq.respectTransparency false in @[simp] lemma contrP_update_add {n : ℕ} [inst : DecidableEq (Fin (n + 1 +1))] {c : Fin (n + 1 + 1) → C} (i j m : Fin (n + 1 + 1)) (hij : i ≠ j ∧ S.τ (c i) = c j) @@ -361,7 +360,6 @@ lemma contrP_update_add {n : ℕ} [inst : DecidableEq (Fin (n + 1 +1))] {c : Fin · simp [contrP, add_smul] · simp [contrP] -set_option backward.isDefEq.respectTransparency false in @[simp] lemma contrP_update_smul {n : ℕ} [inst : DecidableEq (Fin (n + 1 +1))] {c : Fin (n + 1 + 1) → C} (i j m : Fin (n + 1 + 1)) (hij : i ≠ j ∧ S.τ (c i) = c j) diff --git a/Physlib/Relativity/Tensors/Contraction/SuccSuccAbove.lean b/Physlib/Relativity/Tensors/Contraction/SuccSuccAbove.lean index 0f8af30f14..bd8164be61 100644 --- a/Physlib/Relativity/Tensors/Contraction/SuccSuccAbove.lean +++ b/Physlib/Relativity/Tensors/Contraction/SuccSuccAbove.lean @@ -268,7 +268,7 @@ lemma succSuccAbove_natAdd_image_range_castAdd {n n1 : ℕ} (succSuccAbove (n := n1 + n) (Fin.natAdd n1 i) (Fin.natAdd n1 j)) '' (Set.range (Fin.castAdd (m := n) (n := n1))) = {i | i.1 < n1} := by ext a - simp only [Set.mem_image, Set.mem_range, exists_exists_eq_and, Set.mem_setOf_eq] + simp only [Set.mem_image, Set.mem_range, exists_exists_eq_and, Set.mem_ofPred_eq] conv_lhs => enter [1, b] rw [succSuccAbove_natAdd_apply_castAdd i j] @@ -430,4 +430,16 @@ lemma funPredPredAbove_id { n1 : ℕ} (i j : Fin (n1 + 1 + 1)) (hij : i ≠ j) : ext1 m simp [funPredPredAbove] +/-- Pointwise form of commuting deletion of one slot with deletion of a pair. -/ +lemma succSuccAbove_succAbove_comm_apply {n : ℕ} (i j : Fin (n + 1 + 1 + 1)) + (k : Fin (n + 1)) (m : Fin n) : + (i.succSuccAbove j k).succAbove + (((Fin.predAbove 0 (i.succSuccAbove j k)).predAbove i).succSuccAbove + ((Fin.predAbove 0 (i.succSuccAbove j k)).predAbove j) m) = + i.succSuccAbove j (k.succAbove m) := by + apply Fin.val_injective + simp only [Fin.succSuccAbove, Fin.succAbove, Fin.predAbove, Fin.lt_def, Fin.val_castSucc, + Fin.val_succ, Fin.castPred, apply_ite Fin.val] + grind (splits := 60) + end Fin diff --git a/Physlib/Relativity/Tensors/Contraction/UnitTensorContraction.lean b/Physlib/Relativity/Tensors/Contraction/UnitTensorContraction.lean index 2ea6cfc183..d633d121b0 100644 --- a/Physlib/Relativity/Tensors/Contraction/UnitTensorContraction.lean +++ b/Physlib/Relativity/Tensors/Contraction/UnitTensorContraction.lean @@ -47,6 +47,7 @@ from the `CommRing` `crossToEnd`/`crossToSlot` algebra. ## iv. References +* None. -/ @[expose] public section @@ -71,6 +72,7 @@ survivor tail by `move_last`. -/ +set_option backward.isDefEq.respectTransparency false in /-- Cross-contracting the last slot of the product `E ⊗ B` (with `B` rank one) against the unit tensor for that slot's color returns `E ⊗ B` unchanged, the contracted slot carried to the end. The rank-one spectator case that seeds `crossToEnd_unitTensor_slot`. -/ @@ -123,6 +125,7 @@ private lemma crossToEnd_prodT_unitTensor {nV : ℕ} {cE : Fin nV → C} {cB : C refine Fin.addCases (fun j => ?_) (fun j => ?_) i <;> simp [Fin.append_left, Fin.append_right] · rfl +set_option backward.isDefEq.respectTransparency false in /-- The boundary case of `crossToEnd_unitTensor`, proved by spectator decomposition along the last slot (`eq_sum_evalT`). The last slot is threaded as a variable `i` with `hilast : i = last nA` so that `crossToEnd_unitTensor` can apply it at the image of `i` under its transposition without a @@ -253,6 +256,7 @@ lemma crossToEnd_round_trip_of_unit_slot {nA : ℕ} {c : Fin (nA + 1) → C} {d simp [Fin.append_right, Function.comp_apply] · rfl +set_option backward.isDefEq.respectTransparency false in /-- Round trip for `crossToSlot` at an arbitrary slot, with the colors in their composite form. The general-color statement `crossToSlot_raise_lower_round_trip` is obtained from this by substituting its three color equalities. -/ @@ -347,6 +351,7 @@ variable {nA : ℕ} {c : Fin (nA + 1) → C} {a b d e : C} (i : Fin (nA + 1)) (hM'M : crossToEnd (Fin.last 1) (0 : Fin 2) ((congrArg S.τ he.symm).trans ha) M' M = permT (id : Fin 2 → Fin 2) (IsReindexing.unitTensor_pair hb) (unitTensor (S := S) d)) +set_option backward.isDefEq.respectTransparency false in include hMM' in /-- Lowering undoes raising: `crossToSlot_raise_lower_round_trip` with the color cast absorbed into `crossToSlotInv`. -/ @@ -374,7 +379,7 @@ lemma crossToSlot_crossToSlotInv (t : Tensor S (Function.update c i d)) : intro x y hxy exact permT_injective _ (by rw [← hswap x, ← hswap y, hxy]) have hinj : Function.Injective (crossToSlotInv (S := S) i he hb M') := by - simp only [crossToSlotInv, LinearMap.coe_comp] + simp only [crossToSlotInv] exact (permT_injective _).comp hgi exact Function.LeftInverse.rightInverse_of_injective (crossToSlotInv_crossToSlot i he ha hb M M' hMM') hinj t diff --git a/Physlib/Relativity/Tensors/Dual.lean b/Physlib/Relativity/Tensors/Dual.lean index fa88ec66ce..5a2c96f542 100644 --- a/Physlib/Relativity/Tensors/Dual.lean +++ b/Physlib/Relativity/Tensors/Dual.lean @@ -49,6 +49,7 @@ reindexing of the colors. ## iv. References +* None. -/ @[expose] public section @@ -82,6 +83,7 @@ noncomputable def toDualMapAtIndex : {n : ℕ} → {c : Fin n → C} → (i : Fi -/ +set_option backward.isDefEq.respectTransparency false in /-- The metric tensor at `S.τ c` contracted with the metric tensor at `c` is the unit tensor at `c`. -/ lemma crossToEnd_dual_metricTensor_metricTensor {c : C} : @@ -91,6 +93,7 @@ lemma crossToEnd_dual_metricTensor_metricTensor {c : C} : rw [crossToEnd_two, contrT_dual_metricTensor_metricTensor, permT_permT] exact permT_congr rfl rfl +set_option backward.isDefEq.respectTransparency false in /-- The metric tensor at `c` contracted with the metric tensor at `S.τ c` is the unit tensor at `S.τ c`. -/ lemma crossToEnd_metricTensor_metricTensor_eq_dual_unit {c : C} : diff --git a/Physlib/Relativity/Tensors/Elab.lean b/Physlib/Relativity/Tensors/Elab.lean index 7244349571..65573c3b68 100644 --- a/Physlib/Relativity/Tensors/Elab.lean +++ b/Physlib/Relativity/Tensors/Elab.lean @@ -29,11 +29,11 @@ public import Physlib.Relativity.Tensors.Tensorial - If `a ∈ k` then `{a •ₜ T | μ ν}ᵀ` is `smulNode a (tensorNode T)`. - If `g ∈ S.G` then `{g •ₐ T | μ ν}ᵀ` is `actionNode g (tensorNode T)`. - Suppose `T2` is a tensor with color `![c3]`. - Then `{T | μ ν ⊗ T2 | σ}ᵀ` is `prodNode (tensorNode T1) (tensorNode T2)`. + Then `{T | μ ν ⊗ T2 | σ}ᵀ` is `prodNode (tensorNode T) (tensorNode T2)`. - If `T3` is a tensor with color `![S.τ c1, S.τ c2]`, then - `{T | μ ν ⊗ T3 | μ σ}ᵀ` is `contr 0 1 _ (prodNode (tensorNode T1) (tensorNode T3))`. + `{T | μ ν ⊗ T3 | μ σ}ᵀ` is `contr 0 1 _ (prodNode (tensorNode T) (tensorNode T3))`. `{T | μ ν ⊗ T3 | μ ν }ᵀ` is - `contr 0 0 _ (contr 0 1 _ (prodNode (tensorNode T1) (tensorNode T3)))`. + `contr 0 0 _ (contr 0 1 _ (prodNode (tensorNode T) (tensorNode T3)))`. - If `T4` is a tensor with color `![c2, c1]` then `{T | μ ν + T4 | ν μ }ᵀ`is `addNode (tensorNode T) (perm _ (tensorNode T4))` where `_` is the permutation of the two indices of `T4`. @@ -74,8 +74,10 @@ syntax ident : indexExpr syntax num : indexExpr -/-- Notation to describe the evaluation of a tensor index. -/ -syntax "[" ident "]" : indexExpr +/-- Notation to describe the evaluation of a tensor index. The term inside the brackets is + the value of the index, which can be an identifier `[μ]` or an arbitrary term such as + `[Sum.inl 0]`. -/ +syntax "[" term "]" : indexExpr /-- Notation to describe the jiggle of a tensor index. -/ syntax "τ(" ident ")" : indexExpr @@ -120,10 +122,16 @@ def indexToIdent (stx : Syntax) : TermElabM Ident := match stx with | `(indexExpr|$a:ident) => return a | `(indexExpr| τ($a:ident)) => return a - | `(indexExpr| [$a:ident]) => return a | _ => throwError "Unsupported expression syntax in indexToIdent: {stx}" +/-- For an evaluated bracket index `[t]`, the term `t` giving the value of the index. -/ +def indexToBracketTerm (stx : Syntax) : TermElabM Term := + match stx with + | `(indexExpr| [$a:term]) => return a + | _ => + throwError "Unsupported expression syntax in indexToBracketTerm: {stx}" + /-- Takes a pair ``a b : ℕ × TSyntax `indexExpr``. If `a.1 < b.1` and `a.2 = b.2` then outputs `some (a.1, b.1)`, otherwise `none`. -/ def indexPosEq (a b : TSyntax `indexExpr × ℕ) : TermElabM (Option (ℕ × ℕ)) := do @@ -198,7 +206,7 @@ def getEvalPos (ind : List (TSyntax `indexExpr)) : TermElabM (List (ℕ × ℕ)) def getEvalBracketPos (ind : List (TSyntax `indexExpr)) : TermElabM (List (ℕ × Term)) := do let indEnum := ind.zipIdx let evals := indEnum.filter (fun x => indexExprIsBracketEval x.1) - let evals2 ← (evals.mapM (fun x => indexToIdent x.1)) + let evals2 ← (evals.mapM (fun x => indexToBracketTerm x.1)) let pos := evalAdjustPos (evals.map (fun x => x.2)) return List.zip pos evals2 @@ -267,19 +275,18 @@ def contrListAdjust (l : List (ℕ × ℕ)) : List (ℕ × ℕ) := -/ -/-- Given two lists of indices, all of which are indent, - returns the `List (ℕ)` representing the how one list - permutes into the other. -/ +/-- Given two lists of indices, all of which are identifiers, returns the `List (ℕ)` whose + `i`th entry is the position in `l2` of the `i`th index in `l1`. -/ def getPermutation (l1 l2 : List (TSyntax `indexExpr)) : TermElabM (List ℕ) := do /- Turn every index into an indent. -/ let l1' ← l1.mapM (fun x => indexToIdent x) let l2' ← l2.mapM (fun x => indexToIdent x) - /- For `l1 = [α, β, γ, δ]`, `l1enum` is `[(α, 0), (β, 1), (γ, 2), (δ, 3)]` -/ - let l1enum := l1'.zipIdx - /- For `l2 = [γ, α, δ, β]`, `l2''` is `[(γ,2), (α, 0), (δ, 3), (β, 1)]` -/ - let l2'' := l2'.filterMap - (fun x => l1enum.find? (fun y => Lean.TSyntax.getId y.1 = Lean.TSyntax.getId x)) - return l2''.map fun x => x.2 + /- For `l2 = [γ, α, δ, β]`, `l2enum` is `[(γ, 0), (α, 1), (δ, 2), (β, 3)]`. -/ + let l2enum := l2'.zipIdx + /- For `l1 = [α, β, γ, δ]`, `l1''` is `[(α, 1), (β, 3), (γ, 0), (δ, 2)]`. -/ + let l1'' := l1'.filterMap + (fun x => l2enum.find? (fun y => Lean.TSyntax.getId y.1 = Lean.TSyntax.getId x)) + return l1''.map fun x => x.2 /-- The construction of an expression corresponding to the type of a given string once parsed. -/ def stringToTerm (str : String) : TermElabM Term := do @@ -655,6 +662,23 @@ info: (contrT 0 0 1 ⋯) ((contrT 2 1 3 ⋯) ((prodT u) td)) : #guard_msgs in #check ({u | α β = u' | β α}ᵀ : Prop) +variable {V3 : Fin 3 → Type} [∀ c, AddCommGroup (V3 c)] [∀ c, Module k (V3 c)] + {basisIdx3 : Fin 3 → Type} [∀ c, Fintype (basisIdx3 c)] + [∀ c, DecidableEq (basisIdx3 c)] + {rep3 : (c : Fin 3) → Representation k G (V3 c)} + {b3 : (c : Fin 3) → Module.Basis (basisIdx3 c) k (V3 c)} + {S3 : TensorSpecies k (Fin 3) G V3 basisIdx3 rep3 b3} + {v3 : S3.Tensor ![0, 1, 2]} {v3' : S3.Tensor ![1, 2, 0]} + +-- A non-involutive reordering uses the map from target slots to source slots. +/-- info: v3 = (permT ![2, 0, 1] ⋯) v3' : Prop -/ +#guard_msgs in +#check ({v3 | α β γ = v3' | β γ α}ᵀ : Prop) + +/-- info: v3 + (permT ![2, 0, 1] ⋯) v3' : S3.Tensor ![0, 1, 2] -/ +#guard_msgs in +#check ({v3 | α β γ + v3' | β γ α}ᵀ) + variable {k : Type} [RCLike k] {C : Type} [DecidableEq C] {G : Type} [Group G] {V : C → Type} [∀ c, AddCommGroup (V c)] [∀ c, Module k (V c)] {basisIdx : C → Type} [∀ c, Fintype (basisIdx c)] [∀ c, DecidableEq (basisIdx c)] diff --git a/Physlib/Relativity/Tensors/Evaluation.lean b/Physlib/Relativity/Tensors/Evaluation.lean index 5c22282ca6..cab793b231 100644 --- a/Physlib/Relativity/Tensors/Evaluation.lean +++ b/Physlib/Relativity/Tensors/Evaluation.lean @@ -72,7 +72,6 @@ lemma evalPCoeff_basisVector (i : Fin (n + 1)) (φ : basisIdx (c i)) (b' : Compo noncomputable def evalP (i : Fin (n + 1)) (φ : basisIdx (c i)) (p : Pure S c) : Tensor S (c ∘ i.succAbove) := evalPCoeff i φ p • (drop p i).toTensor -set_option backward.isDefEq.respectTransparency false in @[simp] lemma evalP_update_add [inst : DecidableEq (Fin (n + 1))] (i j : Fin (n + 1)) (φ : basisIdx (c i)) (p : Pure S c) @@ -84,7 +83,6 @@ lemma evalP_update_add [inst : DecidableEq (Fin (n + 1))] (i j : Fin (n + 1)) · simp [add_smul] · simp -set_option backward.isDefEq.respectTransparency false in @[simp] lemma evalP_update_smul [inst : DecidableEq (Fin (n + 1))] (i j : Fin (n + 1)) (φ : basisIdx (c i)) (p : Pure S c) @@ -190,8 +188,59 @@ lemma evalT_permT {n m : ℕ} {c : Fin (n + 1) → C} {c' : Fin (m + 1) → C} -/ -TODO "Add the lemma corresponding the the commutation of two evaluations of tensor - indices." +/-- Commutation of two evaluations on a tensor basis vector. -/ +lemma evalT_evalT_basis {n : ℕ} {c : Fin (n + 1 + 1) → C} + (k1 : Fin (n + 1 + 1)) (k2 : Fin (n + 1)) (φ1 : basisIdx (c k1)) + (φ2 : basisIdx ((c ∘ k1.succAbove) k2)) (ψ : ComponentIdx (S := S) c) : + evalT k2 φ2 (evalT k1 φ1 (basis (S := S) c ψ)) = + permT id (IsReindexing.succAbove_succAbove_comm k1 k2) + (evalT (k2.predAbove k1) + (basisIdxCongr + (congrArg c (Fin.succAbove_succAbove_predAbove k1 k2).symm) φ1) + (evalT (k1.succAbove k2) φ2 (basis (S := S) c ψ))) := by + simp only [evalT_basis, apply_ite, map_zero] + have hk1 : (k1.succAbove k2).succAbove (k2.predAbove k1) = k1 := + Fin.succAbove_succAbove_predAbove k1 k2 + have hcond : + (ψ ((k1.succAbove k2).succAbove (k2.predAbove k1)) = + basisIdxCongr (congrArg c hk1.symm) φ1) ↔ ψ k1 = φ1 := by + rw [ComponentIdx.congr_right ψ _ k1 hk1] + exact (basisIdxCongr _).apply_eq_iff_eq + by_cases h2 : ψ (k1.succAbove k2) = φ2 + · by_cases h1 : ψ k1 = φ1 + · have htr : + ψ ((k1.succAbove k2).succAbove (k2.predAbove k1)) = + basisIdxCongr (congrArg c hk1.symm) φ1 := hcond.mpr h1 + simp only [h2, h1, htr, ↓reduceIte] + rw [permT_basis] + congr 1 + funext i + exact ComponentIdx.congr_right ψ _ _ + (Fin.succAbove_succAbove_succAbove_predAbove k1 k2 i).symm + · have hntr : + ¬ ψ ((k1.succAbove k2).succAbove (k2.predAbove k1)) = + basisIdxCongr (congrArg c hk1.symm) φ1 := by + intro htr + exact h1 (hcond.mp htr) + simp only [h2, h1, hntr, ↓reduceIte] + · simp only [h2, ↓reduceIte, ite_self] + +/-- Evaluating two tensor indices commutes, up to the canonical reindexing +identifying the two possible orders in which the indices are removed. -/ +lemma evalT_evalT {n : ℕ} {c : Fin (n + 1 + 1) → C} + (k1 : Fin (n + 1 + 1)) (k2 : Fin (n + 1)) (φ1 : basisIdx (c k1)) + (φ2 : basisIdx ((c ∘ k1.succAbove) k2)) (t : Tensor S c) : + evalT k2 φ2 (evalT k1 φ1 t) = + permT id (IsReindexing.succAbove_succAbove_comm k1 k2) + (evalT (k2.predAbove k1) + (basisIdxCongr + (congrArg c (Fin.succAbove_succAbove_predAbove k1 k2).symm) φ1) + (evalT (k1.succAbove k2) φ2 t)) := by + induction' t using Tensor.induction_on_basis with ψ a t ht t1 t2 ht1 ht2 + · exact evalT_evalT_basis (S := S) k1 k2 φ1 φ2 ψ + · simp + · simp only [map_smul, ht] + · simp only [map_add, ht1, ht2] /-! @@ -328,6 +377,7 @@ TODO "Add a lemmas related to the commutation of evaluation with contraction." ## Other properties of evaluation -/ +set_option backward.isDefEq.respectTransparency false in /-- Evaluating the single-index basis tensor `basis ![c] (single.symm b)` at the index `x` yields the field element `1` if `b = x` (transported across `![c] 0 = c`) and `0` otherwise: evaluation of a one-index basis tensor is the Kronecker delta. -/ @@ -379,7 +429,6 @@ lemma eq_sum_evalT {n : ℕ} {c : Fin (n + 1) → C} (t : Tensor S c) : exact ComponentIdx.congr_right b _ _ (by rw [Fin.succAbove_last]; rfl) · simp only [id_eq, ComponentIdx.prod_symm_natAdd, ComponentIdx.single_symm_apply, basisIdxCongr_apply_apply] - erw [basisIdxCongr_apply_apply] exact ComponentIdx.congr_right _ _ _ (by fin_cases j; rfl) · intro j h1 h1 rw [if_neg (by grind)] diff --git a/Physlib/Relativity/Tensors/LeviCivita/Basic.lean b/Physlib/Relativity/Tensors/LeviCivita/Basic.lean index 3df63bf374..0266f51685 100644 --- a/Physlib/Relativity/Tensors/LeviCivita/Basic.lean +++ b/Physlib/Relativity/Tensors/LeviCivita/Basic.lean @@ -6,8 +6,6 @@ Authors: Robert Sneiderman module public import Physlib.Relativity.Tensors.RealTensor.Basic -public import Physlib.Relativity.Tensors.UnitTensor -public import Physlib.Meta.Sorry public import Physlib.Relativity.Tensors.OfInt public import Physlib.Mathematics.LeviCivita.Basic /-! @@ -41,6 +39,7 @@ components are carried by `TensorSpecies.Tensor.TensorInt.toTensor`. ## iv. References +* None. -/ @[expose] public section @@ -174,19 +173,4 @@ lemma leviCivita_antisymm_last : {ε4 | μ ν ρ σ = - (ε4 | μ ν σ ρ)}ᵀ funext i fin_cases i <;> rfl -open TensorSpecies Tensor - -@[sorryful] -lemma leviCivita_contract_three : {ε4 | μ ν ρ σ ⊗ ε4 | τ(μ) τ(ν) τ(ρ) τ(τ) = - (-6) • unitTensor (S := realLorentzTensor) Color.down | σ τ }ᵀ := by - sorry - --- `checkType` linter: under the v4.32.0 toolchain, whnf on this tensor-notation --- statement exceeds the linter's 200k-heartbeat budget (it did not on v4.31.0). --- Statement unchanged; see the v4.32.0 bump commit message. -@[sorryful, nolint checkType] -lemma leviCivita_contract_self : - {ε4 | μ ν ρ σ ⊗ ε4 | τ(μ) τ(ν) τ(ρ) τ(σ)}ᵀ.toField = - 24 := by - sorry - end realLorentzTensor diff --git a/Physlib/Relativity/Tensors/LeviCivita/Complex.lean b/Physlib/Relativity/Tensors/LeviCivita/Complex.lean new file mode 100644 index 0000000000..af920b47ed --- /dev/null +++ b/Physlib/Relativity/Tensors/LeviCivita/Complex.lean @@ -0,0 +1,104 @@ +/- +Copyright (c) 2026 Robert Sneiderman. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Robert Sneiderman +-/ +module + +public import Physlib.Relativity.Tensors.ComplexTensor.OfRat +public import Physlib.Relativity.Tensors.LeviCivita.Basic +public import Physlib.Relativity.Tensors.RealTensor.ToComplex +/-! + +# The Levi-Civita tensor as a complex Lorentz tensor + +This file complexifies the real Lorentz Levi-Civita tensor and records its components in the +rational complex tensor basis. + +-/ + +@[expose] public section + +noncomputable section + +namespace complexLorentzTensor + +open Physlib +open KroneckerDelta +open TensorSpecies +open Tensor + +/-! + +## A. Definition and components + +-/ + +/-- The index colors of the complexified real Levi-Civita tensor agree with four complex +contravariant Lorentz indices. -/ +lemma leviCivita_isReindexing : IsReindexing + (realLorentzTensor.colorToComplex ∘ + ![realLorentzTensor.Color.up, realLorentzTensor.Color.up, + realLorentzTensor.Color.up, realLorentzTensor.Color.up]) + ![Color.up, Color.up, Color.up, Color.up] id := by + exact IsReindexing.auto + +/-- A color cast in the complex Lorentz basis preserves the underlying finite index value. -/ +private lemma basisIdxCongr_val {c c1 : Color} (h : c = c1) + (i : Fin (complexLorentzTensor.repDim c)) : + (TensorSpecies.basisIdxCongr + (basisIdx := fun c => Fin (complexLorentzTensor.repDim c)) h i).val = i.val := by + rw [basisIdxCongr_eq_cast] + rfl + +/-- The Levi-Civita tensor `εᵘᵛᵖᵟ` as a complex Lorentz tensor, with `ε⁰¹²³ = 1`. -/ +noncomputable def leviCivita : ℂT[.up, .up, .up, .up] := + permT id leviCivita_isReindexing + (realLorentzTensor.toComplex realLorentzTensor.leviCivita) + +/-- The complex Lorentz Levi-Civita tensor. -/ +scoped[complexLorentzTensor] notation "ε4ℂ" => leviCivita + +/-- The complex Levi-Civita tensor has the Levi-Civita symbol as its real component and zero +imaginary component in the standard basis. -/ +lemma leviCivita_eq_ofRat : ε4ℂ = ofRat (fun + b : ComponentIdx (S := complexLorentzTensor) ![Color.up, Color.up, Color.up, Color.up] => + ⟨generalizedKroneckerDelta + (fun i => Fin.cast (by fin_cases i <;> rfl) (b i)) (id : Fin 4 → Fin 4), 0⟩) := by + apply (Tensor.basis _).repr.injective + ext b + rw [leviCivita, permT_basis_repr_symm_apply] + have hinv (i : Fin 4) : IsReindexing.inv id leviCivita_isReindexing i = i := by + have h := IsReindexing.inv_apply_apply id leviCivita_isReindexing i + simpa using h + rw [ofRat_basis_repr_apply] + let j : ComponentIdx (S := complexLorentzTensor) + (realLorentzTensor.colorToComplex ∘ + ![realLorentzTensor.Color.up, realLorentzTensor.Color.up, + realLorentzTensor.Color.up, realLorentzTensor.Color.up]) := + fun i => basisIdxCongr (by simp [IsReindexing.inv_perserve_color]) + (b (IsReindexing.inv id leviCivita_isReindexing i)) + change (Tensor.basis _).repr + (realLorentzTensor.toComplex realLorentzTensor.leviCivita) j = _ + have hrepr := realLorentzTensor.toComplex_repr realLorentzTensor.leviCivita + (ComponentIdx.complexify.symm j) + rw [Equiv.apply_symm_apply] at hrepr + rw [hrepr, realLorentzTensor.leviCivita_basis_repr_apply] + simp [Physlib.RatComplexNum.toComplexNum] + apply congrArg (fun f : Fin 4 → Fin 4 => generalizedKroneckerDelta f id) + funext i + have hcomplexify : + (finSumFinEquiv (ComponentIdx.complexify.symm j i)).val = (j i).val := by + have h := congrArg Fin.val + (congrFun (ComponentIdx.complexify.apply_symm_apply j) i) + simpa only [realLorentzTensor.ComponentIdx.complexify_apply, Fin.val_cast] using h + apply Fin.ext + simp only [Fin.val_cast] + rw [hcomplexify] + simp only [j] + exact (basisIdxCongr_val + (by simp [IsReindexing.inv_perserve_color]) + (b (IsReindexing.inv id leviCivita_isReindexing i))).trans + (congrArg (fun x => (b x).val) (hinv i)) + +end complexLorentzTensor diff --git a/Physlib/Relativity/Tensors/LeviCivita/Contractions.lean b/Physlib/Relativity/Tensors/LeviCivita/Contractions.lean index 483c43a051..bbf53fb6b6 100644 --- a/Physlib/Relativity/Tensors/LeviCivita/Contractions.lean +++ b/Physlib/Relativity/Tensors/LeviCivita/Contractions.lean @@ -7,45 +7,61 @@ module public import Physlib.Relativity.Tensors.LeviCivita.Basic public import Physlib.Mathematics.KroneckerDelta.Contraction -public import Physlib.Meta.TODO.Basic +public import Physlib.Relativity.Tensors.RealTensor.Metrics.Basic +public import Physlib.Relativity.Tensors.RealTensor.Units.Basic /-! -# Euclidean contraction identities for the Levi-Civita tensor +# Contraction identities for the Levi-Civita tensor ## i. Overview This file proves the "epsilon-epsilon" contraction identities for the rank-four Levi-Civita -tensor `leviCivita` (notation `ε4`) in `d = 3`, stated in terms of the standard-basis +tensor `leviCivita` (notation `ε4`) in `d = 4`, stated in terms of the standard-basis components of `ε4` itself (`realLorentzTensor.leviCivita_basis_repr_apply`). The underlying facts about the `generalizedKroneckerDelta` alone, with no -tensor content — lives in `Physlib.Mathematics.KroneckerDelta.Contraction`, next to the +tensor content, live in `Physlib.Mathematics.KroneckerDelta.Contraction`, next to the definition of `generalizedKroneckerDelta`. Here we specialise those facts to the components of `ε4`, where `(ε4)_b = (Tensor.basis _).repr ε4 b` is the standard-basis component of `ε4`, an integer Levi-Civita symbol carried to the reals, and the sums run over the remaining (uncontracted) component slots. +It also proves the Lorentzian tensor identities obtained by lowering all four indices of one +factor: the complete contraction is `-24`, while contracting three index pairs gives `-6` times +the unit tensor. + +The Lorentzian proofs proceed through reusable component statements: lowering all four indices +contributes the orientation sign, tensor contractions become finite sums of matching components, +and the Euclidean contraction theorems evaluate those sums. + ## ii. Key results -- `leviCivita_symbol_contract_zero` : `∑_b (ε4)_b · (ε4)_b = 24` (full Euclidean contraction). -- `leviCivita_symbol_contract_one` : `∑_h (ε4)_{a,h} · (ε4)_{b,h} = 6 · δ[a,b]`. -- `leviCivita_symbol_contract_two` : +- `euclidLeviCivita_symbol_contract_zero` : full Euclidean contraction equals `24`. +- `euclidLeviCivita_symbol_contract_one` : the triple Euclidean contraction equals `6 · δ[a,b]`. +- `euclidLeviCivita_symbol_contract_two` : `∑_h (ε4)_{r,s,h} · (ε4)_{t,w,h} = 2 · (δ[r,t]·δ[s,w] - δ[r,w]·δ[s,t])`. +- `realLorentzTensor.leviCivita_lowered_basis_repr_apply` : lowering all four indices changes + every standard-basis component by the Lorentzian orientation sign `-1`. +- `realLorentzTensor.leviCivita_contract_three_basis_repr_apply` : the tensor triple contraction + is the sum of matching standard-basis components. +- `leviCivita_contract_self` : `ε^{μνρσ} ε_{μνρσ} = -24`. +- `leviCivita_contract_three` : `ε^{μνρσ} ε_{μνρτ} = -6 δ^σ_τ`. ## iii. Table of contents -- A. The combinatorial bridge lemma -- B. Euclidean epsilon-epsilon contraction identities +- A. Euclidean epsilon-epsilon contraction identities +- B. Lorentzian epsilon-epsilon contraction identities + - B.1. The epsilon-epsilon contraction identities ## iv. References +* None. -/ @[expose] public section open Matrix TensorSpecies Tensor KroneckerDelta - /-! ## A. Euclidean epsilon-epsilon contraction identities @@ -67,7 +83,8 @@ lemma euclidLeviCivita_symbol_contract_zero : ((generalizedKroneckerDelta g id : ℝ)) * (generalizedKroneckerDelta g id : ℝ) = ((generalizedKroneckerDelta g id * generalizedKroneckerDelta g id : ℤ) : ℝ) := fun g => by push_cast; ring - erw [Finset.sum_congr rfl fun g _ => hcast g, ← Int.cast_sum, + simp only [euclidLeviCivita] + rw [Finset.sum_congr rfl fun g _ => hcast g, ← Int.cast_sum, sum_generalizedKroneckerDelta_mul_self] norm_num @@ -84,10 +101,23 @@ lemma euclidLeviCivita_symbol_contract_one (a b : Fin 4) : = ((generalizedKroneckerDelta (Fin.cons a h') id * generalizedKroneckerDelta (Fin.cons b h') id : ℤ) : ℝ) := fun h' => by push_cast; ring - erw [Finset.sum_congr rfl fun h' _ => hcast h', ← Int.cast_sum, + simp only [euclidLeviCivita] + rw [Finset.sum_congr rfl fun h' _ => hcast h', ← Int.cast_sum, sum_generalizedKroneckerDelta_mul_cons] push_cast; ring +/-- **Triple Euclidean Levi-Civita contraction with the free index last.** This is the same +contraction as `euclidLeviCivita_symbol_contract_one`, in the slot order produced by the tensor +notation for `ε^{μνρσ} ε_{μνρτ}`. -/ +lemma euclidLeviCivita_symbol_contract_one_last (a b : Fin 4) : + ∑ h : Fin 3 → Fin 4, euclidLeviCivita (Fin.snoc h a) * euclidLeviCivita (Fin.snoc h b) + = 6 * ((kroneckerDelta a b : ℕ) : ℝ) := by + rw [Finset.sum_congr rfl fun h _ => ?_, euclidLeviCivita_symbol_contract_one a b] + simp only [euclidLeviCivita, ← Int.cast_mul, generalizedKroneckerDelta_mul] + rw [Fin.snoc_eq_cons_rotate, Fin.snoc_eq_cons_rotate] + exact congrArg (fun z : ℤ => (z : ℝ)) + (generalizedKroneckerDelta_comp_perm (Fin.cons a h) (Fin.cons b h) (finRotate (3 + 1))) + /-- **Double Euclidean Levi-Civita contraction** `∑_h (ε4)_{r,s,h} · (ε4)_{t,w,h} = 2 · (δ[r,t]·δ[s,w] - δ[r,w]·δ[s,t])` at the symbol level: contracting two of the four `Fin 4` component slots of `ε4` with the naive Kronecker pairing @@ -107,6 +137,216 @@ lemma euclidLeviCivita_symbol_contract_two (r s t w : Fin 4) : * generalizedKroneckerDelta (Fin.cons t (Fin.cons (w) h')) id : ℤ) : ℝ) := fun h' => by push_cast; ring - erw [Finset.sum_congr rfl fun h' _ => hcast h', ← Int.cast_sum, + simp only [euclidLeviCivita] + rw [Finset.sum_congr rfl fun h' _ => hcast h', ← Int.cast_sum, sum_generalizedKroneckerDelta_mul_cons₂] push_cast; ring + +/-! + +## B. Lorentzian epsilon-epsilon contraction identities + +-/ + +namespace realLorentzTensor + +open TensorSpecies Tensor +open ComponentIdx.DropPairSection + +/-- Lowering all four indices of the Levi-Civita tensor changes the sign of every standard-basis +component. This is the tensor-component form of the Lorentzian orientation factor +`det η = -1`. -/ +lemma leviCivita_lowered_basis_repr_apply + (b : ComponentIdx (S := realLorentzTensor 3) + ![Color.down, Color.down, Color.down, Color.down]) : + (Tensor.basis _).repr ({ε4 | τ(μ) τ(ν) τ(ρ) τ(σ)}ᵀ) b = + - (Tensor.basis _).repr ε4 b := by + simp only [toDualMapAtIndex_basis_repr_apply_eq_mul] + by_cases hb : Function.Injective b + · have hp := minkowskiMatrix.prod_diagonal_comp_of_injective hb + rw [Fin.prod_univ_four] at hp + norm_num at hp + linear_combination ((Tensor.basis _).repr ε4 b) * hp + · have hcomp : ¬ Function.Injective (fun i => finSumFinEquiv (b i)) := + fun h => hb (Function.Injective.of_comp h) + rw [leviCivita_basis_repr_eq_leviCivitaSymbol, + leviCivitaSymbol_eq_zero_of_not_injective hcomp] + norm_num + +/-- The sum of the squared standard-basis components of the contravariant Levi-Civita tensor is +`4! = 24`. -/ +lemma leviCivita_basis_contract_self : + ∑ b : ComponentIdx (S := realLorentzTensor 3) + ![Color.up, Color.up, Color.up, Color.up], + (Tensor.basis _).repr ε4 b * (Tensor.basis _).repr ε4 b = 24 := by + calc + _ = ∑ g : Fin 4 → Fin 4, euclidLeviCivita g * euclidLeviCivita g := + Fintype.sum_equiv (Equiv.arrowCongr (Equiv.refl (Fin 4)) + (finSumFinEquiv : (Fin 1 ⊕ Fin 3) ≃ Fin 4)) _ _ fun b => by + rw [leviCivita_basis_repr_apply] + rfl + _ = 24 := euclidLeviCivita_symbol_contract_zero + +/-- Contracting the first three standard-basis components of two contravariant Levi-Civita tensors +gives `3! = 6` times the Kronecker delta on the remaining components. -/ +lemma leviCivita_basis_contract_three (a b : Fin 1 ⊕ Fin 3) : + ∑ h : Fin 3 → Fin 1 ⊕ Fin 3, + (Tensor.basis _).repr ε4 (Fin.snoc h a) * + (Tensor.basis _).repr ε4 (Fin.snoc h b) = + 6 * (if a = b then 1 else 0) := by + simp only [leviCivita_basis_repr_apply] + have hs (y : Fin 1 ⊕ Fin 3) (h : Fin 3 → Fin 1 ⊕ Fin 3) : + (fun i => finSumFinEquiv ((Fin.snoc h y : Fin 4 → Fin 1 ⊕ Fin 3) i)) = + Fin.snoc (fun i => finSumFinEquiv (h i)) (finSumFinEquiv y) := by + funext i + fin_cases i <;> rfl + rw [Finset.sum_congr rfl fun h _ => by rw [hs a h, hs b h]] + calc + _ = ∑ g : Fin 3 → Fin 4, + (generalizedKroneckerDelta (Fin.snoc g (finSumFinEquiv a)) id : ℝ) * + (generalizedKroneckerDelta (Fin.snoc g (finSumFinEquiv b)) id : ℝ) := + Fintype.sum_equiv (Equiv.arrowCongr (Equiv.refl (Fin 3)) + (finSumFinEquiv : (Fin 1 ⊕ Fin 3) ≃ Fin 4)) _ _ fun _ => rfl + _ = 6 * ((kroneckerDelta (finSumFinEquiv a) (finSumFinEquiv b) : ℕ) : ℝ) := + euclidLeviCivita_symbol_contract_one_last _ _ + _ = 6 * (if a = b then 1 else 0) := by + by_cases hab : a = b + · subst hab + simp [KroneckerDelta.eq_one_of_same] + · rw [if_neg hab, + KroneckerDelta.eq_zero_of_ne (fun h => hab (finSumFinEquiv.injective h))] + norm_num + +/-- The standard-basis component formula for the tensor contraction +`ε^{μνρσ} ε_{μνρτ}`. -/ +lemma leviCivita_contract_three_basis_repr_apply + (b : ComponentIdx (S := realLorentzTensor 3) ![Color.up, Color.down]) : + (Tensor.basis _).repr + {ε4 | μ ν ρ σ ⊗ ε4 | τ(μ) τ(ν) τ(ρ) τ(τ)}ᵀ b = + ∑ h : Fin 3 → Fin 1 ⊕ Fin 3, + (Tensor.basis _).repr ε4 (Fin.snoc h (b 0)) * + (Tensor.basis _).repr ({ε4 | τ(μ) τ(ν) τ(ρ) τ(σ)}ᵀ) (Fin.snoc h (b 1)) := by + have route {cA cB : Fin 4 → Color} + (h1 : (0 : Fin 4) ≠ 2) (h2 : (1 : Fin 6) ≠ 4) (h3 : (2 : Fin 8) ≠ 6) + (b : Fin 2 → Fin 1 ⊕ Fin 3) (x0 x1 x2 : Fin 1 ⊕ Fin 3) : + let v := (ofFinEquiv (S := realLorentzTensor 3) (c := Fin.append cA cB) h3 + ((ofFinEquiv h2 ((ofFinEquiv h1 b (x0, x0)).1) (x1, x1)).1) (x2, x2)).1 + (ComponentIdx.prod (S := realLorentzTensor 3) (c := cA) (c1 := cB)) v = + (![x0, x1, x2, b 0], ![x0, x1, x2, b 1]) := by + dsimp only + apply Prod.ext <;> funext m <;> fin_cases m <;> rfl + simp only [contrT_basis_repr_apply_eq_fin, prodT_basis_repr_apply, + route] + let F (h : Fin 3 → Fin 1 ⊕ Fin 3) := + (Tensor.basis _).repr ε4 ![h 0, h 1, h 2, b 0] * + (Tensor.basis _).repr ({ε4 | τ(μ) τ(ν) τ(ρ) τ(σ)}ᵀ) ![h 0, h 1, h 2, b 1] + change (∑ x0, ∑ x1, ∑ x2, F ![x0, x1, x2]) = _ + let e : ((Fin 1 ⊕ Fin 3) × (Fin 1 ⊕ Fin 3) × (Fin 1 ⊕ Fin 3)) ≃ + (Fin 3 → Fin 1 ⊕ Fin 3) := + { toFun := fun p => ![p.1, p.2.1, p.2.2] + invFun := fun v => (v 0, v 1, v 2) + left_inv := fun _ => rfl + right_inv := fun v => by funext m; fin_cases m <;> rfl } + calc + _ = ∑ h, F h := by + rw [← Equiv.sum_comp e F] + simp only [Fintype.sum_prod_type] + rfl + _ = _ := by + refine Finset.sum_congr rfl fun h _ => ?_ + dsimp only [F] + have hs (y : Fin 1 ⊕ Fin 3) : + (![h 0, h 1, h 2, y] : Fin 4 → Fin 1 ⊕ Fin 3) = Fin.snoc h y := by + funext i + fin_cases i <;> rfl + rw [hs (b 0), hs (b 1)] + +/-! + +### B.1. The epsilon-epsilon contraction identities + +-/ + +/-- Contracting three indices of the Lorentzian Levi-Civita tensor with a fully lowered copy gives +`-6` times the mixed-index unit tensor. -/ +lemma leviCivita_contract_three : {ε4 | μ ν ρ σ ⊗ ε4 | τ(μ) τ(ν) τ(ρ) τ(τ) = + (-6) • unitTensor (S := realLorentzTensor) Color.down | σ τ }ᵀ := by + apply (Tensor.basis _).repr.injective + ext b + simp only [map_zsmul, Finsupp.coe_smul, Pi.smul_apply, zsmul_eq_mul, + permT_basis_repr_symm_apply, basisIdxCongr_eq_refl, Equiv.refl_apply, + unitTensor_repr_apply Color.down] + rw [IsReindexing.inv_eq_self_of_pointwise_eq _ (by decide), + IsReindexing.inv_eq_self_of_pointwise_eq _ (by decide)] + norm_num + rw [leviCivita_contract_three_basis_repr_apply] + calc + _ = - ∑ h : Fin 3 → Fin 1 ⊕ Fin 3, + (Tensor.basis _).repr ε4 (Fin.snoc h (b 0)) * + (Tensor.basis _).repr ε4 (Fin.snoc h (b 1)) := by + rw [← Finset.sum_neg_distrib] + refine Finset.sum_congr rfl fun h _ => ?_ + rw [leviCivita_lowered_basis_repr_apply] + ring + _ = - (6 * (if b 0 = b 1 then 1 else 0)) := by + rw [leviCivita_basis_contract_three] + _ = (if b 0 = b 1 then -6 else 0) := by + split_ifs <;> norm_num + +-- `checkType` linter: whnf on these full-contraction tensor-notation statements exceeds the +-- linter's 200k-heartbeat budget (since the v4.32.0 bump; still the case on v4.33.0). The proofs +-- themselves elaborate within the default budget. +/-- Fully contracting the tensor product of `ε4` and its fully lowered form is the sum of the +products of their matching standard-basis components. -/ +@[nolint checkType] +lemma leviCivita_contract_self_eq_sum : + {ε4 | μ ν ρ σ ⊗ ε4 | τ(μ) τ(ν) τ(ρ) τ(σ)}ᵀ.toField = + ∑ b : ComponentIdx (S := realLorentzTensor 3) + ![Color.up, Color.up, Color.up, Color.up], + (Tensor.basis _).repr ε4 b * + (Tensor.basis _).repr ({ε4 | τ(μ) τ(ν) τ(ρ) τ(σ)}ᵀ) b := by + have route {cA cB : Fin 4 → Color} + (h1 : (0 : Fin 2) ≠ 1) (h2 : (1 : Fin 4) ≠ 3) + (h3 : (2 : Fin 6) ≠ 5) (h4 : (3 : Fin 8) ≠ 7) + (x0 x1 x2 x3 : Fin 1 ⊕ Fin 3) : + let v := (ofFinEquiv (S := realLorentzTensor 3) (c := Fin.append cA cB) h4 + ((ofFinEquiv h3 + ((ofFinEquiv h2 + ((ofFinEquiv h1 (fun j => j.elim0) (x0, x0)).1) (x1, x1)).1) (x2, x2)).1) + (x3, x3)).1 + (ComponentIdx.prod (S := realLorentzTensor 3) (c := cA) (c1 := cB)) v = + (![x0, x1, x2, x3], ![x0, x1, x2, x3]) := by + dsimp only + apply Prod.ext <;> funext m <;> fin_cases m <;> rfl + rw [Tensor.toField_eq_repr] + simp only [contrT_basis_repr_apply_eq_fin, prodT_basis_repr_apply, + route] + let F (b : Fin 4 → Fin 1 ⊕ Fin 3) := (Tensor.basis _).repr ε4 b * + (Tensor.basis _).repr ({ε4 | τ(μ) τ(ν) τ(ρ) τ(σ)}ᵀ) b + change (∑ x0, ∑ x1, ∑ x2, ∑ x3, F ![x0, x1, x2, x3]) = ∑ b, F b + let e : ((Fin 1 ⊕ Fin 3) × (Fin 1 ⊕ Fin 3) × (Fin 1 ⊕ Fin 3) × (Fin 1 ⊕ Fin 3)) ≃ + (Fin 4 → Fin 1 ⊕ Fin 3) := + { toFun := fun p => ![p.1, p.2.1, p.2.2.1, p.2.2.2] + invFun := fun v => (v 0, v 1, v 2, v 3) + left_inv := fun _ => rfl + right_inv := fun v => by funext m; fin_cases m <;> rfl } + rw [← Equiv.sum_comp e F] + simp only [Fintype.sum_prod_type] + rfl + +/-- Fully contracting the Lorentzian Levi-Civita tensor with a lowered copy gives `-24`. -/ +@[nolint checkType] +lemma leviCivita_contract_self : + {ε4 | μ ν ρ σ ⊗ ε4 | τ(μ) τ(ν) τ(ρ) τ(σ)}ᵀ.toField = - 24 := by + rw [leviCivita_contract_self_eq_sum] + calc + _ = - ∑ b : ComponentIdx (S := realLorentzTensor 3) + ![Color.up, Color.up, Color.up, Color.up], + (Tensor.basis _).repr ε4 b * (Tensor.basis _).repr ε4 b := by + rw [← Finset.sum_neg_distrib] + refine Finset.sum_congr rfl fun b _ => ?_ + rw [leviCivita_lowered_basis_repr_apply] + ring + _ = -24 := by rw [leviCivita_basis_contract_self] + +end realLorentzTensor diff --git a/Physlib/Relativity/Tensors/MetricTensor.lean b/Physlib/Relativity/Tensors/MetricTensor.lean index e9e1a9678b..57b7139e81 100644 --- a/Physlib/Relativity/Tensors/MetricTensor.lean +++ b/Physlib/Relativity/Tensors/MetricTensor.lean @@ -29,6 +29,13 @@ open Tensor noncomputable def metricTensor (c : C) : S.Tensor ![c, c] := fromConstPair (S.metric c) +/-- A component of the metric tensor is the corresponding component of the metric intertwiner +in the tensor-product basis. -/ +lemma metricTensor_basis_repr (c : C) (φ : ComponentIdx (S := S) ![c, c]) : + (Tensor.basis _).repr (metricTensor (S := S) c) φ = + (Module.Basis.tensorProduct (b c) (b c)).repr ((S.metric c) (1 : k)) (φ 0, φ 1) := by + rw [metricTensor, fromConstPair, fromPairT_basis_repr] + lemma metricTensor_congr {c c1 : C} (h : c = c1) : S.metricTensor c = permT id (by simp [h]) (metricTensor c1) := by subst h @@ -48,6 +55,7 @@ lemma permT_fromPairTContr_metric_metric {c : C} : rw [← S.contr_metric] rfl +set_option backward.isDefEq.respectTransparency false in lemma fromPairTContr_metric_metric_eq_permT_unit {c : C} : fromPairTContr ((S.metric c) (1 : k)) ((S.metric (S.τ c)) (1 : k)) = @@ -59,6 +67,7 @@ lemma fromPairTContr_metric_metric_eq_permT_unit {c : C} : apply permT_congr_eq_id decide +set_option backward.isDefEq.respectTransparency false in /-- The contraction of the metric tensor with its dual gives the unit tensor. This is the de-categorification of `S.contr_metric`. -/ @[simp] @@ -72,6 +81,7 @@ lemma contrT_metricTensor_metricTensor {c : C} : rw [permT_permT] rfl +set_option backward.isDefEq.respectTransparency false in lemma contrT_metricTensor_metricTensor_eq_dual_unit {c : C} : contrT 2 1 2 (by simp; rfl) (prodT (metricTensor c) (metricTensor (S.τ c))) = permT ![0, 1] (And.intro (by decide) (fun i => by diff --git a/Physlib/Relativity/Tensors/Product.lean b/Physlib/Relativity/Tensors/Product.lean index f32c5d7ab1..908205f575 100644 --- a/Physlib/Relativity/Tensors/Product.lean +++ b/Physlib/Relativity/Tensors/Product.lean @@ -67,8 +67,8 @@ The following results exist for both `prodP` and `prodT` : ## iv. References -- arXiv:2411.07667 - +* Tooby-Smith, Formalization of physics index notation in Lean 4, arXiv:2411.07667. + [ref: tooby_smith_2024_index_notation] -/ @[expose] public section @@ -305,7 +305,6 @@ lemma Pure.prodP_permP_right {n n'} {c : Fin n → C} {c' : Fin n' → C} -/ -set_option backward.isDefEq.respectTransparency false in lemma Pure.prodP_assoc {n n1 n2} {c : Fin n → C} {c1 : Fin n1 → C} {c2 : Fin n2 → C} (p : Pure S c) (p1 : Pure S c1) (p2 : Pure S c2) : diff --git a/Physlib/Relativity/Tensors/RealTensor/Basic.lean b/Physlib/Relativity/Tensors/RealTensor/Basic.lean index b957145324..c550403afd 100644 --- a/Physlib/Relativity/Tensors/RealTensor/Basic.lean +++ b/Physlib/Relativity/Tensors/RealTensor/Basic.lean @@ -26,6 +26,7 @@ open TensorProduct namespace realLorentzTensor +set_option backward.isDefEq.respectTransparency false in /-- The colors associated with complex representations of SL(2, ℂ) of interest to physics. -/ inductive Color /-- The color associated with contravariant Lorentz vectors. -/ diff --git a/Physlib/Relativity/Tensors/RealTensor/CoVector/Basic.lean b/Physlib/Relativity/Tensors/RealTensor/CoVector/Basic.lean index e9636635c3..f3ac357874 100644 --- a/Physlib/Relativity/Tensors/RealTensor/CoVector/Basic.lean +++ b/Physlib/Relativity/Tensors/RealTensor/CoVector/Basic.lean @@ -28,9 +28,13 @@ noncomputable section namespace Lorentz -/-- Real contravariant Lorentz vector. -/ +/-- Real covariant Lorentz vector. -/ +@[implicit_reducible] def CoVector (d : ℕ := 3) := Fin 1 ⊕ Fin d → ℝ +/- As for `Vector`, `CoVector d` is applied directly as a function throughout the library; + marking it implicit-reducible lets such applications typecheck at implicit transparency. -/ + namespace CoVector instance {d} : AddCommMonoid (CoVector d) := @@ -89,6 +93,7 @@ instance (d : ℕ) : Inner ℝ (CoVector d) where lemma inner_eq_equivEuclid (d : ℕ) (v w : CoVector d) : ⟪v, w⟫_ℝ = ⟪equivEuclid d v, equivEuclid d w⟫_ℝ := rfl + /-- The Euclidean inner product structure on `CoVector`. -/ instance innerProductSpace (d : ℕ) : InnerProductSpace ℝ (CoVector d) where norm_sq_eq_re_inner v := by @@ -148,14 +153,14 @@ def basis {d : ℕ} : Basis (Fin 1 ⊕ Fin d) ℝ (CoVector d) := lemma basis_apply {d : ℕ} (μ ν : Fin 1 ⊕ Fin d) : basis μ ν = if μ = ν then 1 else 0 := by simp [basis] - erw [Pi.basisFun_apply, Pi.single_apply] + rw [Pi.basisFun_apply, Pi.single_apply] congr 1 exact Lean.Grind.eq_congr' rfl rfl lemma basis_repr_apply {d : ℕ} (p : CoVector d) (μ : Fin 1 ⊕ Fin d) : basis.repr p μ = p μ := by simp [basis] - erw [Pi.basisFun_repr] + rw [Pi.basisFun_repr] lemma map_apply_eq_basis_mulVec {d : ℕ} (f : CoVector d →ₗ[ℝ] CoVector d) (p : CoVector d) : (f p) = (LinearMap.toMatrix basis basis) f *ᵥ p := by diff --git a/Physlib/Relativity/Tensors/RealTensor/CoVector/Tensorial.lean b/Physlib/Relativity/Tensors/RealTensor/CoVector/Tensorial.lean index 5a5c6537f2..6f3de12bc0 100644 --- a/Physlib/Relativity/Tensors/RealTensor/CoVector/Tensorial.lean +++ b/Physlib/Relativity/Tensors/RealTensor/CoVector/Tensorial.lean @@ -165,18 +165,15 @@ lemma smul_eq_mulVec {d} (Λ : LorentzGroup d) (p : CoVector d) : lemma smul_add {d : ℕ} (Λ : LorentzGroup d) (p q : CoVector d) : Λ • (p + q) = Λ • p + Λ • q := by simp -set_option backward.isDefEq.respectTransparency false in @[simp] lemma smul_sub {d : ℕ} (Λ : LorentzGroup d) (p q : CoVector d) : Λ • (p - q) = Λ • p - Λ • q := by rw [smul_eq_mulVec, smul_eq_mulVec, smul_eq_mulVec, Matrix.mulVec_sub] -set_option backward.isDefEq.respectTransparency false in lemma smul_zero {d : ℕ} (Λ : LorentzGroup d) : Λ • (0 : CoVector d) = 0 := by rw [smul_eq_mulVec, Matrix.mulVec_zero] -set_option backward.isDefEq.respectTransparency false in lemma smul_neg {d : ℕ} (Λ : LorentzGroup d) (p : CoVector d) : Λ • (-p) = - (Λ • p) := by rw [smul_eq_mulVec, smul_eq_mulVec, Matrix.mulVec_neg] @@ -194,7 +191,6 @@ def actionCLM {d : ℕ} (Λ : LorentzGroup d) : lemma actionCLM_apply {d : ℕ} (Λ : LorentzGroup d) (p : CoVector d) : actionCLM Λ p = Λ • p := rfl -set_option backward.isDefEq.respectTransparency false in lemma smul_basis {d : ℕ} (Λ : LorentzGroup d) (μ : Fin 1 ⊕ Fin d) : Λ • basis μ = ∑ ν, Λ⁻¹.1 μ ν • basis ν := by funext i diff --git a/Physlib/Relativity/Tensors/RealTensor/Contraction/CrossToEnd.lean b/Physlib/Relativity/Tensors/RealTensor/Contraction/CrossToEnd.lean new file mode 100644 index 0000000000..857fc88913 --- /dev/null +++ b/Physlib/Relativity/Tensors/RealTensor/Contraction/CrossToEnd.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2026 Robert Sneiderman. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Robert Sneiderman +-/ +module + +public import Physlib.Relativity.Tensors.RealTensor.Basic +/-! + +# Components of real Lorentz cross contractions + +## i. Overview + +This file gives the standard-basis component formula for `crossToEnd` on real Lorentz tensors. +The contraction pairing of the standard covariant and contravariant bases reduces the generic +component expansion to one finite sum. + +## ii. Key results + +- `realLorentzTensor.crossToEnd_basis_repr_apply_eq_fin` expresses each component of a cross + contraction as a sum over the contracted Lorentz index. + +## iii. Table of contents + +- A. Basis components + +## iv. References + +* None. +-/ + +@[expose] public section + +noncomputable section + +namespace realLorentzTensor + +open TensorSpecies Tensor + +/-! + +## A. Basis components + +-/ + +/-- For real Lorentz tensors, the component formula for `crossToEnd` collapses to one sum because +the standard contravariant and covariant bases are dual under contraction. -/ +lemma crossToEnd_basis_repr_apply_eq_fin {d nA nB : ℕ} {cA : Fin (nA + 1) → Color} + {cB : Fin (nB + 1) → Color} (i : Fin (nA + 1)) (j : Fin (nB + 1)) + (hc : (realLorentzTensor d).τ (cA i) = cB j) (t : ℝT(d, cA)) (M : ℝT(d, cB)) + (φ : ComponentIdx (S := realLorentzTensor d) + (Fin.append (cA ∘ i.succAbove) (cB ∘ j.succAbove))) : + (Tensor.basis _).repr (crossToEnd i j hc t M) φ = + ∑ x : Fin 1 ⊕ Fin d, + (Tensor.basis cA).repr t (i.insertNth x (fun m => φ (Fin.castAdd nB m))) * + (Tensor.basis cB).repr M (j.insertNth x (fun m => φ (Fin.natAdd nA m))) := by + rw [crossToEnd] + simp only [LinearMap.compr₂_apply, LinearMap.comp_apply] + rw [permT_basis_repr_symm_apply, contrT_basis_repr_apply_eq_fin] + conv_lhs => enter [2, x]; rw [permT_basis_repr_symm_apply, prodT_basis_repr_apply] + simp only [basisIdxCongr_eq_refl, Equiv.refl_apply] + refine Finset.sum_congr rfl fun x _ => ?_ + simp only [ComponentIdx.prod, Equiv.coe_fn_mk, basisIdxCongr_eq_refl, Equiv.refl_apply] + congr 1 + · congr 1 + funext m + rw [IsReindexing.inv_cast_eq] + induction m using Fin.succAboveCases (i := i) with + | x => + rw [Fin.insertNth_apply_same] + exact ComponentIdx.DropPairSection.ofFinEquiv_apply_fst _ _ _ + | p q => + rw [Fin.insertNth_apply_succAbove] + conv_lhs => rw [← Fin.succSuccAbove_castAdd_natAdd_apply_castAdd i j q] + simp only [Fin.cast_cast, Fin.cast_eq_self] + rw [(ComponentIdx.DropPairSection.mem_iff_apply_succSuccAbove_eq _ _).mp + (ComponentIdx.DropPairSection.ofFinEquiv _ _ _).2] + simp only [basisIdxCongr_eq_refl, Equiv.refl_apply] + exact congrArg φ (IsReindexing.inv_id_eq _ _) + · congr 1 + funext m + rw [IsReindexing.inv_cast_eq] + induction m using Fin.succAboveCases (i := j) with + | x => + rw [Fin.insertNth_apply_same] + exact ComponentIdx.DropPairSection.ofFinEquiv_apply_snd _ _ _ + | p q => + rw [Fin.insertNth_apply_succAbove] + conv_lhs => rw [← Fin.succSuccAbove_castAdd_natAdd_apply_natAdd i j q] + simp only [Fin.cast_cast, Fin.cast_eq_self] + rw [(ComponentIdx.DropPairSection.mem_iff_apply_succSuccAbove_eq _ _).mp + (ComponentIdx.DropPairSection.ofFinEquiv _ _ _).2] + simp only [basisIdxCongr_eq_refl, Equiv.refl_apply] + exact congrArg φ (IsReindexing.inv_id_eq _ _) + +end realLorentzTensor diff --git a/Physlib/Relativity/Tensors/RealTensor/Matrix/Pre.lean b/Physlib/Relativity/Tensors/RealTensor/Matrix/Pre.lean index 7162b89567..86083f53de 100644 --- a/Physlib/Relativity/Tensors/RealTensor/Matrix/Pre.lean +++ b/Physlib/Relativity/Tensors/RealTensor/Matrix/Pre.lean @@ -27,6 +27,7 @@ def contrContrToMatrixRe {d : ℕ} : (ContrMod d ⊗[ℝ] ContrMod d) ≃ₗ[ℝ Finsupp.linearEquivFunOnFinite ℝ ℝ ((Fin 1 ⊕ Fin d) × (Fin 1 ⊕ Fin d)) ≪≫ₗ LinearEquiv.curry ℝ ℝ (Fin 1 ⊕ Fin d) (Fin 1 ⊕ Fin d) +set_option backward.isDefEq.respectTransparency false in /-- Expanding `contrContrToMatrixRe` in terms of the standard basis. -/ lemma contrContrToMatrixRe_symm_expand_tmul (M : Matrix (Fin 1 ⊕ Fin d) (Fin 1 ⊕ Fin d) ℝ) : contrContrToMatrixRe.symm M = ∑ i, ∑ j, M i j • (contrBasis d i ⊗ₜ[ℝ] contrBasis d j) := by @@ -46,6 +47,7 @@ def coCoToMatrixRe {d : ℕ} : (CoMod d ⊗[ℝ] CoMod d) ≃ₗ[ℝ] Finsupp.linearEquivFunOnFinite ℝ ℝ ((Fin 1 ⊕ Fin d) × (Fin 1 ⊕ Fin d)) ≪≫ₗ LinearEquiv.curry ℝ ℝ (Fin 1 ⊕ Fin d) (Fin 1 ⊕ Fin d) +set_option backward.isDefEq.respectTransparency false in /-- Expanding `coCoToMatrixRe` in terms of the standard basis. -/ lemma coCoToMatrixRe_symm_expand_tmul (M : Matrix (Fin 1 ⊕ Fin d) (Fin 1 ⊕ Fin d) ℝ) : coCoToMatrixRe.symm M = ∑ i, ∑ j, M i j • (coBasis d i ⊗ₜ[ℝ] coBasis d j) := by @@ -64,6 +66,7 @@ def contrCoToMatrixRe {d : ℕ} : (ContrMod d ⊗[ℝ] CoMod d) ≃ₗ[ℝ] Finsupp.linearEquivFunOnFinite ℝ ℝ ((Fin 1 ⊕ Fin d) × (Fin 1 ⊕ Fin d)) ≪≫ₗ LinearEquiv.curry ℝ ℝ (Fin 1 ⊕ Fin d) (Fin 1 ⊕ Fin d) +set_option backward.isDefEq.respectTransparency false in /-- Expansion of ` (coBasis d) (coBasis d)` in terms of the standard basis. -/ lemma contrCoToMatrixRe_symm_expand_tmul (M : Matrix (Fin 1 ⊕ Fin d) (Fin 1 ⊕ Fin d) ℝ) : contrCoToMatrixRe.symm M = ∑ i, ∑ j, M i j • (contrBasis d i ⊗ₜ[ℝ] coBasis d j) := by @@ -83,6 +86,7 @@ def coContrToMatrixRe : (CoMod d ⊗[ℝ] ContrMod d) ≃ₗ[ℝ] Finsupp.linearEquivFunOnFinite ℝ ℝ ((Fin 1 ⊕ Fin d) × (Fin 1 ⊕ Fin d)) ≪≫ₗ LinearEquiv.curry ℝ ℝ (Fin 1 ⊕ Fin d) (Fin 1 ⊕ Fin d) +set_option backward.isDefEq.respectTransparency false in /-- Expansion of `coContrToMatrixRe` in terms of the standard basis. -/ lemma coContrToMatrixRe_symm_expand_tmul (M : Matrix (Fin 1 ⊕ Fin d) (Fin 1 ⊕ Fin d) ℝ) : coContrToMatrixRe.symm M = ∑ i, ∑ j, M i j • (coBasis d i ⊗ₜ[ℝ] contrBasis d j) := by diff --git a/Physlib/Relativity/Tensors/RealTensor/Metrics/Basic.lean b/Physlib/Relativity/Tensors/RealTensor/Metrics/Basic.lean index 61061f0d79..f006a6b3be 100644 --- a/Physlib/Relativity/Tensors/RealTensor/Metrics/Basic.lean +++ b/Physlib/Relativity/Tensors/RealTensor/Metrics/Basic.lean @@ -1,12 +1,11 @@ /- Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joseph Tooby-Smith +Authors: Robert Sneiderman, Joseph Tooby-Smith -/ module -public import Physlib.Relativity.Tensors.RealTensor.Basic -public import Physlib.Relativity.Tensors.MetricTensor +public import Physlib.Relativity.Tensors.RealTensor.Contraction.CrossToEnd /-! ## Metrics as real Lorentz tensors @@ -97,7 +96,7 @@ lemma actionT_contrMetric {d} (g : LorentzGroup d) : g • η d = η d := by /- -## There value with respect to a basis +## Their value with respect to a basis -/ @@ -105,7 +104,11 @@ lemma coMetric_repr_apply_eq_minkowskiMatrix {d : ℕ} (b : ComponentIdx (S := realLorentzTensor d) ![Color.down, Color.down]) : (Tensor.basis _).repr (coMetric d) b = minkowskiMatrix (b 0) (b 1) := by - rw [coMetric_eq_fromPairT, fromPairT_basis_repr, + change (Tensor.basis _).repr + (metricTensor (S := realLorentzTensor d) Color.down) b = _ + rw [metricTensor_basis_repr, + show ((realLorentzTensor d).metric Color.down) (1 : ℝ) = Lorentz.preCoMetricVal d from + Lorentz.preCoMetric_apply_one, Lorentz.preCoMetricVal_expand_tmul_minkowskiMatrix] simp only [map_sum, Finsupp.coe_finsetSum, Finset.sum_apply, map_smul, Finsupp.coe_smul, Pi.smul_apply, Basis.tensorProduct_repr_tmul_apply, Basis.repr_self, Finsupp.single_apply, @@ -117,7 +120,11 @@ lemma contrMetric_repr_apply_eq_minkowskiMatrix {d : ℕ} (b : ComponentIdx (S := realLorentzTensor d) ![Color.up, Color.up]) : (Tensor.basis _).repr (contrMetric d) b = minkowskiMatrix (b 0) (b 1) := by - rw [contrMetric_eq_fromPairT, fromPairT_basis_repr, + change (Tensor.basis _).repr + (metricTensor (S := realLorentzTensor d) Color.up) b = _ + rw [metricTensor_basis_repr, + show ((realLorentzTensor d).metric Color.up) (1 : ℝ) = Lorentz.preContrMetricVal d from + Lorentz.preContrMetric_apply_one, Lorentz.preContrMetricVal_expand_tmul_minkowskiMatrix] simp only [map_sum, Finsupp.coe_finsetSum, Finset.sum_apply, map_smul, Finsupp.coe_smul, Pi.smul_apply, Basis.tensorProduct_repr_tmul_apply, Basis.repr_self, Finsupp.single_apply, @@ -125,4 +132,60 @@ lemma contrMetric_repr_apply_eq_minkowskiMatrix {d : ℕ} rw [Finset.sum_eq_single (b 0)] <;> simp +contextual [minkowskiMatrix.as_diagonal, Matrix.diagonal_apply] +/-- The component matrix of either real Lorentz metric tensor is the Minkowski matrix. -/ +lemma metricTensor_repr_apply_eq_minkowskiMatrix {d : ℕ} (c : Color) + (φ : ComponentIdx (S := realLorentzTensor d) ![c, c]) : + (Tensor.basis _).repr (metricTensor (S := realLorentzTensor d) c) φ = + minkowskiMatrix (φ 0) (φ 1) := by + cases c with + | up => exact contrMetric_repr_apply_eq_minkowskiMatrix φ + | down => exact coMetric_repr_apply_eq_minkowskiMatrix φ + +set_option backward.isDefEq.respectTransparency false in +/-- Raising or lowering one index of a real Lorentz tensor contracts that slot's components with +the Minkowski matrix. -/ +lemma toDualMapAtIndex_basis_repr_apply {d n : ℕ} {c : Fin (n + 1) → Color} + (i : Fin (n + 1)) (t : ℝT(d, c)) + (φ : ComponentIdx (S := realLorentzTensor d) + (Function.update c i ((realLorentzTensor d).τ (c i)))) : + (Tensor.basis _).repr (Tensor.toDualMapAtIndex (S := realLorentzTensor d) i t) φ = + ∑ x : Fin 1 ⊕ Fin d, + (Tensor.basis c).repr t (i.insertNth x (fun m => φ (i.succAbove m))) * + minkowskiMatrix x (φ i) := by + have h := crossToSlot_basis_repr_apply (S := realLorentzTensor d) i (0 : Fin 2) rfl + (metricTensor (S := realLorentzTensor d) ((realLorentzTensor d).τ (c i))) t φ + rw [crossToEnd_basis_repr_apply_eq_fin] at h + simp only [basisIdxCongr_eq_refl, Equiv.refl_apply] at h + refine h.trans (Finset.sum_congr rfl fun x _ => ?_) + congr 1 + · congr 1 + funext m + induction m using Fin.succAboveCases (i := i) with + | x => rw [Fin.insertNth_apply_same, Fin.insertNth_apply_same] + | p q => + rw [Fin.insertNth_apply_succAbove, Fin.insertNth_apply_succAbove, + IsReindexing.inv_equiv_symm_eq, + ← Fin.append_succAbove_const_eq_cycleIcc i, Fin.append_left] + rw [metricTensor_repr_apply_eq_minkowskiMatrix] + congr 1 + rw [show (1 : Fin 2) = (0 : Fin 2).succAbove 0 from rfl, + Fin.insertNth_apply_succAbove, IsReindexing.inv_equiv_symm_eq, + ← Fin.append_succAbove_const_eq_cycleIcc i, Fin.append_right] + +/-- In the standard Lorentz basis, raising or lowering an index multiplies the component with that +index fixed by the corresponding diagonal entry of the Minkowski metric. -/ +lemma toDualMapAtIndex_basis_repr_apply_eq_mul {d n : ℕ} {c : Fin (n + 1) → Color} + (i : Fin (n + 1)) (t : ℝT(d, c)) + (φ : ComponentIdx (S := realLorentzTensor d) + (Function.update c i ((realLorentzTensor d).τ (c i)))) : + (Tensor.basis _).repr (Tensor.toDualMapAtIndex (S := realLorentzTensor d) i t) φ = + (Tensor.basis c).repr t φ * minkowskiMatrix (φ i) (φ i) := by + rw [toDualMapAtIndex_basis_repr_apply] + change ((fun x => (Tensor.basis c).repr t + (i.insertNth x (fun m => φ (i.succAbove m)))) ᵥ* minkowskiMatrix) (φ i) = _ + rw [minkowskiMatrix.vecMul_apply] + congr 2 + change (i.insertNth (φ i) (i.removeNth φ) : Fin (n + 1) → Fin 1 ⊕ Fin d) = φ + exact Fin.insertNth_self_removeNth i φ + end realLorentzTensor diff --git a/Physlib/Relativity/Tensors/RealTensor/Metrics/Pre.lean b/Physlib/Relativity/Tensors/RealTensor/Metrics/Pre.lean index d346da31b0..2125831420 100644 --- a/Physlib/Relativity/Tensors/RealTensor/Metrics/Pre.lean +++ b/Physlib/Relativity/Tensors/RealTensor/Metrics/Pre.lean @@ -38,7 +38,6 @@ lemma preContrMetricVal_expand_tmul {d : ℕ} : preContrMetricVal d = simp [Fintype.sum_sum_type, minkowskiMatrix.inl_0_inl_0, minkowskiMatrix.inr_i_inr_i, sub_eq_add_neg] -set_option backward.isDefEq.respectTransparency false in /-- The metric `ηᵃᵃ` as a morphism `𝟙_ (Rep ℝ (LorentzGroup d)) ⟶ ContrMod.rep ⊗ ContrMod.rep`, making its invariance under the action of `LorentzGroup d`. -/ def preContrMetric (d : ℕ := 3) : @@ -81,7 +80,6 @@ lemma preCoMetricVal_expand_tmul {d : ℕ} : preCoMetricVal d = simp [Fintype.sum_sum_type, minkowskiMatrix.inl_0_inl_0, minkowskiMatrix.inr_i_inr_i, sub_eq_add_neg] -set_option backward.isDefEq.respectTransparency false in /-- The metric `ηᵢᵢ` as a morphism `𝟙_ (Rep ℂ (LorentzGroup d))) ⟶ CoMod.rep ⊗ CoMod.rep`, making its invariance under the action of `LorentzGroup d`. -/ def preCoMetric (d : ℕ := 3) : (Representation.trivial ℝ (LorentzGroup d) ℝ).IntertwiningMap diff --git a/Physlib/Relativity/Tensors/RealTensor/ToComplex.lean b/Physlib/Relativity/Tensors/RealTensor/ToComplex.lean index b60e25f967..c9d2e04be3 100644 --- a/Physlib/Relativity/Tensors/RealTensor/ToComplex.lean +++ b/Physlib/Relativity/Tensors/RealTensor/ToComplex.lean @@ -53,10 +53,9 @@ The main definitions and statements are: ## iv. References -The general formalism of Lorentz tensors and their operations is developed in -other parts of the library; here we only specialise to the passage from real to -complex Lorentz tensors. - +* None — the general formalism of Lorentz tensors and their operations is + developed in other parts of the library; here we only specialise to the + passage from real to complex Lorentz tensors. -/ @[expose] public section @@ -232,6 +231,7 @@ open Lorentz.SL2C ## pure -/ +set_option backward.isDefEq.respectTransparency false in /-- For a given color, the map turning a real Lorentz vector into a complex one. -/ noncomputable def toComplexVector (c : realLorentzTensor.Color) : realLorentzTensor.modules 3 c →ₛₗ[Complex.ofRealHom] complexLorentzTensor.modules @@ -248,13 +248,11 @@ noncomputable def toComplexVector (c : realLorentzTensor.Color) : congr funext x rw [add_smul] - rfl | Color.down => simp only [map_add, Finsupp.coe_add, Pi.add_apply, Nat.reduceAdd, ← Finset.sum_add_distrib] congr funext x rw [add_smul] - rfl map_smul' r v := by match c with | Color.up => @@ -264,7 +262,6 @@ noncomputable def toComplexVector (c : realLorentzTensor.Color) : congr funext x rw [← smul_smul] - rfl | Color.down => simp only [map_smul, Finsupp.coe_smul, Pi.smul_apply, smul_eq_mul, Nat.reduceAdd, Complex.ofRealHom_eq_coe, Complex.coe_smul] @@ -272,7 +269,6 @@ noncomputable def toComplexVector (c : realLorentzTensor.Color) : congr funext x rw [← smul_smul] - rfl lemma toComplexVector_up_eq_inclCongrRealLorentz (v : Lorentz.ContrMod 3) : toComplexVector Color.up v = Lorentz.inclCongrRealLorentz v := by @@ -412,7 +408,6 @@ Finally we record that `toComplex` is equivariant for the natural action of -/ -set_option backward.isDefEq.respectTransparency false in /-- The map `toComplex` is equivariant. -/ lemma toComplex_equivariant {n} {c : Fin n → realLorentzTensor.Color} (v : ℝT(3, c)) (Λ : SL(2, ℂ)) : @@ -464,6 +459,7 @@ by the operator `permT`. (b (σ j))) := by simp [Tensor.basis_apply, permT_pure, Pure.permP_basisVector, basisIdxCongr_eq_cast] +set_option backward.isDefEq.respectTransparency false in /-- The map `toComplex` commutes with permT. -/ lemma permT_toComplex {n m : ℕ} {c : Fin n → realLorentzTensor.Color} @@ -530,6 +526,7 @@ private lemma cast_componentIdx_eq_fun {n : ℕ} Fin.cast (congr_arg (fun col => complexLorentzTensor.repDim (col x)) h) (f x)) := funext fun x => cast_componentIdx_apply h f x +set_option backward.isDefEq.respectTransparency false in /-- `complexify` commutes with `prod` of component indices. -/ @[simp] lemma complexify_prod {n m : ℕ} @@ -550,7 +547,6 @@ lemma complexify_prod {n m : ℕ} erw [basisIdxCongr_eq_cast] simp -set_option backward.isDefEq.respectTransparency false in /-- The map `toComplex` commutes with prodT. -/ lemma prodT_toComplex {n m : ℕ} {c : Fin n → realLorentzTensor.Color} @@ -631,7 +627,6 @@ lemma toComplex_contrP_basisVector {n : ℕ} {c : Fin (n + 1 + 1) → realLorent rw [Pure.dropPair_basisVector, ← Tensor.basis_apply] exact congr_arg _ (funext fun m => ComponentIdx.complexify_comp_succSuccAbove b m) -set_option backward.isDefEq.respectTransparency false in /-- The map `toComplex` commutes with `contrT`. -/ lemma contrT_toComplex {n : ℕ} {c : Fin (n + 1 + 1) → realLorentzTensor.Color} {i j : Fin (n + 1 + 1)} diff --git a/Physlib/Relativity/Tensors/RealTensor/Units/Basic.lean b/Physlib/Relativity/Tensors/RealTensor/Units/Basic.lean new file mode 100644 index 0000000000..6c567308a3 --- /dev/null +++ b/Physlib/Relativity/Tensors/RealTensor/Units/Basic.lean @@ -0,0 +1,75 @@ +/- +Copyright (c) 2026 Robert Sneiderman. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Robert Sneiderman +-/ +module + +public import Physlib.Relativity.Tensors.RealTensor.Basic +/-! + +# Unit tensors for real Lorentz tensors + +## i. Overview + +This file computes the unit tensors of `realLorentzTensor` in the standard covariant and +contravariant bases. + +## ii. Key results + +- `realLorentzTensor.unitTensor_repr_apply` identifies the standard-basis components of either + real Lorentz unit tensor with the Kronecker delta. + +## iii. Table of contents + +- A. Basis components + +## iv. References + +* None. +-/ + +@[expose] public section + +open Module TensorProduct + +noncomputable section + +namespace realLorentzTensor + +open TensorSpecies Tensor + +/-! + +## A. Basis components + +-/ + +set_option backward.isDefEq.respectTransparency false in +/-- In the standard contravariant and covariant bases, either real Lorentz unit tensor has +Kronecker-delta components. -/ +lemma unitTensor_repr_apply {d : ℕ} (c : Color) + (φ : ComponentIdx (S := realLorentzTensor d) ![(realLorentzTensor d).τ c, c]) : + (Tensor.basis _).repr (unitTensor (S := realLorentzTensor d) c) φ = + if φ 0 = φ 1 then 1 else 0 := by + cases c with + | up => + rw [unitTensor_basis_repr, + show ((realLorentzTensor d).unit Color.up) (1 : ℝ) = Lorentz.preCoContrUnitVal d from + Lorentz.preCoContrUnit_apply_one] + simp only [τ_up_eq_down] + rw [Lorentz.preCoContrUnitVal_expand_tmul] + simp only [map_sum, Finsupp.coe_finsetSum, Finset.sum_apply, + Basis.tensorProduct_repr_tmul_apply, Basis.repr_self, Finsupp.single_apply, smul_eq_mul] + rw [Finset.sum_eq_single (φ 0)] <;> aesop + | down => + rw [unitTensor_basis_repr, + show ((realLorentzTensor d).unit Color.down) (1 : ℝ) = Lorentz.preContrCoUnitVal d from + Lorentz.preContrCoUnit_apply_one] + simp only [τ_down_eq_up] + rw [Lorentz.preContrCoUnitVal_expand_tmul] + simp only [map_sum, Finsupp.coe_finsetSum, Finset.sum_apply, + Basis.tensorProduct_repr_tmul_apply, Basis.repr_self, Finsupp.single_apply, smul_eq_mul] + rw [Finset.sum_eq_single (φ 0)] <;> aesop + +end realLorentzTensor diff --git a/Physlib/Relativity/Tensors/RealTensor/Units/Pre.lean b/Physlib/Relativity/Tensors/RealTensor/Units/Pre.lean index 605ae3f2c4..2a994ee7e7 100644 --- a/Physlib/Relativity/Tensors/RealTensor/Units/Pre.lean +++ b/Physlib/Relativity/Tensors/RealTensor/Units/Pre.lean @@ -43,7 +43,6 @@ lemma preContrCoUnitVal_expand_tmul {d : ℕ} : preContrCoUnitVal d = simp [hb] · simp -set_option backward.isDefEq.respectTransparency false in /-- The contra-co unit for complex lorentz vectors as a morphism `𝟙_ (Rep ℂ SL(2,ℂ)) ⟶ complexContr ⊗ complexCo`, manifesting the invariance under the `SL(2, ℂ)` action. -/ @@ -95,7 +94,6 @@ lemma preCoContrUnitVal_expand_tmul {d : ℕ} : preCoContrUnitVal d = simp [hb] · simp -set_option backward.isDefEq.respectTransparency false in /-- The co-contra unit for complex lorentz vectors as a morphism `𝟙_ (Rep ℝ (LorentzGroup d)) ⟶ CoMod.rep ⊗ ContrMod.rep`, manifesting the invariance under the `LorentzGroup d` action. -/ diff --git a/Physlib/Relativity/Tensors/RealTensor/Vector/Basic.lean b/Physlib/Relativity/Tensors/RealTensor/Vector/Basic.lean index 529398ff46..0e40391384 100644 --- a/Physlib/Relativity/Tensors/RealTensor/Vector/Basic.lean +++ b/Physlib/Relativity/Tensors/RealTensor/Vector/Basic.lean @@ -29,8 +29,14 @@ noncomputable section namespace Lorentz /-- Real contravariant Lorentz vector. -/ +@[implicit_reducible] def Vector (d : ℕ := 3) := Fin 1 ⊕ Fin d → ℝ +/- `Vector d` is applied directly as a function throughout the library. Marking it + implicit-reducible lets such applications typecheck at implicit transparency, so that + `rw` and `simp` can match patterns containing them (see the Lean 4.33 release notes on + `backward.isDefEq.respectTransparency.types`). -/ + namespace Vector instance {d} : AddCommMonoid (Vector d) := @@ -116,6 +122,11 @@ instance innerProductSpace (d : ℕ) : InnerProductSpace ℝ (Vector d) where simp only [inner_eq_equivEuclid, map_smul] exact InnerProductSpace.smul_left (equivEuclid d x) (equivEuclid d y) r +/-- The inner product on `Vector d` as a sum over components. -/ +lemma inner_eq_sum {d : ℕ} (v w : Vector d) : ⟪v, w⟫_ℝ = ∑ μ, v μ * w μ := by + rw [inner_eq_equivEuclid, PiLp.inner_apply] + simp [mul_comm] + /-- The instance of a `ChartedSpace` on `Vector d`. -/ instance : ChartedSpace (Vector d) (Vector d) := chartedSpaceSelf (Vector d) @@ -278,14 +289,14 @@ def basis {d : ℕ} : Basis (Fin 1 ⊕ Fin d) ℝ (Vector d) := lemma basis_apply {d : ℕ} (μ ν : Fin 1 ⊕ Fin d) : basis μ ν = if μ = ν then 1 else 0 := by simp [basis] - erw [Pi.basisFun_apply, Pi.single_apply] + rw [Pi.basisFun_apply, Pi.single_apply] congr 1 exact Lean.Grind.eq_congr' rfl rfl lemma basis_repr_apply {d : ℕ} (p : Vector d) (μ : Fin 1 ⊕ Fin d) : basis.repr p μ = p μ := by simp [basis] - erw [Pi.basisFun_repr] + rw [Pi.basisFun_repr] lemma map_apply_eq_basis_mulVec {d : ℕ} (f : Vector d →ₗ[ℝ] Vector d) (p : Vector d) : (f p) = (LinearMap.toMatrix basis basis) f *ᵥ p := by @@ -433,15 +444,11 @@ open InnerProductSpace lemma basis_inner {d : ℕ} (μ : Fin 1 ⊕ Fin d) (p : Lorentz.Vector d) : ⟪Lorentz.Vector.basis μ, p⟫_ℝ = p μ := by - simp [inner_eq_equivEuclid] - rw [PiLp.inner_apply] - simp + simp [inner_eq_sum] lemma inner_basis {d : ℕ} (p : Lorentz.Vector d) (μ : Fin 1 ⊕ Fin d) : ⟪p, Lorentz.Vector.basis μ⟫_ℝ = p μ := by - simp [inner_eq_equivEuclid] - rw [PiLp.inner_apply] - simp + simp [inner_eq_sum] end Vector diff --git a/Physlib/Relativity/Tensors/RealTensor/Vector/MinkowskiProduct.lean b/Physlib/Relativity/Tensors/RealTensor/Vector/MinkowskiProduct.lean index 2dbe8d943a..6f75ee9259 100644 --- a/Physlib/Relativity/Tensors/RealTensor/Vector/MinkowskiProduct.lean +++ b/Physlib/Relativity/Tensors/RealTensor/Vector/MinkowskiProduct.lean @@ -143,7 +143,6 @@ lemma minkowskiProduct_toCoord_minkowskiMatrix {d : ℕ} (p q : Vector d) : neg_mul, Finset.sum_neg_distrib] rfl -set_option backward.isDefEq.respectTransparency false in @[simp] lemma minkowskiProduct_invariant {d : ℕ} (p q : Vector d) (Λ : LorentzGroup d) : ⟪Λ • p, Λ • q⟫ₘ = ⟪p, q⟫ₘ := by diff --git a/Physlib/Relativity/Tensors/RealTensor/Vector/Pre/Basic.lean b/Physlib/Relativity/Tensors/RealTensor/Vector/Pre/Basic.lean index f2f6c988c8..c07df048cb 100644 --- a/Physlib/Relativity/Tensors/RealTensor/Vector/Pre/Basic.lean +++ b/Physlib/Relativity/Tensors/RealTensor/Vector/Pre/Basic.lean @@ -64,7 +64,6 @@ lemma continuous_contr {T : Type} [TopologicalSpace T] (f : T → ContrMod d) (h : Continuous (fun i => (f i).toFin1dℝ)) : Continuous f := by exact continuous_induced_rng.mpr h -set_option backward.isDefEq.respectTransparency false in lemma contr_continuous {T : Type} [TopologicalSpace T] (f : ContrMod d → T) (h : Continuous (f ∘ (@ContrMod.toFin1dℝEquiv d).symm)) : Continuous f := by let x := Equiv.toHomeomorphOfIsInducing (@ContrMod.toFin1dℝEquiv d).toEquiv diff --git a/Physlib/Relativity/Tensors/RealTensor/Vector/Pre/Contraction.lean b/Physlib/Relativity/Tensors/RealTensor/Vector/Pre/Contraction.lean index 1d82b73a53..06fc785a6e 100644 --- a/Physlib/Relativity/Tensors/RealTensor/Vector/Pre/Contraction.lean +++ b/Physlib/Relativity/Tensors/RealTensor/Vector/Pre/Contraction.lean @@ -278,7 +278,6 @@ lemma nondegenerate : (∀ (x : ContrMod d), ⟪x, y⟫ₘ = 0) ↔ y = 0 := by · exact (self_parity_eq_zero_iff _).mp ((symm _ _).trans $ h _) · simp [h] -set_option backward.isDefEq.respectTransparency false in lemma matrix_apply_eq_iff_sub : ⟪x, Λ *ᵥ y⟫ₘ = ⟪x, Λ' *ᵥ y⟫ₘ ↔ ⟪x, (Λ - Λ') *ᵥ y⟫ₘ = 0 := by rw [← sub_eq_zero, ← LinearMap.map_sub, ← tmul_sub, ← ContrMod.sub_mulVec Λ Λ' y] @@ -320,7 +319,6 @@ lemma _root_.LorentzGroup.mem_iff_invariant : Λ ∈ LorentzGroup d ↔ rw [← matrix_eq_id_iff] at h exact LorentzGroup.mem_iff_dual_mul_self.mpr h -set_option backward.isDefEq.respectTransparency false in lemma _root_.LorentzGroup.mem_iff_norm : Λ ∈ LorentzGroup d ↔ ∀ (w : ContrMod d), ⟪Λ *ᵥ w, Λ *ᵥ w⟫ₘ = ⟪w, w⟫ₘ := by rw [LorentzGroup.mem_iff_invariant] diff --git a/Physlib/Relativity/Tensors/RealTensor/Vector/Pre/Modules.lean b/Physlib/Relativity/Tensors/RealTensor/Vector/Pre/Modules.lean index 72d7b7d89e..6be54744e7 100644 --- a/Physlib/Relativity/Tensors/RealTensor/Vector/Pre/Modules.lean +++ b/Physlib/Relativity/Tensors/RealTensor/Vector/Pre/Modules.lean @@ -43,18 +43,18 @@ lemma ext {ψ ψ' : ContrMod d} (h : ψ.val = ψ'.val) : ψ = ψ' := by subst h rfl -/-- The equivalence between `ContrℝModule` and `Fin 1 ⊕ Fin d → ℂ`. -/ +/-- The equivalence between `ContrMod` and `Fin 1 ⊕ Fin d → ℝ`. -/ def toFin1dℝFun : ContrMod d ≃ (Fin 1 ⊕ Fin d → ℝ) where toFun v := v.val invFun f := ⟨f⟩ left_inv _ := rfl right_inv _ := rfl -/-- The instance of `AddCommGroup` on `ContrℝModule` defined via its equivalence +/-- The instance of `AddCommGroup` on `ContrMod` defined via its equivalence with `Fin 1 ⊕ Fin d → ℝ`. -/ instance : AddCommGroup (ContrMod d) := Equiv.addCommGroup toFin1dℝFun -/-- The instance of `Module` on `ContrℝModule` defined via its equivalence +/-- The instance of `Module` on `ContrMod` defined via its equivalence with `Fin 1 ⊕ Fin d → ℝ`. -/ instance : Module ℝ (ContrMod d) := Equiv.module ℝ toFin1dℝFun @@ -64,11 +64,11 @@ lemma val_add (ψ ψ' : ContrMod d) : (ψ + ψ').val = ψ.val + ψ'.val := rfl @[simp] lemma val_smul (r : ℝ) (ψ : ContrMod d) : (r • ψ).val = r • ψ.val := rfl -/-- The linear equivalence between `ContrℝModule` and `(Fin 1 ⊕ Fin d → ℝ)`. -/ +/-- The linear equivalence between `ContrMod` and `(Fin 1 ⊕ Fin d → ℝ)`. -/ def toFin1dℝEquiv : ContrMod d ≃ₗ[ℝ] (Fin 1 ⊕ Fin d → ℝ) := Equiv.linearEquiv ℝ toFin1dℝFun -/-- The underlying element of `Fin 1 ⊕ Fin d → ℝ` of a element in `ContrℝModule` defined +/-- The underlying element of `Fin 1 ⊕ Fin d → ℝ` of a element in `ContrMod` defined through the linear equivalence `toFin1dℝEquiv`. -/ abbrev toFin1dℝ (ψ : ContrMod d) := toFin1dℝEquiv ψ @@ -79,7 +79,7 @@ lemma toFin1dℝ_eq_val (ψ : ContrMod d) : ψ.toFin1dℝ = ψ.val := by rfl -/ -/-- The standard basis of `ContrℝModule` indexed by `Fin 1 ⊕ Fin d`. -/ +/-- The standard basis of `ContrMod` indexed by `Fin 1 ⊕ Fin d`. -/ def stdBasis : Basis (Fin 1 ⊕ Fin d) ℝ (ContrMod d) := Basis.ofEquivFun toFin1dℝEquiv @[simp] @@ -173,7 +173,7 @@ lemma mulVec_mulVec (M N : Matrix (Fin 1 ⊕ Fin d) (Fin 1 ⊕ Fin d) ℝ) (v : ## The norm -(Not the Minkowski norm, but the norm of a vector in `ContrℝModule d`.) +(Not the Minkowski norm, but the norm of a vector in `ContrMod d`.) -/ /-- A `NormedAddCommGroup` structure on `ContrMod`. This is not an instance, as we @@ -197,7 +197,7 @@ def toSpace (v : ContrMod d) : EuclideanSpace ℝ (Fin d) := WithLp.toLp 2 (v.va -/ -/-- The representation of the Lorentz group acting on `ContrℝModule d`. -/ +/-- The representation of the Lorentz group acting on `ContrMod d`. -/ def rep : Representation ℝ (LorentzGroup d) (ContrMod d) where toFun g := Matrix.toLinAlgEquiv stdBasis g map_one' := EmbeddingLike.map_eq_one_iff.mpr rfl diff --git a/Physlib/Relativity/Tensors/RealTensor/Vector/Tensorial.lean b/Physlib/Relativity/Tensors/RealTensor/Vector/Tensorial.lean index 245f32c5fe..452bbda0bd 100644 --- a/Physlib/Relativity/Tensors/RealTensor/Vector/Tensorial.lean +++ b/Physlib/Relativity/Tensors/RealTensor/Vector/Tensorial.lean @@ -125,6 +125,39 @@ lemma tensor_basis_repr_toTensor_apply {d : ℕ} (p : Vector d) (μ : ComponentI /-! +## Tensor products of vectors + +-/ + +/-- Evaluating both indices of an element of `Vector d ⊗ Vector d` gives its coefficient + in the tensor-product basis. -/ +lemma toField_eval_eval_eq_tensorProduct_repr {d} (F : Vector d ⊗[ℝ] Vector d) + (μ ν : Fin 1 ⊕ Fin d) : + toField {F | [μ] [ν]}ᵀ = (basis.tensorProduct basis).repr F (μ, ν) := by + conv_rhs => rw [Tensorial.prod_eq_sum_eval basis_eq_map_tensor_basis basis_eq_map_tensor_basis F] + simp [-Fintype.sum_sum_type, Basis.tensorProduct_repr_tmul_apply, Finsupp.single_apply] + rfl + +/-- The coefficient of an element of `Vector d ⊗ Vector d` in the tensor basis is its + coefficient in the tensor-product basis. -/ +lemma tensor_basis_repr_toTensor_prod_apply {d} (F : Vector d ⊗[ℝ] Vector d) + (b : ComponentIdx (S := realLorentzTensor d) (Fin.append ![Color.up] ![Color.up])) : + (Tensor.basis _).repr (toTensor F) b = (basis.tensorProduct basis).repr F (b 0, b 1) := by + rw [Tensorial.basis_toTensor_apply, Tensorial.basis_map_prod] + simp only [Nat.reduceSucc, Nat.reduceAdd, Basis.repr_reindex, Finsupp.mapDomain_equiv_apply, + Equiv.symm_symm, Fin.isValue] + rw [tensor_basis_map_eq_basis_reindex] + have hb : (((basis (d := d)).reindex indexEquiv.symm).tensorProduct + (basis.reindex indexEquiv.symm)) = + ((basis (d := d)).tensorProduct (basis (d := d))).reindex + (indexEquiv.symm.prodCongr indexEquiv.symm) := by + ext ⟨i, j⟩ + simp + rw [hb, Module.Basis.repr_reindex_apply] + congr 1 + +/-! + ## The action of the Lorentz group -/ @@ -161,18 +194,15 @@ lemma smul_eq_mulVec {d} (Λ : LorentzGroup d) (p : Vector d) : lemma smul_add {d : ℕ} (Λ : LorentzGroup d) (p q : Vector d) : Λ • (p + q) = Λ • p + Λ • q := by simp -set_option backward.isDefEq.respectTransparency false in @[simp] lemma smul_sub {d : ℕ} (Λ : LorentzGroup d) (p q : Vector d) : Λ • (p - q) = Λ • p - Λ • q := by rw [smul_eq_mulVec, smul_eq_mulVec, smul_eq_mulVec, Matrix.mulVec_sub] -set_option backward.isDefEq.respectTransparency false in lemma smul_zero {d : ℕ} (Λ : LorentzGroup d) : Λ • (0 : Vector d) = 0 := by rw [smul_eq_mulVec, Matrix.mulVec_zero] -set_option backward.isDefEq.respectTransparency false in lemma smul_neg {d : ℕ} (Λ : LorentzGroup d) (p : Vector d) : Λ • (-p) = - (Λ • p) := by rw [smul_eq_mulVec, smul_eq_mulVec, Matrix.mulVec_neg] @@ -219,7 +249,6 @@ lemma actionCLM_surjective {d : ℕ} (Λ : LorentzGroup d) : use (actionCLM Λ⁻¹) x1 simp [actionCLM_apply] -set_option backward.isDefEq.respectTransparency false in lemma smul_basis {d : ℕ} (Λ : LorentzGroup d) (μ : Fin 1 ⊕ Fin d) : Λ • basis μ = ∑ ν, Λ.1 ν μ • basis ν := by funext i diff --git a/Physlib/Relativity/Tensors/RealTensor/Velocity/Basic.lean b/Physlib/Relativity/Tensors/RealTensor/Velocity/Basic.lean index 0720cd529c..3ef9f8b7dc 100644 --- a/Physlib/Relativity/Tensors/RealTensor/Velocity/Basic.lean +++ b/Physlib/Relativity/Tensors/RealTensor/Velocity/Basic.lean @@ -20,7 +20,7 @@ Lorentz vectors which have norm equal to one and which are future-directed. open TensorProduct namespace Lorentz -open Vector +open _root_.Lorentz.Vector /-- A Lorentz Velocity is a Lorentz vector which has norm equal to one and which is future-directed. -/ diff --git a/Physlib/Relativity/Tensors/Reindexing.lean b/Physlib/Relativity/Tensors/Reindexing.lean index 6bbb7e51da..e4d4195b0b 100644 --- a/Physlib/Relativity/Tensors/Reindexing.lean +++ b/Physlib/Relativity/Tensors/Reindexing.lean @@ -143,6 +143,32 @@ lemma inv_apply_apply {n m : ℕ} {c : Fin n → C} {c1 : Fin m → C} change h.toEquiv.symm (h.toEquiv x) = x simp +lemma inv_eq_self_of_pointwise_eq {n : ℕ} {c c1 : Fin n → C} {σ : Fin n → Fin n} + (h : IsReindexing c c1 σ) (hσ : ∀ x, σ x = x) (x : Fin n) : + h.inv σ x = x := by + have hx := h.inv_apply_apply σ x + rw [hσ] at hx + exact hx + +lemma inv_id_eq {n : ℕ} {c c1 : Fin n → C} + (h : IsReindexing c c1 (id : Fin n → Fin n)) (x : Fin n) : + h.inv (id : Fin n → Fin n) x = x := + h.inv_apply_apply (id : Fin n → Fin n) x + +lemma inv_cast_eq {n m : ℕ} {c : Fin n → C} {c1 : Fin m → C} (e : m = n) + (h : IsReindexing c c1 (Fin.cast e)) (x : Fin n) : + h.inv (Fin.cast e) x = Fin.cast e.symm x := by + have hx := h.inv_apply_apply (Fin.cast e) x + have hval : (h.inv (Fin.cast e) x).val = x.val := congrArg Fin.val hx + exact Fin.val_inj.mp hval + +lemma inv_equiv_symm_eq {n : ℕ} {c c1 : Fin n → C} (e : Equiv.Perm (Fin n)) + (h : IsReindexing c c1 ⇑e.symm) (x : Fin n) : + h.inv ⇑e.symm x = e x := by + have hx := h.inv_apply_apply ⇑e.symm x + apply e.symm.injective + rw [hx, Equiv.symm_apply_apply] + lemma preserve_color {n m : ℕ} {c : Fin n → C} {c1 : Fin m → C} {σ : Fin m → Fin n} (h : IsReindexing c c1 σ) : ∀ (x : Fin m), c1 x = (c ∘ σ) x := by @@ -491,10 +517,7 @@ lemma succSuccAbove_succAbove_comm {n : ℕ} {c : Fin (n + 1 + 1 + 1) → C} refine ⟨Function.bijective_id, fun m => ?_⟩ simp only [id_eq, Function.comp_apply] congr 1 - apply Fin.val_injective - simp only [Fin.succSuccAbove, Fin.succAbove, lt_def, val_castSucc, - val_succ, apply_ite Fin.val, apply_dite Fin.val, Fin.predAbove, Fin.castPred] - grind (splits := 60) + exact Fin.succSuccAbove_succAbove_comm_apply i j k m /-- Removing two single entries from `c` in either order gives the same colour list: removing the `k1`-th entry and then the (shifted) `k2`-th entry matches removing the diff --git a/Physlib/Relativity/Tensors/Tensorial.lean b/Physlib/Relativity/Tensors/Tensorial.lean index c301054f10..e5afc34091 100644 --- a/Physlib/Relativity/Tensors/Tensorial.lean +++ b/Physlib/Relativity/Tensors/Tensorial.lean @@ -51,8 +51,7 @@ We define the class `Tensorial` here, and provide an API around its use. ## iv. References -There are no known references for this material. - +* None. -/ @[expose] public section @@ -133,7 +132,6 @@ We now define the action of the group `G` on a type `M` carrying a tensorial ins noncomputable instance (priority := high) smulAction [Tensorial S c M] : SMul G M where smul g m := toTensor.symm (g • toTensor m) -set_option backward.isDefEq.respectTransparency false in noncomputable instance mulAction [Tensorial S c M] : MulAction G M where one_smul m := by change toTensor.symm (1 • toTensor m) = _ @@ -171,7 +169,6 @@ lemma smul_toTensor_symm {g : G} {t : Tensor S c} [self : Tensorial S c M] : -/ -set_option backward.isDefEq.respectTransparency false in noncomputable instance (priority := high) distribMulAction [Tensorial S c M] : DistribMulAction G M where smul_add g m m' := by @@ -187,7 +184,6 @@ noncomputable instance (priority := high) distribMulAction [Tensorial S c M] : -/ -set_option backward.isDefEq.respectTransparency false in /-- The action of the group on a `Tensorial` instance as a linear map. -/ noncomputable def smulLinearMap (g : G) [Tensorial S c M] : M →ₗ[k] M where toFun m := g • m @@ -207,12 +203,13 @@ lemma smulLinearMap_apply {g : G} [Tensorial S c M] (m : M) : -/ -set_option backward.isDefEq.respectTransparency false in instance [Tensorial S c M] : SMulCommClass k G M where smul_comm c g m := by apply toTensor.injective simp [toTensor_smul] +instance [Tensorial S c M] : SMulCommClass G k M := SMulCommClass.symm _ _ _ + /-! ## C. Properties of the basis @@ -255,7 +252,6 @@ lemma toTensor_tprod {n2 : ℕ} {c2 : Fin n2 → C} {M₂ : Type} -/ -set_option backward.isDefEq.respectTransparency false in lemma smul_prod {n2 : ℕ} {c2 : Fin n2 → C} {M₂ : Type} [Tensorial S c M] [AddCommMonoid M₂] [Module k M₂] [Tensorial S c2 M₂] (g : G) (m : M) (m2 : M₂) : @@ -323,6 +319,7 @@ lemma prod_tensor_basis_eq_map_reindex {n2 : ℕ} {c2 : Fin n2 → C} {M₂ : Ty attribute [-simp] Matrix.cons_val_zero Matrix.cons_val Fin.succAbove_zero open Tensor in +set_option backward.isDefEq.respectTransparency false in /-- Double basis expansion of an element of a tensor product `M ⊗[k] M₂` of two `Tensorial` one-index spaces. Given bases `b`, `b2` of `M`, `M₂` coming from the single-index tensor bases, every `x : M ⊗[k] M₂` is the double sum over `i, j` of the iterated evaluation coefficient diff --git a/Physlib/Relativity/Tensors/UnitTensor.lean b/Physlib/Relativity/Tensors/UnitTensor.lean index 106246b89a..1acf47e278 100644 --- a/Physlib/Relativity/Tensors/UnitTensor.lean +++ b/Physlib/Relativity/Tensors/UnitTensor.lean @@ -29,11 +29,20 @@ open Tensor noncomputable def unitTensor (c : C) : S.Tensor ![S.τ c, c] := fromConstPair (S.unit c) +/-- A component of the unit tensor is the corresponding component of the unit intertwiner in the +tensor-product basis. -/ +lemma unitTensor_basis_repr (c : C) (φ : ComponentIdx (S := S) ![S.τ c, c]) : + (Tensor.basis _).repr (unitTensor (S := S) c) φ = + (Module.Basis.tensorProduct (b (S.τ c)) (b c)).repr ((S.unit c) (1 : k)) + (φ 0, φ 1) := by + rw [unitTensor, fromConstPair, fromPairT_basis_repr] + lemma unitTensor_congr {c c1 : C} (h : c = c1) : unitTensor c = permT id (by simp [h]) (unitTensor (S := S) c1) := by subst h simp +set_option backward.isDefEq.respectTransparency false in /-- The unit tensor is symmetric on dualing the color. -/ lemma unitTensor_eq_permT_dual (c : C) : S.unitTensor c = permT ![1, 0] (And.intro (by decide) (fun i => by fin_cases i <;> simp)) @@ -62,6 +71,7 @@ lemma unitTensor_eq_permT_dual (c : C) : · simp_all · simp_all +set_option backward.isDefEq.respectTransparency false in lemma dual_unitTensor_eq_permT_unitTensor (c : C) : S.unitTensor (S.τ c) = permT ![1, 0] (And.intro (by decide) (fun i => by fin_cases i <;> simp)) (unitTensor c) := by diff --git a/Physlib/SpaceAndTime/ReferenceFrame.lean b/Physlib/SpaceAndTime/ReferenceFrame.lean new file mode 100644 index 0000000000..74268675ab --- /dev/null +++ b/Physlib/SpaceAndTime/ReferenceFrame.lean @@ -0,0 +1,229 @@ +/- +Copyright (c) 2026 Raunak Chhatwal. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Raunak Chhatwal +-/ +module + +public import Mathlib.LinearAlgebra.AffineSpace.Basis +public import Mathlib.Topology.Algebra.Module.TransferInstance +public import Physlib.SpaceAndTime.Space.Basic +public import Physlib.SpaceAndTime.Time.Basic +/-! +# Reference frames + +A point in space and a list of coordinates are different kinds of data. Assigning coordinates to a +point requires an origin and a basis for measuring displacements from that origin. A +`ReferenceFrame` records those choices at every time. + +This distinction is built into `Space d`, which is an affine space. Two points determine a +displacement, but no point is automatically the zero point. The chosen origin therefore belongs to +the frame, not to space itself. Similarly, a displacement has coordinate components only after a +basis has been chosen. + +Real-valued coordinates in all frames use the same implicit units of space and time. Different +reference frames represent different coordinate grids, not changes to this shared unit convention. +`Time` already includes an implicit choice of time unit, origin, and orientation. With this common +choice, `Time` is also the time coordinate in every frame and should be used directly in place of +frame-relative time coordinates. A frame therefore carries no additional time origin or time basis. +This convention applies to vector functions of time and all other time-dependent quantities. + +Most applications should use frames that are both inertial and orthonormal. In orthonormal frames, +the norm and inner product of coordinate vectors are given by the familiar Euclidean formulas. The +extra generality here also permits nonorthonormal coordinate grids. Giving every coordinate tuple +the standard Euclidean norm and dot product, independently of its basis, would make coordinate +transformations involving such a grid non-isometric: the same geometric displacement could acquire +different lengths, or a pair of displacements a different angle, merely by changing frames. Instead, +the metric on frame vectors is pulled back from geometric displacement space through the frame +basis. The usual component formulas are recovered for orthonormal frames. +-/ + +@[expose] public noncomputable section + +namespace ClassicalMechanics + +variable {d : ℕ} + +/-! +## A. Reference frames + +A reference frame can be pictured as a coordinate grid carried through time. It is part of how +motion is described, not an additional physical object moving with the particles. +-/ + +/-- A time-indexed choice of affine origin and displacement basis in `d`-dimensional space. -/ +structure ReferenceFrame (d : ℕ) where + /-- The point assigned coordinate zero at each time. -/ + origin : Time → Space d + /-- The basis used to turn displacement vectors into coordinate components at each time. -/ + basis : Time → Module.Basis (Fin d) ℝ (EuclideanSpace ℝ (Fin d)) + +/-- Build a reference frame from the trajectories of a collection of reference points. + +At each time, the reference points must form an affine basis: none is redundant, and together they +span the whole space. One reference point is chosen as the origin, and the displacements from it to +the remaining points form the coordinate basis. The resulting frame need not be inertial or +orthonormal. -/ +def ReferenceFrame.fromReferencePoints + (referencePoints : Finset (Time → Space d)) + (independence : ∀ t, AffineIndependent ℝ fun point : referencePoints => point.val t) + (spans_space : ∀ t, affineSpan ℝ {point.val t | point : referencePoints} = ⊤) : + ReferenceFrame d := + let affineBasis (t : Time) : AffineBasis referencePoints ℝ (Space d) := + ⟨fun point => point.val t, independence t, spans_space t⟩ + let reference_points_not_empty := (affineBasis 0).nonempty + let origin := Classical.choice reference_points_not_empty + letI := Fintype.ofFinite {point : referencePoints // point ≠ origin} + let basis t := (affineBasis t).basisOf origin + let other_reference_points_size_eq_dim : + Fintype.card {point : referencePoints // point ≠ origin} = d := + by simpa using (Module.finrank_eq_card_basis <| basis 0).symm + let basisReindexed t := + (basis t).reindex (Fintype.equivFinOfCardEq other_reference_points_size_eq_dim) + { origin := origin, basis := basisReindexed } + +/-! +## B. Inertial reference frames + +In Newtonian mechanics, an inertial coordinate grid does not rotate or change scale, and its origin +moves in a straight line at constant velocity. These conditions restrict the frame, not the +particles described in that frame. +-/ + +namespace ReferenceFrame + +variable {frame : ReferenceFrame d} + +/-- Whether the frame basis induces the same inner product on coordinates at every time. -/ +def IsMetricConserved (frame : ReferenceFrame d) : Prop := + ∀ t₁ t₂ i j, + inner ℝ (frame.basis t₁ i) (frame.basis t₁ j) = inner ℝ (frame.basis t₂ i) (frame.basis t₂ j) + +/-- Whether the frame's coordinate basis is orthonormal at every time. -/ +def Orthonormal (frame : ReferenceFrame d) : Prop := + ∀ t, _root_.Orthonormal ℝ (frame.basis t) + +/-- An orthonormal frame conserves its coordinate metric. -/ +lemma Orthonormal.isMetricConserved (h : frame.Orthonormal) : frame.IsMetricConserved := by + intro t₁ t₂ i j + rw [orthonormal_iff_ite.mp (h t₁) i j, orthonormal_iff_ite.mp (h t₂) i j] + +instance [h : Fact frame.Orthonormal] : Fact frame.IsMetricConserved := ⟨h.out.isMetricConserved⟩ + +/-- Whether a reference frame is related to its initial grid by uniform translation alone. -/ +structure IsInertial (frame : ReferenceFrame d) : Prop where + /-- Elapsed time times `velocity` is exactly the origin's displacement. -/ + origin_moves_uniformly : + ∃ velocity, ∀ t₁ t₂, frame.origin t₂ -ᵥ frame.origin t₁ = (t₂ - t₁).val • velocity + /-- The coordinate axes neither rotate nor change scale with time. -/ + basis_conserved : ∀ t₁ t₂, frame.basis t₁ = frame.basis t₂ + +/-- The time-independent velocity of an inertial frame's coordinate origin. -/ +def IsInertial.velocity (h : frame.IsInertial) : EuclideanSpace ℝ (Fin d) := + Classical.choose h.origin_moves_uniformly + +/-- An inertial frame conserves its coordinate metric. -/ +lemma IsInertial.isMetricConserved (h : frame.IsInertial) : frame.IsMetricConserved := by + intro t₁ t₂ i j + rw [h.basis_conserved t₁ t₂] + +/-- Inertiality provides the conserved metric needed for metric operations on frame vectors. -/ +instance [h : Fact frame.IsInertial] : Fact frame.IsMetricConserved := ⟨h.out.isMetricConserved⟩ + +/-! +## C. Vectors in a reference frame + +`frame.Vector` is the common coordinate carrier for vector quantities expressed relative to +`frame`. It intentionally records the coordinate frame but not the physical dimension, so relative +position, velocity, acceleration, force, momentum, and similar quantities can use the same +componentwise calculations. Their different physical roles, units, and transformation laws must be +supplied by the surrounding definitions. When a vector represents a displacement, `dispEquiv` +converts its coordinates into the corresponding geometric displacement at a given time. +-/ + +/-- The `d` real components used to express a vector quantity relative to `frame`. -/ +structure Vector (frame : ReferenceFrame d) where + /-- One scalar coefficient for each axis of the frame. -/ + components : Fin d → ℝ + +namespace Vector + +/-- Equivalence between frame vectors and coordinate components -/ +def componentEquiv : frame.Vector ≃ (Fin d → ℝ) := + Equiv.mk components mk Eq.refl Eq.refl + +instance : AddCommGroup frame.Vector := componentEquiv.addCommGroup + +instance : Module ℝ frame.Vector := componentEquiv.module ℝ + +/-- Scalar multiplication by a positive real. -/ +instance : SMul {x : ℝ // 0 < x} frame.Vector where + smul c x := c.val • x + +/-- Linear equivalence between frame vectors and coordinate components. -/ +def componentLinearEquiv : frame.Vector ≃ₗ[ℝ] (Fin d → ℝ) := + {componentEquiv with map_add' _ _ := rfl, map_smul' _ _ := rfl} + +/-- Equivalence between frame vectors and geometric displacements in space, +defined by the frame's basis at `t`. -/ +def dispEquiv (t : Time) : frame.Vector ≃ₗ[ℝ] EuclideanSpace ℝ (Fin d) := + componentLinearEquiv.trans (frame.basis t).equivFun.symm + +/-- Use the same topology for frame vectors as components' product topology. -/ +instance : TopologicalSpace frame.Vector := componentEquiv.topologicalSpace + +/-- Continuous linear equivalence between frame vectors and coordinate components. -/ +def componentContLinearEquiv (frame : ReferenceFrame d) : frame.Vector ≃L[ℝ] (Fin d → ℝ) := + { componentLinearEquiv with + continuous_toFun := continuous_induced_dom + continuous_invFun := componentEquiv.homeomorph.continuous_invFun } + +instance : FiniteDimensional ℝ frame.Vector := + FiniteDimensional.of_injective componentLinearEquiv.toLinearMap componentEquiv.injective + +/-- Continuous equivalence between frame vectors and geometric displacements in space, +defined by the frame's basis at `t`. -/ +def contDispEquiv (t : Time) : frame.Vector ≃L[ℝ] EuclideanSpace ℝ (Fin d) := + (componentContLinearEquiv frame).trans (frame.basis t).equivFun.toContinuousLinearEquiv.symm + +/-- The physical norm on frame vectors, pulled back from geometric displacement space. -/ +instance [_h : Fact frame.IsMetricConserved] : NormedAddCommGroup frame.Vector := + let normedSpace := + NormedAddCommGroup.induced _ _ (dispEquiv 0).toLinearMap (dispEquiv 0).injective + let metricSpace := + normedSpace.replaceTopology <| (contDispEquiv 0).toHomeomorph.isInducing.eq_induced + { metricSpace with norm := normedSpace.norm, dist_eq := normedSpace.dist_eq } + +/-- The physical inner product on frame vectors, pulled back from geometric displacement space. -/ +instance [Fact frame.IsMetricConserved] : InnerProductSpace ℝ frame.Vector where + inner x y := inner ℝ (dispEquiv 0 x) (dispEquiv 0 y) + norm_smul_le c x := show ‖dispEquiv 0 (c • x)‖ ≤ _ * ‖dispEquiv 0 x‖ by rw [map_smul, norm_smul] + norm_sq_eq_re_inner x := norm_sq_eq_re_inner (dispEquiv 0 x) + conj_inner_symm x y := inner_conj_symm _ _ + add_left x y z := by rw [map_add, inner_add_left] + smul_left x y r := by rw [map_smul, inner_smul_left] + +/-- In an orthonormal frame, the norm is the square root of squared components. -/ +lemma norm_euclidean_if_orthonormal [h : Fact frame.Orthonormal] : + ∀ v : frame.Vector, ‖v‖^2 = ∑ i, (v.components i)^2 := by + intro v + let basis := (frame.basis 0).toOrthonormalBasis (h.out 0) + calc + _ = ‖basis.repr.symm (WithLp.toLp 2 v.components)‖ ^ 2 := by rfl + _ = ‖WithLp.toLp 2 v.components‖ ^ 2 := by rw [basis.repr.symm.norm_map] + _ = _ := EuclideanSpace.real_norm_sq_eq _ + +/-- In an orthonormal frame, the inner product is the sum of component products. -/ +lemma inner_euclidean_if_orthonormal [h : Fact frame.Orthonormal] : + ∀ v w : frame.Vector, inner ℝ v w = ∑ i, v.components i * w.components i := by + intro v w + let basis := (frame.basis 0).toOrthonormalBasis (h.out 0) + calc + _ = inner ℝ (basis.repr.symm <| WithLp.toLp 2 v.components) + (basis.repr.symm <| WithLp.toLp 2 w.components) := by rfl + _ = inner ℝ (WithLp.toLp 2 v.components) _ := by rw [basis.repr.symm.inner_map_map] + _ = _ := by rw [PiLp.inner_apply]; simp_rw [Real.inner_apply] + +end ClassicalMechanics.ReferenceFrame.Vector + +end diff --git a/Physlib/SpaceAndTime/ReferenceFrame/API-map.yaml b/Physlib/SpaceAndTime/ReferenceFrame/API-map.yaml new file mode 100644 index 0000000000..d4a9d91664 --- /dev/null +++ b/Physlib/SpaceAndTime/ReferenceFrame/API-map.yaml @@ -0,0 +1,112 @@ +version: v0.1 + +Title: Reference frame + +Overview: | + An observer describing motion needs a coordinate grid, and the grid is a + choice rather than a feature of space. Two points of space determine a + displacement, and a displacement acquires numerical components only once + axes have been picked. Space carries a zero point of its own, but an + observer is under no obligation to use it: which point the coordinates call + zero is part of the observer's choice. A reference frame is that pair of + choices, an origin and a set of axes, carried along through time. + + An inertial frame is one whose grid is not being pushed around. Its axes are + the same at every time, and its origin drifts in a straight line at constant + speed, both measured against the affine structure that space itself + supplies. This is a restriction on the observer rather than on whatever is + being observed, and it is the setting in which the familiar Newtonian + statements about free motion hold. + + A vector quantity measured by an observer, a relative position, a velocity, + an acceleration, a force, a momentum, is a list of components read off that + observer's axes. Such lists add and scale componentwise regardless of which + quantity they stand for, so they share one carrier here; the physical + dimension, units and transformation law belong to whatever definition + supplies the quantity. Lengths and angles are the exception, since they are + geometric facts about the displacement rather than about the numbers: they + are taken from the underlying space through the frame's axes, so that a grid + with skew or unequal axes cannot make the same physical displacement appear + to change length. When the axes are orthonormal this reduces to the familiar + Euclidean formulas, the sum of the squared components giving the squared + length and the sum of the componentwise products giving the inner product. + +ParentAPIs: + - "Space (Physlib/SpaceAndTime/Space)" + - "Time (Physlib/SpaceAndTime/Time)" + +References: [] + +Requirements: + + - description: "The key data structure `ReferenceFrame d`, recording an affine origin and a displacement basis at each time, is defined." + done: true + location: "Physlib/SpaceAndTime/ReferenceFrame.lean (ReferenceFrame, ReferenceFrame.origin, ReferenceFrame.basis)" + + - description: "The API contains a construction of a frame from the trajectories of a collection of reference points forming an affine basis at each time." + done: true + location: "Physlib/SpaceAndTime/ReferenceFrame.lean (ReferenceFrame.fromReferencePoints)" + + - description: "The API contains the condition that a frame induces the same inner product on coordinates at every time." + done: true + location: "Physlib/SpaceAndTime/ReferenceFrame.lean (ReferenceFrame.IsMetricConserved)" + + - description: "The API contains the condition that a frame's axes are orthonormal at every time, the result that such a frame conserves its coordinate metric, and the instance making that available to typeclass inference." + done: true + location: "Physlib/SpaceAndTime/ReferenceFrame.lean (ReferenceFrame.Orthonormal, Orthonormal.isMetricConserved, Fact frame.IsMetricConserved)" + + - description: "The API contains the condition for a frame to be inertial, namely that its origin moves with constant velocity and its axes are the same at every time." + done: true + location: "Physlib/SpaceAndTime/ReferenceFrame.lean (ReferenceFrame.IsInertial, origin_moves_uniformly, basis_conserved)" + + - description: "The API contains the constant velocity of an inertial frame's origin." + done: true + location: "Physlib/SpaceAndTime/ReferenceFrame.lean (IsInertial.velocity)" + + - description: "The API contains the result that an inertial frame conserves its coordinate metric, and the instance making that available to typeclass inference." + done: true + location: "Physlib/SpaceAndTime/ReferenceFrame.lean (IsInertial.isMetricConserved, Fact frame.IsMetricConserved)" + + - description: "The API contains the carrier `frame.Vector` for the components of a vector quantity measured relative to a frame, together with its equivalence to coordinate tuples." + done: true + location: "Physlib/SpaceAndTime/ReferenceFrame.lean (ReferenceFrame.Vector, components, componentEquiv, componentLinearEquiv)" + + - description: "The API contains the additive and scalar structure on frame vectors, inherited componentwise." + done: true + location: "Physlib/SpaceAndTime/ReferenceFrame.lean (AddCommGroup frame.Vector, Module ℝ frame.Vector)" + + - description: "The API contains the identification of a frame vector with a geometric displacement in space at a given time, through the frame's basis, in both linear and continuous linear form." + done: true + location: "Physlib/SpaceAndTime/ReferenceFrame.lean (dispEquiv, contDispEquiv)" + + - description: "The API contains the topology on frame vectors, its continuous linear equivalence with coordinate tuples, and finite dimensionality." + done: true + location: "Physlib/SpaceAndTime/ReferenceFrame.lean (componentContLinearEquiv, TopologicalSpace frame.Vector, FiniteDimensional ℝ frame.Vector)" + + - description: "The API contains the norm and inner product on frame vectors of a frame with conserved coordinate metric, pulled back through the frame basis from geometric displacement space, so that a displacement keeps its length and its angles when the axes are skew or unequally scaled." + done: true + location: "Physlib/SpaceAndTime/ReferenceFrame.lean (NormedAddCommGroup frame.Vector, InnerProductSpace ℝ frame.Vector)" + + - description: "The API contains the Euclidean component formulas for the norm and inner product in an orthonormal frame." + done: true + location: "Physlib/SpaceAndTime/ReferenceFrame.lean (norm_euclidean_if_orthonormal, inner_euclidean_if_orthonormal)" + + - description: "The API shall contain a choice of time origin for a frame, so that time translations can act on frames." + done: false + location: N/A + + - description: "The API shall contain the defining property of an inertial frame's origin velocity, and the origin and basis of a frame built from reference points." + done: false + location: N/A + + - description: "The API shall contain the relative motion of two inertial frames, expressed as the boost, rotation and translation carrying one to the other, together with the induced transformation law for frame vectors." + done: false + location: N/A + + - description: "The API shall contain the derivative of a trajectory expressed in a frame, giving the velocity and acceleration measured by that frame as the time derivative of its coordinate components." + done: false + location: N/A + + - description: "The API shall contain the statement that a frame whose axes are constant and whose origin moves with constant velocity relative to an inertial frame is itself inertial." + done: false + location: N/A diff --git a/Physlib/SpaceAndTime/Space/ConstantSliceDist.lean b/Physlib/SpaceAndTime/Space/ConstantSliceDist.lean index 3bccaca7a6..48b9999f0e 100644 --- a/Physlib/SpaceAndTime/Space/ConstantSliceDist.lean +++ b/Physlib/SpaceAndTime/Space/ConstantSliceDist.lean @@ -47,6 +47,7 @@ lines and planes, rather then points. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/SpaceAndTime/Space/CrossProduct.lean b/Physlib/SpaceAndTime/Space/CrossProduct.lean index b904c9367f..ac020af8d9 100644 --- a/Physlib/SpaceAndTime/Space/CrossProduct.lean +++ b/Physlib/SpaceAndTime/Space/CrossProduct.lean @@ -33,6 +33,7 @@ and prove various properties about it related to time derivatives and inner prod ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/SpaceAndTime/Space/Derivatives/Basic.lean b/Physlib/SpaceAndTime/Space/Derivatives/Basic.lean index dc8161afd8..9766708b3d 100644 --- a/Physlib/SpaceAndTime/Space/Derivatives/Basic.lean +++ b/Physlib/SpaceAndTime/Space/Derivatives/Basic.lean @@ -50,6 +50,7 @@ in the standard directions. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/SpaceAndTime/Space/Derivatives/Curl.lean b/Physlib/SpaceAndTime/Space/Derivatives/Curl.lean index 56811e9e40..8afeb162ba 100644 --- a/Physlib/SpaceAndTime/Space/Derivatives/Curl.lean +++ b/Physlib/SpaceAndTime/Space/Derivatives/Curl.lean @@ -52,6 +52,7 @@ We also prove some basic vector-identities involving of the curl operator. ## iv. References +* None. -/ @[expose] public section @@ -663,6 +664,7 @@ TODO "Generalize the statement that a curl-free field is a gradient -/ open KroneckerDelta in +set_option backward.isDefEq.respectTransparency false in /-- The components of the curl as a contraction with the Levi-Civita symbol, `(∇ ⨯ f) x i = ∑ j k, ε_{ijk} ∂[j] fₖ x`. -/ lemma curl_eq_sum_leviCivitaSymbol (f : Space → EuclideanSpace ℝ (Fin 3)) diff --git a/Physlib/SpaceAndTime/Space/Derivatives/DerivativeIndex.lean b/Physlib/SpaceAndTime/Space/Derivatives/DerivativeIndex.lean index e7a5cca1f9..9e6583a3ce 100644 --- a/Physlib/SpaceAndTime/Space/Derivatives/DerivativeIndex.lean +++ b/Physlib/SpaceAndTime/Space/Derivatives/DerivativeIndex.lean @@ -28,6 +28,7 @@ remaining independent of any specific jet or field-theory construction. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/SpaceAndTime/Space/Derivatives/Div.lean b/Physlib/SpaceAndTime/Space/Derivatives/Div.lean index 92f8daac28..2fb714afac 100644 --- a/Physlib/SpaceAndTime/Space/Derivatives/Div.lean +++ b/Physlib/SpaceAndTime/Space/Derivatives/Div.lean @@ -37,6 +37,7 @@ properties about it. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/SpaceAndTime/Space/Derivatives/Grad.lean b/Physlib/SpaceAndTime/Space/Derivatives/Grad.lean index 47d049bc0d..10039c7148 100644 --- a/Physlib/SpaceAndTime/Space/Derivatives/Grad.lean +++ b/Physlib/SpaceAndTime/Space/Derivatives/Grad.lean @@ -53,6 +53,7 @@ of the input function with respect to each spatial coordinate. ## iv. References +* None. -/ @[expose] public section @@ -479,7 +480,6 @@ scoped[Space] notation "∇ᵈ" => distGrad -/ -set_option backward.isDefEq.respectTransparency false in lemma distGrad_inner_eq {d} (f : (Space d) →d[ℝ] ℝ) (η : 𝓢(Space d, ℝ)) (y : EuclideanSpace ℝ (Fin d)) : ⟪∇ᵈ f η, y⟫_ℝ = fderivD ℝ f η (basis.repr.symm y) := by rw [distGrad] diff --git a/Physlib/SpaceAndTime/Space/Derivatives/Iterated.lean b/Physlib/SpaceAndTime/Space/Derivatives/Iterated.lean index af9506c204..11a43c9e4a 100644 --- a/Physlib/SpaceAndTime/Space/Derivatives/Iterated.lean +++ b/Physlib/SpaceAndTime/Space/Derivatives/Iterated.lean @@ -37,6 +37,7 @@ of coordinate directions, and the iterated derivative is then defined by repeate ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/SpaceAndTime/Space/Derivatives/Laplacian.lean b/Physlib/SpaceAndTime/Space/Derivatives/Laplacian.lean index dcdb7a4b64..590b4e0d0d 100644 --- a/Physlib/SpaceAndTime/Space/Derivatives/Laplacian.lean +++ b/Physlib/SpaceAndTime/Space/Derivatives/Laplacian.lean @@ -31,6 +31,7 @@ functions defined on `Space d`. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/SpaceAndTime/Space/Derivatives/MatrixDiv.lean b/Physlib/SpaceAndTime/Space/Derivatives/MatrixDiv.lean index c7a61b8155..eddc791cb0 100644 --- a/Physlib/SpaceAndTime/Space/Derivatives/MatrixDiv.lean +++ b/Physlib/SpaceAndTime/Space/Derivatives/MatrixDiv.lean @@ -35,6 +35,7 @@ the vector field whose `i`th component is ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/SpaceAndTime/Space/Derivatives/MultiIndex.lean b/Physlib/SpaceAndTime/Space/Derivatives/MultiIndex.lean index 999ac26136..2303efe8de 100644 --- a/Physlib/SpaceAndTime/Space/Derivatives/MultiIndex.lean +++ b/Physlib/SpaceAndTime/Space/Derivatives/MultiIndex.lean @@ -35,6 +35,7 @@ Theory development. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/SpaceAndTime/Space/DistConst.lean b/Physlib/SpaceAndTime/Space/DistConst.lean index e169eda71c..5fb2a3672a 100644 --- a/Physlib/SpaceAndTime/Space/DistConst.lean +++ b/Physlib/SpaceAndTime/Space/DistConst.lean @@ -28,6 +28,7 @@ We show that the derivatives of this constant distribution are zero. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/SpaceAndTime/Space/DistOfFunction.lean b/Physlib/SpaceAndTime/Space/DistOfFunction.lean index 8fbc194ba9..0fd7769286 100644 --- a/Physlib/SpaceAndTime/Space/DistOfFunction.lean +++ b/Physlib/SpaceAndTime/Space/DistOfFunction.lean @@ -36,6 +36,7 @@ to reference the underlying Schwartz maps. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/SpaceAndTime/Space/Integrals/NormPow.lean b/Physlib/SpaceAndTime/Space/Integrals/NormPow.lean index 20c0fb61e7..a9086fbbed 100644 --- a/Physlib/SpaceAndTime/Space/Integrals/NormPow.lean +++ b/Physlib/SpaceAndTime/Space/Integrals/NormPow.lean @@ -36,6 +36,7 @@ The integrability of `x ↦ ‖x‖ᵖ` on `ball 0 b` and `(ball 0 b)ᶜ` follow ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/SpaceAndTime/Space/Integrals/RadialAngularMeasure.lean b/Physlib/SpaceAndTime/Space/Integrals/RadialAngularMeasure.lean index bfc3872289..c9c6e2d1cb 100644 --- a/Physlib/SpaceAndTime/Space/Integrals/RadialAngularMeasure.lean +++ b/Physlib/SpaceAndTime/Space/Integrals/RadialAngularMeasure.lean @@ -36,6 +36,7 @@ This file is equivalent to `invPowMeasure`, which will slowly be deprecated. ## iv. References +* None. -/ @[expose] public section @@ -144,15 +145,15 @@ lemma radialAngularMeasure_closedBall (r : ℝ) : rw [abs_of_nonneg (le_of_lt x.2.2)] simp [h1] rw [MeasureTheory.lintegral_indicator <| - MeasurableSet.prod MeasurableSet.univ (measurableSet_setOf.mpr (by fun_prop))] + MeasurableSet.prod MeasurableSet.univ (measurableSet_setOfPred.mpr (by fun_prop))] simp [MeasureTheory.Measure.prod_prod, Measure.volumeIoiPow] rw [MeasureTheory.Measure.comap_apply _ Subtype.val_injective (fun s hs => MeasurableSet.subtype_image measurableSet_Ioi hs) - _ (measurableSet_setOf.mpr (by fun_prop))] + _ (measurableSet_setOfPred.mpr (by fun_prop))] trans 3 * ENNReal.ofReal (4 / 3 * π) * volume (α := ℝ) (Set.Ioc 0 r) · congr ext x - simp only [Set.mem_image, Set.mem_setOf_eq, Subtype.exists, Set.mem_Ioi, exists_and_left, + simp only [Set.mem_image, Set.mem_ofPred_eq, Subtype.exists, Set.mem_Ioi, exists_and_left, exists_prop, exists_eq_right_right, Set.mem_Ioc] grind simp only [volume_Ioc, sub_zero] diff --git a/Physlib/SpaceAndTime/Space/IsDistBounded.lean b/Physlib/SpaceAndTime/Space/IsDistBounded.lean index e977aef5c8..1f0c680cde 100644 --- a/Physlib/SpaceAndTime/Space/IsDistBounded.lean +++ b/Physlib/SpaceAndTime/Space/IsDistBounded.lean @@ -61,6 +61,7 @@ of the space. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/SpaceAndTime/Space/LengthUnit.lean b/Physlib/SpaceAndTime/Space/LengthUnit.lean index e4d32fea58..a5c6b86ccc 100644 --- a/Physlib/SpaceAndTime/Space/LengthUnit.lean +++ b/Physlib/SpaceAndTime/Space/LengthUnit.lean @@ -22,6 +22,17 @@ To define specific length units, we first state the existence of a a given length unit, and then construct all other length units from it. We choose to state the existence of the length unit of meters, and construct all other length units from that. +## References + +* The BIPM SI Brochure, for the meter, the speed of light, and SI prefixes. + [ref: bipm_si_brochure_2019] +* NIST Handbook 44, Appendix C, for the international foot-based units and the international + nautical mile. [ref: nist_hb44_2023] +* IAU 2012 Resolution B2, for the astronomical unit. [ref: iau_2012_resolution_b2] +* The IAU Style Manual recommendations, for the Julian year convention used in the light-year. + [ref: iau_style_manual_units] +* IAU 2015 Resolution B2, for the exact parsec convention. [ref: iau_2015_resolution_b2] + -/ @[expose] public section @@ -78,9 +89,13 @@ lemma div_self (x : LengthUnit) : lemma div_symm (x y : LengthUnit) : x / y = (y / x)⁻¹ := NNReal.eq <| by - rw [div_eq_val, inv_eq_one_div, div_eq_val] - simp only [one_div, NNReal.coe_inv] - rw [toReal, inv_div] + show x.val / y.val = (y.val / x.val)⁻¹ + rw [inv_div] + +/-- The unit-ratio cocycle at `ℝ≥0` (the un-coerced form of `div_mul_div_coe`). -/ +lemma div_mul_div (x y z : LengthUnit) : (x / y) * (y / z) = x / z := NNReal.eq <| by + show x.val / y.val * (y.val / z.val) = x.val / z.val + rw [div_mul_div_comm, mul_comm x.val y.val, mul_div_mul_left _ _ y.val_ne_zero] @[simp] lemma div_mul_div_coe (x y z : LengthUnit) : @@ -102,6 +117,7 @@ def scale (r : ℝ) (x : LengthUnit) (hr : 0 < r := by norm_num) : LengthUnit := lemma scale_div_self (x : LengthUnit) (r : ℝ) (hr : 0 < r) : scale r x hr / x = (⟨r, le_of_lt hr⟩ : ℝ≥0) := by simp [scale, div_eq_val] + rfl @[simp] lemma self_div_scale (x : LengthUnit) (r : ℝ) (hr : 0 < r) : @@ -118,9 +134,8 @@ lemma scale_one (x : LengthUnit) : scale 1 x = x := by lemma scale_div_scale (x1 x2 : LengthUnit) {r1 r2 : ℝ} (hr1 : 0 < r1) (hr2 : 0 < r2) : scale r1 x1 hr1 / scale r2 x2 hr2 = (⟨r1, le_of_lt hr1⟩ / ⟨r2, le_of_lt hr2⟩) * (x1 / x2) := by refine NNReal.eq ?_ - simp [scale, div_eq_val] - rw [toReal] - field_simp + show r1 * x1.val / (r2 * x2.val) = r1 / r2 * (x1.val / x2.val) + rw [div_mul_div_comm] @[simp] lemma scale_scale (x : LengthUnit) (r1 r2 : ℝ) (hr1 : 0 < r1) (hr2 : 0 < r2) : @@ -139,17 +154,17 @@ From this choice of meters, we can define other length units by scaling meters. The references for the numerical definitions used below are: * the BIPM SI Brochure for the meter, the speed of light, and SI prefixes: - https://www.bipm.org/documents/d/guest/si-brochure-9-en-pdf + https://www.bipm.org/documents/d/guest/si-brochure-9-en-pdf [ref: bipm_si_brochure_2019] * NIST Handbook 44, Appendix C, for the international foot-based units and the international nautical mile: - https://doi.org/10.6028/NIST.HB.44-2023 + https://doi.org/10.6028/NIST.HB.44-2023 [ref: nist_hb44_2023] * IAU 2012 Resolution B2 for the astronomical unit: - https://iauarchive.eso.org/static/resolutions/IAU2012_English.pdf + https://iauarchive.eso.org/static/resolutions/IAU2012_English.pdf [ref: iau_2012_resolution_b2] * the IAU Style Manual recommendations for the Julian year convention used in the light-year: - https://iauarchive.eso.org/publications/proceedings_rules/units/ + https://iauarchive.eso.org/publications/proceedings_rules/units/ [ref: iau_style_manual_units] * IAU 2015 Resolution B2 for the exact parsec convention: - https://iauarchive.eso.org/static/resolutions/IAU2015_English.pdf + https://iauarchive.eso.org/static/resolutions/IAU2015_English.pdf [ref: iau_2015_resolution_b2] -/ @@ -222,10 +237,17 @@ noncomputable def parsecs : LengthUnit := scale (648000/Real.pi) astronomicalUni /-- There are exactly 1760 yards in a mile. -/ lemma miles_div_yards : miles / yards = (⟨1760, by norm_num⟩ : ℝ≥0) := - NNReal.eq <| by simp [miles, yards]; rw [toReal]; norm_num + NNReal.eq <| by + simp [miles, yards] + show (1609.344 : ℝ) / 0.9144 = ((⟨1760, by norm_num⟩ : ℝ≥0) : ℝ) + push_cast + norm_num /-- There are exactly 220 yards in a furlong. -/ lemma furlongs_div_yards : furlongs / yards = (⟨220, by norm_num⟩ : ℝ≥0) := NNReal.eq <| by - simp [furlongs, yards]; rw [toReal]; norm_num + simp [furlongs, yards] + show (201.168 : ℝ) / 0.9144 = ((⟨220, by norm_num⟩ : ℝ≥0) : ℝ) + push_cast + norm_num end LengthUnit diff --git a/Physlib/SpaceAndTime/Space/Module.lean b/Physlib/SpaceAndTime/Space/Module.lean index e676fc4c88..c2070036ad 100644 --- a/Physlib/SpaceAndTime/Space/Module.lean +++ b/Physlib/SpaceAndTime/Space/Module.lean @@ -5,14 +5,10 @@ Authors: Joseph Tooby-Smith -/ module -public import Physlib.SpaceAndTime.Space.Basic public import Physlib.SpaceAndTime.Space.Origin -public import Mathlib.Geometry.Manifold.Diffeomorph public import Mathlib.Analysis.Distribution.TemperateGrowth public import Mathlib.MeasureTheory.Measure.Haar.InnerProductSpace -public import Mathlib.Analysis.Calculus.ContDiff.WithLp public import Mathlib.Tactic.Cases -public import Mathlib.Analysis.Calculus.FDeriv.WithLp /-! # The structure of a module on Space @@ -469,6 +465,12 @@ lemma eval_contDiff {d n} (i : Fin d) : convert (coordCLM i).contDiff simp [coordCLM_apply, coord] +@[fun_prop] +lemma eval_hasTemperateGrowth {d} (i : Fin d) : + Function.HasTemperateGrowth (fun p : Space d => p i) := by + convert (coordCLM i).hasTemperateGrowth + simp [coordCLM_apply, coord] + /-- The continuous linear equivalence between `Space d` and the corresponding `Pi` type. -/ noncomputable def equivPi (d : ℕ) : Space d ≃L[ℝ] Π (_ : Fin d), ℝ := LinearEquiv.toContinuousLinearEquiv <| @@ -667,15 +669,16 @@ noncomputable def modelDiffeo {d} : Diffeomorph (𝓡 d) 𝓘(ℝ, Space d) (Spa right_inv _ := rfl contMDiff_toFun := by refine contMDiff_iff.mpr ⟨continuous_id', fun x y => ?_⟩ - simpa [← Function.id_def, homEuclideanSpaceSpace] using by fun_prop + simpa [← Function.id_def, homEuclideanSpaceSpace, chartAt_self_eq] using by fun_prop contMDiff_invFun := by apply contMDiff_iff.mpr ⟨by simpa using by fun_prop, fun x y => ?_⟩ - simpa [homEuclideanSpaceSpace] using by fun_prop + simpa [homEuclideanSpaceSpace, chartAt_self_eq] using by fun_prop @[simp] lemma modelDiffeo_apply {d : ℕ} (p : Space d) : modelDiffeo p = p := rfl +set_option backward.isDefEq.respectTransparency false in open Manifold in /-- The derivative of `modelDiffeo` provides an equivalence between `Space d` and `EuclideanSpace ℝ (Fin d)`. This equivalences takes the basis diff --git a/Physlib/SpaceAndTime/Space/Norm/Basic.lean b/Physlib/SpaceAndTime/Space/Norm/Basic.lean index 17d2f35085..6561843a87 100644 --- a/Physlib/SpaceAndTime/Space/Norm/Basic.lean +++ b/Physlib/SpaceAndTime/Space/Norm/Basic.lean @@ -66,6 +66,7 @@ We use properties of this power series to prove various results about distributi ## iv. References +* None. -/ @[expose] public section @@ -574,7 +575,7 @@ lemma gradient_dist_normPowerSeries_log_tendsTo_distGrad_norm {d : ℕ} (hd : 2 Filter.atTop (𝓝 (⟪∇ᵈ (distOfFunction (fun x : Space d => Real.log ‖x‖) (IsDistBounded.log_norm)) η, y⟫_ℝ)) := by - haveI : NeZero d := ⟨by omega⟩ + have : NeZero d := ⟨by omega⟩ simp only [distGrad_inner_eq, Distribution.fderivD_apply, distOfFunction_apply] change Filter.Tendsto (fun n => - ∫ (x : Space d), fderiv ℝ η x (basis.repr.symm y) * Real.log (normPowerSeries n x)) @@ -609,7 +610,7 @@ lemma gradient_dist_normPowerSeries_log_tendsTo {d : ℕ} (hd : 2 ≤ d) (𝓝 (⟪distOfFunction (fun x : Space d => (‖x‖ ^ (- 2 : ℤ)) • basis.repr x) (by refine (IsDistBounded.zpow_smul_repr_self _ ?_) omega) η, y⟫_ℝ)) := by - haveI : NeZero d := ⟨by omega⟩ + have : NeZero d := ⟨by omega⟩ simp only [gradient_dist_normPowerSeries_log, distOfFunction_inner] have h1 (n : ℕ) (x : Space d) : η x * ⟪(normPowerSeries n x ^ (- 2 : ℤ)) • basis.repr x, y⟫_ℝ = @@ -642,8 +643,7 @@ lemma gradient_dist_normPowerSeries_log_tendsTo {d : ℕ} (hd : 2 ≤ d) filter_upwards [Measure.ae_ne volume 0] with x hx simp [mul_assoc] gcongr - rw [abs_of_nonneg (by simp)] - exact normPowerSeries_zpow_le_norm_sq_add_one n (- 2 : ℤ) x hx + simpa using normPowerSeries_zpow_le_norm_sq_add_one n (- 2 : ℤ) x hx · filter_upwards [Measure.ae_ne volume 0] with x hx have h2 : ⟪(‖x‖ ^ (- 2 : ℤ)) • basis.repr x, y⟫_ℝ = ⟪basis.repr x, y⟫_ℝ * ‖x‖ ^ (- 2 : ℤ) := by @@ -709,6 +709,7 @@ private lemma integrable_real_pow_mul_schwartz refine (ψ.integrable_pow_mul volume k).mono' (by fun_prop) (ae_of_all _ fun x => by simp [norm_mul, norm_pow]) +set_option backward.isDefEq.respectTransparency false in private lemma radial_power_deriv_integral_by_parts {d : ℕ} (η : 𝓢(Space d, ℝ)) (n : ↑(Metric.sphere (0 : Space d) 1)) @@ -1094,9 +1095,11 @@ lemma distLaplacian_fundamentalSolution_norm_zpow {d : ℕ} : rw [distOfFunction_apply] refine integral_eq_zero_of_ae (ae_of_all _ fun x => ?_) rw [Subsingleton.elim x 0] - simp [zero_zpow_eq] - simp [hzero] - · haveI : NeZero d := ⟨by omega⟩ + simp + simp only [Nat.cast_zero, zero_sub, neg_neg] + rw [hzero] + simp + · have : NeZero d := ⟨by omega⟩ rw [distLaplacian] change ∇ᵈ ⬝ (∇ᵈ (distOfFunction (fun x : Space d => ‖x‖ ^ (- ((d : ℤ) - 2))) diff --git a/Physlib/SpaceAndTime/Space/Norm/IteratedLaplacian.lean b/Physlib/SpaceAndTime/Space/Norm/IteratedLaplacian.lean index 555e2f2061..c19bf600bb 100644 --- a/Physlib/SpaceAndTime/Space/Norm/IteratedLaplacian.lean +++ b/Physlib/SpaceAndTime/Space/Norm/IteratedLaplacian.lean @@ -27,6 +27,7 @@ gives a nonzero constant multiple of the Dirac delta at the origin. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/SpaceAndTime/Space/Norm/Regularized.lean b/Physlib/SpaceAndTime/Space/Norm/Regularized.lean index 41bd66c986..e943ae7738 100644 --- a/Physlib/SpaceAndTime/Space/Norm/Regularized.lean +++ b/Physlib/SpaceAndTime/Space/Norm/Regularized.lean @@ -29,6 +29,7 @@ This file contains basic API for regularized powers of the norm on `Space d`, na ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/SpaceAndTime/Space/Origin.lean b/Physlib/SpaceAndTime/Space/Origin.lean index 360d104925..407ee90489 100644 --- a/Physlib/SpaceAndTime/Space/Origin.lean +++ b/Physlib/SpaceAndTime/Space/Origin.lean @@ -6,7 +6,6 @@ Authors: Shaopeng Zhu, Joseph Tooby-Smith module public import Physlib.SpaceAndTime.Space.Basic -public import Mathlib.Analysis.Normed.Affine.Isometry /-! # The origin of `Space` and the Euclidean chart diff --git a/Physlib/SpaceAndTime/Space/Slice.lean b/Physlib/SpaceAndTime/Space/Slice.lean index 4487e19d38..34600ef0de 100644 --- a/Physlib/SpaceAndTime/Space/Slice.lean +++ b/Physlib/SpaceAndTime/Space/Slice.lean @@ -31,8 +31,7 @@ extracts the `i`th coordinate on `Space d.succ`. ## iv. References -- https://leanprover.zulipchat.com/#narrow/channel/479953-Physlib/topic/API.20around.20.60Space.20.28d1.20.2B.20d2.29.60.20to.20.60Space.20d1.20x.20Space.20d2.60/with/556754634 - +* https://leanprover.zulipchat.com/#narrow/channel/479953-Physlib/topic/API.20around.20.60Space.20.28d1.20.2B.20d2.29.60.20to.20.60Space.20d1.20x.20Space.20d2.60/with/556754634. -/ @[expose] public section diff --git a/Physlib/SpaceAndTime/Space/SmoothFunctions.lean b/Physlib/SpaceAndTime/Space/SmoothFunctions.lean new file mode 100644 index 0000000000..4d1145fba3 --- /dev/null +++ b/Physlib/SpaceAndTime/Space/SmoothFunctions.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Giuseppe Sorge. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Giuseppe Sorge +-/ +module + +public import Physlib.SpaceAndTime.Space.Module +public import Mathlib.Geometry.Manifold.ContMDiffMap +/-! + +# Smooth real-valued functions on space + +`Space.cmap` bundles a smooth real-valued function on `Space d`, given as a plain function +together with a `ContDiff` proof, into the space of bundled smooth maps +`C^⊤⟮𝓘(ℝ, Space d), Space d; 𝓘(ℝ, ℝ), ℝ⟯`. Such bundled maps are, for instance, the test +functions on which the mass distribution of a rigid body acts. + +-/ + +@[expose] public section + +open Manifold + +namespace Space + +/-- Bundle a smooth real-valued function on `Space d` as an element of the space of bundled +smooth maps. Keeping this as a named constructor ensures the resulting type head stays +`ContMDiffMap`, so the module/ring operations and `comp` resolve correctly. -/ +def cmap {d : ℕ} (f : Space d → ℝ) (hf : ContDiff ℝ ⊤ f) : + C^⊤⟮𝓘(ℝ, Space d), Space d; 𝓘(ℝ, ℝ), ℝ⟯ := ⟨f, hf.contMDiff⟩ + +@[simp] +lemma cmap_apply {d : ℕ} (f : Space d → ℝ) (hf : ContDiff ℝ ⊤ f) (y : Space d) : + cmap f hf y = f y := rfl + +end Space diff --git a/Physlib/SpaceAndTime/Space/Translations.lean b/Physlib/SpaceAndTime/Space/Translations.lean index 7ce7c116d7..1e71893a0b 100644 --- a/Physlib/SpaceAndTime/Space/Translations.lean +++ b/Physlib/SpaceAndTime/Space/Translations.lean @@ -127,6 +127,7 @@ lemma distTranslate_distGrad {d : ℕ} (a : EuclideanSpace ℝ (Fin d)) rw [fderiv_comp_add_right] open MeasureTheory +set_option backward.isDefEq.respectTransparency false in lemma distTranslate_ofFunction {d : ℕ} (a : EuclideanSpace ℝ (Fin d)) (f : Space d → X) (hf : IsDistBounded f) : distTranslate a (distOfFunction f hf) = diff --git a/Physlib/SpaceAndTime/SpaceTime/Basic.lean b/Physlib/SpaceAndTime/SpaceTime/Basic.lean index b2a4112cf8..57a44cc3b7 100644 --- a/Physlib/SpaceAndTime/SpaceTime/Basic.lean +++ b/Physlib/SpaceAndTime/SpaceTime/Basic.lean @@ -62,6 +62,7 @@ allowing it to be used in tensorial expressions. ## iv. References +* None. -/ @[expose] public section @@ -304,11 +305,13 @@ lemma toTimeAndSpace_symm_apply_time_space {d : ℕ} {c : SpeedOfLight} (x : Spa (toTimeAndSpace c).symm (x.time c, x.space) = x := (toTimeAndSpace c).left_inv x +set_option backward.isDefEq.respectTransparency false in @[simp] lemma space_toTimeAndSpace_symm {d : ℕ} {c : SpeedOfLight} (t : Time) (s : Space d) : ((toTimeAndSpace c).symm (t, s)).space = s := by simp [space, toTimeAndSpace] +set_option backward.isDefEq.respectTransparency false in @[simp] lemma time_toTimeAndSpace_symm {d : ℕ} {c : SpeedOfLight} (t : Time) (s : Space d) : ((toTimeAndSpace c).symm (t, s)).time c = t := by @@ -349,6 +352,7 @@ lemma toTimeAndSpace_symm_fderiv {d : ℕ} {c : SpeedOfLight} (x : Time × Space #### B.3.3. `toTimeAndSpace` acting on spatial basis vectors -/ +set_option backward.isDefEq.respectTransparency false in lemma toTimeAndSpace_basis_inr {d : ℕ} {c : SpeedOfLight} (i : Fin d) : toTimeAndSpace c (Lorentz.Vector.basis (Sum.inr i)) = (0, Space.basis i) := by @@ -363,6 +367,7 @@ lemma toTimeAndSpace_basis_inr {d : ℕ} {c : SpeedOfLight} (i : Fin d) : -/ +set_option backward.isDefEq.respectTransparency false in lemma toTimeAndSpace_basis_inl {d : ℕ} {c : SpeedOfLight} : toTimeAndSpace (d := d) c (Lorentz.Vector.basis (Sum.inl 0)) = (⟨1/c.val⟩, 0) := by refine Prod.ext ?_ ?_ @@ -415,6 +420,7 @@ lemma timeSpaceBasis_apply_inr {d : ℕ} (c : SpeedOfLight) (i : Fin d) : -/ +set_option backward.isDefEq.respectTransparency false in /-- The equivalence on of `SpaceTime` taking `(1, 0, 0, ...)` to of `(c, 0, 0, ....)` and keeping all other components the same. -/ def timeSpaceBasisEquiv {d : ℕ} (c : SpeedOfLight) : @@ -485,6 +491,7 @@ def timeSpaceBasisEquiv {d : ℕ} (c : SpeedOfLight) : -/ +set_option backward.isDefEq.respectTransparency false in lemma det_timeSpaceBasisEquiv {d : ℕ} (c : SpeedOfLight) : (timeSpaceBasisEquiv (d := d) c).det = c.val := by rw [@LinearEquiv.coe_det] @@ -504,6 +511,7 @@ lemma det_timeSpaceBasisEquiv {d : ℕ} (c : SpeedOfLight) : -/ +set_option backward.isDefEq.respectTransparency false in lemma timeSpaceBasis_eq_map_basis {d : ℕ} (c : SpeedOfLight) : timeSpaceBasis (d := d) c = Module.Basis.map (Lorentz.Vector.basis (d := d)) (timeSpaceBasisEquiv c).toLinearEquiv := by diff --git a/Physlib/SpaceAndTime/SpaceTime/Boosts.lean b/Physlib/SpaceAndTime/SpaceTime/Boosts.lean index 0e3769ba18..24bdefb97e 100644 --- a/Physlib/SpaceAndTime/SpaceTime/Boosts.lean +++ b/Physlib/SpaceAndTime/SpaceTime/Boosts.lean @@ -28,9 +28,7 @@ Note that the material here currently assumes that the speed of light `c = 1`. ## iv. References -See e.g. -- https://en.wikipedia.org/wiki/Lorentz_transformation - +* https://en.wikipedia.org/wiki/Lorentz_transformation. [ref: wiki_lorentz_transformation] -/ @[expose] public section diff --git a/Physlib/SpaceAndTime/SpaceTime/Derivatives.lean b/Physlib/SpaceAndTime/SpaceTime/Derivatives.lean index b02031d0a0..eddc56d7cc 100644 --- a/Physlib/SpaceAndTime/SpaceTime/Derivatives.lean +++ b/Physlib/SpaceAndTime/SpaceTime/Derivatives.lean @@ -52,6 +52,7 @@ distributions on `SpaceTime d`. ## iv. References +* None. -/ @[expose] public section @@ -122,6 +123,7 @@ lemma deriv_eq_manifoldDeriv {M : Type} [NormedAddCommGroup M] [NormedSpace ℝ deriv μ f y = manifoldDeriv 𝓘(ℝ, M) μ f y := by rw [deriv_eq_mfderiv, manifoldDeriv_eq] +set_option backward.isDefEq.respectTransparency false in @[simp] lemma manifoldDeriv_const {E H N : Type} [NormedAddCommGroup E] [NormedSpace ℝ E] [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [TopologicalSpace N] diff --git a/Physlib/SpaceAndTime/SpaceTime/LorentzAction.lean b/Physlib/SpaceAndTime/SpaceTime/LorentzAction.lean index a84380c9a1..049731c58c 100644 --- a/Physlib/SpaceAndTime/SpaceTime/LorentzAction.lean +++ b/Physlib/SpaceAndTime/SpaceTime/LorentzAction.lean @@ -36,6 +36,7 @@ we define the induced action on Schwartz functions and distributions. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/SpaceAndTime/Time/Basic.lean b/Physlib/SpaceAndTime/Time/Basic.lean index 1bec924fd8..d12bd19cbb 100644 --- a/Physlib/SpaceAndTime/Time/Basic.lean +++ b/Physlib/SpaceAndTime/Time/Basic.lean @@ -61,6 +61,7 @@ or origin. ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/SpaceAndTime/Time/Derivatives.lean b/Physlib/SpaceAndTime/Time/Derivatives.lean index de4ac19406..db7503936b 100644 --- a/Physlib/SpaceAndTime/Time/Derivatives.lean +++ b/Physlib/SpaceAndTime/Time/Derivatives.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Nikolai Kashcheev, Joseph Tooby-Smith +Authors: Nikolai Kashcheev, Zhi Kai Pong, Joseph Tooby-Smith -/ module @@ -22,19 +22,31 @@ In this module we define and prove basic lemmas about derivatives of functions o - `deriv` : The derivative of a function `Time → M` at a given time. - `manifoldDeriv` : The derivative of a function from `Time` to a manifold. +- `derivVec` : The derivative of a function from `Time` into a torsor, such as `Space d`, + valued in the vector space of displacements of that torsor. +- `hasDerivAt_comp_toRealCLE_symm` : The time derivative as a `HasDerivAt` on `ℝ`, for a curve + reparametrised through the canonical equivalence `toRealCLE.symm : ℝ ≃L[ℝ] Time`. +- `deriv_comp_toRealCLE_of_hasDerivAt` : Its converse, a `HasDerivAt` on `ℝ` read as the time + derivative of the curve pulled back to `Time` through `toRealCLE`. +- `deriv_comp_neg` and `deriv_deriv_comp_neg` : The first and second time derivatives under the + reversal of time `t ↦ -t`. ## iii. Table of contents - A. The definition of the derivative - A.1. Derivatives of functions into vector spaces - - A.2. Derivatives of functions into manifolds + - A.2. The derivative through the canonical equivalence with `ℝ` + - A.3. Derivatives of functions into manifolds + - A.4. Derivatives of functions into torsors - B. Linearlity properties of the derivative - C. Derivative of constant functions -- D. Smoothness properties +- D. Smoothness properties and the reversal of time - E. Derivatives of components +- F. Derivatives of trajectories into `Space` ## iv. References +* None. -/ @[expose] public section @@ -68,7 +80,44 @@ lemma deriv_eq [AddCommGroup M] [Module ℝ M] [TopologicalSpace M] /-! -### A.2. Derivatives of functions into manifolds +### A.2. The derivative through the canonical equivalence with `ℝ` + +`Time` is identified with `ℝ` by the continuous linear equivalence `toRealCLE`. Precomposing a +curve `w : Time → M` with `toRealCLE.symm : ℝ ≃L[ℝ] Time` gives a curve on `ℝ`, whose Mathlib +derivative (`HasDerivAt`) at `τ` is the time derivative `∂ₜ w` evaluated at `toRealCLE.symm τ`. +This is the bridge through which Mathlib's calculus and ODE theory on `ℝ` applies to curves on +`Time`. Conversely, a `HasDerivAt` on `ℝ` at `toRealCLE t` is the time derivative at `t` of the +curve pulled back to `Time` through `toRealCLE`. + +-/ + +/-- The canonical equivalence `toRealCLE.symm : ℝ ≃L[ℝ] Time` sends `1 : ℝ` to `1 : Time`. -/ +lemma toRealCLE_symm_one : toRealCLE.symm (1 : ℝ) = (1 : Time) := by + simp [toRealCLE] + +/-- Bridge from the time derivative to `HasDerivAt`: if `w : Time → M` is differentiable at +`toRealCLE.symm τ`, then the curve `τ ↦ w (toRealCLE.symm τ)` on `ℝ` has derivative +`∂ₜ w (toRealCLE.symm τ)` at `τ`. -/ +lemma hasDerivAt_comp_toRealCLE_symm [NormedAddCommGroup M] [NormedSpace ℝ M] + (w : Time → M) (τ : ℝ) (hw : DifferentiableAt ℝ w (toRealCLE.symm τ)) : + HasDerivAt (fun τ : ℝ => w (toRealCLE.symm τ)) (∂ₜ w (toRealCLE.symm τ)) τ := by + apply hw.hasFDerivAt.comp_hasDerivAt_of_eq τ _ rfl + exact Time.toRealCLE_symm_one ▸ toRealCLE.symm.hasFDerivAt.hasDerivAt + +/-- The converse of the bridge `hasDerivAt_comp_toRealCLE_symm`: if the curve `γ : ℝ → M` has +derivative `v` at `toRealCLE t`, then the curve `t ↦ γ (toRealCLE t)` on `Time` has time +derivative `v` at `t`. -/ +lemma deriv_comp_toRealCLE_of_hasDerivAt [NormedAddCommGroup M] [NormedSpace ℝ M] + (γ : ℝ → M) (t : Time) (v : M) (h : HasDerivAt γ v (toRealCLE t)) : + ∂ₜ (fun s => γ (toRealCLE s)) t = v := by + rw [Time.deriv_eq, fderiv_fun_comp _ h.differentiableAt toRealCLE.differentiableAt, + toRealCLE.fderiv, ContinuousLinearMap.comp_apply, ContinuousLinearEquiv.coe_coe, + fderiv_eq_smul_deriv, h.deriv] + exact Eq.trans (by rfl) (Time.one_val ▸ one_smul _ v) + +/-! + +### A.3. Derivatives of functions into manifolds -/ @@ -103,6 +152,7 @@ lemma deriv_eq_manifoldDeriv [NormedAddCommGroup M] [NormedSpace ℝ M] deriv f t = manifoldDeriv 𝓘(ℝ, M) f t := by rw [deriv_eq_mfderiv, manifoldDeriv_eq] +set_option backward.isDefEq.respectTransparency false in open Manifold in @[simp] lemma manifoldDeriv_const {E H N : Type} [NormedAddCommGroup E] [NormedSpace ℝ E] @@ -113,6 +163,45 @@ lemma manifoldDeriv_const {E H N : Type} [NormedAddCommGroup E] [NormedSpace ℝ /-! +### A.4. Derivatives of functions into torsors + +A trajectory in physical space is a curve of points, and its velocity is a displacement per +unit time, that is a vector. For a torsor `P` over a vector space `V`, for example +`Space d` over `EuclideanSpace ℝ (Fin d)`, the derivative of a curve `f : Time → P` is +therefore valued in `V` rather than in `P`. It is defined by differentiating the displacement +curve `s ↦ f s -ᵥ f t`, which is `V`-valued, so that no origin of `P` is ever chosen. The +reference point used to form the displacement is irrelevant, see `derivVec_eq_fderiv_vsub`. + +-/ + +/-- The time derivative of a trajectory into a torsor `P` over a vector space `V`, +valued in `V`. For a trajectory `f : Time → Space d` this is the velocity, a spatial vector in +`EuclideanSpace ℝ (Fin d)` rather than a point of `Space d`. -/ +noncomputable def derivVec {V P : Type} [AddCommGroup V] [Module ℝ V] [TopologicalSpace V] + [AddTorsor V P] (f : Time → P) : Time → V := + fun t => fderiv ℝ (fun s => f s -ᵥ f t) t 1 + +@[inherit_doc derivVec] +scoped notation "∂ₜᵥ" => derivVec + +lemma derivVec_eq {V P : Type} [AddCommGroup V] [Module ℝ V] [TopologicalSpace V] + [AddTorsor V P] (f : Time → P) (t : Time) : + ∂ₜᵥ f t = fderiv ℝ (fun s => f s -ᵥ f t) t 1 := rfl + +/-- The derivative of a trajectory into a torsor does not depend on the reference point used +to form the displacement: any base point `p` gives the same derivative. The normed hypotheses on +`V` here come from `fderiv_add_const`; the definition itself needs only a topological vector +space. -/ +lemma derivVec_eq_fderiv_vsub {V P : Type} [NormedAddCommGroup V] [NormedSpace ℝ V] + [AddTorsor V P] (f : Time → P) (p : P) (t : Time) : + ∂ₜᵥ f t = fderiv ℝ (fun s => f s -ᵥ p) t 1 := by + have h : (fun s => f s -ᵥ f t) = fun s => (f s -ᵥ p) + (p -ᵥ f t) := by + funext s + rw [vsub_add_vsub_cancel] + rw [derivVec_eq, h, fderiv_add_const] + +/-! + ## B. Linearlity properties of the derivative -/ @@ -172,9 +261,16 @@ lemma deriv_const [NormedAddCommGroup M] [NormedSpace ℝ M] (m : M) : rw [deriv] simp +/-- A trajectory constant at a point of a torsor has zero derivative. -/ +@[simp] +lemma derivVec_const {V P : Type} [AddCommGroup V] [Module ℝ V] [TopologicalSpace V] + [AddTorsor V P] (p : P) : + ∂ₜᵥ (fun _ => p) t = (0 : V) := by + simp [derivVec] + /-! -## D. Smoothness properties +## D. Smoothness properties and the reversal of time -/ @@ -204,6 +300,23 @@ lemma deriv_contDiff_of_contDiff {M : Type} change ContDiff ℝ ∞ ((fun x => x 1) ∘ (fun t => fderiv ℝ f t)) apply ContDiff.comp <;> fun_prop +/-- The time derivative of a `C^(n+1)` curve is `C^n`. -/ +@[fun_prop] +lemma deriv_contDiff_of_contDiff_succ {M : Type} {n : WithTop ℕ∞} + [NormedAddCommGroup M] [NormedSpace ℝ M] (f : Time → M) (hf : ContDiff ℝ (n + 1) f) : + ContDiff ℝ n (∂ₜ f) := by + unfold deriv + change ContDiff ℝ n ((fun x => x 1) ∘ (fun t => fderiv ℝ f t)) + exact ContDiff.comp (by fun_prop) (contDiff_succ_iff_fderiv.mp hf).2.2 + +/-- The time derivative of a `C²` curve is differentiable. -/ +@[fun_prop] +lemma deriv_differentiable_of_contDiff_two {M : Type} + [NormedAddCommGroup M] [NormedSpace ℝ M] (f : Time → M) (hf : ContDiff ℝ 2 f) : + Differentiable ℝ (∂ₜ f) := + (deriv_contDiff_of_contDiff_succ (n := 1) f (by rw [one_add_one_eq_two]; exact hf)).differentiable + (by simp) + @[fun_prop] lemma deriv_contDiff_of_space {n} {M : Type} [NormedAddCommGroup M] [NormedSpace ℝ M] (f : Time → Space d → M) (hf : ContDiff ℝ (n + 1) ↿f) : @@ -211,6 +324,26 @@ lemma deriv_contDiff_of_space {n} {M : Type} [NormedAddCommGroup M] [NormedSpace unfold deriv fun_prop +/-- The chain rule for the time derivative under the reversal of time: the derivative of +`t ↦ f (-t)` at `t` is minus the derivative of `f` at `-t`. -/ +lemma deriv_comp_neg {M : Type} [NormedAddCommGroup M] [NormedSpace ℝ M] + (f : Time → M) (t : Time) (hf : DifferentiableAt ℝ f (-t)) : + ∂ₜ (fun s => f (-s)) t = -∂ₜ f (-t) := by + rw [Time.deriv_eq, Time.deriv_eq, fderiv_fun_comp _ hf (by fun_prop), fderiv_fun_neg] + simp + +/-- The second derivative is unchanged by the reversal of time: for a `C²` curve `f`, the second +derivative of `t ↦ f (-t)` at `t` is the second derivative of `f` at `-t`, the two changes of sign +cancelling. -/ +lemma deriv_deriv_comp_neg {M : Type} [NormedAddCommGroup M] [NormedSpace ℝ M] + (f : Time → M) (hf : ContDiff ℝ 2 f) (t : Time) : + ∂ₜ (∂ₜ (fun s => f (-s))) t = ∂ₜ (∂ₜ f) (-t) := by + rw [← neg_neg (∂ₜ (∂ₜ f) (-t)), + ← deriv_comp_neg _ _ ((deriv_differentiable_of_contDiff_two f hf) _), ← Time.deriv_neg] + congr + ext + exact deriv_comp_neg f _ (hf.differentiable (by simp) _) + /-! ## E. Derivatives of components @@ -223,6 +356,20 @@ lemma differentiable_euclid {f : Time → EuclideanSpace ℝ (Fin n)} rw [differentiable_euclidean] fun_prop +/-- Chain rule for a real function of one coordinate of a curve in Euclidean space: the time +derivative of `t ↦ f (r t i)` is `f'` times the `i`-th component of the velocity, where `f'` is +the derivative of `f` at `r t i`. -/ +lemma deriv_comp_coord {ι : Type} [Fintype ι] {f : ℝ → ℝ} {f' : ℝ} + {r : Time → EuclideanSpace ℝ ι} {t : Time} + (i : ι) (hr : DifferentiableAt ℝ r t) (hf : HasDerivAt f f' (r t i)) : + ∂ₜ (fun s => f (r s i)) t = f' * ∂ₜ r t i := by + have h1 : HasFDerivAt (fun s : Time => r s i) + ((EuclideanSpace.proj (𝕜 := ℝ) i).comp (fderiv ℝ r t)) t := + (EuclideanSpace.proj (𝕜 := ℝ) i).hasFDerivAt.comp t hr.hasFDerivAt + have h2 : HasFDerivAt (fun s : Time => f (r s i)) _ t := hf.comp_hasFDerivAt t h1 + rw [Time.deriv_eq, h2.fderiv, Time.deriv_eq] + simp + lemma deriv_euclid { μ} {f : Time→ EuclideanSpace ℝ (Fin n)} (hf : Differentiable ℝ f) (t : Time) : deriv (fun t => f t μ) t = deriv (fun t => f t) t μ := by @@ -261,4 +408,43 @@ lemma deriv_space {d : ℕ} {f : Time → Space d} deriv (fun s => f s i) t = deriv f t i := (Space.fderiv_space_components i f hf t 1).symm +/-! + +## F. Derivatives of trajectories into `Space` + +For a trajectory `f : Time → Space d` of points in space, the torsor derivative `∂ₜᵥ f` is +valued in the displacement space `EuclideanSpace ℝ (Fin d)`. Componentwise it agrees with the +time derivatives of the coordinates, and under the identification of `Space d` with its +displacement space given by the (arbitrary) zero point it recovers the vector space derivative +`∂ₜ f`. The latter bridges `∂ₜᵥ` to the existing `∂ₜ` API. + +Note that `Space d` carries two `AddTorsor` instances: the intended one over +`EuclideanSpace ℝ (Fin d)`, and one over itself coming from the module structure on `Space d`. +Instance resolution selects the former, so `∂ₜᵥ` of a trajectory in `Space d` is valued in +`EuclideanSpace ℝ (Fin d)` as intended. + +-/ + +/-- The components of the torsor derivative of a trajectory in `Space d` are the time +derivatives of the coordinates of the trajectory. -/ +lemma derivVec_space {f : Time → Space d} (hf : Differentiable ℝ f) (t : Time) (i : Fin d) : + ∂ₜᵥ f t i = ∂ₜ (fun s => f s i) t := by + have hv : Differentiable ℝ (fun s => (f s -ᵥ f t : EuclideanSpace ℝ (Fin d))) := by + apply differentiable_euclid + intro j + simp only [Space.vsub_apply] + exact ((Space.eval_differentiable j).comp hf).sub_const (f t j) + rw [derivVec_eq, deriv_eq, ← fderiv_euclid hv t 1] + simp only [Space.vsub_apply] + rw [fderiv_sub_const] + +/-- The torsor derivative of a trajectory in `Space d` agrees with the vector space derivative +`∂ₜ` under the identification of `Space d` with its displacement space given by the zero +point. -/ +lemma derivVec_eq_deriv_vsub_zero {f : Time → Space d} (hf : Differentiable ℝ f) (t : Time) : + ∂ₜᵥ f t = ∂ₜ f t -ᵥ (0 : Space d) := by + ext i + rw [derivVec_space hf t i, deriv_space hf t i, Space.vsub_apply] + simp + end Time diff --git a/Physlib/SpaceAndTime/Time/TimeUnit.lean b/Physlib/SpaceAndTime/Time/TimeUnit.lean index 2da8bd01b0..82165ca766 100644 --- a/Physlib/SpaceAndTime/Time/TimeUnit.lean +++ b/Physlib/SpaceAndTime/Time/TimeUnit.lean @@ -81,9 +81,13 @@ lemma div_self (x : TimeUnit) : lemma div_symm (x y : TimeUnit) : x / y = (y / x)⁻¹ := NNReal.eq <| by - rw [div_eq_val, inv_eq_one_div, div_eq_val] - simp only [one_div, NNReal.coe_inv] - rw [toReal, inv_div] + show x.val / y.val = (y.val / x.val)⁻¹ + rw [inv_div] + +/-- The unit-ratio cocycle at `ℝ≥0` (the un-coerced form of `div_mul_div_coe`). -/ +lemma div_mul_div (x y z : TimeUnit) : (x / y) * (y / z) = x / z := NNReal.eq <| by + show x.val / y.val * (y.val / z.val) = x.val / z.val + rw [div_mul_div_comm, mul_comm x.val y.val, mul_div_mul_left _ _ y.val_ne_zero] @[simp] lemma div_mul_div_coe (x y z : TimeUnit) : @@ -105,6 +109,7 @@ def scale (r : ℝ) (x : TimeUnit) (hr : 0 < r := by norm_num) : TimeUnit := lemma scale_div_self (x : TimeUnit) (r : ℝ) (hr : 0 < r) : scale r x hr / x = (⟨r, le_of_lt hr⟩ : ℝ≥0) := by simp [scale, div_eq_val] + rfl @[simp] lemma scale_one (x : TimeUnit) : scale 1 x = x := by @@ -114,9 +119,8 @@ lemma scale_one (x : TimeUnit) : scale 1 x = x := by lemma scale_div_scale (x1 x2 : TimeUnit) {r1 r2 : ℝ} (hr1 : 0 < r1) (hr2 : 0 < r2) : scale r1 x1 hr1 / scale r2 x2 hr2 = (⟨r1, le_of_lt hr1⟩ / ⟨r2, le_of_lt hr2⟩) * (x1 / x2) := by refine NNReal.eq ?_ - simp [scale, div_eq_val] - rw [toReal] - field_simp + show r1 * x1.val / (r2 * x2.val) = r1 / r2 * (x1.val / x2.val) + rw [div_mul_div_comm] @[simp] lemma self_div_scale (x : TimeUnit) (r : ℝ) (hr : 0 < r) : @@ -196,15 +200,27 @@ lemma weeks_div_seconds : weeks / seconds = (604800 : ℝ≥0) := NNReal.eq <| b simp [weeks]; rw [toReal]; norm_num lemma days_div_minutes : days / minutes = (1440 : ℝ≥0) := NNReal.eq <| by - simp [days, minutes]; rw [toReal]; norm_num + simp [days, minutes] + show (24 * 60 * 60 : ℝ) / 60 = ((1440 : ℝ≥0) : ℝ) + push_cast + norm_num lemma weeks_div_minutes : weeks / minutes = (10080 : ℝ≥0) := NNReal.eq <| by - simp [weeks, minutes]; rw [toReal]; norm_num + simp [weeks, minutes] + show (7 * 24 * 60 * 60 : ℝ) / 60 = ((10080 : ℝ≥0) : ℝ) + push_cast + norm_num lemma days_div_hours : days / hours = (24 : ℝ≥0) := NNReal.eq <| by - simp [hours, days]; rw [toReal]; norm_num + simp [hours, days] + show (24 * 60 * 60 : ℝ) / (60 * 60) = ((24 : ℝ≥0) : ℝ) + push_cast + norm_num lemma weeks_div_hours : weeks / hours = (168 : ℝ≥0) := NNReal.eq <| by - simp [weeks, hours]; rw [toReal]; norm_num + simp [weeks, hours] + show (7 * 24 * 60 * 60 : ℝ) / (60 * 60) = ((168 : ℝ≥0) : ℝ) + push_cast + norm_num end TimeUnit diff --git a/Physlib/SpaceAndTime/TimeAndSpace/Basic.lean b/Physlib/SpaceAndTime/TimeAndSpace/Basic.lean index 75fb653f11..6f855507f5 100644 --- a/Physlib/SpaceAndTime/TimeAndSpace/Basic.lean +++ b/Physlib/SpaceAndTime/TimeAndSpace/Basic.lean @@ -53,6 +53,7 @@ The derivative and distribution results are in the namespace `Space` by conventi ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/SpaceAndTime/TimeAndSpace/ConstantTimeDist.lean b/Physlib/SpaceAndTime/TimeAndSpace/ConstantTimeDist.lean index 10457cdf29..a0e8f12602 100644 --- a/Physlib/SpaceAndTime/TimeAndSpace/ConstantTimeDist.lean +++ b/Physlib/SpaceAndTime/TimeAndSpace/ConstantTimeDist.lean @@ -54,6 +54,7 @@ to get a Schwartz Map on `Space d`. ## iv. References +* None. -/ @[expose] public section @@ -206,7 +207,7 @@ lemma time_integral_hasFDerivAt {d : ℕ} (η : 𝓢(Time × Space d, ℝ)) (x have hf : Integrable η (volume.prod volume) := by exact η.integrable apply MeasureTheory.Integrable.comp_measurable - · haveI : (Measure.map (fun t => (t, x₀)) (volume (α := Time))).HasTemperateGrowth := by + · have : (Measure.map (fun t => (t, x₀)) (volume (α := Time))).HasTemperateGrowth := by refine { exists_integrable := ?_ } obtain ⟨r, hr⟩ := Measure.HasTemperateGrowth.exists_integrable (μ := volume (α := Time)) use r @@ -455,7 +456,7 @@ lemma time_integral_contDiff {d : ℕ} (n : ℕ) (η : 𝓢(Time × Space d, ℝ @[fun_prop] lemma integrable_time_integral {d : ℕ} (η : 𝓢(Time × Space d, ℝ)) (x : Space d) : Integrable (fun t => η (t, x)) volume := by - haveI : Measure.HasTemperateGrowth ((Measure.map (fun t => (t, x)) (volume (α := Time)))) := by + have : Measure.HasTemperateGrowth ((Measure.map (fun t => (t, x)) (volume (α := Time)))) := by refine { exists_integrable := ?_ } obtain ⟨r, hr⟩ := Measure.HasTemperateGrowth.exists_integrable (μ := volume (α := Time)) use r @@ -606,7 +607,7 @@ lemma iteratedFDeriv_integrable {n} {d : ℕ} (η : 𝓢(Time × Space d, ℝ)) Integrable (fun t => iteratedFDeriv ℝ n ⇑η (t, x)) volume := by rw [← MeasureTheory.integrable_norm_iff] apply iteratedFDeriv_norm_integrable η x - haveI : SecondCountableTopologyEither Time + have : SecondCountableTopologyEither Time (ContinuousMultilinearMap ℝ (fun i : Fin n => Time × Space d) ℝ) := { out := by left diff --git a/Physlib/SpaceAndTime/TimeAndSpace/EuclideanGroup/Action.lean b/Physlib/SpaceAndTime/TimeAndSpace/EuclideanGroup/Action.lean index a7e4575c9b..256a6c8044 100644 --- a/Physlib/SpaceAndTime/TimeAndSpace/EuclideanGroup/Action.lean +++ b/Physlib/SpaceAndTime/TimeAndSpace/EuclideanGroup/Action.lean @@ -32,6 +32,7 @@ the time coordinate and acts on the space coordinate by the usual Euclidean-grou ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/SpaceAndTime/TimeAndSpace/EuclideanGroup/SchwartzAction.lean b/Physlib/SpaceAndTime/TimeAndSpace/EuclideanGroup/SchwartzAction.lean index b289e50582..b51a383e0e 100644 --- a/Physlib/SpaceAndTime/TimeAndSpace/EuclideanGroup/SchwartzAction.lean +++ b/Physlib/SpaceAndTime/TimeAndSpace/EuclideanGroup/SchwartzAction.lean @@ -30,6 +30,7 @@ In this file we define the pullback action of the Euclidean group on Schwartz ma ## iv. References +* None. -/ @[expose] public section diff --git a/Physlib/StatisticalMechanics/CanonicalEnsemble/Basic.lean b/Physlib/StatisticalMechanics/CanonicalEnsemble/Basic.lean index a2df56b9d1..61ccd42cd0 100644 --- a/Physlib/StatisticalMechanics/CanonicalEnsemble/Basic.lean +++ b/Physlib/StatisticalMechanics/CanonicalEnsemble/Basic.lean @@ -87,10 +87,10 @@ mean energies and integrability. ## 8. References -* L. D. Landau & E. M. Lifshitz, *Statistical Physics, Part 1*. +* L. D. Landau & E. M. Lifshitz, Statistical Physics, Part 1. [ref: landau_statphys1] * D. Tong, Cambridge Lecture Notes (sections on canonical ensemble). - - https://www.damtp.cam.ac.uk/user/tong/statphys/one.pdf - - https://www.damtp.cam.ac.uk/user/tong/statphys/two.pdf + - https://www.damtp.cam.ac.uk/user/tong/statphys/one.pdf [ref: tong_statphys_notes_one] + - https://www.damtp.cam.ac.uk/user/tong/statphys/two.pdf [ref: tong_statphys_notes_two] ## 9. Roadmap diff --git a/Physlib/StatisticalMechanics/CanonicalEnsemble/Finite.lean b/Physlib/StatisticalMechanics/CanonicalEnsemble/Finite.lean index f1f80ed179..0b1900a00d 100644 --- a/Physlib/StatisticalMechanics/CanonicalEnsemble/Finite.lean +++ b/Physlib/StatisticalMechanics/CanonicalEnsemble/Finite.lean @@ -41,9 +41,8 @@ systems (addition, `nsmul`, and `congr`). ## References -- L. D. Landau & E. M. Lifshitz, *Statistical Physics, Part 1*, §31. -- D. Tong, *Lectures on Statistical Physics*, §1.3. - +* L. D. Landau & E. M. Lifshitz, Statistical Physics, Part 1, §31. [ref: landau_statphys1] +* D. Tong, Lectures on Statistical Physics, §1.3. [ref: tong_statistical_physics] -/ @[expose] public section @@ -113,7 +112,7 @@ instance [IsFinite 𝓒] (n : ℕ) : IsFinite (nsmul n 𝓒) where μ_eq_count := by induction n with | zero => - haveI : Subsingleton (Fin 0 → ι) := ⟨by intro f g; funext i; exact Fin.elim0 i⟩ + have : Subsingleton (Fin 0 → ι) := ⟨by intro f g; funext i; exact Fin.elim0 i⟩ have h_cases : ∀ s : Set (Fin 0 → ι), s = ∅ ∨ s = Set.univ := fun s => s.eq_empty_or_nonempty.imp_right fun ⟨y, hy⟩ => Set.eq_univ_of_forall fun x => by rwa [Subsingleton.elim x y] @@ -124,7 +123,7 @@ instance [IsFinite 𝓒] (n : ℕ) : IsFinite (nsmul n 𝓒) where · subst hs simp [CanonicalEnsemble.nsmul, IsFinite.μ_eq_count (𝓒:=𝓒)] | succ n ih => - haveI : IsFinite (nsmul n 𝓒) := { + have : IsFinite (nsmul n 𝓒) := { μ_eq_count := ih dof_eq_zero := by simp [CanonicalEnsemble.dof_nsmul, IsFinite.dof_eq_zero (𝓒:=𝓒)] @@ -132,7 +131,7 @@ instance [IsFinite 𝓒] (n : ℕ) : IsFinite (nsmul n 𝓒) where simp [CanonicalEnsemble.phase_space_unit_nsmul, IsFinite.phase_space_unit_eq_one (𝓒:=𝓒)] } - letI : Fintype (Fin (n+1) → ι) := inferInstance + let : Fintype (Fin (n+1) → ι) := inferInstance have h : ((𝓒 + nsmul n 𝓒).congr (MeasurableEquiv.piFinSuccAbove (fun _ => ι) 0)).μ diff --git a/Physlib/StatisticalMechanics/CanonicalEnsemble/Lemmas.lean b/Physlib/StatisticalMechanics/CanonicalEnsemble/Lemmas.lean index 59e14cf0e3..4a6eb680af 100644 --- a/Physlib/StatisticalMechanics/CanonicalEnsemble/Lemmas.lean +++ b/Physlib/StatisticalMechanics/CanonicalEnsemble/Lemmas.lean @@ -48,9 +48,9 @@ calculus identities for the canonical ensemble. ## References -Same references as `Basic.lean` (Landau–Lifshitz; Tong), especially the identities -`F = U - T S` and `U = -∂_β log Z`. - +* Same references as `Basic.lean`. [ref: landau_statphys1] +* Same references as `Basic.lean`, especially the identities `F = U - T S` and + `U = -∂_β log Z`. [ref: tong_statistical_physics] -/ @[expose] public section diff --git a/Physlib/StatisticalMechanics/CanonicalEnsemble/TwoState.lean b/Physlib/StatisticalMechanics/CanonicalEnsemble/TwoState.lean index f3f850e4e3..d9774a57a1 100644 --- a/Physlib/StatisticalMechanics/CanonicalEnsemble/TwoState.lean +++ b/Physlib/StatisticalMechanics/CanonicalEnsemble/TwoState.lean @@ -6,7 +6,6 @@ Authors: Matteo Cipollina, Joseph Tooby-Smith module public import Physlib.StatisticalMechanics.CanonicalEnsemble.Finite -public import Physlib.Meta.Informal.Basic /-! # Two-state canonical ensemble @@ -98,10 +97,37 @@ lemma twoState_meanEnergy_eq (E₀ E₁ : ℝ) (T : Temperature) : simp [Fin.sum_univ_two, twoState_probability_fst, twoState_probability_snd] ring -/-- A simplification of the `entropy` of the two-state canonical ensemble. -/ -informal_lemma twoState_entropy_eq where - tag := "EVJJI" - deps := [``twoState, ``thermodynamicEntropy] +/-- A simplification of the `entropy` of the two-state canonical ensemble. + +Since `β 0 = 0`, at `T = 0` the right-hand side evaluates to `Constants.kB * Real.log 2`. +See `twoState_entropy_eq_T_neq_zero` for the same statement carrying `T ≠ 0`. -/ +lemma twoState_entropy_eq (E₀ E₁ : ℝ) (T : Temperature) : + (twoState E₀ E₁).thermodynamicEntropy T = + Constants.kB * (Real.log (2 * Real.cosh (β T * (E₁ - E₀) / 2)) + - β T * (E₁ - E₀) / 2 * Real.tanh (β T * (E₁ - E₀) / 2)) := by + rw [thermodynamicEntropy_eq_shannonEntropy, shannonEntropy] + set x := β T * (E₁ - E₀) / 2 + have h2c : (2 : ℝ) * Real.cosh x ≠ 0 := by positivity + have hp0 : (twoState E₀ E₁).probability T 0 = Real.exp x / (2 * Real.cosh x) := by + rw [twoState_probability_fst, Real.tanh_eq_sinh_div_cosh, Real.sinh_eq, Real.cosh_eq] + field_simp + ring + have hp1 : (twoState E₀ E₁).probability T 1 = Real.exp (-x) / (2 * Real.cosh x) := by + rw [twoState_probability_snd, Real.tanh_eq_sinh_div_cosh, Real.sinh_eq, Real.cosh_eq] + field_simp + ring + rw [Fin.sum_univ_two, hp0, hp1, Real.log_div (Real.exp_ne_zero _) h2c, + Real.log_div (Real.exp_ne_zero _) h2c, Real.log_exp, Real.log_exp] + rw [Real.tanh_eq_sinh_div_cosh, Real.sinh_eq, Real.cosh_eq] + field_simp + ring + +/-- An instance of `twoState_entropy_eq` assuming T ≠ 0 -/ +lemma twoState_entropy_eq_T_neq_zero (E₀ E₁ : ℝ) (T : Temperature) (_ : T ≠ 0) : + (twoState E₀ E₁).thermodynamicEntropy T = + Constants.kB * (Real.log (2 * Real.cosh (β T * (E₁ - E₀) / 2)) + - β T * (E₁ - E₀) / 2 * Real.tanh (β T * (E₁ - E₀) / 2)) := + twoState_entropy_eq E₀ E₁ T /-- A simplification of the `helmholtzFreeEnergy` of the two-state canonical ensemble. -/ lemma twoState_helmholtzFreeEnergy_eq (E₀ E₁ : ℝ) (T : Temperature) : diff --git a/Physlib/StatisticalMechanics/MicroCanonicalEnsemble/IdealGas.lean b/Physlib/StatisticalMechanics/MicroCanonicalEnsemble/IdealGas.lean index ddef990f3e..71743a9c3b 100644 --- a/Physlib/StatisticalMechanics/MicroCanonicalEnsemble/IdealGas.lean +++ b/Physlib/StatisticalMechanics/MicroCanonicalEnsemble/IdealGas.lean @@ -38,7 +38,7 @@ def IdealGas : NVEHamiltonian where rintro ⟨n, V⟩ dsimp refine Measurable.ite ?_ ?_ measurable_const - · simp_rw [Set.setOf_forall] + · simp_rw [Set.ofPred_forall] exact MeasurableSet.iInter fun i => MeasurableSet.iInter fun ax => measurableSet_le (by fun_prop) measurable_const · simp_rw [← WithTop.coe_sum] @@ -96,7 +96,7 @@ lemma partitionZ_eq (hV : 0 < V) (hβ : 0 < β) : have h_measurability : Measurable fun x : (Fin n × Fin 3 → ℝ) × (Fin n × Fin 3 → ℝ) => if ∃ x_1 x_2, V ^ (3⁻¹:ℝ) / 2 < |x.1 (x_1, x_2)| then 0 else Real.exp (-(β * ∑ x_1 : Fin n × Fin 3, x.2 (x_1.1, x_1.2) ^ 2 / 2)) := by - refine Measurable.ite (measurableSet_setOf.mpr ?_) (by fun_prop) (by fun_prop) + refine Measurable.ite (measurableSet_setOfPred.mpr ?_) (by fun_prop) (by fun_prop) exact h_measurable_box.comp measurable_fst rw [MeasureTheory.integral_eq_lintegral_of_nonneg_ae] rotate_left @@ -122,11 +122,11 @@ lemma partitionZ_eq (hV : 0 < V) (hβ : 0 < β) : · exact Measurable.aestronglyMeasurable (by fun_prop) · exact Filter.Eventually.of_forall fun _ => by positivity · refine (Measurable.ite ?_ measurable_const measurable_const).aestronglyMeasurable - simp_rw [Set.setOf_forall] + simp_rw [Set.ofPred_forall] exact MeasurableSet.iInter fun i => MeasurableSet.iInter fun j => measurableSet_le (by fun_prop) measurable_const · refine (Measurable.ite ?_ measurable_const measurable_const).ennreal_ofReal - simp_rw [Set.setOf_forall] + simp_rw [Set.ofPred_forall] exact MeasurableSet.iInter fun i => MeasurableSet.iInter fun j => measurableSet_le (by fun_prop) measurable_const congr 1 diff --git a/Physlib/StringTheory/FTheory/SU5/Basic.lean b/Physlib/StringTheory/FTheory/SU5/Basic.lean index e255252144..505277ca6e 100644 --- a/Physlib/StringTheory/FTheory/SU5/Basic.lean +++ b/Physlib/StringTheory/FTheory/SU5/Basic.lean @@ -43,7 +43,8 @@ There are a number of important propositions in the theory. The charges are additionally constrained by the configuration `CodimensionOneConfig`, of the zero-section (`σ₀`) and the additional rational section (`σ₁`). -This is detailed in the paper `arxiv:1504.05593`. In implemented here using +This is detailed in the paper `arxiv:1504.05593` [ref: lawrie_schafer_nameki_wong_2015]. In +implemented here using - `Charges.ofFinset S5 S10`: which gives the finite set of charges where the 5-bar charges must live in the set `S5` and the 10-bar charges must live in the set `S10`. @@ -54,7 +55,6 @@ This is detailed in the paper `arxiv:1504.05593`. In implemented here using ## References -This theory is looked at in the following paper: -- arXiv:1507.05961. - +* Froggatt-Nielsen meets Mordell-Weil: A Phenomenological Survey of Global F-theory GUTs + with U(1)s (arxiv:1507.05961). [ref: arxiv_1507_05961] -/@[expose] public section diff --git a/Physlib/StringTheory/FTheory/SU5/Charges/AnomalyFree.lean b/Physlib/StringTheory/FTheory/SU5/Charges/AnomalyFree.lean index 3dab14bab6..ace86fdbf1 100644 --- a/Physlib/StringTheory/FTheory/SU5/Charges/AnomalyFree.lean +++ b/Physlib/StringTheory/FTheory/SU5/Charges/AnomalyFree.lean @@ -39,8 +39,7 @@ which do not have exotics. ## iv. References -There are no known references for the material in this section. - +* None. -/ @[expose] public section diff --git a/Physlib/StringTheory/FTheory/SU5/Charges/OfRationalSection.lean b/Physlib/StringTheory/FTheory/SU5/Charges/OfRationalSection.lean index 4b8e0e436c..96c507937d 100644 --- a/Physlib/StringTheory/FTheory/SU5/Charges/OfRationalSection.lean +++ b/Physlib/StringTheory/FTheory/SU5/Charges/OfRationalSection.lean @@ -15,12 +15,13 @@ public import Mathlib.Data.Fintype.Sets Within SU(5) F-theory with 10d and 5-bar matter fields there are constraints on the allowed U(1) charges the fields can have. -These constraints are determined in arXiv:1504.05593. They are related to the +These constraints are determined in arXiv:1504.05593 [ref: lawrie_schafer_nameki_wong_2015]. +They are related to the distinct configurations of the zero-section (`σ₀`) relativity to the additional rational section (`σ₁`s) in codimension one fiber. For our purposes here, we currently just state the constraints found -in arXiv:1504.05593, and leave the proof and derivation of these constraints to future -work. +in arXiv:1504.05593 [ref: lawrie_schafer_nameki_wong_2015], and leave the proof and derivation +of these constraints to future work. ## ii. Key results @@ -45,20 +46,17 @@ work. ## iv. References -The main reference for the material in this section is the paper: - -Lawrie, Schafer-Nameki and Wong. -F-theory and All Things Rational: Surveying U(1) Symmetries with Rational Sections -. Page 6. - -- See also footnote 4 of 1507.05961 - +* The main reference for the material in this section: Lawrie, Schafer-Nameki and Wong, F-theory + and All Things Rational: Surveying U(1) Symmetries with Rational Sections, page 6. + [ref: lawrie_schafer_nameki_wong_2015] +* See also footnote 4 of 1507.05961. [ref: arxiv_1507_05961] -/ @[expose] public section TODO "The results in this file are currently stated, but not proved. - They should should be proved following e.g. https://arxiv.org/pdf/1504.05593. + They should should be proved following e.g. https://arxiv.org/pdf/1504.05593 + [ref: lawrie_schafer_nameki_wong_2015]. This is a large project." namespace FTheory diff --git a/Physlib/StringTheory/FTheory/SU5/Charges/Viable.lean b/Physlib/StringTheory/FTheory/SU5/Charges/Viable.lean index 0b48100415..2121b5f89a 100644 --- a/Physlib/StringTheory/FTheory/SU5/Charges/Viable.lean +++ b/Physlib/StringTheory/FTheory/SU5/Charges/Viable.lean @@ -90,8 +90,7 @@ will be very welcome. In particular working out a way to restrict by anomaly can ## iv. References -There are no known references for the material in this section. - +* None. -/ @[expose] public section diff --git a/Physlib/StringTheory/FTheory/SU5/Fluxes/Basic.lean b/Physlib/StringTheory/FTheory/SU5/Fluxes/Basic.lean index 89c157a522..ad432dcd58 100644 --- a/Physlib/StringTheory/FTheory/SU5/Fluxes/Basic.lean +++ b/Physlib/StringTheory/FTheory/SU5/Fluxes/Basic.lean @@ -118,9 +118,8 @@ they can be derived from other data structures. ## iv. References -- [1] arXiv:1401.5084 -- For an old version of the material in this module see PR #569. - +* Rational F-Theory GUTs without exotics (arXiv:1401.5084). [ref: arxiv_1401_5084] +* For an old version of the material in this module see PR #569. -/ @[expose] public section diff --git a/Physlib/StringTheory/FTheory/SU5/Fluxes/NoExotics/ChiralIndices.lean b/Physlib/StringTheory/FTheory/SU5/Fluxes/NoExotics/ChiralIndices.lean index 1af23d3566..eed9fe57d9 100644 --- a/Physlib/StringTheory/FTheory/SU5/Fluxes/NoExotics/ChiralIndices.lean +++ b/Physlib/StringTheory/FTheory/SU5/Fluxes/NoExotics/ChiralIndices.lean @@ -40,8 +40,7 @@ we state them for the representation `D = (bar 3,1)_{1/3}` only: ## iv. References -There are no known references for the material in this module. - +* None. -/ @[expose] public section diff --git a/Physlib/StringTheory/FTheory/SU5/Fluxes/NoExotics/Completeness.lean b/Physlib/StringTheory/FTheory/SU5/Fluxes/NoExotics/Completeness.lean index 986e2a3b25..a39cb77d36 100644 --- a/Physlib/StringTheory/FTheory/SU5/Fluxes/NoExotics/Completeness.lean +++ b/Physlib/StringTheory/FTheory/SU5/Fluxes/NoExotics/Completeness.lean @@ -59,8 +59,7 @@ are only constrained by `2` SM representations `D` and `L`. ## iv. References -There are no known references for the material in this module. - +* None. -/ @[expose] public section diff --git a/Physlib/StringTheory/FTheory/SU5/Fluxes/NoExotics/Elems.lean b/Physlib/StringTheory/FTheory/SU5/Fluxes/NoExotics/Elems.lean index 1f6da927a7..4ddfb0738d 100644 --- a/Physlib/StringTheory/FTheory/SU5/Fluxes/NoExotics/Elems.lean +++ b/Physlib/StringTheory/FTheory/SU5/Fluxes/NoExotics/Elems.lean @@ -52,8 +52,7 @@ elements of those elements. ## iv. References -There are no known references for the material in this module. - +* None. -/ @[expose] public section diff --git a/Physlib/StringTheory/FTheory/SU5/Quanta/Basic.lean b/Physlib/StringTheory/FTheory/SU5/Quanta/Basic.lean index a521686ce8..0eb6a9def3 100644 --- a/Physlib/StringTheory/FTheory/SU5/Quanta/Basic.lean +++ b/Physlib/StringTheory/FTheory/SU5/Quanta/Basic.lean @@ -46,8 +46,8 @@ properties thereof. ## iv. References -A reference for the anomaly cancellation conditions is arXiv:1401.5084 equation 22. - +* Rational F-Theory GUTs without exotics (arXiv:1401.5084), Anomaly cancellation conditions, + equation 22. [ref: arxiv_1401_5084] -/ @[expose] public section @@ -208,8 +208,8 @@ There are two anomaly cancellation conditions in the SU(5)×U(1) model which inv - `∑ᵢ qᵢ² Nᵢ + 3 * ∑ₐ qₐ² Nₐ = 0` where the first sum is over all 5-bar representations and the second is over all 10d representations. -According to arXiv:1401.5084 it is unclear whether this second condition should necessarily be -imposed. +According to arXiv:1401.5084 [ref: arxiv_1401_5084] it is unclear whether this second condition +should necessarily be imposed. -/ diff --git a/Physlib/StringTheory/FTheory/SU5/Quanta/FiveQuanta.lean b/Physlib/StringTheory/FTheory/SU5/Quanta/FiveQuanta.lean index f8b8d6c726..17619bdc3e 100644 --- a/Physlib/StringTheory/FTheory/SU5/Quanta/FiveQuanta.lean +++ b/Physlib/StringTheory/FTheory/SU5/Quanta/FiveQuanta.lean @@ -78,8 +78,8 @@ properties thereof. ## iv. References -A reference for the anomaly cancellation conditions is arXiv:1401.5084. - +* Rational F-Theory GUTs without exotics (arXiv:1401.5084), Anomaly cancellation + conditions. [ref: arxiv_1401_5084] -/ @[expose] public section @@ -910,9 +910,9 @@ variable [CommRing 𝓩] The anomaly coefficient of a `FiveQuanta` is given by the pair of integers: `(∑ᵢ qᵢ Nᵢ, ∑ᵢ qᵢ² Nᵢ)`. - The first components is for the mixed U(1)-MSSM, see equation (22) of arXiv:1401.5084. - The second component is for the mixed U(1)Y-U(1)-U(1) gauge anomaly, - see equation (23) of arXiv:1401.5084. + The first components is for the mixed U(1)-MSSM, see equation (22) of arXiv:1401.5084 + [ref: arxiv_1401_5084]. The second component is for the mixed U(1)Y-U(1)-U(1) gauge anomaly, + see equation (23) of arXiv:1401.5084 [ref: arxiv_1401_5084]. -/ def anomalyCoefficient (F : FiveQuanta 𝓩) : 𝓩 × 𝓩 := ((F.map fun x => x.2.2 • x.1).sum, (F.map fun x => x.2.2 • (x.1 * x.1)).sum) diff --git a/Physlib/StringTheory/FTheory/SU5/Quanta/IsViable.lean b/Physlib/StringTheory/FTheory/SU5/Quanta/IsViable.lean index 971bbfee47..af86831902 100644 --- a/Physlib/StringTheory/FTheory/SU5/Quanta/IsViable.lean +++ b/Physlib/StringTheory/FTheory/SU5/Quanta/IsViable.lean @@ -6,7 +6,6 @@ Authors: Joseph Tooby-Smith module public import Physlib.StringTheory.FTheory.SU5.Charges.AnomalyFree -public import Mathlib.Data.ZMod.Defs /-! # Viable Quanta with Yukawa @@ -55,8 +54,8 @@ lake exe graph --from ## iv. References -The key reference for the material in this module is: arXiv:1507.05961. - +* Froggatt-Nielsen meets Mordell-Weil: A Phenomenological Survey of Global F-theory GUTs + with U(1)s (arxiv:1507.05961). [ref: arxiv_1507_05961] -/ @[expose] public section diff --git a/Physlib/StringTheory/FTheory/SU5/Quanta/TenQuanta.lean b/Physlib/StringTheory/FTheory/SU5/Quanta/TenQuanta.lean index f2adeb9c84..c25506f91f 100644 --- a/Physlib/StringTheory/FTheory/SU5/Quanta/TenQuanta.lean +++ b/Physlib/StringTheory/FTheory/SU5/Quanta/TenQuanta.lean @@ -80,8 +80,8 @@ properties thereof. ## iv. References -A reference for the anomaly cancellation conditions is arXiv:1401.5084. - +* Rational F-Theory GUTs without exotics (arXiv:1401.5084), Anomaly cancellation + conditions. [ref: arxiv_1401_5084] -/ @[expose] public section @@ -1053,9 +1053,9 @@ variable [CommRing 𝓩] The anomaly coefficient of a `TenQuanta` is given by the pair of integers: `(∑ᵢ qᵢ Nᵢ, 3 * ∑ᵢ qᵢ² Nᵢ)`. - The first components is for the mixed U(1)-MSSM, see equation (22) of arXiv:1401.5084. - The second component is for the mixed U(1)Y-U(1)-U(1) gauge anomaly, - see equation (23) of arXiv:1401.5084. + The first components is for the mixed U(1)-MSSM, see equation (22) of arXiv:1401.5084 + [ref: arxiv_1401_5084]. The second component is for the mixed U(1)Y-U(1)-U(1) gauge anomaly, + see equation (23) of arXiv:1401.5084 [ref: arxiv_1401_5084]. -/ def anomalyCoefficient (F : TenQuanta 𝓩) : 𝓩 × 𝓩 := ((F.map fun x => x.2.2 • x.1).sum, 3 * (F.map fun x => x.2.2 • (x.1 * x.1)).sum) diff --git a/Physlib/Thermodynamics/Temperature/API-map.yaml b/Physlib/Thermodynamics/Temperature/API-map.yaml new file mode 100644 index 0000000000..689bbf13a9 --- /dev/null +++ b/Physlib/Thermodynamics/Temperature/API-map.yaml @@ -0,0 +1,97 @@ +version: v0.1 + +Title: Temperature + +Overview: | + Temperature here is measured from absolute zero and is taken to be + nonnegative: no scale used here places a state below absolute zero, which + excludes the negative absolute temperatures a system with a bounded energy + spectrum can carry. A choice of scale is a choice of how large one degree + is, and nothing more, so two such choices differ by a positive ratio, and + kelvin is the scale from which the others here are obtained by rescaling. + + In statistical mechanics the quantity that actually appears is not the + temperature itself but its reciprocal, weighted by the Boltzmann constant: + the inverse temperature that multiplies an energy in a Boltzmann factor. On + positive temperatures the correspondence is a bijection onto the positive + inverse temperatures and reverses order, so a hot system is one with a small + inverse temperature; the boundary value zero is paired with itself, which is + a convention of the underlying nonnegative reals rather than a physical + statement. The limit of large inverse temperature is the one recorded here: + sending the inverse temperature to infinity drives the temperature to + absolute zero, the regime in which a system settles into its lowest energy + states. + + Thermodynamic quantities are differentiated with respect to one or the other + of these variables, so the change of variable between them is smooth at + positive temperature, and a derivative in one variable determines the + derivative in the other. + +ParentAPIs: + - "Boltzmann constant (Physlib/StatisticalMechanics/BoltzmannConstant.lean)" + +References: + - L. D. Landau & E. M. Lifshitz, Statistical Physics, Part 1 (§9 temperature, §31 the Gibbs distribution). + - N. F. Ramsey, Thermodynamics and statistical mechanics at negative absolute temperatures, Physical Review 103 (1956), 20-28. + +Requirements: + + - description: "The key data structure `Temperature`, an absolute temperature in an arbitrary scale that puts absolute zero at zero, is defined, with its coercions, topology, zero and extensionality." + done: true + location: "Physlib/Thermodynamics/Temperature/Basic.lean (Temperature, val, toReal, ext, Coe Temperature ℝ≥0, Coe Temperature ℝ, TopologicalSpace Temperature, Zero Temperature)" + + - description: "The API contains the inverse temperature attached to a temperature, its defining formula in terms of the Boltzmann constant, and the construction of a temperature from an inverse temperature." + done: true + location: "Physlib/Thermodynamics/Temperature/Basic.lean (β, β_toReal, ofβ, ofβ_eq, ofβ_toReal)" + + - description: "The API contains the result that passing to the inverse temperature and back is the identity in both directions." + done: true + location: "Physlib/Thermodynamics/Temperature/Basic.lean (β_ofβ, ofβ_β)" + + - description: "The API contains the result that a strictly positive temperature has strictly positive inverse temperature." + done: true + location: "Physlib/Thermodynamics/Temperature/Basic.lean (beta_pos)" + + - description: "The API contains the continuity of the temperature as a function of the inverse temperature at positive inverse temperature, and the differentiability of its real coordinate on the positive reals." + done: true + location: "Physlib/Thermodynamics/Temperature/Basic.lean (ofβ_continuousOn, ofβ_differentiableOn)" + + - description: "The API contains the behaviour in the limit of large inverse temperature, namely eventual positivity and convergence of the temperature to absolute zero from above." + done: true + location: "Physlib/Thermodynamics/Temperature/Basic.lean (eventually_pos_ofβ, tendsto_toReal_ofβ_atTop, tendsto_ofβ_atTop)" + + - description: "The API contains constructions of a temperature from a nonnegative real and from a real together with a proof of nonnegativity, with their defining equations." + done: true + location: "Physlib/Thermodynamics/Temperature/Basic.lean (ofNNReal, ofNNReal_val, coe_ofNNReal_coe, coe_ofNNReal_real, ofRealNonneg, ofRealNonneg_val)" + + - description: "The API contains the derivative of the inverse temperature with respect to the temperature at positive temperature, and the chain rule converting a derivative with respect to the inverse temperature into a derivative with respect to the temperature." + done: true + location: "Physlib/Thermodynamics/Temperature/Basic.lean (betaFromReal, beta_fun_T_formula, beta_fun_T_eq_on_Ioi, deriv_beta_wrt_T, chain_rule_T_beta)" + + - description: "The key data structure `TemperatureUnit`, a choice of temperature scale carrying a positive scale factor, is defined." + done: true + location: "Physlib/Thermodynamics/Temperature/TemperatureUnits.lean (TemperatureUnit, val_ne_zero, val_pos, Inhabited TemperatureUnit)" + + - description: "The API contains the ratio of two temperature units as a nonnegative real, with its positivity and its reflexivity, symmetry and composition properties." + done: true + location: "Physlib/Thermodynamics/Temperature/TemperatureUnits.lean (HDiv TemperatureUnit TemperatureUnit ℝ≥0, div_eq_val, div_ne_zero, div_pos, div_self, div_symm, div_mul_div, div_mul_div_coe)" + + - description: "The API contains the rescaling of a temperature unit by a positive real, with the ratios it induces and its composition law." + done: true + location: "Physlib/Thermodynamics/Temperature/TemperatureUnits.lean (scale, scale_div_self, self_div_scale, scale_one, scale_div_scale, scale_scale)" + + - description: "The API contains kelvin as the reference temperature unit, together with the units obtained from it by rescaling." + done: true + location: "Physlib/Thermodynamics/Temperature/TemperatureUnits.lean (kelvin, nanokelvin, microkelvin, millikelvin, absoluteFahrenheit)" + + - description: "The API shall contain the temperature manifold, diffeomorphic to the nonnegative reals, of which a temperature unit is a translationally invariant metric." + done: false + location: N/A + + - description: "The API shall contain the conversion of a temperature value between two temperature units." + done: false + location: N/A + + - description: "The API shall contain scales whose zero is offset from absolute zero, namely degrees Celsius and degrees Fahrenheit as ordinarily used, as opposed to the absolute Fahrenheit-sized degree already present, together with their conversion to absolute scales." + done: false + location: N/A diff --git a/Physlib/Thermodynamics/Temperature/TemperatureUnits.lean b/Physlib/Thermodynamics/Temperature/TemperatureUnits.lean index 0b61fad11f..c778f840aa 100644 --- a/Physlib/Thermodynamics/Temperature/TemperatureUnits.lean +++ b/Physlib/Thermodynamics/Temperature/TemperatureUnits.lean @@ -80,9 +80,13 @@ lemma div_self (x : TemperatureUnit) : lemma div_symm (x y : TemperatureUnit) : x / y = (y / x)⁻¹ := NNReal.eq <| by - rw [div_eq_val, inv_eq_one_div, div_eq_val] - simp only [one_div, NNReal.coe_inv] - rw [toReal, inv_div] + show x.val / y.val = (y.val / x.val)⁻¹ + rw [inv_div] + +/-- The unit-ratio cocycle at `ℝ≥0` (the un-coerced form of `div_mul_div_coe`). -/ +lemma div_mul_div (x y z : TemperatureUnit) : (x / y) * (y / z) = x / z := NNReal.eq <| by + show x.val / y.val * (y.val / z.val) = x.val / z.val + rw [div_mul_div_comm, mul_comm x.val y.val, mul_div_mul_left _ _ y.val_ne_zero] @[simp] lemma div_mul_div_coe (x y z : TemperatureUnit) : @@ -104,6 +108,7 @@ def scale (r : ℝ) (x : TemperatureUnit) (hr : 0 < r := by norm_num) : Temperat lemma scale_div_self (x : TemperatureUnit) (r : ℝ) (hr : 0 < r) : scale r x hr / x = (⟨r, le_of_lt hr⟩ : ℝ≥0) := by simp [scale, div_eq_val] + rfl @[simp] lemma self_div_scale (x : TemperatureUnit) (r : ℝ) (hr : 0 < r) : @@ -120,9 +125,8 @@ lemma scale_one (x : TemperatureUnit) : scale 1 x = x := by lemma scale_div_scale (x1 x2 : TemperatureUnit) {r1 r2 : ℝ} (hr1 : 0 < r1) (hr2 : 0 < r2) : scale r1 x1 hr1 / scale r2 x2 hr2 = (⟨r1, le_of_lt hr1⟩ / ⟨r2, le_of_lt hr2⟩) * (x1 / x2) := by refine NNReal.eq ?_ - simp [scale, div_eq_val] - rw [toReal] - field_simp + show r1 * x1.val / (r2 * x2.val) = r1 / r2 * (x1.val / x2.val) + rw [div_mul_div_comm] @[simp] lemma scale_scale (x : TemperatureUnit) (r1 r2 : ℝ) (hr1 : 0 < r1) (hr2 : 0 < r2) : diff --git a/Physlib/Units/API-map.yaml b/Physlib/Units/API-map.yaml new file mode 100644 index 0000000000..75f4511e66 --- /dev/null +++ b/Physlib/Units/API-map.yaml @@ -0,0 +1,327 @@ +version: v0.1 + +Title: Units + +Overview: | + Every physical quantity has a dimension: a rational power of each base dimension, + recording how the numerical value of the quantity changes when the unit of each base + quantity is changed. The LTMCT set has five base dimensions: length, time, mass, + charge and temperature, whose initials give the name; they are written L𝓭, T𝓭, + M𝓭, C𝓭 and Θ𝓭. Dimensions multiply by adding exponents and invert by negating + them, so they form a commutative group with a rational power operation. The + International System of Quantities (ISQ) uses a different set of seven base + quantities, in which electric charge is derived as current times time; + both sets are available and are related by a faithful inclusion and a reduction. + LTMCT is the set over which the typed unit layer (LTMCTUnitChoices and its SI choice) + and the named derived quantities are built; the ISQ set carries SIUnitChoices. + + A unit system fixes one concrete unit for each base quantity. Changing from one system + to another multiplies a quantity of dimension d by a positive factor: the product, + over the base quantities, of the ratio of the two units raised to the exponent that d + assigns to that base quantity. That factor is multiplicative in the dimension, equals + one when the two systems agree, and composes along a chain, so the value of a quantity + in one system determines its value in every other. The statement is proved once for a + general set of base dimensions and specialises to the LTMCT set and to the ISQ set + without being restated. + + A value carrying a dimension inherits the additive, order and scalar structure of its + underlying type, while products and quotients add and subtract the exponents. Area, + speed, energy, pressure and momentum appear as named dimensions with concrete units. + A statement is dimensionally correct when its truth does not depend on the unit system + in which it is written, which is the formal content of dimensional analysis; the API + expresses that condition for values, functions and propositions, and proves that the + derivative and the integral of a dimensionally correct quantity are again + dimensionally correct. + +ParentAPIs: + - "Time (Physlib/SpaceAndTime/Time)" + - "Space (Physlib/SpaceAndTime/Space)" + - "Mass (Physlib/ClassicalMechanics/Mass)" + - "Charge (Physlib/Electromagnetism/Charge)" + - "Temperature (Physlib/Thermodynamics/Temperature)" + +References: + - "International Bureau of Weights and Measures (BIPM), The International System of Units (SI Brochure), 9th edition (2019), Chapter 1 (quantities and units) and Chapter 2 (the defining constants and the seven base units)" + - "ISO/IEC 80000-1:2009, Quantities and units, Part 1: General, Clauses 3 to 6 (quantities, systems of quantities, dimensions, and systems of units)" + - "JCGM 200:2012, International vocabulary of metrology (VIM, 3rd edition), Clause 1 (base quantity, derived quantity, quantity dimension, base unit, coherent system of units)" + - "G. I. Barenblatt, Scaling, Self-similarity, and Intermediate Asymptotics, Cambridge University Press (1996), Chapter 1, Sections 1.1 and 1.2 (dimensions, systems of units, and the change of a quantity under a change of unit)" + - "Lean Zulip, #Physlib > physical units: https://leanprover.zulipchat.com/#narrow/channel/479953-Physlib/topic/physical.20units" + +Requirements: + + - description: "A dimension assigns a rational exponent to each base dimension, with extensionality." + done: true + location: "Physlib/Units/Dimension.lean (Dimension, Dimension.ext)" + + - description: "Dimensions form a commutative group with a rational power operation." + done: true + location: "Physlib/Units/Dimension.lean (CommGroup (Dimension B), Dimension.qpow_exponent)" + + - description: "The exponents of a product, of the unit, of an inverse, of a quotient and of a natural power are computed." + done: true + location: "Physlib/Units/Dimension.lean (Dimension.mul_exponent, Dimension.one_exponent, Dimension.inv_exponent, Dimension.div_exponent, Dimension.npow_exponent)" + + - description: "The base vector at each base dimension is defined, with its exponents." + done: true + location: "Physlib/Units/Dimension.lean (Dimension.single, Dimension.single_exponent)" + + - description: "A change of base-dimension set is a monoid homomorphism of dimensions, either an injective embedding of one set into another or a surjective reduction of a richer set onto a coarser one, so a relabelling that does not preserve products, inverses and rational powers is not expressible." + done: true + location: "Physlib/Units/Dimension.lean (Dimension.extend, Dimension.extend_exponent_apply, Dimension.extendHom, Dimension.Embedding, Dimension.Projection, Dimension.Embedding.ofBasis)" + + - description: "The LTMCT set of five base dimensions is defined with the exponent projection of each." + done: true + location: "Physlib/Units/LTMCTDimensionBase.lean (LTMCTDimensionBase, Dimension.length, Dimension.time, Dimension.mass, Dimension.charge, Dimension.temperature)" + + - description: "A dimension is constructed from its five exponents." + done: true + location: "Physlib/Units/LTMCTDimensionBase.lean (Dimension.ofLTMCTDimensionBase)" + + - description: "Each of the five exponents is computed under products, units, inverses, quotients and natural powers." + done: true + location: "Physlib/Units/LTMCTDimensionBase.lean (Dimension.length_mul, Dimension.one_time, Dimension.inv_mass, Dimension.div_charge, Dimension.npow_temperature)" + + - description: "The named generators L𝓭, T𝓭, M𝓭, C𝓭 and Θ𝓭 are defined and identified with the corresponding base vectors of the generic algebra." + done: true + location: "Physlib/Units/LTMCTDimensionBase.lean (Dimension.L𝓭, Dimension.T𝓭, Dimension.M𝓭, Dimension.C𝓭, Dimension.Θ𝓭, Dimension.L𝓭_eq_single, Dimension.T𝓭_eq_single, Dimension.M𝓭_eq_single, Dimension.C𝓭_eq_single, Dimension.Θ𝓭_eq_single)" + + - description: "The seven base quantities of the International System of Quantities are defined." + done: true + location: "Physlib/Units/ISQDimensionBase.lean (ISQDimensionBase, ISQDimensionBase.card_eq_seven)" + + - description: "Electric charge is derived as current times time, with its exponents in current, time and mass." + done: true + location: "Physlib/Units/ISQDimensionBase.lean (ISQDimensionBase.charge, ISQDimensionBase.charge_exponent_current, ISQDimensionBase.charge_exponent_time, ISQDimensionBase.charge_exponent_mass)" + + - description: "Amount of substance and luminous intensity are independent of the other base quantities." + done: true + location: "Physlib/Units/ISQDimensionBase.lean (ISQDimensionBase.single_amount_ne_one, ISQDimensionBase.single_luminousIntensity_ne_one)" + + - description: "A faithful embedding carries the LTMCT base dimensions into the ISQ set, sending the charge generator to the derived ISQ charge." + done: true + location: "Physlib/Units/ISQBridge.lean (Dimension.toISQFun, Dimension.toISQHom, Dimension.toISQHom_apply, Dimension.toISQHom_injective, Dimension.ltmctToISQ, Dimension.toISQHom_C𝓭)" + + - description: "A reduction reads electric current as charge per time and forgets amount of substance and luminous intensity." + done: true + location: "Physlib/Units/ISQBridge.lean (Dimension.fromISQFun, Dimension.fromISQHom, Dimension.fromISQHom_apply, Dimension.fromISQHom_surjective, Dimension.isqToLTMCT)" + + - description: "The reduction is a retraction of the embedding, and the composite in the other order is not the identity." + done: true + location: "Physlib/Units/ISQBridge.lean (Dimension.fromISQHom_comp_toISQHom, Dimension.isqToLTMCT_comp_ltmctToISQ)" + + - description: "A unit choice fixes one unit for each of the five LTMCT base quantities, with the SI choice of metre, second, kilogram, coulomb and kelvin." + done: true + location: "Physlib/Units/Basic.lean (LTMCTUnitChoices, LTMCTUnitChoices.SI, LTMCTUnitChoices.SI_length, LTMCTUnitChoices.SI_time, LTMCTUnitChoices.SI_mass, LTMCTUnitChoices.SI_charge, LTMCTUnitChoices.SI_temperature)" + + - description: "A second unit choice rescales each SI base unit by a distinct prime, which serves to refute dimensional correctness." + done: true + location: "Physlib/Units/Basic.lean (LTMCTUnitChoices.SIPrimed, LTMCTUnitChoices.dimScale_SI_SIPrimed, LTMCTUnitChoices.dimScale_SIPrimed_SI)" + + - description: "The factor by which a quantity of a given dimension rescales under a change of unit choice is a monoid homomorphism from dimensions to the positive reals." + done: true + location: "Physlib/Units/Basic.lean (LTMCTUnitChoices.dimScale, LTMCTUnitChoices.dimScale_apply)" + + - description: "The rescaling factor is one on the trivial dimension and on a unit system paired with itself." + done: true + location: "Physlib/Units/Basic.lean (LTMCTUnitChoices.dimScale_self, LTMCTUnitChoices.dimScale_one)" + + - description: "The rescaling factor is strictly positive and nonzero, composes along a chain of three unit choices, and inverts when the two choices are swapped." + done: true + location: "Physlib/Units/Basic.lean (LTMCTUnitChoices.dimScale_ne_zero, LTMCTUnitChoices.dimScale_pos, LTMCTUnitChoices.dimScale_transitive, LTMCTUnitChoices.dimScale_symm, LTMCTUnitChoices.dimScale_mul_symm, LTMCTUnitChoices.dimScale_coe_mul_symm, LTMCTUnitChoices.dimScale_of_inv_eq_swap)" + + - description: "Scaling by the rescaling factor is injective." + done: true + location: "Physlib/Units/Basic.lean (LTMCTUnitChoices.smul_dimScale_injective)" + + - description: "A type may be assigned a dimension, strengthened to a type on which the positive reals act." + done: true + location: "Physlib/Units/Basic.lean (HasDim, HasDim.d, dim, CarriesDimension)" + + - description: "A function from unit choices to a dimension-carrying type is required to rescale by the correct factor under every change of unit." + done: true + location: "Physlib/Units/Basic.lean (HasDimension, hasDimension_iff)" + + - description: "The subtype of functions satisfying that condition carries a scalar action." + done: true + location: "Physlib/Units/Basic.lean (Dimensionful, Dimensionful.ext, Dimensionful.smul_apply)" + + - description: "For each fixed unit choice, a value of a dimension-carrying type is equivalent to a quantity given in every unit system." + done: true + location: "Physlib/Units/Basic.lean (CarriesDimension.toDimensionful, CarriesDimension.toDimensionful_apply_apply)" + + - description: "A magnitude layer assigns a positive real to each base dimension, with nonzero ratios." + done: true + location: "Physlib/Units/ParametricUnits.lean (UnitScale, UnitScale.ratio_ne_zero)" + + - description: "The scaling homomorphism on the magnitude layer is the product over the base dimensions of the unit ratio raised to the corresponding exponent, and is transitive." + done: true + location: "Physlib/Units/ParametricUnits.lean (UnitScale.dimScale, UnitScale.dimScale_self, UnitScale.dimScale_one, UnitScale.dimScale_transitive)" + + - description: "A catalogue names a type of admissible units and a magnitude for each base dimension, and a unit system chooses exactly one unit per base dimension." + done: true + location: "Physlib/Units/UnitSystem.lean (UnitMagnitudeCatalog, UnitSystem, UnitSystem.ext)" + + - description: "A unit system projects onto the magnitude layer." + done: true + location: "Physlib/Units/UnitSystem.lean (UnitSystem.toScale, UnitSystem.toScale_scale)" + + - description: "The bespoke five-field unit choice is equivalent to a unit system over the LTMCT base dimensions, and its hand-written scaling law is the generic product specialised to that set." + done: true + location: "Physlib/Units/ParametricUnits.lean (LTMCTUnitChoices.toScale); Physlib/Units/UnitSystem.lean (LTMCTUnitChoices.equivUnitSystem, LTMCTUnitChoices.toScale_equivUnitSystem, prod_univ_LTMCTDimensionBase, LTMCTUnitChoices.dimScale_eq_toScale_dimScale)" + + - description: "Units of electric current, of amount of substance and of luminous intensity are defined, each a positive magnitude with its quotient by another unit of the same kind." + done: true + location: "Physlib/Units/SIUnitChoices.lean (CurrentUnit, CurrentUnit.val_pos, CurrentUnit.div_eq_val, AmountUnit, AmountUnit.div_eq_val, LuminousIntensityUnit, LuminousIntensityUnit.div_eq_val)" + + - description: "The coherent SI units ampere, mole and candela are named." + done: true + location: "Physlib/Units/SIUnitChoices.lean (CurrentUnit.amperes, AmountUnit.moles, LuminousIntensityUnit.candelas)" + + - description: "A typed unit choice over the seven ISQ base quantities is defined, with the coherent SI choice of metre, kilogram, second, ampere, kelvin, mole and candela." + done: true + location: "Physlib/Units/SIUnitChoices.lean (SIUnitChoices, SIUnitChoices.SI)" + + - description: "The scaling factor over the ISQ base quantities is obtained from the generic product rather than restated." + done: true + location: "Physlib/Units/SIUnitChoices.lean (prod_univ_ISQDimensionBase, SIUnitChoices.dimScale, SIUnitChoices.dimScale_self)" + + - description: "The SI unit choice over the five LTMCT base quantities shall be computable, which a note in the source records as requiring the axioms that define the base units to be replaced." + done: false + location: "N/A" + + - description: "The unit types for electric current, amount of substance and luminous intensity shall carry the same rescaling operation as the other five, so that a decimal multiple such as the milliampere can be named." + done: true + location: > + Physlib/Units/SIUnitChoices.lean + (CurrentUnit.scale, CurrentUnit.scale_div_self, CurrentUnit.self_div_scale, + CurrentUnit.scale_one, CurrentUnit.scale_div_scale, CurrentUnit.scale_scale, + CurrentUnit.milliamperes, AmountUnit.scale, AmountUnit.scale_div_self, + AmountUnit.self_div_scale, AmountUnit.scale_one, AmountUnit.scale_div_scale, + AmountUnit.scale_scale, LuminousIntensityUnit.scale, + LuminousIntensityUnit.scale_div_self, LuminousIntensityUnit.self_div_scale, + LuminousIntensityUnit.scale_one, LuminousIntensityUnit.scale_div_scale, + LuminousIntensityUnit.scale_scale) + + - description: "A unit-dependent type comes with the transformation of its elements induced by a change of unit, subject to composition along a chain of unit choices and triviality on an unchanged choice." + done: true + location: "Physlib/Units/UnitDependent.lean (UnitDependent)" + + - description: "Strengthenings require that transformation to commute with a scalar action, to be linear, or to be linear and continuous." + done: true + location: "Physlib/Units/UnitDependent.lean (MulUnitDependent, LinearUnitDependent, ContinuousLinearUnitDependent)" + + - description: "The transformation is packaged as an equivalence, a linear map, a linear equivalence, a continuous linear map and a continuous linear equivalence." + done: true + location: "Physlib/Units/UnitDependent.lean (UnitDependent.scaleUnit_symm_apply, UnitDependent.scaleUnit_injective, UnitDependent.scaleUnitEquiv, LinearUnitDependent.scaleUnitLinear, LinearUnitDependent.scaleUnitLinearEquiv, ContinuousLinearUnitDependent.scaleUnitContLinear, ContinuousLinearUnitDependent.scaleUnitContLinearEquiv)" + + - description: "Instances are given for the unit choices themselves and for every type carrying a dimension." + done: true + location: "Physlib/Units/UnitDependent.lean (LTMCTUnitChoices.scaleUnit_apply_fst, LTMCTUnitChoices.dimScale_scaleUnit, Dimensionful.of_scaleUnit, HasDim.scaleUnit_apply)" + + - description: "Instances for function types act on the argument, on the value, or on both." + done: true + location: "Physlib/Units/UnitDependent.lean (UnitDependent.scaleUnit_apply_fun_right, UnitDependent.scaleUnit_apply_fun_left, UnitDependent.scaleUnit_apply_fun, instUnitDependentTwoSided, instUnitDependentTwoSidedMul, instContinuousLinearUnitDependentMap)" + + - description: "Dimensional correctness is the condition that a quantity or a statement be unchanged by a change of unit system, with its unfolding for functions acting on the argument, on the value and on both." + done: true + location: "Physlib/Units/UnitDependent.lean (IsDimensionallyCorrect, isDimensionallyCorrect_iff, isDimensionallyCorrect_fun_iff, isDimensionallyCorrect_fun_left, isDimensionallyCorrect_fun_right)" + + - description: "The dimension-preserving product of two dimension-carrying types scales as the product of their dimensions." + done: true + location: "Physlib/Units/UnitDependent.lean (DMul, DMul.hMul_scaleUnit)" + + - description: "The subset of a unit-dependent type consisting of the elements that scale according to a prescribed dimension itself carries that dimension." + done: true + location: "Physlib/Units/UnitDependent.lean (DimSet, DimSet.mem_iff, scaleUnit_dimSet_val)" + + - description: "Values of an underlying type may be tagged with a dimension over any set of base dimensions." + done: true + location: "Physlib/Units/WithDim/Basic.lean (WithDim, WithDim.ext, WithDim.dim_apply)" + + - description: "The tagged type inherits zero, addition, negation and subtraction, each computed on the underlying value." + done: true + location: "Physlib/Units/WithDim/Basic.lean (WithDim.val_zero, WithDim.val_add, WithDim.val_neg, WithDim.val_sub)" + + - description: "The tagged type inherits the order relations and the action of the positive reals." + done: true + location: "Physlib/Units/WithDim/Basic.lean (WithDim.le_def, WithDim.lt_def, WithDim.smul_val)" + + - description: "Multiplication and division of real-valued tagged quantities multiply the underlying values and multiply the dimensions." + done: true + location: "Physlib/Units/WithDim/Basic.lean (WithDim.withDim_hMul_val, WithDim.val_mul_eq_mul, WithDim.val_pow_two_eq_mul, WithDim.val_div_val, WithDim.div_scaleUnit)" + + - description: "Over the LTMCT base dimensions the tagged type carries its dimension and its transformation under a change of unit is scalar multiplication by the scaling factor." + done: true + location: "Physlib/Units/WithDim/Basic.lean (WithDim.scaleUnit_val, WithDim.scaleUnit_val_eq_scaleUnit_val, WithDim.scaleUnit_val_eq_scaleUnit_val_of_dim_eq)" + + - description: "A tagged quantity of trivial dimension is unchanged by a change of unit." + done: true + location: "Physlib/Units/WithDim/Basic.lean (WithDim.scaleUnit_dim_eq_zero)" + + - description: "A cast moves a tagged quantity between two tags whose dimensions are equal, with the equality discharged automatically." + done: true + location: "Physlib/Units/WithDim/Basic.lean (WithDim.cast, WithDim.cast_refl, WithDim.cast_scaleUnit)" + + - description: "The dimension-tagged type shall inherit further structure from its underlying type: multiplicative and other non-additive algebraic structure, the remaining order structure, and topological structure." + done: false + location: "N/A" + + - description: "Area has dimension length squared, with the square metre, square foot, square mile, are, hectare and acre, their values in SI units, and the identity of one acre with 43560 square feet." + done: true + location: "Physlib/Units/WithDim/Area.lean (DimArea, DimArea.squareMeter, DimArea.squareFoot, DimArea.squareMile, DimArea.are, DimArea.hectare, DimArea.acre, DimArea.squareFoot_in_SI, DimArea.squareMile_in_SI, DimArea.acre_in_SI, DimArea.acre_eq_mul_squareFeet)" + + - description: "Speed has dimension length over time, with the metre per second, mile per hour, kilometre per hour, knot and the speed of light, their values in SI units, and the conversions between them." + done: true + location: "Physlib/Units/WithDim/Speed.lean (DimSpeed, DimSpeed.oneMeterPerSecond, DimSpeed.oneMilePerHour, DimSpeed.oneKilometerPerHour, DimSpeed.oneKnot, DimSpeed.speedOfLight, DimSpeed.oneMilePerHour_in_SI, DimSpeed.speedOfLight_in_SI, DimSpeed.oneKnot_eq_mul_oneKilometerPerHour, DimSpeed.oneKilometerPerHour_eq_mul_oneKnot, DimSpeed.oneMeterPerSecond_eq_mul_oneMilePerHour)" + + - description: "Energy has dimension mass times length squared over time squared, with the joule, electronvolt, calorie and kilowatt hour." + done: true + location: "Physlib/Units/WithDim/Energy.lean (DimEnergy, DimEnergy.joule, DimEnergy.electronVolt, DimEnergy.calorie, DimEnergy.kilowattHour)" + + - description: "Pressure has dimension mass over length over time squared, with the pascal, millimetre of mercury, bar, standard atmosphere, torr and pound per square inch." + done: true + location: "Physlib/Units/WithDim/Pressure.lean (DimPressure, DimPressure.pascal, DimPressure.millimeterOfMercury, DimPressure.bar, DimPressure.standardAtmosphere, DimPressure.torr, DimPressure.psi)" + + - description: "Momentum has dimension mass times length over time and takes values in d spatial components, the three-momentum rather than the four-momentum." + done: true + location: "Physlib/Units/WithDim/Momentum.lean (Momentum)" + + - description: "The API shall contain the mass of a particle and the velocity of a particle in d spatial dimensions as named dimension-carrying quantities, in the manner of momentum, which Mass.lean and Velocity.lean announce in their module documentation but do not yet declare." + done: false + location: "N/A" + + - description: "The derivative of a dimensionally correct differentiable function is dimensionally correct, with the explicit rescaling of the derivative at a rescaled point." + done: true + location: "Physlib/Units/FDeriv.lean (fderiv_apply_scaleUnit, fderiv_isDimensionallyCorrect)" + + - description: "The equation giving the derivative in a fixed direction as a quantity of the dimension of the target divided by the dimension of the source is dimensionally correct." + done: true + location: "Physlib/Units/FDeriv.lean (fderiv_dimension_const_direction)" + + - description: "A measure on a type carrying a dimension is unit-dependent, and the integral of a function whose dimension is that of its values divided by the dimension of the measure has the dimension of the values." + done: true + location: "Physlib/Units/Integral.lean (scaleUnit_measure, integral_isDimensionallyCorrect)" + + - description: "A worked example converts a length of 400 metres to miles." + done: true + location: "Physlib/Units/Examples.lean (UnitExamples.meters400)" + + - description: "The relations E = m c^2 and F = m a are stated over dimension-tagged reals and shown to be dimensionally correct." + done: true + location: "Physlib/Units/Examples.lean (UnitExamples.EnergyMassWithDim, UnitExamples.energyMassWithDim_isDimensionallyCorrect, UnitExamples.NewtonsSecondWithDim, UnitExamples.newtonsSecondWithDim_isDimensionallyCorrect)" + + - description: "A speed as distance over time, an expression of mixed dimension in mass, temperature, current, length and time, and the cosine of an angular frequency times a time are each shown to be dimensionally correct." + done: true + location: "Physlib/Units/Examples.lean (UnitExamples.SpeedEq, UnitExamples.speedEq_isDimensionallyCorrect, UnitExamples.OddDimensions, UnitExamples.oddDimensions_isDimensionallyCorrect, UnitExamples.CosDim, UnitExamples.cosDim_isDimensionallyCorrect)" + + - description: "The relation E = m c is shown not to be dimensionally correct by exhibiting a change of unit that breaks it." + done: true + location: "Physlib/Units/Examples.lean (UnitExamples.EnergyMassWithDimNot, UnitExamples.energyMassWithDimNot_not_isDimensionallyCorrect)" + + - description: "The version of E = m c^2 written with the speed of light in an explicit unit system is proved in SI units and then transported to every unit system." + done: true + location: "Physlib/Units/Examples.lean (UnitExamples.EnergyMass, UnitExamples.energyMass_isDimensionallyCorrect, UnitExamples.example1_energyMass, UnitExamples.example2_energyMass)" + + - description: "The equality of a length with a speed times a time holds propositionally rather than definitionally, so the two tagged types are bridged by a cast, and the same comparison is repeated over a set of base dimensions with no physical unit system, namely bits and symbols." + done: true + location: "Physlib/Units/ParametricDimensionExamples.lean (ParametricDimensionExamples.Info, ParametricDimensionExamples.bitDim, ParametricDimensionExamples.symbolDim)" diff --git a/Physlib/Units/Basic.lean b/Physlib/Units/Basic.lean index 9d689fe679..bf7f4b72e4 100644 --- a/Physlib/Units/Basic.lean +++ b/Physlib/Units/Basic.lean @@ -50,8 +50,9 @@ Units within Physlib are implemented with the following convention: ## References Zulip chats discussing units: -- https://leanprover.zulipchat.com/#narrow/channel/479953-Physlib/topic/physical.20units -- https://leanprover.zulipchat.com/#narrow/channel/116395-maths/topic/Dimensional.20Analysis.20Revisited/with/530238303 + +* https://leanprover.zulipchat.com/#narrow/channel/479953-Physlib/topic/physical.20units. +* https://leanprover.zulipchat.com/#narrow/channel/116395-maths/topic/Dimensional.20Analysis.20Revisited/with/530238303. ## Note @@ -108,12 +109,10 @@ noncomputable def dimScale (u1 u2 : LTMCTUnitChoices) :Dimension LTMCTDimensionB map_one' := by simp map_mul' d1 d2 := by - simp only [Dimension.length_mul, Rat.cast_add, Dimension.time_mul, Dimension.mass_mul, - Dimension.charge_mul, Dimension.temperature_mul] - repeat rw [rpow_add] + simp only [Dimension.length_mul, Dimension.Exponent.coe_add, Rat.cast_add, Dimension.time_mul, + Dimension.mass_mul, Dimension.charge_mul, Dimension.temperature_mul] + repeat rw [NNReal.rpow_add (by simp)] ring - all_goals - simp lemma dimScale_apply (u1 u2 : LTMCTUnitChoices) (d : Dimension LTMCTDimensionBase) : dimScale u1 u2 d = @@ -144,11 +143,8 @@ lemma dimScale_transitive (u1 u2 u3 : LTMCTUnitChoices) (d : Dimension LTMCTDime (u2.temperature / u3.temperature) ^ (d.temperature : ℝ)) · ring repeat rw [← mul_rpow] - apply NNReal.eq - simp only [LengthUnit.div_eq_val, TimeUnit.div_eq_val, MassUnit.div_eq_val, ChargeUnit.div_eq_val, - TemperatureUnit.div_eq_val, NNReal.coe_mul, coe_rpow] - rw [toReal] - field_simp + rw [LengthUnit.div_mul_div, TimeUnit.div_mul_div, MassUnit.div_mul_div, + ChargeUnit.div_mul_div, TemperatureUnit.div_mul_div] @[simp] lemma dimScale_mul_symm (u1 u2 : LTMCTUnitChoices) (d : Dimension LTMCTDimensionBase) : @@ -322,10 +318,7 @@ instance {M : Type} [CarriesDimension M] : @[ext] lemma Dimensionful.ext {M : Type} [CarriesDimension M] (f1 f2 : Dimensionful M) - (h : f1.val = f2.val) : f1 = f2 := by - cases f1 - cases f2 - simp_all + (h : f1.val = f2.val) : f1 = f2 := Subtype.ext h instance {M : Type} [CarriesDimension M] : MulAction ℝ≥0 (Dimensionful M) where smul a f := ⟨fun u => a • f.1 u, fun u1 u2 => by diff --git a/Physlib/Units/Dimension.lean b/Physlib/Units/Dimension.lean index 202d091237..63e8f10643 100644 --- a/Physlib/Units/Dimension.lean +++ b/Physlib/Units/Dimension.lean @@ -7,6 +7,7 @@ module public import Mathlib.Analysis.Normed.Field.Lemmas public import Mathlib.Tactic.DeriveFintype +public import Physlib.Units.Exponent /-! # Dimension @@ -14,11 +15,12 @@ public import Mathlib.Tactic.DeriveFintype In this module we define the type `Dimension` which carries the dimension of a physical quantity. -A `Dimension B` is parameterised by a *basis* `B` of base dimensions: it assigns a -rational `exponent` to each base dimension `b : B`. The parameterisation is purely in -the dimensional *algebra*: `Dimension B` is a `CommGroup` for every `B` +A `Dimension B` is parameterised by a *basis* `B` of base dimensions equipped with a +`DimensionBasis` representation. Each representation is additively equivalent to assigning an +`Exponent` to every base dimension `b : B`. The parameterisation is purely in +the dimensional *algebra*: `Dimension B` is a `CommGroup` for every represented basis `B` (multiplication adds exponents, inversion negates them), so quantities can be typed by -dimensions over any basis. The commutative-group and `ℚ`-power structure, decidable +dimensions over any basis. The commutative-group, `Exponent`- and `ℚ`-power structures, decidable equality (`DecidableEq`), the base vectors `single b`, and the change-of-basis map `extend` are all generic in `B`. @@ -41,36 +43,73 @@ open NNReal -/ -/-- A dimension over a basis `B` of base dimensions: a rational `exponent` for each - base dimension `b : B`. PhysLib's default basis is `LTMCTDimensionBase`. -/ -structure Dimension (B : Type) where - /-- The exponent of each base dimension. -/ - exponent : B → ℚ +/-- A choice of exponent-tuple representation for a basis `B`. Native addition on `Exponents` +is used for dimension multiplication, while `exponentEquiv` provides the basis-generic API. -/ +class DimensionBasis (B : Type) where + /-- The native tuple of exponents for this basis. -/ + Exponents : Type + /-- The additive structure on native exponent tuples. -/ + [addCommGroup : AddCommGroup Exponents] + /-- Native exponent tuples are additively equivalent to exponent functions on the basis. -/ + exponentEquiv : Exponents ≃+ (B → Dimension.Exponent) + +attribute [instance_reducible, instance] DimensionBasis.addCommGroup + +namespace DimensionBasis + +/-- The function-backed exponent representation for a basis without a specialized tuple. -/ +@[instance_reducible] def pi (B : Type) : DimensionBasis B where + Exponents := B → Dimension.Exponent + addCommGroup := inferInstance + exponentEquiv := AddEquiv.refl _ + +end DimensionBasis + +/-- A dimension over a represented basis `B`. PhysLib's default basis is +`LTMCTDimensionBase`. -/ +structure Dimension (B : Type) [DimensionBasis B] where + /-- The dimension's native exponent tuple. -/ + exponents : DimensionBasis.Exponents B namespace Dimension -variable {B : Type} +variable {B : Type} [DimensionBasis B] + +/-- The exponent of a dimension at a base dimension. -/ +def exponent (d : Dimension B) : B → Exponent := + DimensionBasis.exponentEquiv d.exponents + +/-- Construct a dimension from an exponent function. -/ +def ofFunction (f : B → Exponent) : Dimension B := + ⟨DimensionBasis.exponentEquiv.symm f⟩ + +@[simp] +lemma ofFunction_exponent (f : B → Exponent) (b : B) : (ofFunction f).exponent b = f b := by + simp [ofFunction, exponent] @[ext] lemma ext {d1 d2 : Dimension B} (h : ∀ b, d1.exponent b = d2.exponent b) : d1 = d2 := by cases d1 cases d2 congr + apply DimensionBasis.exponentEquiv.injective funext b exact h b instance : Mul (Dimension B) where - mul d1 d2 := ⟨fun b => d1.exponent b + d2.exponent b⟩ + mul d1 d2 := ⟨d1.exponents + d2.exponents⟩ @[simp] lemma mul_exponent (d1 d2 : Dimension B) (b : B) : - (d1 * d2).exponent b = d1.exponent b + d2.exponent b := rfl + (d1 * d2).exponent b = d1.exponent b + d2.exponent b := by + exact congrFun (map_add DimensionBasis.exponentEquiv d1.exponents d2.exponents) b instance : One (Dimension B) where - one := ⟨fun _ => 0⟩ + one := ⟨0⟩ @[simp] -lemma one_exponent (b : B) : (1 : Dimension B).exponent b = 0 := rfl +lemma one_exponent (b : B) : (1 : Dimension B).exponent b = 0 := by + exact congrFun (map_zero DimensionBasis.exponentEquiv) b instance : CommGroup (Dimension B) where mul_assoc a b c := by @@ -82,16 +121,19 @@ instance : CommGroup (Dimension B) where mul_one a := by ext x simp - inv d := ⟨fun b => -d.exponent b⟩ + inv d := ⟨-d.exponents⟩ inv_mul_cancel a := by - ext x - simp + cases a with + | mk exponents => + change Dimension.mk (-exponents + exponents) = Dimension.mk 0 + rw [neg_add_cancel] mul_comm a b := by ext x simp [add_comm] @[simp] -lemma inv_exponent (d : Dimension B) (b : B) : d⁻¹.exponent b = -d.exponent b := rfl +lemma inv_exponent (d : Dimension B) (b : B) : d⁻¹.exponent b = -d.exponent b := by + exact congrFun (map_neg DimensionBasis.exponentEquiv d.exponents) b @[simp] lemma div_exponent (d1 d2 : Dimension B) (b : B) : @@ -106,11 +148,23 @@ lemma npow_exponent (d : Dimension B) (n : ℕ) (b : B) : | succ n ih => rw [pow_succ, mul_exponent, ih, succ_nsmul] instance : Pow (Dimension B) ℚ where - pow d q := ⟨fun b => d.exponent b * q⟩ + pow d q := ofFunction fun b => d.exponent b * Exponent.ofRat q @[simp] lemma qpow_exponent (d : Dimension B) (q : ℚ) (b : B) : - (d ^ q).exponent b = d.exponent b * q := rfl + (d ^ q).exponent b = d.exponent b * Exponent.ofRat q := by + exact ofFunction_exponent _ _ + +/-- Raising a dimension to an `Exponent` power. Unlike the `ℚ`-valued power, this preserves +reducible arithmetic for concrete fractional exponents. -/ +@[default_instance 10000] +instance : Pow (Dimension B) Exponent where + pow d c := ofFunction fun b => d.exponent b * c + +@[simp] +lemma epow_exponent (d : Dimension B) (c : Exponent) (b : B) : + (d ^ c).exponent b = d.exponent b * c := by + exact ofFunction_exponent _ _ /-- Decidable equality of dimensions over a finite basis `B`. -/ instance [Fintype B] : DecidableEq (Dimension B) := fun d1 d2 => @@ -119,26 +173,26 @@ instance [Fintype B] : DecidableEq (Dimension B) := fun d1 d2 => /-- The base-dimension vector for `b : B`: exponent `1` at `b`, `0` elsewhere. This is the generic analogue of the named generators `L𝓭`, `T𝓭`, … -/ -def single [DecidableEq B] (b : B) : Dimension B := ⟨Pi.single b 1⟩ +def single [DecidableEq B] (b : B) : Dimension B := ofFunction (Pi.single b 1) @[simp] lemma single_exponent [DecidableEq B] (b b' : B) : (single b).exponent b' = if b' = b then 1 else 0 := by - simp only [single, Pi.single_apply] + simp only [single, ofFunction_exponent, Pi.single_apply] /-- Change of basis along a map `f : B → B'` of base dimensions: reindex a dimension over `B` into one over `B'` by placing each exponent at its image. For an embedding `f` (injective) this preserves every exponent (`extend_exponent_apply`), so a dimension in one system re-expresses faithfully in an extending one. -/ -def extend {B' : Type} [Fintype B] [DecidableEq B'] (f : B → B') (d : Dimension B) : - Dimension B' := - ⟨fun b' => ∑ b, if f b = b' then d.exponent b else 0⟩ +def extend {B' : Type} [DimensionBasis B'] [Fintype B] [DecidableEq B'] + (f : B → B') (d : Dimension B) : Dimension B' := + ofFunction fun b' => ∑ b, if f b = b' then d.exponent b else 0 @[simp] -lemma extend_exponent_apply {B' : Type} [Fintype B] [DecidableEq B'] {f : B → B'} - (hf : Function.Injective f) (d : Dimension B) (b : B) : +lemma extend_exponent_apply {B' : Type} [DimensionBasis B'] [Fintype B] [DecidableEq B'] + {f : B → B'} (hf : Function.Injective f) (d : Dimension B) (b : B) : (extend f d).exponent (f b) = d.exponent b := by - simp only [extend] + simp only [extend, ofFunction_exponent] rw [Finset.sum_eq_single b (fun b'' _ hne => by simp [hf.ne hne]) (by simp)] simp @@ -163,13 +217,13 @@ that sends a base dimension to an inequivalent one is *not* expressible as eithe -/ /-- `extend f` packaged as a monoid homomorphism of dimensions. -/ -def extendHom {B' : Type} [Fintype B] [DecidableEq B'] (f : B → B') : +def extendHom {B' : Type} [DimensionBasis B'] [Fintype B] [DecidableEq B'] (f : B → B') : Dimension B →* Dimension B' where toFun := extend f map_one' := by ext b'; simp [extend] map_mul' d1 d2 := by ext b' - simp only [extend, mul_exponent] + simp only [extend, ofFunction_exponent, mul_exponent] rw [← Finset.sum_add_distrib] refine Finset.sum_congr rfl fun b _ => ?_ split_ifs <;> simp @@ -179,7 +233,7 @@ def extendHom {B' : Type} [Fintype B] [DecidableEq B'] (f : B → B') : inverses and rational powers); injectivity makes it a faithful inclusion of the basis `B` into `B'`. Cross-basis dimension injections are produced as `Embedding`s so that dimension-preservation holds by construction. -/ -structure Embedding (B B' : Type) where +structure Embedding (B B' : Type) [DimensionBasis B] [DimensionBasis B'] where /-- The underlying dimension-preserving homomorphism. -/ toHom : Dimension B →* Dimension B' /-- The homomorphism is injective (a faithful embedding). -/ @@ -189,7 +243,7 @@ structure Embedding (B B' : Type) where dimensions. As a `MonoidHom` it is truth-preserving, but it is lossy — it reduces a richer basis `B'` onto a coarser basis `B`, collapsing the base dimensions that `B` does not track. -/ -structure Projection (B' B : Type) where +structure Projection (B' B : Type) [DimensionBasis B'] [DimensionBasis B] where /-- The underlying dimension-preserving homomorphism. -/ toHom : Dimension B' →* Dimension B /-- The homomorphism is surjective (the reduction hits every dimension of `B`). -/ @@ -198,7 +252,8 @@ structure Projection (B' B : Type) where /-- An injective *basis* map `f : B → B'` induces a dimension embedding, via `extend`. This is the label-level case: it sends each base dimension of `B` to a base dimension of `B'`, so it is automatically dimension-preserving and faithful. -/ -def Embedding.ofBasis {B B' : Type} [Fintype B] [DecidableEq B'] +def Embedding.ofBasis {B B' : Type} [DimensionBasis B] [DimensionBasis B'] + [Fintype B] [DecidableEq B'] (f : B → B') (hf : Function.Injective f) : Embedding B B' where toHom := extendHom f inj := by diff --git a/Physlib/Units/Examples.lean b/Physlib/Units/Examples.lean index 702a3d13fb..4700e685e6 100644 --- a/Physlib/Units/Examples.lean +++ b/Physlib/Units/Examples.lean @@ -30,6 +30,7 @@ open Dimension CarriesDimension LTMCTUnitChoices UnitDependent HasDim /-- The length corresponding to 400 meters. -/ noncomputable def meters400 : Dimensionful (WithDim L𝓭 ℝ) := toDimensionful SI ⟨400⟩ +set_option backward.isDefEq.respectTransparency false in /-- Changing that length to miles. 400 meters is very almost a quarter of a mile. -/ example : meters400 {SI with length := LengthUnit.miles} = ⟨1/4 - 73/50292⟩ := by @@ -110,7 +111,6 @@ def EnergyMassWithDimNot (m : WithDim M𝓭 ℝ) (E : WithDim (M𝓭 * L𝓭 * L (c : WithDim (L𝓭 * T𝓭⁻¹) ℝ) : Prop := E.1 = m.1 * c.1 -set_option backward.isDefEq.respectTransparency false in lemma energyMassWithDimNot_not_isDimensionallyCorrect : ¬ IsDimensionallyCorrect EnergyMassWithDimNot := by simp only [isDimensionallyCorrect_fun_iff, not_forall, funext_iff, scaleUnit_apply_fun] diff --git a/Physlib/Units/Exponent.lean b/Physlib/Units/Exponent.lean new file mode 100644 index 0000000000..e4c03010af --- /dev/null +++ b/Physlib/Units/Exponent.lean @@ -0,0 +1,284 @@ +/- +Copyright (c) 2026 Raunak Chhatwal. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Raunak Chhatwal +-/ +module + +public import Mathlib.Algebra.Field.TransferInstance +public import Mathlib.Algebra.Field.Rat +public import Mathlib.Algebra.Order.Ring.InjSurj +public import Mathlib.Algebra.Order.Ring.Rat +/-! + +# Reducible rational arithmetic for dimension exponents + +This module defines `Exponent`, a wrapper around the rational numbers whose arithmetic is +reducible. This lets concrete arithmetic on dimension exponents hold by definitional equality. + +The corresponding rational operations are irreducible in Lean. Locally unsealing them does not +export their reducibility to downstream modules, while globally changing the reducibility of an +imported declaration requires `allowUnsafeReducibility`. The wrapper instead owns transparent +operations while remaining equivalent to `ℚ`. + +The reducibility guarantee applies to the custom addition, subtraction, multiplication, inversion, +and division below. Other operations supplied by the `Field` instance are transferred from `ℚ`. +In particular, rational scalar multiplication and negative integer powers may require propositional +reasoning rather than `rfl`. + +-/ + +@[expose] public section + +namespace Dimension + +/-! + +## A. Definition + +-/ + +/-- A rational dimension exponent with reducible arithmetic. -/ +structure Exponent where + /-- The rational number represented by the exponent. -/ + toRat : ℚ +deriving DecidableEq + +attribute [coe] Exponent.toRat + +instance : Repr Exponent where + reprPrec x := reprPrec x.toRat + +namespace Exponent + +/-- The equivalence between `Exponent` and the rational numbers. -/ +def equivRat : Exponent ≃ ℚ := + Equiv.mk Exponent.toRat Exponent.mk Eq.refl Eq.refl + +/-- Regard a rational number as a dimension exponent. -/ +def ofRat (q : ℚ) : Exponent := ⟨q⟩ + +@[simp] +lemma ofRat_toRat (q : ℚ) : (ofRat q).toRat = q := rfl + +/-- Fuel-bounded Euclidean algorithm used to make exponent normalization reducible. -/ +def gcdAux : Nat → Nat → Nat → Nat + | 0, _, n => n + | fuel + 1, m, n => if m = 0 then n else gcdAux fuel (n % m) m + +private lemma gcdAux_eq_nat_gcd (fuel m n : Nat) (m_lt_fuel : m < fuel) : + gcdAux fuel m n = Nat.gcd m n := by + induction fuel generalizing m n with + | zero => omega + | succ fuel ih => + rw [gcdAux, Nat.gcd_def] + split + · rfl + · apply ih; have := Nat.mod_lt n (Nat.zero_lt_of_ne_zero ‹m ≠ 0›); omega + +/-- Reducible greatest common divisor used when normalizing an exponent. -/ +def gcd (m n : Nat) : Nat := + gcdAux (m + 1) m n + +/-- The reducible exponent GCD agrees with `Nat.gcd`. -/ +lemma gcd_eq_nat_gcd (m n : Nat) : gcd m n = Nat.gcd m n := by + exact gcdAux_eq_nat_gcd (m + 1) m n (Nat.lt_add_one m) + +/-- Construct an exponent by normalizing a numerator and a nonzero denominator. -/ +def normalize (num : Int) (den : Nat) (den_ne_zero : den ≠ 0) : Exponent := + let g := gcd num.natAbs den + let g_eq : g = num.natAbs.gcd den := gcd_eq_nat_gcd num.natAbs den + ⟨Rat.maybeNormalize num den g + (Rat.normalize.dvd_num g_eq) + (Rat.normalize.dvd_den g_eq) + (Rat.normalize.den_nz den_ne_zero g_eq) + (Rat.normalize.reduced den_ne_zero g_eq)⟩ + +lemma normalize_toRat (num : Int) (den : Nat) (den_ne_zero : den ≠ 0) : + (normalize num den den_ne_zero).toRat = Rat.normalize num den den_ne_zero := by + unfold normalize Rat.normalize + simp only [gcd_eq_nat_gcd] + +/-- The normalized numerator of an exponent. -/ +@[reducible] def num (x : Exponent) : Int := + x.toRat.num + +/-- The normalized denominator of an exponent. -/ +@[reducible] def den (x : Exponent) : Nat := + x.toRat.den + +/-! + +## B. Arithmetic + +-/ + +/-- Reducible addition of dimension exponents. -/ +def add (a b : Exponent) : Exponent := + normalize (a.num * b.den + b.num * a.den) (a.den * b.den) + (Nat.mul_ne_zero a.toRat.den_nz b.toRat.den_nz) + +instance : Add Exponent := Add.mk add + +lemma add_equiv (a b : Exponent) : equivRat (add a b) = equivRat a + equivRat b := by + rw [Rat.add_def] + exact normalize_toRat _ _ _ + +/-- Reducible subtraction of dimension exponents. -/ +def sub (a b : Exponent) : Exponent := + add a ⟨-b.toRat⟩ + +instance : Sub Exponent := Sub.mk sub + +lemma sub_equiv (a b : Exponent) : equivRat (sub a b) = equivRat a - equivRat b := by + rw [sub, add_equiv] + simp [equivRat, sub_eq_add_neg] + +/-- Reducible multiplication of dimension exponents. -/ +def mul (a b : Exponent) : Exponent := + normalize (a.num * b.num) (a.den * b.den) + (Nat.mul_ne_zero a.toRat.den_nz b.toRat.den_nz) + +instance : Mul Exponent := Mul.mk mul + +lemma mul_equiv (a b : Exponent) : equivRat (mul a b) = equivRat a * equivRat b := by + rw [Rat.mul_def] + exact normalize_toRat _ _ _ + +/-- Reducible inversion of a dimension exponent, with `0⁻¹ = 0`. -/ +def inv (a : Exponent) : Exponent := + if ne_zero : a.toRat ≠ 0 then + have num_ne_zero : a.num ≠ 0 := ne_zero ∘ Rat.num_eq_zero.mp + ⟨{ num := a.num.sign * a.den + den := a.num.natAbs + den_nz := by exact Nat.ne_of_gt (Int.natAbs_pos.mpr num_ne_zero) + reduced := by simpa [Int.natAbs_mul, Int.natAbs_sign_of_ne_zero num_ne_zero] + using a.toRat.reduced.symm }⟩ + else a + +instance : Inv Exponent := Inv.mk inv + +lemma inv_equiv (a : Exponent) : equivRat (inv a) = (equivRat a)⁻¹ := by + by_cases ne_zero : a.toRat ≠ 0 + · apply Rat.ext <;> simp [inv, ne_zero, equivRat, Rat.num_inv, Rat.den_inv] + · push Not at ne_zero + apply Rat.ext <;> simp [inv, ne_zero, equivRat] + +/-- Reducible division of dimension exponents. -/ +def div (a b : Exponent) : Exponent := + mul a (inv b) + +instance : Div Exponent := Div.mk div + +lemma div_equiv (a b : Exponent) : equivRat (div a b) = equivRat a / equivRat b := by + rw [div, mul_equiv, inv_equiv, div_eq_mul_inv] + +/-! + +## C. Field structure + +-/ + +instance instField : Field Exponent := by + letI := equivRat.field + apply equivRat.injective.field + · rfl + · rfl + all_goals intros + case add => apply add_equiv + case sub => apply sub_equiv + case inv => apply inv_equiv + case mul => apply mul_equiv + case div => apply div_equiv + all_goals rfl + +/-- The ring equivalence between dimension exponents and rational numbers. -/ +def ringEquivRat : Exponent ≃+* ℚ where + toEquiv := equivRat + map_add' := add_equiv + map_mul' := mul_equiv + +/-- Regard a dimension exponent as a rational number. -/ +instance : Coe Exponent ℚ := ⟨Exponent.toRat⟩ + +@[simp, norm_cast] +lemma coe_inj {a b : Exponent} : (a : ℚ) = b ↔ a = b := + ringEquivRat.injective.eq_iff + +@[simp, norm_cast] +lemma coe_zero : ((0 : Exponent) : ℚ) = 0 := map_zero ringEquivRat + +@[simp, norm_cast] +lemma coe_one : ((1 : Exponent) : ℚ) = 1 := map_one ringEquivRat + +@[simp, norm_cast] +lemma coe_ofNat (n : ℕ) [n.AtLeastTwo] : ((ofNat(n) : Exponent) : ℚ) = ofNat(n) := + map_ofNat ringEquivRat n + +@[simp, norm_cast] +lemma coe_add (a b : Exponent) : ((a + b : Exponent) : ℚ) = a + b := + map_add ringEquivRat a b + +@[simp, norm_cast] +lemma coe_sub (a b : Exponent) : ((a - b : Exponent) : ℚ) = a - b := + map_sub ringEquivRat a b + +@[simp, norm_cast] +lemma coe_neg (a : Exponent) : ((-a : Exponent) : ℚ) = -a := + map_neg ringEquivRat a + +@[simp, norm_cast] +lemma coe_mul (a b : Exponent) : ((a * b : Exponent) : ℚ) = a * b := + map_mul ringEquivRat a b + +@[simp, norm_cast] +lemma coe_inv (a : Exponent) : ((a⁻¹ : Exponent) : ℚ) = (a : ℚ)⁻¹ := + inv_equiv a + +@[simp, norm_cast] +lemma coe_div (a b : Exponent) : ((a / b : Exponent) : ℚ) = (a : ℚ) / b := + div_equiv a b + +instance : LinearOrder Exponent := equivRat.linearOrder + +@[simp, norm_cast] +lemma coe_le_coe {a b : Exponent} : (a : ℚ) ≤ b ↔ a ≤ b := Iff.rfl + +@[simp, norm_cast] +lemma coe_lt_coe {a b : Exponent} : (a : ℚ) < b ↔ a < b := Iff.rfl + +instance : IsStrictOrderedRing Exponent := + Function.Injective.isStrictOrderedRing ringEquivRat + (map_zero ringEquivRat) (map_one ringEquivRat) (map_add ringEquivRat) (map_mul ringEquivRat) + coe_le_coe coe_lt_coe + +instance : CharZero Exponent where + cast_injective _ _ equality := Nat.cast_injective <| congrArg equivRat equality + +-- These regressions pin the field structure to the reducible operations above. +lemma add_eq_instField_add : add = instField.add := rfl +lemma sub_eq_instField_sub : sub = instField.sub := rfl +lemma inv_eq_instField_inv : inv = instField.inv := rfl +lemma mul_eq_instField_mul : mul = instField.mul := rfl +lemma div_eq_instField_div : div = instField.div := rfl + +/-! + +## D. Definitional equality tests + +-/ + +lemma tuple_arithmetic_defeq : + let Length : Exponent × Exponent := (1, 0) + let Time : Exponent × Exponent := (0, 1) + let Speed := Length - Time + Length = Time + Speed := rfl + +lemma rational_arithmetic_defeq : + ((2 / 3 + 5 / 7) * (11 / 13 - 1 / 2) : Exponent) = 87 / 182 := rfl + +lemma inverse_arithmetic_defeq : ((-3 / 4 : Exponent)⁻¹ + 5 / 6) = -1 / 2 := rfl + +end Dimension.Exponent + +end diff --git a/Physlib/Units/ISQBridge.lean b/Physlib/Units/ISQBridge.lean index 1f15d59265..c005cd31ff 100644 --- a/Physlib/Units/ISQBridge.lean +++ b/Physlib/Units/ISQBridge.lean @@ -42,14 +42,14 @@ namespace Dimension send PhysLib's charge generator to the derived ISQ charge `I · T` (the current exponent is the charge exponent, and the time exponent absorbs it). -/ def toISQFun (d : Dimension LTMCTDimensionBase) : Dimension ISQDimensionBase := - ⟨fun + ofFunction fun | .length => d.exponent .length | .mass => d.exponent .mass | .time => d.exponent .time + d.exponent .charge | .current => d.exponent .charge | .temperature => d.exponent .temperature | .amount => 0 - | .luminousIntensity => 0⟩ + | .luminousIntensity => 0 /-- The dimension-preserving embedding of PhysLib dimensions into the ISQ dimensions. -/ def toISQHom : Dimension LTMCTDimensionBase →* Dimension ISQDimensionBase where @@ -57,7 +57,7 @@ def toISQHom : Dimension LTMCTDimensionBase →* Dimension ISQDimensionBase wher map_one' := by ext b; cases b <;> simp [toISQFun] map_mul' d1 d2 := by ext b - cases b <;> simp only [toISQFun, mul_exponent] + cases b <;> simp only [toISQFun, ofFunction_exponent, mul_exponent] all_goals ring /-- `toISQHom` applied to a dimension is `toISQFun`. -/ @@ -67,12 +67,12 @@ lemma toISQHom_apply (d : Dimension LTMCTDimensionBase) : toISQHom d = toISQFun electric current as charge/time (the charge exponent is the current exponent, and the time exponent subtracts it), and drop amount of substance and luminous intensity. -/ def fromISQFun (d : Dimension ISQDimensionBase) : Dimension LTMCTDimensionBase := - ⟨fun + ofFunction fun | .length => d.exponent .length | .time => d.exponent .time - d.exponent .current | .mass => d.exponent .mass | .charge => d.exponent .current - | .temperature => d.exponent .temperature⟩ + | .temperature => d.exponent .temperature /-- The truth-preserving reduction of ISQ dimensions onto PhysLib's. -/ def fromISQHom : Dimension ISQDimensionBase →* Dimension LTMCTDimensionBase where @@ -80,7 +80,7 @@ def fromISQHom : Dimension ISQDimensionBase →* Dimension LTMCTDimensionBase wh map_one' := by ext b; cases b <;> simp [fromISQFun] map_mul' d1 d2 := by ext b - cases b <;> simp only [fromISQFun, mul_exponent] + cases b <;> simp only [fromISQFun, ofFunction_exponent, mul_exponent] all_goals ring /-- `fromISQHom` applied to a dimension is `fromISQFun`. -/ @@ -92,7 +92,7 @@ lemma fromISQHom_comp_toISQHom : fromISQHom.comp toISQHom = MonoidHom.id (Dimension LTMCTDimensionBase) := by refine MonoidHom.ext fun d => Dimension.ext fun b => ?_ cases b <;> simp only [MonoidHom.comp_apply, MonoidHom.id_apply, toISQHom_apply, - fromISQHom_apply, fromISQFun, toISQFun] + fromISQHom_apply, fromISQFun, toISQFun, ofFunction_exponent] all_goals ring /-- `toISQHom` is injective: PhysLib dimensions include faithfully into ISQ. -/ @@ -104,15 +104,15 @@ lemma toISQHom_injective : Function.Injective toISQHom := by simpa only [toISQHom_apply] using hb ext b cases b with - | length => simpa only [toISQFun] using key .length + | length => simpa only [toISQFun, ofFunction_exponent] using key .length | time => have ht := key .time have hc := key .current - simp only [toISQFun] at ht hc + simp only [toISQFun, ofFunction_exponent] at ht hc linarith - | mass => simpa only [toISQFun] using key .mass - | charge => simpa only [toISQFun] using key .current - | temperature => simpa only [toISQFun] using key .temperature + | mass => simpa only [toISQFun, ofFunction_exponent] using key .mass + | charge => simpa only [toISQFun, ofFunction_exponent] using key .current + | temperature => simpa only [toISQFun, ofFunction_exponent] using key .temperature /-- `fromISQHom` is surjective: every PhysLib dimension is the reduction of some ISQ dimension (namely its own embedding). -/ @@ -141,7 +141,6 @@ lemma isqToLTMCT_comp_ltmctToISQ : maps to the *derived* ISQ charge `I · T`. -/ lemma toISQHom_C𝓭 : toISQHom C𝓭 = ISQDimensionBase.charge := by ext b - cases b <;> simp [toISQHom_apply, toISQFun, C𝓭, ofLTMCTDimensionBase, - ISQDimensionBase.charge, single_exponent] + cases b <;> simp [toISQHom_apply, toISQFun, C𝓭, ISQDimensionBase.charge, single_exponent] end Dimension diff --git a/Physlib/Units/ISQDimensionBase.lean b/Physlib/Units/ISQDimensionBase.lean index 8b5782cbed..bc717ac951 100644 --- a/Physlib/Units/ISQDimensionBase.lean +++ b/Physlib/Units/ISQDimensionBase.lean @@ -27,10 +27,9 @@ PhysLib's default `LTMCTDimensionBase` in two ways: ## References -* ISO/IEC 80000-1:2009, *Quantities and units — Part 1: General*. -* JCGM 200:2012, *International vocabulary of metrology — Basic and general concepts - and associated terms (VIM, 3rd edition)*. - +* ISO/IEC 80000-1:2009, Quantities and units — Part 1: General. [ref: iso_80000_1_2009] +* JCGM 200:2012, International vocabulary of metrology — Basic and general concepts and associated + terms (VIM, 3rd edition). [ref: jcgm_200_2012] -/ @[expose] public section @@ -56,7 +55,13 @@ inductive ISQDimensionBase where | amount /-- The luminous-intensity base quantity. -/ | luminousIntensity -deriving DecidableEq, Fintype +deriving DecidableEq + +instance : Fintype ISQDimensionBase where + elems := {.length, .mass, .time, .current, .temperature, .amount, .luminousIntensity} + complete := fun x => by cases x <;> decide + +instance : DimensionBasis ISQDimensionBase := DimensionBasis.pi _ namespace ISQDimensionBase diff --git a/Physlib/Units/LTMCTDimensionBase.lean b/Physlib/Units/LTMCTDimensionBase.lean index fc297a07fe..d24a7262e1 100644 --- a/Physlib/Units/LTMCTDimensionBase.lean +++ b/Physlib/Units/LTMCTDimensionBase.lean @@ -42,7 +42,30 @@ inductive LTMCTDimensionBase where | charge /-- The temperature base dimension. -/ | temperature -deriving DecidableEq, Fintype +deriving DecidableEq + +namespace LTMCTDimensionBase + +instance : Fintype LTMCTDimensionBase where + elems := {.length, .time, .mass, .charge, .temperature} + complete := fun x => by cases x <;> decide + +open Dimension in +/-- The fixed five-component exponent tuple for PhysLib's default dimension basis. -/ +abbrev Exponents := Exponent × Exponent × Exponent × Exponent × Exponent + +instance : DimensionBasis LTMCTDimensionBase where + Exponents := Exponents + addCommGroup := inferInstance + exponentEquiv := + { toFun := fun ⟨l, t, m, c, temp⟩ => fun + | .length => l | .time => t | .mass => m | .charge => c | .temperature => temp + invFun f := ⟨f .length, f .time, f .mass, f .charge, f .temperature⟩ + left_inv e := by rcases e; rfl + right_inv f := by funext b; cases b <;> rfl + map_add' _ _ := by funext b; cases b <;> rfl } + +end LTMCTDimensionBase namespace Dimension @@ -56,44 +79,56 @@ the familiar `.length`, `.time`, `.mass`, `.charge`, `.temperature` API is avail -/ /-- The length exponent of a `LTMCTDimensionBase` dimension. -/ -def length (d : Dimension LTMCTDimensionBase) : ℚ := d.exponent .length +def length (d : Dimension LTMCTDimensionBase) : Exponent := d.exponents.1 /-- The time exponent of a `LTMCTDimensionBase` dimension. -/ -def time (d : Dimension LTMCTDimensionBase) : ℚ := d.exponent .time +def time (d : Dimension LTMCTDimensionBase) : Exponent := d.exponents.2.1 /-- The mass exponent of a `LTMCTDimensionBase` dimension. -/ -def mass (d : Dimension LTMCTDimensionBase) : ℚ := d.exponent .mass +def mass (d : Dimension LTMCTDimensionBase) : Exponent := d.exponents.2.2.1 /-- The charge exponent of a `LTMCTDimensionBase` dimension. -/ -def charge (d : Dimension LTMCTDimensionBase) : ℚ := d.exponent .charge +def charge (d : Dimension LTMCTDimensionBase) : Exponent := d.exponents.2.2.2.1 /-- The temperature exponent of a `LTMCTDimensionBase` dimension. -/ -def temperature (d : Dimension LTMCTDimensionBase) : ℚ := d.exponent .temperature +def temperature (d : Dimension LTMCTDimensionBase) : Exponent := d.exponents.2.2.2.2 + +@[simp] +lemma exponent_length (d : Dimension LTMCTDimensionBase) : d.exponent .length = d.length := rfl + +@[simp] +lemma exponent_time (d : Dimension LTMCTDimensionBase) : d.exponent .time = d.time := rfl + +@[simp] +lemma exponent_mass (d : Dimension LTMCTDimensionBase) : d.exponent .mass = d.mass := rfl + +@[simp] +lemma exponent_charge (d : Dimension LTMCTDimensionBase) : d.exponent .charge = d.charge := rfl + +@[simp] +lemma exponent_temperature (d : Dimension LTMCTDimensionBase) : + d.exponent .temperature = d.temperature := rfl /-- Build a `LTMCTDimensionBase` dimension from its five exponents, in the order `⟨length, time, mass, charge, temperature⟩`. -/ -def ofLTMCTDimensionBase (length time mass charge temperature : ℚ) : Dimension LTMCTDimensionBase := - ⟨fun - | .length => length - | .time => time - | .mass => mass - | .charge => charge - | .temperature => temperature⟩ +def ofLTMCTDimensionBase (length time mass charge temperature : Exponent) : + Dimension LTMCTDimensionBase := + ⟨(length, time, mass, charge, temperature)⟩ @[simp] -lemma ofLTMCTDimensionBase_length (l t m c θ : ℚ) : +lemma ofLTMCTDimensionBase_length (l t m c θ : Exponent) : (ofLTMCTDimensionBase l t m c θ).length = l := rfl @[simp] -lemma ofLTMCTDimensionBase_time (l t m c θ : ℚ) : +lemma ofLTMCTDimensionBase_time (l t m c θ : Exponent) : (ofLTMCTDimensionBase l t m c θ).time = t := rfl @[simp] -lemma ofLTMCTDimensionBase_mass (l t m c θ : ℚ) : +lemma ofLTMCTDimensionBase_mass (l t m c θ : Exponent) : (ofLTMCTDimensionBase l t m c θ).mass = m := rfl @[simp] -lemma ofLTMCTDimensionBase_charge (l t m c θ : ℚ) : +lemma ofLTMCTDimensionBase_charge (l t m c θ : Exponent) : (ofLTMCTDimensionBase l t m c θ).charge = c := rfl @[simp] -lemma ofLTMCTDimensionBase_temperature (l t m c θ : ℚ) : +lemma ofLTMCTDimensionBase_temperature (l t m c θ : Exponent) : (ofLTMCTDimensionBase l t m c θ).temperature = θ := rfl @[simp] @@ -145,49 +180,94 @@ lemma inv_charge (d : Dimension LTMCTDimensionBase) : d⁻¹.charge = -d.charge @[simp] lemma inv_temperature (d : Dimension LTMCTDimensionBase) : d⁻¹.temperature = -d.temperature := rfl +private lemma component_npow (component : Dimension LTMCTDimensionBase → Exponent) + (b : LTMCTDimensionBase) (h : ∀ d, d.exponent b = component d) + (d : Dimension LTMCTDimensionBase) (n : ℕ) : + component (d ^ n) = n • component d := by + calc + component (d ^ n) = (d ^ n).exponent b := (h _).symm + _ = n • d.exponent b := npow_exponent d n b + _ = n • component d := congrArg (n • ·) (h _) + +lemma component_epow (component : Dimension LTMCTDimensionBase → Exponent) + (b : LTMCTDimensionBase) (h : ∀ d, d.exponent b = component d) + (d : Dimension LTMCTDimensionBase) (c : Exponent) : + component (d ^ c) = component d * c := by + calc + component (d ^ c) = (d ^ c).exponent b := (h _).symm + _ = d.exponent b * c := epow_exponent d c b + _ = component d * c := congrArg (· * c) (h _) + @[simp] lemma div_length (d1 d2 : Dimension LTMCTDimensionBase) : - (d1 / d2).length = d1.length - d2.length := by - simp only [length, div_exponent] + (d1 / d2).length = d1.length - d2.length := rfl @[simp] -lemma div_time (d1 d2 : Dimension LTMCTDimensionBase) : (d1 / d2).time = d1.time - d2.time := by - simp only [time, div_exponent] +lemma div_time (d1 d2 : Dimension LTMCTDimensionBase) : (d1 / d2).time = d1.time - d2.time := rfl @[simp] -lemma div_mass (d1 d2 : Dimension LTMCTDimensionBase) : (d1 / d2).mass = d1.mass - d2.mass := by - simp only [mass, div_exponent] +lemma div_mass (d1 d2 : Dimension LTMCTDimensionBase) : (d1 / d2).mass = d1.mass - d2.mass := rfl @[simp] lemma div_charge (d1 d2 : Dimension LTMCTDimensionBase) : - (d1 / d2).charge = d1.charge - d2.charge := by - simp only [charge, div_exponent] + (d1 / d2).charge = d1.charge - d2.charge := rfl @[simp] lemma div_temperature (d1 d2 : Dimension LTMCTDimensionBase) : - (d1 / d2).temperature = d1.temperature - d2.temperature := by - simp only [temperature, div_exponent] + (d1 / d2).temperature = d1.temperature - d2.temperature := rfl @[simp] lemma npow_length (d : Dimension LTMCTDimensionBase) (n : ℕ) : (d ^ n).length = n • d.length := by - simp only [length, npow_exponent] + exact component_npow length .length exponent_length d n @[simp] lemma npow_time (d : Dimension LTMCTDimensionBase) (n : ℕ) : (d ^ n).time = n • d.time := by - simp only [time, npow_exponent] + exact component_npow time .time exponent_time d n @[simp] lemma npow_mass (d : Dimension LTMCTDimensionBase) (n : ℕ) : (d ^ n).mass = n • d.mass := by - simp only [mass, npow_exponent] + exact component_npow mass .mass exponent_mass d n @[simp] lemma npow_charge (d : Dimension LTMCTDimensionBase) (n : ℕ) : (d ^ n).charge = n • d.charge := by - simp only [charge, npow_exponent] + exact component_npow charge .charge exponent_charge d n @[simp] lemma npow_temperature (d : Dimension LTMCTDimensionBase) (n : ℕ) : (d ^ n).temperature = n • d.temperature := by - simp only [temperature, npow_exponent] + exact component_npow temperature .temperature exponent_temperature d n + +/-- The length component of an `Exponent` power. Since `Pow (Dimension B) Exponent` is the + default instance, an unascribed numeric exponent elaborates to this power rather than to + the `ℕ` one, so `npow_length` does not apply to it and this lemma is what `simp` needs. -/ +@[simp] +lemma epow_length (d : Dimension LTMCTDimensionBase) (c : Exponent) : + (d ^ c).length = d.length * c := by + exact component_epow length .length exponent_length d c + +/-- The time component of an `Exponent` power. -/ +@[simp] +lemma epow_time (d : Dimension LTMCTDimensionBase) (c : Exponent) : + (d ^ c).time = d.time * c := by + exact component_epow time .time exponent_time d c + +/-- The mass component of an `Exponent` power. -/ +@[simp] +lemma epow_mass (d : Dimension LTMCTDimensionBase) (c : Exponent) : + (d ^ c).mass = d.mass * c := by + exact component_epow mass .mass exponent_mass d c + +/-- The charge component of an `Exponent` power. -/ +@[simp] +lemma epow_charge (d : Dimension LTMCTDimensionBase) (c : Exponent) : + (d ^ c).charge = d.charge * c := by + exact component_epow charge .charge exponent_charge d c + +/-- The temperature component of an `Exponent` power. -/ +@[simp] +lemma epow_temperature (d : Dimension LTMCTDimensionBase) (c : Exponent) : + (d ^ c).temperature = d.temperature * c := by + exact component_epow temperature .temperature exponent_temperature d c /-- The dimension corresponding to length. -/ def L𝓭 : Dimension LTMCTDimensionBase := ofLTMCTDimensionBase 1 0 0 0 0 @@ -243,19 +323,14 @@ corresponding base dimension, exhibiting them as instances of the basis-generic -/ -lemma L𝓭_eq_single : L𝓭 = single .length := by - ext b; cases b <;> simp [L𝓭, ofLTMCTDimensionBase, single_exponent] +lemma L𝓭_eq_single : L𝓭 = single .length := rfl -lemma T𝓭_eq_single : T𝓭 = single .time := by - ext b; cases b <;> simp [T𝓭, ofLTMCTDimensionBase, single_exponent] +lemma T𝓭_eq_single : T𝓭 = single .time := rfl -lemma M𝓭_eq_single : M𝓭 = single .mass := by - ext b; cases b <;> simp [M𝓭, ofLTMCTDimensionBase, single_exponent] +lemma M𝓭_eq_single : M𝓭 = single .mass := rfl -lemma C𝓭_eq_single : C𝓭 = single .charge := by - ext b; cases b <;> simp [C𝓭, ofLTMCTDimensionBase, single_exponent] +lemma C𝓭_eq_single : C𝓭 = single .charge := rfl -lemma Θ𝓭_eq_single : Θ𝓭 = single .temperature := by - ext b; cases b <;> simp [Θ𝓭, ofLTMCTDimensionBase, single_exponent] +lemma Θ𝓭_eq_single : Θ𝓭 = single .temperature := rfl end Dimension diff --git a/Physlib/Units/ParametricDimensionExamples.lean b/Physlib/Units/ParametricDimensionExamples.lean index 049eb96cc7..a10701a526 100644 --- a/Physlib/Units/ParametricDimensionExamples.lean +++ b/Physlib/Units/ParametricDimensionExamples.lean @@ -17,28 +17,23 @@ illustrates two consequences. A recurring question is how to compare a quantity of dimension `length` with a product of a quantity of dimension `length / time` and a quantity of dimension -`time`. The two dimensions are *equal*, but this equality is a **group -cancellation law** on the rational exponents — it holds *propositionally*, never -*definitionally*: - -* `(L𝓭 / T𝓭) * T𝓭 = L𝓭` cannot be closed by `rfl`: cancellation is not a - reduction rule. -* nor by `decide`: the exponents are rational, so the kernel has nothing to - evaluate. - -Consequently `WithDim ((L𝓭 / T𝓭) * T𝓭) ℝ` and `WithDim L𝓭 ℝ` are genuinely -different types, and a bare `x = v * t` is a type error. The bridge is -`WithDim.cast`, whose default argument discharges the propositional dimension -equality automatically, so the comparison is a one-liner. This is not a -limitation of the representation: no representation of `Dimension` makes the -equality definitional, so a cast on a proven equality is the correct idiom. +`time`. In the fixed-tuple representation of `LTMCTDimensionBase`, reducible exponent +arithmetic makes this concrete cancellation a definitional equality: + +* `(L𝓭 / T𝓭) * T𝓭 = L𝓭` is closed by `rfl`. +* `WithDim ((L𝓭 / T𝓭) * T𝓭) ℝ` and `WithDim L𝓭 ℝ` are therefore definitionally + equal types. + +Consequently a bare `x = v * t` is well-typed for these concrete dimensions. For a +representation where the same cancellation holds only propositionally, `WithDim.cast` +bridges the two dimension-indexed types. ## A non-standard basis -Because `Dimension` is parametric, the same dimensional algebra and the same -`cast`-based comparison are available over *any* basis — not just the physical -`LTMCTDimensionBase`. The unit-scaling layer (`LTMCTUnitChoices`, `dimScale`) is not needed -for either the algebra or the comparison, so neither is referenced here. +Because `Dimension` is parametric, the same dimensional algebra and `cast`-based +comparison are available over any represented basis, not just the physical +`LTMCTDimensionBase`. The unit-scaling layer (`LTMCTUnitChoices`, `dimScale`) is not +needed for either the algebra or the comparison, so neither is referenced here. This module is illustrative and should not be imported by other modules. @@ -50,20 +45,29 @@ open Dimension namespace ParametricDimensionExamples -/-- The dimension equality `(length / time) · time = length` holds -propositionally, by cancellation of the rational exponents. -/ -example : (L𝓭 / T𝓭) * T𝓭 = L𝓭 := by ext; simp +/-- The concrete dimension equality `(length / time) · time = length` holds by +definitional equality. -/ +example : (L𝓭 / T𝓭) * T𝓭 = L𝓭 := rfl -/-- The dimensions are equal, but the two `WithDim` *types* are not -definitionally equal, so `WithDim.cast` bridges them. Its default argument proves -`(L𝓭 / T𝓭) * T𝓭 = L𝓭` with no manual proof. -/ -noncomputable example (v : WithDim (L𝓭 / T𝓭) ℝ) (t : WithDim T𝓭 ℝ) : WithDim L𝓭 ℝ := - (v * t).cast +/-- The two concrete `WithDim` types are definitionally equal, so multiplication has +the required result type without a cast. -/ +example (v : WithDim (L𝓭 / T𝓭) ℝ) (t : WithDim T𝓭 ℝ) : WithDim L𝓭 ℝ := + v * t -/-- The end-to-end comparison: a length equals a velocity times a time, once the -product is cast to the length dimension. -/ +/-- The end-to-end comparison: a length equals a velocity times a time directly. -/ example (x : WithDim L𝓭 ℝ) (v : WithDim (L𝓭 / T𝓭) ℝ) (t : WithDim T𝓭 ℝ) : Prop := - x = (v * t).cast + x = v * t + +/-- Two half-powers of length multiply definitionally to length. The unannotated exponent also +regresses the default away from natural-number division. -/ +example : (L𝓭 ^ (1 / 2)) * (L𝓭 ^ (1 / 2)) = L𝓭 := rfl + +/-- Reducible dimension powers also cancel for non-half fractional exponents. -/ +example : (L𝓭 ^ (2 / 3 : Exponent)) * (L𝓭 ^ (1 / 3 : Exponent)) = L𝓭 := rfl + +/-- Quantities carrying half-powers of length multiply directly to a length. -/ +example (a b : WithDim (L𝓭 ^ (1 / 2)) ℝ) : WithDim L𝓭 ℝ := + a * b /-! ## The same comparison over a non-standard basis @@ -79,11 +83,13 @@ inductive Info /-- The symbol base dimension. -/ | symbol +instance : DimensionBasis Info := DimensionBasis.pi _ + /-- The `bit` base dimension. -/ -def bitDim : Dimension Info := ⟨fun | .bit => 1 | .symbol => 0⟩ +def bitDim : Dimension Info := Dimension.ofFunction fun | .bit => 1 | .symbol => 0 /-- The `symbol` base dimension. -/ -def symbolDim : Dimension Info := ⟨fun | .bit => 0 | .symbol => 1⟩ +def symbolDim : Dimension Info := Dimension.ofFunction fun | .bit => 0 | .symbol => 1 /-- Cancellation works identically over the non-standard basis. -/ example : (bitDim / symbolDim) * symbolDim = bitDim := by ext; simp diff --git a/Physlib/Units/ParametricUnits.lean b/Physlib/Units/ParametricUnits.lean index 92337a5c1d..17ebf2cfc5 100644 --- a/Physlib/Units/ParametricUnits.lean +++ b/Physlib/Units/ParametricUnits.lean @@ -54,28 +54,30 @@ lemma ratio_ne_zero (u1 u2 : UnitScale B) (b : B) : u1.scale b / u2.scale b ≠ dimension `d` rescales by `∏ b, (u1 b / u2 b) ^ d.exponent b` when changing the unit choice from `u1` to `u2`. This is the basis-generic form of `LTMCTUnitChoices.dimScale`. -/ -noncomputable def dimScale [Fintype B] (u1 u2 : UnitScale B) : Dimension B →* ℝ≥0 where +noncomputable def dimScale [DimensionBasis B] [Fintype B] + (u1 u2 : UnitScale B) : Dimension B →* ℝ≥0 where toFun d := ∏ b, (u1.scale b / u2.scale b) ^ (d.exponent b : ℝ) map_one' := by simp map_mul' d1 d2 := by - simp only [Dimension.mul_exponent, Rat.cast_add] + simp only [Dimension.mul_exponent, Dimension.Exponent.coe_add, Rat.cast_add] rw [← Finset.prod_mul_distrib] exact Finset.prod_congr rfl fun b _ => NNReal.rpow_add (u1.ratio_ne_zero u2 b) _ _ @[simp] -lemma dimScale_self [Fintype B] (u : UnitScale B) (d : Dimension B) : +lemma dimScale_self [DimensionBasis B] [Fintype B] (u : UnitScale B) (d : Dimension B) : dimScale u u d = 1 := by simp only [dimScale, MonoidHom.coe_mk, OneHom.coe_mk] refine Finset.prod_eq_one fun b _ => ?_ rw [div_self (u.scale_pos b).ne', NNReal.one_rpow] @[simp] -lemma dimScale_one [Fintype B] (u1 u2 : UnitScale B) : +lemma dimScale_one [DimensionBasis B] [Fintype B] (u1 u2 : UnitScale B) : dimScale u1 u2 1 = 1 := map_one _ /-- The scaling is transitive (a cocycle in the unit choices). -/ -lemma dimScale_transitive [Fintype B] (u1 u2 u3 : UnitScale B) (d : Dimension B) : +lemma dimScale_transitive [DimensionBasis B] [Fintype B] + (u1 u2 u3 : UnitScale B) (d : Dimension B) : dimScale u1 u2 d * dimScale u2 u3 d = dimScale u1 u3 d := by simp only [dimScale, MonoidHom.coe_mk, OneHom.coe_mk, ← Finset.prod_mul_distrib] refine Finset.prod_congr rfl fun b _ => ?_ diff --git a/Physlib/Units/SIUnitChoices.lean b/Physlib/Units/SIUnitChoices.lean index 5b758b2703..703cf7ccb7 100644 --- a/Physlib/Units/SIUnitChoices.lean +++ b/Physlib/Units/SIUnitChoices.lean @@ -23,9 +23,9 @@ The ISQ base quantities are length, mass, time, electric current, thermodynamic temperature, amount of substance and luminous intensity. Four of the corresponding typed unit types already exist (`LengthUnit`, `MassUnit`, `TimeUnit`, `TemperatureUnit`); the remaining three — `CurrentUnit`, `AmountUnit`, `LuminousIntensityUnit` — are introduced -here. (They follow the `LengthUnit` convention of a positive-real magnitude; the full -division/scaling API can be filled in later and, following PhysLib's layout, they would -ultimately live under the relevant physics directories.) +here. They follow the `LengthUnit` convention of a positive-real magnitude and support +rescaling; the remaining unit-ratio relation API can be filled in later and, following +PhysLib's layout, they would ultimately live under the relevant physics directories. `SIUnitChoices := UnitSystem ISQDimensionBase` is then the typed SI unit choice, and `SIUnitChoices.SI` is the coherent SI choice (metre, kilogram, second, ampere, kelvin, @@ -69,9 +69,50 @@ noncomputable instance : HDiv CurrentUnit CurrentUnit ℝ≥0 where lemma div_eq_val (x y : CurrentUnit) : x / y = (⟨x.val / y.val, div_nonneg x.val_pos.le y.val_pos.le⟩ : ℝ≥0) := rfl +/-- Scale a unit of electric current by a positive real factor. -/ +def scale (r : ℝ) (x : CurrentUnit) (hr : 0 < r := by norm_num) : CurrentUnit := + ⟨r * x.val, mul_pos hr x.val_pos⟩ + +@[simp] +lemma scale_div_self (x : CurrentUnit) (r : ℝ) (hr : 0 < r) : + scale r x hr / x = (⟨r, le_of_lt hr⟩ : ℝ≥0) := by + simp [scale, div_eq_val] + rfl + +@[simp] +lemma self_div_scale (x : CurrentUnit) (r : ℝ) (hr : 0 < r) : + x / scale r x hr = + (⟨1 / r, _root_.div_nonneg (by simp) (le_of_lt hr)⟩ : ℝ≥0) := by + simp [scale, div_eq_val] + field_simp + +@[simp] +lemma scale_one (x : CurrentUnit) : scale 1 x = x := by + simp [scale] + +@[simp] +lemma scale_div_scale + (x1 x2 : CurrentUnit) {r1 r2 : ℝ} (hr1 : 0 < r1) (hr2 : 0 < r2) : + scale r1 x1 hr1 / scale r2 x2 hr2 = + (⟨r1, le_of_lt hr1⟩ / ⟨r2, le_of_lt hr2⟩) * (x1 / x2) := by + refine NNReal.eq ?_ + show r1 * x1.val / (r2 * x2.val) = r1 / r2 * (x1.val / x2.val) + rw [div_mul_div_comm] + +@[simp] +lemma scale_scale (x : CurrentUnit) (r1 r2 : ℝ) (hr1 : 0 < r1) (hr2 : 0 < r2) : + scale r1 (scale r2 x hr2) hr1 = + scale (r1 * r2) x (mul_pos hr1 hr2) := by + simp [scale] + ring + /-- The SI coherent unit of electric current, the ampere. -/ def amperes : CurrentUnit := ⟨1, by norm_num⟩ +/-- One milliampere, equal to `10⁻³` amperes. -/ +noncomputable def milliamperes : CurrentUnit := + scale ((1 / 10) ^ 3) amperes + end CurrentUnit /-- A unit of amount of substance — a choice of positive-real magnitude. The SI coherent @@ -97,6 +138,43 @@ noncomputable instance : HDiv AmountUnit AmountUnit ℝ≥0 where lemma div_eq_val (x y : AmountUnit) : x / y = (⟨x.val / y.val, div_nonneg x.val_pos.le y.val_pos.le⟩ : ℝ≥0) := rfl +/-- Scale a unit of amount of substance by a positive real factor. -/ +def scale (r : ℝ) (x : AmountUnit) (hr : 0 < r := by norm_num) : AmountUnit := + ⟨r * x.val, mul_pos hr x.val_pos⟩ + +@[simp] +lemma scale_div_self (x : AmountUnit) (r : ℝ) (hr : 0 < r) : + scale r x hr / x = (⟨r, le_of_lt hr⟩ : ℝ≥0) := by + simp [scale, div_eq_val] + rfl + +@[simp] +lemma self_div_scale (x : AmountUnit) (r : ℝ) (hr : 0 < r) : + x / scale r x hr = + (⟨1 / r, _root_.div_nonneg (by simp) (le_of_lt hr)⟩ : ℝ≥0) := by + simp [scale, div_eq_val] + field_simp + +@[simp] +lemma scale_one (x : AmountUnit) : scale 1 x = x := by + simp [scale] + +@[simp] +lemma scale_div_scale + (x1 x2 : AmountUnit) {r1 r2 : ℝ} (hr1 : 0 < r1) (hr2 : 0 < r2) : + scale r1 x1 hr1 / scale r2 x2 hr2 = + (⟨r1, le_of_lt hr1⟩ / ⟨r2, le_of_lt hr2⟩) * (x1 / x2) := by + refine NNReal.eq ?_ + show r1 * x1.val / (r2 * x2.val) = r1 / r2 * (x1.val / x2.val) + rw [div_mul_div_comm] + +@[simp] +lemma scale_scale (x : AmountUnit) (r1 r2 : ℝ) (hr1 : 0 < r1) (hr2 : 0 < r2) : + scale r1 (scale r2 x hr2) hr1 = + scale (r1 * r2) x (mul_pos hr1 hr2) := by + simp [scale] + ring + /-- The SI coherent unit of amount of substance, the mole. -/ def moles : AmountUnit := ⟨1, by norm_num⟩ @@ -125,6 +203,50 @@ noncomputable instance : HDiv LuminousIntensityUnit LuminousIntensityUnit ℝ≥ lemma div_eq_val (x y : LuminousIntensityUnit) : x / y = (⟨x.val / y.val, div_nonneg x.val_pos.le y.val_pos.le⟩ : ℝ≥0) := rfl +/-- Scale a unit of luminous intensity by a positive real factor. -/ +def scale + (r : ℝ) (x : LuminousIntensityUnit) (hr : 0 < r := by norm_num) : + LuminousIntensityUnit := + ⟨r * x.val, mul_pos hr x.val_pos⟩ + +@[simp] +lemma scale_div_self (x : LuminousIntensityUnit) (r : ℝ) (hr : 0 < r) : + scale r x hr / x = (⟨r, le_of_lt hr⟩ : ℝ≥0) := by + simp [scale, div_eq_val] + rfl + +@[simp] +lemma self_div_scale (x : LuminousIntensityUnit) (r : ℝ) (hr : 0 < r) : + x / scale r x hr = + (⟨1 / r, _root_.div_nonneg (by simp) (le_of_lt hr)⟩ : ℝ≥0) := by + simp [scale, div_eq_val] + field_simp + +@[simp] +lemma scale_one (x : LuminousIntensityUnit) : scale 1 x = x := by + simp [scale] + +@[simp] +lemma scale_div_scale + (x1 x2 : LuminousIntensityUnit) + {r1 r2 : ℝ} + (hr1 : 0 < r1) (hr2 : 0 < r2) : + scale r1 x1 hr1 / scale r2 x2 hr2 = + (⟨r1, le_of_lt hr1⟩ / ⟨r2, le_of_lt hr2⟩) * (x1 / x2) := by + refine NNReal.eq ?_ + show r1 * x1.val / (r2 * x2.val) = r1 / r2 * (x1.val / x2.val) + rw [div_mul_div_comm] + +@[simp] +lemma scale_scale + (x : LuminousIntensityUnit) + (r1 r2 : ℝ) + (hr1 : 0 < r1) (hr2 : 0 < r2) : + scale r1 (scale r2 x hr2) hr1 = + scale (r1 * r2) x (mul_pos hr1 hr2) := by + simp [scale] + ring + /-- The SI coherent unit of luminous intensity, the candela. -/ def candelas : LuminousIntensityUnit := ⟨1, by norm_num⟩ diff --git a/Physlib/Units/UnitDependent.lean b/Physlib/Units/UnitDependent.lean index b9cf9f98d2..e7befe7bfd 100644 --- a/Physlib/Units/UnitDependent.lean +++ b/Physlib/Units/UnitDependent.lean @@ -123,7 +123,7 @@ def LinearUnitDependent.scaleUnitLinear def LinearUnitDependent.scaleUnitLinearEquiv {M : Type} [AddCommMonoid M] [Module ℝ M] [LinearUnitDependent M] (u1 u2 : LTMCTUnitChoices) : M ≃ₗ[ℝ] M := - LinearEquiv.ofLinear (scaleUnitLinear u1 u2) (scaleUnitLinear u2 u1) + LinearEquiv.ofLinearMap (scaleUnitLinear u1 u2) (scaleUnitLinear u2 u1) (by ext u; simp [scaleUnitLinear]) (by ext u; simp [scaleUnitLinear]) @@ -213,14 +213,16 @@ lemma Dimensionful.of_scaleUnit {M : Type} [CarriesDimension M] {u1 u2 u : LTMCT noncomputable instance {M1 : Type} [CarriesDimension M1] : MulUnitDependent M1 where scaleUnit u1 u2 m := (toDimensionful u1 m).1 u2 scaleUnit_trans u1 u2 u3 m := by - simp [toDimensionful] + simp only [toDimensionful_apply_apply] rw [smul_smul, mul_comm, LTMCTUnitChoices.dimScale_transitive] scaleUnit_trans' u1 u2 u3 m := by - simp [toDimensionful, smul_smul, LTMCTUnitChoices.dimScale_transitive] + simp only [toDimensionful_apply_apply] + rw [smul_smul, LTMCTUnitChoices.dimScale_transitive] scaleUnit_id u m := by - simp [toDimensionful, LTMCTUnitChoices.dimScale_self] + simp only [toDimensionful_apply_apply] + rw [LTMCTUnitChoices.dimScale_self, one_smul] scaleUnit_mul u1 u2 r m := by - simp [toDimensionful] + simp only [toDimensionful_apply_apply] exact smul_comm (u1.dimScale u2 (dim M1)) r m lemma HasDim.scaleUnit_apply {M : Type} [CarriesDimension M] @@ -462,7 +464,8 @@ lemma DMul.hMul_scaleUnit {M1 M2 M3 : Type} [CarriesDimension M1] [CarriesDimens [DMul M1 M2 M3] (m1 : M1) (m2 : M2) (u1 u2 : LTMCTUnitChoices) : (scaleUnit u1 u2 m1) * (scaleUnit u1 u2 m2) = scaleUnit u1 u2 (m1 * m2) := by - simpa [scaleUnit, toDimensionful] using + simpa only [toDimensionful_apply_apply, LTMCTUnitChoices.dimScale_self, one_smul, + HasDim.scaleUnit_apply] using DMul.mul_dim (M3 := M3) (toDimensionful u1 m1) (toDimensionful u1 m2) u1 u2 /-! diff --git a/Physlib/Units/UnitSystem.lean b/Physlib/Units/UnitSystem.lean index b593bfd616..506d4fdb08 100644 --- a/Physlib/Units/UnitSystem.lean +++ b/Physlib/Units/UnitSystem.lean @@ -229,6 +229,7 @@ lemma dimScale_eq_toScale_dimScale (u1 u2 : LTMCTUnitChoices) (d : Dimension LTM rw [dimScale_apply, length_ratio, time_ratio, mass_ratio, charge_ratio, temperature_ratio, UnitScale.dimScale, MonoidHom.coe_mk, OneHom.coe_mk, prod_univ_LTMCTDimensionBase] simp only [Dimension.length, Dimension.time, Dimension.mass, Dimension.charge, - Dimension.temperature] + Dimension.temperature, Dimension.exponent_length, Dimension.exponent_time, + Dimension.exponent_mass, Dimension.exponent_charge, Dimension.exponent_temperature] end LTMCTUnitChoices diff --git a/Physlib/Units/WithDim/Area.lean b/Physlib/Units/WithDim/Area.lean index 34eb892928..0a8da77b92 100644 --- a/Physlib/Units/WithDim/Area.lean +++ b/Physlib/Units/WithDim/Area.lean @@ -66,6 +66,7 @@ noncomputable def acre : DimArea := toDimensionful ({SI with lemma squareMeter_in_SI : squareMeter.1 SI = ⟨1⟩ := by simp [squareMeter, toDimensionful_apply_apply] +set_option backward.isDefEq.respectTransparency false in @[simp] lemma squareFoot_in_SI : squareFoot.1 SI = ⟨0.09290304⟩ := by simp [squareFoot, dimScale, LengthUnit.feet, toDimensionful_apply_apply] @@ -73,6 +74,7 @@ lemma squareFoot_in_SI : squareFoot.1 SI = ⟨0.09290304⟩ := by simp [NNReal.coe_ofScientific] norm_num [toReal] +set_option backward.isDefEq.respectTransparency false in @[simp] lemma squareMile_in_SI : squareMile.1 SI = ⟨2589988.110336⟩ := by simp [squareMile, dimScale, LengthUnit.miles, toDimensionful_apply_apply] @@ -88,6 +90,7 @@ lemma are_in_SI : are.1 SI = ⟨100⟩ := by lemma hectare_in_SI : hectare.1 SI = ⟨10000⟩ := by simp [hectare, toDimensionful_apply_apply] +set_option backward.isDefEq.respectTransparency false in @[simp] lemma acre_in_SI : acre.1 SI = ⟨4046.8564224⟩ := by simp [acre, dimScale, LengthUnit.miles, toDimensionful_apply_apply] @@ -101,6 +104,7 @@ lemma acre_in_SI : acre.1 SI = ⟨4046.8564224⟩ := by -/ +set_option backward.isDefEq.respectTransparency false in /-- One acre is exactly `43560` square feet. -/ lemma acre_eq_mul_squareFeet : acre = (43560 : ℝ≥0) • squareFoot := by apply (toDimensionful SI).symm.injective diff --git a/Physlib/Units/WithDim/Basic.lean b/Physlib/Units/WithDim/Basic.lean index 3b06a9dca6..0b02c4ab3f 100644 --- a/Physlib/Units/WithDim/Basic.lean +++ b/Physlib/Units/WithDim/Basic.lean @@ -26,14 +26,15 @@ routes through `LTMCTUnitChoices.dimScale`, is provided for the standard basis open NNReal /-- The type `M` carrying an instance of a dimension `d`. -/ -structure WithDim {B : Type} (d : Dimension B) (M : Type) where +structure WithDim {B : Type} [DimensionBasis B] (d : Dimension B) (M : Type) where /-- The underlying value of `M`. -/ val : M namespace WithDim @[ext] -lemma ext {B : Type} {d : Dimension B} {M} (x1 x2 : WithDim d M) (h : x1.val = x2.val) : +lemma ext {B : Type} [DimensionBasis B] {d : Dimension B} {M} + (x1 x2 : WithDim d M) (h : x1.val = x2.val) : x1 = x2 := by cases x1 cases x2 @@ -50,50 +51,58 @@ lemma dim_apply (d : Dimension LTMCTDimensionBase) (M : Type) : ## Inherited instances -/ -instance {B : Type} (d : Dimension B) (M : Type) [Inhabited M] : Inhabited (WithDim d M) where +instance {B : Type} [DimensionBasis B] (d : Dimension B) (M : Type) [Inhabited M] : + Inhabited (WithDim d M) where default := ⟨default⟩ -instance {B : Type} (d : Dimension B) (M : Type) [Zero M] : Zero (WithDim d M) where +instance {B : Type} [DimensionBasis B] (d : Dimension B) (M : Type) [Zero M] : + Zero (WithDim d M) where zero := ⟨0⟩ @[simp] -lemma val_zero {B : Type} {d : Dimension B} {M : Type} [Zero M] : +lemma val_zero {B : Type} [DimensionBasis B] {d : Dimension B} {M : Type} [Zero M] : (0 : WithDim d M).val = 0 := rfl -instance {B : Type} (d : Dimension B) (M : Type) [Add M] : Add (WithDim d M) where +instance {B : Type} [DimensionBasis B] (d : Dimension B) (M : Type) [Add M] : + Add (WithDim d M) where add m1 m2 := ⟨m1.val + m2.val⟩ @[simp] -lemma val_add {B : Type} {d : Dimension B} {M : Type} [Add M] (m1 m2 : WithDim d M) : +lemma val_add {B : Type} [DimensionBasis B] {d : Dimension B} {M : Type} [Add M] + (m1 m2 : WithDim d M) : (m1 + m2).val = m1.val + m2.val := rfl -instance {B : Type} (d : Dimension B) (M : Type) [Neg M] : Neg (WithDim d M) where +instance {B : Type} [DimensionBasis B] (d : Dimension B) (M : Type) [Neg M] : + Neg (WithDim d M) where neg m := ⟨-m.val⟩ @[simp] -lemma val_neg {B : Type} {d : Dimension B} {M : Type} [Neg M] (m : WithDim d M) : +lemma val_neg {B : Type} [DimensionBasis B] {d : Dimension B} {M : Type} [Neg M] + (m : WithDim d M) : (-m).val = -m.val := rfl -instance {B : Type} (d : Dimension B) (M : Type) [Sub M] : Sub (WithDim d M) where +instance {B : Type} [DimensionBasis B] (d : Dimension B) (M : Type) [Sub M] : + Sub (WithDim d M) where sub m1 m2 := ⟨m1.val - m2.val⟩ @[simp] -lemma val_sub {B : Type} {d : Dimension B} {M : Type} [Sub M] (m1 m2 : WithDim d M) : +lemma val_sub {B : Type} [DimensionBasis B] {d : Dimension B} {M : Type} [Sub M] + (m1 m2 : WithDim d M) : (m1 - m2).val = m1.val - m2.val := rfl -instance {B : Type} (d : Dimension B) (M : Type) [AddSemigroup M] : +instance {B : Type} [DimensionBasis B] (d : Dimension B) (M : Type) [AddSemigroup M] : AddSemigroup (WithDim d M) where add_assoc m1 m2 m3 := by ext simp [add_assoc] -instance {B : Type} (d : Dimension B) (M : Type) [AddCommSemigroup M] : +instance {B : Type} [DimensionBasis B] (d : Dimension B) (M : Type) [AddCommSemigroup M] : AddCommSemigroup (WithDim d M) where add_comm m1 m2 := by ext simp [add_comm] -instance {B : Type} (d : Dimension B) (M : Type) [AddMonoid M] : +instance {B : Type} [DimensionBasis B] (d : Dimension B) (M : Type) [AddMonoid M] : AddMonoid (WithDim d M) where zero_add m := by ext @@ -103,13 +112,13 @@ instance {B : Type} (d : Dimension B) (M : Type) [AddMonoid M] : simp [add_zero] nsmul := nsmulRec -instance {B : Type} (d : Dimension B) (M : Type) [AddCommMonoid M] : +instance {B : Type} [DimensionBasis B] (d : Dimension B) (M : Type) [AddCommMonoid M] : AddCommMonoid (WithDim d M) where add_comm m1 m2 := by ext simp [add_comm] -instance {B : Type} (d : Dimension B) (M : Type) [AddGroup M] : +instance {B : Type} [DimensionBasis B] (d : Dimension B) (M : Type) [AddGroup M] : AddGroup (WithDim d M) where sub_eq_add_neg m1 m2 := by ext @@ -119,27 +128,31 @@ instance {B : Type} (d : Dimension B) (M : Type) [AddGroup M] : simp [neg_add_cancel] zsmul := zsmulRec -instance {B : Type} (d : Dimension B) (M : Type) [AddCommGroup M] : +instance {B : Type} [DimensionBasis B] (d : Dimension B) (M : Type) [AddCommGroup M] : AddCommGroup (WithDim d M) where add_comm m1 m2 := by ext simp [add_comm] -instance {B : Type} (d : Dimension B) (M : Type) [LE M] : LE (WithDim d M) where +instance {B : Type} [DimensionBasis B] (d : Dimension B) (M : Type) [LE M] : + LE (WithDim d M) where le m1 m2 := m1.val ≤ m2.val @[simp] -lemma le_def {B : Type} {d : Dimension B} {M : Type} [LE M] (m1 m2 : WithDim d M) : +lemma le_def {B : Type} [DimensionBasis B] {d : Dimension B} {M : Type} [LE M] + (m1 m2 : WithDim d M) : m1 ≤ m2 ↔ m1.val ≤ m2.val := Iff.rfl -instance {B : Type} (d : Dimension B) (M : Type) [LT M] : LT (WithDim d M) where +instance {B : Type} [DimensionBasis B] (d : Dimension B) (M : Type) [LT M] : + LT (WithDim d M) where lt m1 m2 := m1.val < m2.val @[simp] -lemma lt_def {B : Type} {d : Dimension B} {M : Type} [LT M] (m1 m2 : WithDim d M) : +lemma lt_def {B : Type} [DimensionBasis B] {d : Dimension B} {M : Type} [LT M] + (m1 m2 : WithDim d M) : m1 < m2 ↔ m1.val < m2.val := Iff.rfl -instance {B : Type} (d : Dimension B) (M : Type) [Preorder M] : +instance {B : Type} [DimensionBasis B] (d : Dimension B) (M : Type) [Preorder M] : Preorder (WithDim d M) where le_refl m := by exact le_refl m.val @@ -150,13 +163,13 @@ instance {B : Type} (d : Dimension B) (M : Type) [Preorder M] : change m1.val < m2.val ↔ m1.val ≤ m2.val ∧ ¬ m2.val ≤ m1.val exact lt_iff_le_not_ge -instance {B : Type} (d : Dimension B) (M : Type) [PartialOrder M] : +instance {B : Type} [DimensionBasis B] (d : Dimension B) (M : Type) [PartialOrder M] : PartialOrder (WithDim d M) where le_antisymm m1 m2 h12 h21 := by ext exact le_antisymm h12 h21 -instance {B : Type} (d : Dimension B) (M : Type) [MulAction ℝ≥0 M] : +instance {B : Type} [DimensionBasis B] (d : Dimension B) (M : Type) [MulAction ℝ≥0 M] : MulAction ℝ≥0 (WithDim d M) where smul a m := ⟨a • m.val⟩ one_smul m := ext _ _ (one_smul ℝ≥0 m.val) @@ -165,15 +178,15 @@ instance {B : Type} (d : Dimension B) (M : Type) [MulAction ℝ≥0 M] : exact mul_smul a b m.val @[simp] -lemma smul_val {B : Type} {d : Dimension B} {M : Type} [MulAction ℝ≥0 M] +lemma smul_val {B : Type} [DimensionBasis B] {d : Dimension B} {M : Type} [MulAction ℝ≥0 M] (a : ℝ≥0) (m : WithDim d M) : (a • m).val = a • m.val := rfl -instance {B : Type} {d1 d2 : Dimension B} : +instance {B : Type} [DimensionBasis B] {d1 d2 : Dimension B} : HMul (WithDim d1 ℝ) (WithDim d2 ℝ) (WithDim (d1 * d2) ℝ) where hMul m1 m2 := ⟨m1.val * m2.val⟩ -lemma withDim_hMul_val {B : Type} {d1 d2 : Dimension B} +lemma withDim_hMul_val {B : Type} [DimensionBasis B] {d1 d2 : Dimension B} (m1 : WithDim d1 ℝ) (m2 : WithDim d2 ℝ) : (m1 * m2).val = m1.val * m2.val := rfl @@ -192,13 +205,14 @@ instance {d1 d2 : Dimension LTMCTDimensionBase} : open UnitDependent @[simp] -lemma val_mul_eq_mul {B : Type} {d1 d2 : Dimension B} +lemma val_mul_eq_mul {B : Type} [DimensionBasis B] {d1 d2 : Dimension B} (m1 : WithDim d1 ℝ) (m2 : WithDim d2 ℝ) : m1.val * m2.val = (m1 * m2).val := by simp only [withDim_hMul_val] @[simp] -lemma val_pow_two_eq_mul {B : Type} {d1 : Dimension B} (m1 : WithDim d1 ℝ) : +lemma val_pow_two_eq_mul {B : Type} [DimensionBasis B] {d1 : Dimension B} + (m1 : WithDim d1 ℝ) : m1.val ^ 2 = (m1 * m1).val := by rw [sq] rfl @@ -229,12 +243,13 @@ lemma scaleUnit_val {d : Dimension LTMCTDimensionBase} (M : Type) [MulAction ℝ -/ -noncomputable instance {B : Type} (d1 d2 : Dimension B) : +noncomputable instance {B : Type} [DimensionBasis B] (d1 d2 : Dimension B) : HDiv (WithDim d1 ℝ) (WithDim d2 ℝ) (WithDim (d1 * d2⁻¹) ℝ) where hDiv m1 m2 := ⟨m1.val / m2.val⟩ @[simp] -lemma val_div_val {B : Type} {d1 d2 : Dimension B} (m1 : WithDim d1 ℝ) (m2 : WithDim d2 ℝ) : +lemma val_div_val {B : Type} [DimensionBasis B] {d1 d2 : Dimension B} + (m1 : WithDim d1 ℝ) (m2 : WithDim d2 ℝ) : (m1.val / m2.val) = (m1 / m2).val := rfl @[simp] @@ -267,11 +282,11 @@ lemma scaleUnit_dim_eq_zero {d : Dimension LTMCTDimensionBase} (m : WithDim d set_option linter.unusedVariables false in /-- The casting from `WithDim d M` to `WithDim d2 M` when `d = d2`. -/ @[nolint unusedArguments] -def cast {B : Type} {d d2 : Dimension B} {M : Type} (m : WithDim d M) +def cast {B : Type} [DimensionBasis B] {d d2 : Dimension B} {M : Type} (m : WithDim d M) (h : d = d2 := by ext <;> {simp; try ring}) : WithDim d2 M := ⟨m.val⟩ @[simp] -lemma cast_refl {B : Type} {d : Dimension B} {M : Type} (m : WithDim d M) : +lemma cast_refl {B : Type} [DimensionBasis B] {d : Dimension B} {M : Type} (m : WithDim d M) : cast m rfl = m := rfl @[simp] diff --git a/Physlib/Units/WithDim/Speed.lean b/Physlib/Units/WithDim/Speed.lean index 4e174a6d69..98672efcb4 100644 --- a/Physlib/Units/WithDim/Speed.lean +++ b/Physlib/Units/WithDim/Speed.lean @@ -63,6 +63,7 @@ noncomputable def speedOfLight : Dimensionful (WithDim (L𝓭 * T𝓭⁻¹) ℝ) lemma oneMeterPerSecond_in_SI : oneMeterPerSecond SI = ⟨1⟩ := by simp [oneMeterPerSecond, toDimensionful_apply_apply] +set_option backward.isDefEq.respectTransparency false in @[simp] lemma oneMilePerHour_in_SI : oneMilePerHour SI = ⟨0.44704⟩ := by simp [oneMilePerHour, dimScale, LengthUnit.miles, TimeUnit.hours, toDimensionful_apply_apply] @@ -70,6 +71,7 @@ lemma oneMilePerHour_in_SI : oneMilePerHour SI = ⟨0.44704⟩ := by simp [NNReal.coe_ofScientific] norm_num [toReal] +set_option backward.isDefEq.respectTransparency false in @[simp] lemma oneKilometerPerHour_in_SI : oneKilometerPerHour SI = ⟨5/18⟩ := by @@ -80,6 +82,7 @@ lemma oneKilometerPerHour_in_SI : NNReal.coe_ofNat] norm_num [toReal] +set_option backward.isDefEq.respectTransparency false in @[simp] lemma oneKnot_in_SI : oneKnot SI = ⟨463/900⟩ := by simp [oneKnot, dimScale, LengthUnit.nauticalMiles, TimeUnit.hours, toDimensionful_apply_apply] @@ -98,18 +101,21 @@ lemma speedOfLight_in_SI : speedOfLight SI = ⟨299792458⟩ := by -/ +set_option backward.isDefEq.respectTransparency false in lemma oneKnot_eq_mul_oneKilometerPerHour : oneKnot = (1.852 : ℝ≥0) • oneKilometerPerHour := by apply (toDimensionful SI).symm.injective ext norm_num [toDimensionful] +set_option backward.isDefEq.respectTransparency false in lemma oneKilometerPerHour_eq_mul_oneKnot: oneKilometerPerHour = (250/463 : ℝ≥0) • oneKnot := by apply (toDimensionful SI).symm.injective ext norm_num [toDimensionful] +set_option backward.isDefEq.respectTransparency false in lemma oneMeterPerSecond_eq_mul_oneMilePerHour : oneMeterPerSecond = (3125/1397 : ℝ≥0) • oneMilePerHour := by apply (toDimensionful SI).symm.injective diff --git a/PhyslibAlpha.lean b/PhyslibAlpha.lean index e222e54188..cbef6954a7 100644 --- a/PhyslibAlpha.lean +++ b/PhyslibAlpha.lean @@ -27,6 +27,14 @@ public import PhyslibAlpha.SpaceAndTime.Space.Surfaces.SphericalCylinder public import PhyslibAlpha.SpaceAndTime.Space.Surfaces.SolidCylinder public import PhyslibAlpha.SpaceAndTime.Space.Surfaces.SolidSphere public import PhyslibAlpha.SpaceAndTime.Space.Surfaces.SphericalShell +public import PhyslibAlpha.ClassicalMechanics.NortonDome.Basic +public import PhyslibAlpha.ClassicalMechanics.NortonDome.Determinism +public import PhyslibAlpha.ClassicalMechanics.NortonDome.NewtonianSystem +public import PhyslibAlpha.ClassicalMechanics.NortonDome.PeanoExistence +public import PhyslibAlpha.ClassicalMechanics.NortonDome.PhysicalSpace +public import PhyslibAlpha.ClassicalMechanics.NortonDome.PosPartPow +public import PhyslibAlpha.ClassicalMechanics.NortonDome.Solution +public import PhyslibAlpha.ClassicalMechanics.NortonDome.Sqrt public import PhyslibAlpha.QuantumMechanics.QuantumHarmonicOscillator public import PhyslibAlpha.QuantumMechanics.HarmonicOscillator.Basic public import PhyslibAlpha.QuantumMechanics.HarmonicOscillator.LadderOperators @@ -47,3 +55,159 @@ public import PhyslibAlpha.Particles.BeyondTheStandardModel.TwoHDM.Invariants public import PhyslibAlpha.Particles.BeyondTheStandardModel.TwoHDM.Module public import PhyslibAlpha.Particles.BeyondTheStandardModel.TwoHDM.OrbitRepresentative public import PhyslibAlpha.Particles.BeyondTheStandardModel.TwoHDM.SwapDoublet +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Basic +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Composite +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Norm +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.MonotoneComplete +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Operation +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Symmetry +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Channel.Basic +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Channel.MeasureAndPrepare +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Channel.Normal +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Channel.Weight +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Effect.Basic +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Effect.EffectValuedMeasure +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Effect.BoundedIntegral +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Effect.Integral +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.Basic +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.Convex +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.Discrimination +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.Norm +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.Pure +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.Separation +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.WeightEquivalence +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.NormalEquivalence +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Weight.Basic +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Weight.Continuous +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Weight.Extension +public import PhyslibAlpha.AlgebraicFramework.StarAlgebra.Jordan +public import PhyslibAlpha.AlgebraicFramework.StarAlgebra.Lie +public import PhyslibAlpha.AlgebraicFramework.StarAlgebra.Observable +public import PhyslibAlpha.AlgebraicFramework.StarAlgebra.Restrict +public import PhyslibAlpha.AlgebraicFramework.StarAlgebra.SelfAdjoint +public import PhyslibAlpha.AlgebraicFramework.StarAlgebra.Statistics +public import PhyslibAlpha.AlgebraicFramework.StarAlgebra.Traciality +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.Automorphism +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.Channel +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.ConjugationSymmetry +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.GNS +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.JordanDecomposition +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.OrderUnit +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.Projection +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.SharpEffect +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.SpectralMeasure +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.Stinespring.Kernel +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.Stinespring.Dilation +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.Uncertainty +public import PhyslibAlpha.AlgebraicFramework.WStarAlgebra.Basic +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Dynamics.Automorphism +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Dynamics.Hamiltonian +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Trace +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.TraceClass.Basic +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.TraceClass.HilbertSchmidt +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.TraceClass.Polar +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.TraceClass.GeneralIdeal +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.TraceClass.GeneralProduct +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.TraceClass.IdealNorm +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.TraceClass.Banach +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Cayley.Basic +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Cayley.Measure +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Cayley.Certificate +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Cayley.Inverse +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Basic +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.ScalarMeasure +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Conjugation +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.BoundedIntegral +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.BoundedIntegralAlgebra +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.StoneUnitaryGroup +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.WeakIntegral +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.RealAnalytic +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.AnalyticVector.Basic +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.AnalyticVector.Local +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.AnalyticVector.Nelson +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Existence.CandidateGenerator +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Existence.GeneratorInvariance +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Existence.GenericGardingKernel +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Existence.GardingVectors +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Existence.GaussianKernelGrowth +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Existence.IteratedKernelGrowth +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Existence.GardingVectorWitness +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Existence.StoneGenerator +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Existence.StoneReconstruction +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.SelfAdjointSpectralTheorem +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.SpectralIntegral.Construction +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.SpectralIntegral.SpecTheorem +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.UnitaryInfra.SesquilinearForm +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.UnitaryInfra.SpectralMeasure +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.CayleySpectralData.Construction +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.CayleySpectralData.SpecTheorem +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.BoundedSelfAdjointData +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.SpectralPointMass +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Stone +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Flow.Stone +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Flow.StoneAPI +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Flow.StoneInvariance +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.State.Density +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.State.Vector +public import PhyslibAlpha.AlgebraicFramework.Measurement.Basic +public import PhyslibAlpha.AlgebraicFramework.Measurement.ClassicalSystem +public import PhyslibAlpha.AlgebraicFramework.Measurement.Compatibility +public import PhyslibAlpha.AlgebraicFramework.Measurement.FiniteOutcome +public import PhyslibAlpha.AlgebraicFramework.Measurement.Instrument +public import PhyslibAlpha.AlgebraicFramework.Measurement.MeasurableOutcome +public import PhyslibAlpha.AlgebraicFramework.Measurement.BoundedScalarization +public import PhyslibAlpha.AlgebraicFramework.Measurement.Postprocessing +public import PhyslibAlpha.AlgebraicFramework.Measurement.ProbabilityLaw +public import PhyslibAlpha.AlgebraicFramework.Representation.PVM +public import PhyslibAlpha.AlgebraicFramework.Representation.Covariance.Basic +public import PhyslibAlpha.AlgebraicFramework.Representation.Covariance.Finite +public import PhyslibAlpha.AlgebraicFramework.Representation.Schur +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Basic +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Hom +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.FreeJordanTwo +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Operator +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Examples.SpinFactor +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Observable +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.ProjectionResolution +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Conditioning +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Covariance +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Compatibility +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.JordanCompatibility +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.Basic +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.Jordan +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Power.Associative +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Power.Quadratic +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Quadratic.Fundamental +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Quadratic.Order +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Quadratic.Operational +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.StructureAlgebra +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.FiniteRank +public import PhyslibAlpha.AlgebraicFramework.Algebra.Alternative +public import PhyslibAlpha.AlgebraicFramework.Algebra.NuclearInvolution +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Quadratic.Projection +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Power.GeneratedByOne +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Power.Generated +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.FreeSpecialTwo +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Power.Ring +public import PhyslibAlpha.AlgebraicFramework.Algebra.Derivation +public import PhyslibAlpha.AlgebraicFramework.Algebra.Statistics +public import PhyslibAlpha.AlgebraicFramework.Dynamics.OneParameterGroup +public import PhyslibAlpha.AlgebraicFramework.Dynamics.Generator +public import PhyslibAlpha.AlgebraicFramework.Dynamics.GeneratorIsDerivation +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.Dynamics +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.GeneratedByOne.Closed +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.GeneratedByOne.Inherited +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.GeneratedByOne.Spectrum +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.GeneratedByOne.ContinuousFunctionalCalculus +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.GeneratedByOne.SquareRootUniqueness +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.GeneratedByOne.Effect +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Lueders +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.GeneratedByOne.Uniform +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.GeneratedByOne.PositiveInvertibility +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.Order +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JBW.Basic +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JBW.ProjectionResolution +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.JordanStatistics +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.JordanPositivity +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.JordanCFC +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.JordanSpecial diff --git a/PhyslibAlpha/AlgebraicFramework/Algebra/Alternative.lean b/PhyslibAlpha/AlgebraicFramework/Algebra/Alternative.lean new file mode 100644 index 0000000000..a1cf6bd1be --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/Algebra/Alternative.lean @@ -0,0 +1,159 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Mathlib.Algebra.Ring.Defs +public import Mathlib.Tactic.Abel +public import Mathlib.Tactic.LinearCombination + +/-! +# Alternative algebras + +The coordinate algebra of the exceptional Albert Jordan algebra is octonionic: alternative, not +associative. This file isolates the general associator calculus needed for that eventual model. +It is independent of Jordan order, norms, CFC, and JBW normality. +-/ + +@[expose] public section + +/-- An alternative multiplication has associative repeated factors on either side. -/ +class IsAlternative (A : Type*) [Mul A] : Prop where + /-- Left alternativity. -/ + mul_alternative_left : ∀ x y : A, x * (x * y) = (x * x) * y + /-- Right alternativity. -/ + mul_alternative_right : ∀ x y : A, (y * x) * x = y * (x * x) + +/-- Associative algebras are alternative. -/ +instance (priority := 100) {A : Type*} [Semigroup A] : IsAlternative A where + mul_alternative_left x y := (mul_assoc x x y).symm + mul_alternative_right x y := mul_assoc y x x + +namespace IsAlternative + +variable {A : Type*} [NonUnitalNonAssocRing A] + +/-- The failure of associativity. -/ +def associator (x y z : A) : A := (x * y) * z - x * (y * z) + +theorem associator_add_left (x y z w : A) : + associator (x + y) z w = associator x z w + associator y z w := by + unfold associator + simp only [add_mul] + abel + +theorem associator_add_mid (x y z w : A) : + associator x (y + z) w = associator x y w + associator x z w := by + unfold associator + simp only [add_mul, mul_add] + abel + +theorem associator_add_right (x y z w : A) : + associator x y (z + w) = associator x y z + associator x y w := by + unfold associator + simp only [mul_add] + abel + +/-- Teichmüller's identity holds before alternativity is assumed. -/ +theorem teichmuller (x y z w : A) : + associator (x * y) z w - associator x (y * z) w + associator x y (z * w) = + associator x y z * w + x * associator y z w := by + unfold associator + simp only [sub_mul, mul_sub] + abel + +variable [IsAlternative A] + +theorem associator_self_left (x y : A) : associator x x y = 0 := by + unfold associator + rw [mul_alternative_left] + abel + +theorem associator_right_self (x y : A) : associator y x x = 0 := by + unfold associator + rw [mul_alternative_right] + abel + +/-- The associator is skew under an adjacent swap. -/ +theorem associator_swap_first (x y z : A) : associator x y z = -associator y x z := by + have h : associator (x + y) (x + y) z = 0 := associator_self_left (x + y) z + rw [associator_add_left, associator_add_mid, associator_add_mid, + associator_self_left x z, associator_self_left y z] at h + have h' : associator x y z + associator y x z = 0 := by + abel_nf + rwa [zero_add, add_zero] at h + exact eq_neg_iff_add_eq_zero.mpr h' + +theorem associator_swap_last (x y z : A) : associator x y z = -associator x z y := by + have h : associator x (y + z) (y + z) = 0 := associator_right_self (y + z) x + rw [associator_add_mid, associator_add_right, associator_add_right, + associator_right_self y x, associator_right_self z x] at h + have h' : associator x y z + associator x z y = 0 := by + rwa [add_zero, zero_add] at h + rw [add_comm] at h' + exact (neg_eq_iff_add_eq_zero.mpr h').symm + +theorem associator_cyclic (x y z : A) : associator x y z = associator y z x := by + rw [associator_swap_first x y z, associator_swap_last y x z, neg_neg] + +theorem associator_outer_self (x y : A) : associator x y x = 0 := by + rw [associator_swap_last x y x, associator_self_left, neg_zero] + +/-- The flexible law is forced by alternativity. -/ +theorem mul_flexible (x y : A) : x * (y * x) = (x * y) * x := by + have h := associator_outer_self x y + unfold associator at h + exact sub_eq_zero.mp h |>.symm + +/-- The left Moufang identity. -/ +theorem moufang_left (x y z : A) : (x * (z * x)) * y = x * (z * (x * y)) := by + rw [← sub_eq_zero] + have hstart : (x * (z * x)) * y - x * (z * (x * y)) = + associator (x * z) x y + associator x z (x * y) := by + rw [mul_flexible x z] + unfold associator + abel + rw [hstart, associator_swap_first (x * z) x y, associator_swap_last x z (x * y)] + have e1 : associator x (x * z) y = (x * x * z) * y - x * ((x * z) * y) := by + unfold associator + rw [mul_alternative_left] + have e2 : associator x (x * y) z = (x * x * y) * z - x * ((x * y) * z) := by + unfold associator + rw [mul_alternative_left] + rw [e1, e2] + have hA : associator (x * x) z y + associator (x * x) y z = 0 := by + rw [associator_swap_last (x * x) z y, neg_add_cancel] + have hB : associator x z y + associator x y z = 0 := by + rw [associator_swap_last x z y, neg_add_cancel] + have e3 : (x * x * z) * y = associator (x * x) z y + (x * x) * (z * y) := by + unfold associator; abel + have e4 : (x * x * y) * z = associator (x * x) y z + (x * x) * (y * z) := by + unfold associator; abel + rw [e3, e4, ← mul_alternative_left x (z * y), ← mul_alternative_left x (y * z)] + have key : -(x * (x * (z * y))) + x * ((x * z) * y) + + (-(x * (x * (y * z))) + x * ((x * y) * z)) = + x * (associator x z y + associator x y z) := by + unfold associator + simp only [mul_add, mul_sub] + abel + rw [hB, mul_zero] at key + linear_combination (norm := abel) -hA + key + +/-- McCrimmon's left bumping formula, the key alternative-algebra identity for Albert matrices. -/ +theorem left_bumping (x y z : A) : associator x y (z * x) = x * associator y z x := by + rw [← sub_eq_zero, associator_swap_last x y (z * x)] + have e1 : associator x (z * x) y = x * (z * (x * y)) - x * ((z * x) * y) := by + unfold associator + rw [moufang_left] + rw [e1] + have cyc : associator y z x = associator z x y := associator_cyclic y z x + have key : -(x * (z * (x * y)) - x * ((z * x) * y)) - x * associator y z x = + x * (associator z x y - associator y z x) := by + unfold associator + simp only [mul_sub] + abel + rw [key, cyc, sub_self, mul_zero] + +end IsAlternative diff --git a/PhyslibAlpha/AlgebraicFramework/Algebra/Derivation.lean b/PhyslibAlpha/AlgebraicFramework/Algebra/Derivation.lean new file mode 100644 index 0000000000..171c190857 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/Algebra/Derivation.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Mathlib.Algebra.Module.LinearMap.Defs +public import Mathlib.Data.Real.Basic +public import Mathlib.Tactic.Abel + +/-! + +# Derivations for an arbitrary bilinear multiplication + +## i. Overview + +A derivation is a purely *algebraic* notion: `D(a * b) = D(a) * b + a * D(b)`. No topology, no +time, no continuity, no exponential — it is meaningful for a bare `NonUnitalNonAssocRing`. This is +deliberately factored out of both the Jordan layer (`JordanOrderUnit/`) and any dynamical layer +(`Dynamics/`): "derivation" is an algebra-axis concept, and the fact that the *generator* of a +one-parameter automorphism group happens to be a derivation (`Dynamics/GeneratorIsDerivation.lean`) +is a separate, genuinely analytic bridge theorem, not a definition. + +`E` here is left as general as possible: only `Add`, `Mul`, and enough linearity for `D` itself to +be additive/`ℝ`-linear (`E →ₗ[ℝ] E`) are assumed. `IsCommJordan`, `NonUnitalNonAssocCommRing`, and +every other structure this project puts on top of a bare multiplication are irrelevant to this +file — a Jordan derivation (`D(a ∘ b) = D(a) ∘ b + a ∘ D(b)`) and an associative one are literally +the same predicate, `IsDerivation`, instantiated at different `Mul E`. + +## ii. Key definitions and results + +- `IsDerivation` +- `IsDerivation.zero`, `.add`, `.neg` : derivations form an additive group (stated pointwise; the + submodule structure is left for a future file if needed) + +## iii. Table of contents + +- A. The Leibniz rule +- B. Closure properties + +-/ + +@[expose] public section + +/-! ## A. The Leibniz rule -/ + +/-- `D` is a derivation for the multiplication on `E`: the Leibniz rule `D(a*b) = D(a)*b + a*D(b)`. +Purely algebraic — no topology, and no assumption that `D` arose as the generator of anything. + +Stated under the bare minimum `[Add E] [Mul E] [Module ℝ E]` (rather than bundling a full +`NonUnitalNonAssocRing E`) so that this definition, and the bridge theorem +`Dynamics/GeneratorIsDerivation.lean` that concludes it, can be stated for `E` a normed space with +an independent `Mul E` — avoiding the instance diamond a redundant second `AddCommGroup E` would +otherwise create against `NormedAddCommGroup E`. The closure lemmas in part B, which genuinely need +distributivity, take the stronger hypothesis locally instead. -/ +def IsDerivation {E : Type*} [Mul E] [AddCommGroup E] [Module ℝ E] (D : E →ₗ[ℝ] E) : + Prop := + ∀ a b : E, D (a * b) = D a * b + a * D b + +/-! ## B. Closure properties -/ + +variable {E : Type*} [NonUnitalNonAssocRing E] [Module ℝ E] + +theorem IsDerivation.zero : IsDerivation (0 : E →ₗ[ℝ] E) := by + intro a b; simp + +theorem IsDerivation.add {D₁ D₂ : E →ₗ[ℝ] E} (h₁ : IsDerivation D₁) (h₂ : IsDerivation D₂) : + IsDerivation (D₁ + D₂) := by + intro a b + simp only [LinearMap.add_apply, h₁ a b, h₂ a b, add_mul, mul_add] + abel + +theorem IsDerivation.neg {D : E →ₗ[ℝ] E} (h : IsDerivation D) : IsDerivation (-D) := by + intro a b + simp only [LinearMap.neg_apply, h a b, neg_mul, mul_neg, neg_add_rev] + abel + +theorem IsDerivation.smul [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] (c : ℝ) {D : E →ₗ[ℝ] E} + (h : IsDerivation D) : IsDerivation (c • D) := by + intro a b + simp only [LinearMap.smul_apply, h a b, smul_add, smul_mul_assoc, mul_smul_comm] diff --git a/PhyslibAlpha/AlgebraicFramework/Algebra/NuclearInvolution.lean b/PhyslibAlpha/AlgebraicFramework/Algebra/NuclearInvolution.lean new file mode 100644 index 0000000000..453d8fe587 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/Algebra/NuclearInvolution.lean @@ -0,0 +1,103 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.Algebra.Alternative +public import Mathlib.Algebra.Star.Basic + +/-! +# Nuclear involutions + +A star involution on an alternative algebra whose symmetric elements are nuclear (associate +trivially with everything) — the coordinate-algebra interface a `*`-alternative division algebra +like the octonions needs to support an exceptional Albert Jordan algebra of Hermitian matrices +over it. Independent of Jordan order, norms, CFC, and JBW normality. + +## Key definitions and results + +- `IsNuclear`, `IsNuclearInvolution` +- `nuclear_slip_left`/`_mid`/`_last`/`_last_right` : a nuclear element slips through the + associator. +- `assoc_star_first`/`_mid`/`_last` : the associator is alternating in sign under `star`. +- `nuclear_comm_associator` : a nuclear element commutes with any associator. +-/ + +@[expose] public section + +open IsAlternative + +variable {D : Type*} [NonUnitalNonAssocRing D] [IsAlternative D] + +/-- An element associating trivially in every slot. -/ +def IsNuclear (x : D) : Prop := + ∀ y z : D, associator x y z = 0 ∧ associator y x z = 0 ∧ associator y z x = 0 + +omit [IsAlternative D] in +theorem nuclear_slip_left {n : D} (hn : IsNuclear n) (x y z : D) : + associator (n * x) y z = n * associator x y z := by + have h := teichmuller n x y z + rw [(hn (x * y) z).1, (hn x (y * z)).1, (hn x y).1, zero_mul] at h + linear_combination (norm := abel) h + +theorem nuclear_slip_mid {n : D} (hn : IsNuclear n) (x y z : D) : + associator x (n * y) z = n * associator x y z := by + rw [associator_swap_first x (n * y) z, nuclear_slip_left hn y x z, + associator_swap_first y x z, mul_neg, neg_neg] + +theorem nuclear_slip_last {n : D} (hn : IsNuclear n) (x y z : D) : + associator x y (n * z) = n * associator x y z := by + rw [associator_swap_last x y (n * z), nuclear_slip_mid hn x z y, + associator_swap_last x z y, mul_neg, neg_neg] + +omit [IsAlternative D] in +theorem nuclear_slip_last_right {n : D} (hn : IsNuclear n) (x y z : D) : + associator x y (z * n) = associator x y z * n := by + have h := teichmuller x y z n + rw [(hn (x * y) z).2.2, (hn x (y * z)).2.2, (hn y z).2.2, mul_zero] at h + linear_combination (norm := abel) h + +variable [StarAddMonoid D] + +/-- A star involution whose symmetric elements are nuclear. -/ +class IsNuclearInvolution (D : Type*) [NonUnitalNonAssocRing D] [IsAlternative D] + [StarAddMonoid D] : Prop where + isNuclear_of_star_eq : ∀ x : D, star x = x → IsNuclear x + isNuclear_comm : ∀ n x : D, IsNuclear n → IsNuclear (n * x - x * n) + +variable [IsNuclearInvolution D] + +theorem isNuclear_add_star (x : D) : IsNuclear (x + star x) := by + apply IsNuclearInvolution.isNuclear_of_star_eq + rw [star_add, star_star, add_comm] + +theorem assoc_star_first (x y z : D) : associator (star x) y z = -associator x y z := by + have h : associator (star x) y z + associator x y z = 0 := by + rw [← associator_add_left, add_comm (star x) x] + exact (isNuclear_add_star x y z).1 + linear_combination (norm := abel) h + +theorem assoc_star_mid (x y z : D) : associator x (star y) z = -associator x y z := by + have h : associator x (star y) z + associator x y z = 0 := by + rw [← associator_add_mid, add_comm (star y) y] + exact (isNuclear_add_star y x z).2.1 + linear_combination (norm := abel) h + +theorem assoc_star_last (x y z : D) : associator x y (star z) = -associator x y z := by + have h : associator x y (star z) + associator x y z = 0 := by + rw [← associator_add_right, add_comm (star z) z] + exact (isNuclear_add_star z x y).2.2 + linear_combination (norm := abel) h + +theorem nuclear_comm_associator {n : D} (hn : IsNuclear n) (x y z : D) : + n * associator x y z = associator x y z * n := by + have h4 := nuclear_slip_last hn x y z + have h5 := nuclear_slip_last_right hn x y z + have hz : associator x y (n * z - z * n) = 0 := + (IsNuclearInvolution.isNuclear_comm n z hn x y).2.2 + have hs : associator x y (n * z) - associator x y (z * n) = associator x y (n * z - z * n) := by + unfold associator; simp only [mul_sub]; abel + rw [hz] at hs + linear_combination (norm := abel) -h4 + h5 + hs diff --git a/PhyslibAlpha/AlgebraicFramework/Algebra/Statistics.lean b/PhyslibAlpha/AlgebraicFramework/Algebra/Statistics.lean new file mode 100644 index 0000000000..1aa8611ba1 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/Algebra/Statistics.lean @@ -0,0 +1,138 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Mathlib.Data.Real.Basic +public import Mathlib.LinearAlgebra.BilinearForm.Properties + +/-! + +# Statistics of a linear functional on a bilinear algebra + +## i. Overview + +Second moments and covariance use only a bilinear multiplication and a linear functional. They do +not intrinsically require an order, positivity, associativity, commutativity, or the Jordan +identity. This file defines them at that level so ordered Jordan algebras and self-adjoint parts of +star algebras can share one canonical construction. + +For `omega : E ->_l[R] R`, the covariance is packaged as the bilinear form + +`(a, b) |-> omega (a * b) - omega a * omega b`. + +Commutativity of the product is used only to prove symmetry. A unit and the normalization +`omega 1 = 1` are used only for centering identities. Positivity is deliberately left to the +ordered specialization. + +## ii. Key definitions and results + +- `LinearMap.secondMomentForm` +- `LinearMap.covarianceForm` +- `LinearMap.variance` +- `LinearMap.centered` +- `LinearMap.apply_centered` +- `LinearMap.apply_centered_mul_centered` + +## iii. Table of contents + +- A. Second moments and covariance +- B. Centering a normalized functional + +-/ + +@[expose] public section + +namespace LinearMap + +variable {E : Type*} [NonUnitalNonAssocRing E] [Module ℝ E] + [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] + +/-! ## A. Second moments and covariance -/ + +/-- The second-moment bilinear form associated to a linear functional: +`secondMomentForm omega a b = omega (a * b)`. -/ +def secondMomentForm (omega : E →ₗ[ℝ] ℝ) : LinearMap.BilinForm ℝ E where + toFun a := + { toFun := fun b => omega (a * b) + map_add' := fun b c => by simp only [mul_add, map_add] + map_smul' := fun c b => by simp only [mul_smul_comm, map_smul, RingHom.id_apply] } + map_add' a b := by + ext c + change omega ((a + b) * c) = omega (a * c) + omega (b * c) + rw [add_mul, map_add] + map_smul' c a := by + ext b + change omega ((c • a) * b) = c • omega (a * b) + rw [smul_mul_assoc, map_smul] + +@[simp] +lemma secondMomentForm_apply (omega : E →ₗ[ℝ] ℝ) (a b : E) : + secondMomentForm omega a b = omega (a * b) := rfl + +/-- The covariance bilinear form associated to a linear functional: +`covarianceForm omega a b = omega (a * b) - omega a * omega b`. -/ +def covarianceForm (omega : E →ₗ[ℝ] ℝ) : LinearMap.BilinForm ℝ E where + toFun a := + { toFun := fun b => omega (a * b) - omega a * omega b + map_add' := fun b c => by + simp only [mul_add, map_add] + ring + map_smul' := fun c b => by + simp only [mul_smul_comm, map_smul, RingHom.id_apply, smul_eq_mul] + ring } + map_add' a b := by + ext c + change omega ((a + b) * c) - omega (a + b) * omega c = + (omega (a * c) - omega a * omega c) + (omega (b * c) - omega b * omega c) + rw [add_mul, map_add, map_add] + ring + map_smul' c a := by + ext b + change omega ((c • a) * b) - omega (c • a) * omega b = + c • (omega (a * b) - omega a * omega b) + rw [smul_mul_assoc, map_smul, map_smul] + simp only [smul_eq_mul] + ring + +@[simp] +lemma covarianceForm_apply (omega : E →ₗ[ℝ] ℝ) (a b : E) : + covarianceForm omega a b = omega (a * b) - omega a * omega b := rfl + +/-- The covariance form is symmetric when the multiplication is commutative. -/ +lemma covarianceForm_isSymm (omega : E →ₗ[ℝ] ℝ) (hcomm : ∀ a b : E, a * b = b * a) : + (covarianceForm omega).IsSymm := ⟨fun a b => by + simp only [covarianceForm_apply] + rw [hcomm a b, mul_comm (omega a) (omega b)]⟩ + +/-- The variance associated to a linear functional is the diagonal of its covariance form. -/ +def variance (omega : E →ₗ[ℝ] ℝ) (a : E) : ℝ := covarianceForm omega a a + +lemma covarianceForm_self (omega : E →ₗ[ℝ] ℝ) (a : E) : + covarianceForm omega a a = variance omega a := rfl + +/-! ## B. Centering a normalized functional -/ + +variable [One E] + +/-- Center `a` at the value assigned by `omega`: `a - omega(a) • 1`. -/ +def centered (omega : E →ₗ[ℝ] ℝ) (a : E) : E := a - omega a • (1 : E) + +omit [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] in +/-- A normalized linear functional sends every centered element to zero. -/ +@[simp] +lemma apply_centered (omega : E →ₗ[ℝ] ℝ) (homega : omega 1 = 1) (a : E) : + omega (centered omega a) = 0 := by + simp [centered, homega] + +/-- For a normalized functional, covariance is its value on the product of centered elements. -/ +lemma apply_centered_mul_centered (omega : E →ₗ[ℝ] ℝ) (homega : omega 1 = 1) + (honeLeft : ∀ x : E, 1 * x = x) (honeRight : ∀ x : E, x * 1 = x) (a b : E) : + omega (centered omega a * centered omega b) = covarianceForm omega a b := by + simp only [centered, sub_mul, mul_sub, mul_smul_comm, smul_mul_assoc, map_sub, map_smul, + smul_eq_mul, covarianceForm_apply, honeLeft, honeRight, homega] + ring + +end LinearMap diff --git a/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/Automorphism.lean b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/Automorphism.lean new file mode 100644 index 0000000000..cb3a36ea69 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/Automorphism.lean @@ -0,0 +1,406 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.StarAlgebra.Observable +public import PhyslibAlpha.AlgebraicFramework.StarAlgebra.Lie +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.Channel +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.OrderUnit +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Symmetry +public import Mathlib.Algebra.Star.StarAlgHom + +/-! + +# ⋆-automorphisms and their action on observables + +Reversible transformations of a quantum system act on its observable algebra by +⋆-automorphisms `β : A ≃⋆ₐ[ℂ] A`, `a ↦ β a`. This is genuinely abstract-algebra-level content: it +works for any `A` with enough structure to form `Observable A := selfAdjoint A` +(`StarAlgebra/Observable.lean`) and the observable Lie bracket (`StarAlgebra/Lie.lean`) — no norm, +completeness, order, or Hilbert space enters anywhere in this file. + +A ⋆-automorphism acts on observables (`StarAlgEquiv.observable`) compatibly with composition, +inverses, and the Lie bracket (`StarAlgEquiv.observable_bracket`). A one-parameter group of such +automorphisms (`AutomorphismGroup A`) can be reindexed by a change of coordinates `β` +(`AutomorphismGroup.conj`). Both are just as algebra-level as the observable action above — neither +mentions a norm or a Hilbert space — so they live here rather than at the Hilbert-space layer, +where `HilbertSpace/Dynamics/Automorphism.lean` specializes `AutomorphismGroup (H →L[ℂ] H)` to +unitarily-implemented dynamics and proves it satisfies (and uniquely solves) the Heisenberg +equation. + +## Main definitions + +- `StarAlgEquiv.observable` : a ⋆-automorphism acting on observables, `a ↦ β a`. +- `StarAlgEquiv.observable_bracket` : ⋆-automorphisms preserve the observable Lie bracket. +- `AutomorphismGroup A` : a one-parameter group of ⋆-automorphisms of `A`. +- `AutomorphismGroup.transport` : transport of a flow across a ⋆-isomorphism between algebras. +- `AutomorphismGroup.IsIntertwining` : the commuting square for a ⋆-isomorphism and two flows. +- `AutomorphismGroup.conj` : reindexing a flow `α` by a change of coordinates `β`, + `(conj β α) t = β ∘ (α t) ∘ β⁻¹`. +- `StarAlgEquiv.observableUPLM` : the order-unit channel induced on self-adjoint observables. +- `AutomorphismGroup.toObservableDynamics` : the same dynamics in the existing state/effect API. + +-/ + +@[expose] public section + +/-! ## Action on observables -/ + +section StarAlgEquivObservable + +open scoped selfAdjoint + +variable {A : Type*} [Ring A] [StarRing A] [Module ℂ A] [StarModule ℂ A] + +omit [StarModule ℂ A] in +/-- A ⋆-automorphism `β` acts on observables by `a ↦ β a`. -/ +def StarAlgEquiv.observable (β : A ≃⋆ₐ[ℂ] A) (a : Observable A) : Observable A := + ⟨β (a : A), by + show star (β (a : A)) = β (a : A) + rw [← map_star, a.2]⟩ + +omit [StarModule ℂ A] in +/-- Unfolds `StarAlgEquiv.observable` to its underlying algebra element. -/ +@[simp] +lemma StarAlgEquiv.observable_coe (β : A ≃⋆ₐ[ℂ] A) (a : Observable A) : + (β.observable a : A) = β (a : A) := rfl + +omit [StarModule ℂ A] in +/-- The identity automorphism acts trivially on observables. -/ +@[simp] +lemma StarAlgEquiv.refl_observable : + (StarAlgEquiv.refl (R := ℂ) (A := A)).observable = id := by + funext a + exact Subtype.ext rfl + +omit [StarModule ℂ A] in +/-- Composing `β` then `γ` acts on observables as `γ ∘ β`. -/ +@[simp] +lemma StarAlgEquiv.trans_observable (β γ : A ≃⋆ₐ[ℂ] A) (a : Observable A) : + (β.trans γ).observable a = γ.observable (β.observable a) := + Subtype.ext (StarAlgEquiv.trans_apply β γ (a : A)) + +omit [StarModule ℂ A] in +/-- Undoing `β.observable` by `β.symm.observable` recovers the original observable. -/ +@[simp] +lemma StarAlgEquiv.symm_observable_observable (β : A ≃⋆ₐ[ℂ] A) (a : Observable A) : + β.symm.observable (β.observable a) = a := + Subtype.ext (β.symm_apply_apply (a : A)) + +omit [StarModule ℂ A] in +/-- Applying `β.observable` after `β.symm.observable` recovers the original observable. -/ +@[simp] +lemma StarAlgEquiv.observable_symm_observable (β : A ≃⋆ₐ[ℂ] A) (a : Observable A) : + β.observable (β.symm.observable a) = a := + Subtype.ext (β.apply_symm_apply (a : A)) + +/-- Star automorphisms preserve the observable Lie bracket. -/ +lemma StarAlgEquiv.observable_bracket (β : A ≃⋆ₐ[ℂ] A) (a b : Observable A) : + β.observable ⁅a, b⁆ = ⁅β.observable a, β.observable b⁆ := by + apply Subtype.ext + simp only [observable_coe, selfAdjoint.coe_bracket, map_smul, map_sub, map_mul] + +end StarAlgEquivObservable + +/-! ## C⋆-automorphisms as channels and order-unit symmetries -/ + +section StarAlgEquivChannel + +open scoped selfAdjoint + +variable {A : Type*} [CStarAlgebra A] [PartialOrder A] [StarOrderedRing A] + +/-- A C⋆-⋆-automorphism is a unital completely positive channel. -/ +noncomputable def StarAlgEquiv.toChannel (β : A ≃⋆ₐ[ℂ] A) : Channel A A where + toCompletelyPositiveMap := β.toStarAlgHom + map_one' := β.map_one + +/-- The order-unit channel obtained by restricting a C⋆-⋆-automorphism to self-adjoint elements. +This is the bridge from algebraic reversible dynamics to Basic's states, effects, and covariant +channel API. -/ +noncomputable def StarAlgEquiv.observableUPLM (β : A ≃⋆ₐ[ℂ] A) : + selfAdjoint A →ₚ₁[ℝ] selfAdjoint A := + .ofLinearMap + { toFun := β.observable + map_add' := fun a b => Subtype.ext <| by + change β ((a : A) + b) = β (a : A) + β b + rw [map_add] + map_smul' := fun r a => Subtype.ext <| by + change β ((r : ℂ) • (a : A)) = (r : ℂ) • β (a : A) + exact map_smulₛₗ β.toStarAlgHom (r : ℂ) (a : A) } + (fun a ha => by + show (0 : A) ≤ β (a : A) + exact map_nonneg β.toStarAlgHom ha) + (by + ext + change β (1 : A) = (1 : A) + exact β.map_one) + +/-- The observable channel induced by `β` has the expected pointwise action. -/ +@[simp] +lemma StarAlgEquiv.observableUPLM_apply (β : A ≃⋆ₐ[ℂ] A) (a : selfAdjoint A) : + β.observableUPLM a = β.observable a := rfl + +/-- Every C⋆-⋆-automorphism induces an order-unit symmetry of the self-adjoint observables. -/ +noncomputable def StarAlgEquiv.observableSymmetry (β : A ≃⋆ₐ[ℂ] A) : Symmetry (selfAdjoint A) := + ⟨β.observableUPLM, β.symm.observableUPLM, by + apply UnitalPositiveLinearMap.ext + intro a + change β.symm.observable (β.observable a) = a + exact β.symm_observable_observable a, + by + apply UnitalPositiveLinearMap.ext + intro a + change β.observable (β.symm.observable a) = a + exact β.observable_symm_observable a⟩ + +/-- The observable symmetry induced by `β` is its restricted order-unit channel. -/ +@[simp] +lemma StarAlgEquiv.val_observableSymmetry (β : A ≃⋆ₐ[ℂ] A) : + (β.observableSymmetry : selfAdjoint A →ₚ₁[ℝ] selfAdjoint A) = β.observableUPLM := rfl + +end StarAlgEquivChannel + +section StarAlgEquivInterSystemChannel + +variable {A B : Type*} [CStarAlgebra A] [PartialOrder A] [StarOrderedRing A] + [CStarAlgebra B] [PartialOrder B] [StarOrderedRing B] + +/-- The UCP channel determined by a ⋆-isomorphism between two C⋆-algebras. -/ +noncomputable def StarAlgEquiv.toInterSystemChannel (β : A ≃⋆ₐ[ℂ] B) : Channel A B where + toCompletelyPositiveMap := β.toStarAlgHom + map_one' := β.map_one + +/-- The order-unit channel induced by a ⋆-isomorphism between two observable algebras. -/ +noncomputable def StarAlgEquiv.toObservableUPLM (β : A ≃⋆ₐ[ℂ] B) : + selfAdjoint A →ₚ₁[ℝ] selfAdjoint B := + .ofLinearMap + { toFun := fun a => ⟨β (a : A), by + show star (β (a : A)) = β (a : A) + rw [← map_star, a.2]⟩ + map_add' := fun a b => Subtype.ext <| by + change β ((a : A) + b) = β (a : A) + β b + rw [map_add] + map_smul' := fun r a => Subtype.ext <| by + change β ((r : ℂ) • (a : A)) = (r : ℂ) • β (a : A) + exact map_smulₛₗ β.toStarAlgHom (r : ℂ) (a : A) } + (fun a ha => by + show (0 : B) ≤ β (a : A) + exact map_nonneg β.toStarAlgHom ha) + (by + ext + change β (1 : A) = (1 : B) + exact β.map_one) + +/-- The inter-system observable channel is pointwise the original ⋆-isomorphism. -/ +@[simp] +lemma StarAlgEquiv.coe_toObservableUPLM (β : A ≃⋆ₐ[ℂ] B) (a : selfAdjoint A) : + (β.toObservableUPLM a : B) = β (a : A) := rfl + +end StarAlgEquivInterSystemChannel + +/-! ## Reversible one-parameter dynamics -/ + +/-- A one-parameter group of star-algebra automorphisms. -/ +structure AutomorphismGroup (A : Type*) [Ring A] [StarRing A] [Module ℂ A] where + /-- The automorphism at time `t`. -/ + toFun : ℝ → (A ≃⋆ₐ[ℂ] A) + /-- Evolution at time zero is the identity. -/ + map_zero_apply : ∀ a : A, toFun 0 a = a + /-- The group law, with evolution by `t` followed by evolution by `s`. -/ + map_add_apply : ∀ (s t : ℝ) (a : A), toFun (s + t) a = toFun s (toFun t a) + +/-- An automorphism group is determined by its action at every time. -/ +@[ext] +lemma AutomorphismGroup.ext {A : Type*} [Ring A] [StarRing A] [Module ℂ A] + {α β : AutomorphismGroup A} (h : ∀ t a, α.toFun t a = β.toFun t a) : α = β := by + have hfun : α.toFun = β.toFun := funext fun t => StarAlgEquiv.ext (h t) + cases α + cases β + cases hfun + rfl + +/-! ## Order-unit dynamics induced by C⋆-automorphisms -/ + +section AutomorphismGroupObservableDynamics + +open scoped selfAdjoint + +variable {A : Type*} [CStarAlgebra A] [PartialOrder A] [StarOrderedRing A] + +/-- View a C⋆-algebra automorphism group as the existing order-unit automorphism group of its +self-adjoint observables. Its induced `stateEvolution` and symmetry action on effects are therefore +the project's standard ones, rather than parallel constructions. -/ +noncomputable def AutomorphismGroup.toObservableDynamics (α : AutomorphismGroup A) : + OneParameterAutomorphismGroup (selfAdjoint A) where + toFun t := (α.toFun t).observableUPLM + map_zero' := by + apply UnitalPositiveLinearMap.ext + intro a + change (α.toFun 0).observable a = a + apply Subtype.ext + exact α.map_zero_apply (a : A) + map_add' s t := by + apply UnitalPositiveLinearMap.ext + intro a + change (α.toFun (s + t)).observable a = + (α.toFun s).observable ((α.toFun t).observable a) + apply Subtype.ext + exact α.map_add_apply s t (a : A) + +/-- The observable dynamics is the restriction of the algebraic dynamics at each time. -/ +@[simp] +lemma AutomorphismGroup.toObservableDynamics_apply (α : AutomorphismGroup A) (t : ℝ) + (a : selfAdjoint A) : α.toObservableDynamics t a = (α.toFun t).observable a := rfl + +end AutomorphismGroupObservableDynamics + +/-! ## Transporting and conjugating automorphism groups + +A ⋆-isomorphism `β : A ≃⋆ₐ[ℂ] B` transports a dynamics on `A` to one on `B`. The defining +commuting square says that applying `β` after evolving in `A` agrees with evolving after applying +`β`. This is the dynamics-level counterpart of the channel covariance API: it is the form used by +a quadratic normal-form equivalence, and it also applies to any later change of algebraic +description. + +Conjugation is the special case `A = B`. -/ + +section AutomorphismGroupTransport + +variable {A B C : Type*} [Ring A] [StarRing A] [Module ℂ A] + [Ring B] [StarRing B] [Module ℂ B] [Ring C] [StarRing C] [Module ℂ C] + +/-- Transport a one-parameter ⋆-automorphism group across a ⋆-isomorphism. -/ +def AutomorphismGroup.transport (β : A ≃⋆ₐ[ℂ] B) (α : AutomorphismGroup A) : + AutomorphismGroup B where + toFun t := (β.symm.trans (α.toFun t)).trans β + map_zero_apply b := by + simp [StarAlgEquiv.trans_apply, α.map_zero_apply] + map_add_apply s t b := by + simp only [StarAlgEquiv.trans_apply, α.map_add_apply, β.symm_apply_apply] + +/-- Unfolds transported dynamics: evolve after pulling back through the ⋆-isomorphism. -/ +@[simp] +lemma AutomorphismGroup.transport_apply (β : A ≃⋆ₐ[ℂ] B) (α : AutomorphismGroup A) + (t : ℝ) (b : B) : + (α.transport β).toFun t b = β (α.toFun t (β.symm b)) := by + simp [AutomorphismGroup.transport, StarAlgEquiv.trans_apply] + +/-- A ⋆-isomorphism intertwines two dynamics when its square commutes at every time. -/ +def AutomorphismGroup.IsIntertwining (α : AutomorphismGroup A) (γ : AutomorphismGroup B) + (β : A ≃⋆ₐ[ℂ] B) : Prop := + ∀ (t : ℝ) (a : A), β (α.toFun t a) = γ.toFun t (β a) + +/-- Transported dynamics is intertwined with the original dynamics by the transporting +⋆-isomorphism. -/ +lemma AutomorphismGroup.isIntertwining_transport (β : A ≃⋆ₐ[ℂ] B) + (α : AutomorphismGroup A) : + α.IsIntertwining (α.transport β) β := by + intro t a + simp + +/-- A ⋆-isomorphism intertwines a flow with precisely the dynamics transported along it. -/ +lemma AutomorphismGroup.isIntertwining_iff_eq_transport (α : AutomorphismGroup A) + (γ : AutomorphismGroup B) (β : A ≃⋆ₐ[ℂ] B) : + α.IsIntertwining γ β ↔ γ = α.transport β := by + constructor + · intro h + apply AutomorphismGroup.ext + intro t b + simpa using (h t (β.symm b)).symm + · rintro rfl + exact α.isIntertwining_transport β + +/-- Intertwining squares compose along composable ⋆-isomorphisms. -/ +lemma AutomorphismGroup.IsIntertwining.trans {α : AutomorphismGroup A} {γ : AutomorphismGroup B} + {δ : AutomorphismGroup C} {β : A ≃⋆ₐ[ℂ] B} {χ : B ≃⋆ₐ[ℂ] C} + (hβ : α.IsIntertwining γ β) (hχ : γ.IsIntertwining δ χ) : + α.IsIntertwining δ (β.trans χ) := by + intro t a + change χ (β (α.toFun t a)) = δ.toFun t (χ (β a)) + rw [hβ t a, hχ t (β a)] + +/-- Transport through the identity ⋆-isomorphism leaves a flow unchanged. -/ +@[simp] +lemma AutomorphismGroup.transport_refl (α : AutomorphismGroup A) : + α.transport (StarAlgEquiv.refl (R := ℂ) (A := A)) = α := by + apply AutomorphismGroup.ext + intro t a + simp + +/-- Successive changes of algebraic coordinates transport a flow by their composite. -/ +lemma AutomorphismGroup.transport_trans (α : AutomorphismGroup A) (β : A ≃⋆ₐ[ℂ] B) + (γ : B ≃⋆ₐ[ℂ] C) : + (α.transport β).transport γ = α.transport (β.trans γ) := by + apply AutomorphismGroup.ext + intro t c + simp only [AutomorphismGroup.transport_apply, StarAlgEquiv.trans_apply, + StarAlgEquiv.symm_trans_apply] + +/-- Transporting back through the inverse ⋆-isomorphism recovers the original flow. -/ +@[simp] +lemma AutomorphismGroup.transport_symm_transport (α : AutomorphismGroup A) (β : A ≃⋆ₐ[ℂ] B) : + (α.transport β).transport β.symm = α := by + apply AutomorphismGroup.ext + intro t a + simp + +end AutomorphismGroupTransport + +/-! ## Conjugating an automorphism group by a star automorphism + +Changing which ⋆-automorphism `β` identifies the algebra with itself conjugates a flow `α`: +`(conj β α) t = β ∘ α t ∘ β⁻¹`. -/ + +section AutomorphismGroupConj + +variable {A : Type*} [Ring A] [StarRing A] [Module ℂ A] + +/-- The automorphism group `α`, viewed through the change of coordinates `β`: +`(conj β α) t = β ∘ (α t) ∘ β⁻¹`. -/ +def AutomorphismGroup.conj (β : A ≃⋆ₐ[ℂ] A) (α : AutomorphismGroup A) : AutomorphismGroup A where + toFun := (α.transport β).toFun + map_zero_apply := (α.transport β).map_zero_apply + map_add_apply := (α.transport β).map_add_apply + +/-- Unfolds `AutomorphismGroup.conj` to `(conj β α) t a = β (α t (β⁻¹ a))`. -/ +@[simp] +lemma AutomorphismGroup.conj_apply (β : A ≃⋆ₐ[ℂ] A) (α : AutomorphismGroup A) (t : ℝ) (a : A) : + (α.conj β).toFun t a = β (α.toFun t (β.symm a)) := by + simp [AutomorphismGroup.conj] + +/-- Conjugating by the identity automorphism changes nothing. -/ +@[simp] +lemma AutomorphismGroup.conj_refl (α : AutomorphismGroup A) : + α.conj (StarAlgEquiv.refl (R := ℂ) (A := A)) = α := by + apply AutomorphismGroup.ext + intro t a + simp + +/-- Conjugating successively by `β` then `γ` is the same as conjugating once by `β.trans γ`. -/ +lemma AutomorphismGroup.conj_conj (α : AutomorphismGroup A) (β γ : A ≃⋆ₐ[ℂ] A) : + (α.conj β).conj γ = α.conj (β.trans γ) := by + apply AutomorphismGroup.ext + intro t a + simp only [AutomorphismGroup.conj_apply, StarAlgEquiv.trans_apply, StarAlgEquiv.symm_trans_apply] + +/-- Conjugating by `β` and then undoing it with `β.symm` recovers the original flow. -/ +@[simp] +lemma AutomorphismGroup.conj_symm_conj (α : AutomorphismGroup A) (β : A ≃⋆ₐ[ℂ] A) : + (α.conj β).conj β.symm = α := by + apply AutomorphismGroup.ext + intro t a + simp + +/-- Conjugating by `β.symm` and then undoing it with `β` recovers the original flow. -/ +@[simp] +lemma AutomorphismGroup.conj_conj_symm (α : AutomorphismGroup A) (β : A ≃⋆ₐ[ℂ] A) : + (α.conj β.symm).conj β = α := by + apply AutomorphismGroup.ext + intro t a + simp + +end AutomorphismGroupConj diff --git a/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/Channel.lean b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/Channel.lean new file mode 100644 index 0000000000..072203a3af --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/Channel.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Mathlib.Analysis.CStarAlgebra.CompletelyPositiveMap + +/-! + +# Quantum channels between C⋆-algebras + +A quantum channel between C⋆-algebras is a *unital completely positive* (UCP) map: complete +positivity, not mere positivity, is the physically correct notion at this level, since a channel +must stay positive even after being applied to one half of a larger, entangled system — exactly +what `CompletelyPositiveMap` (`A₁ →CP A₂`, matrix-amplified positivity) already captures. This +sidesteps needing a tensor product of order-unit spaces (flagged as missing in +`OrderUnit/Channel/Basic.lean`): matrix amplification tests positivity against every finite-rank +bystander system without constructing a tensor product explicitly. + +A UCP map is automatically positive (`CompletelyPositiveMapClass` gives `OrderHomClass`), so +`Channel A₁ A₂` restricts, on the self-adjoint parts, to the abstract order-unit-level notion +already built (`OrderUnit/Channel/Basic.lean`'s `UnitalPositiveLinearMap`) — connecting the two is +future work, needing the positive/negative part decomposition of a self-adjoint element. + +## Main definitions + +- `Channel A₁ A₂` + +-/ + +@[expose] public section + +open scoped CStarAlgebra + +variable {A₁ A₂ : Type*} [NonUnitalCStarAlgebra A₁] [NonUnitalCStarAlgebra A₂] + [PartialOrder A₁] [PartialOrder A₂] [StarOrderedRing A₁] [StarOrderedRing A₂] + [One A₁] [One A₂] + +/-- A quantum channel: a unital completely positive map between C⋆-algebras. -/ +structure Channel (A₁ A₂ : Type*) [NonUnitalCStarAlgebra A₁] [NonUnitalCStarAlgebra A₂] + [PartialOrder A₁] [PartialOrder A₂] [StarOrderedRing A₁] [StarOrderedRing A₂] + [One A₁] [One A₂] extends A₁ →CP A₂, OneHom A₁ A₂ + +-- The inherited `OneHom` projection has no separately attachable docstring. +attribute [nolint docBlame] Channel.toOneHom + +namespace Channel + +instance : FunLike (Channel A₁ A₂) A₁ A₂ where + coe f := f.toFun + coe_injective f g h := by + cases f + cases g + congr + apply DFunLike.coe_injective + exact h + +instance : LinearMapClass (Channel A₁ A₂) ℂ A₁ A₂ where + map_add f := map_add f.toCompletelyPositiveMap + map_smulₛₗ f := map_smulₛₗ f.toCompletelyPositiveMap + +instance : CompletelyPositiveMapClass (Channel A₁ A₂) A₁ A₂ where + map_cstarMatrix_nonneg' f := f.map_cstarMatrix_nonneg' + +instance : OneHomClass (Channel A₁ A₂) A₁ A₂ where + map_one f := f.map_one' + +@[ext] +lemma ext {f g : Channel A₁ A₂} (h : ∀ x, f x = g x) : f = g := + DFunLike.ext f g h + +end Channel diff --git a/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/ConjugationSymmetry.lean b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/ConjugationSymmetry.lean new file mode 100644 index 0000000000..701a59a557 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/ConjugationSymmetry.lean @@ -0,0 +1,201 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Symmetry +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.OrderUnit +public import Mathlib.Algebra.Star.Unitary + +/-! + +# Conjugation by a unitary is a symmetry of the self-adjoint part + +A symmetry of a quantum system is standardly modeled as `α_g(a) = U_g a U_g*` for `U` a unitary +representation of a group `G`. This file builds the purely algebraic core of that statement: for a +fixed unitary `u` of a unital C⋆-algebra `A`, conjugation `a ↦ u a u*` restricts to a genuine +order-automorphism of `selfAdjoint A` (`OrderUnit/Symmetry.lean`'s `Symmetry`), and this assignment +is a group homomorphism `unitary A →* Symmetry (selfAdjoint A)`. Composing with a homomorphism +`U : G →* unitary A` — the algebraic shadow of a (strongly continuous, projective) unitary +representation, minus any topology this layer does not carry — produces exactly such a homomorphism +`G →* Symmetry (selfAdjoint A)`. + +Conjugation lands back in `selfAdjoint A` because `IsSelfAdjoint.conjugate` already gives +`IsSelfAdjoint (z * x * star z)` for self-adjoint `x`; it is positive because `A` is a +`StarOrderedRing` (`star_right_conjugate_nonneg`); it is unital because `u * star u = 1` +(`Unitary.mul_star_self_of_mem`); and the two-sided inverse is conjugation by `star u` (equivalently +`u⁻¹`, since `unitary A` is a group with `Inv := star`), because `u * star u = star u * u = 1` +collapses `conjugationLinearMap u` composed with `conjugationLinearMap (star u)` (in either order) +to the identity by pure associativity. None of this needs any topology or continuity hypothesis — +this is purely algebraic content, independent of the "strongly continuous" qualifier that a genuine +unitary representation would carry. + +## Main definitions + +- `unitary.conjugationLinearMap u`, `unitary.conjugationUPLM u` : the underlying `ℝ`-linear map + and unital positive linear map of conjugation by `u`, `a ↦ u a u*`, on `selfAdjoint A`. +- `unitary.conjugationLinearMap_conjugationLinearMap` : the algebraic heart, + `conjugationLinearMap u (conjugationLinearMap v a) = conjugationLinearMap (u * v) a`, with no + unitarity of `u`, `v` needed — pure associativity. +- `unitary.conjugationSymmetry u : Symmetry (selfAdjoint A)` : conjugation by `u` as a genuine + order-automorphism, with inverse conjugation by `star u`. +- `unitary.conjugationSymmetryHom : unitary A →* Symmetry (selfAdjoint A)` : the assignment + `u ↦ conjugationSymmetry u` is a group homomorphism (not an anti-homomorphism — composition + order works out because `Symmetry`'s multiplication is itself `.comp`, "apply the right factor + first"). +- `Unitary.Representation.toSymmetryHom (U : G →* unitary A) : G →* Symmetry (selfAdjoint A)` : + composing with a homomorphism into the unitary group gives `α_g(a) = U_g a U_g*` directly, as a + homomorphism into the automorphism group. + +-/ + +@[expose] public section + +variable {A : Type*} [CStarAlgebra A] [PartialOrder A] [StarOrderedRing A] + +namespace unitary + +/-! ## Conjugation as a linear map -/ + +/-- The underlying `ℝ`-linear map of conjugation by a unitary `u`, `a ↦ u a u*`, restricted to +self-adjoint elements. Lands back in `selfAdjoint A` by `IsSelfAdjoint.conjugate`. -/ +def conjugationLinearMap (u : unitary A) : selfAdjoint A →ₗ[ℝ] selfAdjoint A where + toFun a := ⟨(u : A) * (a : A) * star (u : A), a.2.conjugate (u : A)⟩ + map_add' a b := by + ext + show (u : A) * ((a : A) + (b : A)) * star (u : A) = + (u : A) * (a : A) * star (u : A) + (u : A) * (b : A) * star (u : A) + rw [mul_add, add_mul] + map_smul' c a := by + ext + show (u : A) * (c • (a : A)) * star (u : A) = c • ((u : A) * (a : A) * star (u : A)) + rw [mul_smul_comm, smul_mul_assoc] + +omit [PartialOrder A] [StarOrderedRing A] in +@[simp] +lemma coe_conjugationLinearMap (u : unitary A) (a : selfAdjoint A) : + (conjugationLinearMap u a : A) = (u : A) * (a : A) * star (u : A) := rfl + +omit [PartialOrder A] [StarOrderedRing A] in +/-- The algebraic heart of the whole file: composing conjugation by `v` then by `u` is +conjugation by `u * v`, by pure associativity of multiplication in `A` — no unitarity of `u` or +`v` is used here at all. Matches `Unitary.conjStarAlgAut_mul_apply` in mathlib, which is the same +identity for the full ⋆-algebra automorphism rather than its restriction to `selfAdjoint A`. -/ +lemma conjugationLinearMap_conjugationLinearMap (u v : unitary A) (a : selfAdjoint A) : + conjugationLinearMap u (conjugationLinearMap v a) = conjugationLinearMap (u * v) a := by + ext + show (u : A) * ((v : A) * (a : A) * star (v : A)) * star (u : A) = + ((u * v : unitary A) : A) * (a : A) * star ((u * v : unitary A) : A) + rw [Submonoid.coe_mul, star_mul] + noncomm_ring + +omit [PartialOrder A] [StarOrderedRing A] in +/-- Conjugation by `1` does nothing. -/ +@[simp] +lemma conjugationLinearMap_one (a : selfAdjoint A) : + conjugationLinearMap (1 : unitary A) a = a := by + ext + show (1 : A) * (a : A) * star (1 : A) = (a : A) + simp + +omit [PartialOrder A] [StarOrderedRing A] in +/-- Conjugating by `u` then by `star u` is the identity: this is +`conjugationLinearMap_conjugationLinearMap` specialized along `star u * u = 1`. -/ +lemma conjugationLinearMap_star_conjugationLinearMap (u : unitary A) (a : selfAdjoint A) : + conjugationLinearMap (star u) (conjugationLinearMap u a) = a := by + rw [conjugationLinearMap_conjugationLinearMap, Unitary.star_mul_self, conjugationLinearMap_one] + +omit [PartialOrder A] [StarOrderedRing A] in +/-- Conjugating by `star u` then by `u` is the identity: this is +`conjugationLinearMap_conjugationLinearMap` specialized along `u * star u = 1`. -/ +lemma conjugationLinearMap_conjugationLinearMap_star (u : unitary A) (a : selfAdjoint A) : + conjugationLinearMap u (conjugationLinearMap (star u) a) = a := by + rw [conjugationLinearMap_conjugationLinearMap, Unitary.mul_star_self, conjugationLinearMap_one] + +/-! ## Conjugation as a unital positive linear map -/ + +/-- Conjugation by a unitary `u`, `a ↦ u a u*`, as a unital positive linear map (channel) on +`selfAdjoint A`: positive by `star_right_conjugate_nonneg`, unital because `u * star u = 1`. -/ +noncomputable def conjugationUPLM (u : unitary A) : selfAdjoint A →ₚ₁[ℝ] selfAdjoint A := + .ofLinearMap (conjugationLinearMap u) + (fun x hx => star_right_conjugate_nonneg hx (u : A)) + (by + ext + show (u : A) * (1 : A) * star (u : A) = (1 : A) + rw [mul_one, Unitary.mul_star_self_of_mem u.2]) + +@[simp] +lemma coe_conjugationUPLM (u : unitary A) (a : selfAdjoint A) : + (conjugationUPLM u a : A) = (u : A) * (a : A) * star (u : A) := rfl + +lemma conjugationUPLM_comp_conjugationUPLM (u v : unitary A) : + (conjugationUPLM u).comp (conjugationUPLM v) = conjugationUPLM (u * v) := + UnitalPositiveLinearMap.ext fun a => + Subtype.ext (congrArg Subtype.val (conjugationLinearMap_conjugationLinearMap u v a)) + +lemma conjugationUPLM_one : conjugationUPLM (1 : unitary A) = .id ℝ (selfAdjoint A) := + UnitalPositiveLinearMap.ext fun a => + Subtype.ext (congrArg Subtype.val (conjugationLinearMap_one a)) + +/-! ## Conjugation as a symmetry -/ + +/-- Conjugation by a unitary `u` is a genuine order-automorphism of `selfAdjoint A`: conjugation by +a fixed unitary realizes `α_g(a) = U_g a U_g*` for a single group element. Its two-sided inverse is +conjugation by `star u`. -/ +noncomputable def conjugationSymmetry (u : unitary A) : Symmetry (selfAdjoint A) := + ⟨conjugationUPLM u, conjugationUPLM (star u), + UnitalPositiveLinearMap.ext fun a => + Subtype.ext (congrArg Subtype.val (conjugationLinearMap_star_conjugationLinearMap u a)), + UnitalPositiveLinearMap.ext fun a => + Subtype.ext (congrArg Subtype.val (conjugationLinearMap_conjugationLinearMap_star u a))⟩ + +@[simp] +lemma val_conjugationSymmetry (u : unitary A) : + (conjugationSymmetry u : selfAdjoint A →ₚ₁[ℝ] selfAdjoint A) = conjugationUPLM u := rfl + +/-- `u ↦ conjugationSymmetry u` is a genuine group homomorphism +`unitary A →* Symmetry (selfAdjoint A)`, not an anti-homomorphism — `Symmetry`'s multiplication is +`φ * ψ = φ.comp ψ` (apply `ψ` first), and `conjugationLinearMap_conjugationLinearMap` shows +conjugation composes the same way: conjugating by `v` then `u` is conjugation by `u * v`. -/ +noncomputable def conjugationSymmetryHom : unitary A →* Symmetry (selfAdjoint A) where + toFun := conjugationSymmetry + map_one' := Symmetry.ext fun a => by + rw [val_conjugationSymmetry, conjugationUPLM_one, Symmetry.val_one] + map_mul' u v := Symmetry.ext fun a => by + simp only [Symmetry.val_mul, val_conjugationSymmetry] + rw [conjugationUPLM_comp_conjugationUPLM] + +@[simp] +lemma conjugationSymmetryHom_apply (u : unitary A) : + conjugationSymmetryHom u = conjugationSymmetry u := rfl + +end unitary + +/-! ## Unitary representations induce symmetry actions -/ + +namespace Unitary + +/-- A group homomorphism `U : G →* unitary A` — the algebraic shadow of a unitary representation, +minus any strong-continuity hypothesis, which needs a topology this layer does not carry — +composes with `conjugationSymmetryHom` to give exactly `α_g(a) = U_g a U_g*` as a homomorphism +`G →* Symmetry (selfAdjoint A)`. A measurement covariant under such an action +(`UnitalPositiveLinearMap.IsCovariant` / `EffectValuedMeasure.IsCovariant`, +`Measurement/Covariance.lean`) is exactly one satisfying `M ∘ β_g = α_g ∘ M` for this `α`; +connecting the two is future work, not attempted here. -/ +noncomputable def Representation.toSymmetryHom {G : Type*} [Group G] (U : G →* unitary A) : + G →* Symmetry (selfAdjoint A) := + unitary.conjugationSymmetryHom.comp U + +@[simp] +lemma Representation.toSymmetryHom_apply {G : Type*} [Group G] (U : G →* unitary A) (g : G) : + Representation.toSymmetryHom U g = unitary.conjugationSymmetry (U g) := rfl + +/-- Unwinding `Representation.toSymmetryHom` on an element `a` recovers `α_g(a) = U_g a U_g*` +literally. -/ +lemma Representation.toSymmetryHom_apply_coe {G : Type*} [Group G] (U : G →* unitary A) (g : G) + (a : selfAdjoint A) : + ((Representation.toSymmetryHom U g).1 a : A) = (U g : A) * (a : A) * star (U g : A) := rfl + +end Unitary diff --git a/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/GNS.lean b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/GNS.lean new file mode 100644 index 0000000000..dffaba1b19 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/GNS.lean @@ -0,0 +1,151 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.Basic +public import Mathlib.Analysis.CStarAlgebra.GelfandNaimarkSegal + +/-! + +# The Gelfand─Naimark─Segal (GNS) construction: the cyclic vector + +Every state produces a Hilbert space it did not start with. Given a state `ω` on a unital +C⋆-algebra `A` — no Hilbert space assumed, no representation assumed, just a positive normalized +linear functional (`ω : 𝓢[A]`, `OVERVIEW.md` §13) — the GNS construction recovers both: a Hilbert +space `H_ω`, a `⋆`-representation `π_ω : A → B(H_ω)`, and inside `H_ω` a single unit vector `Ω_ω` +that reproduces `ω` as a vector state of the representation, + + `ω(a) = ⟪Ω_ω, π_ω(a) Ω_ω⟫`. + +`Ω_ω` is *cyclic*: applying every `a ∈ A` to it sweeps out a dense subspace of `H_ω`, so nothing in +`H_ω` sits outside what `π_ω(A)` can reach starting from `Ω_ω`. This is the converse to §13's vector +states `ω_ψ(x) = ⟪ψ, xψ⟫`: every state, not only the ones already handed a Hilbert space to live on, +*is* a vector state — of the Hilbert space this construction builds for it out of `ω` alone. + +`Mathlib.Analysis.CStarAlgebra.GelfandNaimarkSegal` already builds `H_ω` +(`PositiveLinearMap.GNS`) and `π_ω` (`PositiveLinearMap.gnsStarAlgHom`) from an arbitrary positive +linear functional. Its docstring lists the missing cyclic vector as a `TODO`. This file supplies +exactly that: `Ω_ω` +is the image of `1 : A` inside `H_ω`, the defining identity above, cyclicity of `Ω_ω`, and +faithfulness of `π_ω` when `ω` itself is a faithful state. + +## Main definitions + +- `UnitalPositiveLinearMap.GNS`, `UnitalPositiveLinearMap.gnsRep` : `H_ω` and `π_ω`, read directly + off a state `ω : 𝓢[A]` rather than through the bare positive functional mathlib works with. +- `UnitalPositiveLinearMap.gnsCyclicVector` : `Ω_ω`, the image of `1 : A` in `H_ω`, of unit norm + (`norm_gnsCyclicVector`). +- `UnitalPositiveLinearMap.inner_gnsCyclicVector_gnsRep_gnsCyclicVector` : the defining identity + `ω(a) = ⟪Ω_ω, π_ω(a) Ω_ω⟫`. +- `UnitalPositiveLinearMap.denseRange_gnsRep_gnsCyclicVector` : `Ω_ω` is cyclic — `π_ω(A) Ω_ω` is + dense in `H_ω`. +- `UnitalPositiveLinearMap.IsFaithful`, `UnitalPositiveLinearMap.injective_gnsRep_of_isFaithful` : a + faithful state gives an injective (hence genuinely faithful) representation `π_ω`. + +-/ + +@[expose] public section +open scoped ComplexOrder InnerProductSpace +open Complex ContinuousLinearMap UniformSpace Completion + +variable {A : Type*} [CStarAlgebra A] [PartialOrder A] [StarOrderedRing A] + +namespace UnitalPositiveLinearMap + +variable (ω : 𝓢[A]) + +/-- The GNS Hilbert space `H_ω` carried by a state `ω` on a unital C⋆-algebra: the Hilbert space +completion of `A` with respect to the (semi-)inner product `⟨x, y⟩ := ω(x⋆y)`. -/ +noncomputable abbrev GNS := ω.toPositiveLinearMap.GNS + +/-- The GNS representation `π_ω : A → B(H_ω)` carried by a state `ω`: the unital +`⋆`-homomorphism into the bounded operators on `ω.GNS` induced by left multiplication. -/ +noncomputable abbrev gnsRep : A →⋆ₐ[ℂ] (ω.GNS →L[ℂ] ω.GNS) := ω.toPositiveLinearMap.gnsStarAlgHom + +/-- The GNS cyclic vector `Ω_ω ∈ H_ω`: the image of `1 : A` under `A → ω.GNS`. -/ +noncomputable def gnsCyclicVector : ω.GNS := + ((ω.toPositiveLinearMap.toPreGNS 1 : ω.toPositiveLinearMap.PreGNS) : ω.GNS) + +/-- `π_ω(a) Ω_ω` is, concretely, the image of `a` itself under `A → ω.GNS` — since +`π_ω(a) Ω_ω = π_ω(a) · (\text{image of } 1) = \text{image of } (a \cdot 1) = \text{image of } a`. -/ +theorem gnsRep_gnsCyclicVector (a : A) : + ω.gnsRep a ω.gnsCyclicVector = + ((ω.toPositiveLinearMap.toPreGNS a : ω.toPositiveLinearMap.PreGNS) : ω.GNS) := by + show ω.toPositiveLinearMap.gnsStarAlgHom a + ((ω.toPositiveLinearMap.toPreGNS 1 : ω.toPositiveLinearMap.PreGNS) : ω.GNS) = _ + rw [PositiveLinearMap.gnsStarAlgHom_apply] + show ω.toPositiveLinearMap.gnsNonUnitalStarAlgHom a + ((ω.toPositiveLinearMap.toPreGNS 1 : ω.toPositiveLinearMap.PreGNS) : ω.GNS) = _ + rw [PositiveLinearMap.gnsNonUnitalStarAlgHom_apply_coe, PositiveLinearMap.leftMulMapPreGNS_apply, + PositiveLinearMap.ofPreGNS_toPreGNS, mul_one] + +/-- `Ω_ω` has unit norm: `‖Ω_ω‖² = ω(1⋆1) = ω(1) = 1`. -/ +@[simp] +theorem norm_gnsCyclicVector : ‖ω.gnsCyclicVector‖ = 1 := by + have hsq : ((‖ω.gnsCyclicVector‖ ^ 2 : ℝ) : ℂ) = 1 := by + rw [Complex.ofReal_pow] + show (‖(_ : ω.toPositiveLinearMap.GNS)‖ : ℂ) ^ 2 = 1 + rw [gnsCyclicVector, UniformSpace.Completion.norm_coe, + PositiveLinearMap.preGNS_norm_sq, PositiveLinearMap.ofPreGNS_toPreGNS, star_one, one_mul, + UnitalPositiveLinearMap.coe_toPositiveLinearMap, map_one] + have hsq' : ‖ω.gnsCyclicVector‖ ^ 2 = 1 := by exact_mod_cast hsq + nlinarith [norm_nonneg ω.gnsCyclicVector] + +/-- The defining identity of the GNS construction: `ω` is recovered as the vector state of `π_ω` +at the cyclic vector `Ω_ω`. -/ +theorem inner_gnsCyclicVector_gnsRep_gnsCyclicVector (a : A) : + ⟪ω.gnsCyclicVector, ω.gnsRep a ω.gnsCyclicVector⟫_ℂ = ω a := by + rw [gnsRep_gnsCyclicVector, gnsCyclicVector, UniformSpace.Completion.inner_coe, + PositiveLinearMap.preGNS_inner_def, PositiveLinearMap.ofPreGNS_toPreGNS, + PositiveLinearMap.ofPreGNS_toPreGNS, star_one, one_mul, + UnitalPositiveLinearMap.coe_toPositiveLinearMap] + +/-- `Ω_ω` is cyclic: the orbit `π_ω(A) Ω_ω` is dense in `H_ω`, so every vector in `H_ω` is a limit +of vectors reachable from `Ω_ω` by applying elements of `A`. -/ +theorem denseRange_gnsRep_gnsCyclicVector : + DenseRange (fun a : A => ω.gnsRep a ω.gnsCyclicVector) := by + have heq : (fun a : A => ω.gnsRep a ω.gnsCyclicVector) = + (fun a : A => ((ω.toPositiveLinearMap.toPreGNS a : + ω.toPositiveLinearMap.PreGNS) : ω.GNS)) := funext (gnsRep_gnsCyclicVector ω) + rw [heq] + have hden : DenseRange (((↑) : ω.toPositiveLinearMap.PreGNS → ω.GNS)) := + UniformSpace.Completion.denseRange_coe + have hbij : Function.Bijective ω.toPositiveLinearMap.toPreGNS := + ω.toPositiveLinearMap.toPreGNS.toEquiv.bijective + have : (fun a : A => ((ω.toPositiveLinearMap.toPreGNS a : + ω.toPositiveLinearMap.PreGNS) : ω.GNS)) = + ((↑) : ω.toPositiveLinearMap.PreGNS → ω.GNS) ∘ ω.toPositiveLinearMap.toPreGNS := rfl + rw [this] + exact hden.comp (Function.Surjective.denseRange hbij.surjective) + (UniformSpace.Completion.continuous_coe _) + +/-- A state is **faithful** when only `0` gives `x⋆x` weight `0` — the standard notion of a +faithful state on a C⋆-algebra, and the hypothesis under which the GNS representation `π_ω` +becomes injective. -/ +def IsFaithful (ω : 𝓢[A]) : Prop := ∀ x : A, ω (star x * x) = 0 → x = 0 + +/-- A faithful state's GNS representation `π_ω` is injective: `π_ω` genuinely embeds `A` into +`B(H_ω)` rather than merely mapping into it. -/ +theorem injective_gnsRep_of_isFaithful (h : ω.IsFaithful) : Function.Injective ω.gnsRep := by + have key : ∀ a : A, ω.gnsRep a = 0 → a = 0 := by + intro a ha + apply h + have hzero : ω.gnsRep a ω.gnsCyclicVector = 0 := by rw [ha]; rfl + rw [gnsRep_gnsCyclicVector] at hzero + have hnorm : ‖(ω.toPositiveLinearMap.toPreGNS a : ω.toPositiveLinearMap.PreGNS)‖ = 0 := by + have := congrArg norm hzero + rwa [UniformSpace.Completion.norm_coe, norm_zero] at this + have hsq : ((‖(ω.toPositiveLinearMap.toPreGNS a : ω.toPositiveLinearMap.PreGNS)‖ ^ 2 : ℝ) : + ℂ) = 0 := by + rw [hnorm]; norm_num + rw [Complex.ofReal_pow, PositiveLinearMap.preGNS_norm_sq, PositiveLinearMap.ofPreGNS_toPreGNS] + at hsq + rwa [UnitalPositiveLinearMap.coe_toPositiveLinearMap] at hsq + intro a b hab + have hz : ω.gnsRep (a - b) = 0 := by rw [map_sub, hab, sub_self] + exact sub_eq_zero.mp (key _ hz) + +end UnitalPositiveLinearMap diff --git a/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/Jordan.lean b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/Jordan.lean new file mode 100644 index 0000000000..330aa106e7 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/Jordan.lean @@ -0,0 +1,186 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.Basic +public import PhyslibAlpha.AlgebraicFramework.StarAlgebra.Jordan +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.OrderUnit + +/-! + +# The canonical JB-algebra of self-adjoint Cstar elements + +## i. Overview + +This is the payoff of the whole `JordanOrderUnit`/`JB` layer: for any unital C⋆-algebra `A`, +`selfAdjoint A` is a genuine JB-algebra, with the *physically normalized* Jordan product +$$ a \circ b := \tfrac12 (ab + ba), $$ +matching the textbook convention exactly. The multiplication and real Jordan-algebra instances +are inherited directly from `StarAlgebra/Jordan.lean`; this file adds only the genuinely +C⋆-specific order and norm compatibility. The normalization is exactly what makes +`quadRep a b = a b a` below come out on the nose, and what makes the Jordan square `a ∘ a` equal +the *ordinary* square `a * a`, matching `moment`/`variance`'s physical meaning). + +The algebraic product is activated by `open scoped selfAdjoint`; the stronger order/JB instances +remain scoped to `JB` so users can request the analytic structure separately. + +## ii. Key definitions and results + +- `selfAdjoint.instNonUnitalNonAssocCommRing`, `selfAdjoint.instIsCommJordan` +- `JB.instIsJordanOrderUnit`, `JB.instJBAlgebra` +- `JB.quadRep_eq_conj` : `U_a(b) = a b a` +- `JB.mul_self_eq` : the Jordan square agrees with the ordinary square +- `JB.isJordanProjection_iff_isIdempotentElem` : Jordan projections are exactly the ordinary ones + +## iii. Table of contents + +- A. C⋆ order compatibility +- B. The JB-algebra instance +- C. Bridge sanity: squares, `U_a = aba`, projections + +-/ + +@[expose] public section + +namespace JB + +variable {A : Type*} [CStarAlgebra A] [PartialOrder A] [StarOrderedRing A] + +open scoped selfAdjoint + +/-! ## A. C⋆ order compatibility -/ + +omit [PartialOrder A] [StarOrderedRing A] in +theorem one_mul (a : selfAdjoint A) : (1 : selfAdjoint A) * a = a := by + apply Subtype.ext + rw [selfAdjoint.mul_def, selfAdjoint.val_jordanMul] + show (2 : ℝ)⁻¹ • ((1 : A) * (a : A) + (a : A) * (1 : A)) = (a : A) + rw [_root_.one_mul, _root_.mul_one, ← two_smul ℝ (a : A), smul_smul, + inv_mul_cancel₀ (two_ne_zero), one_smul] + +omit [PartialOrder A] [StarOrderedRing A] in +/-- The Jordan square of a self-adjoint element, for the normalized product, is exactly its +ordinary (associative) square. This is the reason `moment`/`variance` computed via the abstract +`IsJordanOrderUnit` layer agree with the operator-theoretic ones. -/ +theorem mul_self_eq (a : selfAdjoint A) : ((a * a : selfAdjoint A) : A) = (a : A) * (a : A) := by + rw [selfAdjoint.mul_def, selfAdjoint.val_jordanMul, ← two_smul ℝ ((a:A)*(a:A)), smul_smul, + inv_mul_cancel₀ (two_ne_zero), one_smul] + +theorem mul_self_nonneg (a : selfAdjoint A) : 0 ≤ a * a := by + show (0 : A) ≤ ((a * a : selfAdjoint A) : A) + rw [mul_self_eq] + calc (0 : A) ≤ star (a : A) * (a : A) := star_mul_self_nonneg _ + _ = (a : A) * (a : A) := by rw [a.2] + +scoped instance instIsJordanOrderUnit : IsJordanOrderUnit (selfAdjoint A) where + mul_self_nonneg := mul_self_nonneg + +/-! ## B. The JB-algebra instance -/ + +omit [PartialOrder A] [StarOrderedRing A] in +theorem norm_mul_le' (a b : selfAdjoint A) : ‖a * b‖ ≤ ‖a‖ * ‖b‖ := by + show ‖((a * b : selfAdjoint A) : A)‖ ≤ ‖(a : A)‖ * ‖(b : A)‖ + rw [selfAdjoint.mul_def, selfAdjoint.val_jordanMul, norm_smul] + calc ‖(2 : ℝ)⁻¹‖ * ‖(a : A) * (b : A) + (b : A) * (a : A)‖ + ≤ ‖(2 : ℝ)⁻¹‖ * (‖(a : A) * (b : A)‖ + ‖(b : A) * (a : A)‖) := by + gcongr; exact norm_add_le _ _ + _ ≤ ‖(2 : ℝ)⁻¹‖ * (‖(a : A)‖ * ‖(b : A)‖ + ‖(b : A)‖ * ‖(a : A)‖) := by + gcongr <;> exact _root_.norm_mul_le _ _ + _ = ‖(a : A)‖ * ‖(b : A)‖ := by + rw [Real.norm_eq_abs, abs_of_pos (by norm_num : (0:ℝ) < 2⁻¹)]; ring + +/-- The self-adjoint part carries one coherent normed Jordan structure inherited from the ambient +Cstar algebra. -/ +noncomputable scoped instance instNormedJordanAlgebra : NormedJordanAlgebra (selfAdjoint A) where + __ := selfAdjoint.instNonAssocCommRing + __ := (inferInstance : Norm (selfAdjoint A)) + __ := (inferInstance : MetricSpace (selfAdjoint A)) + __ := (inferInstance : Module ℝ (selfAdjoint A)) + dist_eq := NormedAddCommGroup.dist_eq + norm_smul_le := NormedSpace.norm_smul_le + smul_comm := fun c a b => (selfAdjoint.jordanMul_smul_right a c b).symm + smul_assoc := selfAdjoint.jordanMul_smul_left + jordan_identity := selfAdjoint.jordanMul_jordanMul_jordanMul_self + norm_mul_le := norm_mul_le' + +/-- The self-adjoint part of a Cstar algebra is complete because it is the closed fixed-point set +of the continuous star operation. -/ +scoped instance instCompleteSpace : CompleteSpace (selfAdjoint A) := + (isClosed_eq continuous_star continuous_id).completeSpace_coe + +omit [PartialOrder A] [StarOrderedRing A] in +theorem norm_mul_self' (a : selfAdjoint A) : ‖a * a‖ = ‖a‖ ^ 2 := by + show ‖((a * a : selfAdjoint A) : A)‖ = ‖(a : A)‖ ^ 2 + rw [mul_self_eq] + exact IsSelfAdjoint.norm_mul_self a.2 + +theorem norm_mul_self_le_add' (a b : selfAdjoint A) : ‖a * a‖ ≤ ‖a * a + b * b‖ := by + show ‖((a * a : selfAdjoint A) : A)‖ ≤ ‖((a * a + b * b : selfAdjoint A) : A)‖ + rw [mul_self_eq] + have hab : ((a * a + b * b : selfAdjoint A) : A) = (a : A) * (a : A) + (b : A) * (b : A) := by + rw [AddSubgroup.coe_add, mul_self_eq, mul_self_eq] + rw [hab] + have h0 : (0 : A) ≤ (b : A) * (b : A) := by + calc (0 : A) ≤ star (b : A) * (b : A) := star_mul_self_nonneg _ + _ = (b : A) * (b : A) := by rw [b.2] + have h0' : (0 : A) ≤ (a : A) * (a : A) := by + calc (0 : A) ≤ star (a : A) * (a : A) := star_mul_self_nonneg _ + _ = (a : A) * (a : A) := by rw [a.2] + exact CStarAlgebra.norm_le_norm_of_nonneg_of_le h0' (le_add_of_nonneg_right h0) + +/-- `selfAdjoint A`, for any unital C⋆-algebra `A`, is a JB-algebra under the normalized Jordan +product: the canonical realization at the head of the architecture + +`AOU → JordanOrderUnit → JB → JBW (later)`, `C*-algebra A ↦ Aₛₐ as a JB-algebra`. -/ +scoped instance instJBAlgebra : JBAlgebra (selfAdjoint A) where + __ := instCompleteSpace + norm_mul_self := norm_mul_self' + norm_mul_self_le_add := norm_mul_self_le_add' + +/-! ## C. Concrete realization identities: squares, `U_a = aba`, projections -/ + +open scoped JordanAlgebra + +omit [PartialOrder A] [StarOrderedRing A] in +/-- **Realization identity, the headline formula**: the abstract quadratic representation +`U_a = 2 L_a^2 - L_{a^2}` from `Operator.lean`, instantiated at the canonical JB realization, is +literally two-sided conjugation `U_a(b) = a b a`. -/ +theorem quadRep_eq_conj (a b : selfAdjoint A) : + ((JordanAlgebra.quadRep a b : selfAdjoint A) : A) = (a : A) * (b : A) * (a : A) := by + have key : (a:A)*((a:A)*(b:A)+(b:A)*(a:A)) + ((a:A)*(b:A)+(b:A)*(a:A))*(a:A) + - ((a:A)*(a:A)*(b:A) + (b:A)*((a:A)*(a:A))) = (2:A) * ((a:A)*(b:A)*(a:A)) := by + noncomm_ring + have hc : (2:ℝ) * (2:ℝ)⁻¹ * (2:ℝ)⁻¹ = (2:ℝ)⁻¹ := by norm_num + have hsum : (2:ℝ)⁻¹ + (2:ℝ)⁻¹ = 1 := by norm_num + have hsq : (2 : ℝ)⁻¹ • ((a : A) * (a : A) + (a : A) * (a : A)) = + (a : A) * (a : A) := by + rw [← two_smul ℝ ((a : A) * (a : A)), smul_smul, + inv_mul_cancel₀ (two_ne_zero), one_smul] + rw [JordanAlgebra.quadRep_apply, AddSubgroup.coe_sub, selfAdjoint.val_smul, + JordanAlgebra.jpow_two] + simp only [selfAdjoint.coe_mul] + rw [hsq, mul_smul_comm, smul_mul_assoc, ← smul_add, smul_smul, smul_smul, hc, ← smul_sub, + key, two_mul, smul_add, ← add_smul, hsum, one_smul] + +omit [PartialOrder A] [StarOrderedRing A] in +/-- **Realization identity**: a Jordan projection for the normalized product is exactly an ordinary +idempotent, `p² = p`. -/ +theorem isJordanProjection_iff_isIdempotentElem {p : selfAdjoint A} : + JordanAlgebra.IsJordanProjection p ↔ IsIdempotentElem (p : A) := by + unfold JordanAlgebra.IsJordanProjection IsIdempotentElem + rw [← mul_self_eq, Subtype.ext_iff] + +omit [PartialOrder A] [StarOrderedRing A] in +/-- **Realization identity**: Jordan orthogonality for the normalized product is exactly ordinary +operator orthogonality `p q = 0`. -/ +theorem jordanOrthogonal_iff {p q : selfAdjoint A} : + JordanAlgebra.JordanOrthogonal p q ↔ (p : A) * (q : A) + (q : A) * (p : A) = 0 := by + unfold JordanAlgebra.JordanOrthogonal + rw [Subtype.ext_iff, selfAdjoint.mul_def, selfAdjoint.val_jordanMul, AddSubgroup.coe_zero, + smul_eq_zero] + simp [(by norm_num : (2:ℝ)⁻¹ ≠ 0)] + +end JB diff --git a/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/JordanCFC.lean b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/JordanCFC.lean new file mode 100644 index 0000000000..ff4bed2bae --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/JordanCFC.lean @@ -0,0 +1,104 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Mathlib.Analysis.CStarAlgebra.ContinuousFunctionalCalculus.Commute +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.Jordan + +/-! +# Continuous functional calculus for Cstar Jordan observables + +This is the realization-specific CFC boundary. An abstract JB-algebra does not yet have the real +Gelfand/complexification theorem needed to construct its one-generator calculus; see +`JordanOrderUnit/JB/GeneratedByOne/CFC_AUDIT.md`. A self-adjoint element of a Cstar algebra does +have Mathlib's real isometric CFC. This file simply packages that existing construction with +codomain `selfAdjoint A`, so its output is a Jordan observable by construction. + +The definition is deliberately not imported by abstract Jordan/JB files. +-/ + +@[expose] public section + +namespace JB + +variable {A : Type*} [CStarAlgebra A] + +open scoped selfAdjoint + +/-- The real continuous functional calculus of a self-adjoint Cstar element, packaged into the +Jordan algebra of observables. This is a specialization of Mathlib's `cfcHom`, not a second CFC +construction. Its codomain is deliberately a linear map: the observable Jordan product is +nonassociative globally, so an `AlgHom` into it would state the wrong structure. -/ +noncomputable def jordanCfc (a : selfAdjoint A) : + C(spectrum ℝ (a : A), ℝ) →ₗ[ℝ] selfAdjoint A where + toFun f := ⟨cfcHom a.property f, cfcHom_predicate a.property f⟩ + map_add' f g := by + ext + exact map_add (cfcHom a.property) f g + map_smul' c f := by + ext + exact map_smul (cfcHom a.property) c f + +/-- The coordinate function is sent to the original Jordan observable. -/ +@[simp] +theorem jordanCfc_id (a : selfAdjoint A) : + jordanCfc a ((ContinuousMap.id ℝ).restrict (spectrum ℝ (a : A))) = a := by + ext + exact cfcHom_id (p := IsSelfAdjoint) a.property + +/-- The concrete Jordan CFC is isometric. -/ +theorem norm_jordanCfc (a : selfAdjoint A) (f : C(spectrum ℝ (a : A), ℝ)) : + ‖jordanCfc a f‖ = ‖f‖ := by + change ‖cfcHom (p := IsSelfAdjoint) a.property f‖ = ‖f‖ + exact norm_cfcHom (p := IsSelfAdjoint) (a : A) f a.property + +/-- Although `jordanCfc` is packaged as a linear map, its values commute because its source is +commutative. Hence it preserves the Jordan product exactly. -/ +theorem jordanCfc_mul (a : selfAdjoint A) (f g : C(spectrum ℝ (a : A), ℝ)) : + jordanCfc a (f * g) = jordanCfc a f * jordanCfc a g := by + have hcomm : cfcHom (p := IsSelfAdjoint) a.property f * + cfcHom (p := IsSelfAdjoint) a.property g = + cfcHom (p := IsSelfAdjoint) a.property g * cfcHom (p := IsSelfAdjoint) a.property f := by + rw [← map_mul, ← map_mul, mul_comm] + ext + rw [selfAdjoint.mul_def, selfAdjoint.val_jordanMul] + change cfcHom (p := IsSelfAdjoint) a.property (f * g) = + (2 : ℝ)⁻¹ • (cfcHom (p := IsSelfAdjoint) a.property f * + cfcHom (p := IsSelfAdjoint) a.property g + + cfcHom (p := IsSelfAdjoint) a.property g * cfcHom (p := IsSelfAdjoint) a.property f) + rw [map_mul, ← hcomm, ← two_smul ℝ (cfcHom (p := IsSelfAdjoint) a.property f * + cfcHom (p := IsSelfAdjoint) a.property g), smul_smul, inv_mul_cancel₀ (by norm_num), one_smul] + +/-- Every continuous function of an observable commutes with that observable in its ambient Cstar +algebra. Thus the one-variable calculus lands in the compatible Jordan fragment generated by +the observable. -/ +theorem jordanCfc_commute (a : selfAdjoint A) (f : C(spectrum ℝ (a : A), ℝ)) : + Commute ((jordanCfc a f : selfAdjoint A) : A) (a : A) := by + change Commute (cfcHom (p := IsSelfAdjoint) a.property f) (a : A) + apply Commute.cfcHom (p := IsSelfAdjoint) a.property (Commute.refl _) + simpa only [a.property.star_eq] using (Commute.refl (a : A)) + +section Order + +variable [PartialOrder A] [StarOrderedRing A] + +/-- A nonnegative continuous function of a Jordan observable is nonnegative. -/ +theorem jordanCfc_nonneg (a : selfAdjoint A) {f : C(spectrum ℝ (a : A), ℝ)} (hf : 0 ≤ f) : + 0 ≤ jordanCfc a f := by + change (0 : A) ≤ cfcHom (p := IsSelfAdjoint) a.property f + have h := cfcHom_mono (p := IsSelfAdjoint) a.property + (f := (0 : C(spectrum ℝ (a : A), ℝ))) (g := f) hf + simpa using h + +/-- The concrete Jordan continuous functional calculus is order-preserving. -/ +theorem jordanCfc_monotone (a : selfAdjoint A) : Monotone (jordanCfc a) := by + intro f g hfg + change cfcHom (p := IsSelfAdjoint) a.property f ≤ cfcHom (p := IsSelfAdjoint) a.property g + exact cfcHom_mono (p := IsSelfAdjoint) a.property hfg + +end Order + +end JB diff --git a/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/JordanCompatibility.lean b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/JordanCompatibility.lean new file mode 100644 index 0000000000..a8bd21b3a0 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/JordanCompatibility.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Compatibility +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.Jordan + +/-! + +# Jordan compatibility of commuting self-adjoint elements + +## i. Overview + +The sanity check for `Compatibility.lean`'s Jordan-intrinsic notion: for `a`, `b` self-adjoint +elements of a C⋆-algebra `A` that already commute in the ordinary associative sense (`ab = ba`), +their multiplication operators for the *Jordan* product also commute — `a` and `b` are +`IsJordanCompatible`. This is a genuine algebraic computation (not a restatement), using +associativity of `A` and the hypothesis `ab = ba` directly, no linearized Jordan identity needed. + +Proof idea: writing `L_a x = ½(ax+xa)`, expand both `a ∘ (b ∘ x)` and `b ∘ (a ∘ x)` into the four +terms `abx`, `axb`, `bxa`, `xba` (respectively `bax`, `bxa`, `axb`, `xab`), and check the two +expansions agree termwise using `ab = ba` (which also gives `xba = xab`, `bax = abx`) — a pure +associative-ring computation. + +## ii. Key definitions and results + +- `JB.isJordanCompatible_of_commute` + +## iii. Table of contents + +- A. The bridge theorem + +-/ + +@[expose] public section + +namespace JB + +variable {A : Type*} [CStarAlgebra A] [PartialOrder A] [StarOrderedRing A] + +open scoped selfAdjoint + +/-! ## A. The bridge theorem -/ + +omit [PartialOrder A] [StarOrderedRing A] in +/-- **Bridge sanity for compatibility.** If `a` and `b` commute in the ordinary associative sense, +they are Jordan-compatible: their Jordan multiplication operators commute. -/ +theorem isJordanCompatible_of_commute {a b : selfAdjoint A} + (hcomm : (a : A) * (b : A) = (b : A) * (a : A)) : + JordanAlgebra.IsJordanCompatible a b := by + apply LinearMap.ext + intro x + change selfAdjoint.jordanMul a (selfAdjoint.jordanMul b x) = + selfAdjoint.jordanMul b (selfAdjoint.jordanMul a x) + rw [selfAdjoint.jordanMul_jordanMul_right, selfAdjoint.jordanMul_jordanMul_right] + congr 1 + apply Subtype.ext + simp only [selfAdjoint.coe_anticommutator] + have e1 : (a:A) * ((b:A)*(x:A)) = (b:A) * ((a:A)*(x:A)) := by + rw [← mul_assoc, hcomm, mul_assoc] + have e2 : (a:A) * ((x:A)*(b:A)) = ((a:A)*(x:A)) * (b:A) := (mul_assoc _ _ _).symm + have e3 : ((b:A)*(x:A)) * (a:A) = (b:A) * ((x:A)*(a:A)) := mul_assoc _ _ _ + have e4 : ((x:A)*(b:A)) * (a:A) = ((x:A)*(a:A)) * (b:A) := by + rw [mul_assoc, ← hcomm, ← mul_assoc] + rw [_root_.mul_add, _root_.add_mul, _root_.mul_add, _root_.add_mul, e1, e2, e3, e4] + abel + +end JB diff --git a/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/JordanDecomposition.lean b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/JordanDecomposition.lean new file mode 100644 index 0000000000..4a4b8bbda1 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/JordanDecomposition.lean @@ -0,0 +1,104 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.StarAlgebra.Observable +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.OrderUnit +public import Mathlib.Analysis.SpecialFunctions.ContinuousFunctionalCalculus.PosPart.Basic +public import Mathlib.Analysis.SpecialFunctions.ContinuousFunctionalCalculus.Rpow.Basic + +/-! + +# The Jordan decomposition of a self-adjoint element + +Every self-adjoint element `a` of a C⋆-algebra splits canonically as `a = a⁺ - a⁻`, a difference of +two *orthogonal* positive elements (`a⁺ * a⁻ = 0`) — the noncommutative analogue of splitting a +real-valued function into its positive and negative parts, or a signed measure into its positive +and negative variation (Camille Jordan's decomposition theorem, 1881/1892). This is not the same +"Jordan" as `StarAlgebra/Jordan.lean`'s Jordan *product* `a ∘ b := a * b + b * a` — that one is +named for Pascual Jordan, no relation, and the shared name is an unfortunate but standard clash in +the operator-algebra literature. + +Mathlib already builds `a⁺`, `a⁻` from the continuous functional calculus (`cfcₙ` applied to the +functions `t ↦ max t 0` and `t ↦ max (-t) 0`) and proves the decomposition, orthogonality, and +uniqueness facts at the level of a bare C⋆-algebra element. This file packages exactly those facts +one level up, at the level of `Observable A := selfAdjoint A` and `PositiveObservable A`, so that +"take the positive/negative part" is available as an operation *on observables*, landing in +`PositiveObservable A` rather than requiring the caller to separately track self-adjointness and +nonnegativity of a bare element of `A` after the fact. + +Genuinely needing a full C⋆-algebra here (rather than a bare order-unit space) is not a corner that +was cut: the continuous functional calculus behind `a⁺`, `a⁻` needs completeness and the +C⋆-identity to exist at all, so `[CStarAlgebra A] [PartialOrder A] [StarOrderedRing A]` is the +correct, load-bearing hypothesis, not one to weaken. + +## Main definitions + +- `Observable.posPart`, `Observable.negPart` : the positive and negative parts of an observable, as + `PositiveObservable A`. +- `Observable.posPart_sub_negPart` : `a⁺ - a⁻ = a`. +- `Observable.posPart_mul_negPart`, `Observable.negPart_mul_posPart` : the two parts are orthogonal. +- `Observable.posPart_negPart_unique` : this is the *only* decomposition of `a` into a difference of + orthogonal positive observables. + +-/ + +@[expose] public section + +variable {A : Type*} [CStarAlgebra A] [PartialOrder A] [StarOrderedRing A] + +namespace Observable + +/-! ## A. Positive observables -/ + +/-- An observable is positive exactly when it is the square of an observable. -/ +lemma nonneg_iff_exists_observable_sq (a : Observable A) : + 0 ≤ (a : A) ↔ ∃ b : Observable A, (a : A) = (b : A) * b := by + constructor + · intro ha + obtain ⟨b, hb, hab⟩ := + CStarAlgebra.nonneg_iff_exists_isSelfAdjoint_and_eq_mul_self.mp ha + exact ⟨⟨b, hb⟩, hab⟩ + · rintro ⟨b, hab⟩ + exact CStarAlgebra.nonneg_iff_exists_isSelfAdjoint_and_eq_mul_self.mpr + ⟨b, b.property, hab⟩ + +/-! ## B. Positive and negative parts -/ + +/-- The positive part of an observable. -/ +noncomputable def posPart (a : Observable A) : PositiveObservable A := + ⟨⟨(a : A)⁺, CFC.posPart_nonneg (a : A) |>.isSelfAdjoint⟩, CFC.posPart_nonneg (a : A)⟩ + +/-- The negative part of an observable. -/ +noncomputable def negPart (a : Observable A) : PositiveObservable A := + ⟨⟨(a : A)⁻, CFC.negPart_nonneg (a : A) |>.isSelfAdjoint⟩, CFC.negPart_nonneg (a : A)⟩ + +/-- Every observable is the difference of its positive and negative parts. -/ +lemma posPart_sub_negPart (a : Observable A) : + (posPart a).1 - (negPart a).1 = a := by + apply Subtype.ext + exact CFC.posPart_sub_negPart (a : A) a.property + +/-- The positive and negative parts of an observable are orthogonal. -/ +lemma posPart_mul_negPart (a : Observable A) : + ((posPart a).1 : A) * (negPart a).1 = 0 := + CFC.posPart_mul_negPart (a : A) + +/-- The negative and positive parts are orthogonal in the opposite order as well. -/ +lemma negPart_mul_posPart (a : Observable A) : + ((negPart a).1 : A) * (posPart a).1 = 0 := + CFC.negPart_mul_posPart (a : A) + +/-- The positive/negative decomposition is the unique decomposition into orthogonal positive +observables: this is the Jordan decomposition theorem. -/ +lemma posPart_negPart_unique (a : Observable A) (b c : PositiveObservable A) + (hsub : (a : A) = (b.1 : A) - c.1) + (horth : (b.1 : A) * c.1 = 0) : + posPart a = b ∧ negPart a = c := by + obtain ⟨hb, hc⟩ := CFC.posPart_negPart_unique hsub horth b.property c.property + exact ⟨Subtype.ext (Subtype.ext hb), Subtype.ext (Subtype.ext hc)⟩ + +end Observable diff --git a/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/JordanPositivity.lean b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/JordanPositivity.lean new file mode 100644 index 0000000000..be6ab09ff6 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/JordanPositivity.lean @@ -0,0 +1,102 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.Jordan +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.JordanDecomposition +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Conditioning + +/-! + +# Jordan positivity and decomposition in a Cstar algebra + +## i. Overview + +The exact cone theorem `a ≥ 0 ⟺ ∃ b, a = b²` and the decomposition +`a = a₊ - a₋` with `a₊ ∘ a₋ = 0` are already available for the canonical realization: +`CStarAlgebra/JordanDecomposition.lean` has `Observable.nonneg_iff_exists_observable_sq`, +`Observable.posPart`/`Observable.negPart`, `Observable.posPart_sub_negPart`, and +`Observable.posPart_mul_negPart`/`.negPart_mul_posPart` — using the *ordinary* associative square +and product, since it predates the Jordan layer. This file is the two-line connection to +the Jordan-native statements, using `mul_self_eq` from `CStarAlgebra/Jordan.lean` (the Jordan +square of a single element is the ordinary square) and ordinary two-sided vanishing to obtain +Jordan orthogonality. + +Square roots, `|a|`, and the CFC-based characterization `a ≥ 0 ⟺ σ(a) ⊆ [0,∞)` are not attempted +here: their abstract versions require the single-observable JB functional calculus. They remain on +that analytic path rather than being duplicated as realization-specific constructions. + +## ii. Key definitions and results + +- `JB.nonneg_iff_exists_jpow_two` +- `JB.jordanOrthogonal_posPart_negPart` + +## iii. Table of contents + +- A. Positivity via the Jordan square +- B. Orthogonality of the Jordan decomposition + +-/ + +@[expose] public section + +namespace JB + +variable {A : Type*} [CStarAlgebra A] [PartialOrder A] [StarOrderedRing A] + +open scoped selfAdjoint +open scoped JB + +/-! ## A. Positivity via the Jordan square -/ + +/-- An observable is positive exactly when it is the Jordan square of an observable — the Jordan +form of `Observable.nonneg_iff_exists_observable_sq`, via `mul_self_eq` identifying the Jordan +square of a single element with its ordinary square. -/ +theorem nonneg_iff_exists_jpow_two (a : selfAdjoint A) : + 0 ≤ (a : A) ↔ + ∃ b : selfAdjoint A, (a : A) = ((JordanAlgebra.jpow b 2 : selfAdjoint A) : A) := by + rw [Observable.nonneg_iff_exists_observable_sq] + refine exists_congr fun b => ?_ + rw [JordanAlgebra.jpow_two, mul_self_eq] + +/-- Quadratic representation preserves positivity in the canonical Cstar Jordan realization. +This is the concrete source of the positivity hypothesis used by abstract projection +conditioning: `U_a(b) = aba = a* b a` because `a` is self-adjoint, and positive cones are closed +under star-conjugation. -/ +theorem quadRep_nonneg (a : selfAdjoint A) {b : selfAdjoint A} (hb : 0 ≤ b) : + 0 ≤ JordanAlgebra.quadRep a b := by + show (0 : A) ≤ ((JordanAlgebra.quadRep a b : selfAdjoint A) : A) + rw [quadRep_eq_conj] + simpa only [a.2.star_eq] using + star_left_conjugate_nonneg (show (0 : A) ≤ (b : A) from hb) (a : A) + +/-- The canonical self-adjoint Cstar realization supplies the abstract quadratic-order +capability. Thus generic Jordan measurement code can use `U_a` as a positive operation without +depending on this realization; this instance is only the concrete discharge of that capability. -/ +instance : JordanAlgebra.IsQuadraticallyPositive (selfAdjoint A) where + quadRep_nonneg := quadRep_nonneg + +/-- Projection conditioning in the canonical Cstar Jordan realization. In contrast to the +abstract constructor, no separate quadratic-positivity argument is required: it is supplied by +the shared `IsQuadraticallyPositive` instance. -/ +noncomputable def JordanAlgebra.IsJordanProjection.conditionCStar {p : selfAdjoint A} + (hp : JordanAlgebra.IsJordanProjection p) (ω : 𝓢[ℝ, selfAdjoint A]) (hmass : 0 < ω p) : + 𝓢[ℝ, selfAdjoint A] := + hp.conditionOfQuadraticPositive ω hmass + +/-! ## B. Orthogonality of the Jordan decomposition -/ + +/-- The positive and negative parts of an observable are Jordan-orthogonal, `a₊ ∘ a₋ = 0`: the +Jordan form of `Observable.posPart_mul_negPart`/`.negPart_mul_posPart`. -/ +theorem jordanOrthogonal_posPart_negPart (a : selfAdjoint A) : + JordanAlgebra.JordanOrthogonal (Observable.posPart a).1 (Observable.negPart a).1 := by + unfold JordanAlgebra.JordanOrthogonal + apply Subtype.ext + rw [selfAdjoint.mul_def, selfAdjoint.val_jordanMul, Observable.posPart_mul_negPart, + Observable.negPart_mul_posPart] + simp + +end JB diff --git a/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/JordanSpecial.lean b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/JordanSpecial.lean new file mode 100644 index 0000000000..0615d30a17 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/JordanSpecial.lean @@ -0,0 +1,89 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.Jordan +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.Order + +/-! + +# Special JB-algebras and C⋆-realizations + +Specialness is a representation property: an abstract JB-algebra is special when it embeds as a +norm-closed unital Jordan subalgebra of the self-adjoint part of a C⋆-algebra. Consequently this +file belongs to the concrete realization branch, while the abstract JB hierarchy remains free of +C⋆ imports. The embedding is linear, isometric, unital, multiplicative for the Jordan product, +and has closed range. + +-/ + +@[expose] public section + +open scoped JB selfAdjoint + +/-- A witness that `E` is special: an isometric unital Jordan embedding into the self-adjoint part +of a Cstar algebra whose range is norm closed. -/ +structure JBAlgebra.IsSpecialWitness (E : Type*) [NormedJordanAlgebra E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] + [JBAlgebra E] (A : Type*) [CStarAlgebra A] [PartialOrder A] [StarOrderedRing A] where + /-- The underlying injective isometric real-linear map. -/ + toLinearIsometry : E →ₗᵢ[ℝ] selfAdjoint A + /-- The order unit is preserved. -/ + map_one : toLinearIsometry 1 = 1 + /-- The Jordan product is preserved. -/ + map_mul : ∀ x y : E, toLinearIsometry (x * y) = toLinearIsometry x * toLinearIsometry y + /-- The represented Jordan subalgebra is norm closed. -/ + isClosed_range : IsClosed (Set.range toLinearIsometry) + +/-- `E` is special when it embeds as a closed Jordan subalgebra of the self-adjoint part of a +Cstar algebra in the same universe. -/ +def JBAlgebra.IsSpecial (E : Type u) [NormedJordanAlgebra E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] + [JBAlgebra E] : Prop := + ∃ (A : Type u) (_ : CStarAlgebra A) (_ : PartialOrder A) (_ : StarOrderedRing A), + Nonempty (JBAlgebra.IsSpecialWitness E A) + +namespace JBAlgebra.IsSpecialWitness + +variable {E A : Type*} [NormedJordanAlgebra E] [Nontrivial E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [JBAlgebra E] + [IsJBOrderUnit E] [CStarAlgebra A] [PartialOrder A] [StarOrderedRing A] + +/-- A special-JB embedding preserves positivity. Exact-cone reconstruction supplies a square +witness in the source; multiplicativity carries that witness to a square in the represented +self-adjoint algebra. -/ +theorem map_nonneg (j : JBAlgebra.IsSpecialWitness E A) {x : E} (hx : 0 ≤ x) : + 0 ≤ (j.toLinearIsometry x : selfAdjoint A) := by + obtain ⟨y, hy⟩ := JBAlgebra.nonneg_iff_exists_mul_self x |>.mp hx + rw [← hy, j.map_mul] + exact IsJordanOrderUnit.mul_self_nonneg _ + +/-- A special-JB embedding is order preserving. This is derived from exact cone reconstruction, +not assumed in the definition of specialness. -/ +theorem monotone (j : JBAlgebra.IsSpecialWitness E A) : Monotone j.toLinearIsometry := by + intro x y hxy + rw [← sub_nonneg] + rw [← map_sub] + exact j.map_nonneg (sub_nonneg.mpr hxy) + +end JBAlgebra.IsSpecialWitness + +namespace JB + +variable {A : Type*} [CStarAlgebra A] [PartialOrder A] [StarOrderedRing A] + +/-- The identity equivalence witnesses that `selfAdjoint A` is special in `A` itself. -/ +noncomputable def isSpecialWitnessRefl : JBAlgebra.IsSpecialWitness (selfAdjoint A) A where + toLinearIsometry := LinearIsometry.id + map_one := rfl + map_mul _ _ := rfl + isClosed_range := by simp + +/-- `selfAdjoint A` is special, for any unital C⋆-algebra `A`. -/ +theorem isSpecial_selfAdjoint : JBAlgebra.IsSpecial (selfAdjoint A) := + ⟨A, ‹_›, ‹_›, ‹_›, ⟨isSpecialWitnessRefl⟩⟩ + +end JB diff --git a/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/JordanStatistics.lean b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/JordanStatistics.lean new file mode 100644 index 0000000000..159c57ced4 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/JordanStatistics.lean @@ -0,0 +1,122 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Covariance +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.Jordan +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.SpectralMeasure + +/-! + +# Spectral formulas for Jordan moments + +## i. Overview + +`JB_ROADMAP.md` item 9 asks for the "headline milestone": +$$ (J, \omega, a) \to C_J(a) \to C(\sigma(a), \mathbb R) \to \mu_{\omega,a}, \qquad + \omega(f(a)) = \int f \, d\mu_{\omega,a}. $$ +This file shows that milestone is *already reached* for the canonical realization +`selfAdjoint A`: `CStarAlgebra/SpectralMeasure.lean` already built `μ_{ω,a}` and +`realSpectralMeasure_integral` (`ω(f(a)) = ∫f dμ_{ω,a}`) via mathlib's own continuous functional +calculus and Riesz–Markov–Kakutani — the C⋆-algebra `A` is already associative, so there was never +a need to build `C_J(a)` from scratch there. What was missing is the *connection* to this file's +own Jordan-algebraic `moment`/`variance` API (`Observable.lean`, `Covariance.lean`), which is +defined via the Jordan powers `a^{[n]}` rather than ordinary powers `aⁿ`. + +The connection rests on one clean fact, `jpow_eq_pow`: for the *single* generator `a`, the +Jordan power `a^{[n]}` equals the ordinary associative power `(a:A)ⁿ` — proved directly by +induction from `mul_self_eq`, with **no use of the open `commute_mulLeft_pow` theorem** +(`Power/Associative.lean`). That theorem is about *arbitrary* pairs of Jordan powers commuting as +operators in a general Jordan algebra; here `a` only ever needs to commute with itself, which is +free. This is worth remembering: the single-generator case that item 9 actually needs was never +blocked on the general power-associativity theorem, only the roadmap's abstract, JB-algebra-generic +route to it (`JB/GENERATED_SUBALGEBRA_ROADMAP.md`) was. + +## ii. Key definitions and results + +- `JB.jpow_eq_pow` +- `JB.moment_eq_integral` : `moment n (ω.onObservables) a = ∫ y, y^n ∂(realSpectralMeasure ω a)` +- `JB.variance_eq_integral_sq_sub` : the variance as `∫y² dμ - (∫y dμ)²` + +## iii. Table of contents + +- A. Jordan powers of a single element are ordinary powers +- B. Moments as integrals against the outcome distribution + +-/ + +@[expose] public section + +open scoped ComplexOrder + +namespace JB + +variable {A : Type*} [CStarAlgebra A] [PartialOrder A] [StarOrderedRing A] + +open scoped selfAdjoint + +/-! ## A. Jordan powers of a single element are ordinary powers -/ + +omit [PartialOrder A] [StarOrderedRing A] in +/-- The Jordan power `a^{[n]}` of a single self-adjoint element +equals its ordinary associative power `(a:A)ⁿ`. Unlike the general power-associativity theorem +(`Power/Associative.lean`'s `commute_mulLeft_pow`), this concrete identity follows directly from +self-commutation in the ambient associative algebra. -/ +theorem jpow_eq_pow (a : selfAdjoint A) (n : ℕ) : + ((JordanAlgebra.jpow a n : selfAdjoint A) : A) = (a : A) ^ n := by + induction n with + | zero => simp [JordanAlgebra.jpow_zero] + | succ n ih => + rw [JordanAlgebra.jpow_succ, selfAdjoint.mul_def, selfAdjoint.val_jordanMul, ih] + have hcomm : (a:A) * (a:A) ^ n = (a:A) ^ n * (a:A) := (Commute.refl (a:A)).pow_right n + rw [← hcomm, ← two_smul ℝ ((a:A) * (a:A)^n), smul_smul, + inv_mul_cancel₀ (two_ne_zero (α := ℝ)), one_smul, pow_succ'] + +/-! ## B. Moments as integrals against the outcome distribution -/ + +open MeasureTheory + +/-- **Item 9's headline result, for the canonical realization.** The `n`-th moment of `a` in the +state `ω` (restricted from a state on the whole C⋆-algebra) is `∫ y^n dμ_{ω,a}` — exactly +`m_n(a) = ∫λⁿ dμ_{ω,a}` from `JB_ROADMAP.md`, obtained by specializing +`realSpectralMeasure_integral` to `f = (· ^ n)` and identifying the Jordan power with the ordinary +one via `jpow_eq_pow`. -/ +theorem moment_eq_integral (ω : 𝓢[A]) (a : selfAdjoint A) (n : ℕ) : + IsJordanOrderUnit.moment n ω.onObservables a = + ∫ y, y ^ n ∂(realSpectralMeasure ω a) := by + have hcfc : cfc (fun x : ℝ => x ^ n) (a : A) = (a : A) ^ n := by + rw [cfc_pow (fun x : ℝ => x) n (a : A) continuousOn_id, cfc_id' (R := ℝ) (a := (a : A))] + have hval : ((JordanAlgebra.jpow a n : selfAdjoint A) : A) = + cfc (fun x : ℝ => x ^ n) (a : A) := by rw [jpow_eq_pow, hcfc] + unfold IsJordanOrderUnit.moment + rw [show (JordanAlgebra.jpow a n : Observable A) = + ⟨cfc (fun x : ℝ => x ^ n) (a : A), cfc_predicate (R := ℝ) _ (a : A)⟩ from Subtype.ext hval] + exact realSpectralMeasure_integral ω a _ (continuousOn_pow n) + +/-- **The mean is the first moment, as an integral.** Specializing `moment_eq_integral` to `n = 1` +gives `ω(a) = ∫ y \, d\mu_{\omega,a}`, since `IsJordanOrderUnit.moment_one` identifies the first +moment with `ω(a)` itself. -/ +theorem apply_eq_integral (ω : 𝓢[A]) (a : selfAdjoint A) : + ω.onObservables a = ∫ y, y ∂(realSpectralMeasure ω a) := by + have h := moment_eq_integral ω a 1 + simp only [IsJordanOrderUnit.moment_one, pow_one] at h + exact h + +/-- **The variance as `∫y² dμ - (∫y dμ)²`**, exactly `JB_ROADMAP.md` item 9's +`Var_ω(a) = \int (\lambda - \omega(a))^2 \, d\mu_{\omega,a}` in its expanded (Kőnig–Huygens) form: +`variance` (`Covariance.lean`) unfolds to `moment 2 - (moment 1)^2`, and both moments are now +integrals by `moment_eq_integral`. -/ +theorem variance_eq_integral_sq_sub (ω : 𝓢[A]) (a : selfAdjoint A) : + IsJordanOrderUnit.variance ω.onObservables a = + (∫ y, y ^ 2 ∂(realSpectralMeasure ω a)) - (∫ y, y ∂(realSpectralMeasure ω a)) ^ 2 := by + calc + IsJordanOrderUnit.variance ω.onObservables a = + IsJordanOrderUnit.moment 2 ω.onObservables a - (ω.onObservables a) ^ 2 := by + simp [IsJordanOrderUnit.variance, LinearMap.variance, IsJordanOrderUnit.moment, + JordanAlgebra.jpow_two, pow_two] + _ = _ := by rw [moment_eq_integral, apply_eq_integral] + +end JB diff --git a/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/OrderUnit.lean b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/OrderUnit.lean new file mode 100644 index 0000000000..cc1491906e --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/OrderUnit.lean @@ -0,0 +1,81 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Basic +public import Mathlib.Analysis.CStarAlgebra.ContinuousFunctionalCalculus.Order +public import Mathlib.Algebra.Star.SelfAdjoint + +/-! + +# The self-adjoint part of a C⋆-algebra is an order-unit space + +`selfAdjoint A`, for a unital C⋆-algebra `A`, is the physically meaningful home for the whole +`OrderUnit`/`Effect`/`Weight`/`Channel`/`Measurement` framework built on top of it: the algebra `A` +itself is *not* an order-unit space in that sense, since `x ≤ n • 1` forces `x` self-adjoint +(`StarOrderedRing.le_iff`), so only the self-adjoint elements can ever be compared to `1` at all. + +`1` bounds every self-adjoint element by `IsSelfAdjoint.le_algebraMap_norm_self`, giving +`IsOrderUnit`. Archimedeanity is the one genuinely analytic fact: if `x ≤ ε • 1` for every `ε > 0`, +then `x` is a limit of `ε • 1` as `ε → 0`, and `≤` is a closed relation +(`OrderClosedTopology`, itself from the norm-closedness of the nonnegative cone, +`isClosed_nonneg`), so the limit inequality `x ≤ 0` survives. + +## Main definitions + +- `selfAdjoint.instIsOrderUnit`, `selfAdjoint.instIsArchimedeanOrderUnit` + +-/ + +@[expose] public section + +variable {A : Type*} [CStarAlgebra A] [PartialOrder A] [StarOrderedRing A] + +namespace selfAdjoint + +/-- Nonnegative real scalars preserve the order on self-adjoint elements: scaling by a +nonnegative real is the same as multiplying by a nonnegative (central) algebra element, and a +nonnegative element times a nonnegative element that commutes with it stays nonnegative. -/ +instance instPosSMulMono : PosSMulMono ℝ (selfAdjoint A) where + smul_le_smul_of_nonneg_left c hc a b hab := by + show (c : ℝ) • (a : A) ≤ (c : ℝ) • (b : A) + have hab' : (a : A) ≤ (b : A) := hab + gcongr + +instance instIsOrderUnit : IsOrderUnit (selfAdjoint A) where + one_nonneg := by + show (0 : A) ≤ (1 : A) + exact zero_le_one + exists_nsmul_one_le x := by + refine ⟨⌈‖(x : A)‖⌉₊, ?_⟩ + have hcast : ((⌈‖(x : A)‖⌉₊ • (1 : selfAdjoint A) : selfAdjoint A) : A) = + (⌈‖(x : A)‖⌉₊ : ℝ) • (1 : A) := by + rw [← Nat.cast_smul_eq_nsmul ℝ] + rfl + show (x : A) ≤ ((⌈‖(x : A)‖⌉₊ • (1 : selfAdjoint A) : selfAdjoint A) : A) + rw [hcast] + calc (x : A) ≤ algebraMap ℝ A ‖(x : A)‖ := x.2.le_algebraMap_norm_self + _ = ‖(x : A)‖ • (1 : A) := Algebra.algebraMap_eq_smul_one _ + _ ≤ (⌈‖(x : A)‖⌉₊ : ℝ) • (1 : A) := by gcongr; exact Nat.le_ceil _ + +instance instIsArchimedeanOrderUnit : IsArchimedeanOrderUnit (selfAdjoint A) where + le_zero_of_forall_pos_smul_one_le x h := by + show (x : A) ≤ (0 : A) + have hg : Filter.Tendsto (fun n : ℕ => (1 / ((n : ℝ) + 1)) • (1 : A)) Filter.atTop + (nhds 0) := by + have h0 : Filter.Tendsto (fun n : ℕ => 1 / ((n : ℝ) + 1)) Filter.atTop (nhds 0) := + tendsto_one_div_add_atTop_nhds_zero_nat + simpa using h0.smul_const (1 : A) + refine le_of_tendsto_of_tendsto' tendsto_const_nhds hg fun n => ?_ + have hε : (0 : ℝ) < 1 / ((n : ℝ) + 1) := by positivity + have hle : x ≤ (1 / ((n : ℝ) + 1)) • (1 : selfAdjoint A) := h (1 / ((n : ℝ) + 1)) hε + have hcast : (((1 / ((n : ℝ) + 1)) • (1 : selfAdjoint A) : selfAdjoint A) : A) = + (1 / ((n : ℝ) + 1)) • (1 : A) := rfl + have hle' : (x : A) ≤ (((1 / ((n : ℝ) + 1)) • (1 : selfAdjoint A) : selfAdjoint A) : A) := + Subtype.coe_le_coe.mpr hle + rwa [hcast] at hle' + +end selfAdjoint diff --git a/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/Projection.lean b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/Projection.lean new file mode 100644 index 0000000000..c67789d9a3 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/Projection.lean @@ -0,0 +1,81 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.SharpEffect +public import Mathlib.Analysis.CStarAlgebra.ContinuousFunctionalCalculus.Projection + +/-! + +# Projections in a C⋆-algebra + +A projection is an idempotent effect: an effect `p : Effect (selfAdjoint A)` whose underlying +element satisfies `p * p = p`. This bundles `IsIdempotentElem.isSharp` (`SharpEffect.lean`) as a +genuine type, in the same style `PVM := {μ : POVM Ω E // μ.IsPVM}` bundles sharpness of every +effect a POVM assigns (`Representation/PVM.lean`) — a `Projection` is exactly the operator-level +data that makes a single POVM outcome a genuine projection. + +Complementation and its involutivity are already available generically for *every* effect +(`Effect.complement`, `Effect.complement_complement`, `OrderUnit/Effect/Basic.lean`); the only new +ingredient needed to transport them to `Projection` is that the complement of an idempotent is +again idempotent, which needs no C⋆-algebraic input at all and is already +`IsIdempotentElem.one_sub` in Mathlib (`Algebra/Ring/Idempotent.lean`). + +The one fact that is genuinely new to this codebase — nothing else here computes a spectrum — is +that the real spectrum of a projection lies in `{0, 1}`. This is exactly Mathlib's +`isIdempotentElem_iff_spectrum_subset`, specialized to the self-adjoint continuous functional +calculus that `selfAdjoint A` already carries for a C⋆-algebra `A`. + +## Main definitions + +- `Projection A` +- `Projection.isSharp` : every projection is a sharp effect (`IsIdempotentElem.isSharp`). +- `Projection.complement`, `Projection.complement_complement` +- `Projection.spectrum_subset_zero_one` + +-/ + +@[expose] public section + +variable {A : Type*} [CStarAlgebra A] [PartialOrder A] [StarOrderedRing A] + +/-- A projection: an idempotent effect in the self-adjoint part of a C⋆-algebra. -/ +def Projection (A : Type*) [CStarAlgebra A] [PartialOrder A] := + {p : Effect (selfAdjoint A) // IsIdempotentElem (((p : selfAdjoint A) : A))} + +namespace Projection + +/-- A projection, viewed as an effect, forgetting idempotence. -/ +instance : CoeOut (Projection A) (Effect (selfAdjoint A)) := ⟨Subtype.val⟩ + +omit [StarOrderedRing A] in +@[ext] +lemma ext {p q : Projection A} (h : (p : Effect (selfAdjoint A)) = (q : Effect (selfAdjoint A))) : + p = q := + Subtype.ext h + +/-- Every projection is a sharp effect: it cannot be written as a nontrivial mixture of two +distinct effects. The payoff of `IsIdempotentElem.isSharp`. -/ +theorem isSharp (p : Projection A) : Effect.IsSharp (p : Effect (selfAdjoint A)) := + p.2.isSharp + +/-- The complementary projection `1 - p`. -/ +def complement (p : Projection A) : Projection A := + ⟨Effect.complement (p : Effect (selfAdjoint A)), p.2.one_sub⟩ + +/-- Taking the complement twice returns the original projection. -/ +@[simp] +lemma complement_complement (p : Projection A) : complement (complement p) = p := + Subtype.ext (Effect.complement_complement (p : Effect (selfAdjoint A))) + +omit [StarOrderedRing A] in +/-- The real spectrum of a projection is contained in `{0, 1}`. -/ +lemma spectrum_subset_zero_one (p : Projection A) : + spectrum ℝ (((p : Effect (selfAdjoint A)) : selfAdjoint A) : A) ⊆ {0, 1} := + (isIdempotentElem_iff_spectrum_subset ℝ (((p : Effect (selfAdjoint A)) : selfAdjoint A) : A) + ((p : Effect (selfAdjoint A)) : selfAdjoint A).2).mp p.2 + +end Projection diff --git a/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/SharpEffect.lean b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/SharpEffect.lean new file mode 100644 index 0000000000..fef0abcd3e --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/SharpEffect.lean @@ -0,0 +1,147 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.OrderUnit +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Effect.Basic +public import Mathlib.Analysis.SpecialFunctions.ContinuousFunctionalCalculus.Rpow.Basic +public import Mathlib.Analysis.CStarAlgebra.Basic +public import Mathlib.Algebra.Module.Torsion.Free + +/-! + +# Idempotent effects in a C⋆-algebra are sharp + +A projection — an idempotent self-adjoint element `p` with `p * p = p` — is a sharp effect: it +cannot be written as a nontrivial mixture of two *different* effects. This is the direction of +`Effect.IsSharp` that matters for reading a projection-valued measure as a `PVM` (every projection +it assigns is automatically sharp, `PVM.lean`); the converse (every sharp effect is a projection) +needs a construction from the continuous functional calculus splitting a non-idempotent effect +into a genuine mixture, and is not attempted here. + +The proof: write `b := 1 - p`. If `p = t • y₁ + s • y₂` for effects `y₁, y₂` and `t, s > 0`, +`t + s = 1`, then conjugating by `b` kills the whole sum (`b * p * b = 0` since `b * p = 0`), and +since conjugation by a self-adjoint element preserves nonnegativity, both `b * y₁ * b` and +`b * y₂ * b` — being nonnegative terms summing to `0` — vanish individually. The C⋆-identity +`‖z⋆z‖ = ‖z‖²`, applied to `z := √y₁ * b`, turns `b * y₁ * b = 0` into `y₁ * b = b * y₁ = 0`, i.e. +`y₁` commutes with `p` and is fixed by conjugating it: `p * y₁ * p = y₁`. Since `y₁ ≤ 1`, +conjugating by `p` then gives `y₁ ≤ p`; the same argument gives `y₂ ≤ p`, and averaging +`p - y₁ ≥ 0`, `p - y₂ ≥ 0` back against the original mixture forces both to be exactly `0`. + +## Main results + +- `IsIdempotentElem.isSharp` : an idempotent effect (in a C⋆-algebra) is sharp. + +-/ + +@[expose] public section + +variable {A : Type*} [CStarAlgebra A] [PartialOrder A] [StarOrderedRing A] + +/-- If `b * x * b = 0` for `b` self-adjoint and `x ≥ 0`, then `√x * b = 0`: the C⋆-identity +`‖z⋆z‖ = ‖z‖²`, applied to `z := √x * b`, since `z⋆z = b * √x * √x * b = b * x * b`. -/ +private lemma sandwich_eq_zero {b x : A} (hb : IsSelfAdjoint b) (hx : 0 ≤ x) + (h : b * x * b = 0) : CFC.sqrt x * b = 0 := by + refine (CStarRing.star_mul_self_eq_zero_iff (CFC.sqrt x * b)).mp ?_ + have hstar : star (CFC.sqrt x * b) = b * CFC.sqrt x := by + rw [star_mul, hb.star_eq, (CFC.sqrt_nonneg x).isSelfAdjoint.star_eq] + rw [hstar] + calc b * CFC.sqrt x * (CFC.sqrt x * b) = b * (CFC.sqrt x * CFC.sqrt x) * b := by noncomm_ring + _ = b * x * b := by rw [CFC.sqrt_mul_sqrt_self x hx] + _ = 0 := h + +/-- The algebraic heart of `IsIdempotentElem.isSharp`, stated on bare elements of `A`: an +idempotent `a` between `0` and `1` cannot be written as a nontrivial mixture of two different +effects. -/ +private lemma eq_of_mem_openSegment_of_isIdempotentElem {a y₁ y₂ : A} (ha0 : 0 ≤ a) (_ha1 : a ≤ 1) + (hidem : a * a = a) (hy₁0 : 0 ≤ y₁) (hy₁1 : y₁ ≤ 1) (hy₂0 : 0 ≤ y₂) (hy₂1 : y₂ ≤ 1) + {t s : ℝ} (ht : 0 < t) (hs : 0 < s) (hts : t + s = 1) (heq : t • y₁ + s • y₂ = a) : + y₁ = a := by + have ha : IsSelfAdjoint a := IsSelfAdjoint.of_nonneg ha0 + have hone : IsSelfAdjoint (1 : A) := IsSelfAdjoint.one A + have hb : IsSelfAdjoint (1 - a) := hone.sub ha + have hy₁ : IsSelfAdjoint y₁ := IsSelfAdjoint.of_nonneg hy₁0 + have hy₂ : IsSelfAdjoint y₂ := IsSelfAdjoint.of_nonneg hy₂0 + -- Conjugating the mixture by `1 - a` kills it, since `(1 - a) * a = 0`. + have hba : (1 - a) * a * (1 - a) = 0 := by + have : (1 - a) * a = 0 := by rw [sub_mul, one_mul, hidem, sub_self] + rw [this, zero_mul] + have hsplit : t • ((1 - a) * y₁ * (1 - a)) + s • ((1 - a) * y₂ * (1 - a)) = 0 := by + have heq2 : (1 - a) * (t • y₁ + s • y₂) * (1 - a) = (1 - a) * a * (1 - a) := by rw [heq] + simp only [mul_add, add_mul, mul_smul_comm, smul_mul_assoc] at heq2 + rwa [hba] at heq2 + -- Both conjugated terms are nonnegative, so each vanishes. + have hb1 : 0 ≤ (1 - a) * y₁ * (1 - a) := hb.conjugate_nonneg hy₁0 + have hb2 : 0 ≤ (1 - a) * y₂ * (1 - a) := hb.conjugate_nonneg hy₂0 + have hz1 : t • ((1 - a) * y₁ * (1 - a)) = 0 := + Effect.nonneg_add_eq_zero (smul_nonneg ht.le hb1) (smul_nonneg hs.le hb2) hsplit + have h1 : (1 - a) * y₁ * (1 - a) = 0 := + (smul_eq_zero.mp hz1).resolve_left ht.ne' + -- Hence `y₁` commutes with `1 - a`, i.e. with `a`, and is fixed by conjugating with `a`. + have hsq := sandwich_eq_zero hb hy₁0 h1 + have hcomm1 : y₁ * (1 - a) = 0 := by + have : CFC.sqrt y₁ * (CFC.sqrt y₁ * (1 - a)) = CFC.sqrt y₁ * 0 := by rw [hsq] + rwa [← mul_assoc, CFC.sqrt_mul_sqrt_self y₁ hy₁0, mul_zero] at this + have hcomm2 : (1 - a) * y₁ = 0 := by + have := congrArg star hcomm1 + rwa [star_mul, hb.star_eq, hy₁.star_eq, star_zero] at this + have hay₁ : a * y₁ = y₁ := by + have := hcomm2 + rw [sub_mul, one_mul, sub_eq_zero] at this + exact this.symm + have hy₁a : y₁ * a = y₁ := by + have := hcomm1 + rw [mul_sub, mul_one, sub_eq_zero] at this + exact this.symm + have hfix : a * y₁ * a = y₁ := by rw [hay₁, hy₁a] + -- `y₁ ≤ 1` conjugated by `a` gives `y₁ ≤ a`; the same argument gives `y₂ ≤ a`. + have hle1 : y₁ ≤ a := by + have := ha.conjugate_le_conjugate hy₁1 + rwa [mul_one, hidem, hfix] at this + have hz2 : s • ((1 - a) * y₂ * (1 - a)) = 0 := + Effect.nonneg_add_eq_zero (smul_nonneg hs.le hb2) (smul_nonneg ht.le hb1) + (by rwa [add_comm] at hsplit) + have h2 : (1 - a) * y₂ * (1 - a) = 0 := + (smul_eq_zero.mp hz2).resolve_left hs.ne' + have hsq2 := sandwich_eq_zero hb hy₂0 h2 + have hcomm1' : y₂ * (1 - a) = 0 := by + have : CFC.sqrt y₂ * (CFC.sqrt y₂ * (1 - a)) = CFC.sqrt y₂ * 0 := by rw [hsq2] + rwa [← mul_assoc, CFC.sqrt_mul_sqrt_self y₂ hy₂0, mul_zero] at this + have hcomm2' : (1 - a) * y₂ = 0 := by + have := congrArg star hcomm1' + rwa [star_mul, hb.star_eq, hy₂.star_eq, star_zero] at this + have hay₂ : a * y₂ = y₂ := by + have := hcomm2'; rw [sub_mul, one_mul, sub_eq_zero] at this; exact this.symm + have hy₂a : y₂ * a = y₂ := by + have := hcomm1'; rw [mul_sub, mul_one, sub_eq_zero] at this; exact this.symm + have hfix2 : a * y₂ * a = y₂ := by rw [hay₂, hy₂a] + have hle2 : y₂ ≤ a := by + have := ha.conjugate_le_conjugate hy₂1 + rwa [mul_one, hidem, hfix2] at this + -- Averaging `a - y₁ ≥ 0` and `a - y₂ ≥ 0` back against `a = t • y₁ + s • y₂` forces both to `0`. + have hfin : t • (a - y₁) + s • (a - y₂) = 0 := by + have h1 : t • a + s • a = a := by rw [← add_smul, hts, one_smul] + rw [smul_sub, smul_sub, show t • a - t • y₁ + (s • a - s • y₂) = + (t • a + s • a) - (t • y₁ + s • y₂) from by abel, h1, heq, sub_self] + have hz3 : t • (a - y₁) = 0 := Effect.nonneg_add_eq_zero (smul_nonneg ht.le (sub_nonneg.mpr hle1)) + (smul_nonneg hs.le (sub_nonneg.mpr hle2)) hfin + have h3 : a - y₁ = 0 := (smul_eq_zero.mp hz3).resolve_left ht.ne' + exact (sub_eq_zero.mp h3).symm + +/-- An idempotent effect is sharp: it cannot be written as a nontrivial mixture of two different +effects. Together with `Effect.isSharp_zero`/`Effect.isSharp_one`/`Effect.isSharp_complement`, this +recovers the standard fact that projections are exactly the sharp effects in one direction — every +projection-valued measure is a `PVM`. -/ +theorem IsIdempotentElem.isSharp {e : Effect (selfAdjoint A)} + (h : IsIdempotentElem ((e : selfAdjoint A) : A)) : Effect.IsSharp e := by + refine ⟨e.2, fun x₁ hx₁ x₂ hx₂ hseg => ?_⟩ + obtain ⟨t, s, ht, hs, hts, hz⟩ := hseg + apply Subtype.ext + have heq : t • (x₁ : A) + s • (x₂ : A) = ((e : selfAdjoint A) : A) := by + have hz' := congrArg Subtype.val hz + simpa using hz' + exact eq_of_mem_openSegment_of_isIdempotentElem e.2.1 e.2.2 h hx₁.1 hx₁.2 hx₂.1 hx₂.2 ht hs hts + heq diff --git a/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/SpectralMeasure.lean b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/SpectralMeasure.lean new file mode 100644 index 0000000000..706c1843b1 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/SpectralMeasure.lean @@ -0,0 +1,373 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.StarAlgebra.Observable +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.OrderUnit +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.SharpEffect +public import PhyslibAlpha.AlgebraicFramework.Measurement.Basic +public import Mathlib.MeasureTheory.Integral.RieszMarkovKakutani.Real +public import Mathlib.MeasureTheory.Measure.ProbabilityMeasure +public import Mathlib.Topology.Algebra.Indicator + +/-! + +# The probability measure of an observable in a state + +A state `ω` and an observable `a` together fix a probability measure `μ_{ω,a}` on `ℝ`: the one +against which integrating `f` gives `ω(f(a))`, so it's what you integrate against for `a`'s +expectation, variance, or any other statistic in the preparation `ω`. `μ_{ω,a}` is supported on +`a`'s spectrum and is the unique measure with this property. + +Restricting `ω` to the observables of the continuous functional calculus of `a` +(`UnitalPositiveLinearMap.onObservables`, `Observable.lean`) turns `ω, a` into one positive, +normalized functional on `C(σ_ℝ(a), ℝ)` — exactly the input to Riesz–Markov–Kakutani, which +Mathlib already supplies. Pushing the result forward along `σ_ℝ(a) ↪ ℝ` gives `μ_{ω,a}`. + +This is the concrete payoff of the whole measurement layer built on top of `OrderUnit/` +(`OVERVIEW.md` §9): `μ_{ω,a}` *is* the outcome distribution of measuring the single observable `a` +in the preparation `ω`. The "Connection to the abstract measurement layer" section below makes +this precise at every isolated point of `a`'s spectrum — a genuine eigenvalue with a spectral +gap — where CFC already supplies the spectral projection needed to state it as a bona fide +`Measurement`, matching `Measurement.outcomeDistribution` (`Measurement/Basic.lean`) exactly. +Doing this at every Borel set at once, recovering `μ_{ω,a}` as a full +`EffectValuedMeasure ℝ (selfAdjoint A)` (a PVM), would need a projection for every Borel set — +the measurable functional calculus underlying the spectral theorem — which this codebase does not +yet have; only continuous functional calculus (`cfc`, `cfcHom`) is available, and that reaches +exactly the clopen (isolated-point) subsets of the spectrum and no further. + +## Main definitions + +- `spectralMeasure`, `realSpectralMeasure` : `μ_{ω,a}`, first on `a`'s spectrum, then on `ℝ`. +- `realSpectralMeasure_integral` : `ω(f(a)) = ∫ f dμ_{ω,a}`. +- `realSpectralMeasure_unique` : `μ_{ω,a}` is the only probability measure on `ℝ`, concentrated on + `a`'s spectrum, reproducing `ω(f(a))` this way. +- `eigenEffect`, `eigenMeasurement` : the two-outcome measurement "does `a` read out `x`?" at an + isolated spectral point `x`, and `eigenMeasurement_outcomeDistribution_true` : its outcome + distribution in `ω` matches `μ_{ω,a}({x})`. + +-/ + +@[expose] public section + +open MeasureTheory CompactlySupportedContinuousMap +open scoped CompactlySupported ComplexOrder + +variable {A : Type*} [CStarAlgebra A] [PartialOrder A] [StarOrderedRing A] + +/-- `f ↦ ω.onObservables (f(a))`: positive since `ω` is a state and `f(a) ≥ 0` for `f ≥ 0`; +already real-valued, with no detour through `Re` needed, since `onObservables` is a state on the +observables directly (`Observable.lean`). -/ +noncomputable def spectralFunctional (ω : 𝓢[A]) (a : Observable A) : + C(spectrum ℝ (a : A), ℝ) →ₚ[ℝ] ℝ := + PositiveLinearMap.mk₀ + { toFun := fun f => ω.onObservables ⟨cfcHom a.property f, cfcHom_predicate a.property f⟩ + map_add' := fun f g => by + have heq : (⟨cfcHom a.property (f + g), cfcHom_predicate a.property (f + g)⟩ : + Observable A) = ⟨cfcHom a.property f, cfcHom_predicate a.property f⟩ + + ⟨cfcHom a.property g, cfcHom_predicate a.property g⟩ := by + apply Subtype.ext; simp + rw [heq, map_add] + map_smul' := fun c f => by + have heq : (⟨cfcHom a.property (c • f), cfcHom_predicate a.property (c • f)⟩ : + Observable A) = c • ⟨cfcHom a.property f, cfcHom_predicate a.property f⟩ := by + apply Subtype.ext; simp + rw [heq, map_smul]; rfl } + (fun f hf => by + have hnn : (0 : A) ≤ cfcHom a.property f := by + have := cfcHom_mono a.property (f := (0 : C(spectrum ℝ (a : A), ℝ))) (g := f) hf + simpa using this + exact ω.onObservables.map_nonneg hnn) + +/-- `spectralFunctional` on compactly supported functions (all functions, since the spectrum is +compact), as `RealRMK.rieszMeasure` requires. -/ +noncomputable def spectralFunctionalCc (ω : 𝓢[A]) (a : Observable A) : + C_c(spectrum ℝ (a : A), ℝ) →ₚ[ℝ] ℝ := + PositiveLinearMap.mk₀ + { toFun := fun f => spectralFunctional ω a f.toContinuousMap + map_add' := fun f g => by + show spectralFunctional ω a (f + g).toContinuousMap = _ + rw [show (f + g).toContinuousMap = f.toContinuousMap + g.toContinuousMap from rfl, map_add] + map_smul' := fun c f => by + show spectralFunctional ω a (c • f).toContinuousMap = _ + rw [show (c • f).toContinuousMap = c • f.toContinuousMap from rfl] + exact (spectralFunctional ω a).toLinearMap.map_smul c f.toContinuousMap } + (fun f hf => (spectralFunctional ω a).map_nonneg hf) + +/-- `spectralMeasure` on the spectrum itself; `realSpectralMeasure` below places it inside `ℝ`. -/ +noncomputable def spectralMeasure (ω : 𝓢[A]) (a : Observable A) : + Measure (spectrum ℝ (a : A)) := + RealRMK.rieszMeasure (spectralFunctionalCc ω a) + +instance spectralMeasure_isFiniteMeasure (ω : 𝓢[A]) (a : Observable A) : + IsFiniteMeasure (spectralMeasure ω a) := by + unfold spectralMeasure; infer_instance + +lemma spectralFunctional_one (ω : 𝓢[A]) (a : Observable A) : + spectralFunctional ω a 1 = 1 := by + show ω.onObservables ⟨cfcHom a.property (1 : C(spectrum ℝ (a : A), ℝ)), + cfcHom_predicate a.property 1⟩ = 1 + have heq : (⟨cfcHom a.property (1 : C(spectrum ℝ (a : A), ℝ)), cfcHom_predicate a.property 1⟩ : + Observable A) = 1 := by + apply Subtype.ext; simp + rw [heq, map_one] + +/-- Total mass one, matching `ω(1) = 1`. -/ +instance spectralMeasure_isProbabilityMeasure (ω : 𝓢[A]) (a : Observable A) : + IsProbabilityMeasure (spectralMeasure ω a) := by + rw [isProbabilityMeasure_iff_real, ← spectralFunctional_one ω a] + have hg : (spectralFunctionalCc ω a) (continuousMapEquiv 1) = spectralFunctional ω a 1 := rfl + rw [← hg, ← RealRMK.integral_rieszMeasure (spectralFunctionalCc ω a) (continuousMapEquiv 1)] + simp [spectralMeasure, measureReal_def] + +/-- `∫ f dμ = ω(f(a))` on the spectrum. -/ +lemma spectralMeasure_integral (ω : 𝓢[A]) (a : Observable A) + (f : C(spectrum ℝ (a : A), ℝ)) : + ω.onObservables ⟨cfcHom a.property f, cfcHom_predicate a.property f⟩ = + ∫ x, f x ∂(spectralMeasure ω a) := by + show (spectralFunctional ω a) f = _ + show (spectralFunctional ω a) f = + ∫ x, (continuousMapEquiv f : spectrum ℝ (a : A) → ℝ) x ∂(spectralMeasure ω a) + exact (RealRMK.integral_rieszMeasure (spectralFunctionalCc ω a) (continuousMapEquiv f)).symm + +/-- The probability measure `μ_{ω,a}` on `ℝ`: `spectralMeasure` pushed forward along the inclusion +of the spectrum into `ℝ`. Integrating `f` against it gives `ω(f(a))` +(`realSpectralMeasure_integral`), so this is what to integrate against for `a`'s expectation, +variance, or any other statistic in the state `ω`. -/ +noncomputable def realSpectralMeasure (ω : 𝓢[A]) (a : Observable A) : Measure ℝ := + Measure.map Subtype.val (spectralMeasure ω a) + +instance realSpectralMeasure_isProbabilityMeasure (ω : 𝓢[A]) (a : Observable A) : + IsProbabilityMeasure (realSpectralMeasure ω a) := + Measure.isProbabilityMeasure_map measurable_subtype_coe.aemeasurable + +/-- `μ_{ω,a}` is concentrated on `a`'s spectrum. -/ +lemma realSpectralMeasure_compl_spectrum (ω : 𝓢[A]) (a : Observable A) : + realSpectralMeasure ω a (spectrum ℝ (a : A))ᶜ = 0 := by + have hmeas : MeasurableSet (spectrum ℝ (a : A))ᶜ := + (spectrum.isClosed (a : A)).measurableSet.compl + show Measure.map Subtype.val (spectralMeasure ω a) (spectrum ℝ (a : A))ᶜ = 0 + rw [Measure.map_apply measurable_subtype_coe hmeas] + convert measure_empty (μ := spectralMeasure ω a) + ext x + simp + +/-- `∫ f dμ_{ω,a} = ω(f(a))`, for any `f` continuous on the spectrum of `a`. -/ +lemma realSpectralMeasure_integral (ω : 𝓢[A]) (a : Observable A) (f : ℝ → ℝ) + (hf : ContinuousOn f (spectrum ℝ (a : A))) : + ω.onObservables ⟨cfc f (a : A), cfc_predicate f (a : A)⟩ = + ∫ y, f y ∂(realSpectralMeasure ω a) := by + have hemb : MeasurableEmbedding (Subtype.val : spectrum ℝ (a : A) → ℝ) := + MeasurableEmbedding.subtype_coe (spectrum.isClosed (a : A)).measurableSet + have hmap : (∫ y, f y ∂(realSpectralMeasure ω a)) = + (∫ x, f (x : ℝ) ∂(spectralMeasure ω a)) := + hemb.integral_map f + rw [hmap] + have heq : (⟨cfc f (a : A), cfc_predicate f (a : A)⟩ : Observable A) = + ⟨cfcHom a.property (⟨fun x => f x, hf.domRestrict⟩ : C(spectrum ℝ (a : A), ℝ)), + cfcHom_predicate a.property _⟩ := by + apply Subtype.ext + exact cfc_apply f (a : A) a.property hf + rw [heq] + exact spectralMeasure_integral ω a ⟨fun x => f x, hf.domRestrict⟩ + +omit [PartialOrder A] [StarOrderedRing A] in +/-- Every continuous function on the spectrum extends to one on `ℝ`, continuous on the spectrum. -/ +lemma exists_continuousOn_extend (a : Observable A) (g : C(spectrum ℝ (a : A), ℝ)) : + ∃ f : ℝ → ℝ, ContinuousOn f (spectrum ℝ (a : A)) ∧ + ∀ x : spectrum ℝ (a : A), f (x : ℝ) = g x := by + classical + refine ⟨fun y => if h : y ∈ spectrum ℝ (a : A) then g ⟨y, h⟩ else 0, ?_, fun x => by simp⟩ + rw [continuousOn_iff_continuous_domRestrict] + convert g.continuous using 1 + ext x + simp + +/-- If a measure `μ` on `ℝ` reproduces `ω(f(a))` for every continuous `f`, then pulling `μ` back +to the spectrum integrates every continuous test +function there exactly as `spectralMeasure ω a` does. -/ +lemma comap_integral_eq (ω : 𝓢[A]) (a : Observable A) (μ : Measure ℝ) + (hrep : ∀ f : ℝ → ℝ, ContinuousOn f (spectrum ℝ (a : A)) → + ω.onObservables ⟨cfc f (a : A), cfc_predicate f (a : A)⟩ = ((∫ y, f y ∂μ : ℝ))) + (hcomap_map : + Measure.map Subtype.val (μ.comap (Subtype.val : spectrum ℝ (a : A) → ℝ)) = μ) + (g : C(spectrum ℝ (a : A), ℝ)) : + (∫ x, g x ∂(μ.comap (Subtype.val : spectrum ℝ (a : A) → ℝ))) = + ∫ x, g x ∂(spectralMeasure ω a) := by + have hemb : MeasurableEmbedding (Subtype.val : spectrum ℝ (a : A) → ℝ) := + MeasurableEmbedding.subtype_coe (spectrum.isClosed (a : A)).measurableSet + obtain ⟨f, hf, hfg⟩ := exists_continuousOn_extend a g + have hfy : (∫ y, f y ∂μ) = + ∫ x, f (x : ℝ) ∂(μ.comap (Subtype.val : spectrum ℝ (a : A) → ℝ)) := by + conv_lhs => rw [← hcomap_map] + exact hemb.integral_map f + have hfg' : (∫ x, f (x : ℝ) ∂(μ.comap (Subtype.val : spectrum ℝ (a : A) → ℝ))) = + ∫ x, g x ∂(μ.comap (Subtype.val : spectrum ℝ (a : A) → ℝ)) := + integral_congr_ae (Filter.Eventually.of_forall hfg) + have hleft := hrep f hf + rw [hfy, hfg'] at hleft + have hright := spectralMeasure_integral ω a g + have hgeq : (⟨cfc f (a : A), cfc_predicate f (a : A)⟩ : Observable A) = + ⟨cfcHom a.property g, cfcHom_predicate a.property g⟩ := by + apply Subtype.ext + show cfc f (a : A) = cfcHom a.property g + have heq : cfc f (a : A) = + cfcHom a.property (⟨fun x => f x, hf.domRestrict⟩ : C(spectrum ℝ (a : A), ℝ)) := + cfc_apply f (a : A) a.property hf + rw [heq] + congr 1 + ext x + exact hfg x + rw [hgeq] at hleft + exact hleft.symm.trans hright + +/-- `μ_{ω,a}` is the only probability measure on `ℝ`, concentrated on `a`'s spectrum, with +`∫ f dμ = ω(f(a))`: any other measure with these two properties already is `μ_{ω,a}`. -/ +lemma realSpectralMeasure_unique (ω : 𝓢[A]) (a : Observable A) (μ : Measure ℝ) + [IsProbabilityMeasure μ] (hsupp : μ (spectrum ℝ (a : A))ᶜ = 0) + (hrep : ∀ f : ℝ → ℝ, ContinuousOn f (spectrum ℝ (a : A)) → + ω.onObservables ⟨cfc f (a : A), cfc_predicate f (a : A)⟩ = ((∫ y, f y ∂μ : ℝ))) : + μ = realSpectralMeasure ω a := by + have hmeas : MeasurableSet (spectrum ℝ (a : A)) := (spectrum.isClosed (a : A)).measurableSet + have hemb : MeasurableEmbedding (Subtype.val : spectrum ℝ (a : A) → ℝ) := + MeasurableEmbedding.subtype_coe hmeas + have hcomap_map : + Measure.map Subtype.val (μ.comap (Subtype.val : spectrum ℝ (a : A) → ℝ)) = μ := by + rw [map_comap_subtype_coe hmeas] + exact Measure.restrict_eq_self_of_ae_mem hsupp + have hfin : IsFiniteMeasure (μ.comap (Subtype.val : spectrum ℝ (a : A) → ℝ)) := by + constructor + rw [hemb.comap_apply, Set.image_univ, Subtype.range_coe] + exact measure_lt_top μ _ + have hreg : (μ.comap (Subtype.val : spectrum ℝ (a : A) → ℝ)).Regular := by infer_instance + have hintCc : ∀ h : C_c(spectrum ℝ (a : A), ℝ), + (∫ x, h x ∂(μ.comap (Subtype.val : spectrum ℝ (a : A) → ℝ))) = + ∫ x, h x ∂(spectralMeasure ω a) := + fun h => comap_integral_eq ω a μ hrep hcomap_map h.toContinuousMap + have hres := MeasureTheory.Measure.ext_of_integral_eq_on_compactlySupported hintCc + rw [← hcomap_map, hres] + rfl + +/-! + +## Connection to the abstract measurement layer + +An isolated point `x` of `a`'s spectrum — one for which `{x}` is clopen in the subspace topology, +i.e. a genuine eigenvalue with a spectral gap around it — is exactly where continuous functional +calculus already reaches: the indicator function of `{x}` is continuous there (clopen sets have +continuous indicators, `IsClopen.continuous_indicator`), so CFC turns it into an honest spectral +projection `eigenEffect`. Pairing that projection with its complement is a two-outcome +`Measurement` (`Measurement/Basic.lean`) — "does `a` read out `x`, or not?" — and its outcome +distribution in `ω` is exactly `μ_{ω,a}` evaluated at `{x}` and its complement +(`eigenMeasurement_outcomeDistribution_true`): the abstract POVM layer's Born rule and the +concrete spectral measure built above agree at every point either can see. + +What is not attempted: doing this simultaneously at every Borel subset of the spectrum, so that +`x ↦ eigenEffect` extends to a full projection-valued `EffectValuedMeasure ℝ (selfAdjoint A)` +agreeing with `realSpectralMeasure` on every Borel set (not just clopen singletons), needs a +projection for every Borel set — the *measurable* functional calculus underlying the spectral +theorem for self-adjoint operators. That is a substantially larger piece of infrastructure than +continuous functional calculus, and this codebase does not have it yet. +-/ + +/-- The indicator function of an isolated point `x` of `a`'s spectrum, as a continuous function on +the spectrum: continuous because `{x}` is clopen (`IsClopen.continuous_indicator`). -/ +noncomputable def eigenIndicator (a : Observable A) {x : spectrum ℝ (a : A)} + (hx : IsClopen ({x} : Set (spectrum ℝ (a : A)))) : C(spectrum ℝ (a : A), ℝ) := + ⟨Set.indicator {x} 1, hx.continuous_indicator continuous_const⟩ + +omit [PartialOrder A] [StarOrderedRing A] in +@[simp] +lemma eigenIndicator_apply (a : Observable A) {x : spectrum ℝ (a : A)} + (hx : IsClopen ({x} : Set (spectrum ℝ (a : A)))) (y : spectrum ℝ (a : A)) : + eigenIndicator a hx y = Set.indicator {x} 1 y := rfl + +/-- The spectral projection at an isolated point `x` of `a`'s spectrum: `cfc` applied to the +(continuous, since `{x}` is clopen) indicator function of `{x}`. Idempotent, hence sharp +(`IsIdempotentElem.isSharp`) — a genuine projection in the operator-algebraic sense. -/ +noncomputable def eigenEffect (a : Observable A) {x : spectrum ℝ (a : A)} + (hx : IsClopen ({x} : Set (spectrum ℝ (a : A)))) : Effect (Observable A) := + ⟨⟨cfcHom a.property (eigenIndicator a hx), cfcHom_predicate a.property (eigenIndicator a hx)⟩, + by + have h0 : (0 : C(spectrum ℝ (a : A), ℝ)) ≤ eigenIndicator a hx := + ContinuousMap.le_def.mpr fun y => by + simp only [ContinuousMap.zero_apply, eigenIndicator_apply, Set.indicator_apply, + Pi.one_apply] + split <;> norm_num + have h1 : eigenIndicator a hx ≤ (1 : C(spectrum ℝ (a : A), ℝ)) := + ContinuousMap.le_def.mpr fun y => by + simp only [ContinuousMap.one_apply, eigenIndicator_apply, Set.indicator_apply, + Pi.one_apply] + split <;> norm_num + refine ⟨?_, ?_⟩ + · show (0 : A) ≤ cfcHom a.property (eigenIndicator a hx) + have := cfcHom_mono a.property h0 + simpa using this + · show cfcHom a.property (eigenIndicator a hx) ≤ (1 : A) + have := cfcHom_mono a.property h1 + simpa using this⟩ + +omit [PartialOrder A] [StarOrderedRing A] in +lemma eigenIndicator_mul_self (a : Observable A) {x : spectrum ℝ (a : A)} + (hx : IsClopen ({x} : Set (spectrum ℝ (a : A)))) : + eigenIndicator a hx * eigenIndicator a hx = eigenIndicator a hx := by + ext y + simp only [ContinuousMap.mul_apply, eigenIndicator_apply, Set.indicator_apply, Pi.one_apply] + split <;> ring + +/-- `eigenEffect` is idempotent: `cfcHom` is an algebra homomorphism, and the indicator function +`eigenIndicator a hx` is already idempotent under pointwise multiplication. -/ +lemma isIdempotentElem_eigenEffect (a : Observable A) {x : spectrum ℝ (a : A)} + (hx : IsClopen ({x} : Set (spectrum ℝ (a : A)))) : + IsIdempotentElem (((eigenEffect a hx : Effect (Observable A)) : Observable A) : A) := by + show cfcHom a.property (eigenIndicator a hx) * cfcHom a.property (eigenIndicator a hx) = + cfcHom a.property (eigenIndicator a hx) + rw [← map_mul, eigenIndicator_mul_self] + +/-- `eigenEffect` is sharp: a genuine projection, not merely an effect. -/ +lemma isSharp_eigenEffect (a : Observable A) {x : spectrum ℝ (a : A)} + (hx : IsClopen ({x} : Set (spectrum ℝ (a : A)))) : + Effect.IsSharp (eigenEffect a hx) := + (isIdempotentElem_eigenEffect a hx).isSharp + +/-- The two-outcome measurement "does `a` read out the isolated spectral point `x`, or not?" -/ +noncomputable def eigenMeasurement (a : Observable A) {x : spectrum ℝ (a : A)} + (hx : IsClopen ({x} : Set (spectrum ℝ (a : A)))) : Measurement (Observable A) Bool where + outcomes := Finset.univ + effects := fun b => if b then eigenEffect a hx else Effect.complement (eigenEffect a hx) + sum_eq_one := by + show ∑ b : Bool, + ((if b then eigenEffect a hx else Effect.complement (eigenEffect a hx) : + Effect (Observable A)) : Observable A) = 1 + rw [Fintype.sum_bool] + show ((eigenEffect a hx : Effect (Observable A)) : Observable A) + + ((Effect.complement (eigenEffect a hx) : Effect (Observable A)) : Observable A) = 1 + have : ((Effect.complement (eigenEffect a hx) : Effect (Observable A)) : Observable A) = + 1 - ((eigenEffect a hx : Effect (Observable A)) : Observable A) := rfl + rw [this] + abel + +/-- The outcome distribution of `eigenMeasurement` in `ω` matches `μ_{ω,a}` at `{x}`: the +abstract Born rule of the two-outcome measurement "does `a` read out `x`?" agrees with the +concrete probability measure built from `a`'s continuous functional calculus. -/ +theorem eigenMeasurement_outcomeDistribution_true (ω : 𝓢[A]) (a : Observable A) + {x : spectrum ℝ (a : A)} (hx : IsClopen ({x} : Set (spectrum ℝ (a : A)))) : + (eigenMeasurement a hx).outcomeDistribution ω.onObservables ⟨true, Finset.mem_univ true⟩ = + (realSpectralMeasure ω a).real ({(x : ℝ)} : Set ℝ) := by + rw [Measurement.outcomeDistribution_apply] + show ω.onObservables (eigenEffect a hx : Observable A) = _ + have hmeas : MeasurableSet ({(x : ℝ)} : Set ℝ) := measurableSet_singleton _ + rw [show ((eigenEffect a hx : Effect (Observable A)) : Observable A) = + ⟨cfcHom a.property (eigenIndicator a hx), cfcHom_predicate a.property (eigenIndicator a hx)⟩ + from rfl, + spectralMeasure_integral ω a (eigenIndicator a hx), + show realSpectralMeasure ω a = Measure.map Subtype.val (spectralMeasure ω a) from rfl, + map_measureReal_apply measurable_subtype_coe hmeas] + have hpre : (Subtype.val : spectrum ℝ (a : A) → ℝ) ⁻¹' ({(x : ℝ)} : Set ℝ) = {x} := by + ext y; simp [Subtype.ext_iff] + rw [hpre] + simp only [eigenIndicator_apply] + exact integral_indicator_one (measurableSet_singleton x) diff --git a/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/Stinespring/Dilation.lean b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/Stinespring/Dilation.lean new file mode 100644 index 0000000000..4338cdd069 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/Stinespring/Dilation.lean @@ -0,0 +1,772 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.Stinespring.Kernel +public import Mathlib.LinearAlgebra.TensorProduct.Finiteness +public import Mathlib.Analysis.InnerProductSpace.Completion +public import Mathlib.Topology.Algebra.LinearMapCompletion + +/-! + +# Stinespring's dilation theorem + +Ported from `unbounded-alpha-public`'s `QuantumMechanics/Unbounded/OperatorAlgebra/Dynamics/ +Stinespring/Core.lean`, restated against this repo's own bare Mathlib hypotheses +(`[CStarAlgebra A] [PartialOrder A] [StarOrderedRing A]`) instead of the upstream-superseded +`OperatorAlgebra` class — see `Kernel.lean`'s docstring for why this is a pure restatement, not new +mathematics. + +Stinespring's theorem is the general statement underlying every physical quantum operation: a +completely positive map `J : A →CP (H →L[ℂ] H)` out of a C⋆-algebra always arises from coupling to +a larger system and applying an ordinary `⋆`-representation. Concretely, it builds a Hilbert space +`K`, a `⋆`-representation `π : A →⋆ₐ[ℂ] (K →L[ℂ] K)`, and an isometry-like embedding +`V : H →L[ℂ] K` with + + `J a = V⋆ π(a) V` (`canonical_stinespring_identity`). + +This subsumes Naimark's dilation theorem as the commutative special case (a POVM is a CP map on +the commutative algebra of bounded measurable functions; positivity there is automatically complete +positivity, and indicator functions recover the projection-valued dilation from `π`). + +## Construction + +The construction is a vector-valued (operator-valued) generalization of the GNS construction, +built on the algebraic tensor product `A ⊗[ℂ] H`: + +- `sesquiBilinear`/`tensorInner` : the (possibly degenerate) `B(H)`-valued-kernel-induced + sesquilinear form `⟪a ⊗ h, b ⊗ k⟫ := ⟪h, J(a⋆b) k⟫` on `A ⊗[ℂ] H`. +- `tensorCore`/`tensorSeminormed`/`tensorInnerProductSpace` : the pre-Hilbert-space structure this + form induces (positivity is `Kernel.lean`'s CP-kernel positivity). +- `leftMul`/`leftMulK` : left multiplication by `A` on the tensor product, shown contractive + (`leftMul_norm_le`) and hence extending to the completion. +- `Canonical.K J` : the completion of `A ⊗[ℂ] H` under the kernel seminorm — the canonical + Stinespring dilation space. +- `Canonical.canonicalRepresentation`, `Canonical.embedding` : the representation `π` and the + embedding `V : H →L[ℂ] K J`. +- `Canonical.canonical_stinespring_identity` : the Stinespring identity itself. +- `Canonical.canonicalWitness` : the identity packaged as a `StinespringWitness`. +- `exists_stinespringWitness` : the dilation theorem, stated as an existence theorem. + +## Main results + +- `Canonical.canonical_stinespring_identity` +- `exists_stinespringWitness` + +-/ + +@[expose] public section + +open scoped ComplexOrder CStarAlgebra TensorProduct +open ContinuousLinearMap + +noncomputable section + +namespace Stinespring + +variable {A H : Type*} [CStarAlgebra A] [PartialOrder A] [StarOrderedRing A] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-- The tensor-product carrier `A ⊗[ℂ] H` the whole construction below lives on. -/ +@[nolint unusedArguments] +abbrev T (A H : Type*) [CStarAlgebra A] [PartialOrder A] [StarOrderedRing A] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] := A ⊗[ℂ] H + +/-- The functional `b ⊗ k ↦ ⟪h, J(a⋆b) k⟫`, the building block of the kernel inner product. -/ +def baseFunctional (J : A →CP (H →L[ℂ] H)) (a : A) (h : H) : + T A H →ₗ[ℂ] ℂ := + TensorProduct.lift (LinearMap.mk₂ ℂ + (fun b k => inner ℂ h (J (star a * b) k)) + (by intro b₁ b₂ k; simp [mul_add, map_add]) + (by + intro c b k + rw [mul_smul_comm, map_smul] + change inner ℂ h (c • (J (star a * b) k)) = _ + rw [inner_smul_right] + rfl) + (by intro b k₁ k₂; simp [map_add]) + (by + intro c b k + rw [map_smul] + rw [inner_smul_right] + rfl)) + +@[simp] +lemma baseFunctional_tmul (J : A →CP (H →L[ℂ] H)) (a b : A) (h k : H) : + baseFunctional J a h (b ⊗ₜ[ℂ] k) = inner ℂ h (J (star a * b) k) := by + rfl + +/-- `baseFunctional`, packaged as a sesquilinear map in `(a, h)`. -/ +def sesquiBilinear (J : A →CP (H →L[ℂ] H)) : + A →ₛₗ[starRingEnd ℂ] H →ₛₗ[starRingEnd ℂ] (T A H →ₗ[ℂ] ℂ) := + LinearMap.mk₂'ₛₗ (starRingEnd ℂ) (starRingEnd ℂ) + (fun a h => baseFunctional J a h) + (by intro a₁ a₂ h; ext x; simp [baseFunctional, star_add, add_mul, map_add]) + (by intro c a h; ext x; simp [baseFunctional, star_smul, map_smul]) + (by intro a h₁ h₂; ext x; simp [baseFunctional]) + (by intro c a h; ext x; simp [baseFunctional]; ring) + +/-- The (possibly degenerate) sesquilinear form on `T A H` induced by lifting `sesquiBilinear` +through the tensor product. -/ +def tensorInner (J : A →CP (H →L[ℂ] H)) : + T A H →ₛₗ[starRingEnd ℂ] (T A H →ₗ[ℂ] ℂ) := + TensorProduct.lift (sesquiBilinear J) + +@[simp] +lemma tensorInner_tmul (J : A →CP (H →L[ℂ] H)) (a b : A) (h k : H) : + tensorInner J (a ⊗ₜ[ℂ] h) (b ⊗ₜ[ℂ] k) = + inner ℂ h (J (star a * b) k) := by + rfl + +lemma tensorInner_conj_symm_tmul (J : A →CP (H →L[ℂ] H)) (a b : A) (h k : H) : + starRingEnd ℂ (tensorInner J (a ⊗ₜ[ℂ] h) (b ⊗ₜ[ℂ] k)) = + tensorInner J (b ⊗ₜ[ℂ] k) (a ⊗ₜ[ℂ] h) := by + rw [tensorInner_tmul, tensorInner_tmul] + rw [inner_conj_symm] + have hstar : J (star b * a) = + ContinuousLinearMap.adjoint (J (star a * b)) := by + calc + J (star b * a) = J (star (star a * b)) := by + congr 1 + simp [star_mul] + _ = star (J (star a * b)) := + (completelyPositiveMap_map_star_general J _).symm + _ = ContinuousLinearMap.adjoint (J (star a * b)) := by rfl + rw [hstar] + exact (ContinuousLinearMap.adjoint_inner_right _ _ _).symm + +lemma tensorInner_conj_symm (J : A →CP (H →L[ℂ] H)) (x y : T A H) : + starRingEnd ℂ (tensorInner J x y) = tensorInner J y x := by + refine TensorProduct.induction_on x ?_ ?_ ?_ + · simp + · intro a h + refine TensorProduct.induction_on y ?_ ?_ ?_ + · simp + · intro b k + exact tensorInner_conj_symm_tmul J a b h k + · intro y z ihy ihz + simp only [map_add, ihy, ihz] + rw [LinearMap.add_apply] + · intro x y ihx ihy + rw [(tensorInner J).map_add] + rw [LinearMap.add_apply] + rw [map_add, ihx, ihy] + rw [map_add] + +lemma tensorInner_nonneg (J : A →CP (H →L[ℂ] H)) (x : T A H) : + 0 ≤ tensorInner J x x := by + obtain ⟨n, a, h, rfl⟩ := TensorProduct.exists_sum_tmul_eq x + let v : PiLp 2 (fun _ : Fin n => H) := WithLp.toLp 2 h + have hv (i : Fin n) : v.ofLp i = h i := rfl + have hp := cpKernel_inner_nonneg_natural' J a v + rw [Finset.sum_comm] at hp + simpa [tensorInner, sesquiBilinear, baseFunctional, v, hv, + Finset.sum_apply, inner_sum, sum_inner] using hp + +/-- `tensorInner`, packaged as a `PreInnerProductSpace.Core` on `T A H`. -/ +@[instance_reducible] +def tensorCore (J : A →CP (H →L[ℂ] H)) : + PreInnerProductSpace.Core ℂ (T A H) where + inner := fun x y => tensorInner J x y + conj_inner_symm := by + intro x y + exact tensorInner_conj_symm J y x + re_inner_nonneg := by + intro x + exact (tensorInner_nonneg J x).1 + add_left := by + intro x y z + exact congrArg (fun f => f z) ((tensorInner J).map_add x y) + smul_left := by + intro x y r + have hs := congrArg (fun f : T A H →ₗ[ℂ] ℂ => f y) + ((tensorInner J).map_smulₛₗ r x) + simp only [LinearMap.smul_apply, smul_eq_mul] at hs + exact hs + +/-- Left multiplication by `a` on the algebra factor of `T A H`. -/ +def leftMul (a : A) : T A H →ₗ[ℂ] T A H := + TensorProduct.map (LinearMap.mulLeft ℂ a) (LinearMap.id) + +@[simp] +lemma leftMul_tmul (a b : A) (h : H) : + leftMul a (b ⊗ₜ[ℂ] h) = (a * b) ⊗ₜ[ℂ] h := by + simp [leftMul] + +lemma tensorInner_leftMul (J : A →CP (H →L[ℂ] H)) (a : A) (x y : T A H) : + tensorInner J (leftMul a x) y = tensorInner J x (leftMul (star a) y) := by + refine TensorProduct.induction_on x ?_ ?_ ?_ + · simp + · intro b h + refine TensorProduct.induction_on y ?_ ?_ ?_ + · simp + · intro c k + simp [leftMul, star_mul, mul_assoc] + · intro y z ihy ihz + simp only [map_add, ihy, ihz] + · intro x z ihx ihz + rw [(leftMul a).map_add, (tensorInner J).map_add] + simp only [LinearMap.add_apply, map_add, ihx, ihz] + +lemma leftMul_mul (a b : A) (x : T A H) : + leftMul (a * b) x = leftMul a (leftMul b x) := by + refine TensorProduct.induction_on x ?_ ?_ ?_ + · simp + · intro c h + simp [leftMul] + · intro x y ihx ihy + simp only [map_add, ihx, ihy] + +lemma leftMul_add (a b : A) (x : T A H) : + leftMul (a + b) x = leftMul a x + leftMul b x := by + refine TensorProduct.induction_on x ?_ ?_ ?_ + · simp + · intro c h + simp [leftMul, add_mul, TensorProduct.add_tmul] + · intro x y ihx ihy + rw [(leftMul (a + b)).map_add, (leftMul a).map_add, (leftMul b).map_add, + ihx, ihy] + abel + +lemma leftMul_smul (r : ℂ) (a : A) (x : T A H) : + leftMul (r • a) x = r • leftMul a x := by + refine TensorProduct.induction_on x ?_ ?_ ?_ + · simp + · intro b h + rw [leftMul_tmul, leftMul_tmul] + rw [smul_mul_assoc] + rw [TensorProduct.smul_tmul, TensorProduct.tmul_smul] + · intro x y ihx ihy + rw [(leftMul (r • a)).map_add, (leftMul a).map_add, ihx, ihy, smul_add] + +lemma leftMul_one (x : T A H) : leftMul (1 : A) x = x := by + refine TensorProduct.induction_on x ?_ ?_ ?_ + · simp + · intro a h + simp [leftMul] + · intro x y ihx ihy + simp only [map_add, ihx, ihy] + +lemma leftMul_norm_sub (a : A) (x : T A H) : + leftMul ((‖a‖ ^ 2 : ℝ) • (1 : A) - star a * a) x = + (‖a‖ ^ 2 : ℂ) • x - leftMul (star a * a) x := by + refine TensorProduct.induction_on x ?_ ?_ ?_ + · simp + · intro b h + simp [leftMul, Algebra.smul_def, sub_mul, TensorProduct.sub_tmul] + simp [Algebra.smul_def, TensorProduct.smul_tmul'] + rw [IsScalarTower.algebraMap_apply ℝ ℂ A] + simp [mul_assoc] + · intro x y ihx ihy + rw [(leftMul ((‖a‖ ^ 2 : ℝ) • (1 : A) - star a * a)).map_add, + map_add, ihx, ihy] + simp only [smul_add] + abel + +lemma tensorInner_leftMul_selfadjoint (J : A →CP (H →L[ℂ] H)) {q : A} (hq : star q = q) + (x : T A H) : + tensorInner J (leftMul q x) x = tensorInner J x (leftMul q x) := by + rw [tensorInner_leftMul J q x x, hq] + +lemma tensorInner_leftMul_nonneg (J : A →CP (H →L[ℂ] H)) {q : A} (hq : 0 ≤ q) + (x : T A H) : 0 ≤ tensorInner J (leftMul q x) x := by + let s : A := CFC.sqrt q + have hs : star s = s := by + dsimp [s] + exact (CFC.sqrt_nonneg q).isSelfAdjoint.star_eq + have hsq : star s * s = q := by + dsimp [s] + rw [(CFC.sqrt_nonneg q).isSelfAdjoint.star_eq] + exact CFC.sqrt_mul_sqrt_self q hq + have hinner : tensorInner J (leftMul q x) x = + tensorInner J (leftMul s x) (leftMul s x) := by + rw [← hsq, leftMul_mul] + rw [tensorInner_leftMul J (star s) (leftMul s x) x] + simp [hs] + rw [hinner] + exact tensorInner_nonneg J _ + +/-! ## The seminorm and pre-Hilbert structures induced by the kernel -/ + +/-- The seminormed-group structure `T A H` inherits from `tensorCore`'s (possibly degenerate) +inner product. -/ +@[instance_reducible] +def tensorSeminormed (J : A →CP (H →L[ℂ] H)) : + SeminormedAddCommGroup (T A H) := + letI : PreInnerProductSpace.Core ℂ (T A H) := tensorCore J + InnerProductSpace.Core.toSeminormedAddCommGroup (c := tensorCore J) + +/-- The inner product space structure on `T A H`, with respect to `tensorSeminormed`, coming +from `tensorCore`. -/ +@[instance_reducible] +def tensorInnerProductSpace (J : A →CP (H →L[ℂ] H)) : + @InnerProductSpace ℂ (T A H) inferInstance (tensorSeminormed J) := by + letI : PreInnerProductSpace.Core ℂ (T A H) := tensorCore J + letI : Inner ℂ (T A H) := ⟨fun x y => tensorInner J x y⟩ + letI : SeminormedAddCommGroup (T A H) := tensorSeminormed J + exact + { toNormedSpace := InnerProductSpace.Core.toNormedSpace (c := tensorCore J) + inner := fun x y => tensorInner J x y + norm_sq_eq_re_inner := by + intro x + have hnorm := + (InnerProductSpace.Core.inner_self_eq_norm_mul_norm (c := tensorCore J) x) + change RCLike.re ((tensorCore J).inner x x) = ‖x‖ * ‖x‖ at hnorm + rw [pow_two] + change ‖x‖ * ‖x‖ = RCLike.re ((tensorCore J).inner x x) + simpa [pow_two] using hnorm.symm + conj_inner_symm := by + intro x y + exact tensorInner_conj_symm J y x + add_left := by + intro x y z + exact congrArg (fun f => f z) ((tensorInner J).map_add x y) + smul_left := by + intro x y r + have hs := congrArg (fun f : T A H →ₗ[ℂ] ℂ => f y) + ((tensorInner J).map_smulₛₗ r x) + simpa only [LinearMap.smul_apply, smul_eq_mul] using hs } + +lemma leftMul_norm_le (a : A) (J : A →CP (H →L[ℂ] H)) (x : T A H) : + letI : SeminormedAddCommGroup (T A H) := tensorSeminormed J + ‖leftMul a x‖ ≤ ‖a‖ * ‖x‖ := by + let : SeminormedAddCommGroup (T A H) := tensorSeminormed J + let q : A := (‖a‖ ^ 2 : ℝ) • (1 : A) - star a * a + have hq : 0 ≤ q := by + dsimp [q] + have hle : star a * a ≤ algebraMap ℝ A ‖star a * a‖ := by + exact (CStarAlgebra.norm_le_iff_le_algebraMap (star a * a) + (norm_nonneg _)).mp le_rfl + rw [CStarRing.norm_star_mul_self] at hle + simpa [sq, Algebra.algebraMap_eq_smul_one] using (sub_nonneg.mpr hle) + have hpos := tensorInner_leftMul_nonneg J hq x + rw [leftMul_norm_sub] at hpos + have hleft : tensorInner J (leftMul (star a * a) x) x = + tensorInner J (leftMul a x) (leftMul a x) := by + rw [tensorInner_leftMul J (star a * a) x x] + simp only [star_mul, star_star] + rw [tensorInner_leftMul J a x (leftMul a x)] + rw [← leftMul_mul] + have hident : tensorInner J + ((‖a‖ ^ 2 : ℂ) • x - leftMul (star a * a) x) x = + (‖a‖ ^ 2 : ℝ) * tensorInner J x x - + tensorInner J (leftMul a x) (leftMul a x) := by + rw [sub_eq_add_neg, (tensorInner J).map_add] + rw [LinearMap.add_apply, (tensorInner J).map_smulₛₗ, + LinearMap.smul_apply, smul_eq_mul] + rw [← neg_one_smul ℂ, (tensorInner J).map_smulₛₗ, + LinearMap.smul_apply, smul_eq_mul] + rw [hleft] + rw [show starRingEnd ℂ (‖a‖ ^ 2 : ℂ) = (‖a‖ ^ 2 : ℂ) by simp] + rw [show starRingEnd ℂ (-1 : ℂ) = (-1 : ℂ) by norm_num] + simp [sub_eq_add_neg] + rw [hident] at hpos + have hreal := (RCLike.nonneg_iff.mp hpos).1 + have hselfx : RCLike.re (tensorInner J x x) = ‖x‖ ^ 2 := by + have hnorm := + (InnerProductSpace.Core.inner_self_eq_norm_mul_norm (c := tensorCore J) x) + change RCLike.re ((tensorCore J).inner x x) = ‖x‖ * ‖x‖ at hnorm + rw [pow_two] + change RCLike.re ((tensorCore J).inner x x) = ‖x‖ * ‖x‖ + exact hnorm + have hselfa : RCLike.re (tensorInner J (leftMul a x) (leftMul a x)) = + ‖leftMul a x‖ ^ 2 := by + have hnorm := + (InnerProductSpace.Core.inner_self_eq_norm_mul_norm (c := tensorCore J) + (leftMul a x)) + change RCLike.re ((tensorCore J).inner (leftMul a x) (leftMul a x)) = + ‖leftMul a x‖ * ‖leftMul a x‖ at hnorm + rw [pow_two] + change RCLike.re ((tensorCore J).inner (leftMul a x) (leftMul a x)) = + ‖leftMul a x‖ * ‖leftMul a x‖ + exact hnorm + simp [map_sub, hselfx, hselfa] at hreal + simp [pow_two, Complex.mul_re, Complex.mul_im, Complex.ofReal_re, + Complex.ofReal_im] at hreal + have hreal' : ‖leftMul a x‖ ^ 2 ≤ ‖a‖ ^ 2 * ‖x‖ ^ 2 := by + simpa only [zero_mul, sub_zero, pow_two, mul_assoc] using hreal + have hax : 0 ≤ ‖a‖ * ‖x‖ := mul_nonneg (norm_nonneg _) (norm_nonneg _) + nlinarith [hreal'] + +lemma uniformContinuous_add (J : A →CP (H →L[ℂ] H)) : + letI : SeminormedAddCommGroup (T A H) := tensorSeminormed J + letI : PseudoMetricSpace (T A H) := SeminormedAddCommGroup.toPseudoMetricSpace + UniformContinuous fun p : T A H × T A H => p.1 + p.2 := by + let : SeminormedAddCommGroup (T A H) := tensorSeminormed J + let : PseudoMetricSpace (T A H) := SeminormedAddCommGroup.toPseudoMetricSpace + refine LipschitzWith.uniformContinuous (K := (2 : NNReal)) ?_ + apply LipschitzWith.of_dist_le_mul (K := (2 : NNReal)) + intro p q + rw [Prod.dist_eq] + calc + dist (p.1 + p.2) (q.1 + q.2) ≤ dist p.1 q.1 + dist p.2 q.2 := + dist_add_add_le _ _ _ _ + _ ≤ 2 * max (dist p.1 q.1) (dist p.2 q.2) := by + nlinarith [le_max_left (dist p.1 q.1) (dist p.2 q.2), + le_max_right (dist p.1 q.1) (dist p.2 q.2)] + +lemma uniformContinuous_neg (J : A →CP (H →L[ℂ] H)) : + letI : SeminormedAddCommGroup (T A H) := tensorSeminormed J + letI : PseudoMetricSpace (T A H) := SeminormedAddCommGroup.toPseudoMetricSpace + UniformContinuous fun x : T A H => -x := by + let : SeminormedAddCommGroup (T A H) := tensorSeminormed J + let : PseudoMetricSpace (T A H) := SeminormedAddCommGroup.toPseudoMetricSpace + refine LipschitzWith.uniformContinuous (K := (1 : NNReal)) ?_ + apply LipschitzWith.of_dist_le_mul (K := (1 : NNReal)) + intro x y + rw [SeminormedAddCommGroup.dist_eq, SeminormedAddCommGroup.dist_eq] + calc + ‖- -x + -y‖ = ‖-((-x) + y)‖ := by rw [neg_add_rev]; simp [add_comm] + _ = ‖-x + y‖ := norm_neg _ + simp only [NNReal.coe_one, one_mul] + exact le_rfl + +/-- `leftMul a`, bundled as a continuous linear map for the kernel seminorm. -/ +def leftMulCLM (J : A →CP (H →L[ℂ] H)) (a : A) : + letI : SeminormedAddCommGroup (T A H) := tensorSeminormed J + letI : InnerProductSpace ℂ (T A H) := tensorInnerProductSpace J + T A H →L[ℂ] T A H := by + letI : SeminormedAddCommGroup (T A H) := tensorSeminormed J + letI : InnerProductSpace ℂ (T A H) := tensorInnerProductSpace J + exact (leftMul a).mkContinuous ‖a‖ (fun x => leftMul_norm_le a J x) + +lemma leftMulCLM_apply (J : A →CP (H →L[ℂ] H)) (a : A) (x : T A H) : + letI : SeminormedAddCommGroup (T A H) := tensorSeminormed J + letI : InnerProductSpace ℂ (T A H) := tensorInnerProductSpace J + leftMulCLM J a x = leftMul a x := by + let : SeminormedAddCommGroup (T A H) := tensorSeminormed J + let : InnerProductSpace ℂ (T A H) := tensorInnerProductSpace J + rfl + +/-- The continuous extension of `leftMulCLM` to the completion of `T A H`. -/ +def leftMulCompletion (J : A →CP (H →L[ℂ] H)) (a : A) : + letI : SeminormedAddCommGroup (T A H) := tensorSeminormed J + letI : PseudoMetricSpace (T A H) := SeminormedAddCommGroup.toPseudoMetricSpace + letI : InnerProductSpace ℂ (T A H) := tensorInnerProductSpace J + letI : NormedSpace ℂ (T A H) := (tensorInnerProductSpace J).toNormedSpace + UniformSpace.Completion (T A H) →L[ℂ] UniformSpace.Completion (T A H) := by + letI : SeminormedAddCommGroup (T A H) := tensorSeminormed J + letI : PseudoMetricSpace (T A H) := SeminormedAddCommGroup.toPseudoMetricSpace + letI : InnerProductSpace ℂ (T A H) := tensorInnerProductSpace J + letI : NormedSpace ℂ (T A H) := (tensorInnerProductSpace J).toNormedSpace + letI : IsUniformAddGroup (T A H) := IsUniformAddGroup.mk' + (uniformContinuous_add J) (uniformContinuous_neg J) + letI : IsBoundedSMul ℂ (T A H) := NormSMulClass.toIsBoundedSMul + letI : UniformContinuousConstSMul ℂ (T A H) := + IsBoundedSMul.toUniformContinuousConstSMul + exact (leftMulCLM J a).completion + +@[simp] +lemma leftMulCompletion_coe (J : A →CP (H →L[ℂ] H)) (a : A) (x : T A H) : + letI : SeminormedAddCommGroup (T A H) := tensorSeminormed J + letI : PseudoMetricSpace (T A H) := SeminormedAddCommGroup.toPseudoMetricSpace + letI : InnerProductSpace ℂ (T A H) := tensorInnerProductSpace J + leftMulCompletion J a (x : UniformSpace.Completion (T A H)) = leftMulCLM J a x := by + let : SeminormedAddCommGroup (T A H) := tensorSeminormed J + let : PseudoMetricSpace (T A H) := SeminormedAddCommGroup.toPseudoMetricSpace + let : InnerProductSpace ℂ (T A H) := tensorInnerProductSpace J + let : NormedSpace ℂ (T A H) := (tensorInnerProductSpace J).toNormedSpace + let : IsUniformAddGroup (T A H) := IsUniformAddGroup.mk' + (uniformContinuous_add J) (uniformContinuous_neg J) + let : IsBoundedSMul ℂ (T A H) := NormSMulClass.toIsBoundedSMul + let : UniformContinuousConstSMul ℂ (T A H) := + IsBoundedSMul.toUniformContinuousConstSMul + change (leftMulCLM J a).completion (x : UniformSpace.Completion (T A H)) = + (leftMulCLM J a) x + exact ContinuousLinearMap.completion_apply_coe (leftMulCLM J a) x + +lemma leftMulCompletion_mul (J : A →CP (H →L[ℂ] H)) (a b : A) : + letI : SeminormedAddCommGroup (T A H) := tensorSeminormed J + letI : PseudoMetricSpace (T A H) := SeminormedAddCommGroup.toPseudoMetricSpace + letI : InnerProductSpace ℂ (T A H) := tensorInnerProductSpace J + letI : NormedSpace ℂ (T A H) := (tensorInnerProductSpace J).toNormedSpace + leftMulCompletion J (a * b) = + (leftMulCompletion J a).comp (leftMulCompletion J b) := by + let : SeminormedAddCommGroup (T A H) := tensorSeminormed J + let : PseudoMetricSpace (T A H) := SeminormedAddCommGroup.toPseudoMetricSpace + let : InnerProductSpace ℂ (T A H) := tensorInnerProductSpace J + let : NormedSpace ℂ (T A H) := (tensorInnerProductSpace J).toNormedSpace + let : IsUniformAddGroup (T A H) := IsUniformAddGroup.mk' + (uniformContinuous_add J) (uniformContinuous_neg J) + let : IsBoundedSMul ℂ (T A H) := NormSMulClass.toIsBoundedSMul + let : UniformContinuousConstSMul ℂ (T A H) := + IsBoundedSMul.toUniformContinuousConstSMul + apply ContinuousLinearMap.ext + intro z + refine UniformSpace.Completion.induction_on z ?_ ?_ + · apply isClosed_eq + · exact (leftMulCompletion J (a * b)).continuous + · exact ((leftMulCompletion J a).comp (leftMulCompletion J b)).continuous + · intro x + change (leftMulCLM J (a * b)).completion (x : UniformSpace.Completion (T A H)) = + (leftMulCLM J a).completion + ((leftMulCLM J b).completion (x : UniformSpace.Completion (T A H))) + rw [ContinuousLinearMap.completion_apply_coe] + rw [ContinuousLinearMap.completion_apply_coe] + rw [ContinuousLinearMap.completion_apply_coe] + rw [leftMulCLM_apply, leftMulCLM_apply, leftMulCLM_apply] + exact congrArg (fun y : T A H => (y : UniformSpace.Completion (T A H))) + (leftMul_mul a b x) + +/-! ## The canonical CP-dependent Hilbert space + +The CP kernel changes the norm, so its pre-Hilbert space is made a type synonym. This is the same +pattern used by Mathlib's own scalar GNS construction (`PositiveLinearMap.PreGNS`): the synonym +lets the tensor product retain its original module structure while carrying a CP-dependent +seminorm and inner product. -/ + +namespace Canonical + +/-- A type synonym for `T A H` carrying the CP-kernel-dependent seminorm and inner product, +kept separate so the tensor product retains its own module structure. -/ +@[nolint unusedArguments] +def Pre (_J : A →CP (H →L[ℂ] H)) := T A H + +instance (J : A →CP (H →L[ℂ] H)) : AddCommGroup (Pre J) := + inferInstanceAs (AddCommGroup (T A H)) + +instance (J : A →CP (H →L[ℂ] H)) : Module ℂ (Pre J) := + inferInstanceAs (Module ℂ (T A H)) + +instance (J : A →CP (H →L[ℂ] H)) : SeminormedAddCommGroup (Pre J) := + tensorSeminormed J + +instance (J : A →CP (H →L[ℂ] H)) : InnerProductSpace ℂ (Pre J) := + InnerProductSpace.ofCore (tensorCore J) + +instance (J : A →CP (H →L[ℂ] H)) : IsUniformAddGroup (Pre J) := + IsUniformAddGroup.mk' (uniformContinuous_add J) (uniformContinuous_neg J) + +instance (J : A →CP (H →L[ℂ] H)) : IsBoundedSMul ℂ (Pre J) := + NormSMulClass.toIsBoundedSMul + +instance (J : A →CP (H →L[ℂ] H)) : UniformContinuousConstSMul ℂ (Pre J) := + IsBoundedSMul.toUniformContinuousConstSMul + +/-- The completion of `Pre J`: the canonical Stinespring Hilbert space attached to `J`. -/ +abbrev K (J : A →CP (H →L[ℂ] H)) := UniformSpace.Completion (Pre J) + +/-- `leftMul a`, viewed as an operator on `Pre J`. -/ +def preLeftMul (J : A →CP (H →L[ℂ] H)) (a : A) : + Pre J →ₗ[ℂ] Pre J := leftMul a + +@[simp] +lemma preLeftMul_apply (J : A →CP (H →L[ℂ] H)) (a : A) (x : Pre J) : + preLeftMul J a x = leftMul a x := rfl + +/-- `preLeftMul`, bundled as a continuous linear map. -/ +def preLeftMulCLM (J : A →CP (H →L[ℂ] H)) (a : A) : + Pre J →L[ℂ] Pre J := + (preLeftMul J a).mkContinuous ‖a‖ (fun x => leftMul_norm_le a J x) + +@[simp] +lemma preLeftMulCLM_apply (J : A →CP (H →L[ℂ] H)) (a : A) (x : Pre J) : + preLeftMulCLM J a x = preLeftMul J a x := rfl + +lemma completion_leftMul_norm_le (J : A →CP (H →L[ℂ] H)) (a : A) (x : K J) : + ‖(preLeftMulCLM J a).completion x‖ ≤ ‖a‖ * ‖x‖ := by + refine UniformSpace.Completion.induction_on x ?_ ?_ + · apply isClosed_le + · exact (preLeftMulCLM J a).completion.continuous.norm + · exact (continuous_const.mul continuous_norm) + · intro y + rw [ContinuousLinearMap.completion_apply_coe, UniformSpace.Completion.norm_coe, + preLeftMulCLM_apply, preLeftMul_apply, UniformSpace.Completion.norm_coe] + exact leftMul_norm_le a J y + +/-- The continuous extension of `preLeftMulCLM` to the completion `K J`. -/ +def leftMulK (J : A →CP (H →L[ℂ] H)) (a : A) : K J →L[ℂ] K J := + ((preLeftMulCLM J a).completion.toLinearMap).mkContinuous ‖a‖ + (completion_leftMul_norm_le J a) + +@[simp] +lemma leftMulK_coe (J : A →CP (H →L[ℂ] H)) (a : A) (x : Pre J) : + leftMulK J a (x : K J) = preLeftMulCLM J a x := + ContinuousLinearMap.completion_apply_coe (preLeftMulCLM J a) x + +lemma leftMulK_mul (J : A →CP (H →L[ℂ] H)) (a b : A) : + leftMulK J (a * b) = (leftMulK J a).comp (leftMulK J b) := by + apply ContinuousLinearMap.ext + intro z + refine UniformSpace.Completion.induction_on z ?_ ?_ + · apply isClosed_eq + · exact (leftMulK J (a * b)).continuous + · exact ((leftMulK J a).comp (leftMulK J b)).continuous + · intro x + rw [leftMulK_coe, ContinuousLinearMap.comp_apply, leftMulK_coe, leftMulK_coe] + rw [preLeftMulCLM_apply, preLeftMulCLM_apply, preLeftMulCLM_apply] + exact congrArg (fun y : Pre J => (y : K J)) (leftMul_mul a b x) + +lemma leftMulK_one (J : A →CP (H →L[ℂ] H)) : + leftMulK J (1 : A) = ContinuousLinearMap.id ℂ (K J) := by + apply ContinuousLinearMap.ext + intro z + refine UniformSpace.Completion.induction_on z ?_ ?_ + · apply isClosed_eq + · exact (leftMulK J (1 : A)).continuous + · fun_prop + · intro x + rw [leftMulK_coe] + change ((preLeftMulCLM J (1 : A)) x : K J) = (x : K J) + rw [preLeftMulCLM_apply, preLeftMul_apply] + exact congrArg (fun y : Pre J => (y : K J)) (leftMul_one x) + +lemma leftMulK_add (J : A →CP (H →L[ℂ] H)) (a b : A) : + leftMulK J (a + b) = leftMulK J a + leftMulK J b := by + apply ContinuousLinearMap.ext + intro z + refine UniformSpace.Completion.induction_on z ?_ ?_ + · apply isClosed_eq + · exact (leftMulK J (a + b)).continuous + · fun_prop + · intro x + rw [leftMulK_coe] + rw [add_apply, leftMulK_coe, leftMulK_coe] + rw [preLeftMulCLM_apply, preLeftMulCLM_apply, preLeftMulCLM_apply] + rw [← UniformSpace.Completion.coe_add] + exact congrArg (fun y : Pre J => (y : K J)) (leftMul_add a b x) + +lemma leftMulK_smul (J : A →CP (H →L[ℂ] H)) (r : ℂ) (a : A) : + leftMulK J (r • a) = r • leftMulK J a := by + apply ContinuousLinearMap.ext + intro z + refine UniformSpace.Completion.induction_on z ?_ ?_ + · apply isClosed_eq + · exact (leftMulK J (r • a)).continuous + · exact (leftMulK J a).continuous.const_smul r + · intro x + rw [leftMulK_coe] + rw [smul_apply, leftMulK_coe] + rw [preLeftMulCLM_apply, preLeftMulCLM_apply] + rw [← UniformSpace.Completion.coe_smul] + exact congrArg (fun y : Pre J => (y : K J)) (leftMul_smul r a x) + +set_option backward.isDefEq.respectTransparency false in +lemma leftMulK_star (J : A →CP (H →L[ℂ] H)) (a : A) : + leftMulK J (star a) = (leftMulK J a).adjoint := by + refine (eq_adjoint_iff (leftMulK J (star a)) (leftMulK J a)).mpr ?_ + intro x y + refine UniformSpace.Completion.induction_on₂ x y ?_ ?_ + · apply isClosed_eq + · fun_prop + · fun_prop + · intro u v + rw [leftMulK_coe, UniformSpace.Completion.inner_coe, + leftMulK_coe, UniformSpace.Completion.inner_coe] + rw [preLeftMulCLM_apply, preLeftMulCLM_apply] + change tensorInner J (leftMul (star a) u) v = tensorInner J u (leftMul a v) + rw [tensorInner_leftMul] + simp only [star_star] + +/-- The canonical embedding `H → Pre J`, `h ↦ 1 ⊗ h`. -/ +def preEmbedding (J : A →CP (H →L[ℂ] H)) : H →ₗ[ℂ] Pre J := + (TensorProduct.mk ℂ A H) 1 + +@[simp] +lemma preEmbedding_apply (J : A →CP (H →L[ℂ] H)) (h : H) : + preEmbedding J h = (1 : A) ⊗ₜ[ℂ] h := rfl + +lemma preEmbedding_norm_sq (J : A →CP (H →L[ℂ] H)) (h : H) : + ‖preEmbedding J h‖ ^ 2 = RCLike.re (inner ℂ h (J (1 : A) h)) := by + rw [@norm_sq_eq_re_inner ℂ (Pre J) _ _] + change RCLike.re (tensorInner J ((1 : A) ⊗ₜ[ℂ] h) ((1 : A) ⊗ₜ[ℂ] h)) = _ + rw [tensorInner_tmul] + simp + +lemma preEmbedding_norm_le (J : A →CP (H →L[ℂ] H)) (h : H) : + ‖preEmbedding J h‖ ≤ Real.sqrt ‖J (1 : A)‖ * ‖h‖ := by + have hsq : ‖preEmbedding J h‖ ^ 2 ≤ + (Real.sqrt ‖J (1 : A)‖ * ‖h‖) ^ 2 := by + rw [preEmbedding_norm_sq] + calc + RCLike.re (inner ℂ h (J (1 : A) h)) ≤ ‖inner ℂ h (J (1 : A) h)‖ := + RCLike.re_le_norm _ + _ ≤ ‖h‖ * ‖J (1 : A) h‖ := norm_inner_le_norm _ _ + _ ≤ ‖h‖ * (‖J (1 : A)‖ * ‖h‖) := by + exact mul_le_mul_of_nonneg_left + (ContinuousLinearMap.le_opNorm (J (1 : A)) h) (norm_nonneg _) + _ = (Real.sqrt ‖J (1 : A)‖ * ‖h‖) ^ 2 := by + rw [mul_pow, Real.sq_sqrt (norm_nonneg _)] + ring + exact (sq_le_sq₀ (norm_nonneg _) (mul_nonneg (Real.sqrt_nonneg _) + (norm_nonneg _))).mp hsq + +/-- `preEmbedding`, bundled as a continuous linear map. -/ +def preEmbeddingCLM (J : A →CP (H →L[ℂ] H)) : H →L[ℂ] Pre J := + (preEmbedding J).mkContinuous (Real.sqrt ‖J (1 : A)‖) (preEmbedding_norm_le J) + +/-- The canonical embedding `H → K J` into the completed Stinespring space. -/ +def embedding (J : A →CP (H →L[ℂ] H)) : H →L[ℂ] K J := + (UniformSpace.Completion.toComplL : Pre J →L[ℂ] K J).comp (preEmbeddingCLM J) + +@[simp] +lemma embedding_apply (J : A →CP (H →L[ℂ] H)) (h : H) : + embedding J h = (preEmbedding J h : K J) := rfl + +set_option backward.isDefEq.respectTransparency false in +/-- The representation of `A` on `K J` by (extended) left multiplication. -/ +def canonicalRepresentation (J : A →CP (H →L[ℂ] H)) : + A →⋆ₐ[ℂ] (K J →L[ℂ] K J) where + toFun := leftMulK J + map_one' := leftMulK_one J + map_mul' := leftMulK_mul J + map_zero' := by + simpa only [map_zero, zero_smul] using (leftMulK_smul J 0 0) + map_add' := leftMulK_add J + commutes' := by + intro r + calc + leftMulK J ((algebraMap ℂ A) r) = r • leftMulK J (1 : A) := by + simpa [Algebra.smul_def] using (leftMulK_smul J r (1 : A)) + _ = (algebraMap ℂ (K J →L[ℂ] K J)) r := by + rw [leftMulK_one] + simp [Algebra.algebraMap_eq_smul_one, ContinuousLinearMap.one_def] + map_star' := leftMulK_star J + +set_option backward.isDefEq.respectTransparency false in +/-- **Stinespring's dilation identity**: `J a = V⋆ π(a) V`, where `π` is `canonicalRepresentation` +and `V` is `embedding`. -/ +theorem canonical_stinespring_identity (J : A →CP (H →L[ℂ] H)) (a : A) : + J a = ContinuousLinearMap.adjoint (embedding J) ∘L + (canonicalRepresentation J a) ∘L embedding J := by + apply ContinuousLinearMap.ext + intro x + rw [@ext_iff_inner_left ℂ H _ _] + intro y + rw [ContinuousLinearMap.comp_apply, ContinuousLinearMap.comp_apply] + rw [ContinuousLinearMap.adjoint_inner_right] + rw [embedding_apply, embedding_apply] + change inner ℂ y (J a x) = + inner ℂ (preEmbedding J y : K J) (leftMulK J a (preEmbedding J x : K J)) + rw [leftMulK_coe] + rw [UniformSpace.Completion.inner_coe] + rw [preLeftMulCLM_apply, preLeftMul_apply] + rw [preEmbedding_apply, preEmbedding_apply] + change inner ℂ y (J a x) = + tensorInner J ((1 : A) ⊗ₜ[ℂ] y) (leftMul a ((1 : A) ⊗ₜ[ℂ] x)) + rw [leftMul_tmul, tensorInner_tmul] + simp + +/-- The canonical Stinespring witness assembled from `canonicalRepresentation` and +`embedding`. -/ +def canonicalWitness (J : A →CP (H →L[ℂ] H)) : + StinespringWitness A H (K J) J where + representation := canonicalRepresentation J + implementing := embedding J + map_eq := canonical_stinespring_identity J + +end Canonical + +/-- **Stinespring's dilation theorem.** Every completely positive map `J : A →CP (H →L[ℂ] H)` out +of a unital C⋆-algebra `A` admits a dilation: an auxiliary Hilbert space `K`, a `⋆`-representation +`π : A →⋆ₐ[ℂ] (K →L[ℂ] K)`, and an implementing operator `V : H →L[ℂ] K` with +`J a = V⋆ π(a) V` for every `a`. The canonical GNS-style construction (`Canonical.canonicalWitness`) +exhibits such a `K`, `π`, `V` concretely; this packages that as a bare existence statement. -/ +theorem exists_stinespringWitness (J : A →CP (H →L[ℂ] H)) : + Nonempty (StinespringWitness A H (Canonical.K J) J) := + ⟨Canonical.canonicalWitness J⟩ + +end Stinespring diff --git a/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/Stinespring/Kernel.lean b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/Stinespring/Kernel.lean new file mode 100644 index 0000000000..08d342af52 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/Stinespring/Kernel.lean @@ -0,0 +1,307 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Mathlib.Analysis.CStarAlgebra.CompletelyPositiveMap +public import Mathlib.Analysis.CStarAlgebra.CStarMatrix +public import Mathlib.Analysis.InnerProductSpace.PiL2 +public import Mathlib.Analysis.InnerProductSpace.Positive +public import Mathlib.Analysis.InnerProductSpace.StarOrder + +/-! + +# The Stinespring witness and its finite-dimensional positivity kernel + +Ported from `unbounded-alpha-public`'s `QuantumMechanics/Unbounded/OperatorAlgebra/Dynamics/ +ChristensenEvans/P1.lean`, restated against this repo's own bare Mathlib hypotheses instead of the +upstream-superseded `OperatorAlgebra` class (`[OperatorAlgebra A]` there is exactly +`[CStarAlgebra A] [PartialOrder A] [StarOrderedRing A]` here — `OperatorAlgebra` adds no field or +axiom beyond those three, so the translation is a pure restatement, not new mathematics). + +A completely positive map `J : A →CP (H →L[ℂ] H)` (Mathlib's own `CompletelyPositiveMap`, matrix- +amplified positivity) is exactly a positive-definite `B(H)`-valued kernel on `A`: applying `J` to +the Gram matrix of any finite family `a : Fin n → A` gives a positive block operator on the +finite Hilbert sum `⊕ᵢ H`. This file builds that translation (`blockMatrixMap`, `gramMatrix`, +`cpKernel_inner_nonneg_natural'`) and the `StinespringWitness` structure recording a concrete +dilation `J a = V⋆ π(a) V`. `Dilation.lean` builds the canonical witness that always exists. + +## Main definitions + +- `blockMatrixMap` : a `CStarMatrix (Fin n) (Fin n) (H →L[ℂ] H)` acting block-by-block on the + finite Hilbert sum `PiLp 2 (Fin n → H)`, and its algebraic API (`_mul`, `_star`, `_one`, ...). +- `gramMatrix`, `cpKernel_inner_nonneg_natural'` : the CP-map positivity kernel on finite families. +- `StinespringWitness A H K J` : a concrete dilation of `J` — an auxiliary Hilbert space `K`, a + representation `π : A →⋆ₐ[ℂ] (K →L[ℂ] K)`, and an implementing operator `V : H →L[ℂ] K` with + `J a = V⋆ π(a) V`. +- `completelyPositiveMap_map_star_general` : a CP map between C⋆-algebras is automatically + star-preserving. + +-/ + +@[expose] public section + +open scoped ComplexOrder CStarAlgebra +open ContinuousLinearMap + +noncomputable section + +/-! ## `blockMatrixMap`: the finite block-operator representation + +This part uses only the codomain Hilbert space `H`, no algebra `A` at all. -/ + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-- The bounded operator on `PiLp 2 (Fin n → H)` acting block-by-block by `M`. -/ +def blockMatrixMap {n : ℕ} (M : CStarMatrix (Fin n) (Fin n) (H →L[ℂ] H)) : + PiLp 2 (fun _ : Fin n => H) →L[ℂ] PiLp 2 (fun _ : Fin n => H) := by + let e : PiLp 2 (fun _ : Fin n => H) ≃L[ℂ] (∀ _ : Fin n, H) := + PiLp.continuousLinearEquiv 2 ℂ (fun _ : Fin n => H) + let p : (∀ _ : Fin n, H) →L[ℂ] (∀ _ : Fin n, H) := + ContinuousLinearMap.pi (fun i => + ∑ j, (M i j).comp (ContinuousLinearMap.proj j)) + exact e.symm.toContinuousLinearMap.comp (p.comp e.toContinuousLinearMap) + +omit [CompleteSpace H] in +@[nolint unusedArguments, simp] +lemma blockMatrixMap_apply {n : ℕ} (M : CStarMatrix (Fin n) (Fin n) (H →L[ℂ] H)) + (x : PiLp 2 (fun _ : Fin n => H)) (i : Fin n) : + (blockMatrixMap M x).ofLp i = ∑ j, M i j (x.ofLp j) := by + simp [blockMatrixMap, PiLp.coe_continuousLinearEquiv] + +lemma blockMatrixMap_star {n : ℕ} (M : CStarMatrix (Fin n) (Fin n) (H →L[ℂ] H)) : + blockMatrixMap (star M) = (blockMatrixMap M).adjoint := by + apply ContinuousLinearMap.ext + intro x + apply ext_inner_right ℂ + intro y + rw [ContinuousLinearMap.adjoint_inner_left] + simp only [PiLp.inner_apply, blockMatrixMap_apply, + CStarMatrix.star_eq_conjTranspose, CStarMatrix.conjTranspose_apply, + ContinuousLinearMap.star_eq_adjoint, sum_inner, inner_sum] + simp_rw [ContinuousLinearMap.adjoint_inner_left] + rw [Finset.sum_comm] + +omit [CompleteSpace H] in +lemma blockMatrixMap_mul {n : ℕ} (M N : CStarMatrix (Fin n) (Fin n) (H →L[ℂ] H)) : + blockMatrixMap (M * N) = blockMatrixMap M ∘L blockMatrixMap N := by + apply ContinuousLinearMap.ext + intro x + apply PiLp.ext + intro i + simp only [blockMatrixMap_apply, ContinuousLinearMap.comp_apply, CStarMatrix.mul_apply] + simp_rw [sum_apply] + rw [Finset.sum_comm] + simp_rw [mul_apply_eq_comp] + simp_rw [map_sum] + +omit [CompleteSpace H] in +lemma blockMatrixMap_one {n : ℕ} : + blockMatrixMap (1 : CStarMatrix (Fin n) (Fin n) (H →L[ℂ] H)) = ContinuousLinearMap.id ℂ _ := by + apply ContinuousLinearMap.ext + intro x + apply PiLp.ext + intro i + rw [blockMatrixMap_apply] + rw [Finset.sum_eq_single i] + · simp + · intro j _ hji + simp [Ne.symm hji] + · simp + +omit [CompleteSpace H] in +lemma blockMatrixMap_add {n : ℕ} (M N : CStarMatrix (Fin n) (Fin n) (H →L[ℂ] H)) : + blockMatrixMap (M + N) = blockMatrixMap M + blockMatrixMap N := by + apply ContinuousLinearMap.ext + intro x + apply PiLp.ext + intro i + rw [blockMatrixMap_apply] + rw [add_apply, PiLp.add_apply] + simp only [CStarMatrix.add_apply] + simp_rw [add_apply] + rw [Finset.sum_add_distrib] + rw [blockMatrixMap_apply, blockMatrixMap_apply] + +omit [CompleteSpace H] in +lemma blockMatrixMap_zero {n : ℕ} : + blockMatrixMap (0 : CStarMatrix (Fin n) (Fin n) (H →L[ℂ] H)) = 0 := by + apply ContinuousLinearMap.ext + intro x + apply PiLp.ext + intro i + simp [blockMatrixMap_apply] + +/-- `blockMatrixMap`, packaged as a star algebra homomorphism from +`CStarMatrix (Fin n) (Fin n) (H →L[ℂ] H)`. -/ +def blockMatrixRepresentation {n : ℕ} : + CStarMatrix (Fin n) (Fin n) (H →L[ℂ] H) →⋆ₐ[ℂ] + (PiLp 2 (fun _ : Fin n => H) →L[ℂ] PiLp 2 (fun _ : Fin n => H)) where + toFun := blockMatrixMap + map_one' := blockMatrixMap_one + map_mul' := blockMatrixMap_mul + map_zero' := blockMatrixMap_zero + map_add' := blockMatrixMap_add + commutes' := by + intro c + apply ContinuousLinearMap.ext + intro x + apply PiLp.ext + intro i + rw [blockMatrixMap_apply] + simp only [Algebra.algebraMap_eq_smul_one, smul_apply] + rw [Finset.sum_eq_single i] + · simp + · intro j _ hji + simp [Ne.symm hji] + · simp + map_star' := blockMatrixMap_star + +lemma blockMatrixMap_isPositive {n : ℕ} {M : CStarMatrix (Fin n) (Fin n) (H →L[ℂ] H)} + (hM : 0 ≤ M) : (blockMatrixMap M).IsPositive := by + apply (ContinuousLinearMap.nonneg_iff_isPositive _).mp + change 0 ≤ (blockMatrixRepresentation (H := H) (n := n)) M + exact map_nonneg (blockMatrixRepresentation (H := H) (n := n)) hM + +lemma blockMatrixMap_inner_nonneg {n : ℕ} {M : CStarMatrix (Fin n) (Fin n) (H →L[ℂ] H)} + (hM : 0 ≤ M) (x : PiLp 2 (fun _ : Fin n => H)) : + 0 ≤ ∑ i, ∑ j, inner ℂ (M i j (x.ofLp j)) (x.ofLp i) := by + have h := (blockMatrixMap_isPositive hM).inner_nonneg_left x + simpa [PiLp.inner_apply, blockMatrixMap_apply, sum_inner, inner_sum] using h + +/-! ## The CP-map positivity kernel + +From here on, `A` is a unital C⋆-algebra with the compatible Mathlib order (`[CStarAlgebra A] +[PartialOrder A] [StarOrderedRing A]`) — the field content of `OperatorAlgebra A`. -/ + +variable {A : Type*} [CStarAlgebra A] [PartialOrder A] [StarOrderedRing A] + +/-- A CP map between C⋆-algebras is automatically star-preserving. -/ +lemma completelyPositiveMap_map_star_general + {A B : Type*} [CStarAlgebra A] [PartialOrder A] [StarOrderedRing A] + [CStarAlgebra B] [PartialOrder B] [StarOrderedRing B] + (J : A →CP B) (a : A) : star (J a) = J (star a) := by + obtain ⟨x, hx, _, ha⟩ := CStarAlgebra.exists_sum_four_nonneg a + rw [ha] + simp only [map_sum, map_smul, star_sum, star_smul] + apply Finset.sum_congr rfl + intro i _ + have hxi : IsSelfAdjoint (x i) := IsSelfAdjoint.of_nonneg (hx i) + have hJxi : IsSelfAdjoint (J (x i)) := + IsSelfAdjoint.of_nonneg (map_nonneg J (hx i)) + rw [hJxi.star_eq, hxi.star_eq] + +/-- A square matrix whose only nonzero row is the zeroth row. -/ +def rowMatrix {n : ℕ} [NeZero n] (a : Fin n → A) : + CStarMatrix (Fin n) (Fin n) A := fun i j => if i = 0 then a j else 0 + +/-- The Gram matrix of a finite family of elements of a C⋆-algebra. -/ +def gramMatrix {n : ℕ} [NeZero n] (a : Fin n → A) : + CStarMatrix (Fin n) (Fin n) A := star (rowMatrix a) * rowMatrix a + +omit [PartialOrder A] [StarOrderedRing A] in +@[simp] +lemma gramMatrix_apply {n : ℕ} [NeZero n] (a : Fin n → A) (i j : Fin n) : + gramMatrix a i j = star (a i) * a j := by + simp [gramMatrix, rowMatrix, CStarMatrix.mul_apply, CStarMatrix.star_eq_conjTranspose] + +lemma gramMatrix_nonneg {n : ℕ} [NeZero n] (a : Fin n → A) : 0 ≤ gramMatrix a := + star_mul_self_nonneg (rowMatrix a) + +lemma cpGramMatrix_nonneg {n : ℕ} [NeZero n] (J : A →CP (H →L[ℂ] H)) (a : Fin n → A) : + 0 ≤ (gramMatrix a).map J := + J.map_cstarMatrix_nonneg _ (gramMatrix_nonneg a) + +lemma cpKernel_inner_nonneg {n : ℕ} [NeZero n] (J : A →CP (H →L[ℂ] H)) (a : Fin n → A) + (x : PiLp 2 (fun _ : Fin n => H)) : + 0 ≤ ∑ i, ∑ j, inner ℂ (J (star (a i) * a j) (x.ofLp j)) (x.ofLp i) := by + have h := blockMatrixMap_inner_nonneg (cpGramMatrix_nonneg J a) x + simpa [gramMatrix_apply] using h + +lemma cpKernel_inner_nonneg' {n : ℕ} (J : A →CP (H →L[ℂ] H)) (a : Fin n → A) + (x : PiLp 2 (fun _ : Fin n => H)) : + 0 ≤ ∑ i, ∑ j, inner ℂ (J (star (a i) * a j) (x.ofLp j)) (x.ofLp i) := by + rcases n with _ | n + · simp + · let _ : NeZero (Nat.succ n) := ⟨Nat.succ_ne_zero n⟩ + exact cpKernel_inner_nonneg J a x + +lemma cpKernel_inner_nonneg_natural {n : ℕ} [NeZero n] (J : A →CP (H →L[ℂ] H)) (a : Fin n → A) + (x : PiLp 2 (fun _ : Fin n => H)) : + 0 ≤ ∑ i, ∑ j, inner ℂ (x.ofLp i) (J (star (a i) * a j) (x.ofLp j)) := by + have hM : 0 ≤ (star (gramMatrix a)).map J := + J.map_cstarMatrix_nonneg _ (star_nonneg_iff.mpr (gramMatrix_nonneg a)) + have h := blockMatrixMap_inner_nonneg hM x + rw [Finset.sum_comm] at h + have hterm (i j : Fin n) : + inner ℂ ((J (star (a j) * a i)) (x.ofLp i)) (x.ofLp j) = + inner ℂ (x.ofLp i) ((J (star (a i) * a j)) (x.ofLp j)) := by + rw [← ContinuousLinearMap.adjoint_inner_left] + have hop : J (star (a j) * a i) = + ContinuousLinearMap.adjoint (J (star (a i) * a j)) := by + calc + J (star (a j) * a i) = J (star (star (a i) * a j)) := by + congr 1 + simp [star_mul] + _ = star (J (star (a i) * a j)) := + (completelyPositiveMap_map_star_general J _).symm + _ = ContinuousLinearMap.adjoint (J (star (a i) * a j)) := by + rfl + rw [hop] + have h' : 0 ≤ ∑ i, ∑ j, + inner ℂ ((J (star (a j) * a i)) (x.ofLp i)) (x.ofLp j) := by + simpa [gramMatrix_apply, CStarMatrix.star_apply] using h + have hEq : (∑ i, ∑ j, + inner ℂ ((J (star (a j) * a i)) (x.ofLp i)) (x.ofLp j)) = + ∑ i, ∑ j, inner ℂ (x.ofLp i) ((J (star (a i) * a j)) (x.ofLp j)) := by + apply Finset.sum_congr rfl + intro i _ + apply Finset.sum_congr rfl + intro j _ + exact hterm i j + rw [← hEq] + exact h' + +lemma cpKernel_inner_nonneg_natural' {n : ℕ} (J : A →CP (H →L[ℂ] H)) (a : Fin n → A) + (x : PiLp 2 (fun _ : Fin n => H)) : + 0 ≤ ∑ i, ∑ j, inner ℂ (x.ofLp i) (J (star (a i) * a j) (x.ofLp j)) := by + rcases n with _ | n + · simp + · let _ : NeZero (Nat.succ n) := ⟨Nat.succ_ne_zero n⟩ + exact cpKernel_inner_nonneg_natural J a x + +/-! ## Stinespring witnesses -/ + +variable {K : Type*} [NormedAddCommGroup K] [InnerProductSpace ℂ K] [CompleteSpace K] + +/-- A Stinespring witness for a completely positive map into bounded operators. + +This is the operator-level form of a dilation: the auxiliary space `K`, the representation `π`, +and the implementing operator `V` are data of the witness. Existence of such a witness (for every +CP map) is `Dilation.lean`'s canonical construction, kept as a separate theorem rather than an +instance or an axiom. -/ +structure StinespringWitness (A H K : Type*) [CStarAlgebra A] [PartialOrder A] + [StarOrderedRing A] [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + [NormedAddCommGroup K] [InnerProductSpace ℂ K] [CompleteSpace K] + (J : A →CP (H →L[ℂ] H)) where + /-- The representation of the input operator algebra on the auxiliary space. -/ + representation : A →⋆ₐ[ℂ] (K →L[ℂ] K) + /-- The implementing bounded operator from the physical space to the auxiliary space. -/ + implementing : H →L[ℂ] K + /-- The Stinespring identity: `J a = V⋆ π(a) V`. -/ + map_eq : ∀ a : A, + J a = ContinuousLinearMap.adjoint implementing ∘L + (representation a) ∘L implementing + +namespace StinespringWitness + +variable {J : A →CP (H →L[ℂ] H)} (W : StinespringWitness A H K J) + +lemma map_eq_apply (a : A) : + J a = ContinuousLinearMap.adjoint W.implementing ∘L + (W.representation a) ∘L W.implementing := + W.map_eq a + +end StinespringWitness diff --git a/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/Uncertainty.lean b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/Uncertainty.lean new file mode 100644 index 0000000000..63abb2a2a3 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/CStarAlgebra/Uncertainty.lean @@ -0,0 +1,175 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.StarAlgebra.Statistics +public import PhyslibAlpha.AlgebraicFramework.StarAlgebra.Lie +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.GNS + +/-! + +# Uncertainty relations + +Positivity of a state gives a Cauchy–Schwarz inequality for expectation values. Applied to +centered observables, this yields the Robertson–Schrödinger and Robertson uncertainty relations. + +Unlike `StarAlgebra.Statistics`, this file genuinely needs a C⋆-algebra: `gns_cauchy_schwarz`, the +seed of every inequality below, is Cauchy–Schwarz for the sesquilinear form `(x, y) ↦ ω(x⋆y)`, and +the cleanest route to it is through the GNS Hilbert space `ω.GNS` of `CStarAlgebra.GNS` — the +completion needs `CStarAlgebra A`, not just a bare star-ordered ring. We get it from the +already-built `UnitalPositiveLinearMap.gnsRep`/`gnsCyclicVector` API (rather than reaching past +`GNS.lean` into mathlib's raw `PreGNS` machinery) via the identity +`⟪π_ω(x) Ω_ω, π_ω(y) Ω_ω⟫ = ω(x⋆y)`: expand the inner product using that `π_ω` is a +⋆-representation and that `Ω_ω` reproduces `ω` (`inner_gnsCyclicVector_gnsRep_gnsCyclicVector`), +then invoke the general Cauchy–Schwarz inequality `inner_mul_inner_self_le` on the Hilbert space +`ω.GNS`. + +The commutator observable used to state the relations is the Lie bracket `⁅a, b⁆` already built in +`StarAlgebra/Lie.lean`; the only fact about it needed here beyond what that file already proves is +that centering leaves it unchanged (`bracket_centered`). + +## Main results + +- `gns_cauchy_schwarz` : Cauchy–Schwarz for the state-induced sesquilinear form on `A`. +- `robertson_schrodinger` : the Robertson–Schrödinger uncertainty inequality, jointly bounding + covariance and the commutator's expectation by the product of the spreads. +- `covariance_cauchy_schwarz`, `robertson` : the familiar `|correlation| ≤ σ_a σ_b` and + Heisenberg-type `|⟨⁅a,b⁆⟩| ≤ σ_a σ_b` relations obtained from it by dropping one term. + +-/ + +@[expose] public section + +open scoped ComplexOrder InnerProductSpace +open ContinuousLinearMap + +variable {A : Type*} [CStarAlgebra A] [PartialOrder A] [StarOrderedRing A] + +open scoped selfAdjoint + +namespace UnitalPositiveLinearMap + +omit [PartialOrder A] [StarOrderedRing A] in +/-- A real multiple of `1` commutes with everything: the algebraic fact making `commutator` +insensitive to shifting by a constant. -/ +private lemma smul_one_comm (r : ℝ) (x : A) : (r • (1 : A)) * x = x * (r • (1 : A)) := by + rw [smul_mul_assoc, one_mul, mul_smul_comm, mul_one] + +/-- The commutator only sees fluctuations, not means: centering `a` and `b` changes nothing about +how badly they fail to commute, since scalar multiples of `1` commute with everything and so +contribute nothing to `ab - ba`. -/ +lemma bracket_centered (ω : 𝓢[A]) (a b : Observable A) : + ⁅centered ω a, centered ω b⁆ = ⁅a, b⁆ := by + apply Subtype.ext + simp only [selfAdjoint.coe_bracket] + congr 1 + show (centered ω a : A) * centered ω b - (centered ω b : A) * centered ω a = + (a : A) * b - (b : A) * a + simp only [centered, LinearMap.centered, AddSubgroup.coe_sub, selfAdjoint.val_smul, + selfAdjoint.val_one, mul_sub, sub_mul] + rw [smul_one_comm ((expectation ω).toLinearMap b) (a : A), + smul_one_comm ((expectation ω).toLinearMap a) (b : A), + smul_one_comm ((expectation ω).toLinearMap a) + ((expectation ω).toLinearMap b • (1 : A))] + abel + +/-- The expectation of a raw product of two fluctuations splits into a real symmetric part +(covariance) and an imaginary antisymmetric part (the commutator's expectation). This is what +turns the Cauchy–Schwarz bound below into simultaneous control on covariance and commutator. -/ +lemma apply_centered_mul_centered (ω : 𝓢[A]) (a b : Observable A) : + ω ((centered ω a : A) * centered ω b) = + (covariance ω a b : ℂ) + Complex.I * (ω⟨⁅a, b⁆⟩ : ℂ) := by + set z := ω ((centered ω a : A) * centered ω b) with hz + have hstar : ω ((centered ω b : A) * centered ω a) = star z := by + rw [hz, apply_mul_comm_eq_star] + have hsub : ω ((centered ω a : A) * centered ω b - (centered ω b : A) * centered ω a) = + (2 * z.im : ℝ) * Complex.I := by + rw [map_sub, hstar, ← hz, Complex.star_def, Complex.sub_conj] + have hcomm : (ω⟨⁅a, b⁆⟩ : ℂ) = (z.im : ℂ) := by + rw [← bracket_centered ω a b, ← apply_observable_eq_expectation, selfAdjoint.coe_bracket, + map_smul, hsub, smul_eq_mul] + ring_nf + rw [Complex.I_sq] + push_cast + ring + have hcov : covariance ω a b = z.re := by + rw [covariance_eq_re_apply_centered_mul, hz] + rw [hcomm, hcov, mul_comm, Complex.re_add_im] + +/-! ## Cauchy–Schwarz -/ + +/-- The image of `x`, `y : A` under `π_ω` at the cyclic vector inner-products to `ω(x⋆y)`: the +key identity connecting `A`'s sesquilinear form `(x, y) ↦ ω(x⋆y)` to the genuine inner product on +the GNS Hilbert space `ω.GNS`, using only `gnsRep`, `gnsCyclicVector` and the defining identity +`inner_gnsCyclicVector_gnsRep_gnsCyclicVector` from `CStarAlgebra.GNS`. -/ +lemma inner_gnsRep_gnsCyclicVector_gnsRep_gnsCyclicVector (ω : 𝓢[A]) (x y : A) : + ⟪ω.gnsRep x ω.gnsCyclicVector, ω.gnsRep y ω.gnsCyclicVector⟫_ℂ = ω (star x * y) := by + rw [← ω.inner_gnsCyclicVector_gnsRep_gnsCyclicVector (star x * y), map_mul, + mul_apply_eq_comp, map_star ω.gnsRep, star_eq_adjoint, adjoint_inner_right] + +/-- Cauchy–Schwarz for the positive sesquilinear form induced by a state, via the genuine inner +product on the GNS Hilbert space `ω.GNS`. -/ +lemma gns_cauchy_schwarz (ω : 𝓢[A]) (x y : A) : + ‖ω (star x * y)‖ * ‖ω (star y * x)‖ ≤ + (ω (star x * x)).re * (ω (star y * y)).re := by + have h := inner_mul_inner_self_le (𝕜 := ℂ) + (ω.gnsRep x ω.gnsCyclicVector) (ω.gnsRep y ω.gnsCyclicVector) + rwa [inner_gnsRep_gnsCyclicVector_gnsRep_gnsCyclicVector, + inner_gnsRep_gnsCyclicVector_gnsRep_gnsCyclicVector, + inner_gnsRep_gnsCyclicVector_gnsRep_gnsCyclicVector, + inner_gnsRep_gnsCyclicVector_gnsRep_gnsCyclicVector] at h + +/-- No state can correlate two fluctuations more strongly than the product of their spreads +allows — the GNS-Cauchy–Schwarz seed of every uncertainty relation below, before splitting the +left side via `apply_centered_mul_centered`. -/ +lemma centered_gns_cauchy_schwarz (ω : 𝓢[A]) (a b : Observable A) : + ‖ω ((centered ω a : A) * centered ω b)‖ * + ‖ω ((centered ω b : A) * centered ω a)‖ ≤ + variance ω a * variance ω b := by + rw [variance_eq_re_apply_centered_mul_self, variance_eq_re_apply_centered_mul_self] + simpa only [(centered ω a).property.star_eq, (centered ω b).property.star_eq] using + gns_cauchy_schwarz ω (centered ω a : A) (centered ω b : A) + +/-- The squared-magnitude form of `centered_gns_cauchy_schwarz`, ready to be split via +`apply_centered_mul_centered` into `robertson_schrodinger`. -/ +lemma centered_cauchy_schwarz (ω : 𝓢[A]) (a b : Observable A) : + Complex.normSq (ω ((centered ω a : A) * centered ω b)) ≤ + variance ω a * variance ω b := by + calc + Complex.normSq (ω ((centered ω a : A) * centered ω b)) = + ‖ω ((centered ω a : A) * centered ω b)‖ * + ‖ω ((centered ω b : A) * centered ω a)‖ := by + rw [apply_mul_comm_eq_star] + simp [Complex.normSq_eq_norm_sq, pow_two] + _ ≤ _ := centered_gns_cauchy_schwarz ω a b + +/-! ## Uncertainty relations -/ + +/-- The Robertson–Schrödinger uncertainty inequality: the sharpest relation here, jointly bounding +covariance and the commutator's expectation by the product of the individual spreads. Dropping +either term below recovers the more familiar `covariance_cauchy_schwarz` / `robertson`. -/ +lemma robertson_schrodinger (ω : 𝓢[A]) (a b : Observable A) : + covariance ω a b ^ 2 + ω⟨⁅a, b⁆⟩ ^ 2 ≤ + variance ω a * variance ω b := by + have h := centered_cauchy_schwarz ω a b + rw [apply_centered_mul_centered, Complex.normSq_apply] at h + simpa [pow_two] using h + +/-- Two observables cannot be more correlated than the product of their uncertainties allows — +the familiar `|correlation| ≤ σ_a · σ_b`, from dropping the commutator term in +`robertson_schrodinger`. -/ +lemma covariance_cauchy_schwarz (ω : 𝓢[A]) (a b : Observable A) : + covariance ω a b ^ 2 ≤ variance ω a * variance ω b := by + nlinarith [robertson_schrodinger ω a b, sq_nonneg (ω⟨⁅a, b⁆⟩)] + +/-- Heisenberg's uncertainty relation: observables that fail to commute cannot both be measured +with arbitrary precision. For position and momentum, `⁅x, p⁆ = iℏ` gives `ΔxΔp ≥ ℏ/2`. Obtained +from `robertson_schrodinger` by dropping the covariance term. -/ +lemma robertson (ω : 𝓢[A]) (a b : Observable A) : + ω⟨⁅a, b⁆⟩ ^ 2 ≤ variance ω a * variance ω b := by + nlinarith [robertson_schrodinger ω a b, sq_nonneg (covariance ω a b)] + +end UnitalPositiveLinearMap diff --git a/PhyslibAlpha/AlgebraicFramework/Dynamics/Generator.lean b/PhyslibAlpha/AlgebraicFramework/Dynamics/Generator.lean new file mode 100644 index 0000000000..c581f50bee --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/Dynamics/Generator.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.Dynamics.OneParameterGroup +public import Mathlib.Analysis.Calculus.Deriv.Basic + +/-! + +# The infinitesimal generator of a one-parameter group + +## i. Overview + +A generator is analytic/dynamical, not algebraic: `D a := lim_{t→0} (α_t(a) - a)/t`, requiring a +topology on `E` (here, a normed real vector space — enough to make sense of the limit) but *not* +requiring `E` to carry any multiplication, order, or star structure at all. This is the deliberate +converse emphasis of `Algebra/Derivation.lean`: derivation is pure algebra with no analysis; +generator is pure analysis with no algebra. `GeneratorIsDerivation.lean` is the bridge connecting +the two, once `E` happens to also carry a compatible multiplication. + +`IsGenerator` is phrased via `HasDerivAt` rather than `deriv` directly, which keeps every +downstream theorem a clean implication (`differentiable ⇒ conclusion`) instead of needing to first +discharge a `DifferentiableAt` side goal to unfold `deriv`. + +## ii. Key definitions and results + +- `IsGenerator` +- `IsGenerator.unique` : the generator, if it exists, is unique (immediate from uniqueness of + derivatives) + +## iii. Table of contents + +- A. The generator + +-/ + +@[expose] public section + +variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] + +/-! ## A. The generator -/ + +/-- `D` is the infinitesimal generator, at `t = 0`, of the one-parameter family `α`: for every `a`, +`t ↦ α t a` is differentiable at `0` with derivative `D a`. No algebraic structure on `E` (product, +order, `⋆`) is assumed — this is purely about the curve `t ↦ α t a` in a normed space. -/ +def IsGenerator (α : ℝ → E → E) (D : E → E) : Prop := + ∀ a : E, HasDerivAt (fun t => α t a) (D a) 0 + +/-- The generator of a one-parameter family, if it exists, is unique — immediate from uniqueness of +derivatives (`HasDerivAt.unique`). -/ +theorem IsGenerator.unique {α : ℝ → E → E} {D₁ D₂ : E → E} (h₁ : IsGenerator α D₁) + (h₂ : IsGenerator α D₂) : D₁ = D₂ := + funext fun a => (h₁ a).unique (h₂ a) diff --git a/PhyslibAlpha/AlgebraicFramework/Dynamics/GeneratorIsDerivation.lean b/PhyslibAlpha/AlgebraicFramework/Dynamics/GeneratorIsDerivation.lean new file mode 100644 index 0000000000..807efe5ad5 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/Dynamics/GeneratorIsDerivation.lean @@ -0,0 +1,75 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.Algebra.Derivation +public import PhyslibAlpha.AlgebraicFramework.Dynamics.Generator +public import Mathlib.Analysis.Calculus.Deriv.Comp +public import Mathlib.Analysis.Calculus.Deriv.Prod +public import Mathlib.Analysis.Calculus.FDeriv.Bilinear +public import Mathlib.Analysis.Normed.Operator.BoundedLinearMaps + +/-! + +# The generator of a one-parameter automorphism group is a derivation + +## i. Overview + +**The bridge theorem.** Given a continuous (bounded) bilinear multiplication on a normed space +`E`, and a one-parameter family `α : ℝ → E → E` that (a) fixes `0` at `t = 0` in the sense +`α 0 = id`, and (b) preserves the product at every time (`α t (a * b) = α t a * α t b`), the +generator of `α` — purely analytically defined, `Dynamics/Generator.lean` — automatically satisfies +the Leibniz rule, hence is a derivation in the purely algebraic sense of `Algebra/Derivation.lean`: +$$ D(a \circ b) = D(a) \circ b + a \circ D(b). $$ + +This is deliberately proved at the most general level where the argument is legitimate: no order, +no Jordan identity, no star structure, not even associativity or commutativity of `*` — only that +`*` is `ℝ`-bilinear and *bounded* (`IsBoundedBilinearMap`), which is exactly what lets one +differentiate `t ↦ α t a * α t b` via the product rule for bilinear maps +(`IsBoundedBilinearMap.hasFDerivAt`) and read off the Leibniz rule from `α`'s multiplicativity. In +particular `IsCommJordan` never appears in this file: it is one instance of the hypothesis +`hmul`/`IsBoundedBilinearMap`, reached only by later composing this theorem with a JB-algebra's +submultiplicativity axiom (`‖a ∘ b‖ ≤ ‖a‖‖b‖`, `JB/Basic.lean`) — see the module docstring's closing +remark for exactly how that composition goes, deliberately *not* performed in this file. + +## ii. Key definitions and results + +- `IsGenerator.isDerivation_of_isAutomorphismFamily` + +## iii. Table of contents + +- A. The bridge theorem + +-/ + +@[expose] public section + +variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [Mul E] + +/-! ## A. The bridge theorem -/ + +/-- **The bridge theorem.** If `α` is a one-parameter family with `α 0 = id`, preserving a bounded +bilinear multiplication at every time, then its generator `D` is a derivation for that +multiplication. Nothing here is specific to Jordan algebras, C⋆-algebras, or any order structure — +see the module docstring for how a JB-algebra's own axioms supply the `IsBoundedBilinearMap` +hypothesis as a corollary, without this theorem ever needing to know that. -/ +theorem IsGenerator.isDerivation_of_isAutomorphismFamily + (bilin : IsBoundedBilinearMap ℝ (fun p : E × E => p.1 * p.2)) + {α : ℝ → E → E} (hα0 : ∀ a, α 0 a = a) (hmul : ∀ t a b, α t (a * b) = α t a * α t b) + {D : E →ₗ[ℝ] E} (hD : IsGenerator α D) : IsDerivation D := by + intro a b + have hpair : HasDerivAt (fun t => (α t a, α t b)) (D a, D b) 0 := (hD a).prodMk (hD b) + have hcomp0 := (bilin.hasFDerivAt (α 0 a, α 0 b)).comp_hasDerivAt 0 hpair + have hcomp : HasDerivAt (fun t => α t a * α t b) + (bilin.deriv (α 0 a, α 0 b) (D a, D b)) 0 := hcomp0 + have hval : bilin.deriv (α 0 a, α 0 b) (D a, D b) = D a * b + a * D b := by + rw [IsBoundedBilinearMap.deriv_apply, hα0, hα0] + abel + rw [hval] at hcomp + have heq : (fun t => α t a * α t b) = fun t => α t (a * b) := by + funext t; rw [hmul] + rw [heq] at hcomp + exact hcomp.unique (hD (a * b)) |>.symm diff --git a/PhyslibAlpha/AlgebraicFramework/Dynamics/OneParameterGroup.lean b/PhyslibAlpha/AlgebraicFramework/Dynamics/OneParameterGroup.lean new file mode 100644 index 0000000000..6cc9637a20 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/Dynamics/OneParameterGroup.lean @@ -0,0 +1,75 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Mathlib.Data.Real.Basic +public import Mathlib.Logic.Function.Basic + +/-! + +# One-parameter groups acting on a bare carrier + +## i. Overview + +The most primitive notion of time evolution is a group action `α : G → E → E`. This file +specializes only the group to `G = (ℝ, +)` — nothing about *what `α` preserves* (linearity, order, +a Jordan product, a `⋆`-structure, ...) and nothing about *continuity* belongs here. Those are +independent axes: + +- structure preservation is a predicate about `α t` for each fixed `t` (see e.g. + `Algebra/Derivation.lean`'s companion notion for the infinitesimal picture, or state directly + `∀ t a b, α t (a * b) = α t a * α t b` at the point of use — no dedicated class is introduced here + since the right notion of "automorphism" depends on which structure `E` carries); +- continuity, and the existence of a generator, is `Dynamics/Generator.lean`, requiring a topology + `E` need not have at all to be a one-parameter group in the sense below. + +This mirrors the point that an Archimedean order-unit space's topology (`OrderUnit/Norm.lean`) is +not "AOU has dynamics" — it only supplies enough structure that a generic dynamical construction +can later be instantiated there. Likewise here: `E` need not be an order-unit space, a Jordan +algebra, or carry any topology for `IsOneParameterGroup` to be meaningful. + +## ii. Key definitions and results + +- `IsOneParameterGroup` + +## iii. Table of contents + +- A. The group law + +-/ + +@[expose] public section + +/-! ## A. The group law -/ + +/-- `α : ℝ → E → E` is a one-parameter group of (not-yet-specified-as-anything) transformations of +`E`: `α 0 = id` and `α (s + t) = α s ∘ α t`. Nothing about linearity, order, a product, or +continuity is assumed — those are independent, composable hypotheses to add at the point of use. -/ +structure IsOneParameterGroup {E : Type*} (α : ℝ → E → E) : Prop where + /-- Evolving for zero time does nothing. -/ + map_zero : ∀ a : E, α 0 a = a + /-- Evolving for `s` then `t` is the same as evolving for `s + t`. -/ + map_add : ∀ s t a, α (s + t) a = α s (α t a) + +namespace IsOneParameterGroup + +variable {E : Type*} {α : ℝ → E → E} (h : IsOneParameterGroup α) +include h + +/-- Every time-`t` map has a two-sided inverse, `α (-t)`: an immediate consequence of the group +law, recorded once here rather than re-derived at each point of use. -/ +theorem left_inv (t : ℝ) (a : E) : α (-t) (α t a) = a := by + have := h.map_add (-t) t a + simpa [h.map_zero] using this.symm + +theorem right_inv (t : ℝ) (a : E) : α t (α (-t) a) = a := by + have := h.map_add t (-t) a + simpa [h.map_zero] using this.symm + +theorem bijective (t : ℝ) : Function.Bijective (α t) := + Function.bijective_iff_has_inverse.mpr ⟨α (-t), h.left_inv t, h.right_inv t⟩ + +end IsOneParameterGroup diff --git a/PhyslibAlpha/AlgebraicFramework/EXTERNAL_INTEGRATION_PLAN.md b/PhyslibAlpha/AlgebraicFramework/EXTERNAL_INTEGRATION_PLAN.md new file mode 100644 index 0000000000..6761067f52 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/EXTERNAL_INTEGRATION_PLAN.md @@ -0,0 +1,370 @@ +# External library integration plan: Spectra and unbounded-alpha-public + +This document maps what exists in two external/sibling code bases against `AlgebraicFramework`'s +own layered hierarchy (see `JordanOrderUnit/JB_ROADMAP.md` §1), states what is already covered +here — much more of it than first assumed, see §2 — and assigns each genuinely reusable remaining +piece to the layer it belongs at, always preferring the strongest/most general hypotheses actually +needed rather than the source's own scoping. Superseded content is stated explicitly as superseded, +not silently dropped, so this stays an accurate record rather than a wish list. + +Every claim below is from direct file reads (this session, both trees, both via `gh api` for +Spectra and `Read`/`grep` for `unbounded-alpha-public`), not from names or descriptions alone. + +**Looking for the per-library file list?** §7 at the end of this document is a flat, one-table-per- +library reference (file → verdict → port target) for all three sources read this session +(`unbounded-alpha-public`, Spectra, `Cobord/JordanAlgebra`). Sections 2–4 below are the same +findings organized by topic/gap instead of by source, with the full reasoning; §7 is the quick +index into them. + +## 1. The layer question, answered once + +Per `JB_ROADMAP.md` §1's hierarchy: + +```text +bilinear algebra → Jordan algebra → Jordan order-unit → normed/JB → JBW + \ + Cstar/Hilbert-space realization +``` + +A Hilbert-space projection-valued-measure/spectral-theorem/automorphism-group construction is +**always** a realization-layer object, never an abstract-layer primitive. The abstract layers only +ever get the generic order/Jordan-theoretic version (`MeasurableProjectionResolution`, +`OneParameterAutomorphismGroup E`, etc.) — Hilbert-space-specific facts are corollaries applied to +`selfAdjoint (H →L[ℂ] H)` or `H →L[ℂ] H`, never smuggled upward. Nothing below changes this; every +recommendation respects it. + +## 2. Correction to the previous version of this document: far more is already superseded + +Direct comparison this session shows `AlgebraicFramework` has **already independently rebuilt**, +at the correct and usually *more general* abstract level, almost everything `unbounded-alpha-public` +has at the `Observables/`/`Dynamics/` layer, and almost everything Spectra/`unbounded-alpha-public` +have for the unbounded self-adjoint spectral theorem itself. Concretely, file-by-file: + +| `unbounded-alpha-public` file | Content | Superseded by (this repo) | Verdict | +|---|---|---|---| +| `Observables/Jordan.lean` | `JordanObservable A`, symmetrized product `a⊙b`, on `[OperatorAlgebra A]` (old class) | `StarAlgebra/Jordan.lean` — same construction, on bare `[Ring A][StarRing A]`, no `OperatorAlgebra` wrapper needed | **Superseded, strictly more general here.** Do not port. | +| `Observables/Lie.lean` | Lie bracket `⁅a,b⁆ = -(i/2)(ab-ba)` on `[OperatorAlgebra A]` | `StarAlgebra/Lie.lean` — same, on `[Ring A][StarRing A][Module ℂ A][StarModule ℂ A]` (verified minimal by a prior session, not just assumed) | **Superseded.** Do not port. | +| `Dynamics/{Automorphism,AutomorphismGroup}.lean` | `AutomorphismGroup A` (one-parameter `*`-automorphism group) and `Aut⋆(B(H))≅PU(H)` (Wigner-type theorem), both on `[OperatorAlgebra A]`/concrete `B(H)` | `OrderUnit/Symmetry.lean`'s `OneParameterAutomorphismGroup E` (fully abstract, `[AddCommGroup E][PartialOrder E]`, no Cstar assumption — genuinely more general) for the abstract half; `HilbertSpace/Dynamics/Automorphism.lean`'s `ProjectiveUnitary H`/the `Aut⋆(H→L[ℂ]H) ≅ PU(H)` theorem (confirmed present, line 25/73/81) for the concrete half | **Superseded on both halves.** Do not port. | +| `Core/AnalyticVector/{Basic,Local,Nelson}.lean` | Nelson's analytic-vector essential-self-adjointness criterion | `HilbertSpace/Unbounded/AnalyticVector/{Basic,Local,Nelson}.lean` (same file names, present, wired in) | **Already exists here independently.** Do not port; if genuinely absent details differ, diff the two directly before assuming either needs work. | +| `Affil/SpectralTheorem.lean`, `Spec/Cayley*.lean`, `Spec/CayleySpectralData*.lean` | Unbounded self-adjoint spectral theorem via Cayley transform | `HilbertSpace/Unbounded/{Cayley,CayleySpectralData,SpectralIntegral}/*.lean`, public endpoint `unboundedSpectralTheorem` (1 `sorry` in the whole ~150-file tree, unrelated) | **Already exists here, independently built, with a stronger final package** (tied to the exact square-moment domain, not just a resolvent identity). Do not port. | +| `Flow/{Stone,StoneAPI,StoneInvariance}.lean` | Stone's theorem | `HilbertSpace/Unbounded/Flow/{Stone,StoneAPI,StoneInvariance}.lean`, `Existence/{StoneGenerator,...}.lean` (same names, present) | **Already exists here.** Do not port. | + +**Conclusion of §2**: `unbounded-alpha-public`'s `OperatorAlgebra/` subtree was, at some point, the +seed this repo's `HilbertSpace/Unbounded/` and `StarAlgebra/`/`OrderUnit/` trees grew from (or a +parallel rebuild covering the same ground) — either way, it is now almost entirely redundant with +what exists here, and usually strictly weaker (Cstar/`B(H)`-specific where this repo has the +abstract order-unit version too). Only two pieces of real, non-redundant value remain, both below. + +## 3. Genuine remaining gaps — what to reuse, and at which exact layer + +### 3.1 `WStarAlgebra (B(H))` instance — realization layer, `WStarAlgebra/` + +**Status: the Hilbert–Schmidt/polar-decomposition prerequisite stack is now ported, and +`HilbertSpace/TraceClass/Banach.lean` is fully sorry-free and wired into `PhyslibAlpha.lean`; +`WStarAlgebra/HilbertSpaceInstance.lean` has 8 of its original 11 gaps closed, 3 remain (genuinely +blocked on a further, separate density/approximation theorem), so it stays unwired per house +style.** + +The missing Hilbert–Schmidt/polar-decomposition infrastructure — confirmed absent from Mathlib by +exhaustive grep (no `Schatten`, `HilbertSchmidt`, or `PolarDecomposition` declaration anywhere) — +is now ported as five new files under `HilbertSpace/TraceClass/`, restated directly against this +repo's own predicate-based `IsTraceClass`/`H →L[ℂ] H` (no bundled-subtype translation was actually +needed: `unbounded-alpha-public`'s own top-level `TraceClass.lean` already used the identical +predicate convention this repo's `Basic.lean` does): + +* `HilbertSchmidt.lean` — the Hilbert–Schmidt predicate, its basis-independence and algebraic + closure (ported from `TraceClass/{HilbertSchmidt,HSAlgebra,HSEstimate}.lean`), plus the + Cauchy–Schwarz diagonal-summability estimates (ported from `TraceClass/TraceProduct.lean`). +* `Polar.lean` — the polar factor `polarFactor T` and the general partial-isometry identity + `star (polarFactor T) * T = |T|` for *every* bounded `T` (ported from `TraceClass/Polar.lean`). +* `GeneralIdeal.lean` — the unconditional (non-self-adjoint) basis-independent trace + `trace_eq_of_hilbertBasis`, crossing the boundary `Basic.lean`'s own self-adjoint-only theorem + left open (ported from `TraceClass/GeneralIdeal.lean`). +* `GeneralProduct.lean` — the master lemma that a product of two Hilbert–Schmidt operators is + trace class, and its two consequences `isTraceClass_add`/`isTraceClass_mul_mul` (the general + two-sided ideal estimate) (ported from `TraceClass/GeneralProduct.lean`). +* `IdealNorm.lean` — the quantitative duality bound and its consequences `traceNorm_add_le` + (subadditivity) and `traceNorm_mul_mul_le` (the quantitative two-sided ideal estimate) (ported + from `TraceClass/IdealNorm.lean`). + +Using this stack, `Banach.lean`'s three remaining gaps (`isTraceClass_add`, `traceNorm_add_le`, +`instCompleteSpace`) are now closed — the last via the absolutely-convergent-series criterion, +following `unbounded-alpha-public`'s `TraceClass/Completeness.lean` directly (ported inline into +`Banach.lean` rather than as a separate file, since it only extends the `TraceClass H` Banach-space +API already assembled there). `Banach.lean` is genuinely sorry-free and now wired into +`PhyslibAlpha.lean`, along with the five new supporting files. + +`HilbertSpaceInstance.lean`'s five algebraic gaps (`isTraceClass_mul_coe`, `norm_trace_le`, +`trace_add`, `trace_smul`, `traceNorm_mul_mul_le`) are direct specializations of the newly-ported +general theorems, and the isometry half of `toDual` (`norm_tracePairing : ‖tracePairing A‖ = ‖A‖`) +is now also closed, ported from `unbounded-alpha-public`'s `WStarAlgebra/TracePairingNorm.lean`'s +rank-one test-vector argument. **3 gaps remain**, all reducing to one genuinely separate analytic +theorem not undertaken this pass: `rankOneSpan_dense` (every trace-class operator is a norm-limit +of finite-rank operators, via Hilbert–Schmidt truncation — source: `WStarAlgebra/ +TracePairingSurj.lean`), which `tracePairing_surjective_of_rankOneSpan_dense` and hence +`tracePairingEquiv`/`tracePairingEquiv_apply` and the final instance all depend on. This is a +substantial, self-contained approximation theorem in its own right (not a short corollary of the +infrastructure just ported) and is the correctly-scoped next slice. **Priority 1, continue as +scoped**: prove `rankOneSpan_dense`, as its own dedicated piece of work. + +### 3.2 Naimark's dilation theorem — realization layer, `Representation/` + +**Status: in progress, paused mid-fix per explicit instruction.** `Representation/ +DiscreteNaimark.lean` (525 lines, 0 sorry, does not yet compile — 7 itemized mechanical Lean-API +fixes remain, none structural). Correctly scoped and named as the *discrete/countable* case only +(per the user's own correction: the general theorem is for an arbitrary measurable POVM +`M : Σ → Eff(H)`, and the deepest frame is that Naimark is a corollary of **Stinespring dilation** +applied to the commutative operator algebra of bounded measurable functions on the outcome space — +commutativity makes positivity automatically complete positivity, so Stinespring's `Φ(f)=V*π(f)V` +specializes via indicator functions to `M(A)=V*P(A)V`). + +**Stinespring dilation — DONE this session.** Ported from `unbounded-alpha-public`'s +`Unbounded/OperatorAlgebra/Dynamics/Stinespring/Core.lean` (the `QuantumMechanics/ +StinespringDilation.lean` file turned out to be an unrelated finite-dimensional `Matrix`/Kraus- +operator treatment, entirely class-agnostic already but not the operator-algebraic theorem wanted +here; not ported). The real content was built on the old `OperatorAlgebra` class (`[OperatorAlgebra +A]`, `A →CP B(H)` via `OperatorAlgebra.Representation A H := A →⋆ₐ[ℂ] B(H)`), confirmed +field-isomorphic to this repo's `[CStarAlgebra A] [PartialOrder A] [StarOrderedRing A]` — exactly +the hypotheses this repo's own `CStarAlgebra/Channel.lean` already uses for Mathlib's own +`CompletelyPositiveMap` (`A₁ →CP A₂`) — so the translation was a mechanical restatement, not new +mathematics. New files: `CStarAlgebra/Stinespring/Kernel.lean` (the `blockMatrixMap` +finite-block-operator API, the CP-kernel positivity chain `gramMatrix`/`cpKernel_inner_nonneg*`, +and the `StinespringWitness A H K J` structure) and `CStarAlgebra/Stinespring/Dilation.lean` (the +tensor-product GNS-style construction on `A ⊗[ℂ] H`, culminating in +`Stinespring.Canonical.canonical_stinespring_identity : J a = V⋆ π(a) V` and the existence theorem +`Stinespring.exists_stinespringWitness`). Generality matches the source exactly (arbitrary unital +`A`, codomain fixed to `H →L[ℂ] H` — going further would need an abstract notion of `⋆`- +representation into a general `WStarAlgebra`, real new math out of scope here). `lake build +PhyslibAlpha` clean, 0 sorry/admit/new axiom, 0 warnings in the new files, wired into +`PhyslibAlpha.lean`. This is the route to the fully general Naimark theorem (a POVM is a CP map on +the commutative algebra of bounded measurable functions; positivity there is automatically complete +positivity, and indicator functions recover the projection-valued dilation from `π`) — specializing +`exists_stinespringWitness` to that commutative case is future work, kept separate from this task. +`DiscreteNaimark.lean`'s 7 mechanical fixes remain **paused per direct instruction** (§6) and were +not touched. + +### 3.3 Tomita–Takesaki modular theory + KMS — `WStarAlgebra/`, large, sequence later + +Unchanged from the previous version of this plan: absent from both trees entirely; Spectra's own +`Modular/*` (~40 files) has the construction up to the modular operator/flow/conjugation/KMS +condition, with the final commutation theorem (`JMJ=M'`) as Spectra's own acknowledged open +research target. Belongs at the `WStarAlgebra/` layer (needs a predual + cyclic separating vector, +same as `WStarAlgebraStructure`/`NormalState`). **Priority 3**, sequence after 3.1/3.2, scope as its +own dedicated multi-file effort — do not start opportunistically. + +### 3.4 Essential spectrum + Weyl's theorem — DONE this session + +`HilbertSpace/Unbounded/EssentialSpectrum/{Defs,WeakCompact,Closed,Smul,Weyl,Discrete}.lean` — all +six files build clean, 0 sorry/admit/axiom, restated against this repo's own `LinearPMap`/ +self-adjoint operator type (no second spectral-measure hierarchy introduced). One honest +hypothesis-level gap (`IsResolventAt`, packaging "total + continuous resolvent" as a hypothesis +pending a closed-graph-theorem bridge lemma this repo doesn't have yet) and one deliberately +unported theorem (`Discrete.lean`'s hard half, which needs Spectra's own bespoke `ProjValMeasure` +machinery to re-derive against this repo's spectral apparatus — left as a documentation-only file +recording the exact bridge). **No further action needed here** beyond, eventually, building the +resolvent-to-CLM bridge lemma (a well-scoped, independently useful item) to discharge `IsResolventAt` +for real. Note: the earlier version of this plan's claim that `JordanOrderUnit/SpectralDecomposition. +lean`'s `discreteSpectrum` names the motivating gap was **checked and found wrong this session** — +no file or declaration by that name exists anywhere in this checkout; only this plan document's own +prose mentioned it. Correcting the record here rather than repeating the error. + +## 4. `Cobord/JordanAlgebra` — investigated in full, and this is the real find + +`unbounded-alpha-public`'s old `Observables/Jordan.lean` carried a standing `TODO`: *"Investigate +`https://github.com/Cobord/JordanAlgebra/` and determine which general Jordan-algebra results are +relevant for quantum mechanics."* Read in full this session (`gh api`, all 19 `Jordan/*.lean` files, +sorry/axiom-counted individually). Small (~4200 lines, 1 star, last pushed 2026-08-24, Lean +`v4.31.0`), **essentially sorry-free — exactly ONE `sorry` in the entire library**, and unlike +Spectra (zero Jordan-algebra content in 373 files, purely Cstar/Hilbert-space theory), this is a +library specifically about abstract commutative Jordan algebras. It is directly on the critical +path, not adjacent to it. + +### 4.1 It already proves McCrimmon's linearized fundamental formula — cross-check target + +`Jordan/JordanAlgebra.lean`'s `lmul_mul_mul_eq` (sorry-free, `[Invertible (2:R)]` on a bare +`CommRing R`/`JordanAlgebra R M`, no real-number specificity): + +```text +L((b*d)*c) = L(b*d)∘L(c) + L(c*d)∘L(b) + L(b*c)∘L(d) − L(b)∘L(c)∘L(d) − L(d)∘L(c)∘L(b) +``` + +proved via McCrimmon's two-stage linearization (`jax2_prime`, `jax2_double_prime`) of the bare +Jordan identity — genuinely more general than this repo's `[NonAssocCommRing E][Module ℝ E]` +setup (works over any commutative ring with `2` invertible) and reaches, in one file, essentially +the same territory `Quadratic/Fundamental.lean`'s `mulLeft_quadRep_normalize`/ +`quadRep_quadRep_eq` spent multiple sessions building toward from first principles. **Action**: +cross-check this repo's own linearized identities against `lmul_mul_mul_eq` (do the two match up +to notation, and does theirs shorten anything here?) before further from-scratch operator- +normalization work in this file. + +### 4.2 It got stuck at the EXACT SAME theorem this repo just solved — worth reporting back + +`Jordan/JordanTriple.lean`'s only `sorry` is in the `JordanAlgebra ⟹ JordanTriple` instance's +`triple_identity` field — **the same Jordan-triple-system fundamental identity** +`tripleOperator_comm` proves in this repo (§ this session's `quadRep_fundamental` work). Cobord's +own approach is term-cancellation search (`find_cancel.py`, reducing to "40 raw multiplication +terms" needing explicit `jordan_mul_comm` rewrites), left stuck and sorry'd with a detailed TODO. +This repo's derivation-operator route (`D_{a,b}:=[L_a,L_b]` is a genuine Jordan-product derivation, +`V_{a,b}:=L_{a*b}+D_{a,b}`, `[V_{a,b},V_{c,d}]=V_{\{a,b,c\},d}-V_{c,\{b,a,d\}}`) closed it cleanly. +**This is worth turning into an actual upstream contribution** — closing Cobord's one remaining +`sorry` with this repo's own already-proved technique, translated to their bare-`CommRing` +generality, is a small, concrete, high-goodwill open-source contribution and a genuine correctness +cross-check of this repo's own proof. Not urgent, but flag it as a live option. + +### 4.3 `StructureAlgebra.lean` — the textbook version of this session's `innerDerivation`/`tripleOperator` + +`JordanDerivation R M` (`R`-linear, Leibniz rule `D(a*b)=a*D(b)+D(a)*b`), `inner` (the inner +derivation constructor — **matches this repo's `innerDerivation` field-for-field**, `leibniz` +matches `innerDerivation_mul`), the commutator Lie algebra on derivations (matches +`innerDerivation_comm`), and `StructureAlgebra R M := M × JordanDerivation R M` (**exactly** +`V_{a,b} := L_{a*b} + D_{a,b}`, packaged as `Jacobson`/`Meyberg`'s classical "structure algebra" of +a Jordan algebra, its own Lie algebra via `toEnd`). All sorry-free. This is strong independent +confirmation that this session's from-scratch `innerDerivation`/`tripleOperator` construction is +not an ad-hoc trick but the standard textbook object (the structure algebra) — worth citing by that +name in `Quadratic/Fundamental.lean`'s docstrings, and worth reading this file directly before any +further structure-algebra-adjacent work here (Peirce theory, generated subalgebras) to reuse its +naming/lemma shape rather than re-deriving. + +### 4.4 `AlbertAlgebra.lean` + `SpinFactor.lean` — the missing non-special concrete instances + +Both fully sorry/axiom-free (890 and 276 lines). `AlbertAlgebra` (3×3 Hermitian octonionic +matrices, via `hermitian_jordan_identity`'s fully generic `H₃(D,-)` construction for any `D` with +`[IsAlternative D][StarRing D][IsNuclearInvolution D]`) and `SpinFactor` (`V × R` from a symmetric +bilinear form) are, respectively, **the** exceptional simple JB algebra and **the** other classical +non-matrix simple JB algebra family — genuinely NOT special (no faithful embedding into any +associative/Cstar algebra exists for the Albert algebra). `AlgebraicFramework`'s only concrete +instances today are all Cstar-based (`selfAdjoint A`) — i.e. all *special*. Getting even one +genuinely exceptional instance (`AlbertAlgebra`) to satisfy `IsJordanOrderUnit`/`JBAlgebra` would be +the strongest possible validation that this repo's abstract layer is not secretly just disguised +C\*-algebra theory, and both already have `isFormallyReal`/`detTrace` (trace/determinant, state +cone) built — directly comparable to `IsJordanOrderUnit`'s own positivity axiom. **High-value, +self-contained future task**: instantiate `AlbertAlgebra`/`SpinFactor` against +`JordanOrderUnit`'s abstract classes and see how far the existing abstract theorems (Stage A's now- +complete fundamental formula, Stage C.2's root uniqueness) carry over immediately for free. + +### 4.5 `FormallyReal.lean` — cross-check for the abstract state/order theory + +`IsFormallyReal`, `states`/`pureStates` (the cone of squares cut by `trace x = 1`, and its +idempotent extreme points), `expect` (linear expectation-value functional) — parallels this repo's +own `IsJordanOrderUnit`/state-cone/effect theory closely enough to be worth a direct side-by-side +read before extending `OrderUnit/State/*` further, as a second independent formulation to check +against (not a port target by itself — the content is comparable in scope to what's already here, +not larger). + +### 4.6 What NOT to take from Cobord + +`Octonion.lean`/`OctonionMatrix.lean`/`MatrixAssociator.lean`/`NuclearInvolution.lean`/ +`HermitianMatrixAssociator.lean`/`MooreDeterminant.lean` are load-bearing *infrastructure* for +`AlbertAlgebra.lean` (§4.4) but not independently interesting for `AlgebraicFramework` — port them +only as part of porting `AlbertAlgebra` itself, not standalone. `Alternative.lean`, +`RealQM.lean`/`ComplexQM.lean`/`QuaternionicQM.lean` (the non-exceptional Hermitian-matrix Jordan +algebras) are lower priority than `AlbertAlgebra`/`SpinFactor` — special Jordan algebras this +repo's Cstar-realization branch already covers in substance via `selfAdjoint A`. `CommNonAssocNF.lean` +is design notes only, no code. + +## 5. What NOT to reuse (unchanged, reaffirmed) + +- Spectra's `ProjValMeasure`/`POVM` bespoke wrapper types, or `unbounded-alpha-public`'s + `OperatorAlgebra`/`OperatorAlgebra.WStarAlgebra` classes themselves (upstream-superseded, PR + #1622) — only proof *content* built on them is ever reused, restated against this repo's own + types/classes. +- Spectra's Hydrogen atom / Dirac equation / Bell inequalities / Fock & Krein spaces / + **information geometry, Bochner/Herglotz/positive-definite-function theory, Fenchel–Legendre + convex analysis** (read this session: `InformationGeometry/{CramerRao,Divergence,Fisher}/*`, + `Bochner/GNS/PosDefFun.lean`, `Herglotz/Basic.lean`, `PositiveDefinite/Basic.lean`, + `Analysis/Convex/Fenchel/Conjugate.lean` — all genuine, well-written mathematics, but targeting + statistical-manifold/DFT physics, orthogonal to `AlgebraicFramework`'s Jordan/order-unit/JB/JBW + scope). Not part of this plan. +- A full branch merge of `unbounded-alpha-public` — confirmed low mechanical-conflict-risk (3 + shared files) but genuinely low-value now that §2 shows almost everything worth taking is either + already superseded or covered by the two targeted items in §3.1/3.2. + +## 6. Priority order — re-ranked by what enables general QM theorems, not by abstract-algebra novelty + +The governing question for this section is: what unlocks a genuinely general quantum-mechanical +theorem, not what is the most mathematically interesting abstract-algebra fact available. Re-ranked +accordingly (an earlier version of this section got this backwards — corrected here): + +1. **Finish `WStarAlgebra(B(H))`** (§3.1) — the actual QM-enabling item. Without a predual there is + no abstract notion of a normal state / general (infinite-dimensional) mixed quantum state, no + density-operator description at the right level of generality. **16 of the original 19 named + sorries are now closed** (`Banach.lean` fully sorry-free and wired in; `HilbertSpaceInstance.lean` + 8/11 closed). The remaining 3 all reduce to one substantial standalone theorem, + `rankOneSpan_dense` (Hilbert–Schmidt truncation/density), the correctly-scoped next slice. +2. **Port Stinespring dilation** from `unbounded-alpha-public` (§3.2) — **done this session** + (`CStarAlgebra/Stinespring/{Kernel,Dilation}.lean`). The general theorem that every physical + quantum operation (channel, measurement, decoherence process) arises from coupling to a larger + system and ordinary unitary dynamics. This is the actual general QM theorem worth having; it + subsumes Naimark's theorem as the commutative special case, so it supersedes rather than depends + on the discrete-Naimark work below. Specializing it to the commutative case to recover general + Naimark is the natural next step, scoped as its own future task. +3. **Tomita–Takesaki/KMS** (§3.3) — large, but this is real physics generality: the general + framework for thermal/equilibrium quantum states and algebraic QFT. Sequence after 1–2, scope as + its own dedicated effort. + +**Explicitly paused, not "to finish," per direct instruction**: `DiscreteNaimark.lean`'s 7 +mechanical compile fixes (§3.2a). The user stopped this work mid-fix and it should not be resumed +without being asked — the general Stinespring route (item 2 above) is the actual priority and +subsumes it; do not schedule the discrete case as upcoming work. + +**Explicitly deprioritized, not urgent**: `AlbertAlgebra`/`SpinFactor` instantiation (§4.4) and the +Cobord cross-checks (§4.1, §4.2) — genuinely interesting for validating the abstract layer's +generality in the pure-mathematics sense, but not something enabling a QM theorem anyone needs +right now. Revisit later, not as current work. `StructureAlgebra.lean` (§4.3) and +`FormallyReal.lean` (§4.5) remain worth reading as background before touching `Quadratic/`- or +`OrderUnit/State/*`-adjacent code respectively, but are not standalone tasks. + +Essential spectrum + Weyl (§3.4) is done — this is also a genuine physics-enabling item (real +Hamiltonians with continuous spectrum, not just toy finite-dimensional ones), already delivered. + +## 7. Per-library file inventory (quick reference) + +One table per source library. "Detail" points at the section above with the full reasoning; read +that before acting on any row, this table is an index, not a substitute. + +### 7.1 `unbounded-alpha-public` (`physlib-dev`, branch `unbounded-alpha-public-no-quantuminfo`) + +| File(s) | Verdict | Port target / status | Detail | +|---|---|---|---| +| `Observables/Jordan.lean` | Superseded, this repo's version is more general | — do not port | §2 | +| `Observables/Lie.lean` | Superseded, this repo's version is more general | — do not port | §2 | +| `Dynamics/{Automorphism,AutomorphismGroup}.lean` | Superseded on both the abstract and concrete half | — do not port | §2 | +| `Core/AnalyticVector/{Basic,Local,Nelson}.lean` | Already exists here independently | — do not port | §2 | +| `Affil/SpectralTheorem.lean`, `Spec/Cayley*.lean`, `Spec/CayleySpectralData*.lean` | Already exists here, stronger package | — do not port | §2 | +| `Flow/{Stone,StoneAPI,StoneInvariance}.lean` | Already exists here | — do not port | §2 | +| `TraceClass/{HilbertSchmidt,HSAlgebra,HSEstimate,TraceProduct}.lean` | Genuine gap, missing Mathlib prerequisite | **Done this session** — ported as `HilbertSpace/TraceClass/HilbertSchmidt.lean`, clean build, 0 sorry, wired into `PhyslibAlpha.lean` | §3.1, §6 | +| `TraceClass/Polar.lean` | Genuine gap, missing Mathlib prerequisite | **Done this session** — ported as `HilbertSpace/TraceClass/Polar.lean`, clean build, 0 sorry, wired into `PhyslibAlpha.lean` | §3.1, §6 | +| `TraceClass/GeneralIdeal.lean` | Genuine gap, missing Mathlib prerequisite | **Done this session** — ported as `HilbertSpace/TraceClass/GeneralIdeal.lean`, clean build, 0 sorry, wired into `PhyslibAlpha.lean` | §3.1, §6 | +| `TraceClass/GeneralProduct.lean` | Genuine gap, missing Mathlib prerequisite | **Done this session** — ported as `HilbertSpace/TraceClass/GeneralProduct.lean`, clean build, 0 sorry, wired into `PhyslibAlpha.lean` | §3.1, §6 | +| `TraceClass/IdealNorm.lean` | Genuine gap, missing Mathlib prerequisite | **Done this session** — ported as `HilbertSpace/TraceClass/IdealNorm.lean`, clean build, 0 sorry, wired into `PhyslibAlpha.lean` | §3.1, §6 | +| `TraceClass/Completeness.lean` | Genuine gap, missing Mathlib prerequisite | **Done this session** — ported inline into `HilbertSpace/TraceClass/Banach.lean`'s `instCompleteSpace`; `Banach.lean` is now fully sorry-free and wired into `PhyslibAlpha.lean` | §3.1, §6 | +| `TraceClass/PositiveIdeal.lean` | Superseded — `Basic.lean` already has the self-adjoint/positive case (`trace_eq_of_hilbertBasis_of_nonneg`/`_of_isSelfAdjoint`) without polar decomposition | Not ported (not needed for the remaining gaps) | §3.1 | +| `WStarAlgebra/{InfiniteDim,TracePairingNorm}.lean` | Genuine gap | **Done this session** — `InfiniteDim.lean`'s field-mapping realized as `WStarAlgebra/HilbertSpaceInstance.lean` (8/11 file-local gaps closed using the newly-ported stack above); `TracePairingNorm.lean`'s isometry argument ported directly (`norm_tracePairing`) | §3.1, §6 | +| `WStarAlgebra/TracePairingSurj.lean` | Genuine gap, substantial standalone analysis (Hilbert–Schmidt truncation/density) | **Not ported this session** — `rankOneSpan_dense` remains the one open gap; `tracePairing_surjective_of_rankOneSpan_dense`'s easy Riesz-representation half is ported, density kept as an explicit hypothesis | §3.1, §6 | +| `Unbounded/OperatorAlgebra/Dynamics/Stinespring/Core.lean` | Genuine gap, was absent from `AlgebraicFramework` entirely | **Done this session** — `CStarAlgebra/Stinespring/{Kernel,Dilation}.lean`, clean build, 0 sorry, wired in | §3.2, §6 | +| `QuantumMechanics/StinespringDilation.lean` | Unrelated finite-`Matrix`/Kraus-operator treatment, already class-agnostic but not the operator-algebraic theorem needed here | Not ported (out of scope, different theorem) | §3.2, §6 | +| `Unbounded/OperatorAlgebra/Dynamics/Stinespring/{Canonical,Converse}.lean` | Christensen–Evans/Lindblad-generator applications of the core Stinespring construction, not the dilation theorem itself | Not ported (separate task if Lindblad dynamics content is wanted later) | §3.2, §6 | +| `Representation/PVM.lean`-style bare family (led to `Representation/DiscreteNaimark.lean`) | Correct but narrow; superseded in priority by Stinespring | **Paused per instruction**, not upcoming work | §3.2, §6 | + +### 7.2 `adambornemann-glitch/Spectra` (GitHub, Apache 2.0) + +| File(s) | Verdict | Port target / status | Detail | +|---|---|---|---| +| `Operator/{DeficiencyIndex,SelfAdjointExtension*,VonNeumannExtension*,KatoRellich}.lean`, `CayleyTransform/*`, `StoneBridge/*`, `YosidaHille/*` | Already exists here (`HilbertSpace/Unbounded/`), independently built, stronger package | — do not port | §2 (via the `unbounded-alpha-public` comparison; Spectra reaches the same ground) | +| `SpectralTheory/Essential/{Closed,Defs,Discrete,Smul,WeakCompact,Weyl}.lean` | Genuine gap, real content | **Done this session** — `HilbertSpace/Unbounded/EssentialSpectrum/*`, clean build, one hypothesis-level gap (`IsResolventAt`) | §3.4 | +| `QuantumMechanics/BornRule/Naimark.lean`, `ProjValMeasure/{Basic,General}.lean` | Correct discrete construction, but wrong normalization hypothesis as first drafted (operator-norm vs. scalar/weak — user's own correction), and the wrong generality target (discrete case, not general Naimark/Stinespring) | Superseded in priority by porting `unbounded-alpha-public`'s Stinespring instead; discrete work paused | §3.2, §6 | +| `Modular/{Cocycle,KMS,Tomita,TomitaTakesaki}/*` (~40 files) | Genuine gap, real content, source's own endgame theorem still open upstream | **Priority 3**, large, not started | §3.3 | +| `InformationGeometry/*`, `Bochner/GNS/PosDefFun.lean`, `Herglotz/*`, `PositiveDefinite/Basic.lean`, `Analysis/Convex/Fenchel/Conjugate.lean` | Real mathematics, wrong scope (statistical-manifold/DFT physics, not Jordan/order-unit/JB/JBW) | Not part of this plan | §5 | +| Hydrogen atom / Dirac equation / Bell inequalities / Fock & Krein spaces | Real physics, wrong scope for `AlgebraicFramework` specifically | Not part of this plan | §5 | +| `ProjValMeasure`/`POVM` wrapper types themselves (as opposed to proof content built on them) | Would be a second competing PVM hierarchy | Never reuse the types, only translated proof content | §1, §5 | + +### 7.3 `Cobord/JordanAlgebra` (GitHub, Apache 2.0, small — ~4200 lines, 1 sorry total) + +| File(s) | Verdict | Port target / status | Detail | +|---|---|---|---| +| `Jordan/JordanAlgebra.lean` (`lmul_mul_mul_eq`, McCrimmon's linearized fundamental formula) | Genuinely more general than this repo's own version, real cross-check value | Deprioritized for now (not QM-enabling) — cross-check when convenient | §4.1, §6 | +| `Jordan/JordanTriple.lean` (the one library-wide `sorry`, same identity as `tripleOperator_comm`) | This repo already solved it independently; closing theirs is a possible small upstream contribution | Deprioritized, optional, low-urgency | §4.2, §6 | +| `Jordan/StructureAlgebra.lean` (`JordanDerivation`, `StructureAlgebra R M`) | Textbook confirmation of this repo's `innerDerivation`/`tripleOperator` — not a port target, a citation/background source | Read before further `Quadratic/`-adjacent work, not a standalone task | §4.3, §6 | +| `Jordan/{AlbertAlgebra,SpinFactor}.lean` | Real, sorry-free, the missing non-special concrete `JBAlgebra` examples | **Deprioritized per direct instruction** — high pure-math value, not currently a physics priority | §4.4, §6 | +| `Jordan/FormallyReal.lean` | Comparable in scope to this repo's own state/order theory, cross-check only | Read before extending `OrderUnit/State/*`, not a standalone task | §4.5, §6 | +| `Jordan/{Octonion,OctonionMatrix,MatrixAssociator,NuclearInvolution,HermitianMatrixAssociator,MooreDeterminant,Alternative,RealQM,ComplexQM,QuaternionicQM,CommNonAssocNF}.lean` | Infrastructure for `AlbertAlgebra`, or lower-priority special-Jordan-algebra content this repo already covers via `selfAdjoint A` | Not part of this plan | §4.6 | diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Dynamics/Automorphism.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Dynamics/Automorphism.lean new file mode 100644 index 0000000000..1542ac1005 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Dynamics/Automorphism.lean @@ -0,0 +1,171 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.Automorphism +public import Physlib.Mathematics.OneParameterSubgroups.Unitary +public import Mathlib.Analysis.Normed.Operator.ContinuousAlgEquiv +public import Mathlib.Analysis.CStarAlgebra.Hom +public import Mathlib.Analysis.InnerProductSpace.StarOrder +public import Mathlib.Algebra.Lie.OfAssociative + +/-! + +# Automorphisms of the bounded operators + +For a complex Hilbert space `H`, every ⋆-automorphism of `H →L[ℂ] H` is implemented by +unitary conjugation: + `A ↦ U A U⋆`. + +Two unitaries implement the same transformation exactly when they differ by a +scalar phase. Consequently, + `Aut⋆(H →L[ℂ] H) ≅ U(H) / U(1) ≅ PU(H)`, +the projective unitary group. + +For Hamiltonian dynamics, this projective ambiguity corresponds to +the freedom to shift a Hamiltonian by a scalar multiple of the identity. + +A norm-continuous unitary one-parameter group `U` also acts on `H →L[ℂ] H` by conjugation, +`αₜ(a) = U(t) a U(t)⋆`, an `AutomorphismGroup (H →L[ℂ] H)`; this action satisfies (and is the +unique solution of) the Heisenberg-type equation `d/dt αₜ(a) = ⁅αₜ(a), i • generator⁆`, where this +bracket is the plain ring commutator on `H →L[ℂ] H` (`Ring.instBracket`/ +`LieRing.of_associative_ring_bracket`), not the `-(i/2)`-normalized observable bracket of +`StarAlgebra/Lie.lean` — the flow here is not restricted to self-adjoint elements, so that bracket +does not apply. Hamiltonian dynamics specializes this construction to `unitaryEvolution ℏ H`. + +`AutomorphismGroup` itself and its conjugation action (`AutomorphismGroup.conj`) are genuinely +algebra-level, not Hilbert-space-specific, and live in `CStarAlgebra/Automorphism.lean`; this file +only adds the Hilbert-space content — that every ⋆-automorphism of `H →L[ℂ] H` comes from a unitary, +the classification up to scalar phase, and the differential (Heisenberg) characterization of the +flow generated by a `UnitaryOneParameterGroup`. + +-/ + +@[expose] public section + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-! ## Every ⋆-automorphism is unitary conjugation -/ + +/-- Every ⋆-automorphism of `H →L[ℂ] H` is implemented by unitary conjugation. -/ +theorem conjStarAlgAut_surjective : + Function.Surjective (Unitary.conjStarAlgAut ℂ (H →L[ℂ] H)) := by + intro φ + obtain ⟨U, hU⟩ := + φ.eq_linearIsometryEquivConjStarAlgEquiv + (NonUnitalStarAlgHom.isometry φ φ.injective).continuous + refine ⟨Unitary.linearIsometryEquiv.symm U, ?_⟩ + rw [Unitary.conjStarAlgAut_symm_unitaryLinearIsometryEquiv] + exact hU.symm + +/-- Two unitaries implement the same ⋆-automorphism of `H →L[ℂ] H` exactly when they differ by a +scalar phase. -/ +lemma conjStarAlgAut_eq_iff (u v : unitary (H →L[ℂ] H)) : + Unitary.conjStarAlgAut ℂ (H →L[ℂ] H) u = + Unitary.conjStarAlgAut ℂ (H →L[ℂ] H) v ↔ + ∃ c : unitary ℂ, u = c • v := + Unitary.conjStarAlgAut_ext_iff' u v + +/-- The projective unitary group of `H`, obtained by quotienting out scalar phases. -/ +def ProjectiveUnitary (H : Type*) [NormedAddCommGroup H] [InnerProductSpace ℂ H] + [CompleteSpace H] := + unitary (H →L[ℂ] H) ⧸ MonoidHom.ker (Unitary.conjStarAlgAut ℂ (H →L[ℂ] H)) + +noncomputable instance : Group (ProjectiveUnitary H) := QuotientGroup.Quotient.group _ + +/-- Reversible transformations of `H →L[ℂ] H` are precisely projective unitaries. -/ +noncomputable def projectiveUnitaryEquivStarAlgAut : + ProjectiveUnitary H ≃* ((H →L[ℂ] H) ≃⋆ₐ[ℂ] (H →L[ℂ] H)) := + QuotientGroup.quotientKerEquivOfSurjective _ conjStarAlgAut_surjective + +/-! ## The automorphism group generated by unitary conjugation -/ + +namespace UnitaryOneParameterGroup + +/-- The reversible dynamics `a ↦ U(t) a U(t)⋆` induced by a unitary one-parameter group. -/ +noncomputable def toAutomorphism (U : UnitaryOneParameterGroup H) : + AutomorphismGroup (H →L[ℂ] H) where + toFun t := + Unitary.conjStarAlgAut ℂ (H →L[ℂ] H) + (⟨U t, U.mem_unitary t⟩ : unitary (H →L[ℂ] H)) + map_zero_apply a := by + simp + map_add_apply s t a := by + let Us : unitary (H →L[ℂ] H) := ⟨U s, U.mem_unitary s⟩ + let Ut : unitary (H →L[ℂ] H) := ⟨U t, U.mem_unitary t⟩ + let Ust : unitary (H →L[ℂ] H) := ⟨U (s + t), U.mem_unitary (s + t)⟩ + have hU : Ust = Us * Ut := by + apply Subtype.ext + exact AddChar.map_add_eq_mul U.toAddChar s t + change + (Unitary.conjStarAlgAut ℂ (H →L[ℂ] H) Ust) a = + ((Unitary.conjStarAlgAut ℂ (H →L[ℂ] H) Us) * + (Unitary.conjStarAlgAut ℂ (H →L[ℂ] H) Ut)) a + rw [hU, map_mul] + +/-- The induced automorphism is unitary conjugation. -/ +@[simp] +lemma toAutomorphism_apply (U : UnitaryOneParameterGroup H) (t : ℝ) (a : H →L[ℂ] H) : + (toAutomorphism U).toFun t a = U t * a * star (U t) := by + rfl + +/-! ## Differential characterization -/ + +/-- The conjugation flow satisfies the Heisenberg equation +`d/dt αₜ(a) = ⁅αₜ(a), i • generator⁆`. -/ +theorem hasDerivAt_toAutomorphism (U : UnitaryOneParameterGroup H) (a : H →L[ℂ] H) (t : ℝ) : + HasDerivAt (fun s : ℝ => (toAutomorphism U).toFun s a) + ⁅(toAutomorphism U).toFun t a, Complex.I • U.generator⁆ t := by + simp only [toAutomorphism_apply, LieRing.of_associative_ring_bracket] + have hcomm := (U.commute_generator t).smul_left Complex.I + have hd := ((U.hasDerivAt t).mul_const a).mul (U.hasDerivAt_star t) + convert hd using 1 <;> try rfl + simp only [mul_neg] + rw [← hcomm.eq] + noncomm_ring + +omit [CompleteSpace H] in +/-- A function on `ℝ` with everywhere-zero derivative is constant. -/ +private lemma const_of_hasDerivAt_zero {f : ℝ → H →L[ℂ] H} (hf : ∀ s, HasDerivAt f 0 s) (t : ℝ) : + f t = f 0 := by + apply isOpen_univ.is_const_of_deriv_eq_zero isPreconnected_univ + (fun s _ => (hf s).differentiableAt.differentiableWithinAt) + · intro s _ + exact (hf s).deriv + · exact Set.mem_univ t + · exact Set.mem_univ 0 + +/-- Along a solution `α` of the Heisenberg equation, the conjugated path +`s ↦ U(s)⋆ αₛ(a) U(s)` has zero derivative. -/ +private lemma hasDerivAt_conj_zero (U : UnitaryOneParameterGroup H) + (α : ℝ → (H →L[ℂ] H) → H →L[ℂ] H) (a : H →L[ℂ] H) + (hα : ∀ t, HasDerivAt (fun s => α s a) ⁅α t a, Complex.I • U.generator⁆ t) + (s : ℝ) : + HasDerivAt (fun r => star (U r) * α r a * U r) 0 s := by + simp only [LieRing.of_associative_ring_bracket] at hα + have hcomm := (U.commute_generator s).smul_left Complex.I + have hd := ((U.hasDerivAt_star s).mul (hα s)).mul (U.hasDerivAt s) + convert hd using 1 <;> try rfl + simp only [Pi.mul_apply, mul_neg] + rw [← hcomm.eq] + noncomm_ring + +/-- The conjugation flow is the unique solution of its Heisenberg initial-value problem. -/ +theorem toAutomorphism_unique (U : UnitaryOneParameterGroup H) + (α : ℝ → (H →L[ℂ] H) → H →L[ℂ] H) (hα0 : α 0 = id) + (hα : ∀ a t, HasDerivAt (fun s : ℝ => α s a) ⁅α t a, Complex.I • U.generator⁆ t) : + α = fun t a => (toAutomorphism U).toFun t a := by + funext t a + have hβ := const_of_hasDerivAt_zero (hasDerivAt_conj_zero U α a (hα a)) t + rw [congrFun hα0 a] at hβ + simp only [id_eq, AddChar.map_zero_eq_one, star_one, one_mul, mul_one] at hβ + rw [toAutomorphism_apply] + have hmul : U t * star (U t) = 1 := Unitary.mul_star_self_of_mem (U.mem_unitary t) + have h := congrArg (fun x : H →L[ℂ] H => U t * x * star (U t)) hβ + rwa [show U t * (star (U t) * α t a * U t) * star (U t) = + (U t * star (U t)) * α t a * (U t * star (U t)) by noncomm_ring, hmul, one_mul, mul_one] at h + +end UnitaryOneParameterGroup diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Dynamics/Hamiltonian.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Dynamics/Hamiltonian.lean new file mode 100644 index 0000000000..a75c5273da --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Dynamics/Hamiltonian.lean @@ -0,0 +1,296 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Dynamics.Automorphism + +/-! + +# Hamiltonian dynamics + +A bounded Hamiltonian `H` determines + + U_H(t) = exp(-itH/ℏ) + +and the automorphism flow + + αₜ(a) = U_H(t) a U_H(t)⋆. + +This is the special case of `UnitaryOneParameterGroup.toAutomorphism`/`hasDerivAt_toAutomorphism`/ +`toAutomorphism_unique` (`HilbertSpace/Dynamics/Automorphism.lean`) where the generating unitary +group is `unitaryEvolution ℏ H`, so the flow is the unique solution of + + dαₜ(a)/dt = -(i/ℏ) [H, αₜ(a)], + α₀ = id. + +Shifting `H` by a real multiple of the identity changes `U_H(t)` only by a scalar phase and +therefore leaves the automorphism flow unchanged. For `H →L[ℂ] H` this is the only ambiguity. + +-/ + +@[expose] public section + +open scoped ComplexOrder + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-- Needed for `NormedSpace.map_exp` at `H →L[ℂ] H`. -/ +noncomputable local instance : NormedAlgebra ℚ (H →L[ℂ] H) := + .restrictScalars ℚ ℂ (H →L[ℂ] H) + +namespace UnitaryOneParameterGroup + +omit [CompleteSpace H] in +/-- A real scalar multiple on `H →L[ℂ] H` agrees with the corresponding complex scalar multiple. -/ +private lemma real_smul_eq_complex_smul (r : ℝ) (x : H →L[ℂ] H) : r • x = (r : ℂ) • x := by + have h' : (r : ℂ) = algebraMap ℝ ℂ r := by norm_cast + rw [h', IsScalarTower.algebraMap_smul] + +/-! ## Unitary evolution -/ + +/-- The unitary evolution `U_H(t) = exp(-itH/ℏ)` generated by `H`. -/ +noncomputable def unitaryEvolution + (ℏ : ℝ) (Hm : Observable (H →L[ℂ] H)) : + UnitaryOneParameterGroup H := + (UnitaryOneParameterGroup.stoneEquiv).symm (ℏ⁻¹ • Hm) + +/-- The generator of `unitaryEvolution` is `ℏ⁻¹ • H`. -/ +@[simp] +lemma unitaryEvolution_generator + (ℏ : ℝ) (Hm : Observable (H →L[ℂ] H)) : + (unitaryEvolution ℏ Hm).generator = + (ℏ⁻¹ : ℝ) • (Hm : H →L[ℂ] H) := by + simp [unitaryEvolution, UnitaryOneParameterGroup.stoneEquiv] + +/-- The closed form `U_H(t) = exp(-itH/ℏ)`. -/ +lemma unitaryEvolution_apply + (ℏ : ℝ) (Hm : Observable (H →L[ℂ] H)) (t : ℝ) : + unitaryEvolution ℏ Hm t = + NormedSpace.exp + ((-(t : ℂ) * Complex.I) • + ((ℏ⁻¹ : ℝ) • (Hm : H →L[ℂ] H))) := by + rw [UnitaryOneParameterGroup.apply_eq_exp_generator] + rw [unitaryEvolution_generator] + +/-! ## Hamiltonian flow -/ + +/-- The automorphism flow induced by the unitary evolution generated by `H`. -/ +noncomputable def hamiltonianFlow + (ℏ : ℝ) (Hm : Observable (H →L[ℂ] H)) : + AutomorphismGroup (H →L[ℂ] H) := + toAutomorphism (unitaryEvolution ℏ Hm) + +/-- Unfolds `hamiltonianFlow` to `a ↦ U(t) a U(t)⋆`. -/ +@[simp] +lemma hamiltonianFlow_apply + (ℏ : ℝ) (Hm : Observable (H →L[ℂ] H)) (t : ℝ) (a : H →L[ℂ] H) : + (hamiltonianFlow ℏ Hm).toFun t a = + unitaryEvolution ℏ Hm t * a * star (unitaryEvolution ℏ Hm t) := by + simp [hamiltonianFlow] + +/-! ## Equivariance under star automorphisms + +Changing the representation by `β` conjugates the flow generated by `β(H)` by `β`. -/ + +/-- Conjugating the generating unitary by `β` amounts to applying `β` pointwise. -/ +lemma unitaryEvolution_map (ℏ : ℝ) (β : (H →L[ℂ] H) ≃⋆ₐ[ℂ] (H →L[ℂ] H)) + (Hm : Observable (H →L[ℂ] H)) (t : ℝ) : + unitaryEvolution ℏ (β.observable Hm) t = β (unitaryEvolution ℏ Hm t) := by + have hcont : Continuous β := (NonUnitalStarAlgHom.isometry β β.injective).continuous + -- `β` is only registered as `ℂ`-linear, so move the real scalar `ℏ⁻¹ • _` to `ℂ` first. + rw [unitaryEvolution_apply, unitaryEvolution_apply, real_smul_eq_complex_smul, + real_smul_eq_complex_smul, NormedSpace.map_exp β hcont, map_smul, map_smul, + StarAlgEquiv.observable_coe] + +/-- The Hamiltonian flow is equivariant under ⋆-automorphism conjugation: `β(H)`'s flow is `H`'s +flow viewed through the change of coordinates `β`. -/ +theorem hamiltonianFlow_map (ℏ : ℝ) (β : (H →L[ℂ] H) ≃⋆ₐ[ℂ] (H →L[ℂ] H)) + (Hm : Observable (H →L[ℂ] H)) : + hamiltonianFlow ℏ (β.observable Hm) = (hamiltonianFlow ℏ Hm).conj β := by + apply AutomorphismGroup.ext + intro t a + rw [AutomorphismGroup.conj_apply, hamiltonianFlow_apply, hamiltonianFlow_apply, + unitaryEvolution_map, map_mul, map_mul, map_star, β.apply_symm_apply] + +/-- The unitary specialization of `hamiltonianFlow_map`, at `β = Ad_V` for a unitary `V`. -/ +lemma hamiltonianFlow_conj_unitary (ℏ : ℝ) (V : unitary (H →L[ℂ] H)) + (Hm : Observable (H →L[ℂ] H)) : + hamiltonianFlow ℏ ((Unitary.conjStarAlgAut ℂ (H →L[ℂ] H) V).observable Hm) = + (hamiltonianFlow ℏ Hm).conj (Unitary.conjStarAlgAut ℂ (H →L[ℂ] H) V) := + hamiltonianFlow_map ℏ (Unitary.conjStarAlgAut ℂ (H →L[ℂ] H) V) Hm + +/-! ## Differential characterization + +A one-line specialization of the generic `UnitaryOneParameterGroup` API to +`U = unitaryEvolution ℏ H`, with generator `(i/ℏ) H`. -/ + +/-- The scaled Hamiltonian `(i/ℏ) H`, the generator on the right of the Heisenberg equation. -/ +noncomputable def G (ℏ : ℝ) (Hm : Observable (H →L[ℂ] H)) : H →L[ℂ] H := + (Complex.I / (ℏ : ℂ)) • (Hm : H →L[ℂ] H) + +/-- `G` is `i` times `unitaryEvolution`'s generator. -/ +private lemma smul_I_generator (ℏ : ℝ) (Hm : Observable (H →L[ℂ] H)) : + Complex.I • (unitaryEvolution ℏ Hm).generator = G ℏ Hm := by + rw [unitaryEvolution_generator, real_smul_eq_complex_smul, smul_smul] + congr 1 + simp [div_eq_mul_inv] + +/-- The Hamiltonian flow satisfies the Heisenberg equation `d/dt αₜ(a) = ⁅αₜ(a), G⁆`. -/ +theorem hasDerivAt_hamiltonianFlow (ℏ : ℝ) (Hm : Observable (H →L[ℂ] H)) (a : H →L[ℂ] H) + (t : ℝ) : + HasDerivAt (fun t : ℝ => (hamiltonianFlow ℏ Hm).toFun t a) + ⁅(hamiltonianFlow ℏ Hm).toFun t a, G ℏ Hm⁆ t := by + rw [← smul_I_generator] + exact hasDerivAt_toAutomorphism (unitaryEvolution ℏ Hm) a t + +/-- The Hamiltonian flow is the unique solution of its Heisenberg initial-value problem. -/ +theorem hamiltonianFlow_unique (ℏ : ℝ) (Hm : Observable (H →L[ℂ] H)) + (α : ℝ → (H →L[ℂ] H) → H →L[ℂ] H) (hα0 : α 0 = id) + (hα : ∀ a t, HasDerivAt (fun s : ℝ => α s a) ⁅α t a, G ℏ Hm⁆ t) : + α = fun t a => (hamiltonianFlow ℏ Hm).toFun t a := by + apply toAutomorphism_unique (unitaryEvolution ℏ Hm) α hα0 + intro a t + rw [smul_I_generator] + exact hα a t + +/-! ## Hamiltonians modulo scalar shifts -/ + +/-- Shifting `H` by `c • 1` shifts `G` by a central term. -/ +private lemma G_add_smul_one (ℏ : ℝ) (Hm : Observable (H →L[ℂ] H)) (c : ℝ) : + G ℏ (Hm + c • 1) = G ℏ Hm + ((Complex.I / (ℏ : ℂ)) * (c : ℂ)) • (1 : H →L[ℂ] H) := by + show (Complex.I / (ℏ : ℂ)) • ((Hm : H →L[ℂ] H) + c • (1 : H →L[ℂ] H)) = + (Complex.I / (ℏ : ℂ)) • (Hm : H →L[ℂ] H) + ((Complex.I / (ℏ : ℂ)) * (c : ℂ)) • (1 : H →L[ℂ] H) + rw [smul_add, real_smul_eq_complex_smul, smul_smul] + +omit [CompleteSpace H] in +/-- A central element (a scalar multiple of `1`) brackets to zero with anything. -/ +private lemma central_cancel (z : ℂ) (x : H →L[ℂ] H) : + ⁅x, z • (1 : H →L[ℂ] H)⁆ = 0 := by + simp [LieRing.of_associative_ring_bracket] + +omit [CompleteSpace H] in +/-- The bracket is additive in its second argument. -/ +private lemma lie_add' (x m n : H →L[ℂ] H) : ⁅x, m + n⁆ = ⁅x, m⁆ + ⁅x, n⁆ := by + simp only [LieRing.of_associative_ring_bracket] + noncomm_ring + +/-- Scalar shifts of `H` don't change the Hamiltonian flow. -/ +lemma hamiltonianFlow_add_smul_one + (ℏ : ℝ) (Hm : Observable (H →L[ℂ] H)) (c : ℝ) : + hamiltonianFlow ℏ (Hm + c • 1) = + hamiltonianFlow ℏ Hm := by + apply AutomorphismGroup.ext + intro t a + have huniq := hamiltonianFlow_unique ℏ Hm + (fun t a => (hamiltonianFlow ℏ (Hm + c • 1)).toFun t a) (by ext a; simp) + (fun a t => by + have hd := hasDerivAt_hamiltonianFlow ℏ (Hm + c • 1) a t + rwa [G_add_smul_one, lie_add', central_cancel, add_zero] at hd) + exact congrFun (congrFun huniq t) a + +/-- Hamiltonians differing by a real scalar multiple of the identity generate the same flow. -/ +lemma hamiltonianFlow_eq_of_eq_add_smul_one + (ℏ : ℝ) (Hm K : Observable (H →L[ℂ] H)) (c : ℝ) + (h : Hm = K + c • 1) : + hamiltonianFlow ℏ Hm = hamiltonianFlow ℏ K := by + rw [h] + exact hamiltonianFlow_add_smul_one ℏ K c + +/-! ## Classification up to star-automorphism conjugation + +`hamiltonianFlow_map` and `hamiltonianFlow_add_smul_one` give the easy direction: `K` generates the +`β`-conjugate of `H`'s flow whenever `K = β(H) + c • 1`. The converse needs a differential argument, +`hamiltonianFlow_eq_iff` below. -/ + +/-- If `K = β(H) + c • 1`, `K`'s flow is `H`'s flow viewed through `β`. -/ +lemma hamiltonianFlow_map_add_smul_one (ℏ : ℝ) (β : (H →L[ℂ] H) ≃⋆ₐ[ℂ] (H →L[ℂ] H)) + (Hm K : Observable (H →L[ℂ] H)) (c : ℝ) (h : K = β.observable Hm + c • 1) : + hamiltonianFlow ℏ K = (hamiltonianFlow ℏ Hm).conj β := by + rw [h, hamiltonianFlow_add_smul_one, hamiltonianFlow_map] + +/-- If `H` and `K` generate the same flow, `G ℏ H - G ℏ K` commutes with everything: equal flows +have equal derivatives at `0`, and the Heisenberg equation reads that off as a bracket. -/ +private lemma comm_G_of_hamiltonianFlow_eq (ℏ : ℝ) (Hm K : Observable (H →L[ℂ] H)) + (heq : hamiltonianFlow ℏ Hm = hamiltonianFlow ℏ K) (a : H →L[ℂ] H) : + a * (G ℏ Hm - G ℏ K) = (G ℏ Hm - G ℏ K) * a := by + have hH := hasDerivAt_hamiltonianFlow ℏ Hm a 0 + have hK := hasDerivAt_hamiltonianFlow ℏ K a 0 + rw [(hamiltonianFlow ℏ Hm).map_zero_apply a, heq] at hH + rw [(hamiltonianFlow ℏ K).map_zero_apply a] at hK + have hbracket := hH.unique hK + simp only [LieRing.of_associative_ring_bracket] at hbracket + have hexpand : a * (G ℏ Hm - G ℏ K) - (G ℏ Hm - G ℏ K) * a + = (a * G ℏ Hm - G ℏ Hm * a) - (a * G ℏ K - G ℏ K * a) := by noncomm_ring + rw [hbracket, sub_self] at hexpand + exact sub_eq_zero.mp hexpand + +/-- A self-adjoint difference of self-adjoint elements that is a scalar multiple of `1` has a real +scalar: self-adjointness of `w • 1` forces `conj w = w`. -/ +private lemma exists_real_of_isSelfAdjoint_sub_smul_one [Nontrivial (H →L[ℂ] H)] + {x y : H →L[ℂ] H} (hx : IsSelfAdjoint x) (hy : IsSelfAdjoint y) {w : ℂ} + (h : x - y = w • (1 : H →L[ℂ] H)) : + ∃ c : ℝ, x = y + c • 1 := by + have hself : IsSelfAdjoint (w • (1 : H →L[ℂ] H)) := h ▸ hx.sub hy + rw [IsSelfAdjoint, star_smul, star_one] at hself + have hwreal : (starRingEnd ℂ) w = w := smul_left_injective ℂ one_ne_zero hself + have hwre : w = (w.re : ℂ) := Complex.ext rfl (Complex.conj_eq_iff_im.mp hwreal) + rw [hwre, ← real_smul_eq_complex_smul] at h + exact ⟨w.re, sub_eq_iff_eq_add'.mp h⟩ + +/-- Two Hamiltonians generate the same flow (at a fixed representation) exactly when they differ +by a real scalar multiple of the identity. -/ +theorem hamiltonianFlow_eq_iff (ℏ : ℝ) (hℏ : ℏ ≠ 0) [Nontrivial (H →L[ℂ] H)] + (Hm K : Observable (H →L[ℂ] H)) : + hamiltonianFlow ℏ Hm = hamiltonianFlow ℏ K ↔ ∃ c : ℝ, Hm = K + c • 1 := by + constructor + · intro heq + have hcentral : G ℏ Hm - G ℏ K ∈ Subalgebra.center ℂ (H →L[ℂ] H) := + Subalgebra.mem_center_iff.mpr (comm_G_of_hamiltonianFlow_eq ℏ Hm K heq) + obtain ⟨z, hz⟩ := (Algebra.IsCentral.mem_center_iff (K := ℂ)).mp hcentral + rw [Algebra.algebraMap_eq_smul_one] at hz + have ha : (Complex.I / (ℏ : ℂ)) ≠ 0 := div_ne_zero Complex.I_ne_zero (by exact_mod_cast hℏ) + have hHK : (Hm : H →L[ℂ] H) - (K : H →L[ℂ] H) = + ((Complex.I / (ℏ : ℂ))⁻¹ * z) • (1 : H →L[ℂ] H) := by + have hGdiff : G ℏ Hm - G ℏ K = + (Complex.I / (ℏ : ℂ)) • ((Hm : H →L[ℂ] H) - (K : H →L[ℂ] H)) := by + simp only [G, smul_sub] + rw [← smul_smul] + exact (eq_inv_smul_iff₀ ha).mpr (hGdiff.symm.trans hz) + obtain ⟨c, hc⟩ := exists_real_of_isSelfAdjoint_sub_smul_one Hm.2 K.2 hHK + exact ⟨c, Subtype.ext hc⟩ + · rintro ⟨c, h⟩ + exact hamiltonianFlow_eq_of_eq_add_smul_one ℏ Hm K c h + +/-- Two Hamiltonians generate conjugate flows exactly when they agree up to a change of +representation `β` and a real scalar shift. -/ +theorem hamiltonianFlow_conj_iff (ℏ : ℝ) (hℏ : ℏ ≠ 0) [Nontrivial (H →L[ℂ] H)] + (β : (H →L[ℂ] H) ≃⋆ₐ[ℂ] (H →L[ℂ] H)) (Hm K : Observable (H →L[ℂ] H)) : + hamiltonianFlow ℏ K = (hamiltonianFlow ℏ Hm).conj β ↔ ∃ c : ℝ, K = β.observable Hm + c • 1 := by + rw [← hamiltonianFlow_map] + exact hamiltonianFlow_eq_iff ℏ hℏ K (β.observable Hm) + +/-- Two Hamiltonians generate flows related by some automorphism of `H →L[ℂ] H` exactly when one +is a unitary conjugate of the other, up to a real scalar shift. -/ +theorem hamiltonianFlow_iff_exists_unitary (ℏ : ℝ) (hℏ : ℏ ≠ 0) [Nontrivial (H →L[ℂ] H)] + (Hm K : Observable (H →L[ℂ] H)) : + (∃ β : (H →L[ℂ] H) ≃⋆ₐ[ℂ] (H →L[ℂ] H), hamiltonianFlow ℏ K = (hamiltonianFlow ℏ Hm).conj β) ↔ + ∃ (V : unitary (H →L[ℂ] H)) (c : ℝ), + (K : H →L[ℂ] H) = (V : H →L[ℂ] H) * (Hm : H →L[ℂ] H) * star (V : H →L[ℂ] H) + + c • 1 := by + constructor + · rintro ⟨β, hβ⟩ + obtain ⟨V, hV⟩ := conjStarAlgAut_surjective (H := H) β + obtain ⟨c, hc⟩ := (hamiltonianFlow_conj_iff ℏ hℏ β Hm K).mp hβ + refine ⟨V, c, ?_⟩ + have := congrArg (Subtype.val (p := fun x : H →L[ℂ] H => IsSelfAdjoint x)) hc + simpa [← hV, Unitary.conjStarAlgAut_apply] using this + · rintro ⟨V, c, hc⟩ + refine ⟨Unitary.conjStarAlgAut ℂ (H →L[ℂ] H) V, ?_⟩ + apply hamiltonianFlow_map_add_smul_one ℏ (Unitary.conjStarAlgAut ℂ (H →L[ℂ] H) V) Hm K c + apply Subtype.ext + simpa [Unitary.conjStarAlgAut_apply] using hc + +end UnitaryOneParameterGroup diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/State/Density.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/State/Density.lean new file mode 100644 index 0000000000..413b216a81 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/State/Density.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 David Gross. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Gross +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Trace +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.Basic + +/-! + +# Density-operator states + +Construction of states from positive trace-one continuous linear endomorphisms. + +-/ + +@[expose] public section + +open ComplexOrder ContinuousLinearMap + +namespace UnitalPositiveLinearMap + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] +variable {ρ : H →L[ℂ] H} (hpos : 0 ≤ ρ) (hnorm : (ρ : H →ₗ[ℂ] H).trace ℂ H = 1) + +/-- A trace-one positive continuous linear map defines a state. -/ +noncomputable def ofDensity : 𝓢[H →L[ℂ] H] := + { ρ.traceMulOpₚ with map_one' := by simp_all } + +@[simp] +lemma ofDensity_apply {ρ : H →L[ℂ] H} (hpos : 0 ≤ ρ) + (hnorm : (ρ : H →ₗ[ℂ] H).trace ℂ H = 1) (x : H →L[ℂ] H) : + ofDensity hpos hnorm x = (↑x * ↑ρ : H →ₗ[ℂ] H).trace ℂ H := + ρ.traceMulOpₚ_apply_of_nonneg hpos x + +end UnitalPositiveLinearMap diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/State/Vector.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/State/Vector.lean new file mode 100644 index 0000000000..814161b783 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/State/Vector.lean @@ -0,0 +1,55 @@ +/- +Copyright (c) 2026 David Gross. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Gross +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.StarAlgebra.Restrict +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.Basic +public import Mathlib + +/-! + +# Vector states + +Vector states on spaces of continuous linear endomorphisms. + +-/ + +@[expose] public section + +open ComplexOrder ContinuousLinearMap +open scoped InnerProductSpace + +section ofVec + +variable {H 𝕜 : Type*} [RCLike 𝕜] [NormedAddCommGroup H] [InnerProductSpace 𝕜 H] + +/-- The vector functional associated with `ψ`. -/ +@[simps apply] +def PositiveLinearMap.ofVec (ψ : H) : 𝓟[𝕜, H →L[𝕜] H] where + toFun x := ⟪ψ, x • ψ⟫_𝕜 + map_add' x y := by simp [inner_add_right] + map_smul' x y := by simp [inner_smul_right] + monotone' x y hxy := by + simpa [inner_sub_right] using ((le_def x y).mp hxy).inner_nonneg_right ψ + +/-- The vector state associated with a unit vector. -/ +@[simps! apply] +def UnitalPositiveLinearMap.ofVec {ψ : H} (h : ‖ψ‖ = 1) : 𝓢[𝕜, H →L[𝕜] H] := + { PositiveLinearMap.ofVec ψ with map_one' := by simp [h] } + +end ofVec + +section Example + +open UnitalPositiveLinearMap + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +example (ψ : H) (h : ‖ψ‖ = 1) : + (ofVec h).restrictSAC (1 : selfAdjoint (H →L[ℂ] H)) = (1 : ℝ) := by + simp + +end Example diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Trace.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Trace.lean new file mode 100644 index 0000000000..45af3bf20d --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Trace.lean @@ -0,0 +1,84 @@ +/- +Copyright (c) 2026 David Gross. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Gross +-/ +module + +public import Mathlib +public import PhyslibAlpha.AlgebraicFramework.StarAlgebra.Traciality + +/-! + +# Trace as a positive linear map on continuous linear maps + +## Main definitions + +- `PositiveLinearMap.conjugateₚ`: conjugation as a positive linear map. +- `ContinuousLinearMap.traceₚ`: trace as a positive linear map. +- `ContinuousLinearMap.traceMulOpₚ`: the trace pairing with a positive operator. +- `ContinuousLinearMap.traceₚ_isTracial`: the trace is a tracial functional in the sense of + `LinearMap.IsTracial` (`StarAlgebra/Traciality.lean`) — the fact connecting this concrete + Hilbert-space trace to the abstract tracial-weight/state framework. + +-/ + +@[expose] public section + +section Conjugate + +variable {A : Type*} [NonUnitalSemiring A] [PartialOrder A] [StarRing A] [StarOrderedRing A] + (R : Type*) [Semiring R] [StarRing R] + [Module R A] [StarModule R A] [SMulCommClass R A A] [IsScalarTower R A A] + +/-- Conjugation `x ↦ c * x * star x`, as a positive linear map. -/ +@[simps!] +def PositiveLinearMap.conjugateₚ (c : A) : A →ₚ[R] A where + toLinearMap := LinearMap.mulLeftRight R (c, star c) + monotone' _ _ h := star_right_conjugate_le_conjugate h c + +end Conjugate + +open ComplexOrder + +section Complex + +variable {E : Type*} [NormedAddCommGroup E] [InnerProductSpace ℂ E] [CompleteSpace E] + +namespace ContinuousLinearMap + +/-- The trace on continuous linear maps, bundled as a positive linear map. -/ +@[simps!] +noncomputable def traceₚ : (E →L[ℂ] E) →ₚ[ℂ] ℂ := .mk₀ + { toFun x := x.toLinearMap.trace ℂ E + map_add' x y := by simp + map_smul' m x := by simp } + (fun x h ↦ by + simpa using (x.isPositive_toLinearMap_iff.mpr (x.nonneg_iff_isPositive.mp h)).trace_nonneg) + +/-- The trace is a tracial functional: cyclic under multiplication, connecting the concrete +Hilbert-space trace here to `LinearMap.IsTracial` from `StarAlgebra/Traciality.lean`. -/ +lemma traceₚ_isTracial : (traceₚ (E := E)).toLinearMap.IsTracial := + fun x y => by simp [traceₚ_apply, toLinearMap_mul, LinearMap.trace_mul_comm] + +open PositiveLinearMap + +/-- The positive linear functional `x ↦ tr (√ρ * x * √ρ†)`. -/ +noncomputable def traceMulOpₚ (ρ : E →L[ℂ] E) : (E →L[ℂ] E) →ₚ[ℂ] ℂ := + traceₚ.comp (conjugateₚ ℂ (CFC.sqrt ρ)) + +@[simp] +lemma traceMulOpₚ_apply_of_nonneg {ρ : E →L[ℂ] E} (h : 0 ≤ ρ) (x : E →L[ℂ] E) : + ρ.traceMulOpₚ x = (↑x * ↑ρ : E →ₗ[ℂ] E).trace ℂ E := by + simp_rw [traceMulOpₚ, PositiveLinearMap.comp_apply, coe_toLinearMap, conjugateₚ_apply, + traceₚ_apply, toLinearMap_mul] + rw [mul_assoc, LinearMap.trace_mul_comm, mul_assoc, (CFC.sqrt_nonneg ρ).isSelfAdjoint.star_eq] + have := congrArg toLinearMap (CFC.sqrt_mul_sqrt_self ρ h) + simp_all + +@[simp] +lemma traceMulOpₚ_apply_of_not_nonneg {ρ : E →L[ℂ] E} (h : ¬0 ≤ ρ) (x : E →L[ℂ] E) : + ρ.traceMulOpₚ x = 0 := by + simp [traceMulOpₚ, CFC.sqrt_of_not_nonneg h] + +end ContinuousLinearMap diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/TraceClass/Banach.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/TraceClass/Banach.lean new file mode 100644 index 0000000000..19cdd77d1b --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/TraceClass/Banach.lean @@ -0,0 +1,462 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.TraceClass.Basic +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.TraceClass.GeneralProduct +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.TraceClass.IdealNorm +public import Mathlib.Analysis.Normed.Group.Seminorm +public import Mathlib.Analysis.Normed.Group.Completeness + +/-! +# The trace-class Banach space `𝒮₁(H)` + +Ported from `unbounded-alpha-public`'s +`QuantumMechanics/Unbounded/OperatorAlgebra/TraceClass/Space.lean`, adapted to this repo's +predicate-based `IsTraceClass`/`traceNorm`/`trace` (`HilbertSpace/TraceClass/Basic.lean`) rather +than the source's own bundled `TraceClass H` subtype (which lived in a *different*, non-predicate +`IsTraceClass` universe with its own general-product/ideal-norm theory built up over ~150KB across +17 files: `GeneralProduct.lean`, `IdealNorm.lean`, `PositiveIdeal.lean`, `HilbertSchmidt.lean`, +`Polar.lean`, `TraceAlgebra.lean`, etc.). This file re-bundles this repo's own `IsTraceClass` +predicate into the same kind of submodule/Banach-space package the source built, but the *proofs* +of the arithmetic closure facts that package needs (trace-class is closed under `+`, the trace norm +is subadditive, scalar multiplication scales it exactly, completeness) are **not** re-derived here: +they are exactly the "genuinely harder work" this repo's own `Basic.lean` docstring says it leaves +to "the later trace-class Banach space phase" (see `Basic.lean`'s own module doc, third paragraph +under "Relationship to `HilbertSpace/Trace.lean`"). This file is the promised later phase, but +lands with those specific gaps still open rather than silently invoking them. + +## What closes the arithmetic-closure gaps + +**Fully sorry-free.** The Hilbert–Schmidt/polar-decomposition prerequisite stack +(`HilbertSpace/TraceClass/{HilbertSchmidt,Polar,GeneralIdeal,GeneralProduct,IdealNorm}.lean`, +restating `unbounded-alpha-public`'s +`TraceClass/{HilbertSchmidt,HSAlgebra,HSEstimate,Polar,GeneralIdeal,GeneralProduct,IdealNorm, +Completeness}.lean` directly against this repo's own `H →L[ℂ] H`/predicate-based `IsTraceClass` — +no bundled-subtype translation was needed, since the source's own top-level `TraceClass.lean` +already used the identical predicate convention this repo's `Basic.lean` does) supplies: + +* `isTraceClass_add` / `traceNorm_add_le` — from `GeneralProduct.isTraceClass_add` and + `IdealNorm.traceNorm_add_le`, both built on the master lemma that a product of two + Hilbert–Schmidt operators is trace class (`GeneralProduct.isTraceClass_mul_of_isHilbertSchmidt`), + itself resting on the general partial-isometry identity `Polar.star_polarFactor_mul_self : star + (polarFactor T) * T = |T|` (valid for *every* bounded `T`, not just self-adjoint ones). +* `instCompleteSpace` — via the absolutely-convergent-series criterion + (`NormedAddCommGroup.completeSpace_of_summable_imp_tendsto`), following + `unbounded-alpha-public`'s `Completeness.lean` directly: partial sums of an absolutely convergent + series are Cauchy in operator norm (operator norm ≤ trace norm, `opNorm_le_traceNorm`), hence + converge in `H →L[ℂ] H`; the auxiliary lower-semicontinuity lemma + `isTraceClass_of_tendsto_of_traceNorm_bounded` identifies the limit as trace class with a + quantitative trace-norm bound, applied twice (once to the whole sequence, once to each shifted + tail) to get the tail bound that is exactly trace-norm convergence. + +`isTraceClass_smul`/`traceNorm_smul` follow from Mathlib's `CFC.abs_smul`, and `opNorm_le_traceNorm` +is the elementary "operator norm ≤ Hilbert–Schmidt norm" argument, using `Basic.lean`'s Parseval +lemma `hasSum_norm_sq_inner_basis`. +-/ + +@[expose] public section + +noncomputable section + +open scoped ComplexOrder InnerProductSpace Topology Filter +open Filter + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-! ## Arithmetic closure of `IsTraceClass` -/ + +theorem isTraceClass_zero : IsTraceClass (0 : H →L[ℂ] H) := by + obtain ⟨w, b, _⟩ := exists_hilbertBasis ℂ H + exact ⟨w, b, by simp [CFC.abs_zero]⟩ + +/-- **Gap (3), closed directly**: trace class is closed under scalar multiplication, via Mathlib's +`CFC.abs_smul : CFC.abs (c • T) = ‖c‖ • CFC.abs T`. -/ +theorem isTraceClass_smul (c : ℂ) {T : H →L[ℂ] H} (hT : IsTraceClass T) : + IsTraceClass (c • T) := by + obtain ⟨w, b, hb⟩ := hT + refine ⟨w, b, ?_⟩ + have habs : CFC.abs (c • T) = ‖c‖ • CFC.abs T := CFC.abs_smul c T + have heq : ∀ i : w, (⟪b i, CFC.abs (c • T) (b i)⟫_ℂ).re + = ‖c‖ * (⟪b i, CFC.abs T (b i)⟫_ℂ).re := by + intro i + rw [habs, smul_apply, + RCLike.real_smul_eq_coe_smul (K := ℂ), inner_smul_right] + simp [Complex.mul_re] + simpa only [heq] using hb.mul_left ‖c‖ + +-- Trace class is closed under addition: `isTraceClass_add`, ported into `GeneralProduct.lean` +-- from the polar-decomposition/Hilbert–Schmidt-factorization argument (see module docstring). +-- That theorem already has exactly the signature `IsTraceClass T → IsTraceClass T' → +-- IsTraceClass (T + T')`, so it is used directly (e.g. below, and in `traceClassSubmodule`) +-- rather than restated here. + +theorem isTraceClass_neg {T : H →L[ℂ] H} (hT : IsTraceClass T) : IsTraceClass (-T) := by + have h := isTraceClass_smul (-1 : ℂ) hT + rwa [neg_one_smul] at h + +/-- Transporting `traceNorm` across an equality of the underlying operator. Needed because `rw` +cannot rewrite `traceNorm`'s operator argument directly (the motive depends on the witness proof). +-/ +theorem traceNorm_transport {X Y : H →L[ℂ] H} (hEq : X = Y) (hX : IsTraceClass X) : + traceNorm X hX = traceNorm Y (hEq ▸ hX) := by + subst hEq; rfl + +theorem traceNorm_zero : traceNorm (0 : H →L[ℂ] H) isTraceClass_zero = 0 := by + obtain ⟨w, b, _⟩ := exists_hilbertBasis ℂ H + rw [traceNorm_eq_of_hilbertBasis isTraceClass_zero b] + simp [CFC.abs_zero] + +/-- **Gap (3), closed directly**: the trace norm scales exactly under scalar multiplication, +`‖c • T‖₁ = ‖c‖ * ‖T‖₁`, via `CFC.abs_smul` and `traceNorm_eq_of_hilbertBasis` (evaluated at `T`'s +own witness basis, where `traceNorm T hT` unfolds definitionally). -/ +theorem traceNorm_smul (c : ℂ) {T : H →L[ℂ] H} (hT : IsTraceClass T) : + traceNorm (c • T) (isTraceClass_smul c hT) = ‖c‖ * traceNorm T hT := by + set w₀ : Set H := hT.choose with hw₀ + set b₀ : HilbertBasis w₀ ℂ H := hT.choose_spec.choose with hb₀def + have habs : CFC.abs (c • T) = ‖c‖ • CFC.abs T := CFC.abs_smul c T + have heq : ∀ i : w₀, (⟪b₀ i, CFC.abs (c • T) (b₀ i)⟫_ℂ).re + = ‖c‖ * (⟪b₀ i, CFC.abs T (b₀ i)⟫_ℂ).re := by + intro i + rw [habs, smul_apply, + RCLike.real_smul_eq_coe_smul (K := ℂ), inner_smul_right] + simp [Complex.mul_re] + rw [traceNorm_eq_of_hilbertBasis (isTraceClass_smul c hT) b₀] + calc ∑' i : w₀, (⟪b₀ i, CFC.abs (c • T) (b₀ i)⟫_ℂ).re + = ∑' i : w₀, ‖c‖ * (⟪b₀ i, CFC.abs T (b₀ i)⟫_ℂ).re := tsum_congr heq + _ = ‖c‖ * ∑' i : w₀, (⟪b₀ i, CFC.abs T (b₀ i)⟫_ℂ).re := tsum_mul_left + _ = ‖c‖ * traceNorm T hT := rfl + +theorem traceNorm_neg {T : H →L[ℂ] H} (hT : IsTraceClass T) (hnegT : IsTraceClass (-T)) : + traceNorm (-T) hnegT = traceNorm T hT := by + have h1 := traceNorm_smul (-1 : ℂ) hT + have h2 := traceNorm_transport (neg_one_smul ℂ T) (isTraceClass_smul (-1) hT) + calc + traceNorm (-T) hnegT = + traceNorm (-T) (neg_one_smul ℂ T ▸ isTraceClass_smul (-1) hT) := traceNorm_congr + _ = traceNorm ((-1 : ℂ) • T) (isTraceClass_smul (-1) hT) := h2.symm + _ = ‖(-1 : ℂ)‖ * traceNorm T hT := h1 + _ = traceNorm T hT := by norm_num + +-- The trace norm is subadditive, `‖T + T'‖₁ ≤ ‖T‖₁ + ‖T'‖₁`: `traceNorm_add_le`, ported into +-- `IdealNorm.lean` from the duality-bound argument (see module docstring), already has exactly +-- this signature, so it is used directly (e.g. in `traceClassAddGroupNorm` below) rather than +-- restated here. + +/-- **Gap (4), closed directly** (not from the source's `IdealNorm.lean:332`, which builds this +from the general duality/ideal-norm machinery): `‖T‖ ≤ ‖T‖₁`, proved instead by the elementary +"operator norm ≤ Hilbert–Schmidt norm" argument. Writing `A := |T|`, `S := √A` (self-adjoint, +`S*S = A`), for any unit `x`: `‖Sx‖² = ∑ᵢ‖⟪bᵢ,Sx⟫‖²` (Parseval) `= ∑ᵢ‖⟪Sbᵢ,x⟫‖²` (`S` self-adjoint) +`≤ ∑ᵢ‖Sbᵢ‖²‖x‖²` (Cauchy–Schwarz termwise) `= ‖T‖₁ ‖x‖²` (the trace-norm diagonal sum, in the same +basis). Hence `‖S‖ ≤ √‖T‖₁`, so `‖T‖ = ‖A‖ = ‖S*S‖ = ‖S‖² ≤ ‖T‖₁`. -/ +theorem opNorm_le_traceNorm {T : H →L[ℂ] H} (hT : IsTraceClass T) : ‖T‖ ≤ traceNorm T hT := by + set A : H →L[ℂ] H := CFC.abs T with hAdef + have hAnonneg : 0 ≤ A := CFC.abs_nonneg T + have hAself : IsSelfAdjoint A := .of_nonneg hAnonneg + set S : H →L[ℂ] H := CFC.sqrt A with hSdef + have hSself : IsSelfAdjoint S := .of_nonneg (CFC.sqrt_nonneg A) + have hSS : S * S = A := CFC.sqrt_mul_sqrt_self A hAnonneg + have hTA : ‖T‖ = ‖A‖ := (CFC.norm_abs).symm + have hAeq : ‖A‖ = ‖S‖ ^ 2 := by rw [← hSS]; exact hSself.norm_mul_self + set w₀ : Set H := hT.choose with hw₀ + set b₀ : HilbertBasis w₀ ℂ H := hT.choose_spec.choose with hb₀def + have hb₀ : Summable (fun i : w₀ => (⟪b₀ i, A (b₀ i)⟫_ℂ).re) := hT.choose_spec.choose_spec + have hSstar : ContinuousLinearMap.adjoint S = S := + (ContinuousLinearMap.star_eq_adjoint S).symm.trans hSself + have hpt : ∀ i : w₀, (⟪b₀ i, A (b₀ i)⟫_ℂ).re = ‖S (b₀ i)‖ ^ 2 := by + intro i + have hinner : ⟪b₀ i, A (b₀ i)⟫_ℂ = ⟪S (b₀ i), S (b₀ i)⟫_ℂ := by + rw [← hSS] + show ⟪b₀ i, (S * S) (b₀ i)⟫_ℂ = _ + rw [ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply] + rw [← ContinuousLinearMap.adjoint_inner_left S (S (b₀ i)) (b₀ i), hSstar] + rw [hinner, inner_self_eq_norm_sq_to_K]; norm_cast + have hSum : Summable (fun i : w₀ => ‖S (b₀ i)‖ ^ 2) := hb₀.congr hpt + have htrEq : traceNorm T hT = ∑' i : w₀, ‖S (b₀ i)‖ ^ 2 := tsum_congr hpt + have htrNonneg : 0 ≤ traceNorm T hT := traceNorm_nonneg T hT + have hbound : ∀ x : H, ‖S x‖ ^ 2 ≤ traceNorm T hT * ‖x‖ ^ 2 := by + intro x + have hpar : HasSum (fun i : w₀ => ‖⟪b₀ i, S x⟫_ℂ‖ ^ 2) (‖S x‖ ^ 2) := + hasSum_norm_sq_inner_basis b₀ (S x) + have heq2 : ∀ i : w₀, ⟪b₀ i, S x⟫_ℂ = ⟪S (b₀ i), x⟫_ℂ := fun i => by + have h := ContinuousLinearMap.adjoint_inner_left S x (b₀ i) + rw [hSstar] at h + exact h.symm + have hpar' : HasSum (fun i : w₀ => ‖⟪S (b₀ i), x⟫_ℂ‖ ^ 2) (‖S x‖ ^ 2) := by + simpa [heq2] using hpar + have hCS : ∀ i : w₀, ‖⟪S (b₀ i), x⟫_ℂ‖ ^ 2 ≤ ‖S (b₀ i)‖ ^ 2 * ‖x‖ ^ 2 := fun i => by + have h : ‖⟪S (b₀ i), x⟫_ℂ‖ ≤ ‖S (b₀ i)‖ * ‖x‖ := norm_inner_le_norm _ _ + calc ‖⟪S (b₀ i), x⟫_ℂ‖ ^ 2 ≤ (‖S (b₀ i)‖ * ‖x‖) ^ 2 := + pow_le_pow_left₀ (norm_nonneg _) h 2 + _ = ‖S (b₀ i)‖ ^ 2 * ‖x‖ ^ 2 := by ring + have hdom : HasSum (fun i : w₀ => ‖S (b₀ i)‖ ^ 2 * ‖x‖ ^ 2) (traceNorm T hT * ‖x‖ ^ 2) := by + rw [htrEq]; exact hSum.hasSum.mul_right (‖x‖ ^ 2) + exact hasSum_le hCS hpar' hdom + have hboundNorm : ∀ x : H, ‖S x‖ ≤ Real.sqrt (traceNorm T hT) * ‖x‖ := by + intro x + have h1 : ‖S x‖ ^ 2 ≤ traceNorm T hT * ‖x‖ ^ 2 := hbound x + have h2 : Real.sqrt (‖S x‖ ^ 2) ≤ Real.sqrt (traceNorm T hT * ‖x‖ ^ 2) := + Real.sqrt_le_sqrt h1 + rwa [Real.sqrt_sq (norm_nonneg _), Real.sqrt_mul htrNonneg, + Real.sqrt_sq (norm_nonneg _)] at h2 + have hSnorm_le : ‖S‖ ≤ Real.sqrt (traceNorm T hT) := + S.opNorm_le_bound (Real.sqrt_nonneg _) hboundNorm + have hSsq_le : ‖S‖ ^ 2 ≤ traceNorm T hT := by + have h := pow_le_pow_left₀ (norm_nonneg S) hSnorm_le 2 + rwa [Real.sq_sqrt htrNonneg] at h + rw [hTA, hAeq] + exact hSsq_le + +/-! ## The trace-class submodule and Banach space -/ + +/-- **The trace-class operators, as a `ℂ`-submodule of `H →L[ℂ] H`.** This is the concrete object +underlying the trace-class Banach space: its carrier type inherits `AddCommGroup`/`Module ℂ` +directly from the ambient `Submodule` API, so only the norm structure remains to be supplied. +Direct port of the source's `traceClassSubmodule`. -/ +def traceClassSubmodule (H : Type*) [NormedAddCommGroup H] [InnerProductSpace ℂ H] + [CompleteSpace H] : Submodule ℂ (H →L[ℂ] H) where + carrier := {T | IsTraceClass T} + zero_mem' := isTraceClass_zero + add_mem' ha hb := isTraceClass_add ha hb + smul_mem' c _ ha := isTraceClass_smul c ha + +/-- **The trace-class Banach space `𝒮₁(H)`.** Deliberately a plain (semireducible) `def`, not an +`abbrev`, for the same reason as the source: the carrier of `traceClassSubmodule H` already has a +generic `Submodule`-induced `NormedAddCommGroup` instance coming from the ambient *operator* norm, +and marking `TraceClass H` reducible would let typeclass search find that competing instance +instead of the trace-norm one constructed below. -/ +def TraceClass (H : Type*) [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] : + Type _ := + traceClassSubmodule H + +namespace TraceClass + +noncomputable instance instAddCommGroup : AddCommGroup (TraceClass H) := + inferInstanceAs (AddCommGroup (traceClassSubmodule H)) + +noncomputable instance instModule : Module ℂ (TraceClass H) := + inferInstanceAs (Module ℂ (traceClassSubmodule H)) + +theorem mem_iff {T : H →L[ℂ] H} : T ∈ traceClassSubmodule H ↔ IsTraceClass T := Iff.rfl + +/-- The trace-class witness carried by an element of `TraceClass H`. -/ +theorem isTraceClass_coe (T : TraceClass H) : IsTraceClass T.1 := T.2 + +/-- Build an element of `TraceClass H` from an operator and its trace-class witness. A dedicated +constructor, rather than the anonymous `⟨T, hT⟩`, because `TraceClass H` is deliberately a plain +(semireducible) `def` (see above). -/ +def ofOperator (T : H →L[ℂ] H) (hT : IsTraceClass T) : TraceClass H := ⟨T, hT⟩ + +@[simp] theorem ofOperator_coe (T : H →L[ℂ] H) (hT : IsTraceClass T) : + (ofOperator T hT).1 = T := rfl + +/-- **The trace norm as an `AddGroupNorm`** on the trace-class submodule: nonnegativity, the +triangle inequality (`traceNorm_add_le`), invariance under negation, and the zero-detection +property (via `opNorm_le_traceNorm`). -/ +noncomputable def traceClassAddGroupNorm : AddGroupNorm (TraceClass H) where + toFun T := traceNorm T.1 (isTraceClass_coe T) + map_zero' := traceNorm_zero + neg' T := traceNorm_neg (isTraceClass_coe T) (isTraceClass_coe (-T)) + add_le' T T' := traceNorm_add_le (isTraceClass_coe T) (isTraceClass_coe T') + (isTraceClass_coe (T + T')) + eq_zero_of_map_eq_zero' T hT0 := by + have hop : ‖T.1‖ ≤ traceNorm T.1 (isTraceClass_coe T) := + opNorm_le_traceNorm (isTraceClass_coe T) + rw [hT0] at hop + have : T.1 = 0 := norm_le_zero_iff.mp hop + exact Subtype.ext this + +/-- **The trace-class Banach space's `NormedAddCommGroup` instance**, with norm `traceNorm`. -/ +noncomputable instance instNormedAddCommGroup : NormedAddCommGroup (TraceClass H) := + AddGroupNorm.toNormedAddCommGroup traceClassAddGroupNorm + +theorem norm_eq_traceNorm (T : TraceClass H) : + ‖T‖ = traceNorm T.1 (isTraceClass_coe T) := rfl + +/-- **The trace-class Banach space's `NormedSpace ℂ` instance**: scalar multiplication scales the +trace norm exactly, by `traceNorm_smul`. -/ +noncomputable instance instNormedSpace : NormedSpace ℂ (TraceClass H) where + norm_smul_le c T := by + rw [norm_eq_traceNorm, norm_eq_traceNorm] + have hEq : ((c • T : TraceClass H)).1 = c • T.1 := rfl + have h := traceNorm_transport hEq (isTraceClass_coe (c • T)) + rw [h] + exact le_of_eq (traceNorm_smul c (isTraceClass_coe T)) + +/-- **Lower semicontinuity of the trace norm under operator-norm convergence.** If a sequence of +trace-class operators with uniformly bounded trace norm converges in operator norm, its limit is +trace class with the same bound. This is the single analytic fact needed for completeness: it lets +a trace-norm-Cauchy sequence's operator-norm limit be recognized as trace class, with a +quantitative tail bound. Ported from `unbounded-alpha-public`'s +`TraceClass/Completeness.lean`. -/ +theorem isTraceClass_of_tendsto_of_traceNorm_bounded {Tn : ℕ → H →L[ℂ] H} {T : H →L[ℂ] H} {C : ℝ} + (hTn : ∀ n, IsTraceClass (Tn n)) (hbound : ∀ n, traceNorm (Tn n) (hTn n) ≤ C) + (htendsto : Tendsto Tn atTop (𝓝 T)) : + ∃ hT : IsTraceClass T, traceNorm T hT ≤ C := by + obtain ⟨w, b, _⟩ := exists_hilbertBasis ℂ H + set W : H →L[ℂ] H := Polar.polarFactor T with hWdef + have hWnorm : ‖W‖ ≤ 1 := Polar.polarFactor_opNorm_le T + have hcont : ∀ i : w, Tendsto (fun n => ‖⟪W (b i), Tn n (b i)⟫_ℂ‖) atTop + (𝓝 ‖⟪W (b i), T (b i)⟫_ℂ‖) := by + intro i + have h1 : Tendsto (fun n => Tn n (b i)) atTop (𝓝 (T (b i))) := by + have hev : Continuous (fun X : H →L[ℂ] H => X (b i)) := + (ContinuousLinearMap.apply ℂ H (b i : H)).continuous + exact hev.continuousAt.tendsto.comp htendsto + have h2 : Tendsto (fun n => ⟪W (b i), Tn n (b i)⟫_ℂ) atTop + (𝓝 ⟪W (b i), T (b i)⟫_ℂ) := + ((continuous_const.inner continuous_id).continuousAt.tendsto.comp h1 + |>.congr (fun _ => rfl)).mono_left le_rfl + exact continuous_norm.continuousAt.tendsto.comp h2 + have hFinset : ∀ u : Finset w, (∑ i ∈ u, ‖⟪W (b i), T (b i)⟫_ℂ‖) ≤ C := by + intro u + have hpt : ∀ n, (∑ i ∈ u, ‖⟪W (b i), Tn n (b i)⟫_ℂ‖) ≤ C := by + intro n + have hsum : Summable (fun i : w => ‖⟪W (b i), Tn n (b i)⟫_ℂ‖) := + summable_norm_inner_contraction_of_isTraceClass (hTn n) hWnorm b + have hall : (∑' i : w, ‖⟪W (b i), Tn n (b i)⟫_ℂ‖) ≤ C := + (tsum_norm_inner_contraction_le_traceNorm (hTn n) hWnorm b).trans (hbound n) + exact (hsum.sum_le_tsum u (fun i _ => norm_nonneg _)).trans hall + have hlim : Tendsto (fun n => ∑ i ∈ u, ‖⟪W (b i), Tn n (b i)⟫_ℂ‖) atTop + (𝓝 (∑ i ∈ u, ‖⟪W (b i), T (b i)⟫_ℂ‖)) := + tendsto_finsetSum u (fun i _ => hcont i) + exact le_of_tendsto hlim (Eventually.of_forall hpt) + have hsummable : Summable (fun i : w => ‖⟪W (b i), T (b i)⟫_ℂ‖) := + summable_of_sum_le (fun _ => norm_nonneg _) hFinset + have htsum_le : (∑' i : w, ‖⟪W (b i), T (b i)⟫_ℂ‖) ≤ C := + Real.tsum_le_of_sum_le (fun _ => norm_nonneg _) hFinset + have hpoint : ∀ i : w, (⟪b i, CFC.abs T (b i)⟫_ℂ).re = ‖⟪W (b i), T (b i)⟫_ℂ‖ := by + intro i + have hval : ⟪b i, CFC.abs T (b i)⟫_ℂ = ⟪W (b i), T (b i)⟫_ℂ := by + have habs : CFC.abs T = star W * T := (Polar.star_polarFactor_mul_self T).symm + rw [habs, ContinuousLinearMap.star_eq_adjoint, ContinuousLinearMap.mul_def, + ContinuousLinearMap.comp_apply, + ContinuousLinearMap.adjoint_inner_right W (b i) (T (b i))] + have hpos : (CFC.abs T).IsPositive := (CFC.abs T).nonneg_iff_isPositive.mp (CFC.abs_nonneg T) + have hx := (ContinuousLinearMap.isPositive_iff_complex (CFC.abs T)).mp hpos (b i) + have h1 : ⟪CFC.abs T (b i), b i⟫_ℂ = ((⟪CFC.abs T (b i), b i⟫_ℂ).re : ℂ) := hx.1.symm + have hre : (⟪CFC.abs T (b i), b i⟫_ℂ).re = (⟪b i, CFC.abs T (b i)⟫_ℂ).re := by + rw [← inner_conj_symm (CFC.abs T (b i)) (b i)]; exact Complex.conj_re _ + have heq : ⟪b i, CFC.abs T (b i)⟫_ℂ = ((⟪b i, CFC.abs T (b i)⟫_ℂ).re : ℂ) := by + calc + ⟪b i, CFC.abs T (b i)⟫_ℂ = (starRingEnd ℂ) ⟪CFC.abs T (b i), b i⟫_ℂ := + (inner_conj_symm (b i) (CFC.abs T (b i))).symm + _ = (starRingEnd ℂ) ((⟪CFC.abs T (b i), b i⟫_ℂ).re : ℂ) := congrArg (starRingEnd ℂ) h1 + _ = ((⟪CFC.abs T (b i), b i⟫_ℂ).re : ℂ) := by simp + _ = ((⟪b i, CFC.abs T (b i)⟫_ℂ).re : ℂ) := by rw [hre] + have hnonneg : 0 ≤ (⟪b i, CFC.abs T (b i)⟫_ℂ).re := by rw [← hre]; exact hx.2 + rw [show ‖⟪W (b i), T (b i)⟫_ℂ‖ = ‖⟪b i, CFC.abs T (b i)⟫_ℂ‖ from by rw [hval], + heq, Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg hnonneg, Complex.ofReal_re] + have hT : IsTraceClass T := ⟨w, b, by + apply hsummable.congr + exact fun i => (hpoint i).symm⟩ + refine ⟨hT, ?_⟩ + rw [traceNorm_eq_of_hilbertBasis hT b] + calc + (∑' i : w, (⟪b i, CFC.abs T (b i)⟫_ℂ).re) = ∑' i : w, ‖⟪W (b i), T (b i)⟫_ℂ‖ := + tsum_congr hpoint + _ ≤ C := htsum_le + +/-- **Completeness of the trace-class Banach space.** Given an absolutely convergent series `u` +(`Σ‖uₙ‖₁ < ∞`), its partial sums `Sₙ` are Cauchy in operator norm (since operator norm ≤ trace +norm), hence converge in `H →L[ℂ] H` to some `S`; the lower-semicontinuity lemma above identifies +`S` as trace class (bounded by the full sum `M`), and applied again to the shifted tail sequence +gives the quantitative tail bound `‖⟨S,·⟩ - Sₙ‖₁ ≤ M - Σᵢ₌₀ⁿ⁻¹‖uᵢ‖₁ → 0`, which is exactly +trace-norm convergence of `Sₙ` to `S`. Ported from `unbounded-alpha-public`'s +`TraceClass/Completeness.lean`. -/ +noncomputable instance instCompleteSpace : CompleteSpace (TraceClass H) := by + apply NormedAddCommGroup.completeSpace_of_summable_imp_tendsto + intro u hu + set psum : ℕ → ℝ := fun n => ∑ i ∈ Finset.range n, ‖u i‖ with hpartialdef + set M : ℝ := ∑' n, ‖u n‖ with hMdef + set Sn : ℕ → TraceClass H := fun n => ∑ i ∈ Finset.range n, u i with hSndef + set Tn : ℕ → H →L[ℂ] H := fun n => (Sn n).1 with hTndef + have hpartial_le_M : ∀ n, psum n ≤ M := fun n => hu.sum_le_tsum _ (fun i _ => norm_nonneg _) + have hpartial_tendsto : Tendsto psum atTop (𝓝 M) := hu.hasSum.tendsto_sum_nat + set tail : ℕ → ℝ := fun n => M - psum n with htaildef + have htail_tendsto : Tendsto tail atTop (𝓝 0) := by + have := hpartial_tendsto.const_sub M + simpa [htaildef] using this + have hSn_diff : ∀ n m : ℕ, n ≤ m → Sn m - Sn n = ∑ i ∈ Finset.Ico n m, u i := by + intro n m hnm + simp only [hSndef] + rw [Finset.sum_Ico_eq_sub _ hnm] + have hpsum_split : ∀ n m : ℕ, n ≤ m → + (∑ i ∈ Finset.Ico n m, ‖u i‖) = psum m - psum n := by + intro n m hnm + simp only [hpartialdef] + rw [Finset.sum_Ico_eq_sub _ hnm] + have htrace_tail_bound : ∀ n m : ℕ, n ≤ m → ‖Sn m - Sn n‖ ≤ tail n := by + intro n m hnm + rw [hSn_diff n m hnm] + calc ‖∑ i ∈ Finset.Ico n m, u i‖ ≤ ∑ i ∈ Finset.Ico n m, ‖u i‖ := norm_sum_le _ _ + _ = psum m - psum n := hpsum_split n m hnm + _ ≤ tail n := by simp only [htaildef]; linarith [hpartial_le_M m] + have hSn_diff_coe : ∀ n m : ℕ, ((Sn m - Sn n : TraceClass H)).1 = Tn m - Tn n := + fun n m => Submodule.coe_sub _ _ _ + have htn_cauchy : CauchySeq Tn := by + apply cauchySeq_of_le_tendsto_0' tail _ htail_tendsto + intro n m hnm + rw [dist_eq_norm] + have heqop : Tn n - Tn m = -(Tn m - Tn n) := by abel + rw [heqop, norm_neg, ← hSn_diff_coe n m] + calc ‖((Sn m - Sn n : TraceClass H)).1‖ ≤ ‖(Sn m - Sn n : TraceClass H)‖ := + opNorm_le_traceNorm (isTraceClass_coe (Sn m - Sn n)) + _ ≤ tail n := htrace_tail_bound n m hnm + obtain ⟨S, hStendsto⟩ := cauchySeq_tendsto_of_complete htn_cauchy + have hSn_bound : ∀ n, traceNorm (Sn n).1 (isTraceClass_coe (Sn n)) ≤ M := by + intro n + show ‖Sn n‖ ≤ M + calc ‖Sn n‖ ≤ ∑ i ∈ Finset.range n, ‖u i‖ := by + simp only [hSndef]; exact norm_sum_le _ _ + _ = psum n := rfl + _ ≤ M := hpartial_le_M n + obtain ⟨hS, -⟩ := isTraceClass_of_tendsto_of_traceNorm_bounded + (fun n => isTraceClass_coe (Sn n)) hSn_bound hStendsto + refine ⟨ofOperator S hS, ?_⟩ + apply tendsto_iff_dist_tendsto_zero.mpr + have hbound_S : ∀ n, dist (Sn n) (ofOperator S hS : TraceClass H) ≤ tail n := by + intro n + rw [dist_eq_norm] + have hVtrace : ∀ m, IsTraceClass (Tn (n + m) - Tn n) := by + intro m + rw [← hSn_diff_coe n (n + m)] + exact isTraceClass_coe (Sn (n + m) - Sn n) + have hVbound : ∀ m, traceNorm (Tn (n + m) - Tn n) (hVtrace m) ≤ tail n := by + intro m + have h1 : traceNorm (Tn (n + m) - Tn n) (hVtrace m) = + traceNorm ((Sn (n + m) - Sn n : TraceClass H)).1 + (isTraceClass_coe (Sn (n + m) - Sn n)) := by + have hEq : Tn (n + m) - Tn n = ((Sn (n + m) - Sn n : TraceClass H)).1 := + (hSn_diff_coe n (n + m)).symm + exact traceNorm_transport hEq (hVtrace m) + rw [h1] + show ‖Sn (n + m) - Sn n‖ ≤ tail n + exact htrace_tail_bound n (n + m) (Nat.le_add_right n m) + have hVtendsto : Tendsto (fun m => Tn (n + m) - Tn n) atTop (𝓝 (S - Tn n)) := by + have h1 : Tendsto (fun m => Tn (n + m)) atTop (𝓝 S) := by + have h2 : Tendsto (fun m => Tn (m + n)) atTop (𝓝 S) := + hStendsto.comp (tendsto_add_atTop_nat n) + simpa only [add_comm] using h2 + exact h1.sub tendsto_const_nhds + obtain ⟨hSTn, hSTnbound⟩ := isTraceClass_of_tendsto_of_traceNorm_bounded hVtrace hVbound + hVtendsto + have heqfinal : ((ofOperator S hS : TraceClass H) - Sn n).1 = S - Tn n := rfl + have hnorm_eq : ‖(ofOperator S hS : TraceClass H) - Sn n‖ = traceNorm (S - Tn n) hSTn := by + have h3 : ‖(ofOperator S hS : TraceClass H) - Sn n‖ = + traceNorm ((ofOperator S hS : TraceClass H) - Sn n).1 + (isTraceClass_coe ((ofOperator S hS : TraceClass H) - Sn n)) := rfl + rw [h3] + exact traceNorm_transport heqfinal (isTraceClass_coe ((ofOperator S hS : TraceClass H) - Sn + n)) + rw [norm_sub_rev] + rw [hnorm_eq] + exact hSTnbound + exact squeeze_zero (fun n => dist_nonneg) hbound_S htail_tendsto + +end TraceClass + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/TraceClass/Basic.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/TraceClass/Basic.lean new file mode 100644 index 0000000000..a5c921d064 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/TraceClass/Basic.lean @@ -0,0 +1,776 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Mathlib.Analysis.SpecialFunctions.ContinuousFunctionalCalculus.Abs +public import Mathlib.Analysis.InnerProductSpace.StarOrder +public import Mathlib.Analysis.InnerProductSpace.l2Space +public import Mathlib.Analysis.InnerProductSpace.Trace +public import Mathlib.LinearAlgebra.FiniteDimensional.Defs +public import Mathlib.LinearAlgebra.Dimension.Finite +public import Mathlib.LinearAlgebra.Trace +public import Mathlib.LinearAlgebra.Projection +public import Mathlib.Topology.Algebra.Module.ContinuousLinearMap.Idempotent + +/-! + +# Trace-class operators + +For `T : H →L[ℂ] H` on a complex Hilbert space `H`, `|T| := CFC.abs T = √(T⋆T)` (Mathlib's +continuous functional calculus absolute value). `T` is **trace class** if `∑ᵢ ⟪eᵢ, |T| eᵢ⟫` +converges for some Hilbert basis `{eᵢ}`; the **trace norm** `‖T‖₁` is that sum, and the **trace** +`Tr T := ∑ᵢ ⟪eᵢ, T eᵢ⟫` (which converges whenever the trace norm does, via Cauchy–Schwarz). The +Hilbert basis is quantified over `w : Set H` rather than an arbitrary index type `Type*` (matching +Mathlib's own `exists_hilbertBasis`, which produces exactly such a `w`) — every Hilbert space has +a basis indexed this way, so nothing is lost, and it keeps every index type in `H`'s own universe +rather than introducing a genuinely polymorphic (and, for a bare `Prop`-valued `def`, awkward) +universe parameter. + +## Relationship to `HilbertSpace/Trace.lean` + +`Trace.lean`'s `ContinuousLinearMap.traceₚ` is the ordinary linear-algebra trace +(`LinearMap.trace ℂ H T.toLinearMap`), bundled as a positive linear map: it is defined on *every* +`T : H →L[ℂ] H`, but is only the actual trace when `H` is finite-dimensional (`LinearMap.trace` is +`0` by convention outside that case, via `Module.finrank`-based junk value machinery upstream in +Mathlib — nothing in `traceₚ` needs or uses that convention explicitly). `IsTraceClass`/`trace` +here are the general infinite-dimensional notion: which *bounded* operators have a well-defined +trace via a convergent diagonal sum, before knowing anything about positivity or finite rank. +`trace_eq_sum_inner_hilbertBasis_of_finiteDimensional` below is the connecting fact: in finite +dimension, `LinearMap.trace ℂ H T.toLinearMap` — i.e. `traceₚ T` — agrees with the diagonal sum in +any Hilbert basis, and `HasFiniteMultiplicity.trace_eq_finrank_range_of_finiteDimensional` uses +this explicitly to reduce the finite-dimensional case of the new `trace` to the old one. No general +(infinite-dimensional) theorem "`traceₚ` agrees with `trace` whenever both are defined" is proved +here: `traceₚ` has no trace-class hypothesis to begin with (it is total, using `LinearMap.trace`'s +own junk-value convention outside finite dimension), so such a theorem would need to first isolate +exactly when the *linear-algebra* trace of an infinite-dimensional operator happens to coincide +with its analytic trace-class trace — genuine, unattempted work, not forced here. + +Genuinely well-defined trace-class theory needs one famous, hard fact: + +> the value of `∑ᵢ ⟪eᵢ, |T| eᵢ⟫` (hence trace-class-ness itself, and the value of the trace) does +> not depend on the choice of Hilbert basis `{eᵢ}`. + +The positive/self-adjoint part is proved below (`summable_inner_abs_of_hilbertBasis`) directly +from Mathlib's `HilbertBasis` API — **not** via the unbounded spectral theorem. The route is the +standard Hilbert–Schmidt double-sum/Fubini argument: for a self-adjoint `S`, write +`⟪eᵢ, S eᵢ⟫ = ‖√S eᵢ‖²` (continuous functional calculus square root), expand `‖√S eᵢ‖²` via +Parseval against a *second* basis `{fⱼ}`, and swap the resulting (unconditionally +Fubini-swappable, since all terms are nonnegative and the outer sum is controlled by the +trace-class hypothesis) double sum `∑ᵢ∑ⱼ = ∑ⱼ∑ᵢ`. `|T| = CFC.abs T` is always self-adjoint, so +this handles `summable_inner_abs_of_hilbertBasis` in full generality. For `trace_eq_of_hilbertBasis` +the positive case is now proved by the same square-root/Parseval argument +(`trace_eq_of_hilbertBasis_of_nonneg`), and the self-adjoint case is obtained by decomposing into +positive and negative parts (`trace_eq_of_hilbertBasis_of_isSelfAdjoint`). The general +non-self-adjoint case would go through +the polar decomposition `T = U|T|` instead, and packaging the trace-class operators themselves as +a Banach space `TraceClass H` is separate, genuinely harder work; neither is attempted here. + +## Definitions + +- `IsTraceClass` : `T` is trace class. +- `traceNorm`/`trace` : witness-basis definitions of the trace norm and trace. +- `HasFiniteMultiplicity` : a projection is trace class — the honest Murray–von Neumann finiteness + condition for "isolated eigenvalue of finite multiplicity", which a purely topological account of + discrete spectrum cannot express. + +-/ + +@[expose] public section + +noncomputable section + +open scoped ComplexOrder InnerProductSpace + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-! ## Trace class -/ + +/-- **`T` is trace class**: `∑ᵢ ⟪eᵢ, |T| eᵢ⟫` converges for some Hilbert basis `{eᵢ}` of `H` +(`|T| := CFC.abs T`, Mathlib's continuous functional calculus absolute value `√(T⋆T)`). By the +basis-independence theorem below, "some" is equivalent to "every". -/ +def IsTraceClass (T : H →L[ℂ] H) : Prop := + ∃ (w : Set H) (b : HilbertBasis w ℂ H), Summable (fun i => (⟪b i, CFC.abs T (b i)⟫_ℂ).re) + +/-! ### Basis-independence machinery + +The two lemmas below are the honest analytic content: they need only completeness of `H`, the +continuous functional calculus square root, and Mathlib's `HilbertBasis` Parseval API +(`HilbertBasis.hasSum_inner_mul_inner`). No spectral theorem is used. -/ + +omit [CompleteSpace H] in +/-- **Parseval's identity**, in the form needed below: for a Hilbert basis `{eᵢ}` and any vector +`y`, `∑ᵢ |⟪eᵢ, y⟫|² = ‖y‖²`, unconditionally (`HasSum`, not merely `tsum`). Not `private`: reused +verbatim by `HilbertSpace/TraceClass/Banach.lean`'s Hilbert–Schmidt-domination argument for +`opNorm_le_traceNorm`. -/ +@[nolint unusedArguments] +theorem hasSum_norm_sq_inner_basis {w : Set H} (b : HilbertBasis w ℂ H) (y : H) : + HasSum (fun i : w => ‖⟪b i, y⟫_ℂ‖ ^ 2) (‖y‖ ^ 2) := by + have h := b.hasSum_inner_mul_inner y y + have hpt : ∀ i : w, ⟪y, b i⟫_ℂ * ⟪b i, y⟫_ℂ = ((‖⟪b i, y⟫_ℂ‖ ^ 2 : ℝ) : ℂ) := fun i => by + rw [← inner_conj_symm y (b i), RCLike.conj_mul] + norm_cast + have hval : ⟪y, y⟫_ℂ = ((‖y‖ ^ 2 : ℝ) : ℂ) := by + rw [inner_self_eq_norm_sq_to_K]; norm_cast + simp_rw [hpt] at h + rw [hval] at h + exact Complex.hasSum_ofReal.mp h + +/-- **Basis-independence of `∑ᵢ ‖S eᵢ‖²` for self-adjoint `S`.** This is the Hilbert–Schmidt +double-sum argument: expand `‖S bᵢ‖²` via Parseval against the *second* basis `c`, swap the +(nonnegative, hence unconditionally Fubini-swappable once the outer sum is known finite via `hb`) +double sum, and collapse the inner sum back via Parseval against `b`, using `S` self-adjoint to +turn the adjoint that appears back into `S` itself. -/ +private lemma hasSum_norm_sq_apply_of_selfAdjoint {S : H →L[ℂ] H} (hS : IsSelfAdjoint S) + {w w' : Set H} (b : HilbertBasis w ℂ H) (c : HilbertBasis w' ℂ H) + (hb : Summable (fun i : w => ‖S (b i)‖ ^ 2)) : + HasSum (fun j : w' => ‖S (c j)‖ ^ 2) (∑' i : w, ‖S (b i)‖ ^ 2) := by + classical + set F : w → w' → ℝ := fun i j => ‖⟪c j, S (b i)⟫_ℂ‖ ^ 2 with hFdef + have hFnonneg : 0 ≤ Function.uncurry F := fun _ => sq_nonneg _ + have hrow : ∀ i : w, HasSum (F i) (‖S (b i)‖ ^ 2) := fun i => + hasSum_norm_sq_inner_basis c (S (b i)) + have hSstar : ContinuousLinearMap.adjoint S = S := (ContinuousLinearMap.star_eq_adjoint + S).symm.trans hS + have hcol : ∀ j : w', HasSum (fun i : w => F i j) (‖S (c j)‖ ^ 2) := by + intro j + have e1 : ∀ i : w, ⟪c j, S (b i)⟫_ℂ = ⟪S (c j), b i⟫_ℂ := fun i => by + have h1 := ContinuousLinearMap.adjoint_inner_left S (b i) (c j) + rw [hSstar] at h1 + exact h1.symm + have key : (fun i : w => F i j) = fun i : w => ‖⟪b i, S (c j)⟫_ℂ‖ ^ 2 := by + funext i + show ‖⟪c j, S (b i)⟫_ℂ‖ ^ 2 = _ + rw [e1 i, ← inner_conj_symm (b i) (S (c j)), RCLike.norm_conj] + rw [key] + exact hasSum_norm_sq_inner_basis b (S (c j)) + set G : w' → w → ℝ := fun j i => F i j with hGdef + have hjoint : Summable (Function.uncurry F) := by + rw [summable_prod_of_nonneg hFnonneg] + refine ⟨fun i => (hrow i).summable, ?_⟩ + have heq : (fun i : w => ∑' j : w', F i j) = fun i : w => ‖S (b i)‖ ^ 2 := + funext fun i => (hrow i).tsum_eq + show Summable fun i : w => ∑' j : w', F i j + rwa [heq] + have hswap := hjoint.tsum_comm' (fun i => (hrow i).summable) (fun j => (hcol j).summable) + have hLHS : ∑' j : w', ∑' i : w, F i j = ∑' j : w', ‖S (c j)‖ ^ 2 := + tsum_congr fun j => (hcol j).tsum_eq + have hRHS : ∑' i : w, ∑' j : w', F i j = ∑' i : w, ‖S (b i)‖ ^ 2 := + tsum_congr fun i => (hrow i).tsum_eq + have hEq : ∑' j : w', ‖S (c j)‖ ^ 2 = ∑' i : w, ‖S (b i)‖ ^ 2 := by + rw [← hLHS, ← hRHS]; exact hswap + have hGnonneg : 0 ≤ Function.uncurry G := fun _ => sq_nonneg _ + have hjointG : Summable (Function.uncurry G) := by + have hcomp : Function.uncurry G = Function.uncurry F ∘ (Equiv.prodComm w' w) := by + funext p + simp [Function.uncurry, hGdef, Equiv.prodComm] + rw [hcomp] + exact (Equiv.prodComm w' w).summable_iff.mpr hjoint + have hcolSummable : Summable (fun j : w' => ‖S (c j)‖ ^ 2) := by + have hpair := (summable_prod_of_nonneg hGnonneg).mp hjointG + have h2 : Summable fun j : w' => ∑' i : w, G j i := by + show Summable fun j : w' => ∑' i : w, Function.uncurry G (j, i) + exact hpair.2 + have heq2 : (fun j : w' => ∑' i : w, G j i) = fun j : w' => ‖S (c j)‖ ^ 2 := + funext fun j => (hcol j).tsum_eq + rwa [heq2] at h2 + rw [← hEq] + exact hcolSummable.hasSum + +/-- **Basis independence of trace-class-ness and the trace norm.** `|T| = CFC.abs T` is always +self-adjoint (`abs_nonneg` + `IsSelfAdjoint.of_nonneg`), so writing +`⟪eᵢ, |T| eᵢ⟫ = ‖√|T| eᵢ‖²` (`CFC.sqrt`, self-adjoint) reduces this directly to +`hasSum_norm_sq_apply_of_selfAdjoint`. -/ +theorem summable_inner_abs_of_hilbertBasis {T : H →L[ℂ] H} (h : IsTraceClass T) {w : Set H} + (b : HilbertBasis w ℂ H) : + Summable (fun i => (⟪b i, CFC.abs T (b i)⟫_ℂ).re) := by + obtain ⟨w₀, b₀, hb₀⟩ := h + set A : H →L[ℂ] H := CFC.abs T with hAdef + have hAnonneg : 0 ≤ A := CFC.abs_nonneg T + have hAself : IsSelfAdjoint A := .of_nonneg hAnonneg + set S : H →L[ℂ] H := CFC.sqrt A with hSdef + have hSself : IsSelfAdjoint S := .of_nonneg (CFC.sqrt_nonneg A) + have hpt : ∀ {w' : Set H} (b' : HilbertBasis w' ℂ H) (i : w'), + (⟪b' i, A (b' i)⟫_ℂ).re = ‖S (b' i)‖ ^ 2 := by + intro w' b' i + have hSS : S * S = A := CFC.sqrt_mul_sqrt_self A hAnonneg + have : ⟪b' i, A (b' i)⟫_ℂ = ⟪S (b' i), S (b' i)⟫_ℂ := by + have hSstar : ContinuousLinearMap.adjoint S = S := (ContinuousLinearMap.star_eq_adjoint + S).symm.trans hSself + rw [← hSS] + show ⟪b' i, (S * S) (b' i)⟫_ℂ = _ + rw [ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply] + rw [← ContinuousLinearMap.adjoint_inner_left S (S (b' i)) (b' i), hSstar] + have hval : ⟪S (b' i), S (b' i)⟫_ℂ = ((‖S (b' i)‖ ^ 2 : ℝ) : ℂ) := by + rw [inner_self_eq_norm_sq_to_K]; norm_cast + rw [this, hval, Complex.ofReal_re] + have hb₀' : Summable (fun i : w₀ => ‖S (b₀ i)‖ ^ 2) := by + simpa [hpt b₀] using hb₀ + have := hasSum_norm_sq_apply_of_selfAdjoint hSself b₀ b hb₀' + simpa [hpt b] using this.summable + +/-- The existential definition of trace class is equivalent to summability in every Hilbert +basis. The forward implication is the basis-independence theorem above; the reverse implication +only needs one basis, whose existence is available for every complete Hilbert space. This is the +form that downstream constructions should normally consume, since it avoids carrying the +particular witness selected by `IsTraceClass`. -/ +theorem isTraceClass_iff {T : H →L[ℂ] H} : + IsTraceClass T ↔ + ∀ (w : Set H) (b : HilbertBasis w ℂ H), + Summable (fun i => (⟪b i, CFC.abs T (b i)⟫_ℂ).re) := by + constructor + · intro h w b + exact summable_inner_abs_of_hilbertBasis h b + · intro h + obtain ⟨w, b, _⟩ := exists_hilbertBasis ℂ H + exact ⟨w, b, h w b⟩ + +/-- Every bounded operator on a finite-dimensional Hilbert space is trace class. The proof is +deliberately basis-level: a Hilbert basis exists, its carrier is finite by finite-dimensionality, +and the defining nonnegative series therefore has finite support. This is the concrete + finite-dimensional realization used by the corresponding `WStarAlgebra` instance. -/ +theorem isTraceClass_of_finiteDimensional [FiniteDimensional ℂ H] (T : H →L[ℂ] H) : + IsTraceClass T := by + obtain ⟨w, b, _⟩ := exists_hilbertBasis ℂ H + let : Finite w := b.orthonormal.linearIndependent.finite + let : Fintype w := Fintype.ofFinite w + refine ⟨w, b, ?_⟩ + apply summable_of_hasFiniteSupport + exact Set.finite_univ.subset (by intro i hi; trivial) + +omit [CompleteSpace H] in +/-- The ordinary finite-dimensional trace is the diagonal sum in any Hilbert basis. -/ +@[nolint unusedArguments] +theorem trace_eq_sum_inner_hilbertBasis_of_finiteDimensional + [FiniteDimensional ℂ H] (T : H →L[ℂ] H) {w : Set H} (b : HilbertBasis w ℂ H) : + LinearMap.trace ℂ H T.toLinearMap = ∑' i : w, ⟪b i, T (b i)⟫_ℂ := by + let : Finite w := b.orthonormal.linearIndependent.finite + let : Fintype w := Fintype.ofFinite w + rw [tsum_fintype] + simpa only [HilbertBasis.coe_toOrthonormalBasis, ContinuousLinearMap.coe_coe] using + LinearMap.trace_eq_sum_inner T.toLinearMap b.toOrthonormalBasis + +/-- The trace norm `‖T‖₁ := ∑ᵢ ⟪eᵢ, |T| eᵢ⟫`, computed via a chosen witness Hilbert basis (any +basis gives the same value, by `summable_inner_abs_of_hilbertBasis` — this definition just needs +*a* witness to compute with). -/ +def traceNorm (T : H →L[ℂ] H) (h : IsTraceClass T) : ℝ := + ∑' i : h.choose, (⟪h.choose_spec.choose i, CFC.abs T (h.choose_spec.choose i)⟫_ℂ).re + +/-- The witness proof argument of `traceNorm` is immaterial. This small lemma is useful when +transporting a trace-class operator through a construction that produces a new proof of the same +proposition. -/ +theorem traceNorm_congr {T : H →L[ℂ] H} {h₁ h₂ : IsTraceClass T} : + traceNorm T h₁ = traceNorm T h₂ := by + have hh : h₁ = h₂ := Subsingleton.elim _ _ + rw [hh] + +/-- **The trace**, `Tr T := ∑ᵢ ⟪eᵢ, T eᵢ⟫`, for a trace-class `T`, computed via the same witness +basis as `traceNorm`. `tsum` is total (it evaluates to `0` on a non-summable family), so this +definition needs no convergence proof up front; the honest mathematical content — that the family +`i ↦ ⟪eᵢ, T eᵢ⟫` is *actually* summable for trace-class `T` (a standard Cauchy–Schwarz consequence +of `IsTraceClass`, via the sharp bound `∑ᵢ |⟪eᵢ, T eᵢ⟫| ≤ ∑ᵢ ⟪eᵢ, |T| eᵢ⟫` from the polar +decomposition `T = U|T|`), together with basis-independence, is left to the later trace-class +Banach space phase; the self-adjoint case is handled directly below without polar decomposition. -/ +def trace (T : H →L[ℂ] H) (h : IsTraceClass T) : ℂ := + ∑' i : h.choose, ⟪h.choose_spec.choose i, T (h.choose_spec.choose i)⟫_ℂ + +/-- The witness proof argument of `trace` is immaterial (by `Prop`'s proof irrelevance, the two +`IsTraceClass` proofs are already definitionally equal; this lemma packages that fact for `rw`). +Extension of this file added for `WStarAlgebra/HilbertSpaceInstance.lean`'s rank-one trace +computations, mirroring `traceNorm_congr` above. -/ +theorem trace_congr {T : H →L[ℂ] H} {h₁ h₂ : IsTraceClass T} : + trace T h₁ = trace T h₂ := by + have hh : h₁ = h₂ := Subsingleton.elim _ _ + rw [hh] + +/-- The trace norm is independent of the witness basis used in `IsTraceClass`. This is the +strong form of `summable_inner_abs_of_hilbertBasis`: the square-root/Parseval argument identifies +the actual sums, not merely their convergence. -/ +theorem traceNorm_eq_of_hilbertBasis {T : H →L[ℂ] H} (h : IsTraceClass T) {w : Set H} + (b : HilbertBasis w ℂ H) : + traceNorm T h = ∑' i, (⟪b i, CFC.abs T (b i)⟫_ℂ).re := by + let w₀ : Set H := h.choose + let b₀ : HilbertBasis w₀ ℂ H := h.choose_spec.choose + have hb₀ : Summable (fun i : w₀ => (⟪b₀ i, CFC.abs T (b₀ i)⟫_ℂ).re) := + h.choose_spec.choose_spec + set A : H →L[ℂ] H := CFC.abs T with hAdef + have hAnonneg : 0 ≤ A := CFC.abs_nonneg T + have hAself : IsSelfAdjoint A := .of_nonneg hAnonneg + set S : H →L[ℂ] H := CFC.sqrt A with hSdef + have hSself : IsSelfAdjoint S := .of_nonneg (CFC.sqrt_nonneg A) + have hpt : ∀ {w' : Set H} (b' : HilbertBasis w' ℂ H) (i : w'), + (⟪b' i, A (b' i)⟫_ℂ).re = ‖S (b' i)‖ ^ 2 := by + intro w' b' i + have hSS : S * S = A := CFC.sqrt_mul_sqrt_self A hAnonneg + have hinner : ⟪b' i, A (b' i)⟫_ℂ = ⟪S (b' i), S (b' i)⟫_ℂ := by + have hSstar : ContinuousLinearMap.adjoint S = S := + (ContinuousLinearMap.star_eq_adjoint S).symm.trans hSself + rw [← hSS] + show ⟪b' i, (S * S) (b' i)⟫_ℂ = _ + rw [ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply] + rw [← ContinuousLinearMap.adjoint_inner_left S (S (b' i)) (b' i), hSstar] + rw [hinner, inner_self_eq_norm_sq_to_K] + norm_cast + have hb₀' : Summable (fun i : w₀ => ‖S (b₀ i)‖ ^ 2) := by + apply hb₀.congr + intro i + rw [hAdef, hpt] + have hnorm := hasSum_norm_sq_apply_of_selfAdjoint hSself b₀ b hb₀' + calc + traceNorm T h = ∑' i : w₀, (⟪b₀ i, A (b₀ i)⟫_ℂ).re := by + rfl + _ = ∑' i : w₀, ‖S (b₀ i)‖ ^ 2 := by + apply tsum_congr + intro i + exact hpt b₀ i + _ = ∑' i : w, ‖S (b i)‖ ^ 2 := hnorm.tsum_eq.symm + _ = ∑' i : w, (⟪b i, A (b i)⟫_ℂ).re := by + apply tsum_congr + intro i + exact (hpt b i).symm + _ = ∑' i, (⟪b i, CFC.abs T (b i)⟫_ℂ).re := by + rfl + +omit [CompleteSpace H] in +private lemma real_inner_nonneg_of_nonneg {T : H →L[ℂ] H} (hT : 0 ≤ T) (x : H) : + 0 ≤ (⟪x, T x⟫_ℂ).re := by + have hpos : T.IsPositive := T.nonneg_iff_isPositive.mp hT + have hx := (ContinuousLinearMap.isPositive_iff_complex T).mp hpos x + have heq : (⟪T x, x⟫_ℂ).re = (⟪x, T x⟫_ℂ).re := by + rw [← inner_conj_symm (T x) x] + exact Complex.conj_re _ + rw [← heq] + exact hx.2 + +/-- The trace norm is nonnegative. This is exposed separately from its basis-independence result +so norm estimates can use it without unpacking the chosen Hilbert-basis witness. -/ +theorem traceNorm_nonneg (T : H →L[ℂ] H) (h : IsTraceClass T) : 0 ≤ traceNorm T h := by + unfold traceNorm + exact tsum_nonneg fun i => real_inner_nonneg_of_nonneg (CFC.abs_nonneg T) + (h.choose_spec.choose i) + +private lemma real_inner_mono_of_le {P Q : H →L[ℂ] H} (hPQ : P ≤ Q) (x : H) : + (⟪x, P x⟫_ℂ).re ≤ (⟪x, Q x⟫_ℂ).re := by + have hdiff : 0 ≤ Q - P := sub_nonneg.mpr hPQ + have hpos : (Q - P).IsPositive := (Q - P).nonneg_iff_isPositive.mp hdiff + have hx := (ContinuousLinearMap.isPositive_iff_complex (Q - P)).mp hpos x + have heq : (⟪(Q - P) x, x⟫_ℂ).re = (⟪x, (Q - P) x⟫_ℂ).re := by + rw [← inner_conj_symm ((Q - P) x) x] + exact Complex.conj_re _ + have hx' : 0 ≤ (⟪x, (Q - P) x⟫_ℂ).re := by + rw [← heq] + exact hx.2 + simpa [sub_apply, inner_sub_right, map_sub] using hx' + +private lemma isTraceClass_posPart_of_isSelfAdjoint {T : H →L[ℂ] H} (hT : IsSelfAdjoint T) + (h : IsTraceClass T) : IsTraceClass T⁺ := by + obtain ⟨w, b, hb⟩ := h + refine ⟨w, b, ?_⟩ + rw [CFC.abs_of_nonneg T⁺ (CFC.posPart_nonneg T)] + apply Summable.of_nonneg_of_le + · intro i + exact real_inner_nonneg_of_nonneg (CFC.posPart_nonneg T) (b i) + · intro i + have habs : T⁺ + T⁻ = CFC.abs T := CFC.posPart_add_negPart T hT + have hle : T⁺ ≤ CFC.abs T := by + rw [← habs] + exact le_add_of_nonneg_right (CFC.negPart_nonneg T) + exact real_inner_mono_of_le hle (b i) + · exact hb + +private lemma isTraceClass_negPart_of_isSelfAdjoint {T : H →L[ℂ] H} (hT : IsSelfAdjoint T) + (h : IsTraceClass T) : IsTraceClass T⁻ := by + obtain ⟨w, b, hb⟩ := h + refine ⟨w, b, ?_⟩ + rw [CFC.abs_of_nonneg T⁻ (CFC.negPart_nonneg T)] + apply Summable.of_nonneg_of_le + · intro i + exact real_inner_nonneg_of_nonneg (CFC.negPart_nonneg T) (b i) + · intro i + have habs : T⁺ + T⁻ = CFC.abs T := CFC.posPart_add_negPart T hT + have hle : T⁻ ≤ CFC.abs T := by + rw [← habs] + exact le_add_of_nonneg_left (CFC.posPart_nonneg T) + exact real_inner_mono_of_le hle (b i) + · exact hb + +private lemma summable_inner_of_nonneg {T : H →L[ℂ] H} (hT : 0 ≤ T) (h : IsTraceClass T) + {w : Set H} (b : HilbertBasis w ℂ H) : + Summable (fun i => ⟪b i, T (b i)⟫_ℂ) := by + have hr : Summable (fun i : w => (⟪b i, CFC.abs T (b i)⟫_ℂ).re) := + summable_inner_abs_of_hilbertBasis h b + have habs : CFC.abs T = T := CFC.abs_of_nonneg T hT + have heq (i : w) : ⟪b i, T (b i)⟫_ℂ = + ((⟪b i, CFC.abs T (b i)⟫_ℂ).re : ℂ) := by + rw [habs] + have hpos : T.IsPositive := T.nonneg_iff_isPositive.mp hT + have hx := (ContinuousLinearMap.isPositive_iff_complex T).mp hpos (b i) + have hA : ⟪T (b i), b i⟫_ℂ = ((⟪T (b i), b i⟫_ℂ).re : ℂ) := hx.1.symm + have hre : (⟪T (b i), b i⟫_ℂ).re = (⟪b i, T (b i)⟫_ℂ).re := by + rw [← inner_conj_symm (T (b i)) (b i)] + exact Complex.conj_re _ + have hinner : ⟪b i, T (b i)⟫_ℂ = ((⟪T (b i), b i⟫_ℂ).re : ℂ) := by + calc + ⟪b i, T (b i)⟫_ℂ = (starRingEnd ℂ) ⟪T (b i), b i⟫_ℂ := + (inner_conj_symm (b i) (T (b i))).symm + _ = (starRingEnd ℂ) ((⟪T (b i), b i⟫_ℂ).re : ℂ) := + congrArg (starRingEnd ℂ) hA + _ = ((⟪T (b i), b i⟫_ℂ).re : ℂ) := by simp + exact hinner.trans (congrArg (fun r : ℝ => (r : ℂ)) hre) + have hs : Summable (fun i : w => ((⟪b i, CFC.abs T (b i)⟫_ℂ).re : ℂ)) := + Complex.summable_ofReal.mpr hr + exact hs.congr (fun i => (heq i).symm) + +/-! +Basis-independent trace for positive trace-class operators. + +For a positive operator the absolute value is the operator itself. Taking its continuous- +functional-calculus square root turns every diagonal coefficient into a squared norm, so the +Parseval double-sum theorem already proved above gives the same sum in every Hilbert basis. This +is the positive case needed by density operators and does not use polar decomposition. +-/ +theorem trace_eq_of_hilbertBasis_of_nonneg {T : H →L[ℂ] H} (hT : 0 ≤ T) + (h : IsTraceClass T) {w : Set H} (b : HilbertBasis w ℂ H) : + trace T h = ∑' i, ⟪b i, T (b i)⟫_ℂ := by + let S : H →L[ℂ] H := CFC.sqrt T + have hSself : IsSelfAdjoint S := .of_nonneg (CFC.sqrt_nonneg T) + have hSS : S * S = T := CFC.sqrt_mul_sqrt_self T hT + have hdiag : ∀ {w' : Set H} (b' : HilbertBasis w' ℂ H) (i : w'), + ⟪b' i, T (b' i)⟫_ℂ = ((‖S (b' i)‖ ^ 2 : ℝ) : ℂ) := by + intro w' b' i + have hSstar : ContinuousLinearMap.adjoint S = S := + (ContinuousLinearMap.star_eq_adjoint S).symm.trans hSself + have hinner : ⟪b' i, T (b' i)⟫_ℂ = ⟪S (b' i), S (b' i)⟫_ℂ := by + rw [← hSS] + show ⟪b' i, (S * S) (b' i)⟫_ℂ = _ + rw [ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply] + rw [← ContinuousLinearMap.adjoint_inner_left S (S (b' i)) (b' i), hSstar] + rw [hinner, inner_self_eq_norm_sq_to_K] + norm_cast + let w₀ : Set H := h.choose + let b₀ : HilbertBasis w₀ ℂ H := h.choose_spec.choose + have hWdiag : Summable (fun i : w₀ => ‖S (b₀ i)‖ ^ 2) := by + have hbase : Summable (fun i : w₀ => + (⟪b₀ i, CFC.abs T (b₀ i)⟫_ℂ).re) := h.choose_spec.choose_spec + have habs : CFC.abs T = T := CFC.abs_of_nonneg T hT + apply hbase.congr + intro i + rw [habs, hdiag b₀ i] + rfl + have hnorm := hasSum_norm_sq_apply_of_selfAdjoint hSself b₀ b hWdiag + calc + trace T h = ∑' i : w₀, ⟪b₀ i, T (b₀ i)⟫_ℂ := by + rfl + _ = ∑' i : w₀, ((‖S (b₀ i)‖ ^ 2 : ℝ) : ℂ) := by + apply tsum_congr + intro i + exact hdiag b₀ i + _ = ((∑' i : w₀, ‖S (b₀ i)‖ ^ 2 : ℝ) : ℂ) := + (Complex.ofReal_tsum (fun i : w₀ => ‖S (b₀ i)‖ ^ 2)).symm + _ = ((∑' i : w, ‖S (b i)‖ ^ 2 : ℝ) : ℂ) := by + rw [hnorm.tsum_eq] + _ = ∑' i : w, ⟪b i, T (b i)⟫_ℂ := by + rw [Complex.ofReal_tsum] + apply tsum_congr + intro i + exact (hdiag b i).symm + +/-- Basis-independent trace for self-adjoint trace-class operators. The proof reduces to the +positive theorem through the continuous-functional-calculus decomposition `T = T⁺ - T⁻`; no +polar decomposition is needed for this self-adjoint case. -/ +theorem trace_eq_of_hilbertBasis_of_isSelfAdjoint {T : H →L[ℂ] H} (hT : IsSelfAdjoint T) + (h : IsTraceClass T) {w : Set H} (b : HilbertBasis w ℂ H) : + trace T h = ∑' i, ⟪b i, T (b i)⟫_ℂ := by + let P : H →L[ℂ] H := T⁺ + let N : H →L[ℂ] H := T⁻ + have hP : IsTraceClass P := isTraceClass_posPart_of_isSelfAdjoint hT h + have hN : IsTraceClass N := isTraceClass_negPart_of_isSelfAdjoint hT h + have hPnonneg : 0 ≤ P := CFC.posPart_nonneg T + have hNnonneg : 0 ≤ N := CFC.negPart_nonneg T + have hdecomp : P - N = T := CFC.posPart_sub_negPart T hT + have hPsum : Summable (fun i : w => ⟪b i, P (b i)⟫_ℂ) := + summable_inner_of_nonneg hPnonneg hP b + have hNsum : Summable (fun i : w => ⟪b i, N (b i)⟫_ℂ) := + summable_inner_of_nonneg hNnonneg hN b + let w₀ : Set H := h.choose + let b₀ : HilbertBasis w₀ ℂ H := h.choose_spec.choose + have hPsum₀ : Summable (fun i : w₀ => ⟪b₀ i, P (b₀ i)⟫_ℂ) := + summable_inner_of_nonneg hPnonneg hP b₀ + have hNsum₀ : Summable (fun i : w₀ => ⟪b₀ i, N (b₀ i)⟫_ℂ) := + summable_inner_of_nonneg hNnonneg hN b₀ + have htrace_sub : trace T h = trace P hP - trace N hN := by + calc + trace T h = ∑' i : w₀, ⟪b₀ i, T (b₀ i)⟫_ℂ := by rfl + _ = ∑' i : w₀, (⟪b₀ i, P (b₀ i)⟫_ℂ - ⟪b₀ i, N (b₀ i)⟫_ℂ) := by + apply tsum_congr + intro i + rw [← hdecomp] + simp [sub_apply, inner_sub_right] + _ = (∑' i : w₀, ⟪b₀ i, P (b₀ i)⟫_ℂ) - + (∑' i : w₀, ⟪b₀ i, N (b₀ i)⟫_ℂ) := hPsum₀.tsum_sub hNsum₀ + _ = trace P hP - trace N hN := by + rw [trace_eq_of_hilbertBasis_of_nonneg hPnonneg hP b₀, + trace_eq_of_hilbertBasis_of_nonneg hNnonneg hN b₀] + calc + trace T h = trace P hP - trace N hN := htrace_sub + _ = (∑' i : w, ⟪b i, P (b i)⟫_ℂ) - + (∑' i : w, ⟪b i, N (b i)⟫_ℂ) := by + rw [trace_eq_of_hilbertBasis_of_nonneg hPnonneg hP b, + trace_eq_of_hilbertBasis_of_nonneg hNnonneg hN b] + _ = ∑' i : w, (⟪b i, P (b i)⟫_ℂ - ⟪b i, N (b i)⟫_ℂ) := + (hPsum.tsum_sub hNsum).symm + _ = ∑' i : w, ⟪b i, T (b i)⟫_ℂ := by + apply tsum_congr + intro i + rw [← hdecomp] + simp [sub_apply, inner_sub_right] + +/-! ## Honest finite multiplicity -/ + +/-- **The honest Murray–von Neumann finiteness condition**: a self-adjoint projection +`p : H →L[ℂ] H` has finite multiplicity iff it is trace class (equivalently, since a projection's +eigenvalues are `0`/`1`, iff its range is finite-dimensional). -/ +def HasFiniteMultiplicity (p : H →L[ℂ] H) : Prop := IsStarProjection p ∧ IsTraceClass p + +/-- A trace-class star projection has finite-dimensional range. The proof uses the Hilbert basis +of the range and extends it to a Hilbert basis of `H`: on every range basis vector the projection +has diagonal coefficient `1`, so summability of the trace-class diagonal forces the range basis to +have a finite index type. -/ +theorem HasFiniteMultiplicity.finiteDimensional_range {p : H →L[ℂ] H} + (hp : HasFiniteMultiplicity p) : + FiniteDimensional ℂ (LinearMap.range p.toLinearMap) := by + let W : Submodule ℂ H := LinearMap.range p.toLinearMap + have hpIdem : IsIdempotentElem p.toLinearMap := + (ContinuousLinearMap.isIdempotentElem_toLinearMap_iff).2 hp.1.isIdempotentElem + let : CompleteSpace W := by + change CompleteSpace p.range + exact (ContinuousLinearMap.IsIdempotentElem.isClosed_range + hp.1.isIdempotentElem).completeSpace_coe + obtain ⟨w, b, _⟩ := exists_hilbertBasis ℂ W + have hbOrtho : Orthonormal ℂ (fun i : w => (b i : H)) := by + exact b.orthonormal.comp_linearIsometry W.subtypeₗᵢ + have hbInjective : Function.Injective (fun i : w => (b i : H)) := + hbOrtho.linearIndependent.injective + let s : Set H := Set.range (fun i : w => (b i : H)) + have hsOrtho : Orthonormal ℂ ((↑) : s → H) := hbOrtho.toSubtypeRange + obtain ⟨wH, bH, hsH, hbH⟩ := hsOrtho.exists_hilbertBasis_extension + have hdiag : Summable (fun i : wH => + (⟪bH i, CFC.abs p (bH i)⟫_ℂ).re) := + summable_inner_abs_of_hilbertBasis hp.2 bH + have habs : CFC.abs p = p := CFC.abs_of_nonneg p hp.1.nonneg + let g : w → wH := fun i => + ⟨(b i : H), hsH (show (b i : H) ∈ s from ⟨i, rfl⟩)⟩ + have hgInjective : Function.Injective g := by + intro i j hij + apply Subtype.ext + exact congrArg (fun k : w => (k : W)) + (hbInjective (congrArg (fun z : wH => (z : H)) hij)) + have hconst : Summable (fun _ : w => (1 : ℝ)) := by + have hcomp := hdiag.comp_injective hgInjective + apply hcomp.congr + intro i + change (⟪bH (g i), CFC.abs p (bH (g i))⟫_ℂ).re = 1 + have hbi : bH (g i) = (b i : H) := by + rw [hbH] + rw [hbi, habs] + have hfix : p (b i : H) = (b i : H) := by + exact (LinearMap.IsIdempotentElem.mem_range_iff hpIdem).mp (b i).property + rw [hfix] + have hnorm : ‖(b i : H)‖ = 1 := by + simpa using hbOrtho.1 i + rw [show ⟪(b i : H), (b i : H)⟫_ℂ = + ((‖(b i : H)‖ ^ 2 : ℝ) : ℂ) by + rw [inner_self_eq_norm_sq_to_K] + norm_cast] + simp [hnorm] + let : Finite w := Finite.of_summable_const zero_lt_one hconst + let : Fintype w := Fintype.ofFinite w + change FiniteDimensional ℂ W + exact b.toOrthonormalBasis.toBasis.finiteDimensional_of_finite + +/-- A finite-multiplicity projection has the expected trace. The basis calculation is finite-rank: +extend an orthonormal basis of the range to one of `H`; the projection vanishes on the complementary +basis vectors and is the identity on the range basis. -/ +theorem HasFiniteMultiplicity.trace_eq_finrank_range + {p : H →L[ℂ] H} (hp : HasFiniteMultiplicity p) : + trace p hp.2 = (Module.finrank ℂ (LinearMap.range p.toLinearMap) : ℂ) := by + have hp' : IsStarProjection p ∧ IsTraceClass p := hp + let W : Submodule ℂ H := LinearMap.range p.toLinearMap + let : FiniteDimensional ℂ W := by + change FiniteDimensional ℂ (LinearMap.range p.toLinearMap) + exact hp.finiteDimensional_range + have hpIdem : IsIdempotentElem p.toLinearMap := + (ContinuousLinearMap.isIdempotentElem_toLinearMap_iff).2 hp.1.isIdempotentElem + have hpAdj : ContinuousLinearMap.adjoint p = p := by + rw [← ContinuousLinearMap.star_eq_adjoint] + exact hp.1.isSelfAdjoint + let : CompleteSpace W := by + change CompleteSpace p.range + exact (ContinuousLinearMap.IsIdempotentElem.isClosed_range + hp.1.isIdempotentElem).completeSpace_coe + obtain ⟨w, b, _⟩ := exists_hilbertBasis ℂ W + let : Finite w := b.orthonormal.linearIndependent.finite + let : Fintype w := Fintype.ofFinite w + have hbOrtho : Orthonormal ℂ (fun i : w => (b i : H)) := by + exact b.orthonormal.comp_linearIsometry W.subtypeₗᵢ + have hbInjective : Function.Injective (fun i : w => (b i : H)) := + hbOrtho.linearIndependent.injective + let s : Set H := Set.range (fun i : w => (b i : H)) + have hsOrtho : Orthonormal ℂ ((↑) : s → H) := hbOrtho.toSubtypeRange + obtain ⟨wH, bH, hsH, hbH⟩ := hsOrtho.exists_hilbertBasis_extension + let g : w → wH := fun i => + ⟨(b i : H), hsH (show (b i : H) ∈ s from ⟨i, rfl⟩)⟩ + have hgInjective : Function.Injective g := by + intro i j hij + apply Subtype.ext + exact congrArg (fun k : w => (k : W)) + (hbInjective (congrArg (fun z : wH => (z : H)) hij)) + have hbi (i : w) : bH (g i) = (b i : H) := by + rw [hbH] + have hfix (i : w) : p (b i : H) = (b i : H) := by + exact (LinearMap.IsIdempotentElem.mem_range_iff hpIdem).mp (b i).property + let f : wH → ℝ := fun j => (⟪bH j, CFC.abs p (bH j)⟫_ℂ).re + have hdiag : Summable f := summable_inner_abs_of_hilbertBasis hp.2 bH + have habs : CFC.abs p = p := CFC.abs_of_nonneg p hp.1.nonneg + have hpdiag (x : H) : ⟪x, p x⟫_ℂ = ((‖p x‖ ^ 2 : ℝ) : ℂ) := by + have hpp : p (p x) = p x := by + have h := congrArg (fun q : H →L[ℂ] H => q x) hp.1.isIdempotentElem + simpa [ContinuousLinearMap.mul_def] using h + have h := ContinuousLinearMap.adjoint_inner_left p (p x) x + rw [hpAdj, hpp] at h + rw [← h] + simp + let w₀ : Set H := hp.2.choose + let b₀ : HilbertBasis w₀ ℂ H := hp.2.choose_spec.choose + have hWdiagBase : Summable (fun i : w₀ => + (⟪b₀ i, CFC.abs p (b₀ i)⟫_ℂ).re) := hp.2.choose_spec.choose_spec + have hWdiag : Summable (fun i : w₀ => ‖p (b₀ i)‖ ^ 2) := by + apply hWdiagBase.congr + intro i + rw [habs, hpdiag] + rfl + have hdiagC : Summable (fun j : wH => ⟪bH j, p (bH j)⟫_ℂ) := by + have hreal : Summable (fun j : wH => + ((f j : ℝ) : ℂ)) := Complex.summable_ofReal.mpr hdiag + apply hreal.congr + intro j + dsimp [f] + rw [habs, hpdiag] + change ((‖p (bH j)‖ ^ 2 : ℝ) : ℂ) = ((‖p (bH j)‖ ^ 2 : ℝ) : ℂ) + rfl + have hzero_of_not_mem_range (j : wH) (hj : j ∉ Set.range g) : + p (bH j) = 0 := by + have hjS : bH j ∉ s := by + intro hjs + rcases hjs with ⟨i, hi⟩ + apply hj + refine ⟨i, Subtype.ext ?_⟩ + dsimp [g] + simpa [hbH] using hi + let y : W := ⟨p (bH j), LinearMap.mem_range_self p.toLinearMap (bH j)⟩ + have hyinner (i : w) : ⟪y, b i⟫_ℂ = 0 := by + change ⟪p (bH j), (b i : H)⟫_ℂ = 0 + have horth : ⟪(bH j : H), (b i : H)⟫_ℂ = 0 := by + have hne : j ≠ g i := by + intro hij + apply hj + exact ⟨i, hij.symm⟩ + have h := bH.orthonormal.2 hne + simpa [hbi i] using h + have h := ContinuousLinearMap.adjoint_inner_right p (bH j) (b i : H) + calc + ⟪p (bH j), (b i : H)⟫_ℂ = + ⟪(bH j : H), ContinuousLinearMap.adjoint p (b i : H)⟫_ℂ := h.symm + _ = ⟪(bH j : H), p (b i : H)⟫_ℂ := by rw [hpAdj] + _ = ⟪(bH j : H), (b i : H)⟫_ℂ := by rw [hfix i] + _ = 0 := horth + have hyzero : y = 0 := by + apply (inner_self_eq_zero (𝕜 := ℂ) (E := W)).mp + rw [← (b.hasSum_inner_mul_inner y y).tsum_eq] + simp_rw [hyinner] + simp + exact congrArg (fun z : W => (z : H)) hyzero + have hfg (i : w) : f (g i) = 1 := by + dsimp [f] + rw [hbi i, habs, hfix i] + have hnorm : ‖(b i : H)‖ = 1 := by + simpa using hbOrtho.1 i + rw [inner_self_eq_norm_sq_to_K] + simp [hnorm] + have hsupport : Function.support f ⊆ Set.range g := by + intro j hj + by_contra hj' + exact hj (by + dsimp [f] + rw [habs, hzero_of_not_mem_range j hj'] + simp) + have hsum_support : (∑' j : Set.range g, f j) = ∑' j : wH, f j := + tsum_subtype_eq_of_support_subset hsupport + let e : w ≃ Set.range g := Equiv.ofInjective g hgInjective + have he (i : w) : e i = ⟨g i, ⟨i, rfl⟩⟩ := by + apply Subtype.ext + rfl + have hsum_reindex : (∑' i : w, f (g i)) = ∑' j : Set.range g, f j := by + calc + (∑' i : w, f (g i)) = ∑' i : w, f (e i) := by + apply tsum_congr + intro i + rw [he i] + _ = ∑' j : Set.range g, f (j : wH) := + e.tsum_eq (fun j : Set.range g => f (j : wH)) + have hnormSum : HasSum (fun j : wH => ‖p (bH j)‖ ^ 2) + (∑' i : w₀, ‖p (b₀ i)‖ ^ 2) := + hasSum_norm_sq_apply_of_selfAdjoint hp'.1.isSelfAdjoint b₀ bH hWdiag + have hsum_real : ∑' j : wH, f j = ∑' i : w, f (g i) := by + calc + (∑' j : wH, f j) = ∑' j : Set.range g, f j := hsum_support.symm + _ = ∑' i : w, f (g i) := hsum_reindex.symm + have htrace_real : trace p hp.2 = ((∑' j : wH, f j : ℝ) : ℂ) := by + calc + trace p hp.2 = ∑' i : w₀, ⟪b₀ i, p (b₀ i)⟫_ℂ := by + rfl + _ = ∑' i : w₀, ((‖p (b₀ i)‖ ^ 2 : ℝ) : ℂ) := by + apply tsum_congr + intro i + exact hpdiag (b₀ i) + _ = ((∑' i : w₀, ‖p (b₀ i)‖ ^ 2 : ℝ) : ℂ) := + (Complex.ofReal_tsum (fun i : w₀ => ‖p (b₀ i)‖ ^ 2)).symm + _ = ((∑' j : wH, ‖p (bH j)‖ ^ 2 : ℝ) : ℂ) := by + rw [hnormSum.tsum_eq] + _ = ((∑' j : wH, f j : ℝ) : ℂ) := by + congr 1 + apply tsum_congr + intro j + dsimp [f] + rw [habs, hpdiag] + rfl + rw [htrace_real, hsum_real] + rw [tsum_congr (fun i => hfg i), tsum_fintype] + have hcard : Module.finrank ℂ W = Fintype.card w := + Module.finrank_eq_card_basis b.toOrthonormalBasis.toBasis + rw [hcard] + simp + +/-- In finite dimension, the trace of a finite-multiplicity projection is the dimension of its +range. The proof deliberately goes through the ordinary linear-map trace theorem; this gives a +fully proved finite-dimensional instance without hiding the genuinely harder infinite-dimensional +trace-class argument behind an axiom. -/ +theorem HasFiniteMultiplicity.trace_eq_finrank_range_of_finiteDimensional + [FiniteDimensional ℂ H] {p : H →L[ℂ] H} (hp : HasFiniteMultiplicity p) : + trace p hp.2 = (Module.finrank ℂ (LinearMap.range p.toLinearMap) : ℂ) := by + obtain ⟨w, b, _⟩ := exists_hilbertBasis ℂ H + let : Finite w := b.orthonormal.linearIndependent.finite + let : Fintype w := Fintype.ofFinite w + have hpIdem : IsIdempotentElem p.toLinearMap := + (ContinuousLinearMap.isIdempotentElem_toLinearMap_iff).2 hp.1.isIdempotentElem + calc + trace p hp.2 = LinearMap.trace ℂ H p.toLinearMap := by + unfold trace + exact (trace_eq_sum_inner_hilbertBasis_of_finiteDimensional + p hp.2.choose_spec.choose).symm + _ = (Module.finrank ℂ (LinearMap.range p.toLinearMap) : ℂ) := + (LinearMap.IsIdempotentElem.isProj_range p.toLinearMap hpIdem).trace + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/TraceClass/GeneralIdeal.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/TraceClass/GeneralIdeal.lean new file mode 100644 index 0000000000..c4fdcd1bca --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/TraceClass/GeneralIdeal.lean @@ -0,0 +1,103 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.TraceClass.Polar +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.TraceClass.HilbertSchmidt + +/-! +# The unconditional trace, for arbitrary (not necessarily self-adjoint) trace-class operators + +Ported from `unbounded-alpha-public`'s `TraceClass/GeneralIdeal.lean`. `Basic.lean` already proves +basis-independence of the trace for positive and self-adjoint trace-class operators without polar +decomposition; this file crosses the general non-self-adjoint boundary: `√|T|` is Hilbert–Schmidt, +so `T = polarFactor T * √|T| * √|T|` factors `T`'s diagonal series as a Hilbert–Schmidt product, and +`HilbertSchmidt.tsum_diagonal_mul_eq_tsum_diagonal_swap` (the Fubini swap on that product) upgrades +this to full basis-independence of `trace T` for *every* trace-class `T`. +-/ + +@[expose] public section + +noncomputable section + +open scoped ComplexOrder InnerProductSpace +open HilbertSchmidt + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +private lemma sqrt_abs_diagonal_eq_norm_sq {T : H →L[ℂ] H} {w : Set H} (b : HilbertBasis w ℂ H) + (i : w) : + (⟪b i, CFC.abs T (b i)⟫_ℂ).re = ‖(CFC.sqrt (CFC.abs T)) (b i)‖ ^ 2 := by + let A : H →L[ℂ] H := CFC.abs T + let S : H →L[ℂ] H := CFC.sqrt A + have hAnonneg : 0 ≤ A := CFC.abs_nonneg T + have hSself : IsSelfAdjoint S := .of_nonneg (CFC.sqrt_nonneg A) + have hSS : S * S = A := CFC.sqrt_mul_sqrt_self A hAnonneg + have hinner : ⟪b i, A (b i)⟫_ℂ = ⟪S (b i), S (b i)⟫_ℂ := by + have hSstar : ContinuousLinearMap.adjoint S = S := + (ContinuousLinearMap.star_eq_adjoint S).symm.trans hSself + rw [← hSS] + show ⟪b i, (S * S) (b i)⟫_ℂ = _ + rw [ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply, + ← ContinuousLinearMap.adjoint_inner_left S (S (b i)) (b i), hSstar] + rw [show CFC.abs T = A from rfl, hinner, inner_self_eq_norm_sq_to_K] + norm_cast + +theorem isHilbertSchmidt_sqrt_abs_of_isTraceClass {T : H →L[ℂ] H} (hT : IsTraceClass T) : + IsHilbertSchmidt (CFC.sqrt (CFC.abs T)) := by + obtain ⟨w, b, _⟩ := exists_hilbertBasis ℂ H + refine ⟨w, b, ?_⟩ + have hdiag : Summable (fun i : w => (⟪b i, CFC.abs T (b i)⟫_ℂ).re) := isTraceClass_iff.mp hT w b + exact hdiag.congr (fun i => sqrt_abs_diagonal_eq_norm_sq b i) + +theorem summable_trace_diagonal_of_isTraceClass {T : H →L[ℂ] H} (hT : IsTraceClass T) + {w : Set H} (b : HilbertBasis w ℂ H) : + Summable (fun i : w => ⟪b i, T (b i)⟫_ℂ) := by + let S : H →L[ℂ] H := CFC.sqrt (CFC.abs T) + let U : H →L[ℂ] H := Polar.polarFactor T + have hS : IsHilbertSchmidt S := isHilbertSchmidt_sqrt_abs_of_isTraceClass hT + have hU : ‖U‖ ≤ 1 := Polar.polarFactor_opNorm_le T + have hUS : IsHilbertSchmidt (U * S) := isHilbertSchmidt_mul_left_of_opNorm_le_one hU hS + have hdiag := summable_diagonal_of_hilbertSchmidt b hUS hS + have hSS : S * S = CFC.abs T := CFC.sqrt_mul_sqrt_self (CFC.abs T) (CFC.abs_nonneg T) + have hfactor : (U * S) * S = T := by + rw [mul_assoc, hSS]; exact Polar.polarFactor_mul_absOperator T + simpa only [hfactor] using hdiag + +theorem tsum_diagonal_eq_of_isTraceClass {T : H →L[ℂ] H} (hT : IsTraceClass T) + {w w' : Set H} (b : HilbertBasis w ℂ H) (c : HilbertBasis w' ℂ H) : + (∑' i : w, ⟪b i, T (b i)⟫_ℂ) = ∑' j : w', ⟪c j, T (c j)⟫_ℂ := by + let S : H →L[ℂ] H := CFC.sqrt (CFC.abs T) + let U : H →L[ℂ] H := Polar.polarFactor T + have hS : IsHilbertSchmidt S := isHilbertSchmidt_sqrt_abs_of_isTraceClass hT + have hUS : IsHilbertSchmidt (U * S) := + isHilbertSchmidt_mul_left_of_opNorm_le_one (Polar.polarFactor_opNorm_le T) hS + have hSS : S * S = CFC.abs T := CFC.sqrt_mul_sqrt_self (CFC.abs T) (CFC.abs_nonneg T) + have hfactor : (U * S) * S = T := by + rw [mul_assoc, hSS]; exact Polar.polarFactor_mul_absOperator T + have h₁ := HilbertSchmidt.tsum_diagonal_mul_eq_tsum_diagonal_swap (R := U * S) (S := S) b c hUS hS + have h₂ := HilbertSchmidt.tsum_diagonal_mul_eq_tsum_diagonal_swap (R := S) (S := U * S) c c hS hUS + rw [hfactor] at h₁ h₂ + calc + (∑' i : w, ⟪b i, T (b i)⟫_ℂ) = ∑' j : w', ⟪c j, (S * (U * S)) (c j)⟫_ℂ := h₁ + _ = ∑' j : w', ⟪c j, T (c j)⟫_ℂ := h₂ + +theorem trace_eq_of_hilbertBasis_unconditional {T : H →L[ℂ] H} (hT : IsTraceClass T) {w : Set H} + (b : HilbertBasis w ℂ H) : + trace T hT = ∑' i : w, ⟪b i, T (b i)⟫_ℂ := by + let w₀ : Set H := hT.choose + let b₀ : HilbertBasis w₀ ℂ H := hT.choose_spec.choose + change (∑' i : w₀, ⟪b₀ i, T (b₀ i)⟫_ℂ) = ∑' i : w, ⟪b i, T (b i)⟫_ℂ + exact tsum_diagonal_eq_of_isTraceClass hT b₀ b + +/-- **Basis-independent trace evaluation for an arbitrary trace-class operator.** Unlike the +witness-basis definition, this requires no self-adjointness/positivity hypothesis. -/ +theorem trace_eq_of_hilbertBasis {T : H →L[ℂ] H} (hT : IsTraceClass T) {w : Set H} + (b : HilbertBasis w ℂ H) : + trace T hT = ∑' i : w, ⟪b i, T (b i)⟫_ℂ := + trace_eq_of_hilbertBasis_unconditional hT b + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/TraceClass/GeneralProduct.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/TraceClass/GeneralProduct.lean new file mode 100644 index 0000000000..7b63b465f4 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/TraceClass/GeneralProduct.lean @@ -0,0 +1,192 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.TraceClass.GeneralIdeal + +/-! +# The product of two Hilbert–Schmidt operators is trace class + +Ported from `unbounded-alpha-public`'s `TraceClass/GeneralProduct.lean`. This is the master lemma +that finally crosses the non-self-adjoint boundary honestly: given the general partial-isometry +identity `Polar.star_polarFactor_mul_self` (`star (polarFactor T) * T = |T|`, for *every* bounded +`T`), the diagonal of `|R * S|` for Hilbert–Schmidt `R`, `S` is exactly +`i ↦ ⟪(adjoint R * polarFactor (R*S)) eᵢ, S eᵢ⟫`, absolutely summable by the same Hilbert–Schmidt +Cauchy–Schwarz estimate used for the diagonal of a Hilbert–Schmidt product. + +From this single theorem, the general (not necessarily positive or self-adjoint) trace-class ideal +structure follows: every trace-class operator is already `(polarFactor T * √|T|) * √|T|` (both +Hilbert–Schmidt factors), so this master lemma gives the two-sided ideal estimate and additive +closure of `IsTraceClass` for arbitrary operators, closing `Banach.lean`'s `isTraceClass_add` gap +and `HilbertSpaceInstance.lean`'s `isTraceClass_mul_coe` gap. +-/ + +@[expose] public section + +noncomputable section + +open scoped ComplexOrder InnerProductSpace +open HilbertSchmidt + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-- The diagonal of `star W * (R * S)` (for any contraction `W`) unwinds to a Hilbert–Schmidt +Cauchy–Schwarz pairing. This is the pointwise identity feeding both the master product theorem and +the general additive/ideal closure results below. -/ +theorem diagonal_star_mul_eq_inner {R S W : H →L[ℂ] H} {w : Set H} (b : HilbertBasis w ℂ H) + (i : w) : + ⟪b i, (star W * (R * S)) (b i)⟫_ℂ = ⟪(ContinuousLinearMap.adjoint R * W) (b i), S (b i)⟫_ℂ := by + rw [ContinuousLinearMap.star_eq_adjoint, ContinuousLinearMap.mul_def, + ContinuousLinearMap.comp_apply, ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply, + ContinuousLinearMap.adjoint_inner_right W (b i) (R (S (b i))), + ← ContinuousLinearMap.adjoint_inner_left R (S (b i)) (W (b i)), + ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply] + +/-- **Master lemma**: the product of two Hilbert–Schmidt operators is trace class. The proof +factors `|RS| = star (polarFactor (RS)) * (RS)` (the general partial-isometry identity, valid for +every bounded operator, not just this product) and bounds its diagonal by the Hilbert–Schmidt +Cauchy–Schwarz estimate `HilbertSchmidt.summable_norm_mul_of_square_sums`. -/ +theorem isTraceClass_mul_of_isHilbertSchmidt {R S : H →L[ℂ] H} + (hR : IsHilbertSchmidt R) (hS : IsHilbertSchmidt S) : IsTraceClass (R * S) := by + obtain ⟨w, b, _⟩ := exists_hilbertBasis ℂ H + refine ⟨w, b, ?_⟩ + set W : H →L[ℂ] H := Polar.polarFactor (R * S) with hWdef + have hWnorm : ‖W‖ ≤ 1 := Polar.polarFactor_opNorm_le (R * S) + have hRstar : IsHilbertSchmidt (ContinuousLinearMap.adjoint R) := by + rcases hR with ⟨w₀, b₀, hb₀⟩ + exact ⟨w₀, b₀, summable_norm_sq_adjoint_of_summable_norm_sq b₀ hb₀⟩ + have hRW : IsHilbertSchmidt (ContinuousLinearMap.adjoint R * W) := + isHilbertSchmidt_mul_right_of_opNorm_le_one hWnorm hRstar + have hRWb : Summable (fun i : w => ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ ^ 2) := + summable_norm_sq_apply_of_hilbertBasis w b hRW + have hSb : Summable (fun i : w => ‖S (b i)‖ ^ 2) := summable_norm_sq_apply_of_hilbertBasis w b hS + have hprod : Summable (fun i : w => + ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ * ‖S (b i)‖) := + summable_norm_mul_of_square_sums _ _ hRWb hSb (fun i => norm_nonneg _) (fun i => norm_nonneg _) + have habs : Polar.absOperator (R * S) = star W * (R * S) := (Polar.star_polarFactor_mul_self + (R * S)).symm + have hpoint : ∀ i : w, + ⟪b i, CFC.abs (R * S) (b i)⟫_ℂ = ⟪(ContinuousLinearMap.adjoint R * W) (b i), S (b i)⟫_ℂ := by + intro i + show ⟪b i, Polar.absOperator (R * S) (b i)⟫_ℂ = _ + rw [habs] + exact diagonal_star_mul_eq_inner b i + apply Summable.of_norm_bounded hprod + intro i + calc + ‖(⟪b i, CFC.abs (R * S) (b i)⟫_ℂ).re‖ ≤ ‖⟪b i, CFC.abs (R * S) (b i)⟫_ℂ‖ := + Complex.abs_re_le_norm _ + _ = ‖⟪(ContinuousLinearMap.adjoint R * W) (b i), S (b i)⟫_ℂ‖ := by rw [hpoint i] + _ ≤ ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ * ‖S (b i)‖ := norm_inner_le_norm _ _ + +/-- Every trace-class operator factors as a product of two Hilbert–Schmidt operators: the polar +factor composed with the Hilbert–Schmidt square root of `|T|`, and that same square root again. -/ +theorem isHilbertSchmidt_polarFactor_mul_sqrt_abs_and_sqrt_abs {T : H →L[ℂ] H} + (hT : IsTraceClass T) : + IsHilbertSchmidt (Polar.polarFactor T * CFC.sqrt (CFC.abs T)) ∧ + IsHilbertSchmidt (CFC.sqrt (CFC.abs T)) ∧ + Polar.polarFactor T * CFC.sqrt (CFC.abs T) * CFC.sqrt (CFC.abs T) = T := by + have hS : IsHilbertSchmidt (CFC.sqrt (CFC.abs T)) := isHilbertSchmidt_sqrt_abs_of_isTraceClass hT + have hUS : IsHilbertSchmidt (Polar.polarFactor T * CFC.sqrt (CFC.abs T)) := + isHilbertSchmidt_mul_left_of_opNorm_le_one (Polar.polarFactor_opNorm_le T) hS + refine ⟨hUS, hS, ?_⟩ + rw [mul_assoc, CFC.sqrt_mul_sqrt_self (CFC.abs T) (CFC.abs_nonneg T)] + exact Polar.polarFactor_mul_absOperator T + +/-- **General additive closure of `IsTraceClass`**, for arbitrary (not necessarily positive or +self-adjoint) trace-class operators. Closes `Banach.lean`'s `isTraceClass_add` gap. The proof +conjugates the sum by the *sum's own* polar factor `W`: `star W * (T + T') = star W * T + star W * +T'` splits additively, and each summand's diagonal is absolutely summable by the same +Hilbert–Schmidt Cauchy–Schwarz estimate used in the master lemma, applied to `T`'s and `T'`'s own +Hilbert–Schmidt factorizations. -/ +theorem isTraceClass_add {T T' : H →L[ℂ] H} (hT : IsTraceClass T) (hT' : IsTraceClass T') : + IsTraceClass (T + T') := by + obtain ⟨w, b, _⟩ := exists_hilbertBasis ℂ H + refine ⟨w, b, ?_⟩ + set W : H →L[ℂ] H := Polar.polarFactor (T + T') with hWdef + have hWnorm : ‖W‖ ≤ 1 := Polar.polarFactor_opNorm_le (T + T') + have hsummable_conj : ∀ {X : H →L[ℂ] H}, IsTraceClass X → + Summable (fun i : w => ⟪(b i : H), (star W * X) (b i)⟫_ℂ) := by + intro X hX + obtain ⟨hUS, hS, hfactor⟩ := isHilbertSchmidt_polarFactor_mul_sqrt_abs_and_sqrt_abs hX + set R : H →L[ℂ] H := Polar.polarFactor X * CFC.sqrt (CFC.abs X) with hRdef + set S : H →L[ℂ] H := CFC.sqrt (CFC.abs X) with hSdef + have hRstar : IsHilbertSchmidt (ContinuousLinearMap.adjoint R) := by + rcases hUS with ⟨w₀, b₀, hb₀⟩ + exact ⟨w₀, b₀, summable_norm_sq_adjoint_of_summable_norm_sq b₀ hb₀⟩ + have hRW : IsHilbertSchmidt (ContinuousLinearMap.adjoint R * W) := + isHilbertSchmidt_mul_right_of_opNorm_le_one hWnorm hRstar + have hRWb : Summable (fun i : w => ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ ^ 2) := + summable_norm_sq_apply_of_hilbertBasis w b hRW + have hSb : Summable (fun i : w => ‖S (b i)‖ ^ 2) := + summable_norm_sq_apply_of_hilbertBasis w b hS + have hprod : Summable (fun i : w => + ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ * ‖S (b i)‖) := + summable_norm_mul_of_square_sums _ _ hRWb hSb + (fun i => norm_nonneg _) (fun i => norm_nonneg _) + have hpoint : ∀ i : w, ⟪b i, (star W * X) (b i)⟫_ℂ = + ⟪(ContinuousLinearMap.adjoint R * W) (b i), S (b i)⟫_ℂ := by + intro i + rw [show X = R * S from hfactor.symm] + exact diagonal_star_mul_eq_inner b i + apply Summable.of_norm_bounded hprod + intro i + rw [hpoint i] + exact norm_inner_le_norm _ _ + have hTsum := hsummable_conj hT + have hT'sum := hsummable_conj hT' + have habs : CFC.abs (T + T') = star W * (T + T') := (Polar.star_polarFactor_mul_self (T + + T')).symm + have hsplit : (fun i : w => ⟪b i, CFC.abs (T + T') (b i)⟫_ℂ) = + (fun i : w => ⟪b i, (star W * T) (b i)⟫_ℂ + ⟪b i, (star W * T') (b i)⟫_ℂ) := by + funext i + rw [habs] + show ⟪b i, (star W * (T + T')) (b i)⟫_ℂ = _ + have hstep : (star W * (T + T')) (b i) = (star W * T) (b i) + (star W * T') (b i) := by + rw [ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply, + add_apply, map_add, ContinuousLinearMap.mul_def, + ContinuousLinearMap.comp_apply, ContinuousLinearMap.mul_def, + ContinuousLinearMap.comp_apply] + rw [hstep, inner_add_right] + have hsum : Summable (fun i : w => + ⟪b i, (star W * T) (b i)⟫_ℂ + ⟪b i, (star W * T') (b i)⟫_ℂ) := hTsum.add hT'sum + have hsum' : Summable (fun i : w => + (⟪b i, (star W * T) (b i)⟫_ℂ + ⟪b i, (star W * T') (b i)⟫_ℂ).re) := by + convert (hsum.map Complex.reCLM.toAddMonoidHom Complex.reCLM.continuous) using 1 + ext i; rfl + have hsplit' := congrArg (fun f : w → ℂ => fun i => (f i).re) hsplit + rw [hsplit'] + exact hsum' + +/-- **The general two-sided trace ideal estimate**: conjugating a trace-class operator by +arbitrary bounded operators on either side stays trace class. Closes `HilbertSpaceInstance.lean`'s +`isTraceClass_mul_coe` gap (specializing `B = 1`). Unlike a positive-only conjugation theorem, this +needs no positivity hypothesis on `T`: the two Hilbert–Schmidt factors of `T` absorb `A` and `B` on +either side, and the master lemma finishes the argument. -/ +theorem isTraceClass_mul_mul {A B T : H →L[ℂ] H} (hT : IsTraceClass T) : + IsTraceClass (A * T * B) := by + obtain ⟨_, hS, hfactor⟩ := isHilbertSchmidt_polarFactor_mul_sqrt_abs_and_sqrt_abs hT + set R : H →L[ℂ] H := Polar.polarFactor T * CFC.sqrt (CFC.abs T) with hRdef + set S : H →L[ℂ] H := CFC.sqrt (CFC.abs T) with hSdef + have hUS : IsHilbertSchmidt R := + isHilbertSchmidt_mul_left_of_opNorm_le_one (Polar.polarFactor_opNorm_le T) hS + have hAR : IsHilbertSchmidt (A * R) := isHilbertSchmidt_mul_left hUS + have hSB : IsHilbertSchmidt (S * B) := isHilbertSchmidt_mul_right hS + have heq : A * T * B = (A * R) * (S * B) := by + rw [show T = R * S from hfactor.symm]; simp only [mul_assoc] + rw [heq] + exact isTraceClass_mul_of_isHilbertSchmidt hAR hSB + +/-- Taking the adjoint preserves trace class. -/ +theorem isTraceClass_star {T : H →L[ℂ] H} (hT : IsTraceClass T) : IsTraceClass (star T) := by + obtain ⟨hR, hS, hfactor⟩ := isHilbertSchmidt_polarFactor_mul_sqrt_abs_and_sqrt_abs hT + have hstar : IsTraceClass (star (CFC.sqrt (CFC.abs T)) * + star (Polar.polarFactor T * CFC.sqrt (CFC.abs T))) := + isTraceClass_mul_of_isHilbertSchmidt (isHilbertSchmidt_star hS) (isHilbertSchmidt_star hR) + rw [← hfactor] + simpa only [star_mul] using hstar + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/TraceClass/HilbertSchmidt.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/TraceClass/HilbertSchmidt.lean new file mode 100644 index 0000000000..b658ae4ca1 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/TraceClass/HilbertSchmidt.lean @@ -0,0 +1,519 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.TraceClass.Basic +public import Mathlib.Analysis.MeanInequalities + +/-! +# Hilbert–Schmidt operators + +Ported from `unbounded-alpha-public`'s `TraceClass/{HilbertSchmidt,HSAlgebra,HSEstimate}.lean` and +the Cauchy–Schwarz estimates of `TraceClass/TraceProduct.lean`, restated against this repo's +`H →L[ℂ] H` (the source's `B(H)`) with no bundled subtype involved — the source's own top-level +`TraceClass.lean` already used the identical predicate-based `IsTraceClass`/`traceNorm`/`trace` +this repo's `Basic.lean` does, so no translation of the underlying convention was needed, only the +notation change and reuse of `Basic.lean`'s own (now-public) `hasSum_norm_sq_inner_basis` in place +of the source's private per-file copy of the same lemma. + +A bounded operator `S` is **Hilbert–Schmidt** when `∑ᵢ ‖S eᵢ‖²` converges for some (equivalently, +by the basis-independence theorem below, every) Hilbert basis `{eᵢ}`. This is the reusable analytic +layer between plain boundedness and trace-classness: `S⋆S` is trace class whenever `S` is +Hilbert–Schmidt, a bounded contraction on either side preserves the predicate, and a product of two +Hilbert–Schmidt operators has an absolutely summable diagonal in every basis (the Cauchy–Schwarz +step consumed by the polar-decomposition argument in `GeneralProduct.lean`). +-/ + +@[expose] public section + +noncomputable section + +open scoped ComplexOrder InnerProductSpace + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +namespace HilbertSchmidt + +/-- A bounded operator is Hilbert–Schmidt when its squared norm sum is summable in one Hilbert +basis. The basis-independence theorem below shows this existential definition is equivalent to +using any basis. -/ +def IsHilbertSchmidt (S : H →L[ℂ] H) : Prop := + ∃ (w : Set H) (b : HilbertBasis w ℂ H), Summable (fun i : w => ‖S (b i)‖ ^ 2) + +/-- The Hilbert–Schmidt square sum of `S` in one basis equals the square sum of `S⋆` in a second +basis. This is the nonnegative double-sum identity; the usual basis-independence statement follows +by applying it twice. -/ +lemma hasSum_norm_sq_apply_eq_adjoint {S : H →L[ℂ] H} + {w w' : Set H} (b : HilbertBasis w ℂ H) (c : HilbertBasis w' ℂ H) + (hb : Summable (fun i : w => ‖S (b i)‖ ^ 2)) : + HasSum (fun j : w' => ‖(ContinuousLinearMap.adjoint S) (c j)‖ ^ 2) + (∑' i : w, ‖S (b i)‖ ^ 2) := by + classical + set F : w → w' → ℝ := fun i j => ‖⟪c j, S (b i)⟫_ℂ‖ ^ 2 with hFdef + have hFnonneg : 0 ≤ Function.uncurry F := fun _ => sq_nonneg _ + have hrow : ∀ i : w, HasSum (F i) (‖S (b i)‖ ^ 2) := fun i => + hasSum_norm_sq_inner_basis c (S (b i)) + have hcol : ∀ j : w', HasSum (fun i : w => F i j) + (‖(ContinuousLinearMap.adjoint S) (c j)‖ ^ 2) := by + intro j + have e1 : ∀ i : w, ⟪c j, S (b i)⟫_ℂ = + ⟪(ContinuousLinearMap.adjoint S) (c j), b i⟫_ℂ := fun i => + (ContinuousLinearMap.adjoint_inner_left S (b i) (c j)).symm + have key : (fun i : w => F i j) = fun i : w => + ‖⟪b i, (ContinuousLinearMap.adjoint S) (c j)⟫_ℂ‖ ^ 2 := by + funext i + show ‖⟪c j, S (b i)⟫_ℂ‖ ^ 2 = _ + rw [e1 i, ← inner_conj_symm (b i) ((ContinuousLinearMap.adjoint S) (c j)), + RCLike.norm_conj] + rw [key] + exact hasSum_norm_sq_inner_basis b ((ContinuousLinearMap.adjoint S) (c j)) + have hjoint : Summable (Function.uncurry F) := by + rw [summable_prod_of_nonneg hFnonneg] + refine ⟨fun i => (hrow i).summable, ?_⟩ + have heq : (fun i : w => ∑' j : w', F i j) = fun i : w => ‖S (b i)‖ ^ 2 := + funext fun i => (hrow i).tsum_eq + show Summable fun i : w => ∑' j : w', F i j + rwa [heq] + have hswap := hjoint.tsum_comm' (fun i => (hrow i).summable) (fun j => (hcol j).summable) + have hLHS : ∑' j : w', ∑' i : w, F i j = ∑' j : w', ‖(ContinuousLinearMap.adjoint S) (c j)‖ ^ 2 := + tsum_congr fun j => (hcol j).tsum_eq + have hRHS : ∑' i : w, ∑' j : w', F i j = ∑' i : w, ‖S (b i)‖ ^ 2 := + tsum_congr fun i => (hrow i).tsum_eq + have hEq : ∑' j : w', ‖(ContinuousLinearMap.adjoint S) (c j)‖ ^ 2 = ∑' i : w, ‖S (b i)‖ ^ 2 := by + rw [← hLHS, ← hRHS]; exact hswap + set G : w' → w → ℝ := fun j i => F i j with hGdef + have hGnonneg : 0 ≤ Function.uncurry G := fun _ => sq_nonneg _ + have hjointG : Summable (Function.uncurry G) := by + have hcomp : Function.uncurry G = Function.uncurry F ∘ (Equiv.prodComm w' w) := by + funext p; simp [Function.uncurry, hGdef, Equiv.prodComm] + rw [hcomp] + exact (Equiv.prodComm w' w).summable_iff.mpr hjoint + have hcolSummable : Summable + (fun j : w' => ‖(ContinuousLinearMap.adjoint S) (c j)‖ ^ 2) := by + have hpair := (summable_prod_of_nonneg hGnonneg).mp hjointG + have h2 : Summable fun j : w' => ∑' i : w, G j i := hpair.2 + have heq2 : (fun j : w' => ∑' i : w, G j i) = fun j : w' => + ‖(ContinuousLinearMap.adjoint S) (c j)‖ ^ 2 := + funext fun j => (hcol j).tsum_eq + rwa [heq2] at h2 + rw [← hEq] + exact hcolSummable.hasSum + +lemma summable_norm_sq_adjoint_of_summable_norm_sq {S : H →L[ℂ] H} + {w : Set H} (b : HilbertBasis w ℂ H) + (hb : Summable (fun i : w => ‖S (b i)‖ ^ 2)) : + Summable (fun i : w => ‖(ContinuousLinearMap.adjoint S) (b i)‖ ^ 2) := + (hasSum_norm_sq_apply_eq_adjoint b b hb).summable + +lemma hasSum_norm_sq_apply_of_basis {S : H →L[ℂ] H} {w w' : Set H} + (b : HilbertBasis w ℂ H) (c : HilbertBasis w' ℂ H) + (hb : Summable (fun i : w => ‖S (b i)‖ ^ 2)) : + HasSum (fun j : w' => ‖S (c j)‖ ^ 2) (∑' i : w, ‖S (b i)‖ ^ 2) := by + have hfirst := hasSum_norm_sq_apply_eq_adjoint b c hb + have hstarc : Summable (fun j : w' => ‖(ContinuousLinearMap.adjoint S) (c j)‖ ^ 2) := + hfirst.summable + have hsecond := hasSum_norm_sq_apply_eq_adjoint (S := ContinuousLinearMap.adjoint S) c c hstarc + have hsecond' : HasSum (fun j : w' => ‖S (c j)‖ ^ 2) + (∑' j : w', ‖(ContinuousLinearMap.adjoint S) (c j)‖ ^ 2) := by + simpa only [ContinuousLinearMap.adjoint_adjoint] using hsecond + rw [← hfirst.tsum_eq] + exact hsecond' + +theorem summable_norm_sq_apply_of_hilbertBasis {S : H →L[ℂ] H} + (w : Set H) (b : HilbertBasis w ℂ H) (hS : IsHilbertSchmidt S) : + Summable (fun i : w => ‖S (b i)‖ ^ 2) := by + rcases hS with ⟨w₀, b₀, hb₀⟩ + exact (hasSum_norm_sq_apply_of_basis b₀ b hb₀).summable + +/-! ## Elementary algebraic closure -/ + +theorem isHilbertSchmidt_zero : IsHilbertSchmidt (0 : H →L[ℂ] H) := by + obtain ⟨w, b, _⟩ := exists_hilbertBasis ℂ H + refine ⟨w, b, ?_⟩ + simp + +omit [CompleteSpace H] in +theorem isHilbertSchmidt_smul {S : H →L[ℂ] H} (c : ℂ) (hS : IsHilbertSchmidt S) : + IsHilbertSchmidt (c • S) := by + rcases hS with ⟨w, b, hb⟩ + refine ⟨w, b, ?_⟩ + have hmul := hb.mul_left (‖c‖ ^ 2) + apply hmul.congr + intro i + rw [smul_apply, norm_smul] + ring + +theorem isHilbertSchmidt_add {R S : H →L[ℂ] H} + (hR : IsHilbertSchmidt R) (hS : IsHilbertSchmidt S) : + IsHilbertSchmidt (R + S) := by + rcases hR with ⟨w, b, hbR⟩ + have hSb : Summable (fun i : w => ‖S (b i)‖ ^ 2) := summable_norm_sq_apply_of_hilbertBasis w b hS + refine ⟨w, b, ?_⟩ + apply Summable.of_nonneg_of_le (fun i => sq_nonneg _) + · intro i + have hnorm : ‖R (b i) + S (b i)‖ ≤ ‖R (b i)‖ + ‖S (b i)‖ := norm_add_le _ _ + have hsq : ‖R (b i) + S (b i)‖ ^ 2 ≤ (‖R (b i)‖ + ‖S (b i)‖) ^ 2 := + (sq_le_sq₀ (norm_nonneg _) (add_nonneg (norm_nonneg _) (norm_nonneg _))).2 hnorm + calc + ‖(R + S) (b i)‖ ^ 2 = ‖R (b i) + S (b i)‖ ^ 2 := by rfl + _ ≤ (‖R (b i)‖ + ‖S (b i)‖) ^ 2 := hsq + _ ≤ 2 * ‖R (b i)‖ ^ 2 + 2 * ‖S (b i)‖ ^ 2 := by + nlinarith [sq_nonneg (‖R (b i)‖ - ‖S (b i)‖)] + · exact (hbR.mul_left 2).add (hSb.mul_left 2) + +theorem isHilbertSchmidt_sub {R S : H →L[ℂ] H} + (hR : IsHilbertSchmidt R) (hS : IsHilbertSchmidt S) : + IsHilbertSchmidt (R - S) := by + simpa [sub_eq_add_neg] using isHilbertSchmidt_add hR (isHilbertSchmidt_smul (-1 : ℂ) hS) + +theorem isHilbertSchmidt_star {S : H →L[ℂ] H} (hS : IsHilbertSchmidt S) : + IsHilbertSchmidt (star S) := by + rcases hS with ⟨w, b, hb⟩ + refine ⟨w, b, ?_⟩ + rw [ContinuousLinearMap.star_eq_adjoint] + exact summable_norm_sq_adjoint_of_summable_norm_sq b hb + +omit [CompleteSpace H] in +theorem isHilbertSchmidt_mul_left_of_opNorm_le_one {U S : H →L[ℂ] H} + (hU : ‖U‖ ≤ 1) (hS : IsHilbertSchmidt S) : + IsHilbertSchmidt (U * S) := by + rcases hS with ⟨w, b, hb⟩ + refine ⟨w, b, ?_⟩ + apply Summable.of_nonneg_of_le (fun i => sq_nonneg _) (fun i => ?_) hb + have hi : ‖U (S (b i))‖ ≤ ‖S (b i)‖ := by + calc + ‖U (S (b i))‖ ≤ ‖U‖ * ‖S (b i)‖ := U.le_opNorm _ + _ ≤ ‖S (b i)‖ := by + simpa only [one_mul] using mul_le_mul_of_nonneg_right hU (norm_nonneg (S (b i))) + exact (sq_le_sq₀ (norm_nonneg _) (norm_nonneg _)).2 hi + +theorem isHilbertSchmidt_mul_right_of_opNorm_le_one {S U : H →L[ℂ] H} + (hU : ‖U‖ ≤ 1) (hS : IsHilbertSchmidt S) : + IsHilbertSchmidt (S * U) := by + have hU' : ‖star U‖ ≤ 1 := by simpa using hU + have hleft : IsHilbertSchmidt (star U * star S) := + isHilbertSchmidt_mul_left_of_opNorm_le_one hU' (isHilbertSchmidt_star hS) + have hdouble : IsHilbertSchmidt (star (star U * star S)) := isHilbertSchmidt_star hleft + simpa only [star_mul, star_star] using hdouble + +theorem isHilbertSchmidt_mul_left {U S : H →L[ℂ] H} (hS : IsHilbertSchmidt S) : + IsHilbertSchmidt (U * S) := by + by_cases hU0 : ‖U‖ = 0 + · have hzero : U = 0 := norm_eq_zero.mp hU0 + simpa [hzero] using isHilbertSchmidt_zero (H := H) + · let V : H →L[ℂ] H := (‖U‖ : ℂ)⁻¹ • U + have hV : ‖V‖ ≤ 1 := by dsimp [V]; simp [norm_smul, norm_inv, hU0] + have hVS : IsHilbertSchmidt (V * S) := isHilbertSchmidt_mul_left_of_opNorm_le_one hV hS + have hscaled : IsHilbertSchmidt ((‖U‖ : ℂ) • (V * S)) := isHilbertSchmidt_smul (‖U‖ : ℂ) hVS + have hVeq : (‖U‖ : ℂ) • V = U := by ext x; simp [V, hU0] + rw [show (‖U‖ : ℂ) • (V * S) = ((‖U‖ : ℂ) • V) * S by simp] at hscaled + rwa [hVeq] at hscaled + +theorem isHilbertSchmidt_mul_right {S U : H →L[ℂ] H} (hS : IsHilbertSchmidt S) : + IsHilbertSchmidt (S * U) := by + have hleft : IsHilbertSchmidt (star U * star S) := + isHilbertSchmidt_mul_left (U := star U) (isHilbertSchmidt_star hS) + have hdouble : IsHilbertSchmidt (star (star U * star S)) := isHilbertSchmidt_star hleft + simpa only [star_mul, star_star] using hdouble + +/-- `S⋆S` is trace class whenever `S` is Hilbert–Schmidt. -/ +theorem isTraceClass_star_mul_self_of_isHilbertSchmidt {S : H →L[ℂ] H} + (hS : IsHilbertSchmidt S) : IsTraceClass (star S * S) := by + apply isTraceClass_iff.mpr + intro w b + have hdiag : Summable (fun i : w => ‖S (b i)‖ ^ 2) := + summable_norm_sq_apply_of_hilbertBasis w b hS + have hpos : 0 ≤ star S * S := star_mul_self_nonneg S + have habs : CFC.abs (star S * S) = star S * S := CFC.abs_of_nonneg _ hpos + apply hdiag.congr + intro i + rw [habs] + have hinner : ⟪b i, (star S * S) (b i)⟫_ℂ = ⟪S (b i), S (b i)⟫_ℂ := by + rw [ContinuousLinearMap.star_eq_adjoint, ContinuousLinearMap.mul_def, + ContinuousLinearMap.comp_apply, ContinuousLinearMap.adjoint_inner_right] + rw [hinner, inner_self_eq_norm_sq_to_K] + norm_cast + +/-- `S S⋆` is trace class whenever `S` is Hilbert–Schmidt. -/ +theorem isTraceClass_mul_star_of_isHilbertSchmidt {S : H →L[ℂ] H} + (hS : IsHilbertSchmidt S) : IsTraceClass (S * star S) := by + have hstar : IsHilbertSchmidt (star S) := isHilbertSchmidt_star hS + simpa only [star_star] using isTraceClass_star_mul_self_of_isHilbertSchmidt hstar + +/-! ## Cauchy–Schwarz estimates on Hilbert–Schmidt diagonals -/ + +private lemma holder_two_two : (2 : ℝ).HolderConjugate 2 := by + rw [Real.holderConjugate_iff]; constructor <;> norm_num + +omit [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] in +/-- The real `ℓ²` Cauchy–Schwarz estimate, in the tsum form needed for operator diagonal bounds. -/ +@[nolint unusedArguments] +theorem tsum_mul_le_sqrt_mul_sqrt {w : Set H} {f g : w → ℝ} + (hf : Summable (fun i => f i ^ 2)) (hg : Summable (fun i => g i ^ 2)) + (hf_nonneg : ∀ i, 0 ≤ f i) (hg_nonneg : ∀ i, 0 ≤ g i) : + ∑' i : w, f i * g i ≤ Real.sqrt (∑' i : w, f i ^ 2) * Real.sqrt (∑' i : w, g i ^ 2) := by + have h := Real.inner_le_Lp_mul_Lq_tsum_of_nonneg (f := f) (g := g) holder_two_two + hf_nonneg hg_nonneg (by convert hf using 1; ext i; norm_num [Real.rpow_natCast]) + (by convert hg using 1; ext i; norm_num [Real.rpow_natCast]) + have hf_eq : (∑' i : w, f i ^ (2 : ℝ)) = ∑' i : w, f i ^ 2 := + tsum_congr fun i => Real.rpow_natCast (f i) 2 + have hg_eq : (∑' i : w, g i ^ (2 : ℝ)) = ∑' i : w, g i ^ 2 := + tsum_congr fun i => Real.rpow_natCast (g i) 2 + rw [hf_eq, hg_eq] at h + rw [← Real.sqrt_eq_rpow, ← Real.sqrt_eq_rpow] at h + simpa only [Real.rpow_natCast] using h + +omit [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] in +@[nolint unusedArguments] +lemma summable_norm_mul_of_square_sums {w : Set H} + (f g : w → ℝ) (hf : Summable (fun i => f i ^ 2)) (hg : Summable (fun i => g i ^ 2)) + (hf_nonneg : ∀ i, 0 ≤ f i) (hg_nonneg : ∀ i, 0 ≤ g i) : + Summable (fun i => f i * g i) := by + apply Real.summable_mul_of_Lp_Lq_of_nonneg holder_two_two hf_nonneg hg_nonneg + · convert hf using 1; ext i; norm_num [Real.rpow_natCast] + · convert hg using 1; ext i; norm_num [Real.rpow_natCast] + +omit [CompleteSpace H] in +theorem tsum_norm_inner_mul_inner_le {w : Set H} (b : HilbertBasis w ℂ H) (x y : H) : + ∑' i : w, ‖⟪x, b i⟫_ℂ‖ * ‖⟪b i, y⟫_ℂ‖ ≤ ‖x‖ * ‖y‖ := by + have hx : HasSum (fun i : w => ‖⟪x, b i⟫_ℂ‖ ^ 2) (‖x‖ ^ 2) := by + convert hasSum_norm_sq_inner_basis b x using 1 + funext i + rw [← inner_conj_symm x (b i), RCLike.norm_conj] + have hy : HasSum (fun i : w => ‖⟪b i, y⟫_ℂ‖ ^ 2) (‖y‖ ^ 2) := hasSum_norm_sq_inner_basis b y + have h := Real.inner_le_Lp_mul_Lq_tsum_of_nonneg + (f := fun i : w => ‖⟪x, b i⟫_ℂ‖) (g := fun i : w => ‖⟪b i, y⟫_ℂ‖) holder_two_two + (fun i => norm_nonneg _) (fun i => norm_nonneg _) + (by convert hx.summable using 1; ext i; norm_num [Real.rpow_natCast]) + (by convert hy.summable using 1; ext i; norm_num [Real.rpow_natCast]) + have hxs : (∑' i : w, ‖⟪x, b i⟫_ℂ‖ ^ (2 : ℝ)) = ‖x‖ ^ 2 := by + convert hx.tsum_eq using 1 + exact tsum_congr fun i => Real.rpow_natCast ‖⟪x, b i⟫_ℂ‖ 2 + have hys : (∑' i : w, ‖⟪b i, y⟫_ℂ‖ ^ (2 : ℝ)) = ‖y‖ ^ 2 := by + convert hy.tsum_eq using 1 + exact tsum_congr fun i => Real.rpow_natCast ‖⟪b i, y⟫_ℂ‖ 2 + calc + ∑' i : w, ‖⟪x, b i⟫_ℂ‖ * ‖⟪b i, y⟫_ℂ‖ ≤ + (∑' i : w, ‖⟪x, b i⟫_ℂ‖ ^ (2 : ℝ)) ^ (1 / 2) * + (∑' i : w, ‖⟪b i, y⟫_ℂ‖ ^ (2 : ℝ)) ^ (1 / 2) := + h + _ = ‖x‖ * ‖y‖ := by + rw [hxs, hys, ← Real.sqrt_eq_rpow, ← Real.sqrt_eq_rpow, Real.sqrt_sq (norm_nonneg _), + Real.sqrt_sq (norm_nonneg _)] + +omit [CompleteSpace H] in +private lemma summable_norm_inner_mul_inner {w : Set H} (b : HilbertBasis w ℂ H) (x y : H) : + Summable (fun i : w => ‖⟪x, b i⟫_ℂ‖ * ‖⟪b i, y⟫_ℂ‖) := by + apply Real.summable_mul_of_Lp_Lq_of_nonneg holder_two_two + (fun i => norm_nonneg _) (fun i => norm_nonneg _) + · have hx := (hasSum_norm_sq_inner_basis b x).summable + convert hx using 1 + funext i + rw [← inner_conj_symm x (b i), RCLike.norm_conj] + exact Real.rpow_natCast ‖⟪b i, x⟫_ℂ‖ 2 + · have hy := (hasSum_norm_sq_inner_basis b y).summable + convert hy using 1; ext i; norm_num [Real.rpow_natCast] + +/-- The diagonal coefficients of a product of two Hilbert–Schmidt operators are absolutely +summable. -/ +theorem summable_diagonal_of_hilbertSchmidt {R S : H →L[ℂ] H} + {w : Set H} (b : HilbertBasis w ℂ H) (hR : IsHilbertSchmidt R) (hS : IsHilbertSchmidt S) : + Summable (fun i : w => ⟪b i, (R * S) (b i)⟫_ℂ) := by + have hRstar : IsHilbertSchmidt (ContinuousLinearMap.adjoint R) := by + rcases hR with ⟨w₀, b₀, hb₀⟩ + exact ⟨w₀, b₀, summable_norm_sq_adjoint_of_summable_norm_sq b₀ hb₀⟩ + have hRb : Summable (fun i : w => ‖(ContinuousLinearMap.adjoint R) (b i)‖ ^ 2) := + summable_norm_sq_apply_of_hilbertBasis w b hRstar + have hSb : Summable (fun i : w => ‖S (b i)‖ ^ 2) := summable_norm_sq_apply_of_hilbertBasis w b hS + have hprod : Summable (fun i : w => + ‖(ContinuousLinearMap.adjoint R) (b i)‖ * ‖S (b i)‖) := + summable_norm_mul_of_square_sums _ _ hRb hSb (fun i => norm_nonneg _) (fun i => norm_nonneg _) + apply Summable.of_norm_bounded hprod + intro i + have hi : ⟪b i, (R * S) (b i)⟫_ℂ = ⟪(ContinuousLinearMap.adjoint R) (b i), S (b i)⟫_ℂ := + (ContinuousLinearMap.adjoint_inner_left R (S (b i)) (b i)).symm + rw [hi] + simpa only [mul_apply_eq_comp] using + norm_inner_le_norm ((ContinuousLinearMap.adjoint R) (b i)) (S (b i)) + +private lemma summable_matrix_of_hilbertSchmidt {R S : H →L[ℂ] H} + {w w' : Set H} (b : HilbertBasis w ℂ H) (c : HilbertBasis w' ℂ H) + (hR : IsHilbertSchmidt R) (hS : IsHilbertSchmidt S) : + Summable (Function.uncurry (fun (i : w) (j : w') => + ⟪(ContinuousLinearMap.adjoint R) (b i), c j⟫_ℂ * ⟪c j, S (b i)⟫_ℂ)) := by + have hRstar : IsHilbertSchmidt (ContinuousLinearMap.adjoint R) := by + rcases hR with ⟨w₀, b₀, hb₀⟩ + exact ⟨w₀, b₀, summable_norm_sq_adjoint_of_summable_norm_sq b₀ hb₀⟩ + have hRb : Summable (fun i : w => ‖(ContinuousLinearMap.adjoint R) (b i)‖ ^ 2) := + summable_norm_sq_apply_of_hilbertBasis w b hRstar + have hSb : Summable (fun i : w => ‖S (b i)‖ ^ 2) := summable_norm_sq_apply_of_hilbertBasis w b hS + have hprod : Summable (fun i : w => + ‖(ContinuousLinearMap.adjoint R) (b i)‖ * ‖S (b i)‖) := + summable_norm_mul_of_square_sums _ _ hRb hSb (fun i => norm_nonneg _) (fun i => norm_nonneg _) + let F : w → w' → ℂ := fun i j => ⟪(ContinuousLinearMap.adjoint R) (b i), c j⟫_ℂ * ⟪c j, S (b i)⟫_ℂ + let M : w → w' → ℝ := fun i j => ‖F i j‖ + have hMrow : ∀ i : w, Summable (M i) := by + intro i + have h := summable_norm_inner_mul_inner c ((ContinuousLinearMap.adjoint R) (b i)) (S (b i)) + simpa [M, F, norm_mul] using h + have hMrow_bound : ∀ i : w, ∑' j : w', M i j ≤ + ‖(ContinuousLinearMap.adjoint R) (b i)‖ * ‖S (b i)‖ := by + intro i + simpa [M, F, norm_mul] using + tsum_norm_inner_mul_inner_le c ((ContinuousLinearMap.adjoint R) (b i)) (S (b i)) + have hMrows : Summable (fun i : w => ∑' j : w', M i j) := + Summable.of_nonneg_of_le (fun i => tsum_nonneg fun j => norm_nonneg _) hMrow_bound hprod + have hMnonneg : 0 ≤ Function.uncurry M := fun _ => norm_nonneg _ + have hM : Summable (Function.uncurry M) := by + rw [summable_prod_of_nonneg hMnonneg]; exact ⟨hMrow, hMrows⟩ + apply Summable.of_norm_bounded hM + rintro ⟨i, j⟩ + exact le_rfl + +private lemma hasSum_matrix_row_of_hilbertSchmidt {R S : H →L[ℂ] H} + {w w' : Set H} (b : HilbertBasis w ℂ H) (c : HilbertBasis w' ℂ H) (i : w) : + HasSum (fun j : w' => ⟪(ContinuousLinearMap.adjoint R) (b i), c j⟫_ℂ * ⟪c j, S (b i)⟫_ℂ) + ⟪b i, (R * S) (b i)⟫_ℂ := by + have h := c.hasSum_inner_mul_inner ((ContinuousLinearMap.adjoint R) (b i)) (S (b i)) + have hi : ⟪(ContinuousLinearMap.adjoint R) (b i), S (b i)⟫_ℂ = ⟪b i, (R * S) (b i)⟫_ℂ := + ContinuousLinearMap.adjoint_inner_left R (S (b i)) (b i) + rwa [hi] at h + +private lemma hasSum_matrix_col_of_hilbertSchmidt {R S : H →L[ℂ] H} + {w w' : Set H} (b : HilbertBasis w ℂ H) (c : HilbertBasis w' ℂ H) (j : w') : + HasSum (fun i : w => ⟪(ContinuousLinearMap.adjoint R) (b i), c j⟫_ℂ * ⟪c j, S (b i)⟫_ℂ) + ⟪c j, (S * R) (c j)⟫_ℂ := by + have h := b.hasSum_inner_mul_inner ((ContinuousLinearMap.adjoint S) (c j)) (R (c j)) + have hR : ∀ i : w, ⟪(ContinuousLinearMap.adjoint R) (b i), c j⟫_ℂ = ⟪b i, R (c j)⟫_ℂ := fun i => + ContinuousLinearMap.adjoint_inner_left R (c j) (b i) + have hS : ∀ i : w, ⟪c j, S (b i)⟫_ℂ = ⟪(ContinuousLinearMap.adjoint S) (c j), b i⟫_ℂ := fun i => + (ContinuousLinearMap.adjoint_inner_left S (b i) (c j)).symm + have hpoint : (fun i : w => ⟪(ContinuousLinearMap.adjoint R) (b i), c j⟫_ℂ * ⟪c j, S (b i)⟫_ℂ) = + (fun i : w => ⟪(ContinuousLinearMap.adjoint S) (c j), b i⟫_ℂ * ⟪b i, R (c j)⟫_ℂ) := by + funext i; rw [hR i, hS i, mul_comm] + have hSR : ⟪(ContinuousLinearMap.adjoint S) (c j), R (c j)⟫_ℂ = ⟪c j, (S * R) (c j)⟫_ℂ := + ContinuousLinearMap.adjoint_inner_left S (R (c j)) (c j) + rw [hpoint, ← hSR] + exact h + +/-- **Basis-swap identity**: the diagonal sum of `R * S` in one basis equals the diagonal sum of +`S * R` in any other. This is the Hilbert–Schmidt Fubini step consumed by `GeneralIdeal.lean`'s +unconditional trace theorem and `GeneralProduct.lean`'s master lemma. -/ +theorem tsum_diagonal_mul_eq_tsum_diagonal_swap {R S : H →L[ℂ] H} + {w w' : Set H} (b : HilbertBasis w ℂ H) (c : HilbertBasis w' ℂ H) + (hR : IsHilbertSchmidt R) (hS : IsHilbertSchmidt S) : + (∑' i : w, ⟪b i, (R * S) (b i)⟫_ℂ) = ∑' j : w', ⟪c j, (S * R) (c j)⟫_ℂ := by + let F : w → w' → ℂ := fun i j => ⟪(ContinuousLinearMap.adjoint R) (b i), c j⟫_ℂ * ⟪c j, S (b i)⟫_ℂ + have hF : Summable (Function.uncurry F) := summable_matrix_of_hilbertSchmidt b c hR hS + have hrow : ∀ i : w, HasSum (F i) ⟪b i, (R * S) (b i)⟫_ℂ := fun i => + hasSum_matrix_row_of_hilbertSchmidt b c i + have hcol : ∀ j : w', HasSum (fun i : w => F i j) ⟪c j, (S * R) (c j)⟫_ℂ := fun j => + hasSum_matrix_col_of_hilbertSchmidt b c j + have hswap := hF.tsum_comm' (fun i => (hrow i).summable) (fun j => (hcol j).summable) + calc + ∑' i : w, ⟪b i, (R * S) (b i)⟫_ℂ = ∑' i : w, ∑' j : w', F i j := + tsum_congr fun i => (hrow i).tsum_eq.symm + _ = ∑' j : w', ∑' i : w, F i j := hswap.symm + _ = ∑' j : w', ⟪c j, (S * R) (c j)⟫_ℂ := tsum_congr fun j => (hcol j).tsum_eq + +/-! ## Quantitative right-multiplication estimate -/ + +/-- **Quantitative right-multiplication-by-a-contraction bound**: for `X` and a contraction `W`, +the Hilbert–Schmidt square sum of `X * W` never exceeds that of `X` itself, in the same basis. -/ +theorem tsum_norm_sq_mul_right_le_of_opNorm_le_one {X W : H →L[ℂ] H} (hW : ‖W‖ ≤ 1) + (hX : IsHilbertSchmidt X) {w : Set H} (b : HilbertBasis w ℂ H) : + (∑' i : w, ‖(X * W) (b i)‖ ^ 2) ≤ ∑' i : w, ‖X (b i)‖ ^ 2 := by + have hXW : IsHilbertSchmidt (X * W) := isHilbertSchmidt_mul_right hX + have hXstar : IsHilbertSchmidt (ContinuousLinearMap.adjoint X) := by + rcases hX with ⟨w₀, b₀, hb₀⟩ + exact ⟨w₀, b₀, summable_norm_sq_adjoint_of_summable_norm_sq b₀ hb₀⟩ + have hXWb : Summable (fun i : w => ‖(X * W) (b i)‖ ^ 2) := + summable_norm_sq_apply_of_hilbertBasis w b hXW + have hXb : Summable (fun i : w => ‖X (b i)‖ ^ 2) := summable_norm_sq_apply_of_hilbertBasis w b hX + have hstep1 : (∑' i : w, ‖(X * W) (b i)‖ ^ 2) = + ∑' i : w, ‖(ContinuousLinearMap.adjoint (X * W)) (b i)‖ ^ 2 := + (hasSum_norm_sq_apply_eq_adjoint b b hXWb).tsum_eq.symm + have hadj : ContinuousLinearMap.adjoint (X * W) = + ContinuousLinearMap.adjoint W * ContinuousLinearMap.adjoint X := by + show ContinuousLinearMap.adjoint (X ∘L W) = _ + rw [ContinuousLinearMap.adjoint_comp]; rfl + have hstep2 : ∀ i : w, + ‖(ContinuousLinearMap.adjoint W * ContinuousLinearMap.adjoint X) (b i)‖ ≤ + ‖(ContinuousLinearMap.adjoint X) (b i)‖ := by + intro i + calc + ‖(ContinuousLinearMap.adjoint W * ContinuousLinearMap.adjoint X) (b i)‖ = + ‖(ContinuousLinearMap.adjoint W) ((ContinuousLinearMap.adjoint X) (b i))‖ := by + rw [ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply] + _ ≤ ‖ContinuousLinearMap.adjoint W‖ * ‖(ContinuousLinearMap.adjoint X) (b i)‖ := + ContinuousLinearMap.le_opNorm _ _ + _ ≤ ‖(ContinuousLinearMap.adjoint X) (b i)‖ := by + have hWadj : ‖ContinuousLinearMap.adjoint W‖ ≤ 1 := by + rw [(ContinuousLinearMap.adjoint).norm_map W]; exact hW + calc ‖ContinuousLinearMap.adjoint W‖ * ‖(ContinuousLinearMap.adjoint X) (b i)‖ ≤ + 1 * ‖(ContinuousLinearMap.adjoint X) (b i)‖ := + mul_le_mul_of_nonneg_right hWadj (norm_nonneg _) + _ = ‖(ContinuousLinearMap.adjoint X) (b i)‖ := one_mul _ + have hXstarb : Summable (fun i : w => ‖(ContinuousLinearMap.adjoint X) (b i)‖ ^ 2) := + summable_norm_sq_apply_of_hilbertBasis w b hXstar + have hcompareSummable : Summable (fun i : w => + ‖(ContinuousLinearMap.adjoint W * ContinuousLinearMap.adjoint X) (b i)‖ ^ 2) := + Summable.of_nonneg_of_le (fun i => sq_nonneg _) + (fun i => (sq_le_sq₀ (norm_nonneg _) (norm_nonneg _)).2 (hstep2 i)) hXstarb + have hcompare : (∑' i : w, ‖(ContinuousLinearMap.adjoint W * ContinuousLinearMap.adjoint X) + (b i)‖ ^ 2) ≤ ∑' i : w, ‖(ContinuousLinearMap.adjoint X) (b i)‖ ^ 2 := + hcompareSummable.tsum_le_tsum + (fun i => (sq_le_sq₀ (norm_nonneg _) (norm_nonneg _)).2 (hstep2 i)) hXstarb + have hstep3 : (∑' i : w, ‖(ContinuousLinearMap.adjoint X) (b i)‖ ^ 2) = ∑' i : w, ‖X (b i)‖ ^ 2 := + (hasSum_norm_sq_apply_eq_adjoint b b hXb).tsum_eq + calc + (∑' i : w, ‖(X * W) (b i)‖ ^ 2) = + ∑' i : w, ‖(ContinuousLinearMap.adjoint (X * W)) (b i)‖ ^ 2 := hstep1 + _ = ∑' i : w, ‖(ContinuousLinearMap.adjoint W * ContinuousLinearMap.adjoint X) (b i)‖ ^ 2 := by + rw [hadj] + _ ≤ ∑' i : w, ‖(ContinuousLinearMap.adjoint X) (b i)‖ ^ 2 := hcompare + _ = ∑' i : w, ‖X (b i)‖ ^ 2 := hstep3 + +/-- The self-adjoint specialization of the right-multiplication bound, needed by +`GeneralIdeal.lean`/`PositiveIdeal`-style conjugation estimates. -/ +theorem tsum_norm_sq_mul_right_le_of_selfAdjoint {S A : H →L[ℂ] H} + (hSself : IsSelfAdjoint S) (hS : IsHilbertSchmidt S) + {w w' : Set H} (b : HilbertBasis w ℂ H) (c : HilbertBasis w' ℂ H) : + (∑' i : w', ‖(S * A) (c i)‖ ^ 2) ≤ ‖A‖ ^ 2 * (∑' j : w, ‖S (b j)‖ ^ 2) := by + let R : H →L[ℂ] H := S * A + have hR : IsHilbertSchmidt R := isHilbertSchmidt_mul_right hS + have hRc : Summable (fun i : w' => ‖R (c i)‖ ^ 2) := + summable_norm_sq_apply_of_hilbertBasis w' c hR + have hEq : HasSum (fun j : w => ‖(ContinuousLinearMap.adjoint R) (b j)‖ ^ 2) + (∑' i : w', ‖R (c i)‖ ^ 2) := hasSum_norm_sq_apply_eq_adjoint c b hRc + have hAdjSummable : Summable (fun j : w => ‖(ContinuousLinearMap.adjoint R) (b j)‖ ^ 2) := + hEq.summable + have hSb : Summable (fun j : w => ‖S (b j)‖ ^ 2) := summable_norm_sq_apply_of_hilbertBasis w b hS + have hRstar : ContinuousLinearMap.adjoint R = ContinuousLinearMap.adjoint A * S := by + rw [show R = S ∘SL A by rfl, ContinuousLinearMap.adjoint_comp] + rw [← ContinuousLinearMap.mul_def, (ContinuousLinearMap.star_eq_adjoint S).symm.trans hSself] + have hpoint : ∀ j : w, ‖(ContinuousLinearMap.adjoint R) (b j)‖ ^ 2 ≤ ‖A‖ ^ 2 * ‖S (b j)‖ ^ 2 := by + intro j + rw [hRstar, ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply] + have hnorm : ‖ContinuousLinearMap.adjoint A‖ = ‖A‖ := (ContinuousLinearMap.adjoint).norm_map A + have hle : ‖ContinuousLinearMap.adjoint A (S (b j))‖ ≤ ‖A‖ * ‖S (b j)‖ := by + rw [← hnorm]; exact ContinuousLinearMap.le_opNorm _ _ + calc + ‖ContinuousLinearMap.adjoint A (S (b j))‖ ^ 2 ≤ (‖A‖ * ‖S (b j)‖) ^ 2 := + (sq_le_sq₀ (norm_nonneg _) (mul_nonneg (norm_nonneg _) (norm_nonneg _))).2 hle + _ = ‖A‖ ^ 2 * ‖S (b j)‖ ^ 2 := by ring + have hscaled : Summable (fun j : w => ‖A‖ ^ 2 * ‖S (b j)‖ ^ 2) := hSb.mul_left (‖A‖ ^ 2) + have hsum : (∑' j : w, ‖(ContinuousLinearMap.adjoint R) (b j)‖ ^ 2) ≤ + ∑' j : w, ‖A‖ ^ 2 * ‖S (b j)‖ ^ 2 := hAdjSummable.tsum_le_tsum hpoint hscaled + calc + ∑' i : w', ‖(S * A) (c i)‖ ^ 2 = ∑' j : w, ‖(ContinuousLinearMap.adjoint R) (b j)‖ ^ 2 := + hEq.tsum_eq.symm + _ ≤ ∑' j : w, ‖A‖ ^ 2 * ‖S (b j)‖ ^ 2 := hsum + _ = ‖A‖ ^ 2 * (∑' j : w, ‖S (b j)‖ ^ 2) := tsum_mul_left + +end HilbertSchmidt + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/TraceClass/IdealNorm.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/TraceClass/IdealNorm.lean new file mode 100644 index 0000000000..38ae5a66a6 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/TraceClass/IdealNorm.lean @@ -0,0 +1,372 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.TraceClass.GeneralProduct + +/-! +# Quantitative trace-norm estimates + +Ported from `unbounded-alpha-public`'s `TraceClass/IdealNorm.lean`. This file promotes the +qualitative general ideal theory of `GeneralProduct.lean` to quantitative inequalities: the trace +norm is subadditive (`Banach.lean`'s `traceNorm_add_le` gap) and satisfies the two-sided ideal +estimate `‖A T B‖₁ ≤ ‖A‖ ‖T‖₁ ‖B‖` (`HilbertSpaceInstance.lean`'s `traceNorm_mul_mul_le` gap). The +common engine is a single "duality" bound: for trace-class `A`, any contraction `W`, and any +Hilbert basis, the pairing `∑ᵢ ‖⟪W eᵢ, A eᵢ⟫‖` never exceeds `‖A‖₁`; specializing `W` to the +identity gives `HilbertSpaceInstance.lean`'s `norm_trace_le` gap directly. +-/ + +@[expose] public section + +noncomputable section + +open scoped ComplexOrder InnerProductSpace +open HilbertSchmidt + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-- Transporting `traceNorm` across an equality of the underlying operator. A small generic helper +needed because `rw` cannot rewrite the operator argument of `traceNorm X hX` directly (its motive +depends on `hX`'s own type). -/ +private lemma traceNorm_transport {X Y : H →L[ℂ] H} (hEq : X = Y) (hX : IsTraceClass X) : + traceNorm X hX = traceNorm Y (hEq ▸ hX) := by + subst hEq; rfl + +/-- The Hilbert–Schmidt square sum of `√|A|` computes the trace norm, in every basis. -/ +theorem tsum_sqrt_abs_norm_sq_eq_traceNorm {A : H →L[ℂ] H} (hA : IsTraceClass A) {w : Set H} + (b : HilbertBasis w ℂ H) : + (∑' i : w, ‖CFC.sqrt (CFC.abs A) (b i)‖ ^ 2) = traceNorm A hA := by + rw [traceNorm_eq_of_hilbertBasis hA b] + refine tsum_congr (fun i => ?_) + set S : H →L[ℂ] H := CFC.sqrt (CFC.abs A) with hSdef + have hSself : IsSelfAdjoint S := .of_nonneg (CFC.sqrt_nonneg (CFC.abs A)) + have hSS : S * S = CFC.abs A := CFC.sqrt_mul_sqrt_self (CFC.abs A) (CFC.abs_nonneg A) + have hinner : ⟪b i, CFC.abs A (b i)⟫_ℂ = ⟪S (b i), S (b i)⟫_ℂ := by + have hSstar : ContinuousLinearMap.adjoint S = S := + (ContinuousLinearMap.star_eq_adjoint S).symm.trans hSself + rw [← hSS, ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply, + ← ContinuousLinearMap.adjoint_inner_left S (S (b i)) (b i), hSstar] + rw [hinner, inner_self_eq_norm_sq_to_K] + norm_cast + +/-- The contraction pairing `i ↦ ⟪W eᵢ, A eᵢ⟫` is absolutely summable, for trace-class `A` and any +contraction `W`. -/ +theorem summable_norm_inner_contraction_of_isTraceClass {A W : H →L[ℂ] H} (hA : IsTraceClass A) + (hW : ‖W‖ ≤ 1) {w : Set H} (b : HilbertBasis w ℂ H) : + Summable (fun i : w => ‖⟪W (b i), A (b i)⟫_ℂ‖) := by + obtain ⟨hUS, hS, hfactor⟩ := isHilbertSchmidt_polarFactor_mul_sqrt_abs_and_sqrt_abs hA + set R : H →L[ℂ] H := Polar.polarFactor A * CFC.sqrt (CFC.abs A) with hRdef + set S : H →L[ℂ] H := CFC.sqrt (CFC.abs A) with hSdef + have hRstar : IsHilbertSchmidt (ContinuousLinearMap.adjoint R) := by + rcases hUS with ⟨w₀, b₀, hb₀⟩ + exact ⟨w₀, b₀, summable_norm_sq_adjoint_of_summable_norm_sq b₀ hb₀⟩ + have hRWb : Summable (fun i : w => ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ ^ 2) := + summable_norm_sq_apply_of_hilbertBasis w b + (isHilbertSchmidt_mul_right_of_opNorm_le_one hW hRstar) + have hSb : Summable (fun i : w => ‖S (b i)‖ ^ 2) := summable_norm_sq_apply_of_hilbertBasis w b hS + have hpoint : ∀ i : w, ⟪W (b i), A (b i)⟫_ℂ = + ⟪(ContinuousLinearMap.adjoint R * W) (b i), S (b i)⟫_ℂ := by + intro i + rw [show A = R * S from hfactor.symm, ContinuousLinearMap.mul_def, + ContinuousLinearMap.comp_apply, ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply, + ContinuousLinearMap.adjoint_inner_left R (S (b i)) (W (b i))] + have hprod : Summable (fun i : w => + ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ * ‖S (b i)‖) := + summable_norm_mul_of_square_sums _ _ hRWb hSb (fun i => norm_nonneg _) (fun i => norm_nonneg _) + apply Summable.of_nonneg_of_le (fun i => norm_nonneg _) (fun i => ?_) hprod + rw [hpoint i] + exact norm_inner_le_norm _ _ + +/-- **The duality bound**: for trace-class `A`, any contraction `W`, and any basis, the pairing +`∑ᵢ ‖⟪W eᵢ, A eᵢ⟫‖` never exceeds `‖A‖₁`. This is the single quantitative estimate feeding +subadditivity of the trace norm, and the general two-sided ideal estimate below. -/ +theorem tsum_norm_inner_contraction_le_traceNorm {A W : H →L[ℂ] H} (hA : IsTraceClass A) + (hW : ‖W‖ ≤ 1) {w : Set H} (b : HilbertBasis w ℂ H) : + (∑' i : w, ‖⟪W (b i), A (b i)⟫_ℂ‖) ≤ traceNorm A hA := by + obtain ⟨hUS, hS, hfactor⟩ := isHilbertSchmidt_polarFactor_mul_sqrt_abs_and_sqrt_abs hA + set R : H →L[ℂ] H := Polar.polarFactor A * CFC.sqrt (CFC.abs A) with hRdef + set S : H →L[ℂ] H := CFC.sqrt (CFC.abs A) with hSdef + have hRstar : IsHilbertSchmidt (ContinuousLinearMap.adjoint R) := by + rcases hUS with ⟨w₀, b₀, hb₀⟩ + exact ⟨w₀, b₀, summable_norm_sq_adjoint_of_summable_norm_sq b₀ hb₀⟩ + have hRWb : Summable (fun i : w => ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ ^ 2) := + summable_norm_sq_apply_of_hilbertBasis w b + (isHilbertSchmidt_mul_right_of_opNorm_le_one hW hRstar) + have hSb : Summable (fun i : w => ‖S (b i)‖ ^ 2) := summable_norm_sq_apply_of_hilbertBasis w b hS + have hUSb : Summable (fun i : w => ‖R (b i)‖ ^ 2) := + summable_norm_sq_apply_of_hilbertBasis w b hUS + have hpoint : ∀ i : w, ⟪W (b i), A (b i)⟫_ℂ = + ⟪(ContinuousLinearMap.adjoint R * W) (b i), S (b i)⟫_ℂ := by + intro i + rw [show A = R * S from hfactor.symm, ContinuousLinearMap.mul_def, + ContinuousLinearMap.comp_apply, ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply, + ContinuousLinearMap.adjoint_inner_left R (S (b i)) (W (b i))] + have hprod : Summable (fun i : w => + ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ * ‖S (b i)‖) := + summable_norm_mul_of_square_sums _ _ hRWb hSb (fun i => norm_nonneg _) (fun i => norm_nonneg _) + have hLHSsummable : Summable (fun i : w => ‖⟪W (b i), A (b i)⟫_ℂ‖) := by + apply Summable.of_nonneg_of_le (fun i => norm_nonneg _) (fun i => ?_) hprod + rw [hpoint i]; exact norm_inner_le_norm _ _ + have hle1 : (∑' i : w, ‖⟪W (b i), A (b i)⟫_ℂ‖) ≤ + ∑' i : w, ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ * ‖S (b i)‖ := + hLHSsummable.tsum_le_tsum (fun i => by rw [hpoint i]; exact norm_inner_le_norm _ _) hprod + have hle2 : (∑' i : w, ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ * ‖S (b i)‖) ≤ + Real.sqrt (∑' i : w, ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ ^ 2) * + Real.sqrt (∑' i : w, ‖S (b i)‖ ^ 2) := + tsum_mul_le_sqrt_mul_sqrt hRWb hSb (fun i => norm_nonneg _) (fun i => norm_nonneg _) + have hRWSq : (∑' i : w, ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ ^ 2) ≤ + ∑' i : w, ‖R (b i)‖ ^ 2 := by + have hstep := tsum_norm_sq_mul_right_le_of_opNorm_le_one (X := ContinuousLinearMap.adjoint R) + hW hRstar b + have hadjR : (∑' i : w, ‖(ContinuousLinearMap.adjoint R) (b i)‖ ^ 2) = + ∑' i : w, ‖R (b i)‖ ^ 2 := (hasSum_norm_sq_apply_eq_adjoint b b hUSb).tsum_eq + rwa [hadjR] at hstep + have hRSq : (∑' i : w, ‖R (b i)‖ ^ 2) ≤ ∑' i : w, ‖S (b i)‖ ^ 2 := by + have hpt : ∀ i : w, ‖R (b i)‖ ^ 2 ≤ ‖S (b i)‖ ^ 2 := by + intro i + have hle : ‖R (b i)‖ ≤ ‖S (b i)‖ := by + rw [hRdef, ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply] + calc ‖Polar.polarFactor A (S (b i))‖ ≤ ‖Polar.polarFactor A‖ * ‖S (b i)‖ := + ContinuousLinearMap.le_opNorm _ _ + _ ≤ 1 * ‖S (b i)‖ := + mul_le_mul_of_nonneg_right (Polar.polarFactor_opNorm_le A) (norm_nonneg _) + _ = ‖S (b i)‖ := one_mul _ + exact (sq_le_sq₀ (norm_nonneg _) (norm_nonneg _)).2 hle + exact hUSb.tsum_le_tsum hpt hSb + have hle3 : Real.sqrt (∑' i : w, ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ ^ 2) ≤ + Real.sqrt (∑' i : w, ‖S (b i)‖ ^ 2) := Real.sqrt_le_sqrt (hRWSq.trans hRSq) + have hnonneg : (0:ℝ) ≤ Real.sqrt (∑' i : w, ‖S (b i)‖ ^ 2) := Real.sqrt_nonneg _ + calc + (∑' i : w, ‖⟪W (b i), A (b i)⟫_ℂ‖) ≤ ∑' i : w, + ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ * ‖S (b i)‖ := hle1 + _ ≤ Real.sqrt (∑' i : w, ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ ^ 2) * + Real.sqrt (∑' i : w, ‖S (b i)‖ ^ 2) := hle2 + _ ≤ Real.sqrt (∑' i : w, ‖S (b i)‖ ^ 2) * Real.sqrt (∑' i : w, ‖S (b i)‖ ^ 2) := + mul_le_mul_of_nonneg_right hle3 hnonneg + _ = ∑' i : w, ‖S (b i)‖ ^ 2 := Real.mul_self_sqrt (tsum_nonneg (fun i => sq_nonneg _)) + _ = traceNorm A hA := tsum_sqrt_abs_norm_sq_eq_traceNorm hA b + +/-- The trace-norm diagonal in the basis `b` equals the norm-diagonal pairing against `T`'s own +polar factor: `⟪eᵢ, |T| eᵢ⟫ = ⟪(polarFactor T) eᵢ, T eᵢ⟫` exactly, and the latter is already a +nonnegative real. -/ +private lemma traceNorm_eq_tsum_norm_inner_polarFactor {T : H →L[ℂ] H} (hT : IsTraceClass T) + {w : Set H} (b : HilbertBasis w ℂ H) : + traceNorm T hT = ∑' i : w, ‖⟪Polar.polarFactor T (b i), T (b i)⟫_ℂ‖ := by + rw [traceNorm_eq_of_hilbertBasis hT b] + refine tsum_congr (fun i => ?_) + have hval : ⟪b i, CFC.abs T (b i)⟫_ℂ = ⟪Polar.polarFactor T (b i), T (b i)⟫_ℂ := by + have habs : CFC.abs T = star (Polar.polarFactor T) * T := (Polar.star_polarFactor_mul_self + T).symm + rw [habs, ContinuousLinearMap.star_eq_adjoint, ContinuousLinearMap.mul_def, + ContinuousLinearMap.comp_apply, + ContinuousLinearMap.adjoint_inner_right (Polar.polarFactor T) (b i) (T (b i))] + have hnonnegre : ‖⟪b i, CFC.abs T (b i)⟫_ℂ‖ = (⟪b i, CFC.abs T (b i)⟫_ℂ).re := by + have hpos : (CFC.abs T).IsPositive := (CFC.abs T).nonneg_iff_isPositive.mp (CFC.abs_nonneg T) + have hx := (ContinuousLinearMap.isPositive_iff_complex (CFC.abs T)).mp hpos (b i) + have h1 : ⟪CFC.abs T (b i), b i⟫_ℂ = ((⟪CFC.abs T (b i), b i⟫_ℂ).re : ℂ) := hx.1.symm + have hre : (⟪CFC.abs T (b i), b i⟫_ℂ).re = (⟪b i, CFC.abs T (b i)⟫_ℂ).re := by + rw [← inner_conj_symm (CFC.abs T (b i)) (b i)]; exact Complex.conj_re _ + have heq : ⟪b i, CFC.abs T (b i)⟫_ℂ = ((⟪b i, CFC.abs T (b i)⟫_ℂ).re : ℂ) := by + calc + ⟪b i, CFC.abs T (b i)⟫_ℂ = (starRingEnd ℂ) ⟪CFC.abs T (b i), b i⟫_ℂ := + (inner_conj_symm (b i) (CFC.abs T (b i))).symm + _ = (starRingEnd ℂ) ((⟪CFC.abs T (b i), b i⟫_ℂ).re : ℂ) := congrArg (starRingEnd ℂ) h1 + _ = ((⟪CFC.abs T (b i), b i⟫_ℂ).re : ℂ) := by simp + _ = ((⟪b i, CFC.abs T (b i)⟫_ℂ).re : ℂ) := by rw [hre] + have hnonneg : 0 ≤ (⟪b i, CFC.abs T (b i)⟫_ℂ).re := by rw [← hre]; exact hx.2 + rw [heq, Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg hnonneg] + simp only [Complex.ofReal_re] + rw [← hnonnegre, hval] + +/-- **Subadditivity of the trace norm.** Closes `Banach.lean`'s `traceNorm_add_le` gap. Conjugating +`T + T'` by its own polar factor `W` splits additively, and each summand is controlled by the +duality bound applied to `T` and `T'` separately. -/ +theorem traceNorm_add_le {T T' : H →L[ℂ] H} (hT : IsTraceClass T) (hT' : IsTraceClass T') + (hTT' : IsTraceClass (T + T')) : + traceNorm (T + T') hTT' ≤ traceNorm T hT + traceNorm T' hT' := by + obtain ⟨w, b, _⟩ := exists_hilbertBasis ℂ H + set W : H →L[ℂ] H := Polar.polarFactor (T + T') with hWdef + have hWnorm : ‖W‖ ≤ 1 := Polar.polarFactor_opNorm_le (T + T') + have heq := traceNorm_eq_tsum_norm_inner_polarFactor hTT' b + have hpt : ∀ i : w, ‖⟪W (b i), (T + T') (b i)⟫_ℂ‖ ≤ + ‖⟪W (b i), T (b i)⟫_ℂ‖ + ‖⟪W (b i), T' (b i)⟫_ℂ‖ := by + intro i + rw [add_apply, inner_add_right] + exact norm_add_le _ _ + have hT1 : Summable (fun i : w => ‖⟪W (b i), T (b i)⟫_ℂ‖) := + summable_norm_inner_contraction_of_isTraceClass hT hWnorm b + have hT2 : Summable (fun i : w => ‖⟪W (b i), T' (b i)⟫_ℂ‖) := + summable_norm_inner_contraction_of_isTraceClass hT' hWnorm b + have hsum : Summable (fun i : w => + ‖⟪W (b i), T (b i)⟫_ℂ‖ + ‖⟪W (b i), T' (b i)⟫_ℂ‖) := hT1.add hT2 + have hTT'sum : Summable (fun i : w => ‖⟪W (b i), (T + T') (b i)⟫_ℂ‖) := + summable_norm_inner_contraction_of_isTraceClass hTT' hWnorm b + calc + traceNorm (T + T') hTT' = ∑' i : w, ‖⟪W (b i), (T + T') (b i)⟫_ℂ‖ := heq + _ ≤ ∑' i : w, (‖⟪W (b i), T (b i)⟫_ℂ‖ + ‖⟪W (b i), T' (b i)⟫_ℂ‖) := + hTT'sum.tsum_le_tsum hpt hsum + _ = (∑' i : w, ‖⟪W (b i), T (b i)⟫_ℂ‖) + ∑' i : w, ‖⟪W (b i), T' (b i)⟫_ℂ‖ := + hT1.tsum_add hT2 + _ ≤ traceNorm T hT + traceNorm T' hT' := + add_le_add (tsum_norm_inner_contraction_le_traceNorm hT hWnorm b) + (tsum_norm_inner_contraction_le_traceNorm hT' hWnorm b) + +/-- **Quantitative master lemma**: the trace norm of a product of two Hilbert–Schmidt operators is +bounded by the product of their Hilbert–Schmidt square-root sums, in any common basis. -/ +theorem traceNorm_mul_le_of_isHilbertSchmidt {R S : H →L[ℂ] H} (hR : IsHilbertSchmidt R) + (hS : IsHilbertSchmidt S) (hRS : IsTraceClass (R * S)) {w : Set H} (b : HilbertBasis w ℂ H) : + traceNorm (R * S) hRS ≤ + Real.sqrt (∑' i : w, ‖R (b i)‖ ^ 2) * Real.sqrt (∑' i : w, ‖S (b i)‖ ^ 2) := by + set W : H →L[ℂ] H := Polar.polarFactor (R * S) with hWdef + have hWnorm : ‖W‖ ≤ 1 := Polar.polarFactor_opNorm_le (R * S) + have hRstar : IsHilbertSchmidt (ContinuousLinearMap.adjoint R) := by + rcases hR with ⟨w₀, b₀, hb₀⟩ + exact ⟨w₀, b₀, summable_norm_sq_adjoint_of_summable_norm_sq b₀ hb₀⟩ + have hRWb : Summable (fun i : w => ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ ^ 2) := + summable_norm_sq_apply_of_hilbertBasis w b + (isHilbertSchmidt_mul_right_of_opNorm_le_one hWnorm hRstar) + have hSb : Summable (fun i : w => ‖S (b i)‖ ^ 2) := summable_norm_sq_apply_of_hilbertBasis w b hS + have hRb : Summable (fun i : w => ‖R (b i)‖ ^ 2) := summable_norm_sq_apply_of_hilbertBasis w b hR + have heq := traceNorm_eq_tsum_norm_inner_polarFactor hRS b + have hpoint : ∀ i : w, ⟪W (b i), (R * S) (b i)⟫_ℂ = + ⟪(ContinuousLinearMap.adjoint R * W) (b i), S (b i)⟫_ℂ := by + intro i + rw [ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply, ContinuousLinearMap.mul_def, + ContinuousLinearMap.comp_apply, + ← ContinuousLinearMap.adjoint_inner_left R (S (b i)) (W (b i))] + have hprod : Summable (fun i : w => + ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ * ‖S (b i)‖) := + summable_norm_mul_of_square_sums _ _ hRWb hSb (fun i => norm_nonneg _) (fun i => norm_nonneg _) + have hle1 : (∑' i : w, ‖⟪W (b i), (R * S) (b i)⟫_ℂ‖) ≤ + ∑' i : w, ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ * ‖S (b i)‖ := by + apply Summable.tsum_le_tsum _ _ hprod + · intro i; rw [hpoint i]; exact norm_inner_le_norm _ _ + · apply Summable.of_nonneg_of_le (fun i => norm_nonneg _) (fun i => ?_) hprod + rw [hpoint i]; exact norm_inner_le_norm _ _ + have hle2 : (∑' i : w, ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ * ‖S (b i)‖) ≤ + Real.sqrt (∑' i : w, ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ ^ 2) * + Real.sqrt (∑' i : w, ‖S (b i)‖ ^ 2) := + tsum_mul_le_sqrt_mul_sqrt hRWb hSb (fun i => norm_nonneg _) (fun i => norm_nonneg _) + have hRWSq : (∑' i : w, ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ ^ 2) ≤ + ∑' i : w, ‖R (b i)‖ ^ 2 := by + have hstep := tsum_norm_sq_mul_right_le_of_opNorm_le_one (X := ContinuousLinearMap.adjoint R) + hWnorm hRstar b + have hadjR : (∑' i : w, ‖(ContinuousLinearMap.adjoint R) (b i)‖ ^ 2) = + ∑' i : w, ‖R (b i)‖ ^ 2 := (hasSum_norm_sq_apply_eq_adjoint b b hRb).tsum_eq + rwa [hadjR] at hstep + have hle3 : Real.sqrt (∑' i : w, ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ ^ 2) ≤ + Real.sqrt (∑' i : w, ‖R (b i)‖ ^ 2) := Real.sqrt_le_sqrt hRWSq + calc + traceNorm (R * S) hRS = ∑' i : w, ‖⟪W (b i), (R * S) (b i)⟫_ℂ‖ := heq + _ ≤ ∑' i : w, ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ * ‖S (b i)‖ := hle1 + _ ≤ Real.sqrt (∑' i : w, ‖(ContinuousLinearMap.adjoint R * W) (b i)‖ ^ 2) * + Real.sqrt (∑' i : w, ‖S (b i)‖ ^ 2) := hle2 + _ ≤ Real.sqrt (∑' i : w, ‖R (b i)‖ ^ 2) * Real.sqrt (∑' i : w, ‖S (b i)‖ ^ 2) := + mul_le_mul_of_nonneg_right hle3 (Real.sqrt_nonneg _) + +/-- **The general two-sided trace-ideal norm estimate.** Closes `HilbertSpaceInstance.lean`'s +`traceNorm_mul_mul_le` gap. Sandwiching a trace-class `T` between bounded `A` and `B` scales the +trace norm by at most `‖A‖ * ‖B‖`. The proof factors `T = R * S` through its own Hilbert–Schmidt +factorization, absorbs `A`, `B` into `R`, `S` respectively, and applies the quantitative master +lemma. -/ +theorem traceNorm_mul_mul_le {A B T : H →L[ℂ] H} (hT : IsTraceClass T) + (hABT : IsTraceClass (A * T * B)) : + traceNorm (A * T * B) hABT ≤ ‖A‖ * traceNorm T hT * ‖B‖ := by + obtain ⟨_, hS, hfactor⟩ := isHilbertSchmidt_polarFactor_mul_sqrt_abs_and_sqrt_abs hT + set R₀ : H →L[ℂ] H := Polar.polarFactor T * CFC.sqrt (CFC.abs T) with hR₀def + set S₀ : H →L[ℂ] H := CFC.sqrt (CFC.abs T) with hS₀def + have hUS : IsHilbertSchmidt R₀ := + isHilbertSchmidt_mul_left_of_opNorm_le_one (Polar.polarFactor_opNorm_le T) hS + have hAR : IsHilbertSchmidt (A * R₀) := isHilbertSchmidt_mul_left hUS + have hSB : IsHilbertSchmidt (S₀ * B) := isHilbertSchmidt_mul_right hS + have heq : A * T * B = (A * R₀) * (S₀ * B) := by + rw [show T = R₀ * S₀ from hfactor.symm]; simp only [mul_assoc] + have hABT' : IsTraceClass ((A * R₀) * (S₀ * B)) := heq ▸ hABT + obtain ⟨w, b, _⟩ := exists_hilbertBasis ℂ H + have hbound := traceNorm_mul_le_of_isHilbertSchmidt hAR hSB hABT' b + have hARsq : (∑' i : w, ‖(A * R₀) (b i)‖ ^ 2) ≤ ‖A‖ ^ 2 * ∑' i : w, ‖R₀ (b i)‖ ^ 2 := by + have hR₀b : Summable (fun i : w => ‖R₀ (b i)‖ ^ 2) := + summable_norm_sq_apply_of_hilbertBasis w b hUS + have hpt : ∀ i : w, ‖(A * R₀) (b i)‖ ^ 2 ≤ ‖A‖ ^ 2 * ‖R₀ (b i)‖ ^ 2 := by + intro i + have hle : ‖(A * R₀) (b i)‖ ≤ ‖A‖ * ‖R₀ (b i)‖ := by + rw [ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply] + exact ContinuousLinearMap.le_opNorm _ _ + calc ‖(A * R₀) (b i)‖ ^ 2 ≤ (‖A‖ * ‖R₀ (b i)‖) ^ 2 := + (sq_le_sq₀ (norm_nonneg _) (mul_nonneg (norm_nonneg _) (norm_nonneg _))).2 hle + _ = ‖A‖ ^ 2 * ‖R₀ (b i)‖ ^ 2 := by ring + calc (∑' i : w, ‖(A * R₀) (b i)‖ ^ 2) ≤ ∑' i : w, ‖A‖ ^ 2 * ‖R₀ (b i)‖ ^ 2 := + (summable_norm_sq_apply_of_hilbertBasis w b hAR).tsum_le_tsum hpt (hR₀b.mul_left _) + _ = ‖A‖ ^ 2 * ∑' i : w, ‖R₀ (b i)‖ ^ 2 := tsum_mul_left + have hSBsq : (∑' i : w, ‖(S₀ * B) (b i)‖ ^ 2) ≤ ‖B‖ ^ 2 * ∑' i : w, ‖S₀ (b i)‖ ^ 2 := by + have hS₀b : Summable (fun i : w => ‖S₀ (b i)‖ ^ 2) := + summable_norm_sq_apply_of_hilbertBasis w b hS + by_cases hB0 : ‖B‖ = 0 + · have hBzero : B = 0 := norm_eq_zero.mp hB0 + simp [hBzero] + · have hBcontr : ‖(‖B‖⁻¹ : ℂ) • B‖ ≤ 1 := by + rw [norm_smul, norm_inv, Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg (norm_nonneg B), + inv_mul_cancel₀ hB0] + have hstep := tsum_norm_sq_mul_right_le_of_opNorm_le_one + (X := S₀) (W := (‖B‖⁻¹ : ℂ) • B) hBcontr hS b + have heqB : (fun i : w => ‖(S₀ * ((‖B‖⁻¹ : ℂ) • B)) (b i)‖ ^ 2) = + fun i : w => ‖B‖⁻¹ ^ 2 * ‖(S₀ * B) (b i)‖ ^ 2 := by + funext i + have h1 : (S₀ * ((‖B‖⁻¹ : ℂ) • B)) (b i) = (‖B‖⁻¹ : ℂ) • (S₀ * B) (b i) := by + rw [ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply, + smul_apply, map_smul, ContinuousLinearMap.mul_def, + ContinuousLinearMap.comp_apply] + rw [h1, norm_smul, norm_inv, Complex.norm_real, Real.norm_eq_abs, + abs_of_nonneg (norm_nonneg B), mul_pow] + rw [heqB] at hstep + have htsum_smul : (∑' i : w, ‖B‖⁻¹ ^ 2 * ‖(S₀ * B) (b i)‖ ^ 2) = + ‖B‖⁻¹ ^ 2 * ∑' i : w, ‖(S₀ * B) (b i)‖ ^ 2 := tsum_mul_left + rw [htsum_smul] at hstep + have hfinal : ‖B‖⁻¹ ^ 2 * (∑' i : w, ‖(S₀ * B) (b i)‖ ^ 2) ≤ ∑' i : w, ‖S₀ (b i)‖ ^ 2 := hstep + calc (∑' i : w, ‖(S₀ * B) (b i)‖ ^ 2) + = ‖B‖ ^ 2 * (‖B‖⁻¹ ^ 2 * ∑' i : w, ‖(S₀ * B) (b i)‖ ^ 2) := by field_simp + _ ≤ ‖B‖ ^ 2 * ∑' i : w, ‖S₀ (b i)‖ ^ 2 := mul_le_mul_of_nonneg_left hfinal (sq_nonneg _) + have hS₀Sq : (∑' i : w, ‖S₀ (b i)‖ ^ 2) = traceNorm T hT := + tsum_sqrt_abs_norm_sq_eq_traceNorm hT b + calc + traceNorm (A * T * B) hABT = traceNorm ((A * R₀) * (S₀ * B)) hABT' := + (traceNorm_transport heq hABT).trans traceNorm_congr + _ ≤ Real.sqrt (∑' i : w, ‖(A * R₀) (b i)‖ ^ 2) * Real.sqrt (∑' i : w, ‖(S₀ * B) (b i)‖ ^ 2) := + hbound + _ ≤ Real.sqrt (‖A‖ ^ 2 * ∑' i : w, ‖R₀ (b i)‖ ^ 2) * + Real.sqrt (‖B‖ ^ 2 * ∑' i : w, ‖S₀ (b i)‖ ^ 2) := + mul_le_mul (Real.sqrt_le_sqrt hARsq) (Real.sqrt_le_sqrt hSBsq) (Real.sqrt_nonneg _) + (Real.sqrt_nonneg _) + _ = ‖A‖ * Real.sqrt (∑' i : w, ‖R₀ (b i)‖ ^ 2) * + (‖B‖ * Real.sqrt (∑' i : w, ‖S₀ (b i)‖ ^ 2)) := by + rw [Real.sqrt_mul (sq_nonneg _), Real.sqrt_mul (sq_nonneg _), Real.sqrt_sq (norm_nonneg A), + Real.sqrt_sq (norm_nonneg B)] + _ ≤ ‖A‖ * Real.sqrt (traceNorm T hT) * (‖B‖ * Real.sqrt (∑' i : w, ‖S₀ (b i)‖ ^ 2)) := by + gcongr + · calc (∑' i : w, ‖R₀ (b i)‖ ^ 2) ≤ ∑' i : w, ‖S₀ (b i)‖ ^ 2 := by + have hS₀b : Summable (fun i : w => ‖S₀ (b i)‖ ^ 2) := + summable_norm_sq_apply_of_hilbertBasis w b hS + have hpt : ∀ i : w, ‖R₀ (b i)‖ ^ 2 ≤ ‖S₀ (b i)‖ ^ 2 := by + intro i + have hle : ‖R₀ (b i)‖ ≤ ‖S₀ (b i)‖ := by + rw [hR₀def, ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply] + calc ‖Polar.polarFactor T (S₀ (b i))‖ ≤ ‖Polar.polarFactor T‖ * ‖S₀ (b i)‖ := + ContinuousLinearMap.le_opNorm _ _ + _ ≤ 1 * ‖S₀ (b i)‖ := + mul_le_mul_of_nonneg_right (Polar.polarFactor_opNorm_le T) + (norm_nonneg _) + _ = ‖S₀ (b i)‖ := one_mul _ + exact (sq_le_sq₀ (norm_nonneg _) (norm_nonneg _)).2 hle + exact (summable_norm_sq_apply_of_hilbertBasis w b hUS).tsum_le_tsum hpt hS₀b + _ = traceNorm T hT := hS₀Sq + _ = ‖A‖ * Real.sqrt (traceNorm T hT) * (‖B‖ * Real.sqrt (traceNorm T hT)) := by rw [hS₀Sq] + _ = ‖A‖ * traceNorm T hT * ‖B‖ := by + rw [show ‖A‖ * Real.sqrt (traceNorm T hT) * (‖B‖ * Real.sqrt (traceNorm T hT)) = + ‖A‖ * ‖B‖ * (Real.sqrt (traceNorm T hT) * Real.sqrt (traceNorm T hT)) by ring, + Real.mul_self_sqrt (traceNorm_nonneg T hT)] + ring + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/TraceClass/Polar.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/TraceClass/Polar.lean new file mode 100644 index 0000000000..d058fd1a19 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/TraceClass/Polar.lean @@ -0,0 +1,242 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.TraceClass.Basic +public import Mathlib.Analysis.Normed.Operator.Extend +public import Mathlib.Analysis.InnerProductSpace.Projection.Basic + +/-! +# Polar decomposition for bounded operators + +Ported from `unbounded-alpha-public`'s `TraceClass/Polar.lean`, restated against this repo's +`H →L[ℂ] H` (no bundled trace-class subtype involved at all here — this file only uses `CFC.abs`). + +For a bounded operator `T`, its absolute value `S = |T|` satisfies `‖T x‖ = ‖S x‖`. The resulting +isometry from `range S` to `H` is extended to the closure of that range, producing a genuine +partial isometry `polarFactor T` with `polarFactor T * |T| = T` and, crucially, +`star (polarFactor T) * T = |T|` for *every* bounded `T` — the fact that finally lets trace-class +theory cross the non-self-adjoint boundary in `GeneralIdeal.lean`/`GeneralProduct.lean`. +-/ + +@[expose] public section + +noncomputable section + +open scoped ComplexOrder InnerProductSpace + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +namespace Polar + +/-- The absolute value used in the polar construction. -/ +noncomputable def absOperator (T : H →L[ℂ] H) : H →L[ℂ] H := CFC.abs T + +/-- The closed range subspace of the absolute value. -/ +noncomputable def rangeClosure (T : H →L[ℂ] H) : Submodule ℂ H := + (LinearMap.range (absOperator T).toLinearMap).topologicalClosure + +/-- The absolute value, with codomain restricted to its closed range. -/ +noncomputable def absIntoRange (T : H →L[ℂ] H) : H →ₗ[ℂ] rangeClosure T := + (absOperator T).toLinearMap.codRestrict (rangeClosure T) (by + intro x + exact Submodule.le_topologicalClosure _ (LinearMap.mem_range_self _ x)) + +/-- The inclusion of `range |T|` into its closed range, bundled continuously. -/ +noncomputable def rangeInClosure (T : H →L[ℂ] H) : + (LinearMap.range (absOperator T).toLinearMap) →L[ℂ] rangeClosure T := + (LinearMap.range (absOperator T).toLinearMap).subtypeL.codRestrict + (rangeClosure T) (by + intro x + exact Submodule.le_topologicalClosure _ x.property) + +lemma rangeInClosure_apply (T : H →L[ℂ] H) (x : LinearMap.range (absOperator T).toLinearMap) : + (rangeInClosure T x : H) = x := rfl + +lemma denseRange_rangeInClosure (T : H →L[ℂ] H) : DenseRange (rangeInClosure T) := by + rw [denseRange_iff_closure_range] + ext y + rw [closure_subtype] + have hrange : + (Subtype.val '' Set.range (rangeInClosure T)) = + (LinearMap.range (absOperator T).toLinearMap : Set H) := by + ext x + constructor + · rintro ⟨z, ⟨y, hy⟩, rfl⟩ + rw [← hy] + change (y : H) ∈ LinearMap.range (absOperator T).toLinearMap + exact y.property + · intro hx + let y : LinearMap.range (absOperator T).toLinearMap := ⟨x, hx⟩ + refine ⟨⟨x, Submodule.le_topologicalClosure _ hx⟩, ⟨y, ?_⟩, ?_⟩ + · exact Subtype.ext rfl + · rfl + rw [hrange, ← Submodule.topologicalClosure_coe] + simp only [Set.mem_univ, iff_true] + exact y.property + +lemma absIntoRange_factor (T : H →L[ℂ] H) (x : H) : + absIntoRange T x = rangeInClosure T ⟨absOperator T x, LinearMap.mem_range_self _ x⟩ := rfl + +lemma denseRange_absIntoRange (T : H →L[ℂ] H) : DenseRange (absIntoRange T) := by + let r : H →L[ℂ] (LinearMap.range (absOperator T).toLinearMap) := + (absOperator T).toLinearMap.codRestrict (LinearMap.range (absOperator T).toLinearMap) + (fun x => LinearMap.mem_range_self _ x) |>.mkContinuous + ‖absOperator T‖ (by intro x; exact (absOperator T).le_opNorm x) + have hr : DenseRange r := by + apply Function.Surjective.denseRange + intro y + rcases y with ⟨y, ⟨x, hx⟩⟩ + exact ⟨x, Subtype.ext hx⟩ + have hcomp := DenseRange.comp (denseRange_rangeInClosure T) hr (rangeInClosure T).continuous + have heq : (rangeInClosure T ∘ r) = absIntoRange T := by + funext x; exact Subtype.ext rfl + rwa [heq] at hcomp + +lemma absIntoRange_apply (T : H →L[ℂ] H) (x : H) : (absIntoRange T x : H) = absOperator T x := rfl + +lemma norm_apply_eq_norm_abs_apply (T : H →L[ℂ] H) (x : H) : ‖T x‖ = ‖absOperator T x‖ := by + have hsq : ‖T x‖ ^ 2 = ‖absOperator T x‖ ^ 2 := by + have hnormT : ‖T x‖ ^ 2 = (⟪T x, T x⟫_ℂ).re := by rw [inner_self_eq_norm_sq_to_K]; norm_cast + have hnormS : ‖absOperator T x‖ ^ 2 = (⟪absOperator T x, absOperator T x⟫_ℂ).re := by + rw [inner_self_eq_norm_sq_to_K]; norm_cast + have hT : ⟪T x, T x⟫_ℂ = ⟪x, (ContinuousLinearMap.adjoint T) (T x)⟫_ℂ := + (ContinuousLinearMap.adjoint_inner_right T x (T x)).symm + have hstar : ContinuousLinearMap.adjoint T = star T := + (ContinuousLinearMap.star_eq_adjoint T).symm + have habs : absOperator T * absOperator T = star T * T := by + unfold absOperator; exact CFC.abs_mul_abs T + have habsSelf : IsSelfAdjoint (absOperator T) := .of_nonneg (CFC.abs_nonneg T) + rw [hnormT, hnormS] + calc + (⟪T x, T x⟫_ℂ).re = (⟪x, (star T * T) x⟫_ℂ).re := by + rw [hT, hstar]; simp [ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply] + _ = (⟪x, (absOperator T * absOperator T) x⟫_ℂ).re := by rw [habs] + _ = (⟪absOperator T x, absOperator T x⟫_ℂ).re := by + rw [ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply, + ← ContinuousLinearMap.adjoint_inner_left (absOperator T) (absOperator T x) x, + (ContinuousLinearMap.star_eq_adjoint (absOperator T)).symm.trans habsSelf] + exact (sq_eq_sq₀ (norm_nonneg _) (norm_nonneg _)).mp hsq + +lemma norm_absIntoRange_apply (T : H →L[ℂ] H) (x : H) : + ‖absIntoRange T x‖ = ‖absOperator T x‖ := rfl + +/-- The closed-range subspace is complete, so it admits the orthogonal projection used to define +the bounded polar factor. -/ +noncomputable instance instCompleteSpaceRangeClosure (T : H →L[ℂ] H) : + CompleteSpace (rangeClosure T) := by + let : IsClosed (rangeClosure T : Set H) := Submodule.isClosed_topologicalClosure _ + exact IsClosed.completeSpace_coe + +/-- The polar factor on the closed range of `|T|`. -/ +noncomputable def polarOnRange (T : H →L[ℂ] H) : rangeClosure T →L[ℂ] H := + T.toLinearMap.extendOfNorm (absIntoRange T) + +lemma polarOnRange_eq_on_abs (T : H →L[ℂ] H) (x : H) : + polarOnRange T (absIntoRange T x) = T x := by + unfold polarOnRange + apply LinearMap.extendOfNorm_eq (denseRange_absIntoRange T) + refine ⟨1, fun y => ?_⟩ + rw [one_mul, norm_absIntoRange_apply] + exact (norm_apply_eq_norm_abs_apply T y).le + +lemma polarOnRange_norm_le (T : H →L[ℂ] H) (x : rangeClosure T) : ‖polarOnRange T x‖ ≤ ‖x‖ := by + have hnorm : ∀ y : H, ‖T y‖ ≤ 1 * ‖absIntoRange T y‖ := by + intro y + rw [one_mul, norm_absIntoRange_apply] + exact (norm_apply_eq_norm_abs_apply T y).le + change ‖T.toLinearMap.extendOfNorm (absIntoRange T) x‖ ≤ ‖x‖ + simpa only [one_mul] using LinearMap.norm_extendOfNorm_apply_le (denseRange_absIntoRange T) 1 + hnorm x + +/-- The bounded polar factor, obtained by extending the range isometry by zero on the orthogonal +complement of `closure (range |T|)`. -/ +noncomputable def polarFactor (T : H →L[ℂ] H) : H →L[ℂ] H := + polarOnRange T ∘L (rangeClosure T).orthogonalProjectionOnto + +lemma polarFactor_eq_on_abs (T : H →L[ℂ] H) (x : H) : polarFactor T (absOperator T x) = T x := by + unfold polarFactor + rw [ContinuousLinearMap.comp_apply] + have hx : absOperator T x ∈ rangeClosure T := + Submodule.le_topologicalClosure _ (LinearMap.mem_range_self _ x) + have hp := (rangeClosure T).orthogonalProjectionOnto_mem_subspace_eq_self ⟨absOperator T x, hx⟩ + rw [hp] + exact polarOnRange_eq_on_abs T x + +lemma polarFactor_norm_le (T : H →L[ℂ] H) (x : H) : ‖polarFactor T x‖ ≤ ‖x‖ := by + unfold polarFactor + rw [ContinuousLinearMap.comp_apply] + calc + ‖polarOnRange T ((rangeClosure T).orthogonalProjectionOnto x)‖ ≤ + ‖(rangeClosure T).orthogonalProjectionOnto x‖ := polarOnRange_norm_le T _ + _ ≤ ‖x‖ := (rangeClosure T).norm_orthogonalProjectionOnto_apply_le x + +theorem polarFactor_opNorm_le (T : H →L[ℂ] H) : ‖polarFactor T‖ ≤ 1 := by + apply ContinuousLinearMap.opNorm_le_bound _ zero_le_one + simpa only [one_mul] using polarFactor_norm_le T + +theorem polarFactor_mul_absOperator (T : H →L[ℂ] H) : polarFactor T * absOperator T = T := by + ext x; exact polarFactor_eq_on_abs T x + +/-! ### The partial-isometry adjoint identity -/ + +theorem polarOnRange_norm_eq (T : H →L[ℂ] H) (y : rangeClosure T) : + ‖polarOnRange T y‖ = ‖y‖ := by + have heq : (fun y : rangeClosure T => ‖polarOnRange T y‖) ∘ (absIntoRange T) = + (fun y : rangeClosure T => ‖y‖) ∘ (absIntoRange T) := by + funext x + show ‖polarOnRange T (absIntoRange T x)‖ = ‖absIntoRange T x‖ + rw [polarOnRange_eq_on_abs, norm_apply_eq_norm_abs_apply, norm_absIntoRange_apply] + have hres := (denseRange_absIntoRange T).equalizer ((polarOnRange T).continuous.norm) + continuous_norm heq + exact congrFun hres y + +/-- `polarOnRange T` is a genuine isometry of `rangeClosure T` into `H`: its adjoint is a left +inverse. -/ +theorem adjoint_polarOnRange_comp_self (T : H →L[ℂ] H) : + ContinuousLinearMap.adjoint (polarOnRange T) ∘L polarOnRange T = 1 := + (ContinuousLinearMap.norm_map_iff_adjoint_comp_self (polarOnRange T)).mp + (polarOnRange_norm_eq T) + +/-- `star (polarFactor T) * polarFactor T` is exactly the orthogonal projection onto +`rangeClosure T`. -/ +theorem star_polarFactor_mul_polarFactor (T : H →L[ℂ] H) : + star (polarFactor T) * polarFactor T = (rangeClosure T).starProjection := by + rw [ContinuousLinearMap.star_eq_adjoint] + show ContinuousLinearMap.adjoint + (polarOnRange T ∘L (rangeClosure T).orthogonalProjectionOnto) * + (polarOnRange T ∘L (rangeClosure T).orthogonalProjectionOnto) = + (rangeClosure T).starProjection + rw [ContinuousLinearMap.adjoint_comp, ContinuousLinearMap.mul_def, + ContinuousLinearMap.comp_assoc, + ← ContinuousLinearMap.comp_assoc (ContinuousLinearMap.adjoint (polarOnRange T)), + adjoint_polarOnRange_comp_self, ContinuousLinearMap.one_def, + Submodule.adjoint_orthogonalProjectionOnto] + simp only [ContinuousLinearMap.id_comp] + rfl + +/-- **The general partial-isometry identity**: `star (polarFactor T) * T = |T|`, for *every* +bounded `T`. This is the fact that finally lets the trace ideal cross the non-self-adjoint +boundary: conjugating `T` on the left by `star (polarFactor T)` recovers the absolute value +exactly, not merely up to a norm bound. -/ +theorem star_polarFactor_mul_self (T : H →L[ℂ] H) : star (polarFactor T) * T = absOperator T := by + have hT : polarFactor T * absOperator T = T := polarFactor_mul_absOperator T + have hproj : star (polarFactor T) * T = (rangeClosure T).starProjection * absOperator T := by + calc + star (polarFactor T) * T = star (polarFactor T) * (polarFactor T * absOperator T) := by + rw [hT] + _ = (star (polarFactor T) * polarFactor T) * absOperator T := by rw [mul_assoc] + _ = (rangeClosure T).starProjection * absOperator T := by + rw [star_polarFactor_mul_polarFactor] + rw [hproj] + ext x + show (rangeClosure T).starProjection (absOperator T x) = absOperator T x + exact Submodule.starProjection_eq_self_iff.mpr + (Submodule.le_topologicalClosure _ (LinearMap.mem_range_self _ x)) + +end Polar + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/AnalyticVector/Basic.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/AnalyticVector/Basic.lean new file mode 100644 index 0000000000..7aeb0db498 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/AnalyticVector/Basic.lean @@ -0,0 +1,1395 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Physlib.QuantumMechanics.Operators.Unbounded +public import Physlib.QuantumMechanics.Operators.SpectralTheory.Symmetric +public import Physlib.QuantumMechanics.Operators.SpectralTheory.SelfAdjoint +public import Mathlib.Analysis.Calculus.Deriv.Pow +public import Mathlib.Analysis.Calculus.Deriv.Mul +public import Mathlib.Analysis.Calculus.SmoothSeries +public import Mathlib.Analysis.Complex.RealDeriv +public import Mathlib.Analysis.InnerProductSpace.Calculus +public import Mathlib.Analysis.SpecificLimits.Normed +public import Mathlib.Analysis.SpecialFunctions.ExpDeriv +public import Mathlib.Order.Filter.AtTopBot.Ring + +/-! +# Analytic vectors for an unbounded operator (part 1 of Nelson's analytic-vector theorem) + +This covers the `IsAnalyticVector`/`IteratesSeq` +definitions and the radius-controlled vector-valued exponential series `analyticExp` (summability, +derivative, algebraic comparison lemmas), together with the norm-preservation and deficiency-space +vanishing lemmas that feed the global-orbit essential-self-adjointness criterion +(`IsSymmetric.isEssentiallySelfAdjoint_of_denseEntireVectors`) — part 1 of Nelson's analytic-vector +theorem (Reed–Simon Vol. II, Thm X.39). + +## Main definitions + +- `IteratesSeq`, `IsAnalyticVector`, `AnalyticVectorWitness`, `IsEntireVector` : the analytic- and + entire-vector notions for a `LinearPMap`, and the proof-relevant witness structure. +- `analyticExp` / `analyticExpTerm` : the local vector-valued exponential series built from an + iterate witness. + +## Main results + +- `analyticExp_norm_eq_norm` : the local exponential orbit of a symmetric operator's analytic + vector preserves norm. +- `IsSymmetric.isEssentiallySelfAdjoint_of_denseEntireVectors` : a dense family of entire vectors + is sufficient for essential self-adjointness. +-/ + +@[expose] public section + +noncomputable section + +namespace LinearPMap + +open scoped InnerProductSpace Topology +open Filter + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-! ## The definition -/ + +/-- `v` is the iterate sequence of `x` under `T`: `v 0 = x` and `v (n+1) = T (v n)`, as elements +of `T.domain` (so this packages, in particular, the assertion that `x` lies in the domain of every +power `Tⁿ`). Since `T` is single-valued, `v` is uniquely determined by `x` whenever it exists at +all. -/ +def IteratesSeq (T : H →ₗ.[ℂ] H) (x : H) (v : ℕ → T.domain) : Prop := + (v 0 : H) = x ∧ ∀ n, (v (n + 1) : H) = T (v n) + +omit [CompleteSpace H] in +@[nolint unusedArguments] +lemma IteratesSeq.ext {T : H →ₗ.[ℂ] H} {x : H} {v w : ℕ → T.domain} + (hv : IteratesSeq T x v) (hw : IteratesSeq T x w) : + ∀ n, (v n : H) = (w n : H) := by + intro n + induction n with + | zero => exact hv.1.trans hw.1.symm + | succ n ih => + calc + (v (n + 1) : H) = T (v n) := hv.2 n + _ = T (w n) := by + congr 1 + exact Subtype.ext ih + _ = (w (n + 1) : H) := (hw.2 n).symm + +/-- **Analytic vector** (Reed–Simon Vol. II, §X.6). `x` is an analytic vector for `T` if it lies +in the domain of every iterated power `Tⁿ` (witnessed by an iterate sequence `v`, so `v n` +represents `Tⁿ x`) and the exponential-type series `∑ ‖Tⁿx‖ tⁿ / n!` converges for some `t > 0`. -/ +def IsAnalyticVector (T : H →ₗ.[ℂ] H) (x : H) : Prop := + ∃ v : ℕ → T.domain, IteratesSeq T x v ∧ + ∃ t : ℝ, 0 < t ∧ Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial) + +/-- The data hidden by `IsAnalyticVector`, retained as a structure for recursive continuation. +The proposition is ideal for stating density assumptions; this structure is the corresponding +proof-relevant package needed to name the next exponential chart. -/ +structure AnalyticVectorWitness (T : H →ₗ.[ℂ] H) where + /-- The vector the witness is analytic for. -/ + state : H + /-- The iterate sequence witnessing `Tⁿ state`. -/ + iterates : ℕ → T.domain + iterates_spec : IteratesSeq T state iterates + /-- The radius at which the majorant series is known to converge. -/ + radius : ℝ + radius_pos : 0 < radius + summable : Summable (fun n => ‖(iterates n : H)‖ * radius ^ n / n.factorial) + +omit [CompleteSpace H] in +@[nolint unusedArguments] +lemma AnalyticVectorWitness.isAnalytic {T : H →ₗ.[ℂ] H} (W : AnalyticVectorWitness T) : + T.IsAnalyticVector W.state := + ⟨W.iterates, W.iterates_spec, W.radius, W.radius_pos, W.summable⟩ + +/-- Extracts an explicit `AnalyticVectorWitness` from a proof that `x` is an analytic vector. -/ +noncomputable def AnalyticVectorWitness.ofIsAnalytic + {T : H →ₗ.[ℂ] H} {x : H} (h : T.IsAnalyticVector x) : AnalyticVectorWitness T := by + let v : ℕ → T.domain := Classical.choose h + have hv : IteratesSeq T x v := (Classical.choose_spec h).1 + let t : ℝ := Classical.choose (Classical.choose_spec h).2 + have ht : 0 < t := (Classical.choose_spec (Classical.choose_spec h).2).1 + have hsum : Summable (fun n : ℕ => ‖(v n : H)‖ * t ^ n / n.factorial) := + (Classical.choose_spec (Classical.choose_spec h).2).2 + exact ⟨x, v, hv, t, ht, hsum⟩ + +/-- An entire vector has an iterate witness whose factorial majorant converges at every positive +radius. This is stronger than `IsAnalyticVector`; it is the class on which the local exponential +series can be evaluated at arbitrary real times without the global patching argument. -/ +def IsEntireVector (T : H →ₗ.[ℂ] H) (x : H) : Prop := + ∃ v : ℕ → T.domain, IteratesSeq T x v ∧ + ∀ t : ℝ, 0 < t → Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial) + +/-! ## The local exponential series -/ + +/-- The `n`th term of the formal exponential orbit of an analytic vector. The factor is written +with the `I • T` convention used by Stone's theorem: for a real time `s` it is +`(I * s)^n / n! • T^n x`. Keeping the iterate witness explicit is useful because a +`LinearPMap` power is only defined on a nested domain. -/ +def analyticExpTerm (T : H →ₗ.[ℂ] H) (v : ℕ → T.domain) (s : ℝ) (n : ℕ) : H := + (((Complex.I * (s : ℂ)) ^ n) / n.factorial) • (v n : H) + +/-- The formal local exponential orbit associated to an iterate witness. It is deliberately a +`tsum`, rather than a new bundled operator: convergence is supplied by +`IsAnalyticVector.summable_analyticExpTerm` below, while later Nelson/Stone developments can add +the local semigroup laws without changing this scalar-series interface. -/ +def analyticExp (T : H →ₗ.[ℂ] H) (v : ℕ → T.domain) (s : ℝ) : H := + ∑' n, analyticExpTerm T v s n + +omit [CompleteSpace H] in +lemma analyticExp_congr_iterates {T : H →ₗ.[ℂ] H} {x : H} + {v w : ℕ → T.domain} (hv : IteratesSeq T x v) (hw : IteratesSeq T x w) (s : ℝ) : + analyticExp T v s = analyticExp T w s := by + unfold analyticExp + congr 1 + funext n + simp only [analyticExpTerm, IteratesSeq.ext hv hw n] + +omit [CompleteSpace H] in +lemma norm_analyticExpTerm (T : H →ₗ.[ℂ] H) (v : ℕ → T.domain) (s : ℝ) (n : ℕ) : + ‖analyticExpTerm T v s n‖ = ‖(v n : H)‖ * |s| ^ n / n.factorial := by + unfold analyticExpTerm + rw [norm_smul, norm_div, norm_pow, norm_mul, Complex.norm_I, one_mul, Complex.norm_real, + Real.norm_eq_abs, Complex.norm_natCast] + ring + +/-- The formal derivative of an exponential-series term with respect to its real time parameter. +The `n - 1` convention makes the definition uniform at `n = 0`, where the leading factor `n` +annihilates the term. -/ +def analyticExpDerivTerm (T : H →ₗ.[ℂ] H) (v : ℕ → T.domain) (s : ℝ) (n : ℕ) : H := + (((n : ℂ) * Complex.I * (Complex.I * (s : ℂ)) ^ (n - 1)) / n.factorial) • (v n : H) + +omit [CompleteSpace H] in +lemma analyticExpTerm_hasDerivAt (T : H →ₗ.[ℂ] H) (v : ℕ → T.domain) (s : ℝ) (n : ℕ) : + HasDerivAt (fun r : ℝ => analyticExpTerm T v r n) + (analyticExpDerivTerm T v s n) s := by + have hbase : HasDerivAt (fun r : ℝ => Complex.I * (r : ℂ)) Complex.I s := by + have hreal : HasDerivAt (fun r : ℝ => (r : ℂ)) 1 s := by + change HasDerivAt (⇑Complex.ofRealCLM) (Complex.ofRealCLM 1) s + exact Complex.ofRealCLM.hasDerivAt + simpa using hreal.const_mul Complex.I + have hpow := hbase.pow n + have hcoeff := hpow.div_const (n.factorial : ℂ) + have hterm := HasDerivAt.smul_const hcoeff (v n : H) + convert hterm using 1 <;> simp only [analyticExpTerm, analyticExpDerivTerm] + · funext r + rfl + · ring_nf + +omit [CompleteSpace H] in +lemma norm_analyticExpDerivTerm (T : H →ₗ.[ℂ] H) (v : ℕ → T.domain) (s : ℝ) (n : ℕ) : + ‖analyticExpDerivTerm T v s n‖ = + ‖(v n : H)‖ * n * |s| ^ (n - 1) / n.factorial := by + unfold analyticExpDerivTerm + simp only [norm_smul, norm_div, norm_mul, norm_pow, Complex.norm_natCast, + Complex.norm_I, Complex.norm_real, Real.norm_eq_abs] + ring + +lemma analyticExp_hasDerivAt_of_mem_half_radius + {T : H →ₗ.[ℂ] H} {v : ℕ → T.domain} {t s : ℝ} (ht : 0 < t) + (hs : s ∈ Set.Ioo (-t / 2) (t / 2)) + (hsum : Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial)) : + HasDerivAt (fun r : ℝ => analyticExp T v r) + (∑' n, analyticExpDerivTerm T v s n) s := by + have ht0 : 0 ≤ t := ht.le + have hnat : ∀ k : ℕ, (k + 1 : ℝ) ≤ (2 : ℝ) ^ (k + 1) := by + intro k + induction k with + | zero => norm_num + | succ k ih => + calc + (↑(Nat.succ k) + 1 : ℝ) = (k + 1 + 1 : ℝ) := by norm_num + _ ≤ 2 * (k + 1 : ℝ) := by + have hk : (0 : ℝ) ≤ k := by positivity + linarith + _ ≤ 2 * (2 : ℝ) ^ (k + 1) := by gcongr + _ = (2 : ℝ) ^ (k + 2) := by ring + have hderiv_bound : ∀ (n : ℕ) (y : ℝ), y ∈ Set.Ioo (-t / 2) (t / 2) → + ‖analyticExpDerivTerm T v y n‖ ≤ + (2 / t) * (‖(v n : H)‖ * t ^ n / n.factorial) := by + intro n y hy + rw [norm_analyticExpDerivTerm] + have hyabs : |y| ≤ t / 2 := by + rw [abs_le] + constructor <;> linarith [hy.1, hy.2] + cases n with + | zero => simp; positivity + | succ k => + have hkpow : |y| ^ k ≤ (t / 2) ^ k := + pow_le_pow_left₀ (abs_nonneg y) hyabs k + have hmain : (k + 1 : ℝ) * |y| ^ k ≤ 2 * t ^ k := by + calc + (k + 1 : ℝ) * |y| ^ k ≤ (k + 1 : ℝ) * (t / 2) ^ k := by gcongr + _ ≤ (2 : ℝ) ^ (k + 1) * (t / 2) ^ k := by + exact mul_le_mul_of_nonneg_right (hnat k) (by positivity) + _ = 2 * t ^ k := by + rw [div_pow] + field_simp + ring + have hfac : 0 ≤ ‖(v (Nat.succ k) : H)‖ / (Nat.succ k).factorial := by positivity + calc + ‖(v (Nat.succ k) : H)‖ * ↑(Nat.succ k) * |y| ^ k / (Nat.succ k).factorial + = (‖(v (Nat.succ k) : H)‖ / (Nat.succ k).factorial) * + ((k + 1 : ℝ) * |y| ^ k) := by + simp only [Nat.cast_succ] + ring + _ ≤ (‖(v (Nat.succ k) : H)‖ / (Nat.succ k).factorial) * (2 * t ^ k) := by + gcongr + _ = (2 / t) * + (‖(v (Nat.succ k) : H)‖ * t ^ (Nat.succ k) / (Nat.succ k).factorial) := by + field_simp + rw [pow_succ] + ring + have hu : Summable (fun n => (2 / t) * (‖(v n : H)‖ * t ^ n / n.factorial)) := + hsum.mul_left (2 / t) + have hzero : (0 : ℝ) ∈ Set.Ioo (-t / 2) (t / 2) := by + constructor <;> linarith + have hsum_zero : Summable (fun n => analyticExpTerm T v 0 n) := by + apply Summable.of_norm_bounded hsum + intro n + rw [norm_analyticExpTerm] + by_cases hn : n = 0 + · simp [hn] + · simp [hn] + positivity + exact hasDerivAt_tsum_of_isPreconnected hu isOpen_Ioo isPreconnected_Ioo + (fun n y hy => analyticExpTerm_hasDerivAt T v y n) + (fun n y hy => hderiv_bound n y hy) hzero hsum_zero hs + +set_option linter.unusedTactic false in +lemma analyticExp_hasDerivAt_zero {T : H →ₗ.[ℂ] H} {x : H} {v : ℕ → T.domain} + (hv : IteratesSeq T x v) {t : ℝ} (ht : 0 < t) + (hsum : Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial)) : + HasDerivAt (fun s : ℝ => analyticExp T v s) (Complex.I • T (v 0)) 0 := by + have hlocal := analyticExp_hasDerivAt_of_mem_half_radius (T := T) (v := v) ht + (by + change (0 : ℝ) ∈ Set.Ioo (-t / 2) (t / 2) + constructor <;> linarith [ht]) hsum + have hsum_deriv : (∑' n, analyticExpDerivTerm T v 0 n) = Complex.I • T (v 0) := by + rw [tsum_eq_single 1] + · simpa [analyticExpDerivTerm] using congrArg (fun z : H => Complex.I • z) (hv.2 0) + · intro n hn + cases n with + | zero => simp [analyticExpDerivTerm] + | succ n => + cases n with + | zero => exact (hn rfl).elim + | succ n => simp [analyticExpDerivTerm] + rw [hsum_deriv] at hlocal + exact hlocal + +lemma summable_analyticExpDerivTerm_of_mem_half_radius + {T : H →ₗ.[ℂ] H} {v : ℕ → T.domain} {t s : ℝ} (ht : 0 < t) + (hs : s ∈ Set.Ioo (-t / 2) (t / 2)) + (hsum : Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial)) : + Summable (fun n => analyticExpDerivTerm T v s n) := by + have hnat : ∀ k : ℕ, (k + 1 : ℝ) ≤ (2 : ℝ) ^ (k + 1) := by + intro k + induction k with + | zero => norm_num + | succ k ih => + calc + (↑(Nat.succ k) + 1 : ℝ) = (k + 1 + 1 : ℝ) := by norm_num + _ ≤ 2 * (k + 1 : ℝ) := by + have hk : (0 : ℝ) ≤ k := by positivity + linarith + _ ≤ 2 * (2 : ℝ) ^ (k + 1) := by gcongr + _ = (2 : ℝ) ^ (k + 2) := by ring + have hbound : ∀ (n : ℕ), + ‖analyticExpDerivTerm T v s n‖ ≤ + (2 / t) * (‖(v n : H)‖ * t ^ n / n.factorial) := by + intro n + rw [norm_analyticExpDerivTerm] + cases n with + | zero => simp; positivity + | succ k => + have hyabs : |s| ≤ t / 2 := by + rw [abs_le] + constructor <;> linarith [hs.1, hs.2] + have hkpow : |s| ^ k ≤ (t / 2) ^ k := + pow_le_pow_left₀ (abs_nonneg s) hyabs k + have hmain : (k + 1 : ℝ) * |s| ^ k ≤ 2 * t ^ k := by + calc + (k + 1 : ℝ) * |s| ^ k ≤ (k + 1 : ℝ) * (t / 2) ^ k := by gcongr + _ ≤ (2 : ℝ) ^ (k + 1) * (t / 2) ^ k := by + exact mul_le_mul_of_nonneg_right (hnat k) (by positivity) + _ = 2 * t ^ k := by + rw [div_pow] + field_simp + ring + calc + ‖(v (Nat.succ k) : H)‖ * ↑(Nat.succ k) * |s| ^ k / + (Nat.succ k).factorial + = (‖(v (Nat.succ k) : H)‖ / (Nat.succ k).factorial) * + ((k + 1 : ℝ) * |s| ^ k) := by + simp only [Nat.cast_succ] + ring + _ ≤ (‖(v (Nat.succ k) : H)‖ / (Nat.succ k).factorial) * + (2 * t ^ k) := by gcongr + _ = (2 / t) * + (‖(v (Nat.succ k) : H)‖ * t ^ (Nat.succ k) / + (Nat.succ k).factorial) := by + field_simp + rw [pow_succ] + ring + exact Summable.of_norm_bounded (hsum.mul_left (2 / t)) hbound + +lemma analyticExp_mem_closure_graph + {T : H →ₗ.[ℂ] H} {x : H} {v : ℕ → T.domain} (hv : IteratesSeq T x v) + {t s : ℝ} (hT : T.IsClosable) + (hs : s ∈ Set.Ioo (-t / 2) (t / 2)) + (hsum : Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial)) : + (analyticExp T v s, (-Complex.I) • (∑' n, analyticExpDerivTerm T v s n)) ∈ + T.closure.graph := by + have hexp : Summable (fun n => analyticExpTerm T v s n) := by + apply Summable.of_norm_bounded hsum + intro n + rw [norm_analyticExpTerm] + have ht : 0 ≤ t := le_of_lt (by linarith [hs.2, hs.1]) + have hsabs : |s| ≤ t := by + rw [abs_le] + constructor <;> linarith [hs.1, hs.2] + have hpow : |s| ^ n ≤ t ^ n := pow_le_pow_left₀ (abs_nonneg s) hsabs n + have hnonneg : 0 ≤ ‖(v n : H)‖ / n.factorial := by positivity + calc + ‖(v n : H)‖ * |s| ^ n / n.factorial + = (‖(v n : H)‖ / n.factorial) * |s| ^ n := by ring + _ ≤ (‖(v n : H)‖ / n.factorial) * t ^ n := by gcongr + _ = ‖(v n : H)‖ * t ^ n / n.factorial := by ring + have hderiv := summable_analyticExpDerivTerm_of_mem_half_radius + (T := T) (v := v) (by linarith [hs.2, hs.1]) hs hsum + let p : ℕ → T.domain := fun N => ∑ n ∈ Finset.range N, + (((Complex.I * (s : ℂ)) ^ n) / n.factorial) • v n + let q : ℕ → H := fun N => T (p N) + have hp : Filter.Tendsto (fun N => (p N : H)) Filter.atTop (𝓝 (analyticExp T v s)) := by + simpa [p, analyticExp, analyticExpTerm] using (hexp.hasSum.tendsto_sum_nat) + have hq_eq : ∀ N, q N = (-Complex.I) • + (∑ n ∈ Finset.range (N + 1), analyticExpDerivTerm T v s n) := by + intro N + have hterm : ∀ n : ℕ, + T ((((Complex.I * (s : ℂ)) ^ n) / n.factorial) • v n) = + (-Complex.I) • analyticExpDerivTerm T v s (n + 1) := by + intro n + rw [map_smul, ← hv.2 n] + simp [analyticExpDerivTerm, Nat.factorial_succ, smul_smul] + field_simp + ring_nf + rw [Complex.I_sq] + simp + induction N with + | zero => simp [q, p, analyticExpDerivTerm] + | succ N ih => + change T (∑ n ∈ Finset.range (N + 1), + (((Complex.I * (s : ℂ)) ^ n) / n.factorial) • v n) = _ + rw [Finset.sum_range_succ, map_add] + rw [show T (∑ n ∈ Finset.range N, + (((Complex.I * (s : ℂ)) ^ n) / n.factorial) • v n) = q N by rfl] + rw [ih] + rw [hterm N] + rw [← smul_add] + congr 1 + rw [show N + (1 + 1) = (N + 1) + 1 by omega] + rw [Finset.sum_range_succ] + rw [Finset.sum_range_succ] + rw [Finset.sum_range_succ] + have hq : Filter.Tendsto q Filter.atTop (𝓝 ((-Complex.I) • (∑' n, + analyticExpDerivTerm T v s n))) := by + have hd := hderiv.hasSum.tendsto_sum_nat + have hshift := hd.comp (Filter.tendsto_add_atTop_nat 1) + have hshift' := hshift.const_smul (-Complex.I) + exact hshift'.congr' (Filter.Eventually.of_forall fun N => (hq_eq N).symm) + change (analyticExp T v s, (-Complex.I) • (∑' n, analyticExpDerivTerm T v s n)) ∈ + T.closure.graph + rw [← hT.graph_closure_eq_closure_graph] + apply mem_closure_iff_seq_limit.mpr + refine ⟨fun N => ((p N : H), q N), ?_, ?_⟩ + · exact fun N => T.mem_graph (p N) + · rw [nhds_prod_eq] + exact hp.prodMk hq + +lemma analyticExp_mem_closure_domain + {T : H →ₗ.[ℂ] H} {x : H} {v : ℕ → T.domain} (hv : IteratesSeq T x v) + {t s : ℝ} (hT : T.IsClosable) + (hs : s ∈ Set.Ioo (-t / 2) (t / 2)) + (hsum : Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial)) : + analyticExp T v s ∈ T.closure.domain := + mem_domain_of_mem_graph (analyticExp_mem_closure_graph hv hT hs hsum) + +lemma closure_analyticExp_apply + {T : H →ₗ.[ℂ] H} {x : H} {v : ℕ → T.domain} (hv : IteratesSeq T x v) + {t s : ℝ} (hT : T.IsClosable) + (hs : s ∈ Set.Ioo (-t / 2) (t / 2)) + (hsum : Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial)) : + T.closure ⟨analyticExp T v s, analyticExp_mem_closure_domain hv hT hs hsum⟩ = + (-Complex.I) • (∑' n, analyticExpDerivTerm T v s n) := by + apply T.closure.mem_graph_snd_inj' + (T.closure.mem_graph ⟨analyticExp T v s, analyticExp_mem_closure_domain hv hT hs hsum⟩) + (analyticExp_mem_closure_graph hv hT hs hsum) + rfl + +lemma analyticExp_hasDerivAt_eq_smul_closure + {T : H →ₗ.[ℂ] H} {x : H} {v : ℕ → T.domain} (hv : IteratesSeq T x v) + {t s : ℝ} (hT : T.IsClosable) + (hs : s ∈ Set.Ioo (-t / 2) (t / 2)) + (hsum : Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial)) : + HasDerivAt (fun r : ℝ => analyticExp T v r) + (Complex.I • T.closure ⟨analyticExp T v s, + analyticExp_mem_closure_domain hv hT hs hsum⟩) s := by + have h := analyticExp_hasDerivAt_of_mem_half_radius + (T := T) (v := v) (by linarith [hs.2, hs.1]) hs hsum + convert h using 1 + rw [closure_analyticExp_apply hv hT hs hsum] + simp [smul_smul] + +omit [CompleteSpace H] in +@[nolint unusedArguments] +lemma IsSymmetric.re_inner_smul_I_apply_self + {T : H →ₗ.[ℂ] H} (hT : T.IsSymmetric) (x : T.domain) : + (⟪(x : H), Complex.I • T x⟫_ℂ).re = 0 := by + have hreal := (isSymmetric_iff_inner_map_self_real.mp hT x) + have hxy : ⟪(x : H), T x⟫_ℂ = ⟪T x, (x : H)⟫_ℂ := by + calc + ⟪(x : H), T x⟫_ℂ = (starRingEnd ℂ) ⟪T x, (x : H)⟫_ℂ := + (inner_conj_symm (x : H) (T x)).symm + _ = ⟪T x, (x : H)⟫_ℂ := hreal + have hconj : (starRingEnd ℂ) ⟪(x : H), T x⟫_ℂ = ⟪(x : H), T x⟫_ℂ := by + calc + (starRingEnd ℂ) ⟪(x : H), T x⟫_ℂ = + (starRingEnd ℂ) ⟪T x, (x : H)⟫_ℂ := congrArg (starRingEnd ℂ) hxy + _ = ⟪T x, (x : H)⟫_ℂ := hreal + _ = ⟪(x : H), T x⟫_ℂ := hxy.symm + have him : (⟪(x : H), T x⟫_ℂ).im = 0 := by + have him' := congrArg Complex.im hconj + rw [Complex.conj_im] at him' + linarith + rw [inner_smul_right] + simp [Complex.I_mul, him] + +lemma analyticExp_normSq_hasDerivAt_eq_zero + {T : H →ₗ.[ℂ] H} (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) + {x : H} {v : ℕ → T.domain} (hv : IteratesSeq T x v) + {t s : ℝ} (hs : s ∈ Set.Ioo (-t / 2) (t / 2)) + (hsum : Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial)) : + HasDerivAt (fun r : ℝ => ‖analyticExp T v r‖ ^ 2) 0 s := by + have hspan : Dense (Submodule.span ℂ {x : H | T.IsAnalyticVector x} : Set H) := by + rw [dense_iff_closure_eq] + rw [← Submodule.topologicalClosure_coe] + exact congrArg (fun s : Submodule ℂ H => (s : Set H)) hdense + have hdomain : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}) ≤ T.domain := by + refine Submodule.span_le.2 (fun y hy => ?_) + obtain ⟨w, ⟨hw0, -⟩, -⟩ := hy + exact hw0 ▸ (w 0).2 + have hTdense : T.HasDenseDomain := hspan.mono hdomain + have hclosure_symm : T.closure.IsSymmetric := hsym.closure hTdense + let _ : InnerProductSpace ℝ H := InnerProductSpace.rclikeToReal ℂ H + have hlocal := analyticExp_hasDerivAt_eq_smul_closure hv + (hsym.isClosable hTdense) hs hsum + have hnorm : HasDerivAt (fun r : ℝ => ‖analyticExp T v r‖ ^ 2) + (2 * ⟪analyticExp T v s, + Complex.I • T.closure ⟨analyticExp T v s, + analyticExp_mem_closure_domain hv (hsym.isClosable hTdense) hs hsum⟩⟫_ℝ) s := by + simpa [ContinuousLinearMap.toSpanSingleton_apply] using + hlocal.hasFDerivAt.norm_sq.hasDerivAt + have hzero : + (2 : ℝ) * (⟪analyticExp T v s, + Complex.I • T.closure ⟨analyticExp T v s, + analyticExp_mem_closure_domain hv (hsym.isClosable hTdense) hs hsum⟩⟫_ℂ).re = 0 := by + have hinner := hclosure_symm.re_inner_smul_I_apply_self + ⟨analyticExp T v s, + analyticExp_mem_closure_domain hv (hsym.isClosable hTdense) hs hsum⟩ + simp [hinner] + convert hnorm using 1 + simpa [real_inner_eq_re_inner] using hzero.symm + +lemma analyticExp_normSq_eq_normSq_zero + {T : H →ₗ.[ℂ] H} (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) + {x : H} {v : ℕ → T.domain} (hv : IteratesSeq T x v) + {t s : ℝ} (hs : s ∈ Set.Ioo (-t / 2) (t / 2)) + (hsum : Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial)) : + ‖analyticExp T v s‖ ^ 2 = ‖x‖ ^ 2 := by + have ht : 0 < t := by linarith [hs.2, hs.1] + have hconst : ∀ {r u : ℝ}, r ∈ Set.Ioo (-t / 2) (t / 2) → + u ∈ Set.Ioo (-t / 2) (t / 2) → + ‖analyticExp T v r‖ ^ 2 = ‖analyticExp T v u‖ ^ 2 := by + intro r u hr hu + refine isOpen_Ioo.is_const_of_deriv_eq_zero + (s := Set.Ioo (-t / 2) (t / 2)) (f := fun y : ℝ => ‖analyticExp T v y‖ ^ 2) + (isPreconnected_Ioo (a := -t / 2) (b := t / 2)) ?_ ?_ hr hu + · intro y hy + exact (analyticExp_normSq_hasDerivAt_eq_zero hsym hdense hv hy + hsum).differentiableAt.differentiableWithinAt + · intro y hy + exact (analyticExp_normSq_hasDerivAt_eq_zero hsym hdense hv hy hsum).deriv + have hzero : (0 : ℝ) ∈ Set.Ioo (-t / 2) (t / 2) := by + constructor <;> linarith + rw [hconst hs hzero] + rw [analyticExp, tsum_eq_single 0] + · simp [analyticExpTerm, hv.1] + · intro n hn + simp [analyticExpTerm, hn] + +lemma analyticExp_norm_eq_norm + {T : H →ₗ.[ℂ] H} (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) + {x : H} {v : ℕ → T.domain} (hv : IteratesSeq T x v) + {t s : ℝ} (hs : s ∈ Set.Ioo (-t / 2) (t / 2)) + (hsum : Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial)) : + ‖analyticExp T v s‖ = ‖x‖ := by + have hsq := analyticExp_normSq_eq_normSq_zero hsym hdense hv hs hsum + nlinarith [norm_nonneg (analyticExp T v s), norm_nonneg x] + +lemma analyticExp_eq_zero_iff + {T : H →ₗ.[ℂ] H} (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) + {x : H} {v : ℕ → T.domain} (hv : IteratesSeq T x v) + {t s : ℝ} (hs : s ∈ Set.Ioo (-t / 2) (t / 2)) + (hsum : Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial)) : + analyticExp T v s = 0 ↔ x = 0 := by + rw [← norm_eq_zero] + rw [analyticExp_norm_eq_norm hsym hdense hv hs hsum] + exact norm_eq_zero + +omit [CompleteSpace H] in +@[nolint unusedArguments] +lemma IsEntireVector.isAnalyticVector + {T : H →ₗ.[ℂ] H} {x : H} (h : T.IsEntireVector x) : T.IsAnalyticVector x := by + obtain ⟨v, hv, hall⟩ := h + exact ⟨v, hv, 1, one_pos, hall 1 one_pos⟩ + +lemma analyticExp_mem_closure_domain_of_entire + {T : H →ₗ.[ℂ] H} {x : H} {v : ℕ → T.domain} (hv : IteratesSeq T x v) + (hall : ∀ t : ℝ, 0 < t → Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial)) + (hT : T.IsClosable) (s : ℝ) : + analyticExp T v s ∈ T.closure.domain := by + let t : ℝ := 2 * |s| + 1 + have ht : 0 < t := by + dsimp [t] + positivity + have hs : s ∈ Set.Ioo (-t / 2) (t / 2) := by + dsimp [t] + constructor <;> linarith [neg_le_abs s, le_abs_self s] + exact analyticExp_mem_closure_domain hv hT hs (hall t ht) + +lemma IsEntireVector.analyticExp_mem_closure_domain + {T : H →ₗ.[ℂ] H} {x : H} (h : T.IsEntireVector x) + (hT : T.IsClosable) (s : ℝ) : + ∃ v : ℕ → T.domain, IteratesSeq T x v ∧ + analyticExp T v s ∈ T.closure.domain := by + obtain ⟨v, hv, hall⟩ := h + let t : ℝ := 2 * |s| + 1 + have ht : 0 < t := by + dsimp [t] + positivity + have hs : s ∈ Set.Ioo (-t / 2) (t / 2) := by + dsimp [t] + constructor <;> linarith [neg_le_abs s, le_abs_self s] + exact ⟨v, hv, analyticExp_mem_closure_domain_of_entire hv hall hT s⟩ + +lemma IsEntireVector.analyticExp_norm_eq_norm + {T : H →ₗ.[ℂ] H} {x : H} (h : T.IsEntireVector x) + (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) + (s : ℝ) : + ∃ v : ℕ → T.domain, IteratesSeq T x v ∧ ‖analyticExp T v s‖ = ‖x‖ := by + obtain ⟨v, hv, hall⟩ := h + let t : ℝ := 2 * |s| + 1 + have ht : 0 < t := by + dsimp [t] + positivity + have hs : s ∈ Set.Ioo (-t / 2) (t / 2) := by + dsimp [t] + constructor <;> linarith [neg_le_abs s, le_abs_self s] + exact ⟨v, hv, LinearPMap.analyticExp_norm_eq_norm hsym hdense hv hs (hall t ht)⟩ + +lemma analyticExp_hasDerivAt_of_entire + {T : H →ₗ.[ℂ] H} {x : H} {v : ℕ → T.domain} (hv : IteratesSeq T x v) + (hall : ∀ t : ℝ, 0 < t → Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial)) + (hT : T.IsClosable) (s : ℝ) : + HasDerivAt (fun r : ℝ => analyticExp T v r) + (Complex.I • T.closure ⟨analyticExp T v s, + analyticExp_mem_closure_domain_of_entire hv hall hT s⟩) s := by + let t : ℝ := 2 * |s| + 1 + have ht : 0 < t := by + dsimp [t] + positivity + have hs : s ∈ Set.Ioo (-t / 2) (t / 2) := by + dsimp [t] + constructor <;> linarith [neg_le_abs s, le_abs_self s] + exact analyticExp_hasDerivAt_eq_smul_closure hv hT hs (hall t ht) + +lemma analyticExp_inner_deficiency_hasDerivAt + {T : H →ₗ.[ℂ] H} {x : H} {v : ℕ → T.domain} (hv : IteratesSeq T x v) + (hall : ∀ t : ℝ, 0 < t → Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial)) + (hT : T.IsClosable) {y : H} + (hy : y ∈ (T.closure - Complex.I • 1).toFun.rangeᗮ) (s : ℝ) : + HasDerivAt (fun r : ℝ => ⟪y, analyticExp T v r⟫_ℂ) + (-⟪y, analyticExp T v s⟫_ℂ) s := by + have hdom : analyticExp T v s ∈ T.closure.domain := + analyticExp_mem_closure_domain_of_entire hv hall hT s + have hderiv := analyticExp_hasDerivAt_of_entire hv hall hT s + let z : (T.closure - Complex.I • 1).domain := + ⟨analyticExp T v s, by + rw [sub_domain] + exact ⟨hdom, by simp⟩⟩ + have horth : ⟪y, T.closure ⟨analyticExp T v s, hdom⟩ - + Complex.I • (analyticExp T v s)⟫_ℂ = 0 := by + have hz := (Submodule.mem_orthogonal' _ y).mp hy ((T.closure - Complex.I • 1).toFun z) + ⟨z, rfl⟩ + simpa [z, sub_apply] using hz + have hrelation : ⟪y, T.closure ⟨analyticExp T v s, hdom⟩⟫_ℂ = + Complex.I * ⟪y, analyticExp T v s⟫_ℂ := by + rw [inner_sub_right, inner_smul_right] at horth + exact sub_eq_zero.mp horth + have hinner := (hasDerivAt_const (x := s) y).inner ℂ hderiv + convert hinner using 1 + · rfl + · simp only [inner_zero_left, inner_smul_right] + rw [hrelation] + ring_nf + rw [Complex.I_sq] + simp + +lemma analyticExp_inner_deficiency_eq_zero + {T : H →ₗ.[ℂ] H} (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) + {x : H} {v : ℕ → T.domain} (hv : IteratesSeq T x v) + (hall : ∀ t : ℝ, 0 < t → Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial)) + (hT : T.IsClosable) {y : H} + (hy : y ∈ (T.closure - Complex.I • 1).toFun.rangeᗮ) : + ⟪y, x⟫_ℂ = 0 := by + let _ : InnerProductSpace ℝ H := InnerProductSpace.rclikeToReal ℂ H + let f : ℝ → ℂ := fun s => ⟪y, analyticExp T v s⟫_ℂ + let g : ℝ → ℂ := fun s => (Real.exp s : ℂ) * f s + have hg : ∀ s : ℝ, HasDerivAt g 0 s := by + intro s + have he : HasDerivAt (fun r : ℝ => (Real.exp r : ℂ)) (Real.exp s) s := + (Real.hasDerivAt_exp s).ofReal_comp + have hf : HasDerivAt f (-f s) s := by + simpa [f] using analyticExp_inner_deficiency_hasDerivAt hv hall hT hy s + have hp := he.mul hf + have hz : (Real.exp s : ℂ) * f s + (Real.exp s : ℂ) * (-f s) = 0 := by + ring + have hp' : HasDerivAt ((fun r : ℝ => (Real.exp r : ℂ)) * f) 0 s := by + simpa only [hz] using hp + change HasDerivAt (fun r : ℝ => (Real.exp r : ℂ) * f r) 0 s + convert hp' using 1 + funext r + rfl + have hconst : ∀ s : ℝ, g s = g 0 := by + intro s + exact is_const_of_deriv_eq_zero (fun r => (hg r).differentiableAt) + (fun r => (hg r).deriv) s 0 + have hexp : Filter.Tendsto (fun n : ℕ => Real.exp (-(n : ℝ))) atTop (𝓝 0) := by + simpa [Function.comp_def] using + Real.tendsto_exp_atBot.comp + (tendsto_neg_atTop_atBot.comp (tendsto_natCast_atTop_atTop : + Filter.Tendsto (fun n : ℕ => (n : ℝ)) atTop atTop)) + have hupper : Filter.Tendsto + (fun n : ℕ => Real.exp (-(n : ℝ)) * (‖y‖ * ‖x‖)) atTop (𝓝 0) := by + simpa only [Pi.mul_apply, zero_mul] using + hexp.mul (tendsto_const_nhds : + Filter.Tendsto (fun _ : ℕ => ‖y‖ * ‖x‖) atTop (𝓝 (‖y‖ * ‖x‖))) + have hnorm_lim : Filter.Tendsto (fun n : ℕ => ‖g (-(n : ℝ))‖) atTop (𝓝 0) := by + refine squeeze_zero' (f := fun n : ℕ => ‖g (-(n : ℝ))‖) + (g := fun n : ℕ => Real.exp (-(n : ℝ)) * (‖y‖ * ‖x‖)) + (Filter.Eventually.of_forall fun n => norm_nonneg _) + (Filter.Eventually.of_forall (fun n => ?_)) hupper + calc + ‖g (-(n : ℝ))‖ = Real.exp (-(n : ℝ)) * + ‖⟪y, analyticExp T v (-(n : ℝ))⟫_ℂ‖ := by + dsimp [g, f] + rw [norm_mul, Complex.norm_real, Real.norm_eq_abs, + abs_of_pos (Real.exp_pos _)] + _ ≤ Real.exp (-(n : ℝ)) * + (‖y‖ * ‖analyticExp T v (-(n : ℝ))‖) := by + gcongr + exact norm_inner_le_norm _ _ + _ = Real.exp (-(n : ℝ)) * (‖y‖ * ‖x‖) := by + have hnorm : ‖analyticExp T v (-(n : ℝ))‖ = ‖x‖ := by + obtain ⟨w, hw, heq⟩ := IsEntireVector.analyticExp_norm_eq_norm + ⟨v, hv, hall⟩ hsym hdense (-(n : ℝ)) + rw [analyticExp_congr_iterates hv hw, heq] + rw [hnorm] + have hlim : Filter.Tendsto (fun n : ℕ => g (-(n : ℝ))) atTop (𝓝 0) := + (tendsto_zero_iff_norm_tendsto_zero).2 hnorm_lim + have hconst_zero : g 0 = 0 := by + have hc : Tendsto (fun _ : ℕ => g 0) atTop (𝓝 0) := + hlim.congr' (Filter.Eventually.of_forall fun n => hconst (-(n : ℝ))) + exact (tendsto_nhds_unique hc tendsto_const_nhds).symm + have hexp_zero : analyticExp T v 0 = x := by + rw [analyticExp, tsum_eq_single 0] + · simpa [analyticExpTerm] using hv.1 + · intro n hn + simp [analyticExpTerm, hn] + simpa [g, f, hexp_zero] using hconst_zero + +lemma analyticExp_inner_deficiency_hasDerivAt_neg + {T : H →ₗ.[ℂ] H} {x : H} {v : ℕ → T.domain} (hv : IteratesSeq T x v) + (hall : ∀ t : ℝ, 0 < t → Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial)) + (hT : T.IsClosable) {y : H} + (hy : y ∈ (T.closure - (-Complex.I) • 1).toFun.rangeᗮ) (s : ℝ) : + HasDerivAt (fun r : ℝ => ⟪y, analyticExp T v r⟫_ℂ) + (⟪y, analyticExp T v s⟫_ℂ) s := by + have hdom : analyticExp T v s ∈ T.closure.domain := + analyticExp_mem_closure_domain_of_entire hv hall hT s + have hderiv := analyticExp_hasDerivAt_of_entire hv hall hT s + let z : (T.closure - (-Complex.I) • 1).domain := + ⟨analyticExp T v s, by + rw [sub_domain] + exact ⟨hdom, by simp⟩⟩ + have horth : ⟪y, T.closure ⟨analyticExp T v s, hdom⟩ - + (-Complex.I) • (analyticExp T v s)⟫_ℂ = 0 := by + have hz := (Submodule.mem_orthogonal' _ y).mp hy ((T.closure - (-Complex.I) • 1).toFun z) + ⟨z, rfl⟩ + simpa [z, sub_apply] using hz + have hrelation : ⟪y, T.closure ⟨analyticExp T v s, hdom⟩⟫_ℂ = + (-Complex.I) * ⟪y, analyticExp T v s⟫_ℂ := by + rw [inner_sub_right, inner_smul_right] at horth + exact sub_eq_zero.mp horth + let _ : InnerProductSpace ℝ H := InnerProductSpace.rclikeToReal ℂ H + have hinner := (hasDerivAt_const (x := s) y).inner ℂ hderiv + convert hinner using 1 + · rfl + · simp only [inner_zero_left, inner_smul_right] + rw [hrelation] + ring_nf + rw [Complex.I_sq] + simp + +lemma analyticExp_inner_deficiency_eq_zero_neg + {T : H →ₗ.[ℂ] H} (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) + {x : H} {v : ℕ → T.domain} (hv : IteratesSeq T x v) + (hall : ∀ t : ℝ, 0 < t → Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial)) + (hT : T.IsClosable) {y : H} + (hy : y ∈ (T.closure - (-Complex.I) • 1).toFun.rangeᗮ) : + ⟪y, x⟫_ℂ = 0 := by + let f : ℝ → ℂ := fun s => ⟪y, analyticExp T v s⟫_ℂ + let g : ℝ → ℂ := fun s => (Real.exp (-s) : ℂ) * f s + have hg : ∀ s : ℝ, HasDerivAt g 0 s := by + intro s + have he : HasDerivAt (fun r : ℝ => (Real.exp (-r) : ℂ)) + (-Real.exp (-s)) s := by + have hreal := (Real.hasDerivAt_exp (-s)).scomp s + (hasDerivAt_id' (𝕜 := ℝ) s).neg + convert hreal.ofReal_comp using 1 + · funext r + rfl + · simp + have hf : HasDerivAt f (f s) s := by + simpa [f] using analyticExp_inner_deficiency_hasDerivAt_neg hv hall hT hy s + have hp := he.mul hf + have hz : (-Real.exp (-s) : ℂ) * f s + (Real.exp (-s) : ℂ) * f s = 0 := by + ring + have hp' : HasDerivAt ((fun r : ℝ => (Real.exp (-r) : ℂ)) * f) 0 s := by + simpa only [hz] using hp + change HasDerivAt (fun r : ℝ => (Real.exp (-r) : ℂ) * f r) 0 s + convert hp' using 1 + funext r + rfl + have hconst : ∀ s : ℝ, g s = g 0 := by + intro s + exact is_const_of_deriv_eq_zero (fun r => (hg r).differentiableAt) + (fun r => (hg r).deriv) s 0 + have hexp : Filter.Tendsto (fun n : ℕ => Real.exp (-(n : ℝ))) atTop (𝓝 0) := by + simpa [Function.comp_def] using + Real.tendsto_exp_atBot.comp + (tendsto_neg_atTop_atBot.comp (tendsto_natCast_atTop_atTop : + Filter.Tendsto (fun n : ℕ => (n : ℝ)) atTop atTop)) + have hupper : Filter.Tendsto + (fun n : ℕ => Real.exp (-(n : ℝ)) * (‖y‖ * ‖x‖)) atTop (𝓝 0) := by + simpa only [Pi.mul_apply, zero_mul] using + hexp.mul (tendsto_const_nhds : + Filter.Tendsto (fun _ : ℕ => ‖y‖ * ‖x‖) atTop (𝓝 (‖y‖ * ‖x‖))) + have hnorm_lim : Filter.Tendsto (fun n : ℕ => ‖g (n : ℝ)‖) atTop (𝓝 0) := by + refine squeeze_zero' (f := fun n : ℕ => ‖g (n : ℝ)‖) + (g := fun n : ℕ => Real.exp (-(n : ℝ)) * (‖y‖ * ‖x‖)) + (Filter.Eventually.of_forall fun n => norm_nonneg _) + (Filter.Eventually.of_forall (fun n => ?_)) hupper + calc + ‖g (n : ℝ)‖ = Real.exp (-(n : ℝ)) * + ‖⟪y, analyticExp T v (n : ℝ)⟫_ℂ‖ := by + dsimp [g, f] + rw [norm_mul, Complex.norm_real, Real.norm_eq_abs, + abs_of_pos (Real.exp_pos _)] + _ ≤ Real.exp (-(n : ℝ)) * + (‖y‖ * ‖analyticExp T v (n : ℝ)‖) := by + gcongr + exact norm_inner_le_norm _ _ + _ = Real.exp (-(n : ℝ)) * (‖y‖ * ‖x‖) := by + have hnorm : ‖analyticExp T v (n : ℝ)‖ = ‖x‖ := by + obtain ⟨w, hw, heq⟩ := IsEntireVector.analyticExp_norm_eq_norm + ⟨v, hv, hall⟩ hsym hdense (n : ℝ) + rw [analyticExp_congr_iterates hv hw, heq] + rw [hnorm] + have hlim : Filter.Tendsto (fun n : ℕ => g (n : ℝ)) atTop (𝓝 0) := + (tendsto_zero_iff_norm_tendsto_zero).2 hnorm_lim + have hconst_zero : g 0 = 0 := by + have hc : Tendsto (fun _ : ℕ => g 0) atTop (𝓝 0) := + hlim.congr' (Filter.Eventually.of_forall fun n => hconst (n : ℝ)) + exact (tendsto_nhds_unique hc tendsto_const_nhds).symm + have hexp_zero : analyticExp T v 0 = x := by + rw [analyticExp, tsum_eq_single 0] + · simpa [analyticExpTerm] using hv.1 + · intro n hn + simp [analyticExpTerm, hn] + simpa [g, f, hexp_zero] using hconst_zero + +lemma analyticExp_continuousAt_of_mem_half_radius + {T : H →ₗ.[ℂ] H} {v : ℕ → T.domain} {t s : ℝ} (ht : 0 < t) + (hs : s ∈ Set.Ioo (-t / 2) (t / 2)) + (hsum : Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial)) : + ContinuousAt (fun r : ℝ => analyticExp T v r) s := + (analyticExp_hasDerivAt_of_mem_half_radius ht hs hsum).continuousAt + +lemma IsAnalyticVector.exists_analyticExp_summable + {T : H →ₗ.[ℂ] H} {x : H} (h : T.IsAnalyticVector x) : + ∃ v : ℕ → T.domain, IteratesSeq T x v ∧ ∃ t : ℝ, 0 < t ∧ ∀ s : ℝ, |s| ≤ t → + Summable (fun n => analyticExpTerm T v s n) := by + obtain ⟨v, hv, t, ht, hsum⟩ := h + refine ⟨v, hv, t, ht, fun s hs ↦ ?_⟩ + apply Summable.of_norm_bounded hsum + intro n + rw [norm_analyticExpTerm] + have hpow : |s| ^ n ≤ t ^ n := pow_le_pow_left₀ (abs_nonneg s) hs n + have hnonneg : 0 ≤ ‖(v n : H)‖ / n.factorial := by positivity + calc + ‖(v n : H)‖ * |s| ^ n / n.factorial + = (‖(v n : H)‖ / n.factorial) * |s| ^ n := by ring + _ ≤ (‖(v n : H)‖ / n.factorial) * t ^ n := by gcongr + _ = ‖(v n : H)‖ * t ^ n / n.factorial := by ring + +lemma IsAnalyticVector.summable_analyticExpTerm + {T : H →ₗ.[ℂ] H} {v : ℕ → T.domain} {s : ℝ} {t : ℝ} (hs : |s| ≤ t) + (hsum : Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial)) : + Summable (fun n => analyticExpTerm T v s n) := by + apply Summable.of_norm_bounded hsum + intro n + rw [norm_analyticExpTerm] + have hpow : |s| ^ n ≤ t ^ n := pow_le_pow_left₀ (abs_nonneg s) hs n + have hnonneg : 0 ≤ ‖(v n : H)‖ / n.factorial := by positivity + calc + ‖(v n : H)‖ * |s| ^ n / n.factorial + = (‖(v n : H)‖ / n.factorial) * |s| ^ n := by ring + _ ≤ (‖(v n : H)‖ / n.factorial) * t ^ n := by gcongr + _ = ‖(v n : H)‖ * t ^ n / n.factorial := by ring + +lemma IsAnalyticVector.hasSum_analyticExp + {T : H →ₗ.[ℂ] H} {v : ℕ → T.domain} {s : ℝ} {t : ℝ} (hs : |s| ≤ t) + (hsum : Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial)) : + HasSum (fun n => analyticExpTerm T v s n) (analyticExp T v s) := by + simpa only [analyticExp] using + (summable_analyticExpTerm hs hsum).hasSum + +lemma analyticExp_smul_iterates + {T : H →ₗ.[ℂ] H} {v : ℕ → T.domain} {c : ℂ} {s t : ℝ} + (hs : |s| ≤ t) + (hsum : Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial)) : + analyticExp T (fun n => c • v n) s = c • analyticExp T v s := by + have hsum_smul : Summable (fun n => ‖((c • v n : T.domain) : H)‖ * t ^ n / + n.factorial) := by + have heq : (fun n => ‖((c • v n : T.domain) : H)‖ * t ^ n / n.factorial) = + (fun n => ‖c‖ * (‖(v n : H)‖ * t ^ n / n.factorial)) := by + funext n + rw [SetLike.val_smul, norm_smul] + ring + rw [heq] + exact hsum.mul_left _ + have hleft := (IsAnalyticVector.hasSum_analyticExp (T := T) + (v := fun n => c • v n) hs hsum_smul) + have hright := (IsAnalyticVector.hasSum_analyticExp (T := T) (v := v) hs hsum).const_smul c + have hterms : (fun n => analyticExpTerm T (fun n => c • v n) s n) = + (fun n => c • analyticExpTerm T v s n) := by + funext n + unfold analyticExpTerm + rw [SetLike.val_smul, smul_smul, smul_smul] + congr 1 + ring + rw [hterms] at hleft + exact hleft.unique hright + +lemma analyticExp_add_iterates + {T : H →ₗ.[ℂ] H} {v w : ℕ → T.domain} {s t : ℝ} + (hs : |s| ≤ t) + (hv : Summable (fun n => ‖(v n : H)‖ * t ^ n / n.factorial)) + (hw : Summable (fun n => ‖(w n : H)‖ * t ^ n / n.factorial)) : + analyticExp T (fun n => v n + w n) s = + analyticExp T v s + analyticExp T w s := by + have hsum_add : Summable (fun n => ‖((v n + w n : T.domain) : H)‖ * t ^ n / + n.factorial) := by + have ht : 0 ≤ t := le_trans (abs_nonneg s) hs + have hbound : ∀ n, ‖((v n + w n : T.domain) : H)‖ * t ^ n / + n.factorial ≤ ‖(v n : H)‖ * t ^ n / n.factorial + + ‖(w n : H)‖ * t ^ n / n.factorial := by + intro n + have htri : ‖((v n + w n : T.domain) : H)‖ ≤ ‖(v n : H)‖ + ‖(w n : H)‖ := by + exact norm_add_le _ _ + calc + ‖((v n + w n : T.domain) : H)‖ * t ^ n / n.factorial + ≤ (‖(v n : H)‖ + ‖(w n : H)‖) * t ^ n / n.factorial := by + gcongr + _ = ‖(v n : H)‖ * t ^ n / n.factorial + + ‖(w n : H)‖ * t ^ n / n.factorial := by ring + exact Summable.of_nonneg_of_le (fun n => by positivity) hbound (hv.add hw) + have hleft := (IsAnalyticVector.hasSum_analyticExp (T := T) + (v := fun n => v n + w n) hs hsum_add) + have hright := (IsAnalyticVector.hasSum_analyticExp (T := T) (v := v) hs hv).add + (IsAnalyticVector.hasSum_analyticExp (T := T) (v := w) hs hw) + have hterms : (fun n => analyticExpTerm T (fun n => v n + w n) s n) = + (fun n => analyticExpTerm T v s n + analyticExpTerm T w s n) := by + funext n + simp [analyticExpTerm, smul_add] + rw [hterms] at hleft + exact hleft.unique hright + +omit [CompleteSpace H] in +lemma analyticExp_zero {T : H →ₗ.[ℂ] H} {x : H} {v : ℕ → T.domain} + (hv : IteratesSeq T x v) : analyticExp T v 0 = x := by + rw [analyticExp, tsum_eq_single 0] + · simpa [analyticExpTerm] using hv.1 + · intro n hn + simp [analyticExpTerm, hn] + +omit [CompleteSpace H] in +lemma analyticExpTerm_succ {T : H →ₗ.[ℂ] H} {v : ℕ → T.domain} + (hv : IteratesSeq T x v) (s : ℝ) (n : ℕ) : + analyticExpTerm T v s (n + 1) = + (((Complex.I * (s : ℂ)) ^ (n + 1)) / (n + 1).factorial) • T (v n) := by + unfold analyticExpTerm + rw [hv.2 n] + +omit [CompleteSpace H] in +lemma IsAnalyticVector.mem_domain {T : H →ₗ.[ℂ] H} {x : H} (h : T.IsAnalyticVector x) : + x ∈ T.domain := by + obtain ⟨v, ⟨hv0, -⟩, -⟩ := h + exact hv0 ▸ (v 0).2 + +omit [CompleteSpace H] in +/-- An analytic-vector witness for a closable operator is also a witness for its closure. + +The iterate sequence is transported pointwise along `T.le_closure`; the closure agrees with `T` +on the original domain, so no regularity beyond closability is needed for this transfer. -/ +lemma IsAnalyticVector.for_closure {T : H →ₗ.[ℂ] H} {x : H} + (h : T.IsAnalyticVector x) : + T.closure.IsAnalyticVector x := by + obtain ⟨v, hv, t, ht, hsum⟩ := h + let w : ℕ → T.closure.domain := fun n => + ⟨(v n : H), T.le_closure.1 (v n).property⟩ + have hw : IteratesSeq T.closure x w := by + refine ⟨?_, fun n => ?_⟩ + · exact hv.1 + · have hcl : T ⟨(v n : H), (v n).property⟩ = + T.closure (w n) := by + exact T.le_closure.2 rfl + calc + (w (n + 1) : H) = T (v n) := hv.2 n + _ = T.closure (w n) := hcl + refine ⟨w, hw, t, ht, ?_⟩ + simpa [w] using hsum + +omit [CompleteSpace H] in +/-- Applying `T` to an analytic vector preserves analyticity, with a smaller radius. + +The shifted iterate sequence is `n ↦ v (n+1)`. The loss of radius absorbs the linear factor +`n+1` introduced when the factorial denominator is shifted. -/ +lemma IsAnalyticVector.apply {T : H →ₗ.[ℂ] H} {x : H} + (h : T.IsAnalyticVector x) : + T.IsAnalyticVector (T ⟨x, IsAnalyticVector.mem_domain h⟩) := by + have hx : x ∈ T.domain := IsAnalyticVector.mem_domain h + obtain ⟨v, hv, t, ht, hsum⟩ := h + let w : ℕ → T.domain := fun n => v (n + 1) + have hw : IteratesSeq T (T ⟨x, hx⟩) w := by + refine ⟨?_, fun n => ?_⟩ + · change (v (0 + 1) : H) = T ⟨x, hx⟩ + rw [show (0 + 1 : ℕ) = 1 by rfl, hv.2 0] + congr 1 + exact Subtype.ext hv.1 + · change (v ((n + 1) + 1) : H) = T (v (n + 1)) + exact hv.2 (n + 1) + have htail : Summable (fun n : ℕ => + ‖(v (n + 1) : H)‖ * t ^ (n + 1) / (n + 1).factorial) := by + simpa only [Nat.add_assoc] using + ((summable_nat_add_iff + (f := fun n : ℕ => ‖(v n : H)‖ * t ^ n / n.factorial) 1).2 hsum) + have hfactor : ∀ n : ℕ, (n + 1 : ℝ) * ((1 : ℝ) / 2) ^ n ≤ 2 := by + intro n + induction n with + | zero => norm_num + | succ n ih => + calc + (n.succ + 1 : ℝ) * ((1 : ℝ) / 2) ^ n.succ = + ((n + 2 : ℝ) / 2) * ((1 : ℝ) / 2) ^ n := by + rw [pow_succ] + rw [Nat.cast_succ] + ring + _ ≤ (n + 1 : ℝ) * ((1 : ℝ) / 2) ^ n := by + gcongr + nlinarith + _ ≤ 2 := ih + have hbound : ∀ n : ℕ, + ‖(w n : H)‖ * (t / 2) ^ n / n.factorial ≤ + (2 / t) * (‖(v (n + 1) : H)‖ * t ^ (n + 1) / (n + 1).factorial) := by + intro n + have htn : t ≠ 0 := ne_of_gt ht + have hfactor' : (n + 1 : ℝ) * ((1 : ℝ) / 2) ^ n / t ≤ 2 / t := + div_le_div_of_nonneg_right (hfactor n) ht.le + calc + ‖(w n : H)‖ * (t / 2) ^ n / n.factorial = + ((n + 1 : ℝ) * ((1 : ℝ) / 2) ^ n / t) * + (‖(v (n + 1) : H)‖ * t ^ (n + 1) / (n + 1).factorial) := by + dsimp [w] + rw [Nat.factorial_succ] + field_simp [htn] + push_cast + ring + _ ≤ (2 / t) * (‖(v (n + 1) : H)‖ * t ^ (n + 1) / (n + 1).factorial) := by + gcongr + have ht2 : 0 < t / 2 := by linarith + refine ⟨w, hw, t / 2, ht2, ?_⟩ + apply Summable.of_nonneg_of_le (fun n => by positivity) hbound + exact htail.mul_left (2 / t) + +omit [CompleteSpace H] in +/-- Applying the closed operator to a transported analytic vector preserves analyticity. + +This is the form used by continuation arguments: after transporting an analytic witness from +`T` to `T.closure`, the smaller-radius invariance lemma can be iterated without leaving the closed +operator's domain. -/ +lemma IsAnalyticVector.closure_apply {T : H →ₗ.[ℂ] H} {x : H} + (h : T.IsAnalyticVector x) : + T.closure.IsAnalyticVector + (T.closure ⟨x, IsAnalyticVector.mem_domain (IsAnalyticVector.for_closure h)⟩) := by + exact IsAnalyticVector.apply (IsAnalyticVector.for_closure h) + +/-! ## Structural closure properties -/ + +omit [CompleteSpace H] in +lemma isAnalyticVector_zero (T : H →ₗ.[ℂ] H) : T.IsAnalyticVector 0 := by + let v : ℕ → T.domain := fun _ => ⟨0, T.domain.zero_mem⟩ + refine ⟨v, ⟨by simp [v], fun n => ?_⟩, 1, one_pos, ?_⟩ + · change (0 : H) = T (v n) + change (0 : H) = T (0 : T.domain) + exact (map_zero T).symm + · simp [v] + +omit [CompleteSpace H] in +/-- Analytic vectors are closed under scalar multiplication, with the same radius. -/ +lemma IsAnalyticVector.smul {T : H →ₗ.[ℂ] H} {x : H} (h : T.IsAnalyticVector x) (c : ℂ) : + T.IsAnalyticVector (c • x) := by + obtain ⟨v, ⟨hv0, hvS⟩, t, ht, hsum⟩ := h + refine ⟨fun n => c • v n, ⟨by simp [hv0], fun n => ?_⟩, t, ht, ?_⟩ + · show (c • v (n + 1) : H) = T (c • v n) + rw [hvS n, ← LinearPMap.map_smul] + · have heq : (fun n => ‖(c • v n : T.domain).1‖ * t ^ n / n.factorial) + = fun n => ‖c‖ * (‖(v n : H)‖ * t ^ n / n.factorial) := by + funext n + rw [SetLike.val_smul, norm_smul] + ring + rw [heq] + exact hsum.mul_left _ + +omit [CompleteSpace H] in +/-- Analytic vectors form an additive submodule: if `x` is analytic with radius `t₁` and `y` with +radius `t₂`, then `x + y` is analytic with radius `min t₁ t₂` — the standard argument, since +`T.domain` is a submodule (so `x + y` and every iterate stay in the domain, with `T` additive +there) and the two majorizing power series compare termwise once the smaller radius is used for +both. -/ +lemma IsAnalyticVector.add {T : H →ₗ.[ℂ] H} {x y : H} + (hx : T.IsAnalyticVector x) (hy : T.IsAnalyticVector y) : + T.IsAnalyticVector (x + y) := by + obtain ⟨v, ⟨hv0, hvS⟩, t1, ht1, hsum1⟩ := hx + obtain ⟨w, ⟨hw0, hwS⟩, t2, ht2, hsum2⟩ := hy + have ht : (0:ℝ) < min t1 t2 := lt_min ht1 ht2 + refine ⟨fun n => v n + w n, ⟨by simp [hv0, hw0], fun n => ?_⟩, min t1 t2, ht, ?_⟩ + · show ((v (n + 1) + w (n + 1) : T.domain) : H) = T (v n + w n) + show ((v (n+1) : H) + (w (n+1) : H)) = T (v n + w n) + rw [hvS n, hwS n, LinearPMap.map_add] + · have hbound : ∀ n, ‖((v n + w n : T.domain) : H)‖ * (min t1 t2) ^ n / n.factorial + ≤ ‖(v n : H)‖ * t1 ^ n / n.factorial + ‖(w n : H)‖ * t2 ^ n / n.factorial := by + intro n + have htri : ‖((v n + w n : T.domain) : H)‖ ≤ ‖(v n : H)‖ + ‖(w n : H)‖ := by + show ‖((v n : H) + (w n : H))‖ ≤ _ + exact norm_add_le _ _ + have h1 : (min t1 t2) ^ n ≤ t1 ^ n := pow_le_pow_left₀ ht.le (min_le_left t1 t2) n + have h2 : (min t1 t2) ^ n ≤ t2 ^ n := pow_le_pow_left₀ ht.le (min_le_right t1 t2) n + have hv1 : (0:ℝ) ≤ ‖(v n : H)‖ := norm_nonneg _ + have hw1 : (0:ℝ) ≤ ‖(w n : H)‖ := norm_nonneg _ + calc ‖((v n + w n : T.domain) : H)‖ * (min t1 t2) ^ n / n.factorial + ≤ (‖(v n : H)‖ + ‖(w n : H)‖) * (min t1 t2) ^ n / n.factorial := by + gcongr + _ = ‖(v n : H)‖ * (min t1 t2) ^ n / n.factorial + + ‖(w n : H)‖ * (min t1 t2) ^ n / n.factorial := by ring + _ ≤ ‖(v n : H)‖ * t1 ^ n / n.factorial + ‖(w n : H)‖ * t2 ^ n / n.factorial := by + gcongr + exact Summable.of_nonneg_of_le (fun n => by positivity) hbound (hsum1.add hsum2) + +/-- The analytic vectors form a genuine complex submodule. This packages the set used in the +density hypothesis of Nelson's theorem and is also the natural candidate for the common analytic +core in the joint-commutation theorem. -/ +def analyticVectors (T : H →ₗ.[ℂ] H) : Submodule ℂ H where + carrier := {x | T.IsAnalyticVector x} + zero_mem' := isAnalyticVector_zero T + add_mem' := IsAnalyticVector.add + smul_mem' := fun c _ hx => hx.smul c + +omit [CompleteSpace H] in +@[simp] +lemma mem_analyticVectors {T : H →ₗ.[ℂ] H} {x : H} : + x ∈ T.analyticVectors ↔ T.IsAnalyticVector x := Iff.rfl + +omit [CompleteSpace H] in +lemma analyticVectors_le_domain {T : H →ₗ.[ℂ] H} : + T.analyticVectors ≤ T.domain := by + intro x hx + exact IsAnalyticVector.mem_domain hx + +omit [CompleteSpace H] in +lemma dense_analyticVectors_iff {T : H →ₗ.[ℂ] H} : + (T.analyticVectors : Submodule ℂ H).topologicalClosure = ⊤ ↔ + (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤ := by + change T.analyticVectors.topologicalClosure = ⊤ ↔ + (Submodule.span ℂ (T.analyticVectors : Set H)).topologicalClosure = ⊤ + rw [Submodule.span_eq] + +/-! ## Eigenvectors are analytic -/ + +omit [CompleteSpace H] in +/-- Every eigenvector is analytic for `T`, with *every* radius `t > 0`: its iterate sequence has +exactly geometric norm `‖x‖ * |μ|ⁿ`, so the series is dominated by a genuine exponential series, +convergent by `Real.summable_pow_div_factorial`. In particular every vector in a dense eigenbasis +(as in `RealAnalytic.lean`'s `isEssentiallySelfAdjoint_of_hilbertBasis_eigenvectors`) is +already an analytic vector: that theorem is the special case of Nelson's theorem where the dense +set of analytic vectors is exhibited concretely as an eigenbasis, rather than only assumed to +exist abstractly. -/ +lemma isAnalyticVector_of_eigenvector {T : H →ₗ.[ℂ] H} {x : H} (hx : x ∈ T.domain) (μ : ℂ) + (heig : T ⟨x, hx⟩ = μ • x) (t : ℝ) (ht : 0 < t) : T.IsAnalyticVector x := by + have hmem : ∀ n : ℕ, μ ^ n • x ∈ T.domain := fun n => T.domain.smul_mem _ hx + refine ⟨fun n => ⟨μ ^ n • x, hmem n⟩, ⟨by simp, fun n => ?_⟩, t, ht, ?_⟩ + · show μ ^ (n + 1) • x = T ⟨μ ^ n • x, hmem n⟩ + have hcast : (⟨μ ^ n • x, hmem n⟩ : T.domain) = μ ^ n • (⟨x, hx⟩ : T.domain) := by + ext; simp + rw [hcast, LinearPMap.map_smul, heig, smul_smul, pow_succ] + · have heq : (fun n => ‖(⟨μ ^ n • x, hmem n⟩ : T.domain).1‖ * t ^ n / n.factorial) + = fun n => ‖x‖ * ((‖μ‖ * t) ^ n / n.factorial) := by + funext n + simp only [norm_smul, norm_pow, mul_pow] + ring + rw [heq] + exact (Real.summable_pow_div_factorial (‖μ‖ * t)).mul_left _ + +omit [CompleteSpace H] in +@[nolint unusedArguments] +lemma isEntireVector_of_eigenvector {T : H →ₗ.[ℂ] H} {x : H} (hx : x ∈ T.domain) (μ : ℂ) + (heig : T ⟨x, hx⟩ = μ • x) : T.IsEntireVector x := by + have hmem : ∀ n : ℕ, μ ^ n • x ∈ T.domain := fun n => T.domain.smul_mem _ hx + refine ⟨fun n => ⟨μ ^ n • x, hmem n⟩, ⟨by simp, fun n => ?_⟩, fun t ht => ?_⟩ + · show μ ^ (n + 1) • x = T ⟨μ ^ n • x, hmem n⟩ + have hcast : (⟨μ ^ n • x, hmem n⟩ : T.domain) = μ ^ n • (⟨x, hx⟩ : T.domain) := by + ext + simp + rw [hcast, LinearPMap.map_smul, heig, smul_smul, pow_succ] + · have heq : (fun n => ‖(⟨μ ^ n • x, hmem n⟩ : T.domain).1‖ * t ^ n / n.factorial) + = fun n => ‖x‖ * ((‖μ‖ * t) ^ n / n.factorial) := by + funext n + simp only [norm_smul, norm_pow, mul_pow] + ring + rw [heq] + exact (Real.summable_pow_div_factorial (‖μ‖ * t)).mul_left _ + +omit [CompleteSpace H] in +lemma isEntireVector_zero (T : H →ₗ.[ℂ] H) : T.IsEntireVector 0 := by + let v : ℕ → T.domain := fun _ => ⟨0, T.domain.zero_mem⟩ + refine ⟨v, ⟨by simp [v], fun n => ?_⟩, fun t ht => ?_⟩ + · change (0 : H) = T (v n) + change (0 : H) = T (0 : T.domain) + exact (map_zero T).symm + · simp [v] + +omit [CompleteSpace H] in +lemma IsEntireVector.smul {T : H →ₗ.[ℂ] H} {x : H} (h : T.IsEntireVector x) (c : ℂ) : + T.IsEntireVector (c • x) := by + obtain ⟨v, ⟨hv0, hvS⟩, hall⟩ := h + refine ⟨fun n => c • v n, ⟨by simp [hv0], fun n => ?_⟩, fun t ht => ?_⟩ + · show (c • v (n + 1) : H) = T (c • v n) + rw [hvS n, ← LinearPMap.map_smul] + · have heq : (fun n => ‖(c • v n : T.domain).1‖ * t ^ n / n.factorial) + = fun n => ‖c‖ * (‖(v n : H)‖ * t ^ n / n.factorial) := by + funext n + rw [SetLike.val_smul, norm_smul] + ring + rw [heq] + exact (hall t ht).mul_left _ + +omit [CompleteSpace H] in +lemma IsEntireVector.add {T : H →ₗ.[ℂ] H} {x y : H} + (hx : T.IsEntireVector x) (hy : T.IsEntireVector y) : + T.IsEntireVector (x + y) := by + obtain ⟨v, ⟨hv0, hvS⟩, hallv⟩ := hx + obtain ⟨w, ⟨hw0, hwS⟩, hallw⟩ := hy + refine ⟨fun n => v n + w n, ⟨by simp [hv0, hw0], fun n => ?_⟩, fun t ht => ?_⟩ + · show ((v (n + 1) + w (n + 1) : T.domain) : H) = T (v n + w n) + show ((v (n + 1) : H) + (w (n + 1) : H)) = T (v n + w n) + rw [hvS n, hwS n, LinearPMap.map_add] + · have hbound : ∀ n, ‖((v n + w n : T.domain) : H)‖ * t ^ n / + n.factorial ≤ ‖(v n : H)‖ * t ^ n / n.factorial + + ‖(w n : H)‖ * t ^ n / n.factorial := by + intro n + have htri : ‖((v n + w n : T.domain) : H)‖ ≤ ‖(v n : H)‖ + ‖(w n : H)‖ := by + exact norm_add_le _ _ + calc + ‖((v n + w n : T.domain) : H)‖ * t ^ n / n.factorial + ≤ (‖(v n : H)‖ + ‖(w n : H)‖) * t ^ n / n.factorial := by + gcongr + _ = ‖(v n : H)‖ * t ^ n / n.factorial + + ‖(w n : H)‖ * t ^ n / n.factorial := by ring + exact Summable.of_nonneg_of_le (fun n => by positivity) hbound + ((hallv t ht).add (hallw t ht)) + +omit [CompleteSpace H] in +/-- The submodule of entire vectors for `T`. -/ +def entireVectors (T : H →ₗ.[ℂ] H) : Submodule ℂ H where + carrier := {x | T.IsEntireVector x} + zero_mem' := isEntireVector_zero T + add_mem' := IsEntireVector.add + smul_mem' := fun c _ hx => hx.smul c + +omit [CompleteSpace H] in +@[simp] +lemma mem_entireVectors {T : H →ₗ.[ℂ] H} {x : H} : + x ∈ T.entireVectors ↔ T.IsEntireVector x := Iff.rfl + +/-! ## The global-orbit essential-self-adjointness criterion -/ + +/-- A dense family of entire vectors is sufficient for essential self-adjointness. + +This is the part of Nelson's argument for which the global exponential orbit is available without +any continuation argument. The two deficiency spaces are killed directly: pair the global orbit +with a deficiency vector, solve the resulting scalar ODE, and send the real time to the end at +which the compensating exponential tends to zero. The original finite-radius Nelson theorem +below is stronger; it still requires the local-semigroup continuation step. -/ +theorem IsSymmetric.isEssentiallySelfAdjoint_of_denseEntireVectors + {T : H →ₗ.[ℂ] H} (hsym : T.IsSymmetric) + (hdense : T.entireVectors.topologicalClosure = ⊤) : + T.IsEssentiallySelfAdjoint := by + have hleAnalytic : T.entireVectors ≤ T.analyticVectors := by + intro x hx + exact IsEntireVector.isAnalyticVector hx + have hdenseAnalyticSubmodule : T.analyticVectors.topologicalClosure = ⊤ := by + apply top_unique + rw [← hdense] + exact Submodule.topologicalClosure_mono hleAnalytic + have hdenseAnalytic : + (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤ := + (dense_analyticVectors_iff (T := T)).mp hdenseAnalyticSubmodule + have hleDomain : T.entireVectors ≤ T.domain := by + intro x hx + exact analyticVectors_le_domain (IsEntireVector.isAnalyticVector hx) + have hdenseDomain : T.HasDenseDomain := by + have hdomainClosure : T.domain.topologicalClosure = ⊤ := by + apply top_unique + rw [← hdense] + exact Submodule.topologicalClosure_mono hleDomain + rw [LinearPMap.hasDenseDomain_def, dense_iff_closure_eq] + rw [← Submodule.topologicalClosure_coe, hdomainClosure] + rfl + have hT : T.IsClosable := hsym.isClosable hdenseDomain + have hspanEntire : + (Submodule.span ℂ (T.entireVectors : Set H)).topologicalClosure = ⊤ := by + rw [Submodule.span_eq] + exact hdense + have hdefect_plus : T.defectNumber Complex.I = 0 := by + rw [← defectNumber_closure (T := T) (z := Complex.I) + (hsym.mem_regularityDomain_of_im_ne_zero (by simp))] + show Module.rank ℂ ↥((T.closure - Complex.I • 1).toFun.rangeᗮ) = 0 + apply Submodule.rank_eq_zero.mpr + apply (Submodule.eq_bot_iff _).mpr + intro y hy + have hyspan : y ∈ (Submodule.span ℂ (T.entireVectors : Set H))ᗮ := by + rw [Submodule.mem_orthogonal'] + intro u hu + refine Submodule.span_induction (p := fun z _ ↦ ⟪y, z⟫_ℂ = 0) ?_ ?_ ?_ ?_ hu + · rintro z hz + obtain ⟨w, hw, hallw⟩ := mem_entireVectors.mp hz + exact analyticExp_inner_deficiency_eq_zero hsym hdenseAnalytic hw hallw hT hy + · simp + · intro z₁ z₂ _ _ hz₁ hz₂ + simp [inner_add_right, hz₁, hz₂] + · intro c z _ hz + simp [inner_smul_right, hz] + have hspanBot : + (Submodule.span ℂ (T.entireVectors : Set H))ᗮ = (⊥ : Submodule ℂ H) := + Submodule.topologicalClosure_eq_top_iff.mp hspanEntire + exact (Submodule.mem_bot ℂ).mp (hspanBot ▸ hyspan) + have hdefect_minus : T.defectNumber (-Complex.I) = 0 := by + rw [← defectNumber_closure (T := T) (z := -Complex.I) + (hsym.mem_regularityDomain_of_im_ne_zero (by simp))] + show Module.rank ℂ ↥((T.closure - (-Complex.I) • 1).toFun.rangeᗮ) = 0 + apply Submodule.rank_eq_zero.mpr + apply (Submodule.eq_bot_iff _).mpr + intro y hy + have hyspan : y ∈ (Submodule.span ℂ (T.entireVectors : Set H))ᗮ := by + rw [Submodule.mem_orthogonal'] + intro u hu + refine Submodule.span_induction (p := fun z _ ↦ ⟪y, z⟫_ℂ = 0) ?_ ?_ ?_ ?_ hu + · rintro z hz + obtain ⟨w, hw, hallw⟩ := mem_entireVectors.mp hz + exact analyticExp_inner_deficiency_eq_zero_neg hsym hdenseAnalytic hw hallw hT hy + · simp + · intro z₁ z₂ _ _ hz₁ hz₂ + simp [inner_add_right, hz₁, hz₂] + · intro c z _ hz + simp [inner_smul_right, hz] + have hspanBot : + (Submodule.span ℂ (T.entireVectors : Set H))ᗮ = (⊥ : Submodule ℂ H) := + Submodule.topologicalClosure_eq_top_iff.mp hspanEntire + exact (Submodule.mem_bot ℂ).mp (hspanBot ▸ hyspan) + exact hsym.isEssentiallySelfAdjoint_of_defectNumber_eq_zero + hdenseDomain hdefect_plus hdefect_minus + +/-! ## Common domain infrastructure for the finite-radius argument -/ + +omit [CompleteSpace H] in +@[nolint unusedArguments] +lemma hasDenseDomain_of_denseAnalyticVectors + {T : H →ₗ.[ℂ] H} + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) : + T.HasDenseDomain := by + have hspan : Dense (Submodule.span ℂ {x : H | T.IsAnalyticVector x} : Set H) := by + rw [dense_iff_closure_eq] + rw [← Submodule.topologicalClosure_coe] + exact congrArg (fun s : Submodule ℂ H => (s : Set H)) hdense + have hdomain : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}) ≤ T.domain := by + refine Submodule.span_le.2 (fun x hx => ?_) + exact IsAnalyticVector.mem_domain (by simpa using hx) + exact hspan.mono hdomain + +lemma IsSymmetric.closure_of_denseAnalyticVectors + {T : H →ₗ.[ℂ] H} (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) : + T.closure.IsSymmetric := + hsym.closure (hasDenseDomain_of_denseAnalyticVectors hdense) + +/-! ## The global-orbit certificate targeted by Nelson continuation -/ + +/-- A local norm-preserving orbit on a symmetric operator's analytic radius. The finite-radius +Nelson construction starts with this object and must extend it by overlapping local pieces. -/ +structure LocalAnalyticOrbit (T : H →ₗ.[ℂ] H) (x : H) where + /-- The radius on which the orbit is defined. -/ + radius : ℝ + radius_pos : 0 < radius + /-- The orbit itself, as a function of real time. -/ + toFun : ℝ → H + initial : toFun 0 = x + mem_domain : ∀ s, |s| < radius → toFun s ∈ T.closure.domain + hasDerivAt : ∀ (s : ℝ) (hs : |s| < radius), + HasDerivAt toFun + (Complex.I • T.closure ⟨toFun s, mem_domain s hs⟩) s + norm_eq : ∀ (s : ℝ) (_hs : |s| < radius), ‖toFun s‖ = ‖x‖ + + +end LinearPMap diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/AnalyticVector/Local.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/AnalyticVector/Local.lean new file mode 100644 index 0000000000..9c03386be8 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/AnalyticVector/Local.lean @@ -0,0 +1,1199 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.AnalyticVector.Basic + +/-! +# Analytic vectors for an unbounded operator (part 2 of 3: local and global orbits) + +Continuation of `AnalyticVector/Basic.lean`; this part covers `LocalAnalyticOrbit` and +`GlobalAnalyticOrbit`, the certificate objects the finite-radius +Nelson construction extends by overlapping local pieces (Reed–Simon Vol. II, Thm X.39). + +## Main definitions + +- `GlobalAnalyticOrbit` : a global norm-preserving orbit for a vector, with the differential + equation interpreted in the closed operator; the exact analytic certificate needed by the + deficiency argument. +- `LocalOrbitCover` / `LocalOrbitCoreCover` : a countable cover of `ℝ` by local analytic orbits, + agreeing pairwise on their overlaps, used to glue local charts into a global orbit. + +## Main results + +- `LocalAnalyticOrbit.eq_of_same_initial` : two local orbits based at the same state agree on the + intersection of their domains. +- `LocalOrbitCover.toGlobal` / `LocalOrbitCoreCover.toGlobal` : glue a cover into a single global + analytic orbit. +- `GlobalAnalyticOrbit.inner_deficiency_eq_zero` / `inner_deficiency_eq_zero_neg` : a global orbit + kills both deficiency spaces. +-/ + +@[expose] public section + +noncomputable section + +namespace LinearPMap + +open scoped InnerProductSpace Topology +open Filter + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +namespace LocalAnalyticOrbit + +instance {T : H →ₗ.[ℂ] H} {x : H} : CoeFun (LocalAnalyticOrbit T x) + (fun _ => ℝ → H) := ⟨LocalAnalyticOrbit.toFun⟩ + +/-- Recentring is the basic overlap operation in the finite-radius continuation argument. -/ +def translateTo {T : H →ₗ.[ℂ] H} {x : H} (U : LocalAnalyticOrbit T x) (a : ℝ) + (ha : |a| < U.radius) : LocalAnalyticOrbit T (U a) := + let r : ℝ := U.radius - |a| + { radius := r + radius_pos := sub_pos.mpr ha + toFun := fun s => U (a + s) + initial := by simp + mem_domain := fun s hs => by + have hsum : |a + s| ≤ |a| + |s| := abs_add_le _ _ + have hlt : |a| + |s| < U.radius := by + dsimp [r] at hs + linarith + exact U.mem_domain (a + s) (lt_of_le_of_lt hsum hlt) + hasDerivAt := fun s hs => by + have hsum : |a + s| ≤ |a| + |s| := abs_add_le _ _ + have hlt : |a| + |s| < U.radius := by + dsimp [r] at hs + linarith + have hcomp := U.hasDerivAt (a + s) (lt_of_le_of_lt hsum hlt) + have hcomp' := hcomp.comp_const_add a s + simpa only [Function.comp_def] using hcomp' + norm_eq := fun s hs => by + have hsum : |a + s| ≤ |a| + |s| := abs_add_le _ _ + have hlt : |a| + |s| < U.radius := by + dsimp [r] at hs + linarith + calc + ‖U (a + s)‖ = ‖x‖ := U.norm_eq (a + s) (lt_of_le_of_lt hsum hlt) + _ = ‖U a‖ := (U.norm_eq a ha).symm } + +omit [CompleteSpace H] in +@[nolint unusedArguments] +lemma translate {T : H →ₗ.[ℂ] H} {x : H} (U : LocalAnalyticOrbit T x) (a : ℝ) + (ha : |a| < U.radius) : Nonempty (LocalAnalyticOrbit T (U a)) := + ⟨U.translateTo a ha⟩ + +/-- The direct (non-`Nonempty`) form of chart restriction. -/ +def restrictTo {T : H →ₗ.[ℂ] H} {x : H} (U : LocalAnalyticOrbit T x) + {r : ℝ} (hr : 0 < r) (hrU : r ≤ U.radius) : LocalAnalyticOrbit T x := + { radius := r + radius_pos := hr + toFun := U + initial := U.initial + mem_domain := fun s hs => U.mem_domain s (lt_of_lt_of_le hs hrU) + hasDerivAt := fun s hs => U.hasDerivAt s (lt_of_lt_of_le hs hrU) + norm_eq := fun s hs => U.norm_eq s (lt_of_lt_of_le hs hrU) } + +omit [CompleteSpace H] in +/-- Restrict a local orbit to a smaller symmetric radius. Keeping this operation explicit is +useful for gluing: adjacent recentered charts need only agree on a deliberately chosen core of +their domains, while the original charts may have larger asymmetric overlaps. -/ +@[nolint unusedArguments] +lemma restrict {T : H →ₗ.[ℂ] H} {x : H} (U : LocalAnalyticOrbit T x) + {r : ℝ} (hr : 0 < r) (hrU : r ≤ U.radius) : + Nonempty (LocalAnalyticOrbit T x) := by + exact ⟨U.restrictTo hr hrU⟩ + +omit [CompleteSpace H] in +lemma eq_of_same_initial + {T : H →ₗ.[ℂ] H} {x : H} (U V : LocalAnalyticOrbit T x) + (hclosure_symm : T.closure.IsSymmetric) {s : ℝ} + (hs : |s| < min U.radius V.radius) : U s = V s := by + let r : ℝ := min U.radius V.radius + have hr : 0 < r := lt_min U.radius_pos V.radius_pos + have hinterval : ∀ y : ℝ, y ∈ Set.Ioo (-r) r → + HasDerivAt (fun q : ℝ => ‖U q - V q‖ ^ 2) 0 y := by + intro y hy + have hyabs : |y| < r := by + rw [abs_lt] + exact ⟨hy.1, hy.2⟩ + have hyU : |y| < U.radius := lt_of_lt_of_le hyabs (min_le_left _ _) + have hyV : |y| < V.radius := lt_of_lt_of_le hyabs (min_le_right _ _) + have hdom : U y - V y ∈ T.closure.domain := + T.closure.domain.sub_mem (U.mem_domain y hyU) (V.mem_domain y hyV) + let z : T.closure.domain := ⟨U y - V y, hdom⟩ + let u : T.closure.domain := ⟨U y, U.mem_domain y hyU⟩ + let v : T.closure.domain := ⟨V y, V.mem_domain y hyV⟩ + have hderivU := U.hasDerivAt y hyU + have hderivV := V.hasDerivAt y hyV + have hderiv : HasDerivAt (fun q : ℝ => U q - V q) + (Complex.I • T.closure z) y := by + have hsub := hderivU.sub hderivV + have hz : z = u - v := by + apply Subtype.ext + rfl + rw [hz, map_sub] + have hfun : (U.toFun - V.toFun) = (fun q : ℝ => U q - V q) := by + funext q + rfl + rw [hfun] at hsub + simpa [u, v, smul_sub] using hsub + let _ : InnerProductSpace ℝ H := InnerProductSpace.rclikeToReal ℂ H + have hnorm : HasDerivAt (fun q : ℝ => ‖U q - V q‖ ^ 2) + (2 * ⟪U y - V y, Complex.I • T.closure z⟫_ℝ) y := by + simpa [ContinuousLinearMap.toSpanSingleton_apply, inner_sub_left] using + hderiv.hasFDerivAt.norm_sq.hasDerivAt + have hinner := hclosure_symm.re_inner_smul_I_apply_self z + have hinner' : ⟪U y - V y, Complex.I • T.closure z⟫_ℝ = 0 := by + simpa [z, real_inner_eq_re_inner] using hinner + simpa [hinner'] using hnorm + have hconst : ∀ {a b : ℝ}, a ∈ Set.Ioo (-r) r → b ∈ Set.Ioo (-r) r → + ‖U a - V a‖ ^ 2 = ‖U b - V b‖ ^ 2 := by + intro a b ha hb + exact isOpen_Ioo.is_const_of_deriv_eq_zero + (s := Set.Ioo (-r) r) (f := fun q : ℝ => ‖U q - V q‖ ^ 2) + (isPreconnected_Ioo (a := -r) (b := r)) + (fun q hq => (hinterval q hq).differentiableAt.differentiableWithinAt) + (fun q hq => (hinterval q hq).deriv) ha hb + have hzero_mem : (0 : ℝ) ∈ Set.Ioo (-r) r := by + constructor <;> linarith + have hs_mem : s ∈ Set.Ioo (-r) r := by + change -r < s ∧ s < r + exact abs_lt.mp hs + have hnormsq : ‖U s - V s‖ ^ 2 = 0 := by + rw [hconst hs_mem hzero_mem] + simp [U.initial, V.initial] + apply sub_eq_zero.mp + apply norm_eq_zero.mp + nlinarith [sq_nonneg ‖U s - V s‖] + +/-! A translated chart and a chart independently based at the translated state agree on every +smaller symmetric core. This is the elementary overlap statement used by the integer-chart +continuation below; the explicit radius inequalities keep the asymmetric translated radius out of +the later gluing proof. -/ +omit [CompleteSpace H] in +lemma translate_eq_of_same_initial_on_core + {T : H →ₗ.[ℂ] H} {x : H} (U : LocalAnalyticOrbit T x) + (hclosure_symm : T.closure.IsSymmetric) {δ R : ℝ} + (hδ : 0 < δ) (hR : 0 < R) (hδU : δ + R ≤ U.radius) + (V : LocalAnalyticOrbit T (U δ)) (hVR : R ≤ V.radius) {s : ℝ} + (hs : |s| < R) : U (δ + s) = V s := by + have hδU' : |δ| < U.radius := by + rw [abs_of_pos hδ] + linarith + let W : LocalAnalyticOrbit T (U δ) := U.translateTo δ hδU' + have hWR : R ≤ W.radius := by + dsimp [W, translateTo] + rw [abs_of_pos hδ] + linarith + have hsW : |s| < W.radius := lt_of_lt_of_le hs hWR + have hsV : |s| < V.radius := lt_of_lt_of_le hs hVR + have heq := LocalAnalyticOrbit.eq_of_same_initial W V hclosure_symm + (lt_min hsW hsV) + change U (δ + s) = V s at heq + exact heq + +omit [CompleteSpace H] in +lemma translate_eq_of_same_initial_on_core' + {T : H →ₗ.[ℂ] H} {x : H} (U : LocalAnalyticOrbit T x) + (hclosure_symm : T.closure.IsSymmetric) {a R : ℝ} + (hR : 0 < R) (haU : |a| + R ≤ U.radius) + (V : LocalAnalyticOrbit T (U a)) (hVR : R ≤ V.radius) {s : ℝ} + (hs : |s| < R) : U (a + s) = V s := by + have haU' : |a| < U.radius := by linarith + let W : LocalAnalyticOrbit T (U a) := U.translateTo a haU' + have hWR : R ≤ W.radius := by + dsimp [W, translateTo] + linarith + have heq := LocalAnalyticOrbit.eq_of_same_initial W V hclosure_symm + (lt_min (lt_of_lt_of_le hs hWR) (lt_of_lt_of_le hs hVR)) + change U (a + s) = V s at heq + exact heq + +omit [CompleteSpace H] in +/-- Transport a local orbit certificate for the closure back to a closable operator. This is the +local counterpart of `GlobalAnalyticOrbit.of_closure`; it is needed when a fresh chart is produced +recursively for the closed operator but the public continuation interface is phrased for `T`. -/ +@[nolint unusedArguments] +lemma of_closure {T : H →ₗ.[ℂ] H} {x : H} (hT : T.IsClosable) + (U : LocalAnalyticOrbit T.closure x) : Nonempty (LocalAnalyticOrbit T x) := by + have hclosed : T.closure.closure = T.closure := hT.closure_isClosed.closure_eq + have happly : ∀ (z : H) (hz : z ∈ T.closure.domain) + (hz' : z ∈ T.closure.closure.domain), + T.closure.closure ⟨z, hz'⟩ = T.closure ⟨z, hz⟩ := by + intro z hz hz' + have hgraph : (z, T.closure.closure ⟨z, hz'⟩) ∈ T.closure.graph := by + have hgraph_eq : T.closure.closure.graph = T.closure.graph := + congrArg (fun R : H →ₗ.[ℂ] H => R.graph) hclosed + exact hgraph_eq ▸ T.closure.closure.mem_graph ⟨z, hz'⟩ + exact T.closure.mem_graph_snd_inj' hgraph + (T.closure.mem_graph ⟨z, hz⟩) rfl + refine ⟨ + { radius := U.radius + radius_pos := U.radius_pos + toFun := U + initial := U.initial + mem_domain := fun s hs => by + simpa only [hclosed] using U.mem_domain s hs + hasDerivAt := fun s hs => by + have hz' : U s ∈ T.closure.closure.domain := U.mem_domain s hs + have hz : U s ∈ T.closure.domain := by + simpa only [hclosed] using hz' + have hd := U.hasDerivAt s hs + convert hd using 1 + congr 1 + exact (happly _ hz hz').symm + norm_eq := U.norm_eq }⟩ + +end LocalAnalyticOrbit + +/-- A global norm-preserving orbit for a vector, with the differential equation interpreted in the +closed operator. This is the exact analytic certificate needed by the deficiency argument; the +finite-radius Nelson proof constructs it by patching the local exponential series. -/ +structure GlobalAnalyticOrbit (T : H →ₗ.[ℂ] H) (x : H) where + /-- The orbit itself, as a function of real time. -/ + toFun : ℝ → H + initial : toFun 0 = x + mem_domain : ∀ s, toFun s ∈ T.closure.domain + hasDerivAt : ∀ s, HasDerivAt toFun + (Complex.I • T.closure ⟨toFun s, mem_domain s⟩) s + norm_eq : ∀ s, ‖toFun s‖ = ‖x‖ + +namespace GlobalAnalyticOrbit + +instance {T : H →ₗ.[ℂ] H} {x : H} : CoeFun (GlobalAnalyticOrbit T x) + (fun _ => ℝ → H) := ⟨GlobalAnalyticOrbit.toFun⟩ + +lemma exists_bound_choose_mul_geometric {r : ℝ} (hr : 0 ≤ r) (hr' : r < 1) (k : ℕ) : + ∃ C : ℝ, ∀ n : ℕ, (n + k).choose k * r ^ n ≤ C := by + have hnorm : ‖r‖ < 1 := by + simpa [Real.norm_eq_abs, abs_of_nonneg hr] using hr' + have hsum : Summable (fun n : ℕ => (n + k).choose k * r ^ n) := + summable_choose_mul_geometric_of_norm_lt_one k hnorm + refine ⟨∑' n : ℕ, (n + k).choose k * r ^ n, fun n => ?_⟩ + exact hsum.le_tsum n (fun j _ => by positivity) + +lemma summable_shifted_factorial_majorant {a : ℕ → ℝ} {t q : ℝ} + (ha : ∀ n, 0 ≤ a n) (ht : 0 < t) (hq : 0 ≤ q) (hqt : q < t) (k : ℕ) + (hsum : Summable (fun n : ℕ => a n * t ^ n / n.factorial)) : + Summable (fun n : ℕ => a (n + k) * q ^ n / n.factorial) := by + let r : ℝ := q / t + have hr : 0 ≤ r := div_nonneg hq ht.le + have hr' : r < 1 := by + dsimp [r] + exact (div_lt_one ht).2 hqt + obtain ⟨C, hC⟩ := exists_bound_choose_mul_geometric hr hr' k + have hC0 : 0 ≤ C := by + have h := hC 0 + norm_num at h + linarith + let b : ℕ → ℝ := fun n => a (n + k) * t ^ (n + k) / (n + k).factorial + have hb : Summable b := by + dsimp [b] + exact (summable_nat_add_iff + (f := fun n : ℕ => a n * t ^ n / n.factorial) k).2 hsum + let K : ℝ := C * (k.factorial : ℝ) / t ^ k + have hK : 0 ≤ K := by + positivity + refine Summable.of_nonneg_of_le + (fun n => div_nonneg (mul_nonneg (ha (n + k)) (pow_nonneg hq _)) (by positivity)) ?_ + (hb.mul_left K) + intro n + have hchoose : (n + k).choose k * r ^ n ≤ C := hC n + have hbase : 0 ≤ b n := by + dsimp [b] + exact div_nonneg (mul_nonneg (ha (n + k)) (pow_nonneg ht.le _)) (by positivity) + have hcoef : (k.factorial : ℝ) * (n + k).choose k * r ^ n / t ^ k ≤ + C * (k.factorial : ℝ) / t ^ k := by + have hfac : 0 ≤ (k.factorial : ℝ) / t ^ k := by positivity + calc + (k.factorial : ℝ) * (n + k).choose k * r ^ n / t ^ k = + ((n + k).choose k * r ^ n) * ((k.factorial : ℝ) / t ^ k) := by + ring + _ ≤ C * ((k.factorial : ℝ) / t ^ k) := + mul_le_mul_of_nonneg_right hchoose hfac + _ = C * (k.factorial : ℝ) / t ^ k := by ring + calc + a (n + k) * q ^ n / n.factorial = + b n * ((k.factorial : ℝ) * (n + k).choose k * r ^ n / t ^ k) := by + dsimp [b, r] + have hfact : (n.factorial : ℝ) * (k.factorial : ℝ) * + (n + k).choose k = (n + k).factorial := by + have h := Nat.factorial_mul_descFactorial + (n := n + k) (k := k) (Nat.le_add_left k n) + rw [Nat.descFactorial_eq_factorial_mul_choose] at h + have hnk : n + k - k = n := by omega + rw [hnk] at h + norm_cast + simpa [mul_assoc] using h + have hfact' : (n + k).factorial = + (n.factorial : ℝ) * ((k.factorial : ℝ) * (n + k).choose k) := by + rw [← hfact] + ring + rw [div_pow] + field_simp [ne_of_gt ht] + rw [hfact'] + ring + _ ≤ b n * K := mul_le_mul_of_nonneg_left hcoef hbase + _ = K * b n := by rw [mul_comm] + +/-- The iterate sequence `v` shifted by `k` steps, `n ↦ v (n + k)`. -/ +def shiftedIterates {T : H →ₗ.[ℂ] H} (v : ℕ → T.domain) (k : ℕ) : ℕ → T.domain := + fun n => v (n + k) + +omit [CompleteSpace H] in +@[nolint unusedArguments] +lemma IteratesSeq.shift {T : H →ₗ.[ℂ] H} {x : H} {v : ℕ → T.domain} + (hv : IteratesSeq T x v) (k : ℕ) : + IteratesSeq T (v k) (shiftedIterates v k) := by + refine ⟨?_, fun n => ?_⟩ + · simp [shiftedIterates] + · change (v (n + 1 + k) : H) = T (v (n + k)) + rw [show n + 1 + k = (n + k) + 1 by omega, hv.2] + +omit [CompleteSpace H] in +@[nolint unusedArguments] +lemma summable_shifted_iterates {T : H →ₗ.[ℂ] H} {v : ℕ → T.domain} + {t q : ℝ} (ht : 0 < t) (hq : 0 ≤ q) (hqt : q < t) (k : ℕ) + (hsum : Summable (fun n : ℕ => ‖(v n : H)‖ * t ^ n / n.factorial)) : + Summable (fun n : ℕ => ‖(shiftedIterates v k n : H)‖ * q ^ n / n.factorial) := by + exact summable_shifted_factorial_majorant + (a := fun n : ℕ => ‖(v n : H)‖) (t := t) (q := q) + (fun n => norm_nonneg _) ht hq hqt k (by simpa using hsum) + +@[nolint unusedArguments] +lemma neg_I_smul_tsum_analyticExpDerivTerm_shift_eq + {T : H →ₗ.[ℂ] H} {x : H} {v : ℕ → T.domain} (_hv : IteratesSeq T x v) + {t s : ℝ} (ht : 0 < t) (hs : s ∈ Set.Ioo (-t / 2) (t / 2)) + (hsum : Summable (fun n : ℕ => ‖(v n : H)‖ * t ^ n / n.factorial)) (k : ℕ) : + (-Complex.I) • (∑' n, analyticExpDerivTerm T (shiftedIterates v k) s n) = + analyticExp T (shiftedIterates v (k + 1)) s := by + have hsabs : |s| < t / 2 := by + rw [abs_lt] + exact ⟨by linarith [hs.1], by linarith [hs.2]⟩ + let t' : ℝ := (t + 2 * |s|) / 2 + have ht' : 0 < t' := by + dsimp [t'] + linarith [ht, abs_nonneg s] + have h2s : 2 * |s| < t' := by + dsimp [t'] + linarith [hsabs] + have ht't : t' < t := by + dsimp [t'] + linarith [hsabs] + have hsum_k : Summable (fun n : ℕ => + ‖(shiftedIterates v k n : H)‖ * t' ^ n / n.factorial) := + summable_shifted_iterates (v := v) ht ht'.le ht't k hsum + have hsum_k1 : Summable (fun n : ℕ => + ‖(shiftedIterates v (k + 1) n : H)‖ * t' ^ n / n.factorial) := + summable_shifted_iterates (v := v) ht ht'.le ht't (k + 1) hsum + have hs' : s ∈ Set.Ioo (-t' / 2) (t' / 2) := by + change -t' / 2 < s ∧ s < t' / 2 + constructor <;> linarith [neg_le_abs s, le_abs_self s, h2s] + have hderiv := summable_analyticExpDerivTerm_of_mem_half_radius + (T := T) (v := shiftedIterates v k) ht' hs' hsum_k + have hsum_next : Summable (fun n : ℕ => analyticExpTerm T + (shiftedIterates v (k + 1)) s n) := by + exact IsAnalyticVector.summable_analyticExpTerm + (t := t') (le_of_lt (by linarith [h2s])) hsum_k1 + let d : ℕ → H := fun n => (-Complex.I) • + analyticExpDerivTerm T (shiftedIterates v k) s n + have htail : HasSum (fun n => d (n + 1)) + (analyticExp T (shiftedIterates v (k + 1)) s - d 0) := by + convert hsum_next.hasSum using 1 + · funext n + dsimp [d, analyticExpDerivTerm, analyticExpTerm, shiftedIterates] + rw [show n + 1 + k = n + (k + 1) by omega] + simp only [smul_smul] + congr 1 + rw [Nat.factorial_succ] + field_simp [Nat.factorial_ne_zero] + push_cast + ring_nf + simp [Complex.I_sq] + · simp [analyticExp, d, analyticExpDerivTerm] + have hd : HasSum d ((-Complex.I) • + (∑' n, analyticExpDerivTerm T (shiftedIterates v k) s n)) := by + simpa [d] using hderiv.hasSum.const_smul (-Complex.I) + have hd' : HasSum d (analyticExp T (shiftedIterates v (k + 1)) s) := by + have htail0 : HasSum (fun n => d (n + 1)) + (analyticExp T (shiftedIterates v (k + 1)) s - + ∑ i ∈ Finset.range 1, d i) := by + simpa [d, analyticExpDerivTerm] using htail + have htail' := (hasSum_nat_add_iff' (G := H) (f := d) + (g := analyticExp T (shiftedIterates v (k + 1)) s) 1).mp htail0 + simpa [d, analyticExpDerivTerm, analyticExp] using htail' + exact hd.unique hd' + +lemma IsAnalyticVector.localAnalyticOrbit_at_exp + {T : H →ₗ.[ℂ] H} {x : H} {v : ℕ → T.domain} (hv : IteratesSeq T x v) + {t a : ℝ} (ht : 0 < t) (ha : |a| < t / 2) + (hsum : Summable (fun n : ℕ => ‖(v n : H)‖ * t ^ n / n.factorial)) + (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) : + Nonempty (LocalAnalyticOrbit T (analyticExp T v a)) := by + have hdenseDomain : T.HasDenseDomain := hasDenseDomain_of_denseAnalyticVectors hdense + have hT : T.IsClosable := hsym.isClosable hdenseDomain + have hTcloseSym : T.closure.IsSymmetric := hsym.closure hdenseDomain + have hTcloseDense : T.closure.HasDenseDomain := hdenseDomain.closure + have hspan_le : Submodule.span ℂ {x : H | T.IsAnalyticVector x} ≤ + Submodule.span ℂ {x : H | T.closure.IsAnalyticVector x} := by + apply Submodule.span_mono + intro z hz + exact IsAnalyticVector.for_closure hz + have hclosedense : + (Submodule.span ℂ {x : H | T.closure.IsAnalyticVector x}).topologicalClosure = ⊤ := by + apply le_antisymm le_top + exact hdense ▸ Submodule.topologicalClosure_mono hspan_le + have hsabs : |a| < t / 2 := ha + let t' : ℝ := (t + 2 * |a|) / 2 + have ht' : 0 < t' := by + dsimp [t'] + linarith [ht, abs_nonneg a] + have h2a : 2 * |a| < t' := by + dsimp [t'] + linarith [hsabs] + have ht't : t' < t := by + dsimp [t'] + linarith [hsabs] + have hs' : a ∈ Set.Ioo (-t' / 2) (t' / 2) := by + change -t' / 2 < a ∧ a < t' / 2 + constructor <;> linarith [neg_le_abs a, le_abs_self a, h2a] + have hsum_shift : ∀ k : ℕ, Summable (fun n : ℕ => + ‖(shiftedIterates v k n : H)‖ * t' ^ n / n.factorial) := by + intro k + exact summable_shifted_iterates (v := v) ht ht'.le ht't k hsum + let w : ℕ → T.closure.domain := fun k => + ⟨analyticExp T (shiftedIterates v k) a, + analyticExp_mem_closure_domain (IteratesSeq.shift hv k) hT hs' (hsum_shift k)⟩ + have hw : IteratesSeq T.closure (analyticExp T v a) w := by + refine ⟨?_, fun k => ?_⟩ + · change analyticExp T (shiftedIterates v 0) a = analyticExp T v a + congr 2 + · have happly := closure_analyticExp_apply (IteratesSeq.shift hv k) hT hs' (hsum_shift k) + have ha_mem : a ∈ Set.Ioo (-t / 2) (t / 2) := by + change -t / 2 < a ∧ a < t / 2 + exact ⟨by linarith [neg_le_abs a, ha], by linarith [le_abs_self a, ha]⟩ + have hshift := neg_I_smul_tsum_analyticExpDerivTerm_shift_eq hv ht ha_mem hsum k + change analyticExp T (shiftedIterates v (k + 1)) a = + T.closure ⟨analyticExp T (shiftedIterates v k) a, _⟩ + rw [happly, hshift] + have hsum_half : Summable (fun k : ℕ => + ‖(shiftedIterates v 0 k : H)‖ * (t / 2) ^ k / k.factorial) := by + exact summable_shifted_iterates (v := v) ht (by positivity) (by linarith) 0 hsum + have hsum_w : Summable (fun k : ℕ => ‖(w k : H)‖ * (t / 2) ^ k / k.factorial) := by + refine hsum_half.congr (fun k => ?_) + have hnorm := analyticExp_norm_eq_norm hsym hdense (IteratesSeq.shift hv k) hs' (hsum_shift k) + change ‖(shiftedIterates v 0 k : H)‖ * (t / 2) ^ k / k.factorial = + ‖analyticExp T (shiftedIterates v k) a‖ * (t / 2) ^ k / k.factorial + rw [hnorm] + simp [shiftedIterates] + have hTclose : T.closure.closure = T.closure := hT.closure_isClosed.closure_eq + have hSclosable : T.closure.IsClosable := hT.closure_isClosed.isClosable + have hr : 0 < (t / 2) / 2 := by linarith + have happly_closure : ∀ (z : H) (hz : z ∈ T.closure.domain) + (hz' : z ∈ T.closure.closure.domain), + T.closure.closure ⟨z, hz'⟩ = T.closure ⟨z, hz⟩ := by + intro z hz hz' + have hgraph : (z, T.closure.closure ⟨z, hz'⟩) ∈ T.closure.graph := by + have hgraph_eq : T.closure.closure.graph = T.closure.graph := + congrArg (fun R : H →ₗ.[ℂ] H => R.graph) hTclose + exact hgraph_eq ▸ T.closure.closure.mem_graph ⟨z, hz'⟩ + exact T.closure.mem_graph_snd_inj' hgraph + (T.closure.mem_graph ⟨z, hz⟩) rfl + refine ⟨ + { radius := (t / 2) / 2 + radius_pos := hr + toFun := fun s => analyticExp T.closure w s + initial := analyticExp_zero hw + mem_domain := fun s hs => by + rw [abs_lt] at hs + have hs' : s ∈ Set.Ioo (-(t / 2) / 2) ((t / 2) / 2) := by + change -(t / 2) / 2 < s ∧ s < (t / 2) / 2 + exact ⟨by linarith [hs.1], by linarith [hs.2]⟩ + have hd := analyticExp_mem_closure_domain hw hSclosable hs' hsum_w + simpa only [hTclose] using hd + hasDerivAt := fun s hs => by + rw [abs_lt] at hs + have hs' : s ∈ Set.Ioo (-(t / 2) / 2) ((t / 2) / 2) := by + change -(t / 2) / 2 < s ∧ s < (t / 2) / 2 + exact ⟨by linarith [hs.1], by linarith [hs.2]⟩ + have hd := analyticExp_hasDerivAt_eq_smul_closure hw hSclosable hs' hsum_w + have hz : analyticExp T.closure w s ∈ T.closure.domain := by + simpa only [hTclose] using analyticExp_mem_closure_domain hw hSclosable hs' hsum_w + convert hd using 1 + congr 1 + exact (happly_closure _ hz + (analyticExp_mem_closure_domain hw hSclosable hs' hsum_w)).symm + , norm_eq := fun s hs => by + rw [abs_lt] at hs + have hs' : s ∈ Set.Ioo (-(t / 2) / 2) ((t / 2) / 2) := by + change -(t / 2) / 2 < s ∧ s < (t / 2) / 2 + exact ⟨by linarith [hs.1], by linarith [hs.2]⟩ + exact analyticExp_norm_eq_norm hTcloseSym hclosedense hw hs' hsum_w }⟩ + +/-- The change-of-origin construction exposes the actual analytic-vector witness of the reached +state. This is the recursive part of the finite-radius continuation argument: a local chart alone +does not provide enough data to apply the same construction again, whereas this theorem supplies +the shifted iterates and their smaller-radius factorial majorant for the closed operator. -/ +lemma IsAnalyticVector.analyticExp_at_isAnalyticVector + {T : H →ₗ.[ℂ] H} {x : H} {v : ℕ → T.domain} (hv : IteratesSeq T x v) + {t a : ℝ} (ht : 0 < t) (ha : |a| < t / 2) + (hsum : Summable (fun n : ℕ => ‖(v n : H)‖ * t ^ n / n.factorial)) + (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) : + T.closure.IsAnalyticVector (analyticExp T v a) := by + have hdenseDomain : T.HasDenseDomain := hasDenseDomain_of_denseAnalyticVectors hdense + have hT : T.IsClosable := hsym.isClosable hdenseDomain + have hspan_le : Submodule.span ℂ {x : H | T.IsAnalyticVector x} ≤ + Submodule.span ℂ {x : H | T.closure.IsAnalyticVector x} := by + apply Submodule.span_mono + intro z hz + exact IsAnalyticVector.for_closure hz + have hclosedense : + (Submodule.span ℂ {x : H | T.closure.IsAnalyticVector x}).topologicalClosure = ⊤ := by + apply le_antisymm le_top + exact hdense ▸ Submodule.topologicalClosure_mono hspan_le + let t' : ℝ := (t + 2 * |a|) / 2 + have ht' : 0 < t' := by + dsimp [t'] + linarith [ht, abs_nonneg a] + have ht't : t' < t := by + dsimp [t'] + linarith [ha] + have hsum_shift : ∀ k : ℕ, Summable (fun n : ℕ => + ‖(shiftedIterates v k n : H)‖ * t' ^ n / n.factorial) := by + intro k + exact summable_shifted_iterates (v := v) ht ht'.le ht't k hsum + have hs' : a ∈ Set.Ioo (-t' / 2) (t' / 2) := by + change -t' / 2 < a ∧ a < t' / 2 + have h2a : 2 * |a| < t' := by + dsimp [t'] + linarith [ha] + constructor <;> linarith [neg_le_abs a, le_abs_self a, h2a] + let w : ℕ → T.closure.domain := fun k => + ⟨analyticExp T (shiftedIterates v k) a, + analyticExp_mem_closure_domain (IteratesSeq.shift hv k) hT hs' + (hsum_shift k)⟩ + have hw : IteratesSeq T.closure (analyticExp T v a) w := by + refine ⟨?_, fun k => ?_⟩ + · change analyticExp T (shiftedIterates v 0) a = analyticExp T v a + congr 2 + · have happly := closure_analyticExp_apply (IteratesSeq.shift hv k) hT hs' + (hsum_shift k) + have ha_mem : a ∈ Set.Ioo (-t / 2) (t / 2) := by + change -t / 2 < a ∧ a < t / 2 + exact ⟨by linarith [neg_le_abs a, ha], by linarith [le_abs_self a, ha]⟩ + have hshift := neg_I_smul_tsum_analyticExpDerivTerm_shift_eq hv ht ha_mem hsum k + change analyticExp T (shiftedIterates v (k + 1)) a = + T.closure ⟨analyticExp T (shiftedIterates v k) a, _⟩ + rw [happly, hshift] + have hsum_half : Summable (fun k : ℕ => + ‖(shiftedIterates v 0 k : H)‖ * (t / 2) ^ k / k.factorial) := by + exact summable_shifted_iterates (v := v) ht (by positivity) (by linarith) 0 hsum + have hsum_w : Summable (fun k : ℕ => + ‖(w k : H)‖ * (t / 2) ^ k / k.factorial) := by + refine hsum_half.congr (fun k => ?_) + have hnorm := analyticExp_norm_eq_norm hsym hdense (IteratesSeq.shift hv k) hs' + (hsum_shift k) + change ‖(shiftedIterates v 0 k : H)‖ * (t / 2) ^ k / k.factorial = + ‖analyticExp T (shiftedIterates v k) a‖ * (t / 2) ^ k / k.factorial + rw [hnorm] + simp [shiftedIterates] + exact ⟨w, hw, t / 2, by linarith, hsum_w⟩ + +/-- Sharp-radius form of `analyticExp_at_isAnalyticVector`: changing origin inside the +half-radius does not consume the analytic radius. Every strictly smaller radius than the +original one remains available at the reached state. This is the uniform-radius estimate used +to iterate local charts indefinitely. -/ +lemma IsAnalyticVector.analyticExp_at_isAnalyticVector_witness_of_radius + {T : H →ₗ.[ℂ] H} {x : H} {v : ℕ → T.domain} (hv : IteratesSeq T x v) + {t a q : ℝ} (ht : 0 < t) (ha : |a| < t / 2) (hq : 0 < q) (hqt : q < t) + (hsum : Summable (fun n : ℕ => ‖(v n : H)‖ * t ^ n / n.factorial)) + (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) : + ∃ w : ℕ → T.closure.domain, IteratesSeq T.closure (analyticExp T v a) w ∧ + 0 < q ∧ Summable (fun n : ℕ => ‖(w n : H)‖ * q ^ n / n.factorial) := by + have hdenseDomain : T.HasDenseDomain := hasDenseDomain_of_denseAnalyticVectors hdense + have hT : T.IsClosable := hsym.isClosable hdenseDomain + have hspan_le : Submodule.span ℂ {x : H | T.IsAnalyticVector x} ≤ + Submodule.span ℂ {x : H | T.closure.IsAnalyticVector x} := by + apply Submodule.span_mono + intro z hz + exact IsAnalyticVector.for_closure hz + have hclosedense : + (Submodule.span ℂ {x : H | T.closure.IsAnalyticVector x}).topologicalClosure = ⊤ := by + apply le_antisymm le_top + exact hdense ▸ Submodule.topologicalClosure_mono hspan_le + let u : ℝ := (max (2 * |a|) q + t) / 2 + have h2a : 2 * |a| < t := by linarith [ha] + have hmax : max (2 * |a|) q < t := (max_lt_iff).2 ⟨h2a, hqt⟩ + have hmax_nonneg : 0 ≤ max (2 * |a|) q := + le_trans (by positivity) (le_max_left _ _) + have hqmax : q ≤ max (2 * |a|) q := le_max_right _ _ + have h2amax : 2 * |a| ≤ max (2 * |a|) q := le_max_left _ _ + have hu : 0 < u := by + dsimp [u] + linarith [ht, hmax_nonneg] + have hqu : q < u := by + dsimp [u] + linarith [hmax, hqmax] + have h2au : 2 * |a| < u := by + dsimp [u] + linarith [hmax, h2amax] + have hut : u < t := by + dsimp [u] + linarith [hmax] + have hs' : a ∈ Set.Ioo (-u / 2) (u / 2) := by + change -u / 2 < a ∧ a < u / 2 + constructor <;> linarith [neg_le_abs a, le_abs_self a, h2au] + have hsum_u : ∀ k : ℕ, Summable (fun n : ℕ => + ‖(shiftedIterates v k n : H)‖ * u ^ n / n.factorial) := by + intro k + exact summable_shifted_iterates (v := v) ht hu.le hut k hsum + have hsum_q : ∀ k : ℕ, Summable (fun n : ℕ => + ‖(shiftedIterates v k n : H)‖ * q ^ n / n.factorial) := by + intro k + exact summable_shifted_iterates (v := v) ht (le_of_lt hq) hqt k hsum + let w : ℕ → T.closure.domain := fun k => + ⟨analyticExp T (shiftedIterates v k) a, + analyticExp_mem_closure_domain (IteratesSeq.shift hv k) hT hs' + (hsum_u k)⟩ + have hw : IteratesSeq T.closure (analyticExp T v a) w := by + refine ⟨?_, fun k => ?_⟩ + · change analyticExp T (shiftedIterates v 0) a = analyticExp T v a + congr 2 + · have happly := closure_analyticExp_apply (IteratesSeq.shift hv k) hT hs' + (hsum_u k) + have ha_mem : a ∈ Set.Ioo (-t / 2) (t / 2) := by + change -t / 2 < a ∧ a < t / 2 + exact ⟨by linarith [neg_le_abs a, ha], by linarith [le_abs_self a, ha]⟩ + have hshift := neg_I_smul_tsum_analyticExpDerivTerm_shift_eq hv ht ha_mem hsum k + change analyticExp T (shiftedIterates v (k + 1)) a = + T.closure ⟨analyticExp T (shiftedIterates v k) a, _⟩ + rw [happly, hshift] + have hsum_w : Summable (fun k : ℕ => + ‖(w k : H)‖ * q ^ k / k.factorial) := by + have hsum_shift_q := hsum_q + refine (hsum_shift_q 0).congr (fun k => ?_) + have hnorm := analyticExp_norm_eq_norm hsym hdense (IteratesSeq.shift hv k) hs' + (hsum_u k) + change ‖(shiftedIterates v 0 k : H)‖ * q ^ k / k.factorial = + ‖analyticExp T (shiftedIterates v k) a‖ * q ^ k / k.factorial + rw [hnorm] + simp [shiftedIterates] + exact ⟨w, hw, hq, hsum_w⟩ + +lemma IsAnalyticVector.analyticExp_at_isAnalyticVector_of_radius + {T : H →ₗ.[ℂ] H} {x : H} {v : ℕ → T.domain} (hv : IteratesSeq T x v) + {t a q : ℝ} (ht : 0 < t) (ha : |a| < t / 2) (hq : 0 < q) (hqt : q < t) + (hsum : Summable (fun n : ℕ => ‖(v n : H)‖ * t ^ n / n.factorial)) + (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) : + T.closure.IsAnalyticVector (analyticExp T v a) := by + obtain ⟨w, hw, hq', hsum_w⟩ := + IsAnalyticVector.analyticExp_at_isAnalyticVector_witness_of_radius + hv ht ha hq hqt hsum hsym hdense + exact ⟨w, hw, q, hq', hsum_w⟩ + +/-! ### Gluing local charts + +The following cover is deliberately an interface: the analytic change-of-origin estimate belongs +to the finite-radius part of Nelson's theorem, while the topological gluing is independent of it. -/ + +/-- A countable cover of `ℝ` by local analytic orbits, all based at states of the same norm as +`x`, agreeing pairwise on their overlaps. -/ +structure LocalOrbitCover (T : H →ₗ.[ℂ] H) (x : H) where + /-- The state each local chart is based at. -/ + state : ℕ → H + /-- The real-time center of each local chart. -/ + center : ℕ → ℝ + /-- The local analytic orbit chart based at `state n`. -/ + chart : ∀ n, LocalAnalyticOrbit T (state n) + center_zero : center 0 = 0 + state_zero : state 0 = x + state_norm : ∀ n, ‖state n‖ = ‖x‖ + cover : ∀ s : ℝ, ∃ n : ℕ, |s - center n| < (chart n).radius + compatible : ∀ (m n : ℕ) (s : ℝ), + |s - center m| < (chart m).radius → |s - center n| < (chart n).radius → + chart m (s - center m) = chart n (s - center n) + +/-! A cover may use smaller symmetric cores of its charts. This avoids requiring compatibility on +the full overlap of two symmetric charts, which need not be contained in a recentered symmetric +domain. -/ + +/-- A `LocalOrbitCover` where compatibility is only required on a (possibly smaller) symmetric +core of each chart's radius. -/ +structure LocalOrbitCoreCover (T : H →ₗ.[ℂ] H) (x : H) where + /-- The state each local chart is based at. -/ + state : ℕ → H + /-- The real-time center of each local chart. -/ + center : ℕ → ℝ + /-- The local analytic orbit chart based at `state n`. -/ + chart : ∀ n, LocalAnalyticOrbit T (state n) + /-- The radius of the (possibly smaller) core used for compatibility. -/ + coreRadius : ℕ → ℝ + core_pos : ∀ n, 0 < coreRadius n + core_le : ∀ n, coreRadius n ≤ (chart n).radius + center_zero : center 0 = 0 + state_zero : state 0 = x + state_norm : ∀ n, ‖state n‖ = ‖x‖ + cover : ∀ s : ℝ, ∃ n : ℕ, |s - center n| < coreRadius n + compatible : ∀ (m n : ℕ) (s : ℝ), + |s - center m| < coreRadius m → |s - center n| < coreRadius n → + chart m (s - center m) = chart n (s - center n) + +lemma exists_int_center_of_pos_step {δ R s : ℝ} (hδ : 0 < δ) (hδR : δ < R) : + ∃ n : ℤ, |s - (n : ℝ) * δ| < R := by + let n : ℤ := ⌊s / δ⌋ + have hfloor : (n : ℝ) ≤ s / δ := by + dsimp [n] + exact Int.floor_le _ + have hnext : s / δ < (n : ℝ) + 1 := by + dsimp [n] + exact Int.lt_floor_add_one _ + have hlow : (n : ℝ) * δ ≤ s := by + have := (le_div_iff₀ hδ).mp hfloor + simpa [mul_comm] using this + have hupp : s < (n : ℝ) * δ + δ := by + have := (div_lt_iff₀ hδ).mp hnext + simpa [add_mul] using this + refine ⟨n, ?_⟩ + have hnonneg : 0 ≤ s - (n : ℝ) * δ := sub_nonneg.mpr hlow + rw [abs_of_nonneg hnonneg] + linarith + +/-! The purely one-dimensional part of integer-chart gluing. If consecutive charts agree after +translation by `δ`, agreement propagates along the whole integer chain. The endpoint hypotheses +are enough: the distance to the affine integer grid is convex, so every intermediate coordinate +remains in the same core. -/ +omit [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] in +@[nolint unusedArguments] +lemma eq_of_adjacent_of_le + {F : ℤ → ℝ → H} {δ R s : ℝ} (hδ : 0 < δ) (hR : 0 < R) + (hadj : ∀ k : ℤ, ∀ z : ℝ, |z| < R → + F k (δ + z) = F (k + 1) z) + {m n : ℤ} (hmn : m ≤ n) + (hm : |s - (m : ℝ) * δ| < R) (hn : |s - (n : ℝ) * δ| < R) : + F m (s - (m : ℝ) * δ) = F n (s - (n : ℝ) * δ) := by + have hinter : ∀ {k : ℤ}, m ≤ k → k ≤ n → + |s - (k : ℝ) * δ| < R := by + intro k hmk hkn + have hmk' : (m : ℝ) ≤ (k : ℝ) := by exact_mod_cast hmk + have hkn' : (k : ℝ) ≤ (n : ℝ) := by exact_mod_cast hkn + have hmkδ : (m : ℝ) * δ ≤ (k : ℝ) * δ := + mul_le_mul_of_nonneg_right hmk' hδ.le + have hknδ : (k : ℝ) * δ ≤ (n : ℝ) * δ := + mul_le_mul_of_nonneg_right hkn' hδ.le + rw [abs_lt] at hm hn ⊢ + by_cases hsk : s < (k : ℝ) * δ + · constructor + · linarith [hn.1] + · linarith + · have hks : (k : ℝ) * δ ≤ s := le_of_not_gt hsk + constructor + · linarith + · linarith [hm.2] + have hchain : ∀ (k : ℤ), m ≤ k → k ≤ n → |s - (k : ℝ) * δ| < R → + F m (s - (m : ℝ) * δ) = F k (s - (k : ℝ) * δ) := by + intro k hmk + refine Int.leInduction (motive := fun j _ => + j ≤ n → |s - (j : ℝ) * δ| < R → + F m (s - (m : ℝ) * δ) = F j (s - (j : ℝ) * δ)) ?_ ?_ k hmk + · intro _ _ + rfl + · intro j hj ih hj1n hj1 + have hjn : j ≤ n := by omega + have hj0 : |s - (j : ℝ) * δ| < R := hinter hj hjn + have hprev := ih hjn hj0 + have hstep := hadj j (s - ((j + 1 : ℤ) : ℝ) * δ) hj1 + have hstep' : F j (s - (j : ℝ) * δ) = + F (j + 1) (s - ((j + 1 : ℤ) : ℝ) * δ) := by + convert hstep using 1 + push_cast + ring + exact hprev.trans hstep' + exact hchain n hmn le_rfl hn + +omit [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] in +lemma eq_of_adjacent + {F : ℤ → ℝ → H} {δ R s : ℝ} (hδ : 0 < δ) (hR : 0 < R) + (hadj : ∀ k : ℤ, ∀ z : ℝ, |z| < R → + F k (δ + z) = F (k + 1) z) + {m n : ℤ} + (hm : |s - (m : ℝ) * δ| < R) (hn : |s - (n : ℝ) * δ| < R) : + F m (s - (m : ℝ) * δ) = F n (s - (n : ℝ) * δ) := by + rcases le_total m n with hmn | hnm + · exact eq_of_adjacent_of_le hδ hR hadj hmn hm hn + · exact (eq_of_adjacent_of_le hδ hR hadj hnm hn hm).symm + +/-- Reindex a bi-infinite integer-indexed core cover by `ℕ`. The reindexing is purely set-theoretic +and uses `Equiv.intEquivNat`; it lets the existing choice-based gluing implementation remain +backwards-compatible while continuation is naturally developed on integer time centers. -/ +noncomputable def LocalOrbitCoreCover.ofIntIndex + {T : H →ₗ.[ℂ] H} {x : H} + (state : ℤ → H) (center coreRadius : ℤ → ℝ) + (chart : ∀ n : ℤ, LocalAnalyticOrbit T (state n)) + (core_pos : ∀ n, 0 < coreRadius n) + (core_le : ∀ n, coreRadius n ≤ (chart n).radius) + (center_zero : center 0 = 0) (state_zero : state 0 = x) + (state_norm : ∀ n, ‖state n‖ = ‖x‖) + (cover : ∀ s : ℝ, ∃ n : ℤ, |s - center n| < coreRadius n) + (compatible : ∀ (m n : ℤ) (s : ℝ), + |s - center m| < coreRadius m → |s - center n| < coreRadius n → + chart m (s - center m) = chart n (s - center n)) : + LocalOrbitCoreCover T x where + state := fun n => state (Equiv.intEquivNat.symm n) + center := fun n => center (Equiv.intEquivNat.symm n) + chart := fun n => chart (Equiv.intEquivNat.symm n) + coreRadius := fun n => coreRadius (Equiv.intEquivNat.symm n) + core_pos := fun n => core_pos _ + core_le := fun n => core_le _ + center_zero := by + have hzero : Equiv.intEquivNat.symm 0 = (0 : ℤ) := by rfl + simpa [hzero] using center_zero + state_zero := by + have hzero : Equiv.intEquivNat.symm 0 = (0 : ℤ) := by rfl + simpa [hzero] using state_zero + state_norm := fun n => state_norm _ + cover := by + intro s + obtain ⟨n, hn⟩ := cover s + exact ⟨Equiv.intEquivNat n, by simpa only [Equiv.symm_apply_apply] using hn⟩ + compatible := by + intro m n s hm hn + exact compatible _ _ s hm hn + +/-- Package the grid argument with the abstract core-cover certificate. The analytic work needed +to construct the charts is intentionally not hidden here: callers only have to provide the local +adjacent equality, while this lemma supplies coverage and all non-adjacent compatibility. -/ +noncomputable def LocalOrbitCoreCover.ofAdjacentIntIndex + {T : H →ₗ.[ℂ] H} {x : H} {δ R : ℝ} + (hδ : 0 < δ) (hδR : δ < R) + (state : ℤ → H) (chart : ∀ n : ℤ, LocalAnalyticOrbit T (state n)) + (core_pos : 0 < R) (core_le : ∀ n : ℤ, R ≤ (chart n).radius) + (state_zero : state 0 = x) + (state_norm : ∀ n : ℤ, ‖state n‖ = ‖x‖) + (hadj : ∀ n : ℤ, ∀ z : ℝ, |z| < R → + chart n (δ + z) = chart (n + 1) z) : + LocalOrbitCoreCover T x := by + let center : ℤ → ℝ := fun n => (n : ℝ) * δ + have hcenter_zero : center 0 = 0 := by + dsimp [center] + norm_num + have hcover : ∀ s : ℝ, ∃ n : ℤ, |s - center n| < R := by + intro s + obtain ⟨n, hn⟩ := exists_int_center_of_pos_step hδ hδR + exact ⟨n, by simpa [center] using hn⟩ + exact LocalOrbitCoreCover.ofIntIndex state center (fun _ => R) chart + (fun _ => core_pos) core_le hcenter_zero state_zero state_norm hcover + (fun m n s hm hn => eq_of_adjacent hδ core_pos hadj (by simpa [center] using hm) + (by simpa [center] using hn)) + +/-- Restricts every chart of a core cover down to its core radius, forgetting the extra room +outside it. -/ +noncomputable def LocalOrbitCoreCover.toLocalOrbitCover + {T : H →ₗ.[ℂ] H} {x : H} (C : LocalOrbitCoreCover T x) : LocalOrbitCover T x where + state := C.state + center := C.center + chart := fun n => (C.chart n).restrictTo (C.core_pos n) (C.core_le n) + center_zero := C.center_zero + state_zero := C.state_zero + state_norm := C.state_norm + cover := by + intro s + obtain ⟨n, hn⟩ := C.cover s + exact ⟨n, hn⟩ + compatible := by + intro m n s hm hn + exact C.compatible m n s hm hn + +/-- Glues a local orbit cover into a single global analytic orbit, choosing at each time the +chart that covers it. -/ +noncomputable def LocalOrbitCover.toGlobal {T : H →ₗ.[ℂ] H} {x : H} + (C : LocalOrbitCover T x) : GlobalAnalyticOrbit T x where + toFun := fun s => C.chart (Classical.choose (C.cover s)) + (s - C.center (Classical.choose (C.cover s))) + initial := by + let n : ℕ := Classical.choose (C.cover 0) + have hn : |0 - C.center n| < (C.chart n).radius := Classical.choose_spec (C.cover 0) + have h0 : |0 - C.center 0| < (C.chart 0).radius := by + simpa [C.center_zero] using (C.chart 0).radius_pos + have hcompat := C.compatible 0 n 0 h0 hn + calc + C.chart (Classical.choose (C.cover 0)) + (0 - C.center (Classical.choose (C.cover 0))) = C.chart 0 (0 - C.center 0) := by + simpa [n] using hcompat.symm + _ = C.state 0 := by simpa [C.center_zero] using (C.chart 0).initial + _ = x := C.state_zero + mem_domain := by + intro s + let n : ℕ := Classical.choose (C.cover s) + have hn : |s - C.center n| < (C.chart n).radius := Classical.choose_spec (C.cover s) + exact (C.chart n).mem_domain (s - C.center n) hn + hasDerivAt := by + intro s + let n : ℕ := Classical.choose (C.cover s) + have hn : |s - C.center n| < (C.chart n).radius := Classical.choose_spec (C.cover s) + have hsI : s ∈ Set.Ioo (C.center n - (C.chart n).radius) + (C.center n + (C.chart n).radius) := by + change C.center n - (C.chart n).radius < s ∧ + s < C.center n + (C.chart n).radius + rw [abs_lt] at hn + constructor <;> linarith + have hlocal := (C.chart n).hasDerivAt (s - C.center n) hn + have hcomp := hlocal.comp_add_const s (-C.center n) + have hevent : ∀ᶠ q : ℝ in 𝓝 s, + (fun r : ℝ => C.chart (Classical.choose (C.cover r)) + (r - C.center (Classical.choose (C.cover r)))) q = + (fun r : ℝ => C.chart n (r + -C.center n)) q := by + filter_upwards [isOpen_Ioo.mem_nhds hsI] with q hq + have hq' : |q - C.center n| < (C.chart n).radius := by + rw [abs_lt] + change C.center n - (C.chart n).radius < q ∧ + q < C.center n + (C.chart n).radius at hq + constructor <;> linarith + have hchosen := Classical.choose_spec (C.cover q) + simpa [sub_eq_add_neg] using + (C.compatible n (Classical.choose (C.cover q)) q hq' hchosen).symm + have hderiv := hcomp.congr_of_eventuallyEq hevent + convert hderiv using 1 + norm_eq := by + intro s + let n : ℕ := Classical.choose (C.cover s) + have hn : |s - C.center n| < (C.chart n).radius := Classical.choose_spec (C.cover s) + calc + ‖C.chart (Classical.choose (C.cover s)) + (s - C.center (Classical.choose (C.cover s)))‖ = ‖C.state n‖ := + (C.chart n).norm_eq (s - C.center n) hn + _ = ‖x‖ := C.state_norm n + +/-- Glues a core cover into a single global analytic orbit, via its underlying `LocalOrbitCover`. -/ +noncomputable def LocalOrbitCoreCover.toGlobal {T : H →ₗ.[ℂ] H} {x : H} + (C : LocalOrbitCoreCover T x) : GlobalAnalyticOrbit T x := + C.toLocalOrbitCover.toGlobal + +omit [CompleteSpace H] in +@[nolint unusedArguments] +lemma LocalOrbitCoreCover.toGlobal_nonempty {T : H →ₗ.[ℂ] H} {x : H} + (C : LocalOrbitCoreCover T x) : Nonempty (GlobalAnalyticOrbit T x) := + ⟨C.toGlobal⟩ + +omit [CompleteSpace H] in +@[nolint unusedArguments] +lemma LocalOrbitCover.toGlobal_nonempty {T : H →ₗ.[ℂ] H} {x : H} + (C : LocalOrbitCover T x) : Nonempty (GlobalAnalyticOrbit T x) := + ⟨C.toGlobal⟩ + +omit [CompleteSpace H] in +/-- A global orbit for the closure of a closable operator is also a global orbit for the original +operator. The only issue is the dependent domain proof in the differential equation; the closed +graph identity `T.closure.closure = T.closure` resolves it explicitly. -/ +@[nolint unusedArguments] +lemma of_closure {T : H →ₗ.[ℂ] H} {x : H} (hT : T.IsClosable) + (U : GlobalAnalyticOrbit T.closure x) : Nonempty (GlobalAnalyticOrbit T x) := by + have hclosed : T.closure.closure = T.closure := hT.closure_isClosed.closure_eq + have happly : ∀ (z : H) (hz : z ∈ T.closure.domain) + (hz' : z ∈ T.closure.closure.domain), + T.closure.closure ⟨z, hz'⟩ = T.closure ⟨z, hz⟩ := by + intro z hz hz' + have hgraph : (z, T.closure.closure ⟨z, hz'⟩) ∈ T.closure.graph := by + have hgraph_eq : T.closure.closure.graph = T.closure.graph := + congrArg (fun R : H →ₗ.[ℂ] H => R.graph) hclosed + exact hgraph_eq ▸ T.closure.closure.mem_graph ⟨z, hz'⟩ + exact T.closure.mem_graph_snd_inj' hgraph + (T.closure.mem_graph ⟨z, hz⟩) rfl + refine ⟨ + { toFun := U + initial := U.initial + mem_domain := fun s => by + simpa only [hclosed] using U.mem_domain s + hasDerivAt := fun s => by + have hz' : U s ∈ T.closure.closure.domain := U.mem_domain s + have hz : U s ∈ T.closure.domain := by + simpa only [hclosed] using hz' + have hd := U.hasDerivAt s + convert hd using 1 + congr 1 + exact (happly _ hz hz').symm + norm_eq := U.norm_eq }⟩ + +omit [CompleteSpace H] in +@[nolint unusedArguments] +lemma inner_deficiency_eq_zero + {T : H →ₗ.[ℂ] H} {x : H} (U : GlobalAnalyticOrbit T x) {y : H} + (hy : y ∈ (T.closure - Complex.I • 1).toFun.rangeᗮ) : + ⟪y, x⟫_ℂ = 0 := by + let f : ℝ → ℂ := fun s => ⟪y, U s⟫_ℂ + let g : ℝ → ℂ := fun s => (Real.exp s : ℂ) * f s + have hg : ∀ s : ℝ, HasDerivAt g 0 s := by + intro s + have hdom : U s ∈ T.closure.domain := U.mem_domain s + let z : (T.closure - Complex.I • 1).domain := + ⟨U s, by + rw [sub_domain] + exact ⟨hdom, by simp⟩⟩ + have horth : ⟪y, T.closure ⟨U s, hdom⟩ - + Complex.I • U s⟫_ℂ = 0 := by + have hz := (Submodule.mem_orthogonal' _ y).mp hy + ((T.closure - Complex.I • 1).toFun z) ⟨z, rfl⟩ + simpa [z, sub_apply] using hz + have hrelation : ⟪y, T.closure ⟨U s, hdom⟩⟫_ℂ = + Complex.I * ⟪y, U s⟫_ℂ := by + rw [inner_sub_right, inner_smul_right] at horth + exact sub_eq_zero.mp horth + have hf0 : HasDerivAt (fun r : ℝ => ⟪y, U r⟫_ℂ) + (-⟪y, U s⟫_ℂ) s := by + have hinner := (hasDerivAt_const (x := s) y).inner ℂ (U.hasDerivAt s) + convert hinner using 1 + · rfl + · simp only [inner_zero_left, inner_smul_right] + rw [hrelation] + ring_nf + rw [Complex.I_sq] + simp + have hf : HasDerivAt f (-f s) s := by + simpa [f] using hf0 + have he : HasDerivAt (fun r : ℝ => (Real.exp r : ℂ)) (Real.exp s) s := + (Real.hasDerivAt_exp s).ofReal_comp + have hp := he.mul hf + have hz : (Real.exp s : ℂ) * f s + (Real.exp s : ℂ) * (-f s) = 0 := by + ring + have hp' : HasDerivAt ((fun r : ℝ => (Real.exp r : ℂ)) * f) 0 s := by + simpa only [hz] using hp + change HasDerivAt (fun r : ℝ => (Real.exp r : ℂ) * f r) 0 s + convert hp' using 1 + funext r + rfl + have hconst : ∀ s : ℝ, g s = g 0 := by + intro s + exact is_const_of_deriv_eq_zero (fun r => (hg r).differentiableAt) + (fun r => (hg r).deriv) s 0 + have hexp : Filter.Tendsto (fun n : ℕ => Real.exp (-(n : ℝ))) atTop (𝓝 0) := by + simpa [Function.comp_def] using + Real.tendsto_exp_atBot.comp + (tendsto_neg_atTop_atBot.comp (tendsto_natCast_atTop_atTop : + Filter.Tendsto (fun n : ℕ => (n : ℝ)) atTop atTop)) + have hupper : Filter.Tendsto + (fun n : ℕ => Real.exp (-(n : ℝ)) * (‖y‖ * ‖x‖)) atTop (𝓝 0) := by + simpa only [Pi.mul_apply, zero_mul] using + hexp.mul (tendsto_const_nhds : + Filter.Tendsto (fun _ : ℕ => ‖y‖ * ‖x‖) atTop (𝓝 (‖y‖ * ‖x‖))) + have hnorm_lim : Filter.Tendsto (fun n : ℕ => ‖g (-(n : ℝ))‖) atTop (𝓝 0) := by + refine squeeze_zero' (f := fun n : ℕ => ‖g (-(n : ℝ))‖) + (g := fun n : ℕ => Real.exp (-(n : ℝ)) * (‖y‖ * ‖x‖)) + (Filter.Eventually.of_forall fun n => norm_nonneg _) + (Filter.Eventually.of_forall (fun n => ?_)) hupper + calc + ‖g (-(n : ℝ))‖ = Real.exp (-(n : ℝ)) * ‖⟪y, U (-(n : ℝ))⟫_ℂ‖ := by + dsimp [g, f] + rw [norm_mul, Complex.norm_real, Real.norm_eq_abs, + abs_of_pos (Real.exp_pos _)] + _ ≤ Real.exp (-(n : ℝ)) * (‖y‖ * ‖U (-(n : ℝ))‖) := by + gcongr + exact norm_inner_le_norm _ _ + _ = Real.exp (-(n : ℝ)) * (‖y‖ * ‖x‖) := by + rw [U.norm_eq] + have hlim : Filter.Tendsto (fun n : ℕ => g (-(n : ℝ))) atTop (𝓝 0) := + (tendsto_zero_iff_norm_tendsto_zero).2 hnorm_lim + have hconst_zero : g 0 = 0 := by + have hc : Tendsto (fun _ : ℕ => g 0) atTop (𝓝 0) := + hlim.congr' (Filter.Eventually.of_forall fun n => hconst (-(n : ℝ))) + exact (tendsto_nhds_unique hc tendsto_const_nhds).symm + simpa [g, f, U.initial] using hconst_zero + +omit [CompleteSpace H] in +@[nolint unusedArguments] +lemma inner_deficiency_eq_zero_neg + {T : H →ₗ.[ℂ] H} {x : H} (U : GlobalAnalyticOrbit T x) {y : H} + (hy : y ∈ (T.closure - (-Complex.I) • 1).toFun.rangeᗮ) : + ⟪y, x⟫_ℂ = 0 := by + let f : ℝ → ℂ := fun s => ⟪y, U s⟫_ℂ + let g : ℝ → ℂ := fun s => (Real.exp (-s) : ℂ) * f s + have hg : ∀ s : ℝ, HasDerivAt g 0 s := by + intro s + have hdom : U s ∈ T.closure.domain := U.mem_domain s + let z : (T.closure - (-Complex.I) • 1).domain := + ⟨U s, by + rw [sub_domain] + exact ⟨hdom, by simp⟩⟩ + have horth : ⟪y, T.closure ⟨U s, hdom⟩ - + (-Complex.I) • U s⟫_ℂ = 0 := by + have hz := (Submodule.mem_orthogonal' _ y).mp hy + ((T.closure - (-Complex.I) • 1).toFun z) ⟨z, rfl⟩ + simpa [z, sub_apply] using hz + have hrelation : ⟪y, T.closure ⟨U s, hdom⟩⟫_ℂ = + (-Complex.I) * ⟪y, U s⟫_ℂ := by + rw [inner_sub_right, inner_smul_right] at horth + exact sub_eq_zero.mp horth + have hf0 : HasDerivAt (fun r : ℝ => ⟪y, U r⟫_ℂ) + (⟪y, U s⟫_ℂ) s := by + have hinner := (hasDerivAt_const (x := s) y).inner ℂ (U.hasDerivAt s) + convert hinner using 1 + · rfl + · simp only [inner_zero_left, inner_smul_right] + rw [hrelation] + ring_nf + rw [Complex.I_sq] + simp + have hf : HasDerivAt f (f s) s := by + simpa [f] using hf0 + have he : HasDerivAt (fun r : ℝ => (Real.exp (-r) : ℂ)) + (-Real.exp (-s)) s := by + have hreal := (Real.hasDerivAt_exp (-s)).scomp s + (hasDerivAt_id' (𝕜 := ℝ) s).neg + convert hreal.ofReal_comp using 1 + · funext r + rfl + · simp + have hp := he.mul hf + have hz : (-Real.exp (-s) : ℂ) * f s + (Real.exp (-s) : ℂ) * f s = 0 := by + ring + have hp' : HasDerivAt ((fun r : ℝ => (Real.exp (-r) : ℂ)) * f) 0 s := by + simpa only [hz] using hp + change HasDerivAt (fun r : ℝ => (Real.exp (-r) : ℂ) * f r) 0 s + convert hp' using 1 + funext r + rfl + have hconst : ∀ s : ℝ, g s = g 0 := by + intro s + exact is_const_of_deriv_eq_zero (fun r => (hg r).differentiableAt) + (fun r => (hg r).deriv) s 0 + have hexp : Filter.Tendsto (fun n : ℕ => Real.exp (-(n : ℝ))) atTop (𝓝 0) := by + simpa [Function.comp_def] using + Real.tendsto_exp_atBot.comp + (tendsto_neg_atTop_atBot.comp (tendsto_natCast_atTop_atTop : + Filter.Tendsto (fun n : ℕ => (n : ℝ)) atTop atTop)) + have hupper : Filter.Tendsto + (fun n : ℕ => Real.exp (-(n : ℝ)) * (‖y‖ * ‖x‖)) atTop (𝓝 0) := by + simpa only [Pi.mul_apply, zero_mul] using + hexp.mul (tendsto_const_nhds : + Filter.Tendsto (fun _ : ℕ => ‖y‖ * ‖x‖) atTop (𝓝 (‖y‖ * ‖x‖))) + have hnorm_lim : Filter.Tendsto (fun n : ℕ => ‖g (n : ℝ)‖) atTop (𝓝 0) := by + refine squeeze_zero' (f := fun n : ℕ => ‖g (n : ℝ)‖) + (g := fun n : ℕ => Real.exp (-(n : ℝ)) * (‖y‖ * ‖x‖)) + (Filter.Eventually.of_forall fun n => norm_nonneg _) + (Filter.Eventually.of_forall (fun n => ?_)) hupper + calc + ‖g (n : ℝ)‖ = Real.exp (-(n : ℝ)) * ‖⟪y, U (n : ℝ)⟫_ℂ‖ := by + dsimp [g, f] + rw [norm_mul, Complex.norm_real, Real.norm_eq_abs, + abs_of_pos (Real.exp_pos _)] + _ ≤ Real.exp (-(n : ℝ)) * (‖y‖ * ‖U (n : ℝ)‖) := by + gcongr + exact norm_inner_le_norm _ _ + _ = Real.exp (-(n : ℝ)) * (‖y‖ * ‖x‖) := by + rw [U.norm_eq] + have hlim : Filter.Tendsto (fun n : ℕ => g (n : ℝ)) atTop (𝓝 0) := + (tendsto_zero_iff_norm_tendsto_zero).2 hnorm_lim + have hconst_zero : g 0 = 0 := by + have hc : Tendsto (fun _ : ℕ => g 0) atTop (𝓝 0) := + hlim.congr' (Filter.Eventually.of_forall fun n => hconst (n : ℝ)) + exact (tendsto_nhds_unique hc tendsto_const_nhds).symm + simpa [g, f, U.initial] using hconst_zero + +end GlobalAnalyticOrbit + +end LinearPMap diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/AnalyticVector/Nelson.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/AnalyticVector/Nelson.lean new file mode 100644 index 0000000000..80ba4d5e44 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/AnalyticVector/Nelson.lean @@ -0,0 +1,578 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.AnalyticVector.Local + +/-! +# Analytic vectors for an unbounded operator (part 3 of 3: gluing and Nelson's criterion) + +Continuation of `AnalyticVector/Local.lean`; this part glues local charts into a global orbit and +concludes Nelson's single-operator analytic-vector essential-self-adjointness criterion. + +## Main results + +- `IsSymmetric.isEssentiallySelfAdjoint_of_denseAnalyticVectors_of_globalOrbit` : a dense family + of analytic vectors proves essential self-adjointness once its local exponential orbits have + been patched to global norm-preserving orbits. +- `IsSymmetric.isEssentiallySelfAdjoint_of_denseAnalyticVectors` : **Nelson's analytic-vector + theorem, single-operator case** (Reed–Simon Vol. II, Theorem X.39, first half). A symmetric + operator with a dense set of analytic vectors is essentially self-adjoint. +-/ + +@[expose] public section + +noncomputable section + +namespace LinearPMap + +open scoped InnerProductSpace Topology +open Filter + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + + +/-- Every entire vector supplies a `GlobalAnalyticOrbit` once the operator is known to be +symmetric on a dense domain. This packages the global case through the same certificate used by +the finite-radius Nelson argument. -/ +lemma IsEntireVector.globalAnalyticOrbit + {T : H →ₗ.[ℂ] H} {x : H} (h : T.IsEntireVector x) + (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) : + Nonempty (GlobalAnalyticOrbit T x) := by + obtain ⟨v, hv, hall⟩ := h + have hdenseDomain : T.HasDenseDomain := hasDenseDomain_of_denseAnalyticVectors hdense + have hT : T.IsClosable := hsym.isClosable hdenseDomain + refine ⟨ + { toFun := fun s => analyticExp T v s + initial := analyticExp_zero hv + mem_domain := fun s => analyticExp_mem_closure_domain_of_entire hv hall hT s + hasDerivAt := fun s => analyticExp_hasDerivAt_of_entire hv hall hT s + norm_eq := ?_ }⟩ + intro s + let t : ℝ := 2 * |s| + 1 + have ht : 0 < t := by + dsimp [t] + positivity + have hs : s ∈ Set.Ioo (-t / 2) (t / 2) := by + dsimp [t] + constructor <;> linarith [neg_le_abs s, le_abs_self s] + exact LinearPMap.analyticExp_norm_eq_norm hsym hdense hv hs (hall t ht) + +/-- The local exponential series attached to an explicit analytic witness is a local orbit +certificate. Keeping the witness in the constructor is important for continuation: the next +state is the value of this very series, rather than an unspecified member of a `Nonempty` proof. -/ +noncomputable def IsAnalyticVector.localAnalyticOrbitOfWitness + {T : H →ₗ.[ℂ] H} {x : H} (v : ℕ → T.domain) (hv : IteratesSeq T x v) + {t : ℝ} (ht : 0 < t) + (hsum : Summable (fun n : ℕ => ‖(v n : H)‖ * t ^ n / n.factorial)) + (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) : + LocalAnalyticOrbit T x := by + have hdenseDomain : T.HasDenseDomain := hasDenseDomain_of_denseAnalyticVectors hdense + have hT : T.IsClosable := hsym.isClosable hdenseDomain + refine + { radius := t / 2 + radius_pos := by linarith + toFun := fun s => analyticExp T v s + initial := analyticExp_zero hv + mem_domain := ?_ + hasDerivAt := ?_ + norm_eq := ?_ } + · intro s hs + have hs' : s ∈ Set.Ioo (-t / 2) (t / 2) := by + rw [abs_lt] at hs + exact ⟨by simpa only [neg_div] using hs.1, hs.2⟩ + exact analyticExp_mem_closure_domain hv hT hs' hsum + · intro s hs + have hs' : s ∈ Set.Ioo (-t / 2) (t / 2) := by + rw [abs_lt] at hs + exact ⟨by simpa only [neg_div] using hs.1, hs.2⟩ + exact analyticExp_hasDerivAt_eq_smul_closure hv hT hs' hsum + · intro s hs + have hs' : s ∈ Set.Ioo (-t / 2) (t / 2) := by + rw [abs_lt] at hs + exact ⟨by simpa only [neg_div] using hs.1, hs.2⟩ + exact LinearPMap.analyticExp_norm_eq_norm hsym hdense hv hs' hsum + +/- The local exponential series attached to an analytic vector is a local orbit certificate. +The radius is halved to leave room for termwise differentiation and passage to the closed graph. -/ +lemma IsAnalyticVector.localAnalyticOrbit + {T : H →ₗ.[ℂ] H} {x : H} (h : T.IsAnalyticVector x) + (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) : + Nonempty (LocalAnalyticOrbit T x) := by + obtain ⟨v, hv, t, ht, hsum⟩ := h + exact ⟨IsAnalyticVector.localAnalyticOrbitOfWitness v hv ht hsum hsym hdense⟩ + +/-- A fresh local chart at a reached state can be chosen with any radius strictly below the +original analytic radius (up to the usual local half-radius). The sharp-radius witness is first +constructed for the closed operator, then its local certificate is transported back to `T`. -/ +lemma IsAnalyticVector.localAnalyticOrbit_at_exp_of_radius + {T : H →ₗ.[ℂ] H} {x : H} {v : ℕ → T.domain} (hv : IteratesSeq T x v) + {t a q : ℝ} (ht : 0 < t) (ha : |a| < t / 2) (hq : 0 < q) (hqt : q < t) + (hsum : Summable (fun n : ℕ => ‖(v n : H)‖ * t ^ n / n.factorial)) + (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) : + Nonempty (LocalAnalyticOrbit T (analyticExp T v a)) := by + have hdenseDomain : T.HasDenseDomain := hasDenseDomain_of_denseAnalyticVectors hdense + have hT : T.IsClosable := hsym.isClosable hdenseDomain + have hclosedSym : T.closure.IsSymmetric := hsym.closure hdenseDomain + have hspan_le : Submodule.span ℂ {x : H | T.IsAnalyticVector x} ≤ + Submodule.span ℂ {x : H | T.closure.IsAnalyticVector x} := by + apply Submodule.span_mono + intro z hz + exact IsAnalyticVector.for_closure hz + have hclosedense : + (Submodule.span ℂ {x : H | T.closure.IsAnalyticVector x}).topologicalClosure = ⊤ := by + apply le_antisymm le_top + exact hdense ▸ Submodule.topologicalClosure_mono hspan_le + have hy : T.closure.IsAnalyticVector (analyticExp T v a) := + GlobalAnalyticOrbit.IsAnalyticVector.analyticExp_at_isAnalyticVector_of_radius + hv ht ha hq hqt hsum hsym hdense + obtain ⟨U⟩ := IsAnalyticVector.localAnalyticOrbit hy hclosedSym hclosedense + exact LocalAnalyticOrbit.of_closure hT U + +/-- Advance a proof-relevant analytic witness by a prescribed real step. The new radius is chosen +as the midpoint of a fixed lower bound and the old radius; consequently repeated advancement +preserves a uniform positive lower bound instead of consuming the radius geometrically. -/ +noncomputable def AnalyticVectorWitness.advance + {T : H →ₗ.[ℂ] H} (hclosed : T.closure = T) + (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) + (W : AnalyticVectorWitness T) {r a : ℝ} + (hr : 0 < r) (hrW : r < W.radius) (ha : |a| < W.radius / 2) : + AnalyticVectorWitness T := by + let q : ℝ := (r + W.radius) / 2 + have hq : 0 < q := by + dsimp [q] + linarith [hr, W.radius_pos] + have hqr : r < q := by + dsimp [q] + linarith + have hqW : q < W.radius := by + dsimp [q] + linarith + have hex : ∃ w : ℕ → T.domain, + IteratesSeq T (analyticExp T W.iterates a) w ∧ + Summable (fun n : ℕ => ‖(w n : H)‖ * q ^ n / n.factorial) := by + obtain ⟨w, hw, hq', hsum_w⟩ := + GlobalAnalyticOrbit.IsAnalyticVector.analyticExp_at_isAnalyticVector_witness_of_radius + W.iterates_spec W.radius_pos ha hq hqW W.summable hsym hdense + have hdom : T.closure.domain = T.domain := congrArg LinearPMap.domain hclosed + let wT : ℕ → T.domain := fun n => + ⟨(w n : H), hdom ▸ (w n).property⟩ + have happly : ∀ (z : H) (hz : z ∈ T.domain) (hz' : z ∈ T.closure.domain), + T.closure ⟨z, hz'⟩ = T ⟨z, hz⟩ := by + intro z hz hz' + have hgraph : (z, T.closure ⟨z, hz'⟩) ∈ T.graph := by + have hgraph_eq : T.closure.graph = T.graph := + congrArg (fun R : H →ₗ.[ℂ] H => R.graph) hclosed + exact hgraph_eq ▸ T.closure.mem_graph ⟨z, hz'⟩ + exact T.mem_graph_snd_inj' hgraph (T.mem_graph ⟨z, hz⟩) rfl + have hwT : IteratesSeq T (analyticExp T W.iterates a) wT := by + refine ⟨?_, fun n => ?_⟩ + · change (w 0 : H) = analyticExp T W.iterates a + exact hw.1 + · change (w (n + 1) : H) = T (wT n) + calc + (w (n + 1) : H) = T.closure (w n) := hw.2 n + _ = T (wT n) := happly (w n : H) (wT n).property (w n).property + have hsum_wT : Summable + (fun n : ℕ => ‖(wT n : H)‖ * q ^ n / n.factorial) := by + change Summable (fun n : ℕ => ‖(w n : H)‖ * q ^ n / n.factorial) + exact hsum_w + exact ⟨wT, hwT, hsum_wT⟩ + let wT : ℕ → T.domain := Classical.choose hex + have hwT : IteratesSeq T (analyticExp T W.iterates a) wT := + (Classical.choose_spec hex).1 + have hsum_wT : Summable (fun n : ℕ => ‖(wT n : H)‖ * q ^ n / n.factorial) := + (Classical.choose_spec hex).2 + exact ⟨analyticExp T W.iterates a, wT, hwT, q, hq, hsum_wT⟩ + +lemma AnalyticVectorWitness.advance_radius + {T : H →ₗ.[ℂ] H} (hclosed : T.closure = T) + (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) + (W : AnalyticVectorWitness T) {r a : ℝ} + (hr : 0 < r) (hrW : r < W.radius) (ha : |a| < W.radius / 2) : + (W.advance hclosed hsym hdense hr hrW ha).radius = (r + W.radius) / 2 := by + rfl + +lemma AnalyticVectorWitness.advance_norm + {T : H →ₗ.[ℂ] H} (hclosed : T.closure = T) + (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) + (W : AnalyticVectorWitness T) {r a : ℝ} + (hr : 0 < r) (hrW : r < W.radius) (ha : |a| < W.radius / 2) : + ‖(W.advance hclosed hsym hdense hr hrW ha).state‖ = ‖W.state‖ := by + have ha' : a ∈ Set.Ioo (-W.radius / 2) (W.radius / 2) := by + change -W.radius / 2 < a ∧ a < W.radius / 2 + rcases (abs_lt.mp ha) with ⟨ha₁, ha₂⟩ + exact ⟨by linarith [ha₁], by linarith [ha₂]⟩ + have hnorm := analyticExp_norm_eq_norm hsym hdense W.iterates_spec ha' W.summable + simpa [AnalyticVectorWitness.advance] using hnorm + +/-- A two-sided line of witnesses with a fixed lower-radius invariant. Positive indices advance +by `δ`, negative indices by `-δ`; the midpoint choice in `advance` makes the invariant stable in +both directions. -/ +noncomputable def AnalyticVectorWitness.uniformIntegerLineData + {T : H →ₗ.[ℂ] H} (hclosed : T.closure = T) + (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) + (W0 : AnalyticVectorWitness T) {r δ : ℝ} + (hr : 0 < r) (hrW0 : r < W0.radius) + (hδ : 0 < δ) (h2δ : 2 * δ < r) : + ℤ → {W : AnalyticVectorWitness T // r < W.radius ∧ ‖W.state‖ = ‖W0.state‖} := by + let motive : ℤ → Type _ := fun _ => + {W : AnalyticVectorWitness T // r < W.radius ∧ ‖W.state‖ = ‖W0.state‖} + let base : motive 0 := ⟨W0, hrW0, rfl⟩ + let succ : ∀ k : ℤ, 0 ≤ k → motive k → motive (k + 1) := fun _ _ ih => by + have ha : |δ| < ih.1.radius / 2 := by + rw [abs_of_pos hδ] + linarith [ih.2.1] + let W := AnalyticVectorWitness.advance hclosed hsym hdense ih.1 hr ih.2.1 ha + refine ⟨W, ?_, ?_⟩ + rw [AnalyticVectorWitness.advance_radius hclosed hsym hdense ih.1 hr ih.2.1 ha] + · linarith [ih.2.1] + · exact (AnalyticVectorWitness.advance_norm hclosed hsym hdense ih.1 hr ih.2.1 ha).trans ih.2.2 + let pred : ∀ k : ℤ, k ≤ 0 → motive k → motive (k - 1) := fun _ _ ih => by + have ha : |-δ| < ih.1.radius / 2 := by + rw [abs_neg, abs_of_pos hδ] + linarith [ih.2.1] + let W := AnalyticVectorWitness.advance hclosed hsym hdense ih.1 hr ih.2.1 ha + refine ⟨W, ?_, ?_⟩ + rw [AnalyticVectorWitness.advance_radius hclosed hsym hdense ih.1 hr ih.2.1 ha] + · linarith [ih.2.1] + · exact (AnalyticVectorWitness.advance_norm hclosed hsym hdense ih.1 hr ih.2.1 ha).trans ih.2.2 + exact fun n => Int.inductionOn' (motive := motive) n 0 base succ pred + +/-- The two-sided line of witnesses underlying `uniformIntegerLineData`. -/ +noncomputable def AnalyticVectorWitness.uniformIntegerLine + {T : H →ₗ.[ℂ] H} (hclosed : T.closure = T) + (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) + (W0 : AnalyticVectorWitness T) {r δ : ℝ} + (hr : 0 < r) (hrW0 : r < W0.radius) + (hδ : 0 < δ) (h2δ : 2 * δ < r) : + ℤ → AnalyticVectorWitness T := + fun n => (AnalyticVectorWitness.uniformIntegerLineData hclosed hsym hdense W0 + hr hrW0 hδ h2δ n).1 + +lemma AnalyticVectorWitness.uniformIntegerLine_succ_of_nonneg + {T : H →ₗ.[ℂ] H} (hclosed : T.closure = T) + (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) + (W0 : AnalyticVectorWitness T) {r δ : ℝ} + (hr : 0 < r) (hrW0 : r < W0.radius) + (hδ : 0 < δ) (h2δ : 2 * δ < r) {n : ℤ} (hn : 0 ≤ n) : + (AnalyticVectorWitness.uniformIntegerLine hclosed hsym hdense W0 + hr hrW0 hδ h2δ (n + 1)).state = + analyticExp T (AnalyticVectorWitness.uniformIntegerLine hclosed hsym hdense W0 + hr hrW0 hδ h2δ n).iterates δ := by + simp [AnalyticVectorWitness.uniformIntegerLine, + AnalyticVectorWitness.uniformIntegerLineData, + Int.inductionOn'_add_one, hn] + rfl + +lemma AnalyticVectorWitness.uniformIntegerLine_pred_of_nonpos + {T : H →ₗ.[ℂ] H} (hclosed : T.closure = T) + (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) + (W0 : AnalyticVectorWitness T) {r δ : ℝ} + (hr : 0 < r) (hrW0 : r < W0.radius) + (hδ : 0 < δ) (h2δ : 2 * δ < r) {n : ℤ} (hn : n ≤ 0) : + (AnalyticVectorWitness.uniformIntegerLine hclosed hsym hdense W0 + hr hrW0 hδ h2δ (n - 1)).state = + analyticExp T (AnalyticVectorWitness.uniformIntegerLine hclosed hsym hdense W0 + hr hrW0 hδ h2δ n).iterates (-δ) := by + simp [AnalyticVectorWitness.uniformIntegerLine, + AnalyticVectorWitness.uniformIntegerLineData, + Int.inductionOn'_sub_one, hn] + rfl + +lemma AnalyticVectorWitness.uniformIntegerLine_step + {T : H →ₗ.[ℂ] H} (hclosed : T.closure = T) + (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) + (W0 : AnalyticVectorWitness T) {r δ : ℝ} + (hr : 0 < r) (hrW0 : r < W0.radius) + (hδ : 0 < δ) (h4δ : 4 * δ < r) {n : ℤ} : + (AnalyticVectorWitness.uniformIntegerLine hclosed hsym hdense W0 + hr hrW0 hδ (by linarith) (n + 1)).state = + analyticExp T (AnalyticVectorWitness.uniformIntegerLine hclosed hsym hdense W0 + hr hrW0 hδ (by linarith) n).iterates δ := by + let W : ℤ → AnalyticVectorWitness T := + AnalyticVectorWitness.uniformIntegerLine hclosed hsym hdense W0 + hr hrW0 hδ (by linarith) + have hbelow : ∀ k : ℤ, r < (W k).radius := by + intro k + exact (AnalyticVectorWitness.uniformIntegerLineData hclosed hsym hdense W0 + hr hrW0 hδ (by linarith) k).2.1 + have hδR : δ < r / 4 := by linarith + have hclosedSym : T.closure.IsSymmetric := by simpa only [hclosed] using hsym + rcases le_total 0 n with hn | hn + · exact AnalyticVectorWitness.uniformIntegerLine_succ_of_nonneg + hclosed hsym hdense W0 hr hrW0 hδ (by linarith) hn + · by_cases hn0 : 0 ≤ n + · exact AnalyticVectorWitness.uniformIntegerLine_succ_of_nonneg + hclosed hsym hdense W0 hr hrW0 hδ (by linarith) hn0 + have hnneg : n + 1 ≤ 0 := by omega + have hpred := AnalyticVectorWitness.uniformIntegerLine_pred_of_nonpos + hclosed hsym hdense W0 hr hrW0 hδ (by linarith) hnneg + let U : LocalAnalyticOrbit T ((W (n + 1)).state) := + IsAnalyticVector.localAnalyticOrbitOfWitness (W (n + 1)).iterates + (W (n + 1)).iterates_spec (W (n + 1)).radius_pos (W (n + 1)).summable + hsym hdense + let V : LocalAnalyticOrbit T (W n).state := + IsAnalyticVector.localAnalyticOrbitOfWitness (W n).iterates + (W n).iterates_spec (W n).radius_pos (W n).summable hsym hdense + have hpred' : (W n).state = analyticExp T (W (n + 1)).iterates (-δ) := by + simpa [W, show n + 1 - 1 = n by omega] using hpred + have hbase : (W n).state = U (-δ) := by + simpa [U, IsAnalyticVector.localAnalyticOrbitOfWitness] using hpred' + let V' : LocalAnalyticOrbit T (U (-δ)) := + { radius := V.radius + radius_pos := V.radius_pos + toFun := V + initial := by + calc + V 0 = (W n).state := V.initial + _ = U (-δ) := hbase + mem_domain := V.mem_domain + hasDerivAt := V.hasDerivAt + norm_eq := by + intro s hs + calc + ‖V s‖ = ‖(W n).state‖ := V.norm_eq s hs + _ = ‖U (-δ)‖ := by rw [hbase] } + have hmarginU : |(-δ)| + r / 4 ≤ U.radius := by + dsimp [U, IsAnalyticVector.localAnalyticOrbitOfWitness] + rw [abs_neg, abs_of_pos hδ] + linarith [hbelow (n + 1)] + have hVcore : r / 4 ≤ V'.radius := by + dsimp [V, V', IsAnalyticVector.localAnalyticOrbitOfWitness] + linarith [hbelow n] + have heq := LocalAnalyticOrbit.translate_eq_of_same_initial_on_core' + U hclosedSym (a := -δ) (R := r / 4) (by positivity) hmarginU V' + hVcore (by rw [abs_of_pos hδ]; exact hδR) + have hzero : analyticExp T (W (n + 1)).iterates 0 = (W (n + 1)).state := + analyticExp_zero (W (n + 1)).iterates_spec + have heq' : analyticExp T (W (n + 1)).iterates 0 = + analyticExp T (W n).iterates δ := by + simpa [U, V', V, IsAnalyticVector.localAnalyticOrbitOfWitness] using heq + rw [hzero] at heq' + simpa [W] using heq' + +/-! Once the analytic continuation has supplied a uniformly thick integer line of witnesses, this +lemma performs the genuinely topological part of Nelson's construction. It is kept separate from +the choice of the line so that the same gluing theorem can be reused by other continuation +arguments. -/ +lemma GlobalAnalyticOrbit.of_uniform_witness_line + {T : H →ₗ.[ℂ] H} {x : H} (hclosed : T.closure = T) + (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) + (W : ℤ → AnalyticVectorWitness T) {r δ : ℝ} + (hr : 0 < r) (hδ : 0 < δ) (h4δ : 4 * δ < r) + (hbelow : ∀ n : ℤ, r < (W n).radius) + (hstate_zero : (W 0).state = x) + (hstate_norm : ∀ n : ℤ, ‖(W n).state‖ = ‖x‖) + (hstep : ∀ n : ℤ, + (W (n + 1)).state = analyticExp T (W n).iterates δ) : + Nonempty (GlobalAnalyticOrbit T x) := by + have hδR : δ < r / 4 := by linarith + have hclosedSym : T.closure.IsSymmetric := by + simpa only [hclosed] using hsym + let chart : ∀ n : ℤ, LocalAnalyticOrbit T ((W n).state) := fun n => + IsAnalyticVector.localAnalyticOrbitOfWitness (W n).iterates + (W n).iterates_spec (W n).radius_pos (W n).summable hsym hdense + have hcore : ∀ n : ℤ, r / 4 ≤ (chart n).radius := by + intro n + dsimp [chart, IsAnalyticVector.localAnalyticOrbitOfWitness] + linarith [hbelow n] + have hmargin : ∀ n : ℤ, r / 4 + δ ≤ (chart n).radius := by + intro n + dsimp [chart, IsAnalyticVector.localAnalyticOrbitOfWitness] + linarith [hbelow n] + have hadj : ∀ n : ℤ, ∀ z : ℝ, |z| < r / 4 → + chart n (δ + z) = chart (n + 1) z := by + intro n z hz + let U := chart n + have hbase : (W (n + 1)).state = U δ := by + dsimp [U, chart, IsAnalyticVector.localAnalyticOrbitOfWitness] + simp only [hstep n] + let V : LocalAnalyticOrbit T (U δ) := + { radius := (chart (n + 1)).radius + radius_pos := (chart (n + 1)).radius_pos + toFun := chart (n + 1) + initial := by + calc + chart (n + 1) 0 = (W (n + 1)).state := (chart (n + 1)).initial + _ = U δ := hbase + mem_domain := (chart (n + 1)).mem_domain + hasDerivAt := (chart (n + 1)).hasDerivAt + norm_eq := by + intro s hs + calc + ‖chart (n + 1) s‖ = ‖(W (n + 1)).state‖ := + (chart (n + 1)).norm_eq s hs + _ = ‖U δ‖ := by rw [hbase] } + have hmarginU : |δ| + r / 4 ≤ U.radius := by + rw [abs_of_pos hδ] + dsimp [U] + linarith [hmargin n] + have heq := LocalAnalyticOrbit.translate_eq_of_same_initial_on_core' + U hclosedSym (a := δ) (R := r / 4) (by positivity) + hmarginU V + (by dsimp [V]; exact hcore (n + 1)) hz + exact heq + let C := LocalOrbitCoreCover.ofAdjacentIntIndex hδ hδR + (fun n => (W n).state) chart (by positivity) + (fun n => hcore n) hstate_zero hstate_norm hadj + exact ⟨C.toGlobal⟩ + +/-- A dense family of analytic vectors proves essential self-adjointness once its local exponential +orbits have been patched to global norm-preserving orbits. The theorem is deliberately separated +from the construction of those orbits: it is the reusable deficiency-space end of Nelson's proof. -/ +theorem IsSymmetric.isEssentiallySelfAdjoint_of_denseAnalyticVectors_of_globalOrbit + {T : H →ₗ.[ℂ] H} (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) + (hOrbit : ∀ x : H, T.IsAnalyticVector x → Nonempty (GlobalAnalyticOrbit T x)) : + T.IsEssentiallySelfAdjoint := by + have hdenseDomain : T.HasDenseDomain := hasDenseDomain_of_denseAnalyticVectors hdense + have hdefect_plus : T.defectNumber Complex.I = 0 := by + rw [← defectNumber_closure (T := T) (z := Complex.I) + (hsym.mem_regularityDomain_of_im_ne_zero (by simp))] + show Module.rank ℂ ↥((T.closure - Complex.I • 1).toFun.rangeᗮ) = 0 + apply Submodule.rank_eq_zero.mpr + apply (Submodule.eq_bot_iff _).mpr + intro y hy + have hyspan : y ∈ (Submodule.span ℂ {x : H | T.IsAnalyticVector x})ᗮ := by + rw [Submodule.mem_orthogonal'] + intro u hu + refine Submodule.span_induction (p := fun z _ ↦ ⟪y, z⟫_ℂ = 0) ?_ ?_ ?_ ?_ hu + · intro z hz + obtain ⟨U⟩ := hOrbit z hz + exact U.inner_deficiency_eq_zero hy + · simp + · intro z₁ z₂ _ _ hz₁ hz₂ + simp [inner_add_right, hz₁, hz₂] + · intro c z _ hz + simp [inner_smul_right, hz] + have hspanBot : + (Submodule.span ℂ {x : H | T.IsAnalyticVector x})ᗮ = (⊥ : Submodule ℂ H) := + Submodule.topologicalClosure_eq_top_iff.mp hdense + exact (Submodule.mem_bot ℂ).mp (hspanBot ▸ hyspan) + have hdefect_minus : T.defectNumber (-Complex.I) = 0 := by + rw [← defectNumber_closure (T := T) (z := -Complex.I) + (hsym.mem_regularityDomain_of_im_ne_zero (by simp))] + show Module.rank ℂ ↥((T.closure - (-Complex.I) • 1).toFun.rangeᗮ) = 0 + apply Submodule.rank_eq_zero.mpr + apply (Submodule.eq_bot_iff _).mpr + intro y hy + have hyspan : y ∈ (Submodule.span ℂ {x : H | T.IsAnalyticVector x})ᗮ := by + rw [Submodule.mem_orthogonal'] + intro u hu + refine Submodule.span_induction (p := fun z _ ↦ ⟪y, z⟫_ℂ = 0) ?_ ?_ ?_ ?_ hu + · intro z hz + obtain ⟨U⟩ := hOrbit z hz + exact U.inner_deficiency_eq_zero_neg hy + · simp + · intro z₁ z₂ _ _ hz₁ hz₂ + simp [inner_add_right, hz₁, hz₂] + · intro c z _ hz + simp [inner_smul_right, hz] + have hspanBot : + (Submodule.span ℂ {x : H | T.IsAnalyticVector x})ᗮ = (⊥ : Submodule ℂ H) := + Submodule.topologicalClosure_eq_top_iff.mp hdense + exact (Submodule.mem_bot ℂ).mp (hspanBot ▸ hyspan) + exact hsym.isEssentiallySelfAdjoint_of_defectNumber_eq_zero + hdenseDomain hdefect_plus hdefect_minus + +/-! ## Nelson's single-operator criterion -/ + +/-- **Nelson's analytic-vector theorem, single-operator case** (Reed–Simon Vol. II, Theorem +X.39, first half). A symmetric operator with a dense set of analytic vectors is essentially +self-adjoint. The proof constructs a uniform-radius two-sided integer line of local exponential +charts, proves adjacent-chart agreement by the symmetric-ODE uniqueness lemma, glues the line into +a global norm-preserving orbit, and applies the deficiency-index criterion. -/ +theorem IsSymmetric.isEssentiallySelfAdjoint_of_denseAnalyticVectors + {T : H →ₗ.[ℂ] H} (hsym : T.IsSymmetric) + (hdense : (Submodule.span ℂ {x : H | T.IsAnalyticVector x}).topologicalClosure = ⊤) : + T.IsEssentiallySelfAdjoint := by + have hdenseDomain : T.HasDenseDomain := hasDenseDomain_of_denseAnalyticVectors hdense + have hT : T.IsClosable := hsym.isClosable hdenseDomain + have hclosed : T.closure.closure = T.closure := hT.closure_isClosed.closure_eq + have hclosedSym : T.closure.IsSymmetric := hsym.closure hdenseDomain + have hspan_le : Submodule.span ℂ {x : H | T.IsAnalyticVector x} ≤ + Submodule.span ℂ {x : H | T.closure.IsAnalyticVector x} := by + apply Submodule.span_mono + intro z hz + exact IsAnalyticVector.for_closure hz + have hclosedense : + (Submodule.span ℂ {x : H | T.closure.IsAnalyticVector x}).topologicalClosure = ⊤ := by + apply le_antisymm le_top + exact hdense ▸ Submodule.topologicalClosure_mono hspan_le + have hOrbit : ∀ z : H, T.IsAnalyticVector z → + Nonempty (GlobalAnalyticOrbit T z) := by + intro z hz + let W0 : AnalyticVectorWitness T.closure := + AnalyticVectorWitness.ofIsAnalytic (IsAnalyticVector.for_closure hz) + let r : ℝ := W0.radius / 2 + let δ : ℝ := r / 8 + have hr : 0 < r := by + dsimp [r] + linarith [W0.radius_pos] + have hrW0 : r < W0.radius := by + dsimp [r] + linarith [W0.radius_pos] + have hδ : 0 < δ := by + dsimp [δ] + positivity + have h4δ : 4 * δ < r := by + dsimp [δ] + linarith + let W : ℤ → AnalyticVectorWitness T.closure := + AnalyticVectorWitness.uniformIntegerLine hclosed hclosedSym hclosedense W0 + hr hrW0 hδ (by linarith) + have hbelow : ∀ n : ℤ, r < (W n).radius := by + intro n + exact (AnalyticVectorWitness.uniformIntegerLineData hclosed hclosedSym hclosedense W0 + hr hrW0 hδ (by linarith) n).2.1 + have hstate_zero : (W 0).state = z := by + have hdata0 : + AnalyticVectorWitness.uniformIntegerLineData hclosed hclosedSym hclosedense W0 + hr hrW0 hδ (by linarith) 0 = + (⟨W0, hrW0, rfl⟩ : + {W : AnalyticVectorWitness T.closure // + r < W.radius ∧ ‖W.state‖ = ‖W0.state‖}) := by + simp [AnalyticVectorWitness.uniformIntegerLineData, Int.inductionOn'_self] + change (AnalyticVectorWitness.uniformIntegerLineData hclosed hclosedSym hclosedense W0 + hr hrW0 hδ (by linarith) 0).1.state = z + rw [hdata0] + rfl + have hstate_norm : ∀ n : ℤ, ‖(W n).state‖ = ‖z‖ := by + intro n + have hn := (AnalyticVectorWitness.uniformIntegerLineData hclosed hclosedSym + hclosedense W0 hr hrW0 hδ (by linarith) n).2.2 + change ‖(AnalyticVectorWitness.uniformIntegerLineData hclosed hclosedSym hclosedense W0 + hr hrW0 hδ (by linarith) n).1.state‖ = ‖z‖ + rw [hn] + rfl + have hstep : ∀ n : ℤ, (W (n + 1)).state = + analyticExp T.closure (W n).iterates δ := by + intro n + exact AnalyticVectorWitness.uniformIntegerLine_step + hclosed hclosedSym hclosedense W0 hr hrW0 hδ h4δ (n := n) + obtain ⟨U⟩ := GlobalAnalyticOrbit.of_uniform_witness_line + (T := T.closure) (x := z) hclosed hclosedSym hclosedense W + hr hδ h4δ hbelow hstate_zero hstate_norm (by simpa [W] using hstep) + exact GlobalAnalyticOrbit.of_closure hT U + exact hsym.isEssentiallySelfAdjoint_of_denseAnalyticVectors_of_globalOrbit + hdense hOrbit + + +end LinearPMap diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Basic.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Basic.lean new file mode 100644 index 0000000000..f05011f05f --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Basic.lean @@ -0,0 +1,250 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Physlib.QuantumMechanics.Operators.SpectralTheory.SpectralMeasure +public import Mathlib.Analysis.InnerProductSpace.WeakOperatorTopology + +/-! + +# Weak-operator-topology spectral measures + +`Physlib.QuantumMechanics.Operators.SpectralTheory.SpectralMeasure` already gives a +star-projection-valued measure `Set α → H →L[ℂ] H`, σ-additive in the *norm* topology on bounded +operators. That norm additivity is too strong a requirement for the spectral measures produced by +the (still-to-come) unbounded spectral theorem: an unbounded self-adjoint operator's spectral +projections need only add up weakly, on each pair of test vectors, not in operator norm. This file +gives that weaker notion its own type, `WOTSpectralMeasure`, valued in Mathlib's weak-operator- +topology copy of the bounded operators, `H →WOT[ℂ] H` (`Mathlib.Analysis.InnerProductSpace. +WeakOperatorTopology`). + +`WOTSpectralMeasure` is otherwise a verbatim analogue of `SpectralMeasure`: same structure shape +(`VectorMeasure` plus "every value is a star projection" plus "`univ ↦ 1`"), same basic algebra +(idempotence, orthogonality on disjoint sets, intersection multiplicativity, commutativity). The +two cannot share a definition because they are literally valued in different types (`H →L[ℂ] H` +vs. `H →WOT[ℂ] H` carry the same ring structure but different topologies, hence different +`VectorMeasure` targets) — but `SpectralMeasure.toWOT`, at the end of this file, is the coercion +that turns any norm-continuous `SpectralMeasure` into a `WOTSpectralMeasure` for free, so nothing +built on `SpectralMeasure` elsewhere in this codebase needs re-deriving to be usable here. + +This file also records the covariance of the type under a measurable pushforward of the +underlying measurable space (`map`) — needed to move a spectral measure along a change of +spectral variable, e.g. through the Cayley transform. + +## Main definitions + +- `WOTSpectralMeasure` : a star-projection-valued measure, σ-additive in the weak-operator + topology. +- `comp_eq_of_inter` : `μS A * μS B = μS (A ∩ B)` for measurable `A`, `B`. +- `map` : pushing a weak spectral measure forward along a measurable function. +- `SpectralMeasure.toWOT` : a norm-continuous spectral measure, viewed weakly. + +-/ + +@[expose] public section + +noncomputable section + +open scoped Topology InnerProductSpace Function +open ContinuousLinearMap ContinuousLinearMapWOT MeasureTheory Set + +namespace QuantumMechanics + +@[nolint unusedArguments] +instance (H : Type*) [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] : + IsAddTorsionFree (H →WOT[ℂ] H) where + nsmul_right_injective n hn := by + refine Function.HasLeftInverse.injective ⟨fun f ↦ (n : ℂ)⁻¹ • f, fun x ↦ ?_⟩ + simp [← Nat.cast_smul_eq_nsmul ℂ, smul_smul, Nat.cast_ne_zero (R := ℂ), hn] + +/-! +## A. The structure and its basic algebra +-/ + +/-- A projection-valued measure with weak-operator σ-additivity: like `SpectralMeasure`, but the +underlying `VectorMeasure` is valued in the weak-operator-topology copy `H →WOT[ℂ] H` of the +bounded operators rather than in `H →L[ℂ] H` with its norm topology. -/ +structure WOTSpectralMeasure + (α : Type*) [MeasurableSpace α] + (H : Type*) [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + extends VectorMeasure α (H →WOT[ℂ] H) where + isStarProjection' : ∀ A, IsStarProjection (measureOf' A) + univ' : measureOf' univ = 1 + +namespace WOTSpectralMeasure + +variable {α : Type*} [MeasurableSpace α] +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] +variable (μS : WOTSpectralMeasure α H) + +attribute [coe] toVectorMeasure + +instance instCoeVectorMeasure : Coe (WOTSpectralMeasure α H) + (VectorMeasure α (H →WOT[ℂ] H)) := ⟨toVectorMeasure⟩ + +instance instCoeFun : CoeFun (WOTSpectralMeasure α H) fun _ ↦ Set α → H →WOT[ℂ] H := + ⟨fun μS ↦ ⇑μS.toVectorMeasure⟩ + +lemma isStarProjection (A : Set α) : IsStarProjection (μS A) := μS.isStarProjection' A + +@[simp] +lemma univ : μS univ = 1 := μS.univ' + +lemma apply_eq_zero_of_not_measurableSet {A : Set α} (hA : ¬MeasurableSet A) : μS A = 0 := + μS.not_measurable' hA + +lemma comp_self (A : Set α) : μS A * μS A = μS A := + (μS.isStarProjection A).isIdempotentElem + +lemma comp_of_disjoint {A B : Set α} (h : Disjoint A B) (hA : MeasurableSet A) + (hB : MeasurableSet B) : μS A * μS B = 0 := by + have hp : μS A * μS (A ∪ B) = μS A := by + refine (IsStarProjection.sub_iff_mul_eq_left (μS.isStarProjection A) + (μS.isStarProjection (A ∪ B))).mp ?_ + simpa [μS.of_union h hA hB] using μS.isStarProjection B + rw [μS.of_union h hA hB, mul_add, μS.comp_self] at hp + apply add_left_cancel (a := μS A) + simpa using hp + +lemma comp_eq_of_inter {A B : Set α} (hA : MeasurableSet A) (hB : MeasurableSet B) : + μS A * μS B = μS (A ∩ B) := by + nth_rw 1 [← inter_union_sdiff B A, ← inter_union_sdiff A B] + simp only [μS.of_union, hA.inter hB, hB.inter hA, hA.diff hB, hB.diff hA, + disjoint_sdiff_inter.symm, add_mul, mul_add] + rw [inter_comm B A, μS.comp_of_disjoint disjoint_sdiff_inter (hA.diff hB) (hA.inter hB), + inter_comm A B, μS.comp_of_disjoint disjoint_sdiff_inter.symm (hB.inter hA) (hB.diff hA)] + simp [μS.comp_self, μS.comp_of_disjoint disjoint_sdiff_sdiff (hA.diff hB) (hB.diff hA)] + +lemma commute (A B : Set α) : Commute (μS A) (μS B) := by + by_cases hAB : MeasurableSet A ∧ MeasurableSet B + · simp [commute_iff_eq, comp_eq_of_inter, hAB, inter_comm] + · rcases not_and_or.mp hAB with hA | hB <;> simp [*] + +/-! ## B. Pushforward along a measurable map -/ + +/-- Push a weak spectral measure forward along a measurable change of spectral variable. -/ +def map {β : Type*} [MeasurableSpace β] (f : α → β) (hf : Measurable f) : + WOTSpectralMeasure β H where + toVectorMeasure := μS.toVectorMeasure.map f + isStarProjection' S := by + change IsStarProjection ((μS.toVectorMeasure.map f) S) + by_cases hS : MeasurableSet S + · rw [MeasureTheory.VectorMeasure.map_apply _ hf hS] + exact μS.isStarProjection _ + · simp [MeasureTheory.VectorMeasure.map, hf, hS] + univ' := by + change (μS.toVectorMeasure.map f) Set.univ = 1 + rw [MeasureTheory.VectorMeasure.map_apply _ hf MeasurableSet.univ] + simp + +@[simp] +lemma map_apply {β : Type*} [MeasurableSpace β] (f : α → β) (hf : Measurable f) + {S : Set β} (hS : MeasurableSet S) : + μS.map f hf S = μS (f ⁻¹' S) := by + change (μS.toVectorMeasure.map f) S = μS (f ⁻¹' S) + exact MeasureTheory.VectorMeasure.map_apply _ hf hS + +lemma map_map_apply {β γ : Type*} [MeasurableSpace β] [MeasurableSpace γ] + (f : α → β) (g : β → γ) (hf : Measurable f) (hg : Measurable g) + {S : Set γ} (hS : MeasurableSet S) : + (μS.map f hf).map g hg S = μS ((g ∘ f) ⁻¹' S) := by + rw [(μS.map f hf).map_apply g hg hS, μS.map_apply f hf (hg hS)] + rfl + +theorem map_map {β γ : Type*} [MeasurableSpace β] [MeasurableSpace γ] + (f : α → β) (g : β → γ) (hf : Measurable f) (hg : Measurable g) : + (μS.map f hf).map g hg = μS.map (g ∘ f) (hg.comp hf) := by + rw [WOTSpectralMeasure.mk.injEq] + apply MeasureTheory.VectorMeasure.ext + intro S hS + rw [μS.map_map_apply f g hf hg hS, μS.map_apply (g ∘ f) (hg.comp hf) hS] + +theorem map_id : μS.map id measurable_id = μS := by + rw [WOTSpectralMeasure.mk.injEq] + apply MeasureTheory.VectorMeasure.ext + intro S hS + rw [μS.map_apply id measurable_id hS] + rfl + +/-- The σ-additivity statement seen by vectors and test vectors. This is often more convenient +than mentioning the `WOT` type directly when proving spectral formulas. -/ +lemma hasSum_inner {f : ℕ → Set α} (hf : ∀ i, MeasurableSet (f i)) + (hdisj : Pairwise (Disjoint on f)) (x y : H) : + HasSum (fun i ↦ ⟪y, μS (f i) x⟫_ℂ) ⟪y, μS (⋃ i, f i) x⟫_ℂ := by + have h := μS.toVectorMeasure.m_iUnion hf hdisj + let g : (H →WOT[ℂ] H) →+ ℂ := + { toFun := fun T ↦ ⟪y, T x⟫_ℂ + map_zero' := by simp + map_add' := by + intro T U + change ⟪y, T x + U x⟫_ℂ = _ + rw [inner_add_right] } + have hg : Continuous g := by + dsimp [g] + fun_prop + change HasSum (fun i ↦ g (μS (f i))) (g (μS (⋃ i, f i))) + exact h.map g hg + +end WOTSpectralMeasure + +end QuantumMechanics + +/-! +## C. Coming from a norm-continuous `SpectralMeasure` +-/ + +namespace SpectralMeasure + +open QuantumMechanics + +variable {α : Type*} [MeasurableSpace α] +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-- Forgetting norm σ-additivity and retaining weak-operator σ-additivity. -/ +def toWOTMap : (H →L[ℂ] H) →+ (H →WOT[ℂ] H) := + { toFun := ContinuousLinearMapWOT.ofCLM + map_zero' := by simp + map_add' := by intro S T; simp } + +omit [CompleteSpace H] in +@[nolint unusedArguments] +lemma continuous_toWOTMap : Continuous (toWOTMap (H := H)) := by + change Continuous (ContinuousLinearMapWOT.ofCLM : + (H →L[ℂ] H) → (H →WOT[ℂ] H)) + exact ContinuousLinearMapWOT.continuous_ofCLM + +/-- A `SpectralMeasure`, viewed in the weak-operator-topology type `H →WOT[ℂ] H`. -/ +def toWOT (μS : SpectralMeasure α H) : WOTSpectralMeasure α H where + toVectorMeasure := by + exact μS.toVectorMeasure.mapRange (toWOTMap (H := H)) + (continuous_toWOTMap (H := H)) + isStarProjection' A := by + change IsStarProjection (ContinuousLinearMapWOT.ofCLM (μS A)) + refine ⟨?_, ?_⟩ + · change ContinuousLinearMapWOT.ofCLM (μS A) * + ContinuousLinearMapWOT.ofCLM (μS A) = ContinuousLinearMapWOT.ofCLM (μS A) + rw [← ContinuousLinearMapWOT.ofCLM_mul] + exact congrArg ContinuousLinearMapWOT.ofCLM + (μS.isStarProjection A).isIdempotentElem + · apply ContinuousLinearMapWOT.toCLM_injective + change star (μS A) = μS A + exact (μS.isStarProjection A).isSelfAdjoint + univ' := by + change ContinuousLinearMapWOT.ofCLM (μS Set.univ) = 1 + rw [SpectralMeasure.univ μS] + simp + +@[simp] +lemma toWOT_apply (μS : SpectralMeasure α H) (A : Set α) : μS.toWOT A = + ContinuousLinearMapWOT.ofCLM (μS A) := by + change (μS.toVectorMeasure.mapRange (toWOTMap (H := H)) + (continuous_toWOTMap (H := H))) A = _ + rw [MeasureTheory.VectorMeasure.mapRange_apply] + rfl + +end SpectralMeasure + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/BoundedIntegral.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/BoundedIntegral.lean new file mode 100644 index 0000000000..3fa059222c --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/BoundedIntegral.lean @@ -0,0 +1,618 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.ScalarMeasure +public import Mathlib.MeasureTheory.Measure.Complex +public import Mathlib.MeasureTheory.Integral.IntegrableOn +public import Mathlib.MeasureTheory.Integral.SetToL1 + +/-! + +# The bounded weak-operator spectral integral + +Builds `boundedIntegral μS f hf hbdd : H →WOT[ℂ] H`, the operator `∫ f dμS` for a bounded +measurable `f : α → ℂ`, in three stages: + +1. `simpleIntegral` : the finite-sum integral of a `SimpleFunc α ℂ`, + `∑ z ∈ f.range, z • μS (f⁻¹{z})`. +2. `boundedIntegralOfUniformApprox` : given an explicit sequence of simple functions + converging + *uniformly* to `f`, the norm-limit (in the underlying `H →L[ℂ] H`, then viewed weakly) of their + simple integrals. `simpleIntegral_norm_le` gives the uniform Cauchy estimate that makes this + limit exist. +3. `boundedIntegral` : specializing to the canonical uniform approximation supplied by + `SimpleFunc.approxOn` on a bounded range (`exists_uniform_simple_approx`), so no approximating + sequence needs to be supplied by hand. + +This is the weak-operator-topology analogue of ordinary integration against a scalar measure +generalized to an operator-valued one; a weak PVM need not have finite variation in operator +norm, so working in the WOT type (rather than trying to make sense of a norm-limit integral +directly) is what makes this integral tractable at all. The characteristic-function case, +`simpleIntegral_piecewise_indicator`, is the bridge back from this integral to `μS` itself: +`∫ 𝟙_S dμS = μS S`. + +## Main definitions + +- `simpleIntegral`, `simpleIntegral_norm_sq_eq_lintegral` : the finite-sum integral, and its + norm-square identity against `diagonalMeasure`. +- `boundedIntegral` : the canonical bounded operator integral of a bounded measurable `f`. + +-/ + +@[expose] public section + +noncomputable section + +open scoped Topology InnerProductSpace Function +open ContinuousLinearMap ContinuousLinearMapWOT MeasureTheory Set + +namespace QuantumMechanics + +namespace WOTSpectralMeasure + +variable {α : Type*} [MeasurableSpace α] +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] +variable (μS : WOTSpectralMeasure α H) + +/-! ## A. The simple-function integral + +The operator integral of a measurable simple multiplier. This is the finite-sum stage of the +bounded spectral calculus. It is defined in the weak-operator representation because a weak PVM +need not have finite variation in operator norm. -/ + +/-- The weak-operator integral of a complex-valued simple function. -/ +noncomputable def simpleIntegral (f : SimpleFunc α ℂ) : H →WOT[ℂ] H := + ∑ z ∈ f.range, z • μS (f ⁻¹' {z}) + +lemma simpleIntegral_inner (f : SimpleFunc α ℂ) (x y : H) : + ⟪y, simpleIntegral μS f x⟫_ℂ = + ∑ z ∈ f.range, z * μS.scalarMeasure x y (f ⁻¹' {z}) := by + change (innerEvaluation (H := H) x y) + (∑ z ∈ f.range, z • μS (f ⁻¹' {z})) = _ + rw [map_sum] + simp [innerEvaluation, ContinuousLinearMapWOT.smul_apply, inner_smul_right, + scalarMeasure_apply] + +lemma simpleIntegral_norm_sq (f : SimpleFunc α ℂ) (x : H) : + ENNReal.ofReal (‖simpleIntegral μS f x‖ ^ 2) = + ∑ z ∈ f.range, ENNReal.ofReal (‖z‖ ^ 2) * + (μS.diagonalMeasure x) (f ⁻¹' {z}) := by + rw [← inner_self_eq_norm_sq (𝕜 := ℂ)] + rw [simpleIntegral] + change ENNReal.ofReal (⟪(∑ z ∈ f.range, z • (μS (f ⁻¹' {z}))) x, + (∑ z ∈ f.range, z • (μS (f ⁻¹' {z}))) x⟫_ℂ).re = _ + have hsum : ∀ (s : Finset ℂ), + (∑ z ∈ s, z • (μS (f ⁻¹' {z}))) x = + ∑ z ∈ s, z • (μS (f ⁻¹' {z})) x := by + intro s + induction s using Finset.induction_on with + | empty => simp + | @insert z s hz ih => + simp only [Finset.sum_insert hz] + rw [ContinuousLinearMapWOT.add_apply, ih] + simp [ContinuousLinearMapWOT.smul_apply] + rw [hsum] + simp only [sum_inner, inner_sum] + simp only [inner_smul_left, inner_smul_right] + have hRHS : + (∑ z ∈ f.range, ENNReal.ofReal (‖z‖ ^ 2) * + (μS.diagonalMeasure x) (f ⁻¹' {z})) = + ENNReal.ofReal (∑ z ∈ f.range, + ‖z‖ ^ 2 * (⟪x, μS (f ⁻¹' {z}) x⟫_ℂ).re) := by + simp_rw [μS.diagonalMeasure_apply x _ (f.measurableSet_fiber _)] + simp_rw [← ENNReal.ofReal_mul (sq_nonneg _)] + rw [← ENNReal.ofReal_sum_of_nonneg] + intro z hz + exact mul_nonneg (sq_nonneg _) (μS.re_inner_nonneg _ x) + rw [hRHS] + have hReSum : ∀ (s : Finset ℂ) (g : ℂ → ℂ), + (∑ z ∈ s, g z).re = ∑ z ∈ s, (g z).re := by + intro s g + induction s using Finset.induction_on with + | empty => simp + | @insert z s hz ih => + simp only [Finset.sum_insert hz, Complex.add_re, ih] + rw [hReSum] + congr 1 + apply Finset.sum_congr rfl + intro z hz + rw [Finset.sum_eq_single z] + · rw [← inner_self_eq_norm_sq (𝕜 := ℂ)] + rw [μS.inner_eq_inner_projection] + rw [inner_self_eq_norm_sq_to_K, inner_self_eq_norm_sq_to_K] + norm_num [pow_two, Complex.mul_re, Complex.mul_im, RCLike.conj_re, RCLike.conj_im, + RCLike.ofReal_re, RCLike.ofReal_im] + have hzNorm : ‖z‖ * ‖z‖ = z.re * z.re + z.im * z.im := by + rw [← pow_two, Complex.sq_norm, Complex.normSq_apply] + rw [hzNorm] + ring + · intro w hw hwz + have hdisj : Disjoint (f ⁻¹' ({z} : Set ℂ)) (f ⁻¹' ({w} : Set ℂ)) := by + refine Set.disjoint_left.2 ?_ + intro a ha hb + have haz : f a = z := by + simpa only [Set.mem_preimage, Set.mem_singleton_iff] using ha + have haw : f a = w := by + simpa only [Set.mem_preimage, Set.mem_singleton_iff] using hb + exact hwz (haw.symm.trans haz) + rw [inner_eq_zero_of_disjoint μS hdisj.symm (f.measurableSet_fiber _) + (f.measurableSet_fiber _) x] + simp + · intro hznot + exact (hznot hz).elim + +lemma simpleIntegral_norm_sq_eq_lintegral (f : SimpleFunc α ℂ) (x : H) : + ENNReal.ofReal (‖simpleIntegral μS f x‖ ^ 2) = + ∫⁻ z, ENNReal.ofReal (‖f z‖ ^ 2) ∂μS.diagonalMeasure x := by + rw [μS.simpleIntegral_norm_sq] + have hfun : (fun z : α => ENNReal.ofReal (‖f z‖ ^ 2)) = + (fun z : α => (f.map (fun z : ℂ => ENNReal.ofReal (‖z‖ ^ 2))) z) := by + funext z + rfl + rw [hfun] + rw [(f.map (fun z : ℂ => ENNReal.ofReal (‖z‖ ^ 2))).lintegral_eq_lintegral] + rw [SimpleFunc.map_lintegral] + +lemma simpleIntegral_norm_sq_le (f : SimpleFunc α ℂ) (x : H) {C : ℝ} + (hC : ∀ z ∈ f.range, ‖z‖ ^ 2 ≤ C ^ 2) : + ENNReal.ofReal (‖simpleIntegral μS f x‖ ^ 2) ≤ + ENNReal.ofReal (C ^ 2 * ‖x‖ ^ 2) := by + rw [μS.simpleIntegral_norm_sq] + calc + (∑ z ∈ f.range, ENNReal.ofReal (‖z‖ ^ 2) * + (μS.diagonalMeasure x) (f ⁻¹' {z})) ≤ + ∑ z ∈ f.range, ENNReal.ofReal (C ^ 2) * + (μS.diagonalMeasure x) (f ⁻¹' {z}) := by + apply Finset.sum_le_sum + intro z hz + exact mul_le_mul_left (ENNReal.ofReal_le_ofReal (hC z hz)) _ + _ = ENNReal.ofReal (C ^ 2) * + ∑ z ∈ f.range, (μS.diagonalMeasure x) (f ⁻¹' {z}) := by + rw [Finset.mul_sum] + _ = ENNReal.ofReal (C ^ 2) * (μS.diagonalMeasure x) Set.univ := by + rw [← f.sum_range_measure_preimage_singleton] + _ = ENNReal.ofReal (C ^ 2 * ‖x‖ ^ 2) := by + rw [μS.diagonalMeasure_univ, ← ENNReal.ofReal_mul (sq_nonneg C)] + +lemma simpleIntegral_norm_le (f : SimpleFunc α ℂ) (x : H) {C : ℝ} + (hC : 0 ≤ C) (hCf : ∀ z ∈ f.range, ‖z‖ ≤ C) : + ‖simpleIntegral μS f x‖ ≤ C * ‖x‖ := by + have hsq : ∀ z ∈ f.range, ‖z‖ ^ 2 ≤ C ^ 2 := by + intro z hz + exact (sq_le_sq₀ (norm_nonneg z) hC).mpr (hCf z hz) + have hENN := μS.simpleIntegral_norm_sq_le f x hsq + have hreal : ‖simpleIntegral μS f x‖ ^ 2 ≤ C ^ 2 * ‖x‖ ^ 2 := + (ENNReal.ofReal_le_ofReal_iff (mul_nonneg (sq_nonneg C) (sq_nonneg ‖x‖))).mp hENN + apply (sq_le_sq₀ (norm_nonneg _) (mul_nonneg hC (norm_nonneg _))).mp + calc + ‖simpleIntegral μS f x‖ ^ 2 ≤ C ^ 2 * ‖x‖ ^ 2 := hreal + _ = (C * ‖x‖) ^ 2 := by ring + +lemma simpleIntegral_const [Nonempty α] (c : ℂ) : + simpleIntegral μS (SimpleFunc.const α c) = c • (1 : H →WOT[ℂ] H) := by + apply ContinuousLinearMapWOT.ext_inner + intro x y + rw [simpleIntegral_inner] + have hpre : (Function.const α c) ⁻¹' ({c} : Set ℂ) = Set.univ := + Set.preimage_const_of_mem (by simp) + rw [SimpleFunc.range_const, Finset.sum_singleton, SimpleFunc.coe_const, hpre, + scalarMeasure_apply, μS.univ] + simp [ContinuousLinearMapWOT.one_apply, ContinuousLinearMapWOT.smul_apply, + inner_smul_right] + +/-! ## B. Uniform approximation and the limiting integral + +The WOT type is a topological copy of the bounded-operator space; its underlying normed operator +is still available through `toCLM`. The finite estimate above therefore gives a norm completion +for any explicitly supplied uniformly convergent simple approximation. Keeping the approximation +sequence as an argument makes the analytic hypotheses visible at this low level. +-/ + +/-- The real-linear map `z ↦ z • μS(S)`, as a bounded operator, for each `z : ℂ`. -/ +def spectralCLM (S : Set α) : ℂ →L[ℝ] (H →L[ℂ] H) := + ((ContinuousLinearMap.id ℂ ℂ).smulRight (ContinuousLinearMapWOT.toCLM (μS S))).restrictScalars ℝ + +lemma spectralCLM_apply (S : Set α) (z : ℂ) : + spectralCLM μS S z = z • ContinuousLinearMapWOT.toCLM (μS S) := by + rfl + +private lemma spectralCLM_finMeasAdditive (μ : Measure α) : + FinMeasAdditive μ (spectralCLM μS) := by + intro S U hS hU hμS hμU hdisj + ext z x + change z • (μS (S ∪ U) x) = z • (μS S x) + z • (μS U x) + rw [μS.of_union hdisj hS hU] + simp [smul_add] + +private lemma simpleFunc_integrable_dirac (f : SimpleFunc α ℂ) [Nonempty α] : + Integrable f (Measure.dirac (Classical.choice (inferInstance : Nonempty α))) := by + obtain ⟨C, hC⟩ := (f.map norm).exists_forall_le + apply Integrable.of_bound f.measurable.aestronglyMeasurable C + filter_upwards [] with x + exact hC x + +@[nolint unusedArguments] +lemma simpleIntegral_eq_setToSimpleFunc (f : SimpleFunc α ℂ) (_μ : Measure α) : + ContinuousLinearMapWOT.toCLM (simpleIntegral μS f) = f.setToSimpleFunc (spectralCLM μS) := by + apply ContinuousLinearMap.ext + intro x + simp only [SimpleFunc.setToSimpleFunc, spectralCLM_apply] + have hsum : ∀ (s : Finset ℂ), + (∑ z ∈ s, z • μS (f ⁻¹' {z})) x = + ∑ z ∈ s, z • (μS (f ⁻¹' {z}) x) := by + intro s + induction s using Finset.induction_on with + | empty => simp + | @insert z s hz ih => + simp only [Finset.sum_insert hz] + rw [ContinuousLinearMapWOT.add_apply, ih] + simp [ContinuousLinearMapWOT.smul_apply] + change (∑ z ∈ f.range, z • μS (f ⁻¹' {z})) x = + (∑ z ∈ f.range, z • ContinuousLinearMapWOT.toCLM (μS (f ⁻¹' {z}))) x + rw [hsum] + simp + +/-! The characteristic-function case is the bridge from bounded integration back to the PVM. -/ + +lemma simpleIntegral_piecewise_indicator {S : Set α} (hS : MeasurableSet S) : + simpleIntegral μS + (SimpleFunc.piecewise S hS (SimpleFunc.const α (1 : ℂ)) + (SimpleFunc.const α (0 : ℂ))) = μS S := by + apply ContinuousLinearMapWOT.toCLM_injective + rw [simpleIntegral_eq_setToSimpleFunc μS _ (0 : Measure α)] + have hempty : spectralCLM μS ∅ = 0 := by + ext z + simp [spectralCLM, μS.empty] + rw [SimpleFunc.setToSimpleFunc_indicator (spectralCLM μS) hempty] + simp [spectralCLM_apply] + +lemma simpleIntegral_add [Nonempty α] (f g : SimpleFunc α ℂ) : + simpleIntegral μS (f + g) = simpleIntegral μS f + simpleIntegral μS g := by + apply ContinuousLinearMapWOT.toCLM_injective + let μ : Measure α := Measure.dirac (Classical.choice (inferInstance : Nonempty α)) + rw [ContinuousLinearMapWOT.toCLM_add] + rw [simpleIntegral_eq_setToSimpleFunc μS (f + g) μ, + simpleIntegral_eq_setToSimpleFunc μS f μ, + simpleIntegral_eq_setToSimpleFunc μS g μ] + exact SimpleFunc.setToSimpleFunc_add (spectralCLM μS) (spectralCLM_finMeasAdditive μS μ) + (simpleFunc_integrable_dirac f) (simpleFunc_integrable_dirac g) + +lemma simpleIntegral_neg [Nonempty α] (f : SimpleFunc α ℂ) : + simpleIntegral μS (-f) = -simpleIntegral μS f := by + apply ContinuousLinearMapWOT.toCLM_injective + let μ : Measure α := Measure.dirac (Classical.choice (inferInstance : Nonempty α)) + rw [ContinuousLinearMapWOT.toCLM_neg] + rw [simpleIntegral_eq_setToSimpleFunc μS (-f) μ, + simpleIntegral_eq_setToSimpleFunc μS f μ] + exact SimpleFunc.setToSimpleFunc_neg (spectralCLM μS) (spectralCLM_finMeasAdditive μS μ) + (simpleFunc_integrable_dirac f) + +lemma simpleIntegral_sub [Nonempty α] (f g : SimpleFunc α ℂ) : + simpleIntegral μS (f - g) = simpleIntegral μS f - simpleIntegral μS g := by + rw [sub_eq_add_neg, simpleIntegral_add, simpleIntegral_neg, sub_eq_add_neg] + +lemma simpleIntegral_mul [Nonempty α] (f g : SimpleFunc α ℂ) : + simpleIntegral μS (f * g) = simpleIntegral μS f * simpleIntegral μS g := by + apply ContinuousLinearMapWOT.toCLM_injective + let μ : Measure α := Measure.dirac (Classical.choice (inferInstance : Nonempty α)) + let p : SimpleFunc α (ℂ × ℂ) := f.pair g + have hf : Integrable f μ := simpleFunc_integrable_dirac f + have hg : Integrable g μ := simpleFunc_integrable_dirac g + have hp : Integrable p μ := SimpleFunc.integrable_pair hf hg + have hadd := spectralCLM_finMeasAdditive μS μ + have hfst : ContinuousLinearMapWOT.toCLM (simpleIntegral μS f) = + ∑ q ∈ p.range, q.1 • ContinuousLinearMapWOT.toCLM (μS (p ⁻¹' {q})) := by + rw [simpleIntegral_eq_setToSimpleFunc μS f μ, ← SimpleFunc.map_fst_pair f g] + rw [SimpleFunc.map_setToSimpleFunc (spectralCLM μS) hadd hp Prod.fst_zero] + simp only [spectralCLM_apply] + have hsnd : ContinuousLinearMapWOT.toCLM (simpleIntegral μS g) = + ∑ q ∈ p.range, q.2 • ContinuousLinearMapWOT.toCLM (μS (p ⁻¹' {q})) := by + rw [simpleIntegral_eq_setToSimpleFunc μS g μ, ← SimpleFunc.map_snd_pair f g] + rw [SimpleFunc.map_setToSimpleFunc (spectralCLM μS) hadd hp Prod.snd_zero] + simp only [spectralCLM_apply] + have hmul : ContinuousLinearMapWOT.toCLM (simpleIntegral μS (f * g)) = + ∑ q ∈ p.range, (q.1 * q.2) • ContinuousLinearMapWOT.toCLM (μS (p ⁻¹' {q})) := by + rw [simpleIntegral_eq_setToSimpleFunc μS (f * g) μ, SimpleFunc.mul_eq_map₂] + rw [SimpleFunc.map_setToSimpleFunc (spectralCLM μS) hadd hp (by simp)] + simp only [spectralCLM_apply] + rw [ContinuousLinearMapWOT.toCLM_mul, hfst, hsnd, hmul] + rw [Finset.sum_mul_sum] + refine Finset.sum_congr rfl fun q hq => ?_ + rw [Finset.sum_eq_single q] + · rw [smul_mul_smul_comm, ← ContinuousLinearMapWOT.toCLM_mul, μS.comp_self] + · intro r hr hneq + rw [smul_mul_smul_comm, ← ContinuousLinearMapWOT.toCLM_mul] + have hdisj : Disjoint (p ⁻¹' {q}) (p ⁻¹' {r}) := by + refine Set.disjoint_left.2 ?_ + intro a haq har + have haq' : p a = q := by + simpa only [Set.mem_preimage, Set.mem_singleton_iff] using haq + have har' : p a = r := by + simpa only [Set.mem_preimage, Set.mem_singleton_iff] using har + exact hneq (har'.symm.trans haq') + rw [μS.comp_of_disjoint hdisj (p.measurableSet_fiber _) + (p.measurableSet_fiber _), ContinuousLinearMapWOT.toCLM_zero, smul_zero] + · intro hq' + exact (hq' hq).elim + +@[nolint unusedArguments] +lemma simpleIntegral_star [Nonempty α] (f : SimpleFunc α ℂ) : + simpleIntegral μS (star f) = star (simpleIntegral μS f) := by + classical + simp only [simpleIntegral, star_sum] + refine Finset.sum_bij (fun z hz => star z) ?_ ?_ ?_ ?_ + · intro z hz + rcases SimpleFunc.mem_range.1 hz with ⟨x, hx⟩ + apply SimpleFunc.mem_range.2 + refine ⟨x, ?_⟩ + change f x = star z + have hx' := congrArg star hx + change star (star (f x)) = star z at hx' + simpa using hx' + · intro z₁ hz₁ z₂ hz₂ h + exact star_injective h + · intro z hz + rcases SimpleFunc.mem_range.1 hz with ⟨x, hx⟩ + refine ⟨star z, ?_, ?_⟩ + · apply SimpleFunc.mem_range.2 + refine ⟨x, ?_⟩ + change star (f x) = star z + exact congrArg star hx + · simp + · intro z hz + have hfiber : (⇑(star f) : α → ℂ) ⁻¹' {z} = + (⇑f : α → ℂ) ⁻¹' {star z} := by + ext x + change star (f x) = z ↔ f x = star z + constructor + · intro h + simpa using congrArg star h + · intro h + exact congrArg star h |>.trans (star_star z) + rw [hfiber, star_smul, star_star] + simp only [(μS.isStarProjection _).isSelfAdjoint.star_eq] + +lemma simpleIntegral_toCLM_norm_le (f : SimpleFunc α ℂ) {C : ℝ} + (hC : 0 ≤ C) (hCf : ∀ z ∈ f.range, ‖z‖ ≤ C) : + ‖ContinuousLinearMapWOT.toCLM (simpleIntegral μS f)‖ ≤ C := by + apply ContinuousLinearMap.opNorm_le_bound _ hC + intro x + exact μS.simpleIntegral_norm_le f x hC hCf + +lemma simpleIntegral_toCLM_diff_norm_le [Nonempty α] (f g : SimpleFunc α ℂ) {C : ℝ} + (hC : 0 ≤ C) (hfg : ∀ x, ‖f x - g x‖ ≤ C) : + ‖ContinuousLinearMapWOT.toCLM (simpleIntegral μS f) - + ContinuousLinearMapWOT.toCLM (simpleIntegral μS g)‖ ≤ C := by + rw [← ContinuousLinearMapWOT.toCLM_sub, ← μS.simpleIntegral_sub] + apply μS.simpleIntegral_toCLM_norm_le (f - g) hC + intro z hz + rcases SimpleFunc.mem_range.1 hz with ⟨x, rfl⟩ + simpa only [SimpleFunc.sub_apply] using hfg x + +lemma simpleIntegral_toCLM_cauchySeq [Nonempty α] {f : α → ℂ} {s : ℕ → SimpleFunc α ℂ} + (hs : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖s n x - f x‖ < ε) : + CauchySeq (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s n))) := by + rw [Metric.cauchySeq_iff] + intro ε hε + rcases hs (ε / 4) (by linarith) with ⟨N, hN⟩ + refine ⟨N, fun m hm n hn => ?_⟩ + have hmn : ∀ x, ‖s m x - s n x‖ ≤ ε / 2 := by + intro x + apply le_of_lt + calc + ‖s m x - s n x‖ ≤ ‖s m x - f x‖ + ‖s n x - f x‖ := by + calc + ‖s m x - s n x‖ = ‖(s m x - f x) - (s n x - f x)‖ := by ring_nf + _ ≤ ‖s m x - f x‖ + ‖s n x - f x‖ := norm_sub_le _ _ + _ < ε / 4 + ε / 4 := add_lt_add (hN m hm x) (hN n hn x) + _ = ε / 2 := by ring + have hbound := μS.simpleIntegral_toCLM_diff_norm_le (s m) (s n) (by linarith) hmn + simpa only [dist_eq_norm] using lt_of_le_of_lt hbound (by linarith) + +/-- The bounded operator integral obtained from an explicit uniformly convergent simple +approximation. The limit is taken in the normed space of bounded operators and then viewed in the +WOT copy. -/ +@[nolint unusedArguments] +noncomputable def boundedIntegralOfUniformApprox [Nonempty α] + (f : α → ℂ) (s : ℕ → SimpleFunc α ℂ) + (_hs : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖s n x - f x‖ < ε) : + H →WOT[ℂ] H := + ContinuousLinearMapWOT.ofCLM + (Filter.atTop.limUnder + (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s n)))) + +lemma boundedIntegralOfUniformApprox_eq_limUnder + [Nonempty α] + (f : α → ℂ) (s : ℕ → SimpleFunc α ℂ) + (hs : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖s n x - f x‖ < ε) : + ContinuousLinearMapWOT.toCLM (boundedIntegralOfUniformApprox μS f s hs) = + Filter.atTop.limUnder + (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s n))) := by + rfl + +lemma boundedIntegralOfUniformApprox_norm_le + [Nonempty α] + (f : α → ℂ) (s : ℕ → SimpleFunc α ℂ) + (hs : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖s n x - f x‖ < ε) + {C : ℝ} (hC : ∀ n x, ‖s n x‖ ≤ C) : + ‖ContinuousLinearMapWOT.toCLM (boundedIntegralOfUniformApprox μS f s hs)‖ ≤ C := by + have hC0 : 0 ≤ C := by + let a₀ : α := Classical.choice (inferInstance : Nonempty α) + exact (norm_nonneg (s 0 a₀)).trans (hC 0 a₀) + have hseq : ∀ n, + ‖ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s n))‖ ≤ C := by + intro n + apply simpleIntegral_toCLM_norm_le μS (s n) hC0 + intro z hz + rcases SimpleFunc.mem_range.1 hz with ⟨x, rfl⟩ + exact hC n x + have hlim : Filter.Tendsto + (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s n))) Filter.atTop + (𝓝 (ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS f s hs))) := by + rw [boundedIntegralOfUniformApprox_eq_limUnder] + exact (simpleIntegral_toCLM_cauchySeq μS hs).tendsto_limUnder + apply (isClosed_le continuous_norm continuous_const).mem_of_tendsto hlim + exact Filter.Eventually.of_forall hseq + +lemma boundedIntegralOfUniformApprox_eq_of_uniform_approx + [Nonempty α] + {f : α → ℂ} {s t : ℕ → SimpleFunc α ℂ} + (hs : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖s n x - f x‖ < ε) + (ht : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖t n x - f x‖ < ε) + (hst : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖s n x - t n x‖ < ε) : + boundedIntegralOfUniformApprox μS f s hs = + boundedIntegralOfUniformApprox μS f t ht := by + apply ContinuousLinearMapWOT.toCLM_injective + let S : ℕ → H →L[ℂ] H := fun n => + ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s n)) + let U : ℕ → H →L[ℂ] H := fun n => + ContinuousLinearMapWOT.toCLM (simpleIntegral μS (t n)) + have hdist : Filter.Tendsto (fun n => dist (S n) (U n)) Filter.atTop (𝓝 0) := by + rw [Metric.tendsto_atTop] + intro ε hε + rcases hst (ε / 2) (by linarith) with ⟨N, hN⟩ + refine ⟨N, fun n hn => ?_⟩ + have hnorm : ‖S n - U n‖ < ε := by + have h := simpleIntegral_toCLM_diff_norm_le μS (s n) (t n) + (by positivity : (0 : ℝ) ≤ ε / 2) (fun x => le_of_lt (hN n hn x)) + have h' : ‖S n - U n‖ ≤ ε / 2 := by + simpa only [S, U, ← ContinuousLinearMapWOT.toCLM_sub] using h + exact h'.trans_lt (by linarith) + have hdist' : dist (S n) (U n) < ε := by + simpa only [dist_eq_norm] using hnorm + change dist (dist (S n) (U n)) 0 < ε + simpa only [dist_zero_right, Real.norm_of_nonneg (dist_nonneg)] using hdist' + have hlimS : Filter.Tendsto (fun n => S n) Filter.atTop + (𝓝 (ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS f s hs))) := by + change Filter.Tendsto + (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s n))) Filter.atTop _ + rw [boundedIntegralOfUniformApprox_eq_limUnder] + exact (simpleIntegral_toCLM_cauchySeq μS hs).tendsto_limUnder + have hlimU : Filter.Tendsto (fun n => U n) Filter.atTop + (𝓝 (ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS f t ht))) := by + change Filter.Tendsto + (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (t n))) Filter.atTop _ + rw [boundedIntegralOfUniformApprox_eq_limUnder] + exact (simpleIntegral_toCLM_cauchySeq μS ht).tendsto_limUnder + have hlimU' : Filter.Tendsto (fun n => U n) Filter.atTop + (𝓝 (ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS f s hs))) := + hlimS.congr_dist hdist + have heq : ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS f s hs) = + ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS f t ht) := + tendsto_nhds_unique hlimU' hlimU + exact heq + +lemma boundedIntegralOfUniformApprox_eq_of_same_target + [Nonempty α] + {f : α → ℂ} {s t : ℕ → SimpleFunc α ℂ} + (hs : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖s n x - f x‖ < ε) + (ht : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖t n x - f x‖ < ε) : + boundedIntegralOfUniformApprox μS f s hs = + boundedIntegralOfUniformApprox μS f t ht := by + apply boundedIntegralOfUniformApprox_eq_of_uniform_approx μS hs ht + intro ε hε + rcases hs (ε / 2) (by linarith) with ⟨Ns, hNs⟩ + rcases ht (ε / 2) (by linarith) with ⟨Nt, hNt⟩ + refine ⟨max Ns Nt, fun n hn x => ?_⟩ + calc + ‖s n x - t n x‖ ≤ ‖s n x - f x‖ + ‖t n x - f x‖ := by + calc + ‖s n x - t n x‖ = ‖(s n x - f x) - (t n x - f x)‖ := by ring_nf + _ ≤ ‖s n x - f x‖ + ‖t n x - f x‖ := norm_sub_le _ _ + _ < ε / 2 + ε / 2 := add_lt_add + (hNs n (le_trans (le_max_left _ _) hn) x) + (hNt n (le_trans (le_max_right _ _) hn) x) + _ = ε := by ring + +/-! ## C. The canonical integral -/ + +lemma exists_uniform_simple_approx [Nonempty α] {f : α → ℂ} (hf : Measurable f) + (hbdd : ∃ C, ∀ x, ‖f x‖ ≤ C) : + ∃ s : ℕ → SimpleFunc α ℂ, + (∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖s n x - f x‖ < ε) ∧ + ∃ C, ∀ n x, ‖s n x‖ ≤ C := by + rcases hbdd with ⟨C, hC⟩ + let a₀ : α := Classical.choice (inferInstance : Nonempty α) + have hC0 : 0 ≤ C := (norm_nonneg (f a₀)).trans (hC a₀) + let K : Set ℂ := Metric.closedBall 0 C + have hKcompact : IsCompact K := isCompact_closedBall 0 C + let _ : TopologicalSpace.SeparableSpace K := hKcompact.isSeparable.separableSpace + have hK0 : (0 : ℂ) ∈ K := by simp [K, hC0] + let _ : Nonempty K := ⟨⟨0, hK0⟩⟩ + let e : ℕ → ℂ := fun k => Nat.casesOn k 0 ((↑) ∘ TopologicalSpace.denseSeq K) + let s : ℕ → SimpleFunc α ℂ := fun n => SimpleFunc.approxOn f hf K 0 hK0 n + refine ⟨s, ?_, ⟨C, ?_⟩⟩ + · intro ε hε + have hε2 : 0 < ε / 2 := by linarith + have hcover : K ⊆ ⋃ k : ℕ, Metric.ball (e k) (ε / 2) := by + intro y hy + have hycl : (⟨y, hy⟩ : K) ∈ closure (Set.range (TopologicalSpace.denseSeq K)) := by + rw [(denseRange_iff_closure_range.mp (TopologicalSpace.denseRange_denseSeq K))] + exact mem_univ _ + have hy_mem : (⟨y, hy⟩ : K) ∈ Metric.ball (⟨y, hy⟩ : K) (ε / 2) := + Metric.mem_ball_self hε2 + rcases (mem_closure_iff.1 hycl) _ Metric.isOpen_ball hy_mem with ⟨z, hz, hzr⟩ + rcases hzr with ⟨k, rfl⟩ + refine mem_iUnion.2 ⟨k + 1, ?_⟩ + have hz' := Metric.mem_ball.mp hz + rw [Subtype.dist_eq] at hz' + simpa [e, Function.comp_def, dist_comm] using hz' + rcases hKcompact.elim_finite_subcover (fun k : ℕ => Metric.ball (e k) (ε / 2)) + (fun _ => Metric.isOpen_ball) hcover with ⟨t, ht⟩ + have ht_ne : t.Nonempty := by + by_contra ht' + have ht_empty : t = ∅ := Finset.not_nonempty_iff_eq_empty.mp ht' + subst ht_empty + simpa using (ht (show (0 : ℂ) ∈ K from hK0)) + let N : ℕ := t.sup id + refine ⟨N, ?_⟩ + intro n hn x + have hfxK : f x ∈ K := by + rw [Metric.mem_closedBall] + simpa [dist_eq_norm] using hC x + rcases Set.mem_iUnion₂.1 (ht hfxK) with ⟨k, hkt, hkx⟩ + have hkn : k ≤ n := (Finset.le_sup hkt).trans hn + have hnearest : edist (SimpleFunc.nearestPt e n (f x)) (f x) ≤ edist (e k) (f x) := + SimpleFunc.edist_nearestPt_le e (f x) hkn + have hkx' : dist (e k) (f x) < ε / 2 := by + simpa [dist_comm] using Metric.mem_ball.mp hkx + have hdist : dist (s n x) (f x) < ε := by + have hnearest' : edist (s n x) (f x) ≤ edist (e k) (f x) := by + simpa [s, SimpleFunc.approxOn, e] using hnearest + have hkxed : edist (e k) (f x) < ENNReal.ofReal ε := by + rw [edist_dist] + exact (ENNReal.ofReal_lt_ofReal_iff hε).2 (by linarith [hkx']) + have hlt : edist (s n x) (f x) < ENNReal.ofReal ε := hnearest'.trans_lt hkxed + rw [edist_dist] at hlt + exact ENNReal.ofReal_lt_ofReal_iff hε |>.mp hlt + simpa only [dist_eq_norm] using hdist + · intro n x + have hx := SimpleFunc.approxOn_mem hf hK0 n x + rw [Metric.mem_closedBall] at hx + simpa [dist_eq_norm] using hx + +/-- The weak-operator-topology integral of a bounded measurable `f : α → ℂ` against `μS`, +defined as the limit of simple-function integrals under uniform approximation. -/ +noncomputable def boundedIntegral [Nonempty α] (f : α → ℂ) (hf : Measurable f) + (hbdd : ∃ C, ∀ x, ‖f x‖ ≤ C) : H →WOT[ℂ] H := by + let s : ℕ → SimpleFunc α ℂ := + Classical.choose (exists_uniform_simple_approx hf hbdd) + have hs : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖s n x - f x‖ < ε := + (Classical.choose_spec (exists_uniform_simple_approx hf hbdd)).1 + exact boundedIntegralOfUniformApprox μS f s hs + +end WOTSpectralMeasure + +end QuantumMechanics + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/BoundedIntegralAlgebra.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/BoundedIntegralAlgebra.lean new file mode 100644 index 0000000000..a6005979f8 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/BoundedIntegralAlgebra.lean @@ -0,0 +1,686 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.BoundedIntegral +public import Mathlib.MeasureTheory.Integral.Bochner.Basic + +/-! + +# Algebra of the bounded weak-operator spectral integral + +`boundedIntegral` (`BoundedIntegral.lean`) is well-defined independently of the choice of uniform +approximating sequence (`boundedIntegral_eq_of_uniform_approx`), which is what makes it possible +to prove it is a `*`-homomorphism from bounded measurable functions to `H →WOT[ℂ] H`: additive +(`boundedIntegral_add`), multiplicative (`boundedIntegral_mul`), star-compatible +(`boundedIntegral_star`), unital (`boundedIntegral_const`), and an isometry on the vector-state +norm (`boundedIntegral_norm_sq_eq_integral`, the operator-integral analogue of Plancherel). The +functional calculus this gives is exactly the bounded piece of what the spectral theorem is meant +to supply once the unbounded case is built: `f ↦ f(T)` for bounded Borel `f`, with no unbounded +operator `T` needed yet since everything here is stated directly against `μS`. + +`ext_of_boundedIntegral_eq` upgrades the scalar-measure extensionality of `ScalarMeasure.lean` to +extensionality by the integral itself: two spectral measures agreeing on every bounded Borel +integral must already agree pointwise on measurable sets (specializing to the indicator function +recovers `ext_of_scalarMeasure_eq`). + +## Main definitions + +- `boundedIntegral_add`, `boundedIntegral_mul`, `boundedIntegral_star`, `boundedIntegral_const` : + the `boundedIntegral` functional calculus is a unital `*`-homomorphism. +- `boundedIntegral_norm_sq_eq_integral` : `‖(boundedIntegral f) x‖² = ∫ |f|² dμₓ`. +- `ext_of_boundedIntegral_eq` : a spectral measure is determined by its bounded integrals. + +-/ + +@[expose] public section + +noncomputable section + +open scoped Topology InnerProductSpace Function +open ContinuousLinearMap ContinuousLinearMapWOT MeasureTheory Set + +namespace QuantumMechanics + +namespace WOTSpectralMeasure + +variable {α : Type*} [MeasurableSpace α] +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] +variable (μS : WOTSpectralMeasure α H) + +/-! ## A. Independence from the approximating sequence -/ + +lemma boundedIntegral_eq_of_uniform_approx [Nonempty α] + {f : α → ℂ} (hf : Measurable f) (hbdd : ∃ C, ∀ x, ‖f x‖ ≤ C) + {s : ℕ → SimpleFunc α ℂ} + (hs : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖s n x - f x‖ < ε) : + boundedIntegral μS f hf hbdd = boundedIntegralOfUniformApprox μS f s hs := by + let s₀ : ℕ → SimpleFunc α ℂ := + Classical.choose (exists_uniform_simple_approx hf hbdd) + have hs₀ : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖s₀ n x - f x‖ < ε := + (Classical.choose_spec (exists_uniform_simple_approx hf hbdd)).1 + unfold boundedIntegral + dsimp [s₀] + exact boundedIntegralOfUniformApprox_eq_of_same_target μS hs₀ hs + +lemma boundedIntegral_eq_of_same_target [Nonempty α] + {f : α → ℂ} {s t : ℕ → SimpleFunc α ℂ} + (hs : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖s n x - f x‖ < ε) + (ht : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖t n x - f x‖ < ε) + (hf : Measurable f) (hbdd : ∃ C, ∀ x, ‖f x‖ ≤ C) : + boundedIntegralOfUniformApprox μS f s hs = boundedIntegral μS f hf hbdd := by + symm + rw [boundedIntegral_eq_of_uniform_approx μS hf hbdd ht] + exact boundedIntegralOfUniformApprox_eq_of_same_target μS ht hs + +lemma boundedIntegral_norm_le [Nonempty α] + {f : α → ℂ} (hf : Measurable f) (hbdd : ∃ C, ∀ x, ‖f x‖ ≤ C) : + ∃ C : ℝ, ‖ContinuousLinearMapWOT.toCLM (boundedIntegral μS f hf hbdd)‖ ≤ C := by + rcases Classical.choose_spec (exists_uniform_simple_approx hf hbdd) with ⟨hs, ⟨C, hC⟩⟩ + refine ⟨C, ?_⟩ + rw [boundedIntegral_eq_of_uniform_approx μS hf hbdd hs] + exact boundedIntegralOfUniformApprox_norm_le μS _ _ hs hC + +lemma boundedIntegral_norm_sq [Nonempty α] + {f : α → ℂ} (hf : Measurable f) (hbdd : ∃ C, ∀ x, ‖f x‖ ≤ C) (x : H) : + ENNReal.ofReal (‖boundedIntegral μS f hf hbdd x‖ ^ 2) = + ∫⁻ z, ENNReal.ofReal (‖f z‖ ^ 2) ∂μS.diagonalMeasure x := by + let s : ℕ → SimpleFunc α ℂ := + Classical.choose (exists_uniform_simple_approx hf hbdd) + have hs : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ z, ‖s n z - f z‖ < ε := + (Classical.choose_spec (exists_uniform_simple_approx hf hbdd)).1 + have hsBound : ∃ C : ℝ, ∀ n z, ‖s n z‖ ≤ C := + (Classical.choose_spec (exists_uniform_simple_approx hf hbdd)).2 + have hclm : Filter.Tendsto + (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s n))) Filter.atTop + (𝓝 (ContinuousLinearMapWOT.toCLM (boundedIntegral μS f hf hbdd))) := by + rw [boundedIntegral_eq_of_uniform_approx μS hf hbdd hs] + rw [boundedIntegralOfUniformApprox_eq_limUnder] + exact (simpleIntegral_toCLM_cauchySeq μS hs).tendsto_limUnder + have hvec : Filter.Tendsto (fun n => simpleIntegral μS (s n) x) Filter.atTop + (𝓝 (boundedIntegral μS f hf hbdd x)) := by + have hev : Continuous (fun A : H →L[ℂ] H => A x) := by fun_prop + exact hev.continuousAt.tendsto.comp hclm + have hnorm : Filter.Tendsto + (fun n => ENNReal.ofReal (‖simpleIntegral μS (s n) x‖ ^ 2)) Filter.atTop + (𝓝 (ENNReal.ofReal (‖boundedIntegral μS f hf hbdd x‖ ^ 2))) := by + exact ENNReal.continuous_ofReal.continuousAt.tendsto.comp + ((continuous_norm.pow 2).continuousAt.tendsto.comp hvec) + let μ : Measure α := μS.diagonalMeasure x + let F : ℕ → α → ENNReal := fun n z => ENNReal.ofReal (‖s n z‖ ^ 2) + let F₀ : α → ENNReal := fun z => ENNReal.ofReal (‖f z‖ ^ 2) + have hFmeas : ∀ n, Measurable (F n) := by + intro n + dsimp [F] + fun_prop + have hC0 : ∃ C : ℝ, 0 ≤ C ∧ ∀ n z, ‖s n z‖ ≤ C := by + rcases hsBound with ⟨C, hC⟩ + have hC0 : 0 ≤ C := by + let a₀ : α := Classical.choice (inferInstance : Nonempty α) + exact (norm_nonneg (s 0 a₀)).trans (hC 0 a₀) + exact ⟨C, hC0, hC⟩ + rcases hC0 with ⟨C, hC0, hC⟩ + have hbound : ∀ n, F n ≤ᵐ[μ] (fun _ : α => ENNReal.ofReal (C ^ 2)) := by + intro n + filter_upwards [] with z + dsimp [F] + apply ENNReal.ofReal_le_ofReal + exact (sq_le_sq₀ (norm_nonneg (s n z)) hC0).mpr (hC n z) + have hfin : (∫⁻ z, ENNReal.ofReal (C ^ 2) ∂μ) ≠ (⊤ : ENNReal) := by + rw [lintegral_const, μS.diagonalMeasure_univ] + apply ENNReal.mul_ne_top ENNReal.ofReal_ne_top + exact ENNReal.ofReal_ne_top + have hlim : ∀ᵐ z ∂μ, Filter.Tendsto (fun n => F n z) Filter.atTop (𝓝 (F₀ z)) := by + filter_upwards [] with z + have hz : Filter.Tendsto (fun n => s n z) Filter.atTop (𝓝 (f z)) := by + rw [Metric.tendsto_atTop] + intro ε hε + rcases hs ε hε with ⟨N, hN⟩ + exact ⟨N, fun n hn => by simpa only [dist_eq_norm] using hN n hn z⟩ + have hnorm' : Filter.Tendsto (fun n => ‖s n z‖) Filter.atTop (𝓝 ‖f z‖) := + continuous_norm.continuousAt.tendsto.comp hz + exact ENNReal.continuous_ofReal.continuousAt.tendsto.comp + ((continuous_id.pow 2).continuousAt.tendsto.comp hnorm') + have hlintegral : Filter.Tendsto (fun n => ∫⁻ z, F n z ∂μ) Filter.atTop + (𝓝 (∫⁻ z, F₀ z ∂μ)) := + MeasureTheory.tendsto_lintegral_of_dominated_convergence + (fun _ : α => ENNReal.ofReal (C ^ 2)) hFmeas hbound hfin hlim + have hlintegral' : Filter.Tendsto + (fun n => ENNReal.ofReal (‖simpleIntegral μS (s n) x‖ ^ 2)) Filter.atTop + (𝓝 (∫⁻ z, ENNReal.ofReal (‖f z‖ ^ 2) ∂μS.diagonalMeasure x)) := by + simpa only [F, F₀, μ, μS.simpleIntegral_norm_sq_eq_lintegral] using hlintegral + exact tendsto_nhds_unique hnorm hlintegral' + +lemma boundedIntegral_norm_le_of_bound [Nonempty α] + {f : α → ℂ} (hf : Measurable f) {C : ℝ} (hC : 0 ≤ C) + (hCf : ∀ x, ‖f x‖ ≤ C) : + ‖ContinuousLinearMapWOT.toCLM + (boundedIntegral μS f hf (⟨C, hCf⟩ : ∃ C : ℝ, ∀ x, ‖f x‖ ≤ C))‖ ≤ C := by + apply ContinuousLinearMap.opNorm_le_iff hC |>.2 + intro x + have hsq : ∀ z, ‖f z‖ ^ 2 ≤ C ^ 2 := by + intro z + exact (sq_le_sq₀ (norm_nonneg (f z)) hC).mpr (hCf z) + have hpoint : ∀ z, ENNReal.ofReal (‖f z‖ ^ 2) ≤ ENNReal.ofReal (C ^ 2) := by + intro z + exact ENNReal.ofReal_le_ofReal (hsq z) + have hlin : (∫⁻ z, ENNReal.ofReal (‖f z‖ ^ 2) + ∂μS.diagonalMeasure x) ≤ ENNReal.ofReal (C ^ 2 * ‖x‖ ^ 2) := by + calc + (∫⁻ z, ENNReal.ofReal (‖f z‖ ^ 2) ∂μS.diagonalMeasure x) ≤ + ∫⁻ _ : α, ENNReal.ofReal (C ^ 2) ∂μS.diagonalMeasure x := + lintegral_mono_ae (Filter.Eventually.of_forall hpoint) + _ = ENNReal.ofReal (C ^ 2 * ‖x‖ ^ 2) := by + rw [lintegral_const, μS.diagonalMeasure_univ, + ← ENNReal.ofReal_mul (sq_nonneg C)] + have hnormsq : ENNReal.ofReal + (‖boundedIntegral μS f hf (⟨C, hCf⟩ : ∃ C : ℝ, ∀ x, ‖f x‖ ≤ C) x‖ ^ 2) ≤ + ENNReal.ofReal (C ^ 2 * ‖x‖ ^ 2) := by + rw [boundedIntegral_norm_sq] + exact hlin + have hreal : ‖boundedIntegral μS f hf + (⟨C, hCf⟩ : ∃ C : ℝ, ∀ x, ‖f x‖ ≤ C) x‖ ^ 2 ≤ + C ^ 2 * ‖x‖ ^ 2 := + (ENNReal.ofReal_le_ofReal_iff (mul_nonneg (sq_nonneg C) (sq_nonneg ‖x‖))).mp hnormsq + apply (sq_le_sq₀ (norm_nonneg _) (mul_nonneg hC (norm_nonneg _))).mp + calc + ‖boundedIntegral μS f hf + (⟨C, hCf⟩ : ∃ C : ℝ, ∀ x, ‖f x‖ ≤ C) x‖ ^ 2 ≤ + C ^ 2 * ‖x‖ ^ 2 := hreal + _ = (C * ‖x‖) ^ 2 := by ring + +lemma boundedIntegral_norm_sq_eq_integral [Nonempty α] + {f : α → ℂ} (hf : Measurable f) (hbdd : ∃ C : ℝ, ∀ x, ‖f x‖ ≤ C) (x : H) : + ‖boundedIntegral μS f hf hbdd x‖ ^ 2 = + ∫ z, ‖f z‖ ^ 2 ∂μS.diagonalMeasure x := by + rcases hbdd with ⟨C, hCf⟩ + let a₀ : α := Classical.choice (inferInstance : Nonempty α) + have hC : 0 ≤ C := (norm_nonneg (f a₀)).trans (hCf a₀) + have hfi : Integrable (fun z : α => ‖f z‖ ^ 2) (μS.diagonalMeasure x) := by + apply Integrable.of_bound (hf.norm.pow_const 2).aestronglyMeasurable (C ^ 2) + filter_upwards [] with z + simpa [Real.norm_eq_abs, abs_of_nonneg (sq_nonneg (‖f z‖))] using + (sq_le_sq₀ (norm_nonneg (f z)) hC).mpr (hCf z) + have hpos : 0 ≤ᵐ[μS.diagonalMeasure x] (fun z : α => ‖f z‖ ^ 2) := + Filter.Eventually.of_forall (fun z => sq_nonneg _) + have hconvert : ENNReal.ofReal (∫ z, ‖f z‖ ^ 2 ∂μS.diagonalMeasure x) = + ∫⁻ z, ENNReal.ofReal (‖f z‖ ^ 2) ∂μS.diagonalMeasure x := + ofReal_integral_eq_lintegral_ofReal hfi hpos + have hmain := boundedIntegral_norm_sq μS hf (⟨C, hCf⟩ : ∃ C : ℝ, ∀ x, ‖f x‖ ≤ C) x + rw [← hconvert] at hmain + exact (ENNReal.ofReal_eq_ofReal_iff (sq_nonneg _) + (integral_nonneg (fun z => sq_nonneg (‖f z‖)))).mp hmain + +/-! ## B. The algebra of the integral -/ + +private lemma boundedIntegralOfUniformApprox_add [Nonempty α] + {f g : α → ℂ} {s t : ℕ → SimpleFunc α ℂ} + (hs : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖s n x - f x‖ < ε) + (ht : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖t n x - g x‖ < ε) + (hsg : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, + ‖(s n + t n) x - (f + g) x‖ < ε) : + boundedIntegralOfUniformApprox μS (f + g) (fun n => s n + t n) hsg = + boundedIntegralOfUniformApprox μS f s hs + + boundedIntegralOfUniformApprox μS g t ht := by + apply ContinuousLinearMapWOT.toCLM_injective + have hfs : Filter.Tendsto + (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s n))) Filter.atTop + (𝓝 (ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS f s hs))) := by + rw [boundedIntegralOfUniformApprox_eq_limUnder] + exact (simpleIntegral_toCLM_cauchySeq μS hs).tendsto_limUnder + have hgt : Filter.Tendsto + (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (t n))) Filter.atTop + (𝓝 (ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS g t ht))) := by + rw [boundedIntegralOfUniformApprox_eq_limUnder] + exact (simpleIntegral_toCLM_cauchySeq μS ht).tendsto_limUnder + have hsum : Filter.Tendsto + (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s n)) + + ContinuousLinearMapWOT.toCLM (simpleIntegral μS (t n))) Filter.atTop + (𝓝 (ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS f s hs) + + ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS g t ht))) := hfs.add hgt + have hsum' : Filter.Tendsto + (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS ((s + t) n))) Filter.atTop + (𝓝 (ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS (f + g) (fun n => s n + t n) hsg))) := by + rw [boundedIntegralOfUniformApprox_eq_limUnder] + exact (simpleIntegral_toCLM_cauchySeq μS hsg).tendsto_limUnder + have hsum'' : Filter.Tendsto + (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s n)) + + ContinuousLinearMapWOT.toCLM (simpleIntegral μS (t n))) Filter.atTop + (𝓝 (ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS (f + g) (fun n => s n + t n) hsg))) := by + simpa only [Pi.add_apply, simpleIntegral_add, ContinuousLinearMapWOT.toCLM_add] using hsum' + exact tendsto_nhds_unique hsum'' hsum + +private lemma boundedIntegralOfUniformApprox_neg [Nonempty α] + {f : α → ℂ} {s : ℕ → SimpleFunc α ℂ} + (hs : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖s n x - f x‖ < ε) + (hneg : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, + ‖(-s n) x - (-f x)‖ < ε) : + boundedIntegralOfUniformApprox μS (fun x => -f x) (fun n => -s n) hneg = + -boundedIntegralOfUniformApprox μS f s hs := by + apply ContinuousLinearMapWOT.toCLM_injective + have hfs : Filter.Tendsto + (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s n))) Filter.atTop + (𝓝 (ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS f s hs))) := by + rw [boundedIntegralOfUniformApprox_eq_limUnder] + exact (simpleIntegral_toCLM_cauchySeq μS hs).tendsto_limUnder + have hneg' : Filter.Tendsto + (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS ((-s) n))) Filter.atTop + (𝓝 (ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS (fun x => -f x) (fun n => -s n) hneg))) := by + rw [boundedIntegralOfUniformApprox_eq_limUnder] + exact (simpleIntegral_toCLM_cauchySeq μS hneg).tendsto_limUnder + have hneg'' : Filter.Tendsto + (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS ((-s) n))) Filter.atTop + (𝓝 (-ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS f s hs))) := by + simpa only [Pi.neg_apply, simpleIntegral_neg, ContinuousLinearMapWOT.toCLM_neg] using hfs.neg + exact tendsto_nhds_unique hneg' hneg'' + +lemma boundedIntegral_neg [Nonempty α] + {f : α → ℂ} (hf : Measurable f) (hbf : ∃ C, ∀ x, ‖f x‖ ≤ C) : + boundedIntegral μS (fun x => -f x) (continuous_neg.measurable.comp hf) + (by + rcases hbf with ⟨C, hC⟩ + exact ⟨C, fun x => by simpa using hC x⟩) = + -boundedIntegral μS f hf hbf := by + classical + rcases exists_uniform_simple_approx hf hbf with ⟨s, hs, hsB⟩ + have hneg : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, + ‖(-s n) x - (-(f x))‖ < ε := by + intro ε hε + rcases hs ε hε with ⟨N, hN⟩ + refine ⟨N, fun n hn x => ?_⟩ + change ‖-s n x - -f x‖ < ε + calc + ‖-s n x - -f x‖ = ‖-(s n x - f x)‖ := by congr 1; ring + _ = ‖s n x - f x‖ := norm_neg _ + _ < ε := hN n hn x + calc + boundedIntegral μS (fun x => -f x) (continuous_neg.measurable.comp hf) _ = + boundedIntegralOfUniformApprox μS (fun x => -f x) (fun n => -s n) hneg := + boundedIntegral_eq_of_uniform_approx μS (continuous_neg.measurable.comp hf) _ hneg + _ = -boundedIntegralOfUniformApprox μS f s hs := + boundedIntegralOfUniformApprox_neg μS hs hneg + _ = -boundedIntegral μS f hf hbf := by + rw [boundedIntegral_eq_of_uniform_approx μS hf hbf hs] + +lemma boundedIntegral_add [Nonempty α] + {f g : α → ℂ} (hf : Measurable f) (hg : Measurable g) + (hbf : ∃ C, ∀ x, ‖f x‖ ≤ C) (hbg : ∃ C, ∀ x, ‖g x‖ ≤ C) : + boundedIntegral μS (f + g) (hf.add hg) + (by + rcases hbf with ⟨Cf, hCf⟩ + rcases hbg with ⟨Cg, hCg⟩ + refine ⟨Cf + Cg, fun x => ?_⟩ + exact (norm_add_le _ _).trans (add_le_add (hCf x) (hCg x))) = + boundedIntegral μS f hf hbf + boundedIntegral μS g hg hbg := by + classical + rcases exists_uniform_simple_approx hf hbf with ⟨s, hs, hsB⟩ + rcases exists_uniform_simple_approx hg hbg with ⟨t, ht, htB⟩ + have hsg : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, + ‖(s n + t n) x - (f + g) x‖ < ε := by + intro ε hε + rcases hs (ε / 2) (by linarith) with ⟨Ns, hNs⟩ + rcases ht (ε / 2) (by linarith) with ⟨Nt, hNt⟩ + refine ⟨max Ns Nt, fun n hn x => ?_⟩ + simp only [Pi.add_apply, SimpleFunc.add_apply] + calc + ‖(s n x + t n x) - (f x + g x)‖ = + ‖(s n x - f x) + (t n x - g x)‖ := by ring_nf + _ ≤ ‖s n x - f x‖ + ‖t n x - g x‖ := norm_add_le _ _ + _ < ε / 2 + ε / 2 := add_lt_add + (hNs n (le_trans (le_max_left _ _) hn) x) + (hNt n (le_trans (le_max_right _ _) hn) x) + _ = ε := by ring + rw [boundedIntegral_eq_of_uniform_approx μS (hf.add hg) _ hsg, + boundedIntegral_eq_of_uniform_approx μS hf hbf hs, + boundedIntegral_eq_of_uniform_approx μS hg hbg ht] + exact boundedIntegralOfUniformApprox_add μS hs ht hsg + +lemma boundedIntegral_const [Nonempty α] (c : ℂ) : + boundedIntegral μS (fun _ : α => c) measurable_const + (⟨‖c‖, fun _ => le_rfl⟩) = c • (1 : H →WOT[ℂ] H) := by + let s : ℕ → SimpleFunc α ℂ := fun _ => SimpleFunc.const α c + have hs : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖s n x - (fun _ : α => c) x‖ < ε := by + intro ε hε + exact ⟨0, fun n hn x => by simp [s, hε]⟩ + rw [boundedIntegral_eq_of_uniform_approx μS measurable_const + (⟨‖c‖, fun _ => le_rfl⟩) hs] + apply ContinuousLinearMapWOT.toCLM_injective + have hconst := boundedIntegralOfUniformApprox_eq_limUnder μS + (fun _ : α => c) s hs + rw [hconst] + rw [show (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s n))) = + (fun _ => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s 0))) by + funext n; rfl] + have hlim : Filter.Tendsto + (fun _ : ℕ => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s 0))) Filter.atTop + (𝓝 (ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s 0)))) := tendsto_const_nhds + rw [hlim.limUnder_eq] + change ContinuousLinearMapWOT.toCLM (simpleIntegral μS (SimpleFunc.const α c)) = + ContinuousLinearMapWOT.toCLM (c • (1 : H →WOT[ℂ] H)) + rw [simpleIntegral_const] + +lemma boundedIntegral_congr [Nonempty α] + {f g : α → ℂ} (hf : Measurable f) (hg : Measurable g) + (hbf : ∃ C, ∀ x, ‖f x‖ ≤ C) (hbg : ∃ C, ∀ x, ‖g x‖ ≤ C) + (hfg : ∀ x, f x = g x) : + boundedIntegral μS f hf hbf = boundedIntegral μS g hg hbg := by + rcases exists_uniform_simple_approx hf hbf with ⟨s, hs, hsB⟩ + have hs' : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖s n x - g x‖ < ε := by + intro ε hε + rcases hs ε hε with ⟨N, hN⟩ + refine ⟨N, fun n hn x => ?_⟩ + rw [← hfg x] + exact hN n hn x + exact (boundedIntegral_eq_of_uniform_approx μS hf hbf hs).trans + (boundedIntegral_eq_of_uniform_approx μS hg hbg hs').symm + +lemma boundedIntegral_indicator [Nonempty α] {S : Set α} (hS : MeasurableSet S) : + boundedIntegral μS (S.indicator (fun _ : α => (1 : ℂ))) + (measurable_const.indicator hS) + (⟨1, fun x => by by_cases hx : x ∈ S <;> simp [hx]⟩) = μS S := by + let s : ℕ → SimpleFunc α ℂ := fun _ => + SimpleFunc.piecewise S hS (SimpleFunc.const α (1 : ℂ)) + (SimpleFunc.const α (0 : ℂ)) + have hs : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, + ‖s n x - S.indicator (fun _ : α => (1 : ℂ)) x‖ < ε := by + intro ε hε + refine ⟨0, fun n hn x => ?_⟩ + rw [show s n = SimpleFunc.piecewise S hS + (SimpleFunc.const α (1 : ℂ)) (SimpleFunc.const α (0 : ℂ)) by rfl] + rw [SimpleFunc.coe_piecewise hS] + simp only [SimpleFunc.coe_const, Function.const_zero, Set.piecewise_eq_indicator] + change ‖S.indicator (fun _ : α => (1 : ℂ)) x - + S.indicator (fun _ : α => (1 : ℂ)) x‖ < ε + simp only [sub_self, norm_zero] + exact hε + rw [boundedIntegral_eq_of_uniform_approx μS (measurable_const.indicator hS) + (⟨1, fun x => by by_cases hx : x ∈ S <;> simp [hx]⟩) hs] + apply ContinuousLinearMapWOT.toCLM_injective + rw [boundedIntegralOfUniformApprox_eq_limUnder μS _ s hs] + rw [show (fun n : ℕ => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s n))) = + (fun _ : ℕ => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s 0))) by + funext n; rfl] + rw [tendsto_const_nhds.limUnder_eq] + change ContinuousLinearMapWOT.toCLM (simpleIntegral μS + (SimpleFunc.piecewise S hS (SimpleFunc.const α (1 : ℂ)) + (SimpleFunc.const α (0 : ℂ)))) = ContinuousLinearMapWOT.toCLM (μS S) + rw [simpleIntegral_piecewise_indicator] + +/-! ## C. Extensionality by the integral -/ + +/-- A bounded spectral integral determines a weak spectral measure. In particular, this gives a +usable uniqueness principle for any construction which agrees with the canonical integral on +bounded Borel multipliers. -/ +theorem ext_of_boundedIntegral_eq [Nonempty α] + {μS νS : WOTSpectralMeasure α H} + (h : ∀ (f : α → ℂ) (hf : Measurable f) (hfb : ∃ C : ℝ, ∀ a, ‖f a‖ ≤ C), + μS.boundedIntegral f hf hfb = νS.boundedIntegral f hf hfb) : + μS = νS := by + apply ext_of_scalarMeasure_eq + intro x y + apply MeasureTheory.VectorMeasure.ext + intro S hS + have h₁ := h (S.indicator (fun _ : α => (1 : ℂ))) + (measurable_const.indicator hS) (by + refine ⟨1, fun a => ?_⟩ + by_cases ha : a ∈ S <;> simp [Set.indicator, ha]) + have h₂ := congrArg (fun A : H →WOT[ℂ] H => ⟪y, A x⟫_ℂ) h₁ + simpa [boundedIntegral_indicator μS hS, boundedIntegral_indicator νS hS, + scalarMeasure_apply] using h₂ + +lemma boundedIntegral_sub [Nonempty α] + {f g : α → ℂ} (hf : Measurable f) (hg : Measurable g) + (hbf : ∃ C, ∀ x, ‖f x‖ ≤ C) (hbg : ∃ C, ∀ x, ‖g x‖ ≤ C) : + boundedIntegral μS (f - g) (hf.sub hg) + (by + rcases hbf with ⟨Cf, hCf⟩ + rcases hbg with ⟨Cg, hCg⟩ + refine ⟨Cf + Cg, fun x => ?_⟩ + exact (norm_sub_le _ _).trans (add_le_add (hCf x) (hCg x))) = + boundedIntegral μS f hf hbf - boundedIntegral μS g hg hbg := by + have hsubBound : ∃ C, ∀ x, ‖(f - g) x‖ ≤ C := by + rcases hbf with ⟨Cf, hCf⟩ + rcases hbg with ⟨Cg, hCg⟩ + refine ⟨Cf + Cg, fun x => ?_⟩ + exact (norm_sub_le _ _).trans (add_le_add (hCf x) (hCg x)) + have hg' : Measurable (fun x => -g x) := continuous_neg.measurable.comp hg + have hbg' : ∃ C, ∀ x, ‖-g x‖ ≤ C := by + rcases hbg with ⟨C, hC⟩ + exact ⟨C, fun x => by simpa using hC x⟩ + have hneg := boundedIntegral_neg μS hg hbg + have hadd := boundedIntegral_add μS hf hg' hbf hbg' + have haddBound : ∃ C, ∀ x, ‖(f + (fun x => -g x)) x‖ ≤ C := by + rcases hbf with ⟨Cf, hCf⟩ + rcases hbg' with ⟨Cg, hCg⟩ + refine ⟨Cf + Cg, fun x => ?_⟩ + exact (norm_add_le _ _).trans (add_le_add (hCf x) (hCg x)) + calc + boundedIntegral μS (f - g) (hf.sub hg) hsubBound = + boundedIntegral μS f hf hbf + + boundedIntegral μS (fun x => -g x) hg' hbg' := by + calc + boundedIntegral μS (f - g) (hf.sub hg) hsubBound = + boundedIntegral μS (f + (fun x => -g x)) + (hf.add hg') haddBound := by + apply boundedIntegral_congr μS (hf.sub hg) (hf.add hg') hsubBound haddBound + intro x + simp [Pi.sub_apply, sub_eq_add_neg] + _ = boundedIntegral μS f hf hbf + + boundedIntegral μS (fun x => -g x) + hg' hbg' := by exact hadd + _ = boundedIntegral μS f hf hbf - boundedIntegral μS g hg hbg := by rw [hneg, sub_eq_add_neg] + +private lemma boundedIntegralOfUniformApprox_mul [Nonempty α] + {f g : α → ℂ} {s t : ℕ → SimpleFunc α ℂ} + (hs : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖s n x - f x‖ < ε) + (ht : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖t n x - g x‖ < ε) + (hprod : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, + ‖(s n * t n) x - (f * g) x‖ < ε) : + boundedIntegralOfUniformApprox μS (f * g) (fun n => s n * t n) hprod = + boundedIntegralOfUniformApprox μS f s hs * + boundedIntegralOfUniformApprox μS g t ht := by + apply ContinuousLinearMapWOT.toCLM_injective + have hfs : Filter.Tendsto + (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s n))) Filter.atTop + (𝓝 (ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS f s hs))) := by + rw [boundedIntegralOfUniformApprox_eq_limUnder] + exact (simpleIntegral_toCLM_cauchySeq μS hs).tendsto_limUnder + have hgt : Filter.Tendsto + (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (t n))) Filter.atTop + (𝓝 (ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS g t ht))) := by + rw [boundedIntegralOfUniformApprox_eq_limUnder] + exact (simpleIntegral_toCLM_cauchySeq μS ht).tendsto_limUnder + have hmul : Filter.Tendsto + (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s n)) * + ContinuousLinearMapWOT.toCLM (simpleIntegral μS (t n))) Filter.atTop + (𝓝 (ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS f s hs) * + ContinuousLinearMapWOT.toCLM (boundedIntegralOfUniformApprox μS g t ht))) := + hfs.mul hgt + have hprod' : Filter.Tendsto + (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS ((s * t) n))) Filter.atTop + (𝓝 (ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS (f * g) (fun n => s n * t n) hprod))) := by + rw [boundedIntegralOfUniformApprox_eq_limUnder] + exact (simpleIntegral_toCLM_cauchySeq μS hprod).tendsto_limUnder + have hprod'' : Filter.Tendsto + (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s n)) * + ContinuousLinearMapWOT.toCLM (simpleIntegral μS (t n))) Filter.atTop + (𝓝 (ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS (f * g) (fun n => s n * t n) hprod))) := by + apply hprod'.congr' + filter_upwards [] with n + change ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s n * t n)) = + ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s n)) * + ContinuousLinearMapWOT.toCLM (simpleIntegral μS (t n)) + rw [simpleIntegral_mul, ContinuousLinearMapWOT.toCLM_mul] + exact tendsto_nhds_unique hprod'' hmul + +lemma boundedIntegral_mul [Nonempty α] + {f g : α → ℂ} (hf : Measurable f) (hg : Measurable g) + (hbf : ∃ C, ∀ x, ‖f x‖ ≤ C) (hbg : ∃ C, ∀ x, ‖g x‖ ≤ C) : + boundedIntegral μS (f * g) (hf.mul hg) + (by + rcases hbf with ⟨Cf, hCf⟩ + rcases hbg with ⟨Cg, hCg⟩ + let a₀ : α := Classical.choice (inferInstance : Nonempty α) + have hCf0 : 0 ≤ Cf := (norm_nonneg (f a₀)).trans (hCf a₀) + refine ⟨Cf * Cg, fun x => ?_⟩ + rw [Pi.mul_apply, norm_mul] + exact mul_le_mul (hCf x) (hCg x) (norm_nonneg _) hCf0) = + boundedIntegral μS f hf hbf * boundedIntegral μS g hg hbg := by + classical + rcases hbf with ⟨Cf, hCf⟩ + rcases hbg with ⟨Cg, hCg⟩ + let hbf' : ∃ C : ℝ, ∀ x, ‖f x‖ ≤ C := ⟨Cf, hCf⟩ + let hbg' : ∃ C : ℝ, ∀ x, ‖g x‖ ≤ C := ⟨Cg, hCg⟩ + rcases exists_uniform_simple_approx hf hbf' with ⟨sf, hsf, hsfB⟩ + rcases exists_uniform_simple_approx hg hbg' with ⟨sg, hsg, hsgB⟩ + rcases hsfB with ⟨Cs, hCs⟩ + let a₀ : α := Classical.choice (inferInstance : Nonempty α) + have hCs0 : 0 ≤ Cs := (norm_nonneg (sf 0 a₀)).trans (hCs 0 a₀) + have hCg0 : 0 ≤ Cg := (norm_nonneg (g a₀)).trans (hCg a₀) + have hD0 : 0 < Cs + Cg + 1 := by linarith + have hprod : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, + ‖(sf n * sg n) x - (f * g) x‖ < ε := by + intro ε hε + let δ : ℝ := ε / (2 * (Cs + Cg + 1)) + have hδ : 0 < δ := by dsimp [δ]; positivity + rcases hsf δ hδ with ⟨Nf, hNf⟩ + rcases hsg δ hδ with ⟨Ng, hNg⟩ + refine ⟨max Nf Ng, fun n hn x => ?_⟩ + simp only [SimpleFunc.mul_apply, Pi.mul_apply] + have hsferr : ‖sf n x - f x‖ < δ := hNf n (le_trans (le_max_left _ _) hn) x + have hsgerr : ‖sg n x - g x‖ < δ := hNg n (le_trans (le_max_right _ _) hn) x + have hdecomp : sf n x * sg n x - f x * g x = + sf n x * (sg n x - g x) + (sf n x - f x) * g x := by ring + calc + ‖sf n x * sg n x - f x * g x‖ = + ‖sf n x * (sg n x - g x) + (sf n x - f x) * g x‖ := by rw [hdecomp] + _ ≤ ‖sf n x‖ * ‖sg n x - g x‖ + + ‖sf n x - f x‖ * ‖g x‖ := by + calc + _ ≤ ‖sf n x * (sg n x - g x)‖ + + ‖(sf n x - f x) * g x‖ := norm_add_le _ _ + _ = _ := by rw [norm_mul, norm_mul] + _ ≤ Cs * δ + δ * Cg := by + exact add_le_add + (mul_le_mul (hCs n x) (le_of_lt hsgerr) (norm_nonneg _) hCs0) + (mul_le_mul (le_of_lt hsferr) (hCg x) (norm_nonneg _) hδ.le) + _ < ε := by + calc + Cs * δ + δ * Cg = (Cs + Cg) * δ := by ring + _ ≤ (Cs + Cg + 1) * δ := by + exact mul_le_mul_of_nonneg_right (by linarith) hδ.le + _ = ε / 2 := by dsimp [δ]; field_simp + _ < ε := by linarith + rw [boundedIntegral_eq_of_uniform_approx μS (hf.mul hg) _ hprod, + boundedIntegral_eq_of_uniform_approx μS hf hbf' hsf, + boundedIntegral_eq_of_uniform_approx μS hg hbg' hsg] + exact boundedIntegralOfUniformApprox_mul μS hsf hsg hprod + +lemma boundedIntegral_smul [Nonempty α] (c : ℂ) {f : α → ℂ} (hf : Measurable f) + (hbf : ∃ C, ∀ x, ‖f x‖ ≤ C) : + boundedIntegral μS (fun x => c * f x) + (measurable_const.mul hf) + (by + rcases hbf with ⟨C, hC⟩ + refine ⟨‖c‖ * C, fun x => ?_⟩ + rw [norm_mul] + exact mul_le_mul_of_nonneg_left (hC x) (norm_nonneg c)) = + c • boundedIntegral μS f hf hbf := by + have hmul := boundedIntegral_mul μS measurable_const hf + (⟨‖c‖, fun _ => le_rfl⟩) hbf + rw [boundedIntegral_const] at hmul + change boundedIntegral μS ((fun _ : α => c) * f) _ _ = _ + have hone : (c • (1 : H →WOT[ℂ] H)) * boundedIntegral μS f hf hbf = + c • boundedIntegral μS f hf hbf := by + ext x + simp [ContinuousLinearMapWOT.mul_apply] + rw [← hone] + exact hmul + +private lemma boundedIntegralOfUniformApprox_star [Nonempty α] + {f : α → ℂ} {s : ℕ → SimpleFunc α ℂ} + (hs : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖s n x - f x‖ < ε) + (hstar : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, + ‖(star (s n)) x - star (f x)‖ < ε) : + boundedIntegralOfUniformApprox μS (fun x => star (f x)) (fun n => star (s n)) hstar = + star (boundedIntegralOfUniformApprox μS f s hs) := by + apply ContinuousLinearMapWOT.toCLM_injective + have hfs : Filter.Tendsto + (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s n))) Filter.atTop + (𝓝 (ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS f s hs))) := by + rw [boundedIntegralOfUniformApprox_eq_limUnder] + exact (simpleIntegral_toCLM_cauchySeq μS hs).tendsto_limUnder + have hstarlim : Filter.Tendsto + (fun n => star (ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s n)))) Filter.atTop + (𝓝 (star (ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS f s hs)))) := + continuous_star.continuousAt.tendsto.comp hfs + have hstar' : Filter.Tendsto + (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (star (s n)))) Filter.atTop + (𝓝 (ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS (fun x => star (f x)) (fun n => star (s n)) + hstar))) := by + rw [boundedIntegralOfUniformApprox_eq_limUnder] + exact (simpleIntegral_toCLM_cauchySeq μS hstar).tendsto_limUnder + have hstar'' : Filter.Tendsto + (fun n => star (ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s n)))) Filter.atTop + (𝓝 (ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS (fun x => star (f x)) (fun n => star (s n)) + hstar))) := by + convert hstar' using 1 + · funext n + rw [simpleIntegral_star] + apply ContinuousLinearMap.ext + intro x + rfl + exact tendsto_nhds_unique hstar'' hstarlim + +lemma boundedIntegral_star [Nonempty α] + {f : α → ℂ} (hf : Measurable f) (hbf : ∃ C, ∀ x, ‖f x‖ ≤ C) : + boundedIntegral μS (fun x => star (f x)) (continuous_star.measurable.comp hf) + (by + rcases hbf with ⟨C, hC⟩ + exact ⟨C, fun x => by simpa using hC x⟩) = + star (boundedIntegral μS f hf hbf) := by + classical + rcases exists_uniform_simple_approx hf hbf with ⟨s, hs, hsB⟩ + have hstar : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, + ‖(star (s n)) x - star (f x)‖ < ε := by + intro ε hε + rcases hs ε hε with ⟨N, hN⟩ + refine ⟨N, fun n hn x => ?_⟩ + change ‖star ((s n) x) - star (f x)‖ < ε + rw [← star_sub, norm_star] + exact hN n hn x + calc + boundedIntegral μS (fun x => star (f x)) (continuous_star.measurable.comp hf) _ = + boundedIntegralOfUniformApprox μS (fun x => star (f x)) (fun n => star (s n)) hstar := + boundedIntegral_eq_of_uniform_approx μS (continuous_star.measurable.comp hf) _ hstar + _ = star (boundedIntegralOfUniformApprox μS f s hs) := + boundedIntegralOfUniformApprox_star μS hs hstar + _ = star (boundedIntegral μS f hf hbf) := by + rw [boundedIntegral_eq_of_uniform_approx μS hf hbf hs] + +end WOTSpectralMeasure + +end QuantumMechanics + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/BoundedSelfAdjointData.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/BoundedSelfAdjointData.lean new file mode 100644 index 0000000000..bcca5f6d66 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/BoundedSelfAdjointData.lean @@ -0,0 +1,129 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.CayleySpectralData.SpecTheorem + +/-! +# The bounded self-adjoint spectral measure + +The bounded normal construction naturally produces a measure on the complex spectrum. For a +self-adjoint operator that spectrum is real, so pushing the measure forward along `Complex.re` +gives the real spectral measure consumed by the unbounded integral API. This file records that +adapter independently of the Cayley transform. +-/ + +@[expose] public section + +noncomputable section + +open MeasureTheory Set Topology +open scoped ComplexOrder CStarAlgebra InnerProductSpace + +namespace QuantumMechanics + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-- The real spectral measure of a bounded self-adjoint operator, obtained from the genuine +bounded-normal spectral measure by the real-part map on the complex spectrum. -/ +noncomputable def boundedSelfAdjointSpectralMeasure + (A : H →L[ℂ] H) (hA : IsSelfAdjoint A) : + QuantumMechanics.WOTSpectralMeasure ℝ H := + (cfcSpectralMeasure A hA.isStarNormal).map + (fun z : spectrum ℂ A => z.1.re) (by fun_prop) + +set_option maxHeartbeats 2000000 in +lemma boundedSelfAdjointSpectralMeasure_reconstruction + (A : H →L[ℂ] H) (hA : IsSelfAdjoint A) (x y : H) : + (boundedSelfAdjointSpectralMeasure A hA).complexWeakIntegral + (fun r : ℝ => (r : ℂ)) x y = ⟪y, A x⟫_ℂ := by + let E := cfcSpectralMeasure A hA.isStarNormal + let f : spectrum ℂ A → ℝ := fun z => z.1.re + have hf : Measurable f := by fun_prop + have hfinite : IsFiniteMeasure (E.scalarMeasure x y).variation := by + rw [cfcSpectralMeasure_scalarMeasure] + exact polarizedCfcScalarMeasure_isFiniteMeasure A hA.isStarNormal x y + let := hfinite + have hgi : (E.scalarMeasure x y).Integrable (fun z => ((f z : ℝ) : ℂ)) := by + have hcont : Continuous (fun z : spectrum ℂ A => ((f z : ℝ) : ℂ)) := by + fun_prop + have hbdd : BddAbove ((fun z : ℂ => ‖z‖) '' (spectrum ℂ A)) := + (spectrum.isCompact A).bddAbove_image continuous_norm.continuousOn + rcases hbdd with ⟨C, hC⟩ + apply MeasureTheory.Integrable.of_bound hcont.aestronglyMeasurable C + filter_upwards [] with z + calc + ‖((f z : ℝ) : ℂ)‖ = |f z| := by simp + _ = |z.1.re| := rfl + _ ≤ ‖z.1‖ := Complex.abs_re_le_norm _ + _ ≤ C := hC ⟨z.1, z.property, rfl⟩ + have hmap := QuantumMechanics.WOTSpectralMeasure.complexWeakIntegral_map + (μS := E) f hf (fun r : ℝ => (r : ℂ)) x y + Complex.continuous_ofReal.aestronglyMeasurable hgi + change (E.map f hf).complexWeakIntegral (fun r : ℝ => (r : ℂ)) x y = _ + rw [hmap] + have hreal : ((fun r : ℝ => (r : ℂ)) ∘ f) = (fun z : spectrum ℂ A => z.1) := by + funext z + exact (hA.mem_spectrum_eq_re z.property).symm + rw [hreal] + unfold QuantumMechanics.WOTSpectralMeasure.complexWeakIntegral + rw [cfcSpectralMeasure_scalarMeasure] + exact polarizedCfcScalarMeasure_integral_spectrum_coe A hA.isStarNormal x y + +/-- Every spectral projection of the real spectral measure of a bounded self-adjoint operator +commutes with any unitary intertwiner of that operator — the Schur's-lemma-facing form of +`cfcSpectralMeasure_commute_of_commute_unitary`. Since `A` is self-adjoint, `Commute A T` alone +gives `Commute (star A) T` for free (`star A = A`), so no separate adjoint-commutation hypothesis +is needed. -/ +lemma boundedSelfAdjointSpectralMeasure_commute_of_commute + (A : H →L[ℂ] H) (hA : IsSelfAdjoint A) {T : H →L[ℂ] H} (hAT : Commute A T) + (hTunit : T ∈ unitary (H →L[ℂ] H)) (E : Set ℝ) : + boundedSelfAdjointSpectralMeasure A hA E * ContinuousLinearMapWOT.ofCLM T = + ContinuousLinearMapWOT.ofCLM T * boundedSelfAdjointSpectralMeasure A hA E := by + have hAT' : Commute (star A) T := by rwa [hA.star_eq] + by_cases hE : MeasurableSet E + · show (cfcSpectralMeasure A hA.isStarNormal).map (fun z : spectrum ℂ A => z.1.re) (by fun_prop) E + * ContinuousLinearMapWOT.ofCLM T = + ContinuousLinearMapWOT.ofCLM T * + (cfcSpectralMeasure A hA.isStarNormal).map (fun z : spectrum ℂ A => z.1.re) (by fun_prop) E + rw [(cfcSpectralMeasure A hA.isStarNormal).map_apply + (fun z : spectrum ℂ A => z.1.re) (by fun_prop) hE] + exact cfcSpectralMeasure_commute_of_commute_unitary A hA.isStarNormal hAT hAT' hTunit _ + · rw [(boundedSelfAdjointSpectralMeasure A hA).apply_eq_zero_of_not_measurableSet hE] + simp + +lemma exists_boundedSelfAdjointSpectralSupport + (A : H →L[ℂ] H) (hA : IsSelfAdjoint A) : + ∃ C : ℝ, HasBoundedSpectralSupport + (boundedSelfAdjointSpectralMeasure A hA) C := by + let E := cfcSpectralMeasure A hA.isStarNormal + let f : spectrum ℂ A → ℝ := fun z => z.1.re + have hbdd : BddAbove ((fun z : ℂ => ‖z‖) '' (spectrum ℂ A)) := + (spectrum.isCompact A).bddAbove_image continuous_norm.continuousOn + rcases hbdd with ⟨B, hB⟩ + let C : ℝ := max 0 B + refine ⟨C, le_max_left _ _, ?_⟩ + intro S hS hdisj + have hpre : f ⁻¹' S = ∅ := by + ext z + constructor + · intro hz + have habs : |f z| ≤ C := by + calc + |f z| ≤ ‖z.1‖ := Complex.abs_re_le_norm _ + _ ≤ B := hB ⟨z.1, z.property, rfl⟩ + _ ≤ C := le_max_right _ _ + have hzIcc : f z ∈ Set.Icc (-C) C := + (abs_le.mp habs) + exact (Set.disjoint_left.1 hdisj hz) hzIcc + · simp + change (E.map f (by fun_prop)) S = 0 + rw [E.map_apply f (by fun_prop) hS, hpre] + simp + +end QuantumMechanics + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Cayley/Basic.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Cayley/Basic.lean new file mode 100644 index 0000000000..ab5f63392a --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Cayley/Basic.lean @@ -0,0 +1,441 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Physlib.QuantumMechanics.Operators.SpectralTheory.SelfAdjoint +public import Mathlib.MeasureTheory.Constructions.BorelSpace.Complex + +/-! + +# The Cayley transform for a self-adjoint operator + +The Cayley transform `c(x) = (x - i) / (x + i)` maps the real line onto the unit circle minus the +point `1` (which corresponds to `x = ∞`). Applied to a self-adjoint operator in place of a real +number, it turns an (unbounded, densely-defined) self-adjoint operator into a bounded unitary +operator — the standard device, due to von Neumann, for reducing unbounded self-adjoint spectral +theory to the bounded/unitary case, where tools such as the continuous functional calculus already +apply. + +This file develops the elementary scalar transform `cayley`/`cayleyInverse` first — the inverse is +only needed away from `1`, the point corresponding to infinity, and is defined arbitrarily there; +on the actual Cayley image it is a genuine inverse — and then transports it to an unbounded +self-adjoint operator `T : H →ₗ.[ℂ] H`: `cayleyPMap T` is the resulting Cayley-transformed partial +operator, which turns out to be everywhere-defined and bounded (`cayleyContinuousLinearMap`), and +in fact a genuine unitary (`cayleyUnitary`) once `T` is self-adjoint. No unbounded theorem is +hidden in a definition: everything here is elementary Hilbert-space algebra once self-adjointness +supplies the resolvent set membership at `± i`. + +- `cayley`, `cayleyInverse` : the scalar Möbius maps `(x - i) / (x + i)` and its (one-sided) + inverse, together with their real/imaginary-part formulas and round-trip identities. +- `cayleyPMap` : the Cayley transform of a partial operator, before forgetting boundedness. +- `cayleyContinuousLinearMap`, `cayleyUnitary` : the resulting bounded operator, proved to be a + genuine unitary once `T` is self-adjoint. + +-/ + +@[expose] public section + +noncomputable section + +open Function MeasureTheory Set +open scoped ComplexOrder InnerProductSpace + +namespace QuantumMechanics + +/-! ## A. The scalar Cayley transform -/ + +/-- The scalar Cayley transform from the real line to the unit circle. -/ +def cayley (x : ℝ) : ℂ := (x - Complex.I) / (x + Complex.I) + +/-- The inverse Cayley coordinate, with an arbitrary value at the point `1` (infinity). -/ +def cayleyInverse (z : ℂ) : ℝ := if z = 1 then 0 else -z.im / (1 - z.re) + +lemma cayley_ne_one (x : ℝ) : cayley x ≠ 1 := by + intro h + have hden : (x : ℂ) + Complex.I ≠ 0 := by + intro hz + have hi := congrArg Complex.im hz + norm_num at hi + have h' : (x : ℂ) - Complex.I = (x : ℂ) + Complex.I := by + have h' := (div_eq_iff hden).mp (by simpa [cayley] using h) + simpa using h' + have hi := congrArg Complex.im h' + norm_num at hi + +lemma cayley_re (x : ℝ) : (cayley x).re = (x ^ 2 - 1) / (x ^ 2 + 1) := by + rw [cayley, Complex.div_re] + simp [Complex.normSq, pow_two] + ring_nf + +lemma cayley_im (x : ℝ) : (cayley x).im = (-2 * x) / (x ^ 2 + 1) := by + rw [cayley, Complex.div_im] + simp [Complex.normSq, pow_two] + ring_nf + +lemma cayleyInverse_cayley (x : ℝ) : cayleyInverse (cayley x) = x := by + rw [cayleyInverse, if_neg (cayley_ne_one x), cayley_im, cayley_re] + have h : x ^ 2 + 1 ≠ 0 := by nlinarith [sq_nonneg x] + field_simp + ring + +lemma cayley_norm (x : ℝ) : ‖cayley x‖ = 1 := by + have hs : ‖cayley x‖ ^ 2 = 1 := by + rw [Complex.sq_norm, Complex.normSq_apply, cayley_re, cayley_im] + have h : x ^ 2 + 1 ≠ 0 := by nlinarith [sq_nonneg x] + field_simp + ring + nlinarith [norm_nonneg (cayley x)] + +lemma cayley_cayleyInverse {z : ℂ} (hz : ‖z‖ = 1) (hz1 : z ≠ 1) : + cayley (cayleyInverse z) = z := by + have hnorm : z.re ^ 2 + z.im ^ 2 = 1 := by + calc + z.re ^ 2 + z.im ^ 2 = Complex.normSq z := by + simp [Complex.normSq_apply, pow_two] + _ = ‖z‖ ^ 2 := (Complex.sq_norm z).symm + _ = 1 := by rw [hz]; norm_num + have hden : 1 - z.re ≠ 0 := by + intro hd + have hre : z.re = 1 := by linarith + have him : z.im = 0 := by nlinarith [hnorm] + apply hz1 + apply Complex.ext <;> assumption + rw [Complex.ext_iff] + simp only [cayleyInverse, if_neg hz1] + rw [cayley_re, cayley_im] + have hx : (-(z.im) / (1 - z.re)) ^ 2 + 1 ≠ 0 := by + positivity + have hrel : z.im ^ 2 + (1 - z.re) ^ 2 = 2 * (1 - z.re) := by + nlinarith [hnorm] + constructor + · field_simp [hden] + nlinarith [hrel] + · field_simp [hden] + have hm := congrArg (fun t : ℝ => z.im * t) hnorm + nlinarith [hm] + +lemma measurable_cayley : Measurable cayley := by + unfold cayley + fun_prop + +lemma measurable_cayleyInverse : Measurable cayleyInverse := by + unfold cayleyInverse + apply Measurable.ite + · exact measurableSet_eq + · fun_prop + · fun_prop + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-! ## B. The Cayley transform of a partial operator -/ + +/-- The Cayley transform before forgetting that it is bounded. -/ +def cayleyPMap (T : H →ₗ.[ℂ] H) : H →ₗ.[ℂ] H := + (T - Complex.I • 1) * (T + Complex.I • 1).inverse + +lemma cayleyPMap_domain_top {T : H →ₗ.[ℂ] H} (hT : IsSelfAdjoint T) : + (cayleyPMap T).domain = ⊤ := by + have hres := LinearPMap.IsSelfAdjoint.mem_resolventSet_of_im_ne_zero hT + (z := -Complex.I) (by norm_num) + have heq : T - (-Complex.I) • 1 = T + Complex.I • 1 := by + exact LinearPMap.ext rfl fun x hf hg => by + simp [LinearPMap.sub_apply, LinearPMap.add_apply, LinearPMap.smul_apply, + neg_smul] + have hker' : (T - (-Complex.I) • 1).toFun.ker = ⊥ := hres.1 + have hrange' : (T - (-Complex.I) • 1).toFun.range = ⊤ := hres.2.1 + have hker : (T + Complex.I • 1).toFun.ker = ⊥ := by + rw [heq] at hker' + exact hker' + have hrange : (T + Complex.I • 1).toFun.range = ⊤ := by + rw [heq] at hrange' + exact hrange' + have hplusdom : (T + Complex.I • 1).domain = T.domain := by + simp [LinearPMap.add_domain] + have hinvdom : (T + Complex.I • 1).inverse.domain = ⊤ := by + rw [LinearPMap.inverse_domain, hrange] + rw [cayleyPMap, LinearPMap.mul_def, LinearPMap.compRestricted_domain] + apply le_antisymm le_top + intro x hx + let xi : (T + Complex.I • 1).inverse.domain := + ⟨x, by rw [hinvdom]; exact Submodule.mem_top⟩ + have hv' : (T + Complex.I • 1).inverse xi ∈ + (T + Complex.I • 1).domain := by + rw [← LinearPMap.inverse_range hker] + exact LinearMap.mem_range_self _ xi + have hv : (T + Complex.I • 1).inverse xi ∈ T.domain := hplusdom ▸ hv' + have hxi' : xi ∈ + Submodule.comap (T + Complex.I • 1).inverse.toFun + (T - Complex.I • 1).domain := by + change (T + Complex.I • 1).inverse xi ∈ (T - Complex.I • 1).domain + simpa [LinearPMap.sub_domain] using hv + refine ⟨xi, hxi', ?_⟩ + rfl + +/-- Turn a continuous partial linear map with full domain into a bounded operator on `H`. -/ +def topDomainToContinuousLinearMap (A : H →ₗ.[ℂ] H) (hdom : A.domain = ⊤) + (hc : Continuous A.toFun) : H →L[ℂ] H := by + let i : H →ₗ[ℂ] A.domain := + { toFun := fun x => ⟨x, hdom ▸ Submodule.mem_top⟩ + map_add' := by intros; rfl + map_smul' := by intros; rfl } + let L : H →ₗ[ℂ] H := A.toFun.comp i + have hL : Continuous L := by + dsimp [L] + apply hc.comp + dsimp [i] + fun_prop + exact ⟨L, hL⟩ + +omit [CompleteSpace H] in +@[nolint unusedArguments] +lemma topDomainToContinuousLinearMap_apply (A : H →ₗ.[ℂ] H) (hdom : A.domain = ⊤) + (hc : Continuous A.toFun) (x : H) : + topDomainToContinuousLinearMap A hdom hc x = A ⟨x, hdom ▸ Submodule.mem_top⟩ := by + rfl + +lemma cayleyPMap_eq_one_sub {T : H →ₗ.[ℂ] H} (hT : IsSelfAdjoint T) : + cayleyPMap T = 1 - (2 * Complex.I) • (T + Complex.I • 1).inverse := by + have hres := LinearPMap.IsSelfAdjoint.mem_resolventSet_of_im_ne_zero hT + (z := -Complex.I) (by norm_num) + have heq : T - (-Complex.I) • 1 = T + Complex.I • 1 := by + exact LinearPMap.ext rfl fun x hf hg => by + simp [LinearPMap.sub_apply, LinearPMap.add_apply, LinearPMap.smul_apply, + neg_smul] + have hker : (T + Complex.I • 1).toFun.ker = ⊥ := by + rw [← heq] + exact hres.1 + have hrange : (T + Complex.I • 1).toFun.range = ⊤ := by + rw [← heq] + exact hres.2.1 + have hinvdom : (T + Complex.I • 1).inverse.domain = ⊤ := by + rw [LinearPMap.inverse_domain, hrange] + have hdom := cayleyPMap_domain_top hT + have hdom' : (1 - (2 * Complex.I) • (T + Complex.I • 1).inverse).domain = ⊤ := by + simp [LinearPMap.sub_domain, hinvdom] + apply LinearPMap.ext (hdom.trans hdom'.symm) + intro x hx hx' + let xi : (T + Complex.I • 1).inverse.domain := + ⟨x, by rw [hinvdom]; exact Submodule.mem_top⟩ + have hxi : (T + Complex.I • 1).inverse xi ∈ (T + Complex.I • 1).domain := by + rw [← LinearPMap.inverse_range hker] + exact LinearMap.mem_range_self _ xi + have hxi_range : (x : H) ∈ LinearMap.range (T + Complex.I • 1).toFun := by + rw [← LinearPMap.inverse_domain] + exact xi.property + obtain ⟨x₀, hx₀⟩ := hxi_range + have hxy : (T + Complex.I • 1) x₀ = xi := by + change (T + Complex.I • 1) x₀ = x + exact hx₀ + have hinv₀ : (T + Complex.I • 1).inverse xi = x₀ := + LinearPMap.inverse_apply_eq hker hxy + have hinv : (T + Complex.I • 1) + ⟨(T + Complex.I • 1).inverse xi, hxi⟩ = x := by + have heq : (⟨(T + Complex.I • 1).inverse xi, hxi⟩ : + (T + Complex.I • 1).domain) = x₀ := Subtype.ext hinv₀ + rw [heq] + exact hx₀ + let y : (T + Complex.I • 1).domain := + ⟨(T + Complex.I • 1).inverse xi, hxi⟩ + have hy : (T + Complex.I • 1) y = x := hinv + change (T - Complex.I • 1) y = x - (2 * Complex.I) • (y : H) + rw [← hy] + simp [LinearPMap.sub_apply, LinearPMap.add_apply, LinearPMap.smul_apply] + module + +lemma cayleyPMap_eq_one_sub_minus {T : H →ₗ.[ℂ] H} (hT : IsSelfAdjoint T) : + cayleyPMap T = 1 - (2 * Complex.I) • (T - (-Complex.I) • 1).inverse := by + have heq : T - (-Complex.I) • 1 = T + Complex.I • 1 := by + exact LinearPMap.ext rfl fun x hf hg => by + simp [LinearPMap.sub_apply, LinearPMap.add_apply, LinearPMap.smul_apply, + neg_smul] + have heq' := congrArg LinearPMap.inverse heq + rw [cayleyPMap_eq_one_sub hT, ← heq'] + +/-! ## C. The bounded, unitary Cayley transform -/ + +/-- The bounded operator represented by the Cayley transform of a self-adjoint `LinearPMap`. -/ +noncomputable def cayleyContinuousLinearMap (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) : + H →L[ℂ] H := by + have hres := LinearPMap.IsSelfAdjoint.mem_resolventSet_of_im_ne_zero hT + (z := -Complex.I) (by norm_num) + have hinvdom : (T - (-Complex.I) • 1).inverse.domain = ⊤ := by + rw [LinearPMap.inverse_domain, hres.2.1] + exact 1 - (2 * Complex.I) • + topDomainToContinuousLinearMap (T - (-Complex.I) • 1).inverse hinvdom hres.2.2 + +/-- A bounded operator, viewed as an everywhere-defined `LinearPMap`. -/ +def continuousLinearMapToPMap (L : H →L[ℂ] H) : H →ₗ.[ℂ] H := + ⟨⊤, L.toLinearMap.comp Submodule.topEquiv.toLinearMap⟩ + +lemma cayleyPMap_eq_continuousLinearMapToPMap {T : H →ₗ.[ℂ] H} + (hT : IsSelfAdjoint T) : + cayleyPMap T = continuousLinearMapToPMap (cayleyContinuousLinearMap T hT) := by + have hres := LinearPMap.IsSelfAdjoint.mem_resolventSet_of_im_ne_zero hT + (z := -Complex.I) (by norm_num) + have heq : T - (-Complex.I) • 1 = T + Complex.I • 1 := by + exact LinearPMap.ext rfl fun x hf hg => by + simp [LinearPMap.sub_apply, LinearPMap.add_apply, LinearPMap.smul_apply, + neg_smul] + calc + cayleyPMap T = 1 - (2 * Complex.I) • (T - (-Complex.I) • 1).inverse := + cayleyPMap_eq_one_sub_minus hT + _ = continuousLinearMapToPMap (cayleyContinuousLinearMap T hT) := by + have hinvdom : (T - (-Complex.I) • 1).inverse.domain = ⊤ := by + rw [LinearPMap.inverse_domain] + exact hres.2.1 + have hdom : (1 - (2 * Complex.I) • + (T - (-Complex.I) • 1).inverse).domain = ⊤ := by + simp [LinearPMap.sub_domain, hinvdom] + have hdom' : (continuousLinearMapToPMap + (cayleyContinuousLinearMap T hT)).domain = ⊤ := rfl + apply LinearPMap.ext (hdom.trans hdom'.symm) + intro x hx hx' + simp only [LinearPMap.sub_apply, LinearPMap.smul_apply, continuousLinearMapToPMap] + simp [cayleyContinuousLinearMap, + topDomainToContinuousLinearMap_apply (T - (-Complex.I) • 1).inverse + hinvdom hres.2.2 x] + +lemma cayleyContinuousLinearMap_norm_shift {T : H →ₗ.[ℂ] H} + (hT : IsSelfAdjoint T) (y : T.domain) : + ‖T y - Complex.I • (y : H)‖ = ‖T y + Complex.I • (y : H)‖ := by + have hsym : T.IsSymmetric := LinearPMap.IsSelfAdjoint.isSymmetric hT + have hreal : (⟪T y, (y : H)⟫_ℂ).im = 0 := by + exact Complex.conj_eq_iff_im.mp + ((LinearPMap.isSymmetric_iff_inner_map_self_real).mp hsym y) + have hsub := norm_sub_sq (𝕜 := ℂ) (T y) (Complex.I • (y : H)) + have hadd := norm_add_sq (𝕜 := ℂ) (T y) (Complex.I • (y : H)) + have hinner : (⟪T y, Complex.I • (y : H)⟫_ℂ).re = 0 := by + rw [inner_smul_right] + simp [Complex.mul_re, hreal] + have hnorm : ‖Complex.I • (y : H)‖ ^ 2 = ‖(y : H)‖ ^ 2 := by + rw [norm_smul] + simp + have hsquares : ‖T y - Complex.I • (y : H)‖ ^ 2 = + ‖T y + Complex.I • (y : H)‖ ^ 2 := by + rw [hsub, hadd] + rw [show RCLike.re ⟪T y, Complex.I • (y : H)⟫_ℂ = 0 from hinner, hnorm] + ring + exact (sq_eq_sq₀ (norm_nonneg _) (norm_nonneg _)).mp hsquares + +lemma cayleyContinuousLinearMap_apply_of_mem_range {T : H →ₗ.[ℂ] H} + (hT : IsSelfAdjoint T) (y : (T + Complex.I • 1).domain) (x : H) + (hy : (T + Complex.I • 1) y = x) : + cayleyContinuousLinearMap T hT x = (T - Complex.I • 1) y := by + have hres := LinearPMap.IsSelfAdjoint.mem_resolventSet_of_im_ne_zero hT + (z := -Complex.I) (by norm_num) + have heq : T - (-Complex.I) • 1 = T + Complex.I • 1 := by + exact LinearPMap.ext rfl fun x hf hg => by + simp [LinearPMap.sub_apply, LinearPMap.add_apply, LinearPMap.smul_apply, + neg_smul] + have hres' := LinearPMap.IsSelfAdjoint.mem_resolventSet_of_im_ne_zero hT + (z := Complex.I) (by norm_num) + have hker' : (T - Complex.I • 1).toFun.ker = ⊥ := hres'.1 + have hminusdom : (T - (-Complex.I) • 1).domain = T.domain := by + simp [LinearPMap.sub_domain] + have hplusdom : (T + Complex.I • 1).domain = T.domain := by + simp [LinearPMap.add_domain] + have hyT : (y : H) ∈ T.domain := by + rw [← hplusdom] + exact y.property + have hym : (y : H) ∈ (T - (-Complex.I) • 1).domain := by + rw [hminusdom] + exact hyT + let hyminus : (T - (-Complex.I) • 1).domain := + ⟨(y : H), hym⟩ + have hyminus_eq : (T - (-Complex.I) • 1) hyminus = x := by + have hyt : (⟨(hyminus : H), hminusdom ▸ hyminus.property⟩ : T.domain) = + ⟨(y : H), hyT⟩ := by + apply Subtype.ext + change (y : H) = (y : H) + rfl + simp only [LinearPMap.sub_apply, LinearPMap.smul_apply] + rw [hyt] + simpa [LinearPMap.add_apply, LinearPMap.smul_apply] using hy + have hxinv : x ∈ (T - (-Complex.I) • 1).inverse.domain := by + rw [LinearPMap.inverse_domain] + rw [hres.2.1] + exact Submodule.mem_top + have hminus_inv : (T - (-Complex.I) • 1).inverse + ⟨x, hxinv⟩ = hyminus := by + exact LinearPMap.inverse_apply_eq hres.1 hyminus_eq + have hc : Continuous (T - (-Complex.I) • 1).inverse.toFun := hres.2.2 + simp only [cayleyContinuousLinearMap, sub_apply, smul_apply] + rw [topDomainToContinuousLinearMap_apply _ _ hc] + rw [hminus_inv] + have hycoe : (hyminus : H) = (y : H) := by + change (y : H) = (y : H) + rfl + rw [hycoe] + change x - (2 * Complex.I) • (y : H) = (T - Complex.I • 1) y + rw [← hy] + simp [LinearPMap.sub_apply, LinearPMap.add_apply, LinearPMap.smul_apply] + module + +lemma cayleyContinuousLinearMap_norm_map {T : H →ₗ.[ℂ] H} + (hT : IsSelfAdjoint T) (x : H) : + ‖cayleyContinuousLinearMap T hT x‖ = ‖x‖ := by + obtain ⟨y, hy⟩ := LinearPMap.IsSelfAdjoint.sub_smul_surjective hT + (z := -Complex.I) (by norm_num) x + have hplusdom : (T + Complex.I • 1).domain = T.domain := by + simp [LinearPMap.add_domain] + let yp : (T + Complex.I • 1).domain := + ⟨(y : H), by rw [hplusdom]; exact (show (y : H) ∈ T.domain from by + simpa [LinearPMap.sub_domain] using y.property)⟩ + have hyp : (T + Complex.I • 1) yp = x := by + simpa [LinearPMap.sub_apply, LinearPMap.add_apply, LinearPMap.smul_apply] using hy + rw [cayleyContinuousLinearMap_apply_of_mem_range hT yp x hyp] + rw [← hyp] + have hypp : (yp : H) ∈ (T + Complex.I • 1).domain := yp.property + let yT : T.domain := ⟨(yp : H), hplusdom ▸ hypp⟩ + have hcoey : (yp : H) = (yT : H) := by + dsimp [yp, yT] + have hshift := cayleyContinuousLinearMap_norm_shift hT yT + convert hshift using 1 <;> + simp [LinearPMap.sub_apply, LinearPMap.add_apply, LinearPMap.smul_apply, hcoey] + +lemma cayleyContinuousLinearMap_isometry {T : H →ₗ.[ℂ] H} + (hT : IsSelfAdjoint T) : Isometry (cayleyContinuousLinearMap T hT) := by + intro x y + have hdist : dist (cayleyContinuousLinearMap T hT x) + (cayleyContinuousLinearMap T hT y) = dist x y := by + simpa [dist_eq_norm, map_sub] using cayleyContinuousLinearMap_norm_map hT (x - y) + rw [edist_dist, hdist, edist_dist] + +lemma cayleyContinuousLinearMap_surjective {T : H →ₗ.[ℂ] H} + (hT : IsSelfAdjoint T) : Function.Surjective (cayleyContinuousLinearMap T hT) := by + intro x + obtain ⟨y, hy⟩ := LinearPMap.IsSelfAdjoint.sub_smul_surjective hT + (z := Complex.I) (by norm_num) x + have hminusdom : (T - Complex.I • 1).domain = T.domain := by + simp [LinearPMap.sub_domain] + have hym : (y : H) ∈ T.domain := by + have h := y.property + exact hminusdom ▸ h + have hplusdom : (T + Complex.I • 1).domain = T.domain := by + simp [LinearPMap.add_domain] + have hypmem : (y : H) ∈ (T + Complex.I • 1).domain := by + rw [hplusdom] + exact hym + let yp : (T + Complex.I • 1).domain := ⟨(y : H), hypmem⟩ + refine ⟨(T + Complex.I • 1) yp, ?_⟩ + rw [cayleyContinuousLinearMap_apply_of_mem_range hT yp _ rfl] + simpa [LinearPMap.sub_apply, LinearPMap.smul_apply] using hy + +/-- The unitary Cayley transform of a self-adjoint partial operator. -/ +noncomputable def cayleyUnitary (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) : H ≃ₗᵢ[ℂ] H := + LinearIsometryEquiv.ofSurjective + ((cayleyContinuousLinearMap T hT).toLinearMap.toLinearIsometry + (cayleyContinuousLinearMap_isometry hT)) + (cayleyContinuousLinearMap_surjective hT) + +@[simp] +lemma cayleyUnitary_apply (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) (x : H) : + cayleyUnitary T hT x = cayleyContinuousLinearMap T hT x := by + rfl + +end QuantumMechanics + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Cayley/Certificate.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Cayley/Certificate.lean new file mode 100644 index 0000000000..7803173a1a --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Cayley/Certificate.lean @@ -0,0 +1,170 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.BoundedIntegralAlgebra +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Cayley.Measure + +/-! + +# The bounded-unitary spectral interface + +The bounded spectral theorem itself does not need the Cayley support condition from +`Cayley/Measure.lean`: that condition is only needed once a bounded unitary's spectral measure is +going to be pulled back to the real line. This file records the general output any construction +of a bounded normal/unitary spectral measure must supply (`BoundedNormalSpectralData`, +`BoundedUnitarySpectralData`), independently of how that measure is actually built — kept general +so an arbitrary bounded normal operator can consume the same interface, not only Cayley unitaries. + +`BoundedUnitarySpectralData` additionally exposes the real spectral measure obtained by pulling +its (Cayley-supported) complex measure back through `cayleyInverseMap`, together with the exact +uniqueness statement: a real spectral measure is determined by its Cayley pushforward. + +- `BoundedNormalSpectralData` : a spectral measure reconstructing a bounded normal operator `U` + in the weak identity-integral sense, with an integral-determined extensionality principle. +- `BoundedUnitarySpectralData` : the same, plus the support condition needed to invert the Cayley + map, and the resulting `realSpectralMeasure`. + +-/ + +@[expose] public section + +noncomputable section + +open scoped InnerProductSpace + +namespace QuantumMechanics +namespace WOTSpectralMeasure + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-! ## A. Bounded normal spectral data -/ + +/-- A bounded normal spectral certificate for `U`: a genuine weak-operator spectral measure +reconstructing `U`. -/ +structure BoundedNormalSpectralData (U : H →L[ℂ] H) where + /-- The spectral measure. -/ + spectralMeasure : WOTSpectralMeasure ℂ H + reconstruction : ∀ x y : H, + spectralMeasure.complexWeakIntegral id x y = ⟪y, U x⟫_ℂ + +namespace BoundedNormalSpectralData + +variable {U : H →L[ℂ] H} + +@[ext] +theorem ext {D E : BoundedNormalSpectralData U} + (h : D.spectralMeasure = E.spectralMeasure) : D = E := by + cases D with + | mk μ hμ => + cases E with + | mk ν hν => + cases h + rfl + +/- A bounded-integral equality is a convenient representation-independent uniqueness criterion. +The stronger hypothesis is intentional: reconstruction of only the identity multiplier does not +by itself expose the spectral projections, whereas equality for all bounded Borel multipliers does. + -/ +theorem ext_of_boundedIntegral_eq {D E : BoundedNormalSpectralData U} + (h : ∀ (f : ℂ → ℂ) (hf : Measurable f) + (hfb : ∃ C : ℝ, ∀ z, ‖f z‖ ≤ C), + D.spectralMeasure.boundedIntegral f hf hfb = + E.spectralMeasure.boundedIntegral f hf hfb) : + D = E := by + apply ext + exact WOTSpectralMeasure.ext_of_boundedIntegral_eq h + +end BoundedNormalSpectralData + +/-! ## B. Bounded unitary spectral data -/ + +/-- The exact output required from the bounded unitary spectral theorem. + +The support equation records both facts needed to invert the Cayley map: the measure is on the +unit circle and has no mass at `1`, the point representing infinity. The reconstruction equation +is weak-operator reconstruction for the bounded unitary itself. This is deliberately a data +structure rather than an axiom-producing definition: constructing it for an arbitrary unitary is +the bounded spectral theorem proper. -/ +structure BoundedUnitarySpectralData (u : H ≃ₗᵢ[ℂ] H) where + /-- The spectral measure. -/ + spectralMeasure : WOTSpectralMeasure ℂ H + support_away_one : ∀ S : Set ℂ, MeasurableSet S → + spectralMeasure S = spectralMeasure (S ∩ {z | ‖z‖ = 1 ∧ z ≠ 1}) + reconstruction : ∀ x y : H, + spectralMeasure.complexWeakIntegral id x y = ⟪y, u x⟫_ℂ + +namespace BoundedUnitarySpectralData + +variable {u : H ≃ₗᵢ[ℂ] H} + +@[ext] +theorem ext {D E : BoundedUnitarySpectralData u} + (h : D.spectralMeasure = E.spectralMeasure) : D = E := by + cases D with + | mk μ hμ hμ' => + cases E with + | mk ν hν hν' => + cases h + rfl + +theorem ext_of_boundedIntegral_eq {D E : BoundedUnitarySpectralData u} + (h : ∀ (f : ℂ → ℂ) (hf : Measurable f) + (hfb : ∃ C : ℝ, ∀ z, ‖f z‖ ≤ C), + D.spectralMeasure.boundedIntegral f hf hfb = + E.spectralMeasure.boundedIntegral f hf hfb) : + D = E := by + apply ext + exact WOTSpectralMeasure.ext_of_boundedIntegral_eq h + +variable {u : H ≃ₗᵢ[ℂ] H} (D : BoundedUnitarySpectralData u) + +/-- Pull the bounded unitary measure back to the real line. -/ +def realSpectralMeasure : WOTSpectralMeasure ℝ H := + WOTSpectralMeasure.cayleyInverseMap D.spectralMeasure + +lemma cayleyMap_realSpectralMeasure : + WOTSpectralMeasure.cayleyMap D.realSpectralMeasure = D.spectralMeasure := by + rw [WOTSpectralMeasure.mk.injEq] + apply MeasureTheory.VectorMeasure.ext + intro S hS + change ((D.realSpectralMeasure.map cayley measurable_cayley) S) = D.spectralMeasure S + rw [D.realSpectralMeasure.map_apply cayley measurable_cayley hS] + change ((D.spectralMeasure.map cayleyInverse measurable_cayleyInverse) + (cayley ⁻¹' S)) = D.spectralMeasure S + rw [D.spectralMeasure.map_apply cayleyInverse measurable_cayleyInverse + (hS.preimage measurable_cayley)] + have hL : MeasurableSet (cayleyInverse ⁻¹' cayley ⁻¹' S) := + (hS.preimage measurable_cayley).preimage measurable_cayleyInverse + rw [D.support_away_one _ hL, D.support_away_one S hS] + congr 1 + ext z + constructor + · rintro ⟨hz, hunit⟩ + refine ⟨?_, hunit⟩ + simpa [Set.mem_preimage, cayley_cayleyInverse hunit.1 hunit.2] using hz + · rintro ⟨hz, hunit⟩ + have hz' : cayley (cayleyInverse z) = z := cayley_cayleyInverse hunit.1 hunit.2 + refine ⟨?_, hunit⟩ + simpa [Set.mem_preimage, hz'] using hz + +/-- The real measure recovered from bounded Cayley data is unique among real measures with the +same Cayley pushforward. -/ +lemma realSpectralMeasure_eq_of_cayleyMap_eq + {μS : WOTSpectralMeasure ℝ H} + (hμ : WOTSpectralMeasure.cayleyMap μS = D.spectralMeasure) : + D.realSpectralMeasure = μS := by + apply WOTSpectralMeasure.cayleyMap_injective + calc + WOTSpectralMeasure.cayleyMap D.realSpectralMeasure = D.spectralMeasure := + D.cayleyMap_realSpectralMeasure + _ = WOTSpectralMeasure.cayleyMap μS := hμ.symm + +end BoundedUnitarySpectralData +end WOTSpectralMeasure +end QuantumMechanics + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Cayley/Inverse.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Cayley/Inverse.lean new file mode 100644 index 0000000000..498178cbbb --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Cayley/Inverse.lean @@ -0,0 +1,643 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Cayley.Basic + +/-! + +# The inverse Cayley operator + +This file contains the reusable operator-side converse to `Cayley/Basic.lean`'s Cayley transform. +A unitary operator `u` has a possible missing point at `1`; its inverse Cayley transform is +therefore the partial operator + +`i (1 + u) (1 - u)⁻¹`. + +The inverse is defined on the range of `1 - u`. The no-fixed-vector hypothesis in +`CayleyUnitaryData` makes the inverse unambiguous. For a unitary, the same hypothesis also forces +the range of `1 - u` to be dense; that fact is proved here using orthogonal complements and the +Hilbert-space adjoint theorem. The range calculations at `± i` then prove self-adjointness +directly from the symmetric-operator criterion already available for `LinearPMap`. + +No model-specific completeness theorem is used here: this is the general layer that a concrete +Hamiltonian can use after producing its Cayley unitary. + +- `inverseCayleyPMap` : the partial inverse Cayley transform of a unitary operator. +- `inverseCayleyPMap_isSelfAdjoint` : the inverse Cayley transform of a unitary with `1` not a + fixed vector, and with `1 - u` having dense range, is self-adjoint. +- `CayleyUnitaryData` : the standard hypotheses for taking an inverse Cayley transform. +- `cayleyContinuousLinearMap_inverseCayleyPMap_eq` : the inverse Cayley transform of `u`'s Cayley + transform recovers `u` itself. + +-/ + +@[expose] public section + +noncomputable section + +open scoped ComplexOrder InnerProductSpace +open Function Set + +namespace QuantumMechanics + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-! ## A. The partial inverse Cayley transform -/ + +/-- A bounded unitary operator viewed as a total `LinearPMap`. -/ +def unitaryToPMap (u : H ≃ₗᵢ[ℂ] H) : H →ₗ.[ℂ] H := + continuousLinearMapToPMap (u.toLinearIsometry.toContinuousLinearMap) + +omit [CompleteSpace H] in +@[nolint unusedArguments, simp] +lemma unitaryToPMap_domain (u : H ≃ₗᵢ[ℂ] H) : (unitaryToPMap u).domain = ⊤ := by + rfl + +omit [CompleteSpace H] in +@[nolint unusedArguments, simp] +lemma one_sub_unitaryToPMap_domain (u : H ≃ₗᵢ[ℂ] H) : + (1 - unitaryToPMap u).domain = ⊤ := by + simp [unitaryToPMap, continuousLinearMapToPMap, LinearPMap.sub_domain] + +/-- The partial inverse Cayley transform of a unitary operator. -/ +def inverseCayleyPMap (u : H ≃ₗᵢ[ℂ] H) : H →ₗ.[ℂ] H := + Complex.I • (1 + unitaryToPMap u) * (1 - unitaryToPMap u).inverse + +omit [CompleteSpace H] in +@[nolint unusedArguments] +lemma inverseCayleyPMap_domain (u : H ≃ₗᵢ[ℂ] H) : + (inverseCayleyPMap u).domain = (1 - unitaryToPMap u).toFun.range := by + rw [inverseCayleyPMap, LinearPMap.mul_def, LinearPMap.compRestricted_domain] + simp only [LinearPMap.smul_domain, LinearPMap.add_domain] + have hgd : ((1 : H →ₗ.[ℂ] H).domain ⊓ (unitaryToPMap u).domain) = ⊤ := by + simp [unitaryToPMap, continuousLinearMapToPMap, LinearPMap.one_domain] + rw [hgd] + apply le_antisymm + · rintro x ⟨y, hy, rfl⟩ + rw [← LinearPMap.inverse_domain] + exact y.property + · intro x hx + have hxdom : x ∈ (1 - unitaryToPMap u).inverse.domain := by + rw [LinearPMap.inverse_domain] + exact hx + refine ⟨⟨x, hxdom⟩, ?_, rfl⟩ + exact Submodule.mem_top + +/-! ## B. Density of the range of `1 - u` -/ + +/- The range of `1 - u` is dense as soon as its orthogonal complement is shown to be zero. The +proof below is deliberately written with the continuous representative: this is the version of +the adjoint/orthogonal-range theorem that remains available in infinite dimension. -/ +lemma one_sub_unitaryToPMap_denseRange_of_ker_eq_bot {u : H ≃ₗᵢ[ℂ] H} + (hker : (1 - unitaryToPMap u).toFun.ker = ⊥) : + Dense ((1 - unitaryToPMap u).toFun.range : Set H) := by + have hrange_eq : (1 - unitaryToPMap u).toFun.range = + (1 - u.toLinearIsometry.toContinuousLinearMap).range := by + ext x + constructor + · rintro ⟨y, rfl⟩ + refine ⟨(y : H), ?_⟩ + rfl + · rintro ⟨y, rfl⟩ + let y' : (1 - unitaryToPMap u).domain := + ⟨y, by + rw [one_sub_unitaryToPMap_domain u] + exact Submodule.mem_top⟩ + refine ⟨y', ?_⟩ + rfl + rw [hrange_eq] + let F : H →L[ℂ] H := 1 - u.toLinearIsometry.toContinuousLinearMap + have horthbot : F.rangeᗮ = ⊥ := by + apply le_antisymm + · intro x hx + have hxinner : ∀ y : H, ⟪x, F y⟫_ℂ = 0 := by + intro y + apply (Submodule.mem_orthogonal' F.range x).mp hx + exact ⟨y, rfl⟩ + have hinner : ∀ y : H, ⟪x, y⟫_ℂ = ⟪u.symm x, y⟫_ℂ := by + intro y + have hz := hxinner y + have hflip := u.inner_map_eq_flip (u.symm x) (u y) + change ⟪x, y - u y⟫_ℂ = 0 at hz + rw [inner_sub_right] at hz + have hflip' : ⟪x, u y⟫_ℂ = ⟪u.symm x, y⟫_ℂ := by + simpa only [u.symm_apply_apply, u.apply_symm_apply] using hflip + rw [hflip'] at hz + exact sub_eq_zero.mp hz + have hfixed : x = u x := by + have hxeq : x = u.symm x := ext_inner_right ℂ hinner + have hxeq' := congrArg (fun z : H => u z) hxeq + simpa only [u.apply_symm_apply] using hxeq'.symm + have hxker : (⟨x, by + rw [one_sub_unitaryToPMap_domain u] + exact Submodule.mem_top⟩ : (1 - unitaryToPMap u).domain) ∈ + (1 - unitaryToPMap u).toFun.ker := by + rw [LinearMap.mem_ker] + change x - u x = 0 + exact sub_eq_zero.mpr hfixed + have hxzero : (⟨x, by + rw [one_sub_unitaryToPMap_domain u] + exact Submodule.mem_top⟩ : (1 - unitaryToPMap u).domain) = 0 := by + rw [hker] at hxker + exact ((Submodule.mem_bot ℂ).mp hxker) + exact congrArg Subtype.val hxzero + · exact bot_le + change Dense (F.range : Set H) + rw [dense_iff_closure_eq] + rw [← Submodule.topologicalClosure_coe] + rw [← Submodule.orthogonal_orthogonal_eq_closure] + rw [horthbot, Submodule.bot_orthogonal_eq_top] + rfl + +lemma unitaryToPMap_cayleyUnitary_eq_cayleyPMap {T : H →ₗ.[ℂ] H} + (hT : IsSelfAdjoint T) : + unitaryToPMap (cayleyUnitary T hT) = cayleyPMap T := by + have hc : (cayleyUnitary T hT).toLinearIsometry.toContinuousLinearMap = + cayleyContinuousLinearMap T hT := by + ext x + exact cayleyUnitary_apply T hT x + rw [unitaryToPMap, hc] + exact (cayleyPMap_eq_continuousLinearMapToPMap hT).symm + +lemma cayleyUnitary_one_sub_ker_eq_bot {T : H →ₗ.[ℂ] H} + (hT : IsSelfAdjoint T) : + (1 - unitaryToPMap (cayleyUnitary T hT)).toFun.ker = ⊥ := by + have hres := LinearPMap.IsSelfAdjoint.mem_resolventSet_of_im_ne_zero hT + (z := -Complex.I) (by norm_num) + have hker : (T + Complex.I • (1 : H →ₗ.[ℂ] H)).toFun.ker = ⊥ := by + have heq : T - (-Complex.I) • (1 : H →ₗ.[ℂ] H) = T + Complex.I • 1 := by + exact LinearPMap.ext rfl fun x hf hg => by + simp [LinearPMap.sub_apply, LinearPMap.add_apply, LinearPMap.smul_apply, neg_smul] + rw [← heq] + exact hres.1 + have hinvker := LinearPMap.inverse_ker hker + have hEq : 1 - unitaryToPMap (cayleyUnitary T hT) = + (2 * Complex.I) • (T + Complex.I • (1 : H →ₗ.[ℂ] H)).inverse := by + rw [unitaryToPMap_cayleyUnitary_eq_cayleyPMap hT, cayleyPMap_eq_one_sub hT] + have hdom : (1 - (1 - (2 * Complex.I) • + (T + Complex.I • (1 : H →ₗ.[ℂ] H)).inverse)).domain = + ((2 * Complex.I) • (T + Complex.I • (1 : H →ₗ.[ℂ] H)).inverse).domain := by + simp [LinearPMap.sub_domain] + apply LinearPMap.ext hdom + intro x hx hx' + simp only [LinearPMap.sub_apply, LinearPMap.smul_apply] + module + rw [hEq] + apply LinearMap.ker_eq_bot'.mpr + intro x hx + have hx' : (2 * Complex.I) • + (T + Complex.I • (1 : H →ₗ.[ℂ] H)).inverse x = 0 := hx + have hxinv : (T + Complex.I • (1 : H →ₗ.[ℂ] H)).inverse x = 0 := by + rcases smul_eq_zero.mp hx' with h | h + · norm_num at h + · exact h + have hxker : x ∈ (T + Complex.I • (1 : H →ₗ.[ℂ] H)).inverse.toFun.ker := + LinearMap.mem_ker.mpr hxinv + rw [hinvker] at hxker + exact (Submodule.mem_bot ℂ).mp hxker + +omit [CompleteSpace H] in +@[nolint unusedArguments] +lemma linearPMap_range_smul {Q : H →ₗ.[ℂ] H} (a : ℂ) (ha : a ≠ 0) : + (a • Q).toFun.range = Q.toFun.range := by + ext x + constructor + · rintro ⟨y, hy⟩ + let yQ : Q.domain := + ⟨(y : H), by simp [LinearPMap.smul_domain]⟩ + let y' : Q.domain := a • yQ + refine ⟨y', ?_⟩ + change a • Q.toFun yQ = x at hy + simpa [y', Q.toFun.map_smul] using hy + · rintro ⟨y, hy⟩ + let yQ : Q.domain := + ⟨(y : H), by simp [y.property]⟩ + let y' : (a • Q).domain := + ⟨a⁻¹ • (yQ : H), by + rw [LinearPMap.smul_domain] + exact Q.domain.smul_mem _ (by simp [yQ.property])⟩ + refine ⟨y', ?_⟩ + change a • Q.toFun y' = x + change Q.toFun yQ = x at hy + change a • Q.toFun (a⁻¹ • yQ) = x + rw [map_smul, smul_smul, mul_inv_cancel₀ ha, one_smul] + exact hy + +omit [CompleteSpace H] in +@[nolint unusedArguments] +lemma linearPMap_comp_inverse_apply {Q : H →ₗ.[ℂ] H} + (hker : Q.toFun.ker = ⊥) (y : Q.inverse.domain) : + Q (⟨Q.inverse y, by + rw [← LinearPMap.inverse_range hker] + exact LinearMap.mem_range_self _ y⟩ : Q.domain) = y := by + have hc := LinearPMap.compRestricted_inverse_eq hker + obtain ⟨hcd, hcf⟩ := LinearPMap.dExt_iff.mp hc + let ac : (Q ∘ᵣ Q.inverse).domain := + ⟨(y : H), by + refine LinearPMap.mem_compRestricted_domain_iff.mpr ⟨y.property, ?_⟩ + rw [← LinearPMap.inverse_range hker] + exact LinearMap.mem_range_self _ y⟩ + let ad : (LinearPMap.domRestrict (1 : H →ₗ.[ℂ] H) Q.inverse.domain).domain := + ⟨(y : H), by + rw [LinearPMap.domRestrict_domain] + exact ⟨y.property, Submodule.mem_top⟩⟩ + have h := hcf (x := ac) (y := ad) rfl + have had : LinearPMap.domRestrict (1 : H →ₗ.[ℂ] H) Q.inverse.domain ad = y := by + change (ad : H) = (y : H) + rfl + rw [had] at h + simpa [ac, LinearPMap.compRestricted_apply] using h + +lemma inverseCayleyPMap_cayleyUnitary_domain {T : H →ₗ.[ℂ] H} + (hT : IsSelfAdjoint T) : + (inverseCayleyPMap (cayleyUnitary T hT)).domain = T.domain := by + have hres := LinearPMap.IsSelfAdjoint.mem_resolventSet_of_im_ne_zero hT + (z := -Complex.I) (by norm_num) + have hplusker : (T + Complex.I • (1 : H →ₗ.[ℂ] H)).toFun.ker = ⊥ := by + have heq : T - (-Complex.I) • (1 : H →ₗ.[ℂ] H) = T + Complex.I • 1 := by + exact LinearPMap.ext rfl fun x hf hg => by + simp [LinearPMap.sub_apply, LinearPMap.add_apply, LinearPMap.smul_apply, neg_smul] + rw [← heq] + exact hres.1 + have hplusrange : (T + Complex.I • (1 : H →ₗ.[ℂ] H)).toFun.range = ⊤ := by + have heq : T - (-Complex.I) • (1 : H →ₗ.[ℂ] H) = T + Complex.I • 1 := by + exact LinearPMap.ext rfl fun q hq hq' => by + simp [LinearPMap.sub_apply, LinearPMap.add_apply, LinearPMap.smul_apply, neg_smul] + rw [← heq] + exact hres.2.1 + have hEq : 1 - unitaryToPMap (cayleyUnitary T hT) = + (2 * Complex.I) • (T + Complex.I • (1 : H →ₗ.[ℂ] H)).inverse := by + rw [unitaryToPMap_cayleyUnitary_eq_cayleyPMap hT, cayleyPMap_eq_one_sub hT] + have hdom : (1 - (1 - (2 * Complex.I) • + (T + Complex.I • (1 : H →ₗ.[ℂ] H)).inverse)).domain = + ((2 * Complex.I) • (T + Complex.I • (1 : H →ₗ.[ℂ] H)).inverse).domain := by + simp [LinearPMap.sub_domain] + apply LinearPMap.ext hdom + intro x hx hx' + simp only [LinearPMap.sub_apply, LinearPMap.smul_apply] + module + have hrange : (1 - unitaryToPMap (cayleyUnitary T hT)).toFun.range = T.domain := by + rw [hEq, linearPMap_range_smul _ (by norm_num), LinearPMap.inverse_range hplusker] + simp [LinearPMap.add_domain] + rw [inverseCayleyPMap_domain, hrange] + +omit [CompleteSpace H] in +lemma inverseCayleyPMap_apply_on_range {u : H ≃ₗᵢ[ℂ] H} + (hker : (1 - unitaryToPMap u).toFun.ker = ⊥) (a : (1 - unitaryToPMap u).domain) : + inverseCayleyPMap u (⟨(1 - unitaryToPMap u) a, by + rw [inverseCayleyPMap_domain u] + exact LinearMap.mem_range_self _ a⟩) = + Complex.I • (1 + unitaryToPMap u) a := by + let y : (1 - unitaryToPMap u).inverse.domain := + ⟨(1 - unitaryToPMap u) a, by + rw [LinearPMap.inverse_domain] + exact LinearMap.mem_range_self _ a⟩ + have hy : (1 - unitaryToPMap u).inverse y = a := by + apply LinearPMap.inverse_apply_eq hker + rfl + simp only [inverseCayleyPMap, LinearPMap.mul_def, LinearPMap.compRestricted_apply, + LinearPMap.smul_apply] + rw [hy] + congr 2 + +lemma inverseCayleyPMap_cayleyUnitary {T : H →ₗ.[ℂ] H} + (hT : IsSelfAdjoint T) : + inverseCayleyPMap (cayleyUnitary T hT) = T := by + let u := cayleyUnitary T hT + have hker : (1 - unitaryToPMap u).toFun.ker = ⊥ := by + simpa [u] using cayleyUnitary_one_sub_ker_eq_bot hT + have hdom : (inverseCayleyPMap u).domain = T.domain := by + simpa [u] using inverseCayleyPMap_cayleyUnitary_domain hT + have hEq : 1 - unitaryToPMap u = + (2 * Complex.I) • (T + Complex.I • (1 : H →ₗ.[ℂ] H)).inverse := by + rw [show unitaryToPMap u = cayleyPMap T by + simpa [u] using unitaryToPMap_cayleyUnitary_eq_cayleyPMap hT] + rw [cayleyPMap_eq_one_sub hT] + have hdom0 : (1 - (1 - (2 * Complex.I) • + (T + Complex.I • (1 : H →ₗ.[ℂ] H)).inverse)).domain = + ((2 * Complex.I) • (T + Complex.I • (1 : H →ₗ.[ℂ] H)).inverse).domain := by + simp [LinearPMap.sub_domain] + apply LinearPMap.ext hdom0 + intro q hq hq' + simp only [LinearPMap.sub_apply, LinearPMap.smul_apply] + module + have hres := LinearPMap.IsSelfAdjoint.mem_resolventSet_of_im_ne_zero hT + (z := -Complex.I) (by norm_num) + have hplusker : (T + Complex.I • (1 : H →ₗ.[ℂ] H)).toFun.ker = ⊥ := by + have heq : T - (-Complex.I) • (1 : H →ₗ.[ℂ] H) = T + Complex.I • 1 := by + exact LinearPMap.ext rfl fun q hq hq' => by + simp [LinearPMap.sub_apply, LinearPMap.add_apply, LinearPMap.smul_apply, neg_smul] + rw [← heq] + exact hres.1 + have hplusrange : (T + Complex.I • (1 : H →ₗ.[ℂ] H)).toFun.range = ⊤ := by + have heq : T - (-Complex.I) • (1 : H →ₗ.[ℂ] H) = T + Complex.I • 1 := by + exact LinearPMap.ext rfl fun q hq hq' => by + simp [LinearPMap.sub_apply, LinearPMap.add_apply, LinearPMap.smul_apply, neg_smul] + rw [← heq] + exact hres.2.1 + apply LinearPMap.ext hdom + intro x hx hx' + have hxrange : (x : H) ∈ (1 - unitaryToPMap u).toFun.range := by + rw [← inverseCayleyPMap_domain u] + exact hx + obtain ⟨a, ha⟩ := hxrange + let ai : (T + Complex.I • (1 : H →ₗ.[ℂ] H)).inverse.domain := + ⟨(a : H), by + rw [LinearPMap.inverse_domain, hplusrange] + exact Submodule.mem_top⟩ + let zp : (T + Complex.I • (1 : H →ₗ.[ℂ] H)).domain := + ⟨(T + Complex.I • (1 : H →ₗ.[ℂ] H)).inverse ai, by + rw [← LinearPMap.inverse_range hplusker] + exact LinearMap.mem_range_self _ ai⟩ + let zpT : T.domain := + ⟨(zp : H), by simpa [LinearPMap.add_domain] using zp.property⟩ + have hza : (T + Complex.I • (1 : H →ₗ.[ℂ] H)) zp = (a : H) := by + exact linearPMap_comp_inverse_apply hplusker ai + let al : (1 - unitaryToPMap u).domain := + ⟨(a : H), by + exact a.property⟩ + let ar : ((2 * Complex.I) • + (T + Complex.I • (1 : H →ₗ.[ℂ] H)).inverse).domain := + ⟨(a : H), by + rw [LinearPMap.smul_domain, LinearPMap.inverse_domain, hplusrange] + exact Submodule.mem_top⟩ + obtain ⟨hEq_dom, hEq_fun⟩ := LinearPMap.dExt_iff.mp hEq + have hEq_a := hEq_fun (x := al) (y := ar) rfl + change (1 - unitaryToPMap u) al = + (2 * Complex.I) • (T + Complex.I • (1 : H →ₗ.[ℂ] H)).inverse ai at hEq_a + have hxval : (x : H) = (2 * Complex.I) • (zp : H) := by + rw [← hEq_a] + exact ha.symm + let xi : (inverseCayleyPMap u).domain := + ⟨(1 - unitaryToPMap u) a, by + rw [inverseCayleyPMap_domain u] + exact LinearMap.mem_range_self _ a⟩ + have hxi : (⟨(x : H), hx⟩ : (inverseCayleyPMap u).domain) = xi := by + apply Subtype.ext + exact ha.symm + let zt : T.domain := + ⟨(2 * Complex.I) • (zpT : H), by + rw [← hxval] + exact hx'⟩ + have hxt : (⟨(x : H), hx'⟩ : T.domain) = zt := by + apply Subtype.ext + exact hxval + rw [hxi, inverseCayleyPMap_apply_on_range hker a] + change Complex.I • ((a : H) + u (a : H)) = T ⟨(x : H), hx'⟩ + rw [hxt] + dsimp [zt] + change Complex.I • ((a : H) + u (a : H)) = + T.toFun ((2 * Complex.I) • zpT) + rw [T.toFun.map_smul] + have hua : u (a : H) = T zpT - Complex.I • (zpT : H) := by + have hEq_a' := hEq_a + change (a : H) - u (a : H) = (2 * Complex.I) • (zpT : H) at hEq_a' + have hza' := hza + change T zpT + Complex.I • (zpT : H) = (a : H) at hza' + have hua' : u (a : H) = (a : H) - (2 * Complex.I) • (zpT : H) := by + rw [eq_sub_iff_add_eq] + rw [← hEq_a'] + module + calc + u (a : H) = (a : H) - (2 * Complex.I) • (zpT : H) := hua' + _ = T zpT - Complex.I • (zpT : H) := by + rw [← hza'] + module + rw [hua] + have hza' := hza + change T zpT + Complex.I • (zpT : H) = (a : H) at hza' + rw [← hza'] + have hsum : (T zpT + Complex.I • (zpT : H)) + + (T zpT - Complex.I • (zpT : H)) = (2 : ℂ) • T zpT := by + module + rw [hsum] + simp [smul_smul, mul_comm] + +omit [CompleteSpace H] in +@[nolint unusedArguments] +lemma cayley_inner_identity (u : H ≃ₗᵢ[ℂ] H) (a b : H) : + ⟪Complex.I • (a + u a), b - u b⟫_ℂ = + ⟪a - u a, Complex.I • (b + u b)⟫_ℂ := by + have hub : ⟪u a, u b⟫_ℂ = ⟪a, b⟫_ℂ := by + simp + simp only [inner_smul_left, inner_smul_right, inner_add_left, inner_add_right, + inner_sub_left, inner_sub_right] + rw [show starRingEnd ℂ Complex.I = -Complex.I by simp] + rw [hub] + ring + +omit [CompleteSpace H] in +/-- The inverse Cayley operator is symmetric whenever `1 - u` is injective. -/ +lemma inverseCayleyPMap_isSymmetric {u : H ≃ₗᵢ[ℂ] H} + (hker : (1 - unitaryToPMap u).toFun.ker = ⊥) : + (inverseCayleyPMap u).IsSymmetric := by + intro x y + have hxrange : (x : H) ∈ (1 - unitaryToPMap u).toFun.range := by + rw [← inverseCayleyPMap_domain u] + exact x.property + have hyrange : (y : H) ∈ (1 - unitaryToPMap u).toFun.range := by + rw [← inverseCayleyPMap_domain u] + exact y.property + obtain ⟨a, ha⟩ := hxrange + obtain ⟨b, hb⟩ := hyrange + let xa : (inverseCayleyPMap u).domain := + ⟨(1 - unitaryToPMap u) a, by + rw [inverseCayleyPMap_domain u] + exact LinearMap.mem_range_self _ a⟩ + let ya : (inverseCayleyPMap u).domain := + ⟨(1 - unitaryToPMap u) b, by + rw [inverseCayleyPMap_domain u] + exact LinearMap.mem_range_self _ b⟩ + have hxa : x = xa := by + apply Subtype.ext + exact ha.symm + have hya : y = ya := by + apply Subtype.ext + exact hb.symm + rw [hxa, hya, inverseCayleyPMap_apply_on_range hker a, + inverseCayleyPMap_apply_on_range hker b] + dsimp [xa, ya] + change ⟪Complex.I • ((a : H) + u (a : H)), (b : H) - u (b : H)⟫_ℂ = + ⟪(a : H) - u (a : H), Complex.I • ((b : H) + u (b : H))⟫_ℂ + exact cayley_inner_identity u (a : H) (b : H) + +omit [CompleteSpace H] in +lemma inverseCayleyPMap_add_I_apply_on_range {u : H ≃ₗᵢ[ℂ] H} + (hker : (1 - unitaryToPMap u).toFun.ker = ⊥) (a : (1 - unitaryToPMap u).domain) : + let x : (inverseCayleyPMap u).domain := + ⟨(1 - unitaryToPMap u) a, by + rw [inverseCayleyPMap_domain u] + exact LinearMap.mem_range_self _ a⟩ + inverseCayleyPMap u x + Complex.I • x = (2 * Complex.I) • (a : H) := by + dsimp + rw [inverseCayleyPMap_apply_on_range hker a] + change Complex.I • ((a : H) + u (a : H)) + Complex.I • ((a : H) - u (a : H)) = _ + module + +omit [CompleteSpace H] in +lemma inverseCayleyPMap_sub_I_apply_on_range {u : H ≃ₗᵢ[ℂ] H} + (hker : (1 - unitaryToPMap u).toFun.ker = ⊥) (a : (1 - unitaryToPMap u).domain) : + let x : (inverseCayleyPMap u).domain := + ⟨(1 - unitaryToPMap u) a, by + rw [inverseCayleyPMap_domain u] + exact LinearMap.mem_range_self _ a⟩ + inverseCayleyPMap u x - Complex.I • x = (2 * Complex.I) • u (a : H) := by + dsimp + rw [inverseCayleyPMap_apply_on_range hker a] + change Complex.I • ((a : H) + u (a : H)) - Complex.I • ((a : H) - u (a : H)) = _ + module + +omit [CompleteSpace H] in +lemma inverseCayleyPMap_hasDenseDomain {u : H ≃ₗᵢ[ℂ] H} + (h_dense : Dense ((1 - unitaryToPMap u).toFun.range : Set H)) : + (inverseCayleyPMap u).HasDenseDomain := by + change Dense ((inverseCayleyPMap u).domain : Set H) + rw [inverseCayleyPMap_domain u] + exact h_dense + +omit [CompleteSpace H] in +lemma inverseCayleyPMap_add_I_range_eq_top {u : H ≃ₗᵢ[ℂ] H} + (hker : (1 - unitaryToPMap u).toFun.ker = ⊥) : + (inverseCayleyPMap u + Complex.I • (1 : H →ₗ.[ℂ] H)).toFun.range = ⊤ := by + apply LinearMap.range_eq_top.mpr + intro y + let a : (1 - unitaryToPMap u).domain := + ⟨(2 * Complex.I)⁻¹ • y, by + rw [one_sub_unitaryToPMap_domain u] + exact Submodule.mem_top⟩ + let x : (inverseCayleyPMap u).domain := + ⟨(1 - unitaryToPMap u) a, by + rw [inverseCayleyPMap_domain u] + exact LinearMap.mem_range_self _ a⟩ + let xp : (inverseCayleyPMap u + Complex.I • (1 : H →ₗ.[ℂ] H)).domain := + ⟨(x : H), by + simp [LinearPMap.add_domain, x, inverseCayleyPMap_domain u]⟩ + refine ⟨xp, ?_⟩ + have hx := inverseCayleyPMap_add_I_apply_on_range hker a + change inverseCayleyPMap u x + Complex.I • (x : H) = y + rw [hx] + change (2 * Complex.I) • ((2 * Complex.I)⁻¹ • y) = y + rw [smul_smul] + have hscalar : (2 : ℂ) * Complex.I * ((2 * Complex.I)⁻¹) = 1 := by + exact mul_inv_cancel₀ (by norm_num) + rw [hscalar, one_smul] + +omit [CompleteSpace H] in +lemma inverseCayleyPMap_sub_I_range_eq_top {u : H ≃ₗᵢ[ℂ] H} + (hker : (1 - unitaryToPMap u).toFun.ker = ⊥) : + (inverseCayleyPMap u - Complex.I • (1 : H →ₗ.[ℂ] H)).toFun.range = ⊤ := by + apply LinearMap.range_eq_top.mpr + intro y + let a : (1 - unitaryToPMap u).domain := + ⟨u.symm ((2 * Complex.I)⁻¹ • y), by + rw [one_sub_unitaryToPMap_domain u] + exact Submodule.mem_top⟩ + let x : (inverseCayleyPMap u).domain := + ⟨(1 - unitaryToPMap u) a, by + rw [inverseCayleyPMap_domain u] + exact LinearMap.mem_range_self _ a⟩ + let xp : (inverseCayleyPMap u - Complex.I • (1 : H →ₗ.[ℂ] H)).domain := + ⟨(x : H), by + rw [LinearPMap.sub_domain, LinearPMap.smul_domain, LinearPMap.one_domain] + exact ⟨x.property, Submodule.mem_top⟩⟩ + refine ⟨xp, ?_⟩ + have hx := inverseCayleyPMap_sub_I_apply_on_range hker a + change inverseCayleyPMap u x - Complex.I • (x : H) = y + rw [hx] + change (2 * Complex.I) • u (u.symm ((2 * Complex.I)⁻¹ • y)) = y + simp only [LinearIsometryEquiv.apply_symm_apply] + rw [smul_smul] + have hscalar : (2 : ℂ) * Complex.I * ((2 * Complex.I)⁻¹) = 1 := by + exact mul_inv_cancel₀ (by norm_num) + rw [hscalar, one_smul] + +/-! ## C. Self-adjointness of the inverse Cayley transform -/ + +/-- The standard hypotheses for taking an inverse Cayley transform. -/ +structure CayleyUnitaryData (u : H ≃ₗᵢ[ℂ] H) : Prop where + /-- The point `1` is not an eigenvalue of the unitary. -/ + one_sub_injective : (1 - unitaryToPMap u).toFun.ker = ⊥ + +lemma inverseCayleyPMap_isSelfAdjoint {u : H ≃ₗᵢ[ℂ] H} + (hker : (1 - unitaryToPMap u).toFun.ker = ⊥) + (h_dense : Dense ((1 - unitaryToPMap u).toFun.range : Set H)) : + IsSelfAdjoint (inverseCayleyPMap u) := by + apply LinearPMap.IsSymmetric.isSelfAdjoint_of_range_eq_top + (inverseCayleyPMap_isSymmetric hker) (inverseCayleyPMap_hasDenseDomain h_dense) + · exact inverseCayleyPMap_add_I_range_eq_top hker + · exact inverseCayleyPMap_sub_I_range_eq_top hker + +/-! ## D. Round trip with the forward Cayley transform -/ + +lemma cayleyContinuousLinearMap_inverseCayleyPMap_apply {u : H ≃ₗᵢ[ℂ] H} + (hker : (1 - unitaryToPMap u).toFun.ker = ⊥) + (h_dense : Dense ((1 - unitaryToPMap u).toFun.range : Set H)) (x : H) : + cayleyContinuousLinearMap (inverseCayleyPMap u) + (inverseCayleyPMap_isSelfAdjoint hker h_dense) x = u x := by + let T : H →ₗ.[ℂ] H := inverseCayleyPMap u + have hT : IsSelfAdjoint T := inverseCayleyPMap_isSelfAdjoint hker h_dense + have hrange := inverseCayleyPMap_add_I_range_eq_top hker + have hxrange : x ∈ (T + Complex.I • (1 : H →ₗ.[ℂ] H)).toFun.range := by + rw [hrange] + exact Submodule.mem_top + obtain ⟨y, hy⟩ := hxrange + have hcalc := cayleyContinuousLinearMap_apply_of_mem_range hT y x hy + rw [hcalc] + have hyT : (y : H) ∈ T.domain := by + simpa [LinearPMap.add_domain] using y.property + have hyI : (y : H) ∈ (inverseCayleyPMap u).domain := hyT + rw [inverseCayleyPMap_domain u] at hyI + obtain ⟨a, ha⟩ := hyI + let ya : (T + Complex.I • (1 : H →ₗ.[ℂ] H)).domain := + ⟨(1 - unitaryToPMap u) a, by + simp [LinearPMap.add_domain, T, inverseCayleyPMap_domain u]⟩ + have hya : y = ya := by + apply Subtype.ext + exact ha.symm + rw [hya] + have hsub : (T - Complex.I • (1 : H →ₗ.[ℂ] H)) ya = + (2 * Complex.I) • u (a : H) := by + change inverseCayleyPMap u + (⟨(1 - unitaryToPMap u) a, by + rw [inverseCayleyPMap_domain u] + exact LinearMap.mem_range_self _ a⟩) - Complex.I • + ((1 - unitaryToPMap u) a : H) = _ + rw [inverseCayleyPMap_sub_I_apply_on_range hker a] + rw [hsub] + have hadd := inverseCayleyPMap_add_I_apply_on_range hker a + have hadd' : (T + Complex.I • (1 : H →ₗ.[ℂ] H)) ya = + (2 * Complex.I) • (a : H) := by + simpa [LinearPMap.add_apply, T, ya] using hadd + change (2 * Complex.I) • u (a : H) = u x + rw [← map_smul] + congr 1 + rw [← hadd'] + rw [← hya] + exact hy + +lemma cayleyContinuousLinearMap_inverseCayleyPMap_eq {u : H ≃ₗᵢ[ℂ] H} + (hker : (1 - unitaryToPMap u).toFun.ker = ⊥) + (h_dense : Dense ((1 - unitaryToPMap u).toFun.range : Set H)) : + cayleyContinuousLinearMap (inverseCayleyPMap u) + (inverseCayleyPMap_isSelfAdjoint hker h_dense) = + u.toLinearIsometry.toContinuousLinearMap := by + ext x + exact cayleyContinuousLinearMap_inverseCayleyPMap_apply hker h_dense x + +lemma inverseCayleyPMap_isSelfAdjoint_of_ker_eq_bot {u : H ≃ₗᵢ[ℂ] H} + (hker : (1 - unitaryToPMap u).toFun.ker = ⊥) : + IsSelfAdjoint (inverseCayleyPMap u) := + inverseCayleyPMap_isSelfAdjoint hker + (one_sub_unitaryToPMap_denseRange_of_ker_eq_bot hker) + +lemma CayleyUnitaryData.inverse_isSelfAdjoint {u : H ≃ₗᵢ[ℂ] H} + (hu : CayleyUnitaryData u) : IsSelfAdjoint (inverseCayleyPMap u) := + inverseCayleyPMap_isSelfAdjoint_of_ker_eq_bot hu.one_sub_injective + +end QuantumMechanics + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Cayley/Measure.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Cayley/Measure.lean new file mode 100644 index 0000000000..e967a0a95a --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Cayley/Measure.lean @@ -0,0 +1,156 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.WeakIntegral +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Cayley.Basic + +/-! + +# Transporting a spectral measure through the Cayley transform + +`Cayley/Basic.lean` gives the scalar Cayley transform `cayley : ℝ → ℂ` and its (one-sided) +inverse `cayleyInverse`. This file pushes a `WOTSpectralMeasure` forward and backward along those +maps (`cayleyMap`, `cayleyInverseMap`), proves the round trip on the real side is exact +(`cayleyInverseMap_cayleyMap`, hence `cayleyMap_injective`), and identifies exactly which complex +measures are genuine Cayley images: those supported on the unit circle away from `1` +(`CayleySupported`), giving an equivalence `cayleyMeasureEquiv` between real spectral measures and +Cayley-supported complex ones. This is the reusable measure-level core of the self-adjoint/unitary +correspondence; no unbounded operator is mentioned in this file at all. + +- `cayleyMap`, `cayleyInverseMap` : pushing a `WOTSpectralMeasure` forward/backward along the + Cayley transform. +- `cayleyInverseMap_cayleyMap`, `cayleyMap_injective` : the round trip on the real side, and the + resulting injectivity of `cayleyMap`. +- `cayleyMeasureEquiv` : the equivalence between real spectral measures and complex spectral + measures supported on the unit circle away from `1`. + +-/ + +@[expose] public section + +noncomputable section + +open Function MeasureTheory Set +open scoped ComplexOrder InnerProductSpace + +namespace QuantumMechanics +namespace WOTSpectralMeasure + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-! ## A. Pushforward and pullback along the Cayley transform -/ + +/-- The bounded spectral measure obtained from a real spectral measure by the Cayley map. -/ +def cayleyMap (μS : WOTSpectralMeasure ℝ H) : WOTSpectralMeasure ℂ H := + μS.map cayley measurable_cayley + +/-- Pull a complex spectral measure back to a real variable using the inverse Cayley coordinate. -/ +def cayleyInverseMap (ν : WOTSpectralMeasure ℂ H) : WOTSpectralMeasure ℝ H := + ν.map cayleyInverse measurable_cayleyInverse + +lemma cayleyInverseMap_cayleyMap (μS : WOTSpectralMeasure ℝ H) : + cayleyInverseMap (cayleyMap μS) = μS := by + cases μS with + | mk vm hp hu => + have hvm : ((vm.map cayley).map cayleyInverse) = vm := by + apply MeasureTheory.VectorMeasure.ext + intro S hS + rw [MeasureTheory.VectorMeasure.map_apply _ measurable_cayleyInverse hS] + rw [MeasureTheory.VectorMeasure.map_apply _ measurable_cayley + (hS.preimage measurable_cayleyInverse)] + congr 1 + ext x + simp [Set.mem_preimage, cayleyInverse_cayley] + unfold cayleyInverseMap cayleyMap + rw [QuantumMechanics.WOTSpectralMeasure.mk.injEq] + exact hvm + +/-- The Cayley pushforward is injective on real spectral measures. Thus a real spectral measure +is completely recoverable from its bounded Cayley-side measure; this is the basic uniqueness +half of the Cayley equivalence used by the unbounded spectral theorem. -/ +lemma cayleyMap_injective {μS νS : WOTSpectralMeasure ℝ H} + (h : cayleyMap μS = cayleyMap νS) : μS = νS := by + calc + μS = cayleyInverseMap (cayleyMap μS) := + (cayleyInverseMap_cayleyMap μS).symm + _ = cayleyInverseMap (cayleyMap νS) := congrArg cayleyInverseMap h + _ = νS := cayleyInverseMap_cayleyMap νS + +/-! ## B. The Cayley equivalence of spectral-measure data -/ + +/-- The support condition which makes the inverse Cayley coordinate an actual inverse rather than +an arbitrary choice at the point representing infinity. -/ +def CayleySupported (ν : WOTSpectralMeasure ℂ H) : Prop := + ∀ S : Set ℂ, MeasurableSet S → + ν S = ν (S ∩ {z | ‖z‖ = 1 ∧ z ≠ 1}) + +lemma cayleyMap_cayleyInverseMap_of_supported + {ν : WOTSpectralMeasure ℂ H} (hν : CayleySupported ν) : + cayleyMap (cayleyInverseMap ν) = ν := by + rw [WOTSpectralMeasure.mk.injEq] + apply MeasureTheory.VectorMeasure.ext + intro S hS + change ((ν.map cayleyInverse measurable_cayleyInverse).map cayley measurable_cayley) S = ν S + rw [(ν.map cayleyInverse measurable_cayleyInverse).map_apply cayley measurable_cayley hS] + rw [ν.map_apply cayleyInverse measurable_cayleyInverse + (hS.preimage measurable_cayley)] + have hL : MeasurableSet (cayleyInverse ⁻¹' cayley ⁻¹' S) := + (hS.preimage measurable_cayley).preimage measurable_cayleyInverse + rw [hν _ hL, hν _ hS] + congr 1 + ext z + constructor + · rintro ⟨hz, hunit⟩ + refine ⟨?_, hunit⟩ + simpa [Set.mem_preimage, cayley_cayleyInverse hunit.1 hunit.2] using hz + · rintro ⟨hz, hunit⟩ + have hz' : cayley (cayleyInverse z) = z := cayley_cayleyInverse hunit.1 hunit.2 + refine ⟨?_, hunit⟩ + simpa [Set.mem_preimage, hz'] using hz + +lemma cayleyMap_cayleySupported (μS : WOTSpectralMeasure ℝ H) : + CayleySupported (cayleyMap μS) := by + have hne : MeasurableSet {z : ℂ | z ≠ 1} := by + rw [show {z : ℂ | z ≠ 1} = ({1} : Set ℂ)ᶜ by ext; simp] + exact (measurableSet_singleton (1 : ℂ)).compl + have hunit : MeasurableSet {z : ℂ | ‖z‖ = 1 ∧ z ≠ 1} := by + exact (measurableSet_eq_fun measurable_norm measurable_const).inter + hne + intro S hS + change (μS.map cayley measurable_cayley) S = + (μS.map cayley measurable_cayley) (S ∩ {z | ‖z‖ = 1 ∧ z ≠ 1}) + rw [μS.map_apply cayley measurable_cayley hS, + μS.map_apply cayley measurable_cayley + (MeasurableSet.inter hS hunit)] + congr 1 + ext x + constructor + · intro hx + exact ⟨hx, cayley_norm x, cayley_ne_one x⟩ + · exact fun hx => hx.1 + +/-- Cayley transport is an equivalence between real WOT spectral measures and complex WOT +spectral measures supported on the unit circle away from `1`. This is the reusable measure-level +core of the self-adjoint/unitary correspondence. -/ +def cayleyMeasureEquiv : + WOTSpectralMeasure ℝ H ≃ {ν : WOTSpectralMeasure ℂ H // CayleySupported ν} where + toFun μS := ⟨cayleyMap μS, cayleyMap_cayleySupported μS⟩ + invFun ν := cayleyInverseMap ν.1 + left_inv μS := cayleyInverseMap_cayleyMap μS + right_inv ν := Subtype.ext (cayleyMap_cayleyInverseMap_of_supported ν.property) + +lemma cayleyMap_weakIntegral {μS : WOTSpectralMeasure ℝ H} + (g : ℂ → ℝ) (x y : H) + (hg : AEStronglyMeasurable g ((μS.scalarMeasure x y).variation.map cayley)) + (hgi : (μS.scalarMeasure x y).Integrable (g ∘ cayley)) : + (cayleyMap μS).weakIntegral g x y = μS.weakIntegral (g ∘ cayley) x y := by + exact WOTSpectralMeasure.weakIntegral_map (μS := μS) cayley measurable_cayley g x y hg hgi + +end WOTSpectralMeasure +end QuantumMechanics + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/CayleySpectralData/Construction.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/CayleySpectralData/Construction.lean new file mode 100644 index 0000000000..36e6e98633 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/CayleySpectralData/Construction.lean @@ -0,0 +1,832 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.UnitaryInfra.SpectralMeasure +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.SpectralIntegral.SpecTheorem +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Cayley.Certificate +public import Mathlib.MeasureTheory.VectorMeasure.SetIntegral +public import Mathlib.MeasureTheory.VectorMeasure.WithDensityVec + +/-! +# Bounded spectral data for a Cayley transform: construction + +Builds the bounded normal spectral certificate for a Cayley unitary `cayleyBoundedOperator T` from +its continuous functional calculus, and specializes it to the case where `1` carries no spectral +mass, culminating in `cayleyRealSpectralMeasure`, the real spectral measure of the original +self-adjoint operator `T`. Continued in `CayleySpectralData/SpecTheorem.lean`, which assembles +this data into the self-adjoint spectral theorem itself. +-/ + +@[expose] public section + +noncomputable section + +open MeasureTheory Set Topology +open scoped ComplexOrder CStarAlgebra InnerProductSpace +open QuantumMechanics.WOTSpectralMeasure + +namespace QuantumMechanics + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] +/-- The real part of a spectral point of `U`, as a compactly supported continuous function on +`spectrum ℂ U`. -/ +def spectrumRealPart (U : H →L[ℂ] H) : + CompactlySupportedContinuousMap (spectrum ℂ U) ℝ := + ⟨⟨fun z => z.1.re, by fun_prop⟩, + hasCompactSupport_def.mpr + (IsCompact.of_isClosed_subset isCompact_univ (isClosed_tsupport _) (subset_univ _))⟩ + +/-- The imaginary part of a spectral point of `U`, as a compactly supported continuous function +on `spectrum ℂ U`. -/ +def spectrumImagPart (U : H →L[ℂ] H) : + CompactlySupportedContinuousMap (spectrum ℂ U) ℝ := + ⟨⟨fun z => z.1.im, by fun_prop⟩, + hasCompactSupport_def.mpr + (IsCompact.of_isClosed_subset isCompact_univ (isClosed_tsupport _) (subset_univ _))⟩ + +lemma cfcScalarMeasure_integral_spectrum_coe + (U : H →L[ℂ] H) (hU : IsStarNormal U) (v : H) : + ∫ z, (z.1 : ℂ) ∂cfcScalarMeasure U hU v = + ((∫ z, spectrumRealPart U z ∂cfcScalarMeasure U hU v : ℝ) : ℂ) + + Complex.I * ∫ z, spectrumImagPart U z ∂cfcScalarMeasure U hU v := by + have hf : Integrable (fun z : spectrum ℂ U => (z.1 : ℂ)) + (cfcScalarMeasure U hU v) := by + rw [← integrableOn_univ] + exact continuous_subtype_val.continuousOn.integrableOn_compact isCompact_univ + have hre : ∫ z, (z.1).re ∂cfcScalarMeasure U hU v = + RCLike.re ⟪v, cfcRealOperator U hU (spectrumRealPart U) v⟫_ℂ := by + simpa [spectrumRealPart] using + cfcScalarMeasure_integral U hU v (spectrumRealPart U) + have him : ∫ z, (z.1).im ∂cfcScalarMeasure U hU v = + RCLike.re ⟪v, cfcRealOperator U hU (spectrumImagPart U) v⟫_ℂ := by + simpa [spectrumImagPart] using + cfcScalarMeasure_integral U hU v (spectrumImagPart U) + rw [← integral_re_add_im hf] + change ((∫ z, (z.1).re ∂cfcScalarMeasure U hU v : ℝ) : ℂ) + + (∫ z, (z.1).im ∂cfcScalarMeasure U hU v : ℝ) * Complex.I = + ((∫ z, (z.1).re ∂cfcScalarMeasure U hU v : ℝ) : ℂ) + + Complex.I * ∫ z, (z.1).im ∂cfcScalarMeasure U hU v + rw [hre, him] + ring + +lemma polarizedCfcScalarMeasure_integral_spectrum_coe + (U : H →L[ℂ] H) (hU : IsStarNormal U) (x y : H) : + ∫ᵛ z, (z.1 : ℂ) ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); + polarizedCfcScalarMeasure (hU := hU) U x y] = + ⟪y, U x⟫_ℂ := by + let fC : spectrum ℂ U → ℂ := fun z => (z.1 : ℂ) + have hfC : Continuous fC := by fun_prop + have hplus : Integrable fC (cfcScalarMeasure U hU (x + y)) := by + rw [← integrableOn_univ] + exact hfC.continuousOn.integrableOn_compact isCompact_univ + have hminus : Integrable fC (cfcScalarMeasure U hU (x - y)) := by + rw [← integrableOn_univ] + exact hfC.continuousOn.integrableOn_compact isCompact_univ + have hip : Integrable fC + (cfcScalarMeasure U hU (x + Complex.I • y)) := by + rw [← integrableOn_univ] + exact hfC.continuousOn.integrableOn_compact isCompact_univ + have him : Integrable fC + (cfcScalarMeasure U hU (x - Complex.I • y)) := by + rw [← integrableOn_univ] + exact hfC.continuousOn.integrableOn_compact isCompact_univ + let μplus := cfcScalarMeasure U hU (x + y) + let μminus := cfcScalarMeasure U hU (x - y) + let νplus := cfcScalarMeasure U hU (x + Complex.I • y) + let νminus := cfcScalarMeasure U hU (x - Complex.I • y) + change ∫ᵛ z, fC z ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); + ((1 / 4 : ℝ) • (μplus.toSignedMeasure - μminus.toSignedMeasure)).toComplexMeasure + ((1 / 4 : ℝ) • (νplus.toSignedMeasure - νminus.toSignedMeasure))] = _ + have hreal : + (((1 / 4 : ℝ) • (μplus.toSignedMeasure - μminus.toSignedMeasure)).mapRange + Complex.ofRealCLM.toAddMonoidHom Complex.ofRealCLM.continuous).Integrable fC := by + rw [VectorMeasure.mapRange_smul, mapRange_sub_toSignedMeasure μplus μminus] + exact (integrable_mapRange_ofReal_signedMeasure μplus fC hplus).sub_vectorMeasure + (integrable_mapRange_ofReal_signedMeasure μminus fC hminus) |>.smul_vectorMeasure _ + have himag : + (((1 / 4 : ℝ) • (νplus.toSignedMeasure - νminus.toSignedMeasure)).mapRange + imaginaryOfRealCLM.toAddMonoidHom imaginaryOfRealCLM.continuous).Integrable fC := by + rw [VectorMeasure.mapRange_smul, mapRange_sub_toSignedMeasure νplus νminus] + exact (integrable_mapRange_imaginaryOfReal_signedMeasure νplus fC hip).sub_vectorMeasure + (integrable_mapRange_imaginaryOfReal_signedMeasure νminus fC him) |>.smul_vectorMeasure _ + rw [integral_toComplexMeasure_eq_add_mapRange _ _ fC hreal himag] + rw [integral_mapRange_ofReal_signedDifference μplus μminus (1 / 4 : ℝ) fC hplus hminus, + integral_mapRange_imaginaryOfReal_signedDifference νplus νminus (1 / 4 : ℝ) fC hip him] + have hJ (v : H) : + ∫ z, (z.1 : ℂ) ∂cfcScalarMeasure U hU v = + ((∫ z, spectrumRealPart U z ∂cfcScalarMeasure U hU v : ℝ) : ℂ) + + Complex.I * ∫ z, spectrumImagPart U z ∂cfcScalarMeasure U hU v := + cfcScalarMeasure_integral_spectrum_coe U hU v + rw [hJ, hJ, hJ, hJ] + have hre := polarizedCfcRealIntegral_eq_inner U hU (spectrumRealPart U) x y + have him' := polarizedCfcRealIntegral_eq_inner U hU (spectrumImagPart U) x y + have hsplit : + cfcRealOperator U hU (spectrumRealPart U) + + (Complex.I : ℂ) • (cfcRealOperator U hU (spectrumImagPart U)) = U := by + unfold cfcRealOperator + rw [← map_smul, ← map_add] + have hid : + realToComplexContinuousMap U (spectrumRealPart U) + + (Complex.I : ℂ) • realToComplexContinuousMap U (spectrumImagPart U) = + (ContinuousMap.id ℂ).restrict (spectrum ℂ U) := by + ext z + change (z.1.re : ℂ) + Complex.I * z.1.im = z.1 + rw [mul_comm] + exact Complex.re_add_im z.1 + calc + cfcHom hU (realToComplexContinuousMap U (spectrumRealPart U) + + Complex.I • realToComplexContinuousMap U (spectrumImagPart U)) = + cfcHom hU ((ContinuousMap.id ℂ).restrict (spectrum ℂ U)) := + congrArg (fun f => cfcHom hU f) hid + _ = U := cfcHom_id hU + have hfinal : + polarizedCfcRealIntegral U hU (spectrumRealPart U) x y + + Complex.I * polarizedCfcRealIntegral U hU (spectrumImagPart U) x y = + ⟪y, (cfcRealOperator U hU (spectrumRealPart U) + + (Complex.I : ℂ) • (cfcRealOperator U hU (spectrumImagPart U))) x⟫_ℂ := by + rw [hre, him'] + simp only [add_apply, smul_apply, inner_add_right, inner_smul_right] + calc + _ = polarizedCfcRealIntegral U hU (spectrumRealPart U) x y + + Complex.I * polarizedCfcRealIntegral U hU (spectrumImagPart U) x y := by + dsimp [polarizedCfcRealIntegral] + ring + _ = ⟪y, (cfcRealOperator U hU (spectrumRealPart U) + + (Complex.I : ℂ) • cfcRealOperator U hU (spectrumImagPart U)) x⟫_ℂ := hfinal + _ = ⟪y, U x⟫_ℂ := by rw [hsplit] + +/-- The Cayley unitary of `T`, as a bounded continuous linear map. -/ +def cayleyBoundedOperator (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) : H →L[ℂ] H := + (cayleyUnitary T hT).toLinearIsometry.toContinuousLinearMap + +lemma cayleyBoundedOperator_apply (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) (x : H) : + cayleyBoundedOperator T hT x = cayleyContinuousLinearMap T hT x := by + rfl + +lemma cayleyBoundedOperator_isStarNormal (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) : + IsStarNormal (cayleyBoundedOperator T hT) := by + let u := cayleyUnitary T hT + change IsStarNormal (u.toLinearIsometry.toContinuousLinearMap) + rw [isStarNormal_iff] + rw [show star u.toLinearIsometry.toContinuousLinearMap = + u.symm.toLinearIsometry.toContinuousLinearMap by + change star (u : H →L[ℂ] H) = (u.symm : H →L[ℂ] H) + exact u.star_eq_symm] + ext x + simp [ContinuousLinearMap.mul_def] + +lemma cayleyBoundedOperator_mem_unitary (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) : + cayleyBoundedOperator T hT ∈ unitary (H →L[ℂ] H) := by + let u := cayleyUnitary T hT + have hstar : star u.toLinearIsometry.toContinuousLinearMap = + u.symm.toLinearIsometry.toContinuousLinearMap := by + change star (u : H →L[ℂ] H) = (u.symm : H →L[ℂ] H) + exact u.star_eq_symm + rw [Unitary.mem_iff] + constructor + · change star u.toLinearIsometry.toContinuousLinearMap * + u.toLinearIsometry.toContinuousLinearMap = 1 + rw [hstar] + ext x + simp [ContinuousLinearMap.mul_def] + · change u.toLinearIsometry.toContinuousLinearMap * + star u.toLinearIsometry.toContinuousLinearMap = 1 + rw [hstar] + ext x + simp [ContinuousLinearMap.mul_def] + +/-- The pushforward of the Cayley unitary's continuous functional calculus spectral measure +along `spectrum ℂ U ↪ ℂ`. -/ +noncomputable def cayleyBoundedSpectralMeasure (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) : + QuantumMechanics.WOTSpectralMeasure ℂ H := + let U := cayleyBoundedOperator T hT + (cfcSpectralMeasure U (cayleyBoundedOperator_isStarNormal T hT)).map + (fun z : spectrum ℂ U => (z : ℂ)) measurable_subtype_coe + +lemma cfcSpectralMeasure_reconstruction_coe + (U : H →L[ℂ] H) (hU : IsStarNormal U) (x y : H) : + (cfcSpectralMeasure U hU).complexWeakIntegral + (fun z : spectrum ℂ U => (z.1 : ℂ)) x y = ⟪y, U x⟫_ℂ := by + unfold QuantumMechanics.WOTSpectralMeasure.complexWeakIntegral + rw [cfcSpectralMeasure_scalarMeasure] + exact polarizedCfcScalarMeasure_integral_spectrum_coe U hU x y + +/-! ## The generic bounded-normal wrapper + +The Riesz--Markov construction is carried out on the compact spectrum. The public spectral +certificate should expose a measure on the ambient scalar field, since that is what the later +functional-calculus and Cayley APIs consume. This wrapper performs exactly that harmless subtype +pushforward and does not impose any unitary or Cayley support hypothesis. +-/ + +lemma cfcSpectralMeasure_ambient_reconstruction + (U : H →L[ℂ] H) (hU : IsStarNormal U) (x y : H) : + ((cfcSpectralMeasure U hU).map + (fun z : spectrum ℂ U => (z : ℂ)) measurable_subtype_coe).complexWeakIntegral + id x y = ⟪y, U x⟫_ℂ := by + unfold QuantumMechanics.WOTSpectralMeasure.complexWeakIntegral + rw [QuantumMechanics.WOTSpectralMeasure.scalarMeasure_map] + rw [(MeasurableEmbedding.subtype_coe (spectrum.isClosed + U).measurableSet).integral_map_vectorMeasure] + change (cfcSpectralMeasure U hU).complexWeakIntegral + (fun z : spectrum ℂ U => (z.1 : ℂ)) x y = ⟪y, U x⟫_ℂ + exact cfcSpectralMeasure_reconstruction_coe U hU x y + +/-- The generic bounded normal spectral certificate for `U`, from its continuous functional +calculus. -/ +noncomputable def cfcBoundedNormalSpectralData + (U : H →L[ℂ] H) (hU : IsStarNormal U) : + QuantumMechanics.WOTSpectralMeasure.BoundedNormalSpectralData U where + spectralMeasure := (cfcSpectralMeasure U hU).map + (fun z : spectrum ℂ U => (z : ℂ)) measurable_subtype_coe + reconstruction := cfcSpectralMeasure_ambient_reconstruction U hU + +/-! A unitary with no spectral mass at `1` is now the exact input expected by the Cayley inverse. +The only extra work is the support calculation: the normal PVM is pushed forward from the compact +spectrum, and the spectrum of a unitary lies on the unit circle. -/ + +/-- The bounded unitary spectral certificate for a unitary with no spectral mass at `1`. -/ +noncomputable def cfcBoundedUnitarySpectralData + (u : H ≃ₗᵢ[ℂ] H) + (h1 : (1 : ℂ) ∉ spectrum ℂ (u : H →L[ℂ] H)) : + QuantumMechanics.WOTSpectralMeasure.BoundedUnitarySpectralData u := by + let hu : unitary (H →L[ℂ] H) := + (Unitary.linearIsometryEquiv (𝕜 := ℂ) (H := H)).symm u + let U : H →L[ℂ] H := u + have hU : IsStarNormal U := by + exact isStarNormal_of_mem_unitary (by simpa [U, hu] using hu.property) + let D := cfcBoundedNormalSpectralData U hU + have hsub : spectrum ℂ U ⊆ Metric.sphere 0 1 := by + simpa [U, hu] using (Unitary.spectrum_subset_circle hu) + have hsupport : ∀ S : Set ℂ, MeasurableSet S → + D.spectralMeasure S = D.spectralMeasure (S ∩ {z | ‖z‖ = 1 ∧ z ≠ 1}) := by + intro S hS + have hpre : (fun z : spectrum ℂ U => (z : ℂ)) ⁻¹' S = + (fun z : spectrum ℂ U => (z : ℂ)) ⁻¹' + (S ∩ {z | ‖z‖ = 1 ∧ z ≠ 1}) := by + ext z + constructor + · intro hz + have hzunit : (z : ℂ) ∈ Metric.sphere 0 1 := hsub z.property + have hznorm : ‖(z : ℂ)‖ = 1 := by + have := Metric.mem_sphere.mp hzunit + simpa [dist_zero_right] using this + have hznot : (z : ℂ) ≠ 1 := by + intro hz1 + apply h1 + simpa [U, hz1] using z.property + exact ⟨hz, hznorm, hznot⟩ + · intro hz + exact hz.1 + change (cfcSpectralMeasure U hU).map + (fun z : spectrum ℂ U => (z : ℂ)) measurable_subtype_coe S = + (cfcSpectralMeasure U hU).map + (fun z : spectrum ℂ U => (z : ℂ)) measurable_subtype_coe + (S ∩ {z | ‖z‖ = 1 ∧ z ≠ 1}) + calc + _ = (cfcSpectralMeasure U hU) + ((fun z : spectrum ℂ U => (z : ℂ)) ⁻¹' S) := + (cfcSpectralMeasure U hU).map_apply + (fun z : spectrum ℂ U => (z : ℂ)) measurable_subtype_coe hS + _ = (cfcSpectralMeasure U hU) + ((fun z : spectrum ℂ U => (z : ℂ)) ⁻¹' + (S ∩ {z | ‖z‖ = 1 ∧ z ≠ 1})) := congrArg _ hpre + _ = _ := ((cfcSpectralMeasure U hU).map_apply + (fun z : spectrum ℂ U => (z : ℂ)) measurable_subtype_coe (hS.inter + ((measurableSet_eq_fun measurable_norm measurable_const).inter + (measurableSet_singleton (1 : ℂ)).compl))).symm + exact { + spectralMeasure := D.spectralMeasure + support_away_one := hsupport + reconstruction := D.reconstruction + } + +lemma cayleyBoundedSpectralMeasure_reconstruction + (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) (x y : H) : + (cayleyBoundedSpectralMeasure T hT).complexWeakIntegral id x y = + ⟪y, cayleyBoundedOperator T hT x⟫_ℂ := by + let U := cayleyBoundedOperator T hT + let hU : IsStarNormal U := cayleyBoundedOperator_isStarNormal T hT + change ((cfcSpectralMeasure U hU).map + (fun z : spectrum ℂ U => (z : ℂ)) measurable_subtype_coe).complexWeakIntegral + id x y = _ + unfold QuantumMechanics.WOTSpectralMeasure.complexWeakIntegral + rw [QuantumMechanics.WOTSpectralMeasure.scalarMeasure_map] + rw [(MeasurableEmbedding.subtype_coe (spectrum.isClosed + U).measurableSet).integral_map_vectorMeasure] + change (cfcSpectralMeasure U hU).complexWeakIntegral + (fun z : spectrum ℂ U => (z.1 : ℂ)) x y = ⟪y, U x⟫_ℂ + exact cfcSpectralMeasure_reconstruction_coe U hU x y + +set_option maxHeartbeats 1000000 in +lemma cayleyBoundedSpectralMeasure_scalarMeasure_isFinite + (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) (x y : H) : + IsFiniteMeasure + ((cayleyBoundedSpectralMeasure T hT).scalarMeasure x y).variation := by + let U := cayleyBoundedOperator T hT + let hU : IsStarNormal U := cayleyBoundedOperator_isStarNormal T hT + have hp : IsFiniteMeasure + (polarizedCfcScalarMeasure (hU := hU) U x y).variation := + polarizedCfcScalarMeasure_isFiniteMeasure U hU x y + let : IsFiniteMeasure + (polarizedCfcScalarMeasure (hU := hU) U x y).variation := hp + change IsFiniteMeasure + (((cfcSpectralMeasure U hU).map + (fun z : spectrum ℂ U => (z : ℂ)) measurable_subtype_coe).scalarMeasure x y).variation + rw [QuantumMechanics.WOTSpectralMeasure.scalarMeasure_map] + rw [cfcSpectralMeasure_scalarMeasure] + infer_instance + +lemma atom_eigenvector_of_reconstruction + (E : QuantumMechanics.WOTSpectralMeasure ℂ H) (V : H →L[ℂ] H) + (hrec : ∀ x y : H, E.complexWeakIntegral id x y = ⟪y, V x⟫_ℂ) + {a : ℂ} (ha : MeasurableSet {a}) (x : H) + (hfinite : ∀ y : H, IsFiniteMeasure (E.scalarMeasure x y).variation) : + V (E {a} x) = a • E {a} x := by + apply ext_inner_left ℂ + intro y + let : IsFiniteMeasure (E.scalarMeasure x y).variation := hfinite y + let : IsFiniteMeasure ((E.scalarMeasure x y).restrict {a}).variation := by + rw [MeasureTheory.VectorMeasure.variation_restrict ha] + infer_instance + have hμ : E.scalarMeasure (E {a} x) y = (E.scalarMeasure x y).restrict {a} := by + apply MeasureTheory.VectorMeasure.ext + intro S hS + rw [QuantumMechanics.WOTSpectralMeasure.scalarMeasure_apply, + MeasureTheory.VectorMeasure.restrict_apply _ ha hS, + QuantumMechanics.WOTSpectralMeasure.scalarMeasure_apply] + change ⟪y, (E S * E {a}) x⟫_ℂ = _ + rw [E.comp_eq_of_inter hS ha] + rw [← hrec (E {a} x) y] + change (∫ᵛ z, id z ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); + E.scalarMeasure (E {a} x) y]) = _ + rw [hμ] + change (∫ᵛ z in {a}, id z ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); + E.scalarMeasure x y]) = _ + have hid : + (∫ᵛ z in {a}, id z ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); + E.scalarMeasure x y]) = + ∫ᵛ _ in {a}, a ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); + E.scalarMeasure x y] := by + apply VectorMeasure.integral_congr_ae + rw [MeasureTheory.VectorMeasure.variation_restrict ha] + filter_upwards [ae_restrict_mem ha] with z hz + simpa [Set.mem_singleton_iff] using hz + rw [hid] + change (∫ᵛ _ : ℂ, a ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); + (E.scalarMeasure x y).restrict {a}]) = _ + rw [VectorMeasure.integral_const] + rw [MeasureTheory.VectorMeasure.restrict_apply_univ] + rw [QuantumMechanics.WOTSpectralMeasure.scalarMeasure_apply] + simp [inner_smul_right] + +lemma cayleyBoundedSpectralMeasure_support_unit_circle + (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) (S : Set ℂ) (hS : MeasurableSet S) : + cayleyBoundedSpectralMeasure T hT S = + cayleyBoundedSpectralMeasure T hT (S ∩ {z | ‖z‖ = 1}) := by + let U := cayleyBoundedOperator T hT + let hU : IsStarNormal U := cayleyBoundedOperator_isStarNormal T hT + have hu : U ∈ unitary (H →L[ℂ] H) := cayleyBoundedOperator_mem_unitary T hT + change (cfcSpectralMeasure U hU).map + (fun z : spectrum ℂ U => (z : ℂ)) measurable_subtype_coe S = + (cfcSpectralMeasure U hU).map + (fun z : spectrum ℂ U => (z : ℂ)) measurable_subtype_coe (S ∩ {z | ‖z‖ = 1}) + change (cfcSpectralMeasure U hU).map + (fun z : spectrum ℂ U => (z : ℂ)) measurable_subtype_coe S = + (cfcSpectralMeasure U hU).map + (fun z : spectrum ℂ U => (z : ℂ)) measurable_subtype_coe + (S ∩ (fun z : ℂ => ‖z‖) ⁻¹' ({1} : Set ℝ)) + rw [(cfcSpectralMeasure U hU).map_apply + (fun z : spectrum ℂ U => (z : ℂ)) measurable_subtype_coe hS, + (cfcSpectralMeasure U hU).map_apply + (fun z : spectrum ℂ U => (z : ℂ)) measurable_subtype_coe + (hS.inter (((isClosed_singleton : IsClosed ({1} : Set ℝ)).preimage + continuous_norm).measurableSet))] + congr 1 + ext z + constructor + · intro hz + refine ⟨hz, ?_⟩ + exact spectrum.norm_eq_one_of_unitary hu z.property + · exact fun hz => hz.1 + +lemma cayleyBoundedOperator_one_eigenspace_eq_bot + (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) {x : H} + (hx : cayleyBoundedOperator T hT x = x) : x = 0 := by + have hres := LinearPMap.IsSelfAdjoint.mem_resolventSet_of_im_ne_zero hT + (z := -Complex.I) (by norm_num) + have heq : T - (-Complex.I) • 1 = T + Complex.I • 1 := by + exact LinearPMap.ext rfl fun z hz hz' => by + simp [LinearPMap.sub_apply, LinearPMap.add_apply, LinearPMap.smul_apply, neg_smul] + have hker : (T + Complex.I • 1).toFun.ker = ⊥ := by + rw [← heq] + exact hres.1 + have hrange : (T + Complex.I • 1).toFun.range = ⊤ := by + rw [← heq] + exact hres.2.1 + have hinvdom : (T + Complex.I • 1).inverse.domain = ⊤ := by + rw [LinearPMap.inverse_domain, hrange] + let xi : (T + Complex.I • 1).inverse.domain := + ⟨x, by rw [hinvdom]; exact Submodule.mem_top⟩ + have hxi : (T + Complex.I • 1).inverse xi ∈ (T + Complex.I • 1).domain := by + rw [← LinearPMap.inverse_range hker] + exact LinearMap.mem_range_self _ xi + let y : (T + Complex.I • 1).domain := + ⟨(T + Complex.I • 1).inverse xi, hxi⟩ + have hxrange : x ∈ (T + Complex.I • 1).toFun.range := by + rw [hrange] + exact Submodule.mem_top + obtain ⟨x₀, hx₀⟩ := hxrange + have hxy : (T + Complex.I • 1) x₀ = xi := by + change (T + Complex.I • 1) x₀ = x + exact hx₀ + have hinv₀ : (T + Complex.I • 1).inverse xi = x₀ := + LinearPMap.inverse_apply_eq hker hxy + have hy : (T + Complex.I • 1) y = x := by + have heq : y = x₀ := Subtype.ext hinv₀ + rw [heq] + exact hx₀ + have hminus : (T - Complex.I • 1) y = x := by + calc + (T - Complex.I • 1) y = cayleyContinuousLinearMap T hT x := by + symm + exact cayleyContinuousLinearMap_apply_of_mem_range hT y x hy + _ = cayleyBoundedOperator T hT x := by + rw [cayleyBoundedOperator_apply] + _ = x := hx + have hdiff : (T + Complex.I • 1) y - (T - Complex.I • 1) y = 0 := by + rw [hy, hminus] + simp + have hplusdom : (T + Complex.I • 1).domain = T.domain := by + simp [LinearPMap.add_domain] + let yt : T.domain := ⟨(y : H), by rw [← hplusdom]; exact y.property⟩ + have hdiff' : (T yt + Complex.I • (y : H)) - + (T yt - Complex.I • (y : H)) = 0 := by + simpa [LinearPMap.add_apply, LinearPMap.sub_apply, LinearPMap.smul_apply] using hdiff + have hy0 : (y : H) = 0 := by + have hscalar : (2 * Complex.I) • (y : H) = 0 := by + have heq : Complex.I • (y : H) = -(Complex.I • (y : H)) := by + apply add_left_cancel (a := T yt) + simpa [sub_eq_add_neg] using (sub_eq_zero.mp hdiff') + calc + (2 * Complex.I) • (y : H) = (Complex.I + Complex.I) • (y : H) := by module + _ = Complex.I • (y : H) + Complex.I • (y : H) := by rw [add_smul] + _ = Complex.I • (y : H) + -(Complex.I • (y : H)) := + congrArg (fun q => Complex.I • (y : H) + q) heq + _ = 0 := add_neg_cancel _ + exact (smul_eq_zero.mp hscalar).resolve_left (by norm_num) + calc + x = (T + Complex.I • 1) y := hy.symm + _ = 0 := by + have hy' : y = 0 := Subtype.ext hy0 + rw [hy'] + simp + +set_option maxHeartbeats 1000000 + +lemma cayleyBoundedSpectralMeasure_id_integrable + (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) (x y : H) : + ((cayleyBoundedSpectralMeasure T hT).scalarMeasure x y).Integrable id := by + let E := cayleyBoundedSpectralMeasure T hT + let C : Set ℂ := {z | ‖z‖ = 1} + have hC : MeasurableSet C := by + dsimp [C] + exact measurableSet_eq_fun measurable_norm measurable_const + have hfinite : IsFiniteMeasure (E.scalarMeasure x y).variation := by + exact cayleyBoundedSpectralMeasure_scalarMeasure_isFinite T hT x y + let := hfinite + have hrestrict : E.scalarMeasure x y = (E.scalarMeasure x y).restrict C := by + apply MeasureTheory.VectorMeasure.ext + intro S hS + rw [MeasureTheory.VectorMeasure.restrict_apply (E.scalarMeasure x y) hC hS] + rw [QuantumMechanics.WOTSpectralMeasure.scalarMeasure_apply, + QuantumMechanics.WOTSpectralMeasure.scalarMeasure_apply] + rw [cayleyBoundedSpectralMeasure_support_unit_circle T hT S hS] + rw [hrestrict] + change MeasureTheory.Integrable id ((E.scalarMeasure x y).restrict C).variation + rw [MeasureTheory.VectorMeasure.variation_restrict hC] + apply MeasureTheory.Integrable.of_bound measurable_id.aestronglyMeasurable 1 + filter_upwards [ae_restrict_mem hC] with z hz + calc + ‖z‖ = 1 := hz + _ ≤ 1 := le_rfl + +lemma cayleyBoundedSpectralMeasure_singleton_one + (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) : + cayleyBoundedSpectralMeasure T hT {1} = 0 := by + let U := cayleyBoundedOperator T hT + let hU : IsStarNormal U := cayleyBoundedOperator_isStarNormal T hT + let E := cayleyBoundedSpectralMeasure T hT + have hrec : ∀ x y : H, E.complexWeakIntegral id x y = ⟪y, U x⟫_ℂ := by + intro x y + exact cayleyBoundedSpectralMeasure_reconstruction T hT x y + apply ContinuousLinearMapWOT.ext_inner + intro x y + have hfinite : ∀ y : H, IsFiniteMeasure (E.scalarMeasure x y).variation := by + intro y + have hp : IsFiniteMeasure + (polarizedCfcScalarMeasure (hU := hU) U x y).variation := by + unfold polarizedCfcScalarMeasure + have hsub (a b : H) : IsFiniteMeasure + (((1 / 4 : ℝ) • ((cfcScalarMeasure U hU a).toSignedMeasure - + (cfcScalarMeasure U hU b).toSignedMeasure)).variation) := by + let : IsFiniteMeasure (cfcScalarMeasure U hU a).toSignedMeasure.variation := by + rw [Measure.variation_toSignedMeasure] + infer_instance + let : IsFiniteMeasure (cfcScalarMeasure U hU b).toSignedMeasure.variation := by + rw [Measure.variation_toSignedMeasure] + infer_instance + apply isFiniteMeasure_of_le + (cfcScalarMeasure U hU a + cfcScalarMeasure U hU b) + rw [MeasureTheory.VectorMeasure.variation_smul] + have hv : ((cfcScalarMeasure U hU a).toSignedMeasure - + (cfcScalarMeasure U hU b).toSignedMeasure).variation ≤ + cfcScalarMeasure U hU a + cfcScalarMeasure U hU b := by + simpa only [Measure.variation_toSignedMeasure] using + (MeasureTheory.VectorMeasure.variation_sub_le + (μ := (cfcScalarMeasure U hU a).toSignedMeasure) + (ν := (cfcScalarMeasure U hU b).toSignedMeasure)) + calc + ‖(1 / 4 : ℝ)‖₊ • + ((cfcScalarMeasure U hU a).toSignedMeasure - + (cfcScalarMeasure U hU b).toSignedMeasure).variation ≤ + (1 : ENNReal) • ((cfcScalarMeasure U hU a).toSignedMeasure - + (cfcScalarMeasure U hU b).toSignedMeasure).variation := by + change ((‖(1 / 4 : ℝ)‖₊ : NNReal) : ENNReal) • + ((cfcScalarMeasure U hU a).toSignedMeasure - + (cfcScalarMeasure U hU b).toSignedMeasure).variation ≤ + (1 : ENNReal) • ((cfcScalarMeasure U hU a).toSignedMeasure - + (cfcScalarMeasure U hU b).toSignedMeasure).variation + gcongr + norm_num + _ ≤ (1 : ENNReal) • (cfcScalarMeasure U hU a + cfcScalarMeasure U hU b) := by + simpa only [one_smul] using hv + _ = cfcScalarMeasure U hU a + cfcScalarMeasure U hU b := by simp + apply isFiniteMeasure_toComplexMeasure + let : IsFiniteMeasure + (polarizedCfcScalarMeasure (hU := hU) U x y).variation := hp + change IsFiniteMeasure + (((cfcSpectralMeasure U hU).map + (fun z : spectrum ℂ U => (z : ℂ)) measurable_subtype_coe).scalarMeasure x y).variation + rw [QuantumMechanics.WOTSpectralMeasure.scalarMeasure_map] + rw [cfcSpectralMeasure_scalarMeasure] + infer_instance + have hAtom := atom_eigenvector_of_reconstruction (a := (1 : ℂ)) E U hrec + (measurableSet_singleton (1 : ℂ)) x hfinite + have hzero : E {1} x = 0 := by + apply cayleyBoundedOperator_one_eigenspace_eq_bot T hT + simpa using hAtom + simpa [E] using congrArg (fun v : H => ⟪y, v⟫_ℂ) hzero + +lemma cayleyBoundedSpectralMeasure_support_away_one + (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) (S : Set ℂ) (hS : MeasurableSet S) : + cayleyBoundedSpectralMeasure T hT S = + cayleyBoundedSpectralMeasure T hT (S ∩ {z | ‖z‖ = 1 ∧ z ≠ 1}) := by + let E := cayleyBoundedSpectralMeasure T hT + have hC : MeasurableSet ({z : ℂ | ‖z‖ = 1}) := + ((isClosed_singleton : IsClosed ({1} : Set ℝ)).preimage continuous_norm).measurableSet + have h1 : MeasurableSet ({(1 : ℂ)} : Set ℂ) := measurableSet_singleton 1 + have hne : MeasurableSet ({z : ℂ | z ≠ 1}) := h1.compl + have hA : MeasurableSet (S ∩ {z : ℂ | ‖z‖ = 1}) := hS.inter hC + have hB : MeasurableSet (S ∩ {z : ℂ | ‖z‖ = 1} ∩ ({(1 : ℂ)} : Set ℂ)) := + (hS.inter hC).inter h1 + have hB' : MeasurableSet (S ∩ {z : ℂ | ‖z‖ = 1} ∩ {z : ℂ | z ≠ 1}) := + (hS.inter hC).inter hne + have hunion : + (S ∩ {z : ℂ | ‖z‖ = 1} ∩ {z : ℂ | z ≠ 1}) ∪ + (S ∩ {z : ℂ | ‖z‖ = 1} ∩ ({(1 : ℂ)} : Set ℂ)) = + S ∩ {z : ℂ | ‖z‖ = 1} := by + ext z + by_cases hz : z = 1 <;> simp [hz] + have hdisj : Disjoint + (S ∩ {z : ℂ | ‖z‖ = 1} ∩ {z : ℂ | z ≠ 1}) + (S ∩ {z : ℂ | ‖z‖ = 1} ∩ ({(1 : ℂ)} : Set ℂ)) := by + refine Set.disjoint_left.2 ?_ + intro z hz hz' + exact hz.2 hz'.2 + have hzeroB : E (S ∩ {z : ℂ | ‖z‖ = 1} ∩ ({(1 : ℂ)} : Set ℂ)) = 0 := by + have hcomp := E.comp_eq_of_inter hB h1 + have hinter : + (S ∩ {z : ℂ | ‖z‖ = 1} ∩ ({(1 : ℂ)} : Set ℂ)) ∩ ({(1 : ℂ)} : Set ℂ) = + S ∩ {z : ℂ | ‖z‖ = 1} ∩ ({(1 : ℂ)} : Set ℂ) := by + ext z + simp + rw [hinter, cayleyBoundedSpectralMeasure_singleton_one T hT] at hcomp + simpa using hcomp.symm + calc + E S = E (S ∩ {z : ℂ | ‖z‖ = 1}) := + cayleyBoundedSpectralMeasure_support_unit_circle T hT S hS + _ = E ((S ∩ {z : ℂ | ‖z‖ = 1} ∩ {z : ℂ | z ≠ 1}) ∪ + (S ∩ {z : ℂ | ‖z‖ = 1} ∩ ({(1 : ℂ)} : Set ℂ))) := by rw [hunion] + _ = E (S ∩ {z : ℂ | ‖z‖ = 1} ∩ {z : ℂ | z ≠ 1}) + + E (S ∩ {z : ℂ | ‖z‖ = 1} ∩ ({(1 : ℂ)} : Set ℂ)) := + E.of_union hdisj hB' hB + _ = E (S ∩ {z : ℂ | ‖z‖ = 1} ∩ {z : ℂ | z ≠ 1}) := by + rw [hzeroB] + simp + _ = E (S ∩ {z | ‖z‖ = 1 ∧ z ≠ 1}) := by + congr 1 + ext z + simp [and_left_comm, and_comm] + +lemma cayleyInverse_mul_one_sub_of_unit_circle + {z : ℂ} (hz : ‖z‖ = 1) (hz1 : z ≠ 1) : + (cayleyInverse z : ℂ) * (1 - z) = Complex.I * (1 + z) := by + let x : ℝ := cayleyInverse z + have hx : cayley x = z := by + exact cayley_cayleyInverse hz hz1 + change (x : ℂ) * (1 - z) = Complex.I * (1 + z) + rw [← hx] + unfold cayley + have hden : (x : ℂ) + Complex.I ≠ 0 := by + intro h + have hi := congrArg Complex.im h + norm_num at hi + field_simp [hden] + ring + +lemma cayley_domain_factorization + (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) (x : T.domain) : + ∃ v : H, + (x : H) = v - cayleyBoundedOperator T hT v ∧ + T x = Complex.I • (v + cayleyBoundedOperator T hT v) := by + let hplusdom : (T + Complex.I • 1).domain = T.domain := by + simp [LinearPMap.add_domain] + let xp : (T + Complex.I • 1).domain := + ⟨(x : H), by rw [hplusdom]; exact x.property⟩ + let a : H := (T + Complex.I • 1) xp + let v : H := (2 * Complex.I)⁻¹ • a + have ha : cayleyBoundedOperator T hT a = (T - Complex.I • 1) xp := by + rw [cayleyBoundedOperator_apply] + exact cayleyContinuousLinearMap_apply_of_mem_range hT xp a rfl + have h2i : (2 * Complex.I : ℂ) ≠ 0 := by norm_num + have hxpinf : (xp : H) ∈ T.domain ⊓ + (Complex.I • (1 : H →ₗ.[ℂ] H)).domain := by + rw [← LinearPMap.add_domain] + exact xp.property + have hxmem : (xp : H) ∈ T.domain ∧ + (xp : H) ∈ (Complex.I • (1 : H →ₗ.[ℂ] H)).domain := by + exact ⟨hxpinf.1, hxpinf.2⟩ + have hxpT : (⟨(xp : H), hxmem.1⟩ : T.domain) = x := by + apply Subtype.ext + rfl + have hxp_coe : (xp : H) = (x : H) := by + rfl + refine ⟨v, ?_, ?_⟩ + · dsimp [v, a] + rw [map_smul, ha] + field_simp [h2i] + simp [LinearPMap.sub_apply, LinearPMap.add_apply, LinearPMap.smul_apply, hxpT, + smul_add, smul_sub, smul_smul, div_eq_mul_inv, Complex.inv_I] + field_simp [h2i] + norm_num [Complex.I_sq, Complex.I_mul_I, pow_two] + simp [hxp_coe]; module + + · dsimp [v, a] + rw [map_smul, ha] + field_simp [h2i] + simp [LinearPMap.sub_apply, LinearPMap.add_apply, LinearPMap.smul_apply, hxpT, + smul_add, smul_sub, smul_smul, div_eq_mul_inv, Complex.inv_I] + field_simp [h2i] + norm_num [Complex.I_sq, Complex.I_mul_I, pow_two] + simp [hxp_coe]; module + +/-! ### A bounded extension of the Cayley difference multiplier + +The algebraic factor `1 - z` is bounded on the unit circle, which is the support of the +bounded Cayley spectral measure, but it is not bounded on all of `ℂ`. The bounded integral +API quite correctly asks for a global bound. We therefore use the zero extension outside the +closed unit disk; support reduction makes it equal to `1 - z` wherever the spectral measure +sees it. +-/ + +/-- `z ↦ 1 - z` on the unit circle, extended by zero elsewhere so it is globally bounded. -/ +def cayleyDifferenceMultiplier (z : ℂ) : ℂ := + if ‖z‖ = 1 then 1 - z else 0 + +lemma cayleyDifferenceMultiplier_measurable : + Measurable cayleyDifferenceMultiplier := by + unfold cayleyDifferenceMultiplier + exact Measurable.ite (measurableSet_eq_fun measurable_norm measurable_const) + (measurable_const.sub measurable_id) measurable_const + +lemma cayleyDifferenceMultiplier_bounded : + ∃ C : ℝ, ∀ z : ℂ, ‖cayleyDifferenceMultiplier z‖ ≤ C := by + refine ⟨2, fun z => ?_⟩ + by_cases hz : ‖z‖ = 1 + · simp [cayleyDifferenceMultiplier, hz] + exact (norm_sub_le _ _).trans (by norm_num; linarith) + · simp [cayleyDifferenceMultiplier, hz] + +lemma cayleyDifferenceMultiplier_eq_one_sub_of_unit_circle {z : ℂ} (hz : ‖z‖ = 1) : + cayleyDifferenceMultiplier z = 1 - z := by + simp [cayleyDifferenceMultiplier, hz] + +lemma boundedIntegral_cayleyDifferenceMultiplier_eq_sub + (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) : + QuantumMechanics.WOTSpectralMeasure.boundedIntegral (cayleyBoundedSpectralMeasure T hT) + cayleyDifferenceMultiplier cayleyDifferenceMultiplier_measurable + cayleyDifferenceMultiplier_bounded = + (1 : H →WOT[ℂ] H) - + ContinuousLinearMapWOT.ofCLM (cayleyBoundedOperator T hT) := by + apply ContinuousLinearMapWOT.ext_inner + intro x y + have hfinite := cayleyBoundedSpectralMeasure_scalarMeasure_isFinite T hT x y + let ν := (cayleyBoundedSpectralMeasure T hT).scalarMeasure x y + let A : Set ℂ := {z : ℂ | ‖z‖ = 1 ∧ z ≠ 1} + have hA : MeasurableSet A := by + dsimp [A] + exact (measurableSet_eq_fun measurable_norm measurable_const).inter + (measurableSet_singleton (1 : ℂ)).compl + have hνA : ν = ν.restrict {z : ℂ | ‖z‖ = 1 ∧ z ≠ 1} := by + apply MeasureTheory.VectorMeasure.ext + intro S hS + rw [MeasureTheory.VectorMeasure.restrict_apply ν + hA hS] + change ⟪y, (cayleyBoundedSpectralMeasure T hT) S x⟫_ℂ = + ⟪y, (cayleyBoundedSpectralMeasure T hT) + (S ∩ {z : ℂ | ‖z‖ = 1 ∧ z ≠ 1}) x⟫_ℂ + rw [cayleyBoundedSpectralMeasure_support_away_one T hT S hS] + have hνA' : ν = ν.restrict A := by simpa [A] using hνA + let := hfinite + have hA_ae : ∀ᵐ z ∂ν.variation, ‖z‖ = 1 ∧ z ≠ 1 := by + have hvar : ν.variation = (ν.restrict A).variation := congrArg + MeasureTheory.VectorMeasure.variation hνA' + rw [hvar, MeasureTheory.VectorMeasure.variation_restrict hA] + exact ae_restrict_mem hA + have hq_ae : cayleyDifferenceMultiplier =ᵐ[ν.variation] + (fun z : ℂ => (1 : ℂ) - z) := by + filter_upwards [hA_ae] with z hz + exact cayleyDifferenceMultiplier_eq_one_sub_of_unit_circle hz.1 + have hconst : ν.Integrable (fun _ : ℂ => (1 : ℂ)) := by + exact MeasureTheory.integrable_const (μ := ν.variation) (c := (1 : ℂ)) + have hfi : ν.Integrable id := + cayleyBoundedSpectralMeasure_id_integrable T hT x y + have hq : ν.Integrable (fun z : ℂ => (1 : ℂ) - z) := hconst.sub hfi + have hqbd : ν.Integrable cayleyDifferenceMultiplier := by + exact hq.congr hq_ae.symm + have hqint : ∫ᵛ z, cayleyDifferenceMultiplier z ∂[ + ContinuousLinearMap.lsmul ℝ ℂ; ν] = + ∫ᵛ z, ((1 : ℂ) - z) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ; ν] := + VectorMeasure.integral_congr_ae hq_ae + have hsub : ∫ᵛ z, ((1 : ℂ) - z) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ; ν] = + ⟪y, x⟫_ℂ - ⟪y, cayleyBoundedOperator T hT x⟫_ℂ := by + have hdiff : ν.Integrable (fun z : ℂ => (1 : ℂ) - z) := hq + change ∫ᵛ z, ((fun _ : ℂ => (1 : ℂ)) z - id z) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ; ν] = _ + rw [VectorMeasure.integral_fun_sub hconst hfi] + rw [VectorMeasure.integral_const] + rw [QuantumMechanics.WOTSpectralMeasure.scalarMeasure_apply] + rw [QuantumMechanics.WOTSpectralMeasure.univ] + simp only [ContinuousLinearMap.lsmul_apply, one_smul] + change ⟪y, x⟫_ℂ - (∫ᵛ z, id z ∂[ + ContinuousLinearMap.lsmul ℝ ℂ; ν]) = _ + rw [show (∫ᵛ z, id z ∂[ + ContinuousLinearMap.lsmul ℝ ℂ; ν]) = + ⟪y, cayleyBoundedOperator T hT x⟫_ℂ by + change (cayleyBoundedSpectralMeasure T hT).complexWeakIntegral id x y = _ + exact cayleyBoundedSpectralMeasure_reconstruction T hT x y] + change ⟪y, QuantumMechanics.WOTSpectralMeasure.boundedIntegral + (cayleyBoundedSpectralMeasure T hT) + cayleyDifferenceMultiplier cayleyDifferenceMultiplier_measurable + cayleyDifferenceMultiplier_bounded x⟫_ℂ = _ + rw [QuantumMechanics.WOTSpectralMeasure.boundedIntegral_inner + (cayleyBoundedSpectralMeasure T hT) cayleyDifferenceMultiplier_measurable + cayleyDifferenceMultiplier_bounded x y hfinite] + rw [hqint, hsub] + simp [inner_sub_right] + +/-- The bounded unitary spectral certificate for `T`'s Cayley unitary. -/ +noncomputable def cayleyBoundedUnitarySpectralData + (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) : + QuantumMechanics.WOTSpectralMeasure.BoundedUnitarySpectralData + (cayleyUnitary T hT) where + spectralMeasure := cayleyBoundedSpectralMeasure T hT + support_away_one := fun S hS => cayleyBoundedSpectralMeasure_support_away_one T hT S hS + reconstruction := by + intro x y + simpa [cayleyUnitary_apply, cayleyBoundedOperator_apply] using + cayleyBoundedSpectralMeasure_reconstruction T hT x y + +/-- The real spectral measure of `T`, transported from its Cayley unitary's bounded unitary +spectral data. -/ +noncomputable def cayleyRealSpectralMeasure + (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) : + QuantumMechanics.WOTSpectralMeasure ℝ H := + (cayleyBoundedUnitarySpectralData T hT).realSpectralMeasure + +lemma cayleyMap_cayleyRealSpectralMeasure + (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) : + QuantumMechanics.WOTSpectralMeasure.cayleyMap (cayleyRealSpectralMeasure T hT) = + cayleyBoundedSpectralMeasure T hT := by + exact (cayleyBoundedUnitarySpectralData T hT).cayleyMap_realSpectralMeasure + +end QuantumMechanics + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/CayleySpectralData/SpecTheorem.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/CayleySpectralData/SpecTheorem.lean new file mode 100644 index 0000000000..607f97c45e --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/CayleySpectralData/SpecTheorem.lean @@ -0,0 +1,857 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.CayleySpectralData.Construction +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.SelfAdjointSpectralTheorem + +/-! +# Bounded spectral data for a Cayley transform: the self-adjoint spectral theorem + +Continues `CayleySpectralData/Construction.lean`: transports its bounded spectral certificate back +through the Cayley transform to `cayleyRealSpectralMeasure`, proves the resulting measure is a +weak spectral resolution of the original self-adjoint operator, and assembles +`unboundedSpectralTheorem` — the public unbounded spectral theorem for a self-adjoint `LinearPMap` +— together with its essentially-self-adjoint variant. +-/ + +@[expose] public section + +noncomputable section + +open MeasureTheory Set Topology +open scoped ComplexOrder CStarAlgebra InnerProductSpace +open QuantumMechanics.WOTSpectralMeasure + +namespace QuantumMechanics + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +lemma cayleyRealSpectralMeasure_mem_domain + (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) (x : T.domain) : + (x : H) ∈ spectralSquareMomentDomain + (cayleyRealSpectralMeasure T hT) := by + let E := cayleyBoundedSpectralMeasure T hT + let q := cayleyDifferenceMultiplier + obtain ⟨v, hx, _⟩ := cayley_domain_factorization T hT x + have hqv : QuantumMechanics.WOTSpectralMeasure.boundedIntegral E q + cayleyDifferenceMultiplier_measurable cayleyDifferenceMultiplier_bounded v = + v - cayleyBoundedOperator T hT v := by + have h := congrArg (fun A : H →WOT[ℂ] H => A v) + (boundedIntegral_cayleyDifferenceMultiplier_eq_sub T hT) + simpa [E, q] using h + have hxeq : (x : H) = QuantumMechanics.WOTSpectralMeasure.boundedIntegral E q + cayleyDifferenceMultiplier_measurable cayleyDifferenceMultiplier_bounded v := + hx.trans hqv.symm + have hdiag : E.diagonalMeasure ((x : H)) = + Measure.withDensity (E.diagonalMeasure v) + (fun z => ENNReal.ofReal (‖q z‖ ^ 2)) := by + rw [hxeq] + exact QuantumMechanics.WOTSpectralMeasure.diagonalMeasure_boundedIntegral_eq_withDensity E + cayleyDifferenceMultiplier_measurable cayleyDifferenceMultiplier_bounded v + let A : Set ℂ := {z : ℂ | ‖z‖ = 1 ∧ z ≠ 1} + have hA : MeasurableSet A := by + dsimp [A] + exact (measurableSet_eq_fun measurable_norm measurable_const).inter + (measurableSet_singleton (1 : ℂ)).compl + have hdiagA : E.diagonalMeasure v = (E.diagonalMeasure v).restrict A := by + apply Measure.ext + intro S hS + rw [MeasureTheory.Measure.restrict_apply hS] + rw [E.diagonalMeasure_apply_eq_norm_sq v S hS, + E.diagonalMeasure_apply_eq_norm_sq v (S ∩ A) (hS.inter hA)] + have hs := cayleyBoundedSpectralMeasure_support_away_one T hT S hS + have hvec : (E S) v = (E (S ∩ A)) v := by + simpa [A] using congrArg (fun P : H →WOT[ℂ] H => P v) hs + rw [hvec] + have hA_ae : ∀ᵐ z ∂E.diagonalMeasure v, z ∈ A := by + rw [hdiagA] + exact ae_restrict_mem hA + have hbase : Integrable (fun z : ℂ => (cayleyInverse z) ^ 2) + (E.diagonalMeasure ((x : H))) := by + rw [hdiag] + let d : ℂ → ENNReal := fun z => ENNReal.ofReal (‖q z‖ ^ 2) + have hd : Measurable d := ENNReal.continuous_ofReal.measurable.comp + (cayleyDifferenceMultiplier_measurable.norm.pow_const 2) + have hd_top : ∀ᵐ z ∂E.diagonalMeasure v, d z < (⊤ : ENNReal) := by + filter_upwards [] with z + exact (lt_top_iff_ne_top).2 (ENNReal.ofReal_ne_top) + apply (integrable_withDensity_iff_integrable_smul₀' hd.aemeasurable hd_top).2 + have hmeas : AEStronglyMeasurable (fun z : ℂ => + (d z).toReal • (cayleyInverse z) ^ 2) (E.diagonalMeasure v) := by + change AEStronglyMeasurable + ((fun z : ℂ => (d z).toReal) * (fun z : ℂ => (cayleyInverse z) ^ 2)) + (E.diagonalMeasure v) + exact hd.ennreal_toReal.aestronglyMeasurable.mul + (measurable_cayleyInverse.pow_const 2).aestronglyMeasurable + apply Integrable.of_bound hmeas 4 + filter_upwards [hA_ae] with z hz + have hzid := cayleyInverse_mul_one_sub_of_unit_circle hz.1 hz.2 + have hqz : q z = 1 - z := cayleyDifferenceMultiplier_eq_one_sub_of_unit_circle hz.1 + rw [norm_smul, Real.norm_eq_abs, abs_of_nonneg ENNReal.toReal_nonneg] + simp only [Real.norm_eq_abs, abs_of_nonneg (sq_nonneg (cayleyInverse z))] + rw [show d z = ENNReal.ofReal (‖1 - z‖ ^ 2) by + dsimp [d] + rw [hqz], + ENNReal.toReal_ofReal (sq_nonneg ‖1 - z‖)] + have hprod : ‖(cayleyInverse z : ℂ) * (1 - z)‖ ≤ 2 := by + rw [hzid] + calc + ‖Complex.I * (1 + z)‖ = ‖1 + z‖ := by rw [norm_mul]; simp + _ ≤ ‖(1 : ℂ)‖ + ‖z‖ := norm_add_le _ _ + _ = 2 := by rw [hz.1]; norm_num + rw [norm_mul, Complex.norm_real, Real.norm_eq_abs] at hprod + have hprod_nonneg : 0 ≤ |cayleyInverse z| * ‖1 - z‖ := + mul_nonneg (abs_nonneg _) (norm_nonneg _) + have hsq := (sq_le_sq₀ hprod_nonneg (by norm_num : (0 : ℝ) ≤ 2)).mpr hprod + calc + ‖1 - z‖ ^ 2 * cayleyInverse z ^ 2 = + (|cayleyInverse z| * ‖1 - z‖) ^ 2 := by + rw [mul_pow, sq_abs] + ring + _ ≤ 2 ^ 2 := hsq + _ = 4 := by norm_num + rw [mem_spectralSquareMomentDomain_iff] + rw [show (cayleyRealSpectralMeasure T hT).diagonalMeasure (x : H) = + Measure.map cayleyInverse (E.diagonalMeasure (x : H)) by + change (E.map cayleyInverse measurable_cayleyInverse).diagonalMeasure (x : H) = _ + exact E.diagonalMeasure_map cayleyInverse measurable_cayleyInverse (x : H)] + apply (integrable_map_measure + ((measurable_id.pow_const 2).aestronglyMeasurable) + measurable_cayleyInverse.aemeasurable).2 + simpa [Function.comp_def] using hbase + +/-! ### Restriction identities for PVM scalar measures + +These identities are independent of the Cayley transform. They express the elementary fact +that testing a projection-valued measure after applying one of its projections restricts the +corresponding scalar measure. They are the bookkeeping lemmas needed when a bounded spectral +moment is localized to a measurable spectral set. +-/ + +lemma WOTSpectralMeasure.scalarMeasure_proj_left_restrict + {α : Type*} [MeasurableSpace α] + (μ : QuantumMechanics.WOTSpectralMeasure α H) {S : Set α} (hS : MeasurableSet S) + (x y : H) : + μ.scalarMeasure (μ S x) y = (μ.scalarMeasure x y).restrict S := by + apply MeasureTheory.VectorMeasure.ext + intro A hA + change μ.scalarMeasure (μ S x) y A = (μ.scalarMeasure x y).restrict S A + rw [MeasureTheory.VectorMeasure.restrict_apply (μ.scalarMeasure x y) hS hA] + rw [QuantumMechanics.WOTSpectralMeasure.scalarMeasure_apply, + QuantumMechanics.WOTSpectralMeasure.scalarMeasure_apply] + change ⟪y, (μ A * μ S) x⟫_ℂ = _ + rw [μ.comp_eq_of_inter hA hS] + +lemma WOTSpectralMeasure.scalarMeasure_proj_right_restrict + {α : Type*} [MeasurableSpace α] + (μ : QuantumMechanics.WOTSpectralMeasure α H) {S : Set α} (hS : MeasurableSet S) + (x y : H) : + μ.scalarMeasure x (μ S y) = (μ.scalarMeasure x y).restrict S := by + apply MeasureTheory.VectorMeasure.ext + intro A hA + change μ.scalarMeasure x (μ S y) A = (μ.scalarMeasure x y).restrict S A + rw [MeasureTheory.VectorMeasure.restrict_apply (μ.scalarMeasure x y) hS hA] + rw [QuantumMechanics.WOTSpectralMeasure.scalarMeasure_apply, + QuantumMechanics.WOTSpectralMeasure.scalarMeasure_apply] + calc + ⟪μ S y, μ A x⟫_ℂ = ⟪y, μ S (μ A x)⟫_ℂ := by + change ⟪ContinuousLinearMapWOT.toCLM (μ S) y, μ A x⟫_ℂ = + ⟪y, ContinuousLinearMapWOT.toCLM (μ S) (μ A x)⟫_ℂ + have hstar : star (ContinuousLinearMapWOT.toCLM (μ S)) = + ContinuousLinearMapWOT.toCLM (μ S) := + congrArg ContinuousLinearMapWOT.toCLM (μ.isStarProjection S).isSelfAdjoint + have hstar' : ContinuousLinearMap.adjoint (ContinuousLinearMapWOT.toCLM (μ S)) = + ContinuousLinearMapWOT.toCLM (μ S) := by + rw [← ContinuousLinearMap.star_eq_adjoint] + exact hstar + calc + ⟪ContinuousLinearMapWOT.toCLM (μ S) y, μ A x⟫_ℂ = + ⟪ContinuousLinearMap.adjoint (ContinuousLinearMapWOT.toCLM (μ S)) y, + μ A x⟫_ℂ := by rw [hstar'] + _ = ⟪y, ContinuousLinearMapWOT.toCLM (μ S) (μ A x)⟫_ℂ := + ContinuousLinearMap.adjoint_inner_left (ContinuousLinearMapWOT.toCLM (μ S)) + (μ A x) y + _ = ⟪y, (μ S * μ A) x⟫_ℂ := rfl + _ = ⟪y, μ (S ∩ A) x⟫_ℂ := by + rw [μ.comp_eq_of_inter hS hA] + _ = ⟪y, μ (A ∩ S) x⟫_ℂ := by rw [inter_comm] + _ = _ := rfl + +@[nolint unusedArguments] +lemma WOTSpectralMeasure.complexWeakIntegral_proj_left + {α : Type*} [MeasurableSpace α] + (μ : QuantumMechanics.WOTSpectralMeasure α H) {S : Set α} (hS : MeasurableSet S) + (g : α → ℂ) (x y : H) + (_hgi : (μ.scalarMeasure x y).Integrable g) : + μ.complexWeakIntegral g (μ S x) y = + ∫ᵛ z, Set.indicator S g z ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); + μ.scalarMeasure x y] := by + unfold QuantumMechanics.WOTSpectralMeasure.complexWeakIntegral + rw [WOTSpectralMeasure.scalarMeasure_proj_left_restrict μ hS] + exact (MeasureTheory.VectorMeasure.integral_indicator + (μ := μ.scalarMeasure x y) (f := g) hS).symm + +@[nolint unusedArguments] +lemma WOTSpectralMeasure.complexWeakIntegral_proj_right + {α : Type*} [MeasurableSpace α] + (μ : QuantumMechanics.WOTSpectralMeasure α H) {S : Set α} (hS : MeasurableSet S) + (g : α → ℂ) (x y : H) + (_hgi : (μ.scalarMeasure x y).Integrable g) : + μ.complexWeakIntegral g x (μ S y) = + ∫ᵛ z, Set.indicator S g z ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); + μ.scalarMeasure x y] := by + unfold QuantumMechanics.WOTSpectralMeasure.complexWeakIntegral + rw [WOTSpectralMeasure.scalarMeasure_proj_right_restrict μ hS] + exact (MeasureTheory.VectorMeasure.integral_indicator + (μ := μ.scalarMeasure x y) (f := g) hS).symm + +lemma WOTSpectralMeasure.reconstruction_commutes_projection + {α : Type*} [MeasurableSpace α] + (μ : QuantumMechanics.WOTSpectralMeasure α H) (U : H →L[ℂ] H) + (f : α → ℂ) + (hrec : ∀ x y, μ.complexWeakIntegral f x y = ⟪y, U x⟫_ℂ) + (hfi : ∀ x y, (μ.scalarMeasure x y).Integrable f) + {S : Set α} (hS : MeasurableSet S) : + μ S * ContinuousLinearMapWOT.ofCLM U = + ContinuousLinearMapWOT.ofCLM U * μ S := by + apply ContinuousLinearMapWOT.ext_inner + intro x y + have hstar : star (ContinuousLinearMapWOT.toCLM (μ S)) = + ContinuousLinearMapWOT.toCLM (μ S) := + congrArg ContinuousLinearMapWOT.toCLM (μ.isStarProjection S).isSelfAdjoint + have hstar' : ContinuousLinearMap.adjoint (ContinuousLinearMapWOT.toCLM (μ S)) = + ContinuousLinearMapWOT.toCLM (μ S) := by + rw [← ContinuousLinearMap.star_eq_adjoint] + exact hstar + have hproj : ⟪y, μ S (U x)⟫_ℂ = ⟪μ S y, U x⟫_ℂ := by + change ⟪y, ContinuousLinearMapWOT.toCLM (μ S) (U x)⟫_ℂ = + ⟪ContinuousLinearMapWOT.toCLM (μ S) y, U x⟫_ℂ + calc + ⟪y, ContinuousLinearMapWOT.toCLM (μ S) (U x)⟫_ℂ = + ⟪y, ContinuousLinearMap.adjoint (ContinuousLinearMapWOT.toCLM (μ S)) + (U x)⟫_ℂ := by rw [hstar'] + _ = ⟪ContinuousLinearMapWOT.toCLM (μ S) y, U x⟫_ℂ := + ContinuousLinearMap.adjoint_inner_right + (ContinuousLinearMapWOT.toCLM (μ S)) y (U x) + calc + ⟪y, (μ S * ContinuousLinearMapWOT.ofCLM U) x⟫_ℂ = + ⟪y, μ S (U x)⟫_ℂ := rfl + _ = ⟪μ S y, U x⟫_ℂ := hproj + _ = μ.complexWeakIntegral f x (μ S y) := (hrec x (μ S y)).symm + _ = ∫ᵛ z, Set.indicator S f z ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); + μ.scalarMeasure x y] := by + exact WOTSpectralMeasure.complexWeakIntegral_proj_right μ hS f x y (hfi x y) + _ = μ.complexWeakIntegral f (μ S x) y := by + symm + exact WOTSpectralMeasure.complexWeakIntegral_proj_left μ hS f x y (hfi x y) + _ = ⟪y, U (μ S x)⟫_ℂ := hrec (μ S x) y + _ = ⟪y, (ContinuousLinearMapWOT.ofCLM U * μ S) x⟫_ℂ := rfl + +lemma WOTSpectralMeasure.complexWeakIntegral_one_sub + (μ : QuantumMechanics.WOTSpectralMeasure ℂ H) (U : H →L[ℂ] H) + (hrec : ∀ x y, μ.complexWeakIntegral id x y = ⟪y, U x⟫_ℂ) + (hfi : ∀ x y, (μ.scalarMeasure x y).Integrable id) + (hfinite : ∀ x y, IsFiniteMeasure (μ.scalarMeasure x y).variation) (x y : H) : + μ.complexWeakIntegral (fun z => (1 : ℂ) - z) x y = + ⟪y, x - U x⟫_ℂ := by + let := hfinite x y + have hconst : (μ.scalarMeasure x y).Integrable (fun _ : ℂ => (1 : ℂ)) := by + change Integrable (fun _ : ℂ => (1 : ℂ)) (μ.scalarMeasure x y).variation + exact MeasureTheory.integrable_const (μ := (μ.scalarMeasure x y).variation) (c := (1 : ℂ)) + have hsub : (μ.scalarMeasure x y).Integrable (fun z => (1 : ℂ) - z) := by + exact hconst.sub (hfi x y) + unfold QuantumMechanics.WOTSpectralMeasure.complexWeakIntegral + have hfun : (fun z : ℂ => (1 : ℂ) - z) = (fun _ : ℂ => (1 : ℂ)) - id := by + funext z + simp + rw [hfun] + rw [VectorMeasure.integral_sub (μ := μ.scalarMeasure x y) + (B := ContinuousLinearMap.lsmul ℝ ℂ) hconst (hfi x y)] + rw [VectorMeasure.integral_const] + rw [QuantumMechanics.WOTSpectralMeasure.scalarMeasure_apply] + simp only [μ.univ, ContinuousLinearMap.lsmul_apply, one_smul] + have hid : (∫ᵛ z, id z ∂[ContinuousLinearMap.lsmul ℝ ℂ; + μ.scalarMeasure x y]) = ⟪y, U x⟫_ℂ := by + change μ.complexWeakIntegral id x y = _ + exact hrec x y + rw [hid] + change ⟪y, x⟫_ℂ - ⟪y, U x⟫_ℂ = _ + rw [inner_sub_right] + +lemma WOTSpectralMeasure.scalarMeasure_domain_factorization + (μ : QuantumMechanics.WOTSpectralMeasure ℂ H) (U : H →L[ℂ] H) + (hrec : ∀ x y, μ.complexWeakIntegral id x y = ⟪y, U x⟫_ℂ) + (hfi : ∀ x y, (μ.scalarMeasure x y).Integrable id) + (hfinite : ∀ x y, IsFiniteMeasure (μ.scalarMeasure x y).variation) + (hcomm : ∀ {S : Set ℂ}, MeasurableSet S → + μ S * ContinuousLinearMapWOT.ofCLM U = + ContinuousLinearMapWOT.ofCLM U * μ S) + (x v y : H) (hx : x = v - U v) {S : Set ℂ} (hS : MeasurableSet S) : + μ.scalarMeasure x y S = + μ.complexWeakIntegral (fun z => (1 : ℂ) - z) (μ S v) y := by + rw [QuantumMechanics.WOTSpectralMeasure.scalarMeasure_apply, hx, map_sub] + have hcommv := congrArg (fun A : H →WOT[ℂ] H => A v) (hcomm hS) + change μ S (U v) = U (μ S v) at hcommv + rw [hcommv] + exact (WOTSpectralMeasure.complexWeakIntegral_one_sub μ U hrec hfi hfinite + (μ S v) y).symm + +/-! ### Complex vector-measure density transport + +The scalar measures of a complex PVM are complex vector measures, rather than positive +measures. This is the reusable density-integral theorem needed by the inverse Cayley step. +-/ + +set_option maxHeartbeats 3000000 in +lemma VectorMeasure.integral_real_withDensity_mul + {α : Type*} [MeasurableSpace α] (μ : MeasureTheory.VectorMeasure α ℂ) + {q : α → ℂ} (hq : μ.Integrable q) {g : α → ℝ} + (hg : (μ.withDensity q (ContinuousLinearMap.mul ℝ ℂ)).Integrable g) + (hvar0 : (μ.withDensity q (ContinuousLinearMap.mul ℝ ℂ)).variation = + μ.variation.withDensity (fun x => ‖q x‖ₑ)) : + ∫ᵛ x, g x ∂[ContinuousLinearMap.lsmul ℝ ℝ (E := ℂ); + μ.withDensity q (ContinuousLinearMap.mul ℝ ℂ)] = + ∫ᵛ x, (g x : ℂ) * q x ∂[ContinuousLinearMap.lsmul ℝ ℂ; μ] := by + let B : ℂ →L[ℝ] ℂ →L[ℝ] ℂ := ContinuousLinearMap.mul ℝ ℂ + have hmul : B = ContinuousLinearMap.lsmul ℝ ℂ := by + ext z w + simp [B, ContinuousLinearMap.mul_apply', ContinuousLinearMap.lsmul_apply, smul_eq_mul] + have hvar : + (μ.withDensity q B).variation = μ.variation.withDensity (fun x => ‖q x‖ₑ) := by + simpa [B] using hvar0 + have hq_lt : ∀ᵐ x ∂μ.variation, ‖q x‖ₑ < ⊤ := by + filter_upwards with x + exact (lt_top_iff_ne_top).2 enorm_ne_top + have bridge : ∀ {f : α → ℝ}, + (μ.withDensity q B).Integrable f → + Integrable (fun x => (f x : ℂ) * q x) μ.variation := by + intro f hf + have hfd : Integrable f (μ.variation.withDensity (fun x => ‖q x‖ₑ)) := by + change Integrable f (μ.withDensity q B).variation at hf + rw [hvar] at hf + exact hf + have hweighted : Integrable + (fun x => (‖q x‖ₑ).toReal • f x) μ.variation := + (integrable_withDensity_iff_integrable_smul₀' + hq.aestronglyMeasurable.enorm hq_lt).1 hfd + have hmeas : AEStronglyMeasurable (fun x => (f x : ℂ) * q x) μ.variation := by + have hqmeas : AEStronglyMeasurable q μ.variation := hq.aestronglyMeasurable + have hnormmeas : AEStronglyMeasurable (fun x => ‖q x‖) μ.variation := + hqmeas.norm + let u : α → ℂ := fun x => (‖q x‖ : ℝ)⁻¹ • q x + have hu : AEStronglyMeasurable u μ.variation := + hnormmeas.inv₀.smul hqmeas + have haux' : AEStronglyMeasurable + (fun x => ((‖q x‖ₑ).toReal • f x : ℂ) * u x) μ.variation := by + convert (Complex.ofRealCLM.continuous.comp_aestronglyMeasurable + hweighted.aestronglyMeasurable).mul hu using 1 + funext x; simp [Complex.ofRealCLM_apply, smul_eq_mul] + have haux := haux' + apply haux.congr + filter_upwards with x + by_cases hqx : q x = 0 + · simp [u, hqx] + · dsimp [u] + rw [show (‖q x‖ₑ).toReal = ‖q x‖ by simp [enorm_eq_nnnorm]] + have hn : (‖q x‖ : ℂ) ≠ 0 := by + exact_mod_cast (norm_ne_zero_iff.mpr hqx) + calc + (‖q x‖ : ℂ) * (f x : ℂ) * (((‖q x‖⁻¹ : ℝ) : ℂ) * q x) = + (‖q x‖ : ℂ) * (f x : ℂ) * ((‖q x‖ : ℂ)⁻¹ * q x) := by + rw [Complex.ofReal_inv] + _ = + (f x : ℂ) * ((‖q x‖ : ℂ) * (‖q x‖ : ℂ)⁻¹) * q x := by ring + _ = (f x : ℂ) * q x := by + rw [mul_inv_cancel₀ hn, mul_one] + apply hweighted.norm.mono' hmeas + filter_upwards with x + rw [norm_mul, Complex.norm_real] + simp [enorm_eq_nnnorm, mul_comm] + apply hg.induction (P := fun f => + ∫ᵛ x, f x ∂[ContinuousLinearMap.lsmul ℝ ℝ (E := ℂ); μ.withDensity q B] = + ∫ᵛ x, (f x : ℂ) * q x ∂[ContinuousLinearMap.lsmul ℝ ℂ; μ]) + · intro c s hs hfinite + change (μ.withDensity q B).variation s < ⊤ at hfinite + have hfinite' : IsFiniteMeasure ((μ.withDensity q B).variation.restrict s) := by + exact MeasureTheory.isFiniteMeasure_restrict.mpr hfinite.ne + let := hfinite' + rw [VectorMeasure.integral_indicator_const c hs] + have hfun : (fun x => ((s.indicator (fun _ => c) x : ℝ) : ℂ) * q x) = + s.indicator (fun x => (c : ℂ) * q x) := by + funext x + by_cases hx : x ∈ s <;> simp [hx] + rw [hfun, MeasureTheory.VectorMeasure.withDensity_apply hq, hmul] + rw [VectorMeasure.integral_indicator (μ := μ) + (B := ContinuousLinearMap.lsmul ℝ ℂ) (f := fun x => (c : ℂ) * q x) hs] + change (c : ℂ) • (∫ᵛ x, q x ∂[ContinuousLinearMap.lsmul ℝ ℂ; μ.restrict s]) = + ∫ᵛ x, (c : ℝ) • q x ∂[ContinuousLinearMap.lsmul ℝ ℂ; μ.restrict s] + rw [VectorMeasure.integral_fun_smul] + simp [smul_eq_mul] + · intro f k _ hf hk hfP hkP + have hfk := bridge hf + have hkk := bridge hk + change (∫ᵛ x, f x + k x ∂[ContinuousLinearMap.lsmul ℝ ℝ (E := ℂ); + μ.withDensity q B]) = _ + rw [VectorMeasure.integral_fun_add (μ := μ.withDensity q B) hf hk] + have hfunadd : (fun x => ((f + k) x : ℂ) * q x) = + (fun x => ((f x : ℂ) + (k x : ℂ)) * q x) := by + funext x + simp [Pi.add_apply] + rw [hfunadd] + have hfunadd' : + (fun x => ((f x : ℂ) + (k x : ℂ)) * q x) = + (fun x => (f x : ℂ) * q x + (k x : ℂ) * q x) := by + funext x + rw [add_mul] + rw [hfunadd'] + rw [VectorMeasure.integral_fun_add (μ := μ) hfk hkk, hfP, hkP] + · apply isClosed_eq + · exact MeasureTheory.VectorMeasure.continuous_integral + · have hLip : LipschitzWith 1 + (fun y : (Lp ℝ 1 ((μ.withDensity q B).variation)) => + ∫ᵛ x, (y x : ℂ) * q x ∂[ContinuousLinearMap.lsmul ℝ ℂ; μ]) := by + rw [lipschitzWith_iff_dist_le_mul] + intro f k + have hf := bridge (by + simpa [B] using (L1.integrable_coeFn f)) + have hk := bridge (by + simpa [B] using (L1.integrable_coeFn k)) + have hdist := MeasureTheory.VectorMeasure.dist_integral_le_lintegral_edist + (μ := μ) (B := ContinuousLinearMap.lsmul ℝ ℂ) hf hk + calc + dist (∫ᵛ x, (f x : ℂ) * q x ∂[ContinuousLinearMap.lsmul ℝ ℂ; μ]) + (∫ᵛ x, (k x : ℂ) * q x ∂[ContinuousLinearMap.lsmul ℝ ℂ; μ]) ≤ + ‖ContinuousLinearMap.lsmul ℝ ℂ‖ * + (∫⁻ x, edist ((f x : ℂ) * q x) ((k x : ℂ) * q x) ∂μ.variation).toReal := hdist + _ = (1 : ℝ) * dist f k := by + have hlin : + (∫⁻ x, edist ((f x : ℂ) * q x) ((k x : ℂ) * q x) ∂μ.variation) = + ∫⁻ x, ‖f x - k x‖ₑ ∂(μ.variation.withDensity + (fun x => ‖q x‖ₑ)) := by + rw [lintegral_withDensity_eq_lintegral_mul₀' + hq.aestronglyMeasurable.enorm] + · apply lintegral_congr_ae + filter_upwards with x + rw [edist_dist, dist_eq_norm, ← sub_mul] + rw [norm_mul, ENNReal.ofReal_mul (norm_nonneg _), + ofReal_norm, ofReal_norm] + have hnorm : ‖(f x : ℂ) - (k x : ℂ)‖ₑ = ‖f x - k x‖ₑ := by + rw [← Complex.ofReal_sub] + simp only [enorm_eq_nnnorm] + apply congrArg ENNReal.ofNNReal + apply NNReal.eq + simp only [coe_nnnorm, Complex.norm_real] + rw [hnorm] + simp [enorm_eq_nnnorm, mul_comm] + · rw [← hvar] + exact (Lp.aestronglyMeasurable f).sub + (Lp.aestronglyMeasurable k) |>.enorm + rw [hlin, ← hvar] + rw [← eLpNorm_one_eq_lintegral_enorm] + have he : eLpNorm (fun x => f x - k x) 1 (μ.withDensity q B).variation = + eLpNorm (⇑(f - k)) 1 (μ.withDensity q B).variation := + eLpNorm_congr_ae (Lp.coeFn_sub f k).symm + rw [he, Lp.dist_def] + rw [eLpNorm_congr_ae (Lp.coeFn_sub f k)] + simp + exact hLip.continuous + · intro f k hfk hf hfP + have hfk' : f =ᵐ[μ.variation.withDensity (fun x => ‖q x‖ₑ)] k := by + change f =ᵐ[(μ.withDensity q B).variation] k at hfk + rw [hvar] at hfk + exact hfk + have hfkq : (fun x => (f x : ℂ) * q x) =ᵐ[μ.variation] + (fun x => (k x : ℂ) * q x) := by + have hqae := (ae_withDensity_iff' hq.aestronglyMeasurable.enorm).1 hfk' + filter_upwards [hqae] with x hx + by_cases hqx : q x = 0 + · simp [hqx] + · rw [hx (by simp [hqx])] + calc + ∫ᵛ x, k x ∂[ContinuousLinearMap.lsmul ℝ ℝ (E := ℂ); + μ.withDensity q B] = + ∫ᵛ x, f x ∂[ContinuousLinearMap.lsmul ℝ ℝ (E := ℂ); + μ.withDensity q B] := + (VectorMeasure.integral_congr_ae (μ := μ.withDensity q B) hfk).symm + _ = ∫ᵛ x, (f x : ℂ) * q x ∂[ContinuousLinearMap.lsmul ℝ ℂ; μ] := hfP + _ = ∫ᵛ x, (k x : ℂ) * q x ∂[ContinuousLinearMap.lsmul ℝ ℂ; μ] := + VectorMeasure.integral_congr_ae (μ := μ) hfkq + +lemma WOTSpectralMeasure.scalarMeasure_eq_withDensity_one_sub + (μ : QuantumMechanics.WOTSpectralMeasure ℂ H) (U : H →L[ℂ] H) + (hrec : ∀ x y, μ.complexWeakIntegral id x y = ⟪y, U x⟫_ℂ) + (hfi : ∀ x y, (μ.scalarMeasure x y).Integrable id) + (hfinite : ∀ x y, IsFiniteMeasure (μ.scalarMeasure x y).variation) + (hcomm : ∀ {S : Set ℂ}, MeasurableSet S → + μ S * ContinuousLinearMapWOT.ofCLM U = + ContinuousLinearMapWOT.ofCLM U * μ S) + (x v y : H) (hx : x = v - U v) : + μ.scalarMeasure x y = + (μ.scalarMeasure v y).withDensity (fun z => (1 : ℂ) - z) + (ContinuousLinearMap.mul ℝ ℂ) := by + let ν := μ.scalarMeasure v y + let := hfinite v y + have hconst : ν.Integrable (fun _ : ℂ => (1 : ℂ)) := by + change Integrable (fun _ : ℂ => (1 : ℂ)) ν.variation + exact MeasureTheory.integrable_const (μ := ν.variation) (c := (1 : ℂ)) + have hq : ν.Integrable (fun z => (1 : ℂ) - z) := by + exact hconst.sub (hfi v y) + apply MeasureTheory.VectorMeasure.ext + intro S hS + rw [WOTSpectralMeasure.scalarMeasure_domain_factorization μ U hrec hfi hfinite hcomm + x v y hx hS] + rw [MeasureTheory.VectorMeasure.withDensity_apply hq] + rw [← MeasureTheory.VectorMeasure.integral_indicator hS] + have hB : ContinuousLinearMap.mul ℝ ℂ = ContinuousLinearMap.lsmul ℝ ℂ := by + ext z w + simp [ContinuousLinearMap.mul_apply', ContinuousLinearMap.lsmul_apply, smul_eq_mul] + rw [hB] + exact WOTSpectralMeasure.complexWeakIntegral_proj_left μ hS + (fun z => (1 : ℂ) - z) v y hq + +lemma cayleyBoundedSpectralMeasure_commutes_operator + (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) + {S : Set ℂ} (hS : MeasurableSet S) : + cayleyBoundedSpectralMeasure T hT S * + ContinuousLinearMapWOT.ofCLM (cayleyBoundedOperator T hT) = + ContinuousLinearMapWOT.ofCLM (cayleyBoundedOperator T hT) * + cayleyBoundedSpectralMeasure T hT S := by + apply WOTSpectralMeasure.reconstruction_commutes_projection + (cayleyBoundedSpectralMeasure T hT) + (cayleyBoundedOperator T hT) id + · intro x y + exact cayleyBoundedSpectralMeasure_reconstruction T hT x y + · intro x y + exact cayleyBoundedSpectralMeasure_id_integrable T hT x y + · exact hS + +lemma cayleyBoundedSpectralMeasure_inverse_moment + (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) : + ∀ x : T.domain, ∀ y : H, + ((cayleyBoundedSpectralMeasure T hT).scalarMeasure (x : H) y).Integrable + cayleyInverse ∧ + ⟪y, T x⟫_ℂ = + (cayleyBoundedSpectralMeasure T hT).weakIntegral + cayleyInverse (x : H) y := by + intro x y + let E := cayleyBoundedSpectralMeasure T hT + let U := cayleyBoundedOperator T hT + obtain ⟨v, hx, hTx⟩ := cayley_domain_factorization T hT x + let ν := E.scalarMeasure v y + let q : ℂ → ℂ := fun z => (1 : ℂ) - z + have hfinite : IsFiniteMeasure ν.variation := by + exact cayleyBoundedSpectralMeasure_scalarMeasure_isFinite T hT v y + let := hfinite + have hfi : ν.Integrable id := by + exact cayleyBoundedSpectralMeasure_id_integrable T hT v y + have hconst : ν.Integrable (fun _ : ℂ => (1 : ℂ)) := by + change Integrable (fun _ : ℂ => (1 : ℂ)) ν.variation + exact MeasureTheory.integrable_const (μ := ν.variation) (c := (1 : ℂ)) + have hq : ν.Integrable q := by + exact hconst.sub hfi + have hq_ae : AEMeasurable (fun z => ‖q z‖ₑ) ν.variation := + hq.aestronglyMeasurable.enorm + have hq_lt : ∀ᵐ z ∂ν.variation, ‖q z‖ₑ < ⊤ := by + filter_upwards with z + exact (lt_top_iff_ne_top).2 (show ‖q z‖ₑ ≠ ⊤ from enorm_ne_top) + have hvar : (ν.withDensity q (ContinuousLinearMap.mul ℝ ℂ)).variation = + ν.variation.withDensity (fun z => ‖q z‖ₑ) := by + rw [MeasureTheory.VectorMeasure.variation_withDensity hq] + rw [MeasureTheory.VectorMeasure.variation_transpose_eq _ _] + · simp [ContinuousLinearMap.mul_apply', nnnorm_mul] + · intro a b + simp [ContinuousLinearMap.mul_apply', nnnorm_mul] + let A : Set ℂ := {z | ‖z‖ = 1 ∧ z ≠ 1} + have hA : MeasurableSet A := by + dsimp [A] + exact (measurableSet_eq_fun measurable_norm measurable_const).inter + (measurableSet_singleton (1 : ℂ)).compl + have hνA : ν = ν.restrict A := by + apply MeasureTheory.VectorMeasure.ext + intro S hS + rw [MeasureTheory.VectorMeasure.restrict_apply ν hA hS] + change ⟪y, E S v⟫_ℂ = ⟪y, E (S ∩ A) v⟫_ℂ + rw [cayleyBoundedSpectralMeasure_support_away_one T hT S hS] + have hA_ae : ∀ᵐ z ∂ν.variation, z ∈ A := by + rw [hνA, MeasureTheory.VectorMeasure.variation_restrict hA] + exact ae_restrict_mem hA + have hprod : Integrable (fun z => (cayleyInverse z : ℂ) * q z) ν.variation := by + have hmeas : AEStronglyMeasurable + (fun z => (cayleyInverse z : ℂ) * q z) ν.variation := by + have hqmeas : AEStronglyMeasurable q ν.variation := hq.aestronglyMeasurable + exact (Complex.ofRealCLM.continuous.comp_aestronglyMeasurable + measurable_cayleyInverse.aestronglyMeasurable).mul hqmeas + apply Integrable.of_bound hmeas 2 + filter_upwards [hA_ae] with z hz + have hzid := cayleyInverse_mul_one_sub_of_unit_circle hz.1 hz.2 + calc + ‖(cayleyInverse z : ℂ) * q z‖ = ‖Complex.I * (1 + z)‖ := by + rw [show q z = 1 - z by rfl, hzid] + _ = ‖1 + z‖ := by rw [norm_mul]; simp + _ ≤ ‖(1 : ℂ)‖ + ‖z‖ := norm_add_le _ _ + _ = 2 := by rw [hz.1]; norm_num + have hweighted : (ν.withDensity q (ContinuousLinearMap.mul ℝ ℂ)).Integrable + cayleyInverse := by + change Integrable cayleyInverse + (ν.withDensity q (ContinuousLinearMap.mul ℝ ℂ)).variation + rw [hvar] + apply (integrable_withDensity_iff_integrable_smul₀' hq_ae hq_lt).2 + have habs : Integrable + (fun z => ‖(cayleyInverse z : ℂ) * q z‖) ν.variation := hprod.norm + have habs' : Integrable + (fun z => ‖q z‖ * |cayleyInverse z|) ν.variation := by + apply habs.congr + filter_upwards with z + simp [Complex.norm_real, Real.norm_eq_abs, mul_comm] + have hsign : Integrable + (fun z => ‖q z‖ * cayleyInverse z) ν.variation := by + apply habs'.congr' + ((hq.aestronglyMeasurable.norm.mul + measurable_cayleyInverse.aestronglyMeasurable)) + filter_upwards with z + simp + apply hsign.congr + filter_upwards with z + simp [toReal_enorm, smul_eq_mul] + have hmeasure : E.scalarMeasure (x : H) y = + ν.withDensity q (ContinuousLinearMap.mul ℝ ℂ) := by + exact WOTSpectralMeasure.scalarMeasure_eq_withDensity_one_sub E U + (fun a b => cayleyBoundedSpectralMeasure_reconstruction T hT a b) + (fun a b => cayleyBoundedSpectralMeasure_id_integrable T hT a b) + (fun a b => cayleyBoundedSpectralMeasure_scalarMeasure_isFinite T hT a b) + (fun {S} hS => cayleyBoundedSpectralMeasure_commutes_operator T hT hS) + (x : H) v y hx + constructor + · rw [hmeasure] + exact hweighted + · have hden := VectorMeasure.integral_real_withDensity_mul ν hq hweighted hvar + have hbase : ∫ᵛ z, (cayleyInverse z : ℂ) * q z ∂[ + ContinuousLinearMap.lsmul ℝ ℂ; ν] = + Complex.I * (∫ᵛ z, (1 + z) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ; ν]) := by + have hplus : ν.Integrable (fun z => (1 : ℂ) + z) := hconst.add hfi + have hpoint : (fun z => (cayleyInverse z : ℂ) * q z) =ᵐ[ν.variation] + (fun z => Complex.I * ((1 : ℂ) + z)) := by + rw [hνA, MeasureTheory.VectorMeasure.variation_restrict hA] + filter_upwards [ae_restrict_mem hA] with z hz + exact cayleyInverse_mul_one_sub_of_unit_circle hz.1 hz.2 + rw [VectorMeasure.integral_congr_ae hpoint] + have hcomp : + ContinuousLinearMap.lsmul ℝ ℂ ∘L ContinuousLinearMap.lsmul ℝ ℂ Complex.I = + (ContinuousLinearMap.compL ℝ ℂ ℂ ℂ + (ContinuousLinearMap.lsmul ℝ ℂ Complex.I)) ∘L + ContinuousLinearMap.lsmul ℝ ℂ := by + ext c w + simp [ContinuousLinearMap.compL_apply, ContinuousLinearMap.lsmul_apply, + smul_eq_mul] + ring + calc + ∫ᵛ x, Complex.I * (1 + x) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ; ν] = + ∫ᵛ x, (ContinuousLinearMap.lsmul ℝ ℂ Complex.I) (1 + x) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ; ν] := by rfl + _ = ∫ᵛ x, (1 + x) ∂[ + (ContinuousLinearMap.lsmul ℝ ℂ) ∘L + (ContinuousLinearMap.lsmul ℝ ℂ Complex.I); ν] := + VectorMeasure.integral_continuousLinearMap_comp hplus + _ = ∫ᵛ x, (1 + x) ∂[ + (ContinuousLinearMap.compL ℝ ℂ ℂ ℂ + (ContinuousLinearMap.lsmul ℝ ℂ Complex.I)) ∘L + ContinuousLinearMap.lsmul ℝ ℂ; ν] := by rw [hcomp] + _ = Complex.I * (∫ᵛ x, (1 + x) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ; ν]) := + (VectorMeasure.continuousLinearMap_apply_integral + (C := ContinuousLinearMap.lsmul ℝ ℂ Complex.I) hplus).symm + unfold QuantumMechanics.WOTSpectralMeasure.weakIntegral + rw [hmeasure, hden, hbase] + have hplus : ∫ᵛ z, (1 + z) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ; ν] = ⟪y, v + U v⟫_ℂ := by + have hplus' : ν.Integrable (fun z => (1 : ℂ) + z) := hconst.add hfi + have hfun : (fun z : ℂ => (1 : ℂ) + z) = + (fun _ : ℂ => (1 : ℂ)) + id := by + funext z + simp + rw [hfun] + change (∫ᵛ z, (1 : ℂ) + id z ∂[ + ContinuousLinearMap.lsmul ℝ ℂ; ν]) = _ + rw [VectorMeasure.integral_fun_add hconst hfi] + rw [VectorMeasure.integral_const] + rw [QuantumMechanics.WOTSpectralMeasure.scalarMeasure_apply] + rw [QuantumMechanics.WOTSpectralMeasure.univ] + simp only [ContinuousLinearMap.lsmul_apply, one_smul] + have hid : (∫ᵛ z, id z ∂[ContinuousLinearMap.lsmul ℝ ℂ; ν]) = + ⟪y, U v⟫_ℂ := by + change E.complexWeakIntegral id v y = _ + exact cayleyBoundedSpectralMeasure_reconstruction T hT v y + rw [hid] + change ⟪y, v⟫_ℂ + ⟪y, U v⟫_ℂ = _ + rw [inner_add_right] + rw [hplus, hTx, inner_smul_right] + +/-! ### The inverse-moment transport lemma + +The bounded spectral reconstruction supplies the Cayley moment `z`. The genuinely unbounded +step is the inverse-Cayley moment on the operator domain. The following theorem isolates the +measure-transport part of that step: once the inverse moment is established on the bounded +Cayley measure, it is transported automatically to the real spectral measure. This keeps the +analytic domain argument separate from the bookkeeping for mapped vector measures. +-/ + +lemma cayleyRealSpectralMeasure_isWeakSpectralResolution_of_inverse_moment + (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) + (hinv : ∀ x : T.domain, ∀ y : H, + ((cayleyBoundedSpectralMeasure T hT).scalarMeasure (x : H) y).Integrable cayleyInverse ∧ + ⟪y, T x⟫_ℂ = + (cayleyBoundedSpectralMeasure T hT).weakIntegral cayleyInverse (x : H) y) : + IsWeakSpectralResolution T (cayleyRealSpectralMeasure T hT) := by + intro x + refine ⟨?_, ?_⟩ + · intro y + have hmap := hinv x y |>.1 + change ((cayleyBoundedSpectralMeasure T hT).map cayleyInverse + measurable_cayleyInverse).scalarMeasure (x : H) y |>.Integrable id + rw [QuantumMechanics.WOTSpectralMeasure.scalarMeasure_map] + exact VectorMeasure.Integrable.map measurable_id.aestronglyMeasurable hmap + · intro y + have hmap := hinv x y |>.1 + have htransport : + (cayleyRealSpectralMeasure T hT).weakIntegral id (x : H) y = + (cayleyBoundedSpectralMeasure T hT).weakIntegral + (id ∘ cayleyInverse) (x : H) y := by + change ((cayleyBoundedSpectralMeasure T hT).map cayleyInverse + measurable_cayleyInverse).weakIntegral id (x : H) y = _ + exact QuantumMechanics.WOTSpectralMeasure.weakIntegral_map + (μS := cayleyBoundedSpectralMeasure T hT) cayleyInverse + measurable_cayleyInverse id (x : H) y + measurable_id.aestronglyMeasurable hmap + rw [htransport] + simpa [Function.comp_def] using (hinv x y).2 + +lemma cayleyRealSpectralMeasure_isWeakSpectralResolution + (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) : + IsWeakSpectralResolution T (cayleyRealSpectralMeasure T hT) := by + apply cayleyRealSpectralMeasure_isWeakSpectralResolution_of_inverse_moment T hT + exact cayleyBoundedSpectralMeasure_inverse_moment T hT + +theorem cayleySelfAdjointSpectralTheorem + (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) : + SelfAdjointSpectralTheorem T (cayleyRealSpectralMeasure T hT) where + isSelfAdjoint := hT + reconstruction := cayleyRealSpectralMeasure_isWeakSpectralResolution T hT + +lemma cayleyRealSpectralMeasure_le_maximal + (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) : + T ≤ QuantumMechanics.WOTSpectralMeasure.maximalSpectralIntegral + (cayleyRealSpectralMeasure T hT) := by + let E := cayleyRealSpectralMeasure T hT + let M := QuantumMechanics.WOTSpectralMeasure.maximalSpectralIntegral E + have hres := cayleyRealSpectralMeasure_isWeakSpectralResolution T hT + refine ⟨?_, ?_⟩ + · intro x hx + change x ∈ spectralSquareMomentDomain E + exact cayleyRealSpectralMeasure_mem_domain T hT (⟨x, hx⟩ : T.domain) + · intro x z hxz + have hxM : (x : H) ∈ M.domain := by + change (x : H) ∈ spectralSquareMomentDomain E + exact cayleyRealSpectralMeasure_mem_domain T hT x + let z₀ : M.domain := ⟨(x : H), hxM⟩ + have hz : z = z₀ := by + apply Subtype.ext + exact hxz.symm + apply ext_inner_left ℂ + intro y + have hfi : (E.scalarMeasure (x : H) y).Integrable id := (hres x).1 y + have hweak := + QuantumMechanics.WOTSpectralMeasure.truncationIntegral_inner_tendsto_weakIntegral + E (x : H) y hfi + have hcomplex : Filter.Tendsto + (fun n : ℕ => ∫ᵛ r, QuantumMechanics.WOTSpectralMeasure.truncationFunction n r ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); E.scalarMeasure (x : H) y]) + Filter.atTop (𝓝 (E.weakIntegral id (x : H) y)) := by + apply hweak.congr' + filter_upwards [] with n + have htrunc : (E.scalarMeasure (x : H) y).Integrable + (QuantumMechanics.WOTSpectralMeasure.realTruncationFunction n) := by + rcases QuantumMechanics.WOTSpectralMeasure.realTruncationFunction_bounded n with ⟨C, hC⟩ + let := QuantumMechanics.WOTSpectralMeasure.scalarMeasure_isFiniteVariation E (x : H) y + apply Integrable.of_bound + (QuantumMechanics.WOTSpectralMeasure.realTruncationFunction_measurable + n).aestronglyMeasurable C + filter_upwards [] with r + simpa [Real.norm_eq_abs] using hC r + have hreal := QuantumMechanics.WOTSpectralMeasure.integral_real_eq_complex + (E.scalarMeasure (x : H) y) htrunc + have hfun : (fun r => QuantumMechanics.WOTSpectralMeasure.truncationFunction n r) = + (fun r => Complex.ofRealCLM + (QuantumMechanics.WOTSpectralMeasure.realTruncationFunction n r)) := by + funext r + simpa [Complex.ofRealCLM_apply] using congrFun + (QuantumMechanics.WOTSpectralMeasure.realTruncationFunction_complex_eq n).symm r + calc + ∫ᵛ r, QuantumMechanics.WOTSpectralMeasure.realTruncationFunction n r ∂[ + ContinuousLinearMap.lsmul ℝ ℝ (E := ℂ); E.scalarMeasure (x : H) y] = + ∫ᵛ r, Complex.ofRealCLM + (QuantumMechanics.WOTSpectralMeasure.realTruncationFunction n r) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ; E.scalarMeasure (x : H) y] := + hreal + _ = ∫ᵛ r, QuantumMechanics.WOTSpectralMeasure.truncationFunction n r ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); E.scalarMeasure (x : H) y] := + congrArg (fun f : ℝ → ℂ => ∫ᵛ r, f r ∂[ + ContinuousLinearMap.lsmul ℝ ℂ; E.scalarMeasure (x : H) y]) hfun.symm + have hmax := + QuantumMechanics.WOTSpectralMeasure.maximalSpectralIntegral_weak_truncation_reconstruction + E (x : H) hxM y + have hinner : ⟪y, M z₀⟫_ℂ = E.weakIntegral id (x : H) y := + tendsto_nhds_unique hmax hcomplex + calc + ⟪y, T x⟫_ℂ = E.weakIntegral id (x : H) y := (hres x).2 y + _ = ⟪y, M z₀⟫_ℂ := hinner.symm + _ = ⟪y, M z⟫_ℂ := by rw [hz] + +theorem cayleyRealSpectralMeasure_eq_maximal + (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) : + maximalSpectralIntegral + (cayleyRealSpectralMeasure T hT) = T := by + exact maximalSpectralIntegral_eq_of_isSelfAdjoint_of_isWeakSpectralResolution + T hT + (cayleyRealSpectralMeasure_isWeakSpectralResolution T hT) + (fun x => cayleyRealSpectralMeasure_mem_domain T hT x) + +theorem cayleyDomainAwareSelfAdjointSpectralTheorem + (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) : + DomainAwareSelfAdjointSpectralTheorem T (cayleyRealSpectralMeasure T hT) := by + exact domainAwareSelfAdjointSpectralTheorem_of_isWeakSpectralResolution + T hT + (cayleyRealSpectralMeasure_isWeakSpectralResolution T hT) + (fun x => cayleyRealSpectralMeasure_mem_domain T hT x) + +/-- The public unbounded spectral theorem for a self-adjoint `LinearPMap`. + +The Cayley transform is an implementation detail of the construction: the result exposes the +real spectral measure and the exact square-moment domain through the standard +`DomainAwareSelfAdjointSpectralTheorem` interface. Clients that already have a self-adjoint +operator should use this facade rather than depending on the Cayley-side names. -/ +theorem unboundedSpectralTheorem + (T : H →ₗ.[ℂ] H) (hT : IsSelfAdjoint T) : + DomainAwareSelfAdjointSpectralTheorem T (cayleyRealSpectralMeasure T hT) := by + exact cayleyDomainAwareSelfAdjointSpectralTheorem T hT + +/-- The public Cayley-based theorem starting from an essentially self-adjoint core. + +The operator supplied to the spectral API is the canonical graph closure. Thus the implication +`essential self-adjointness → self-adjoint closure → exact unbounded spectral theorem` is visible +in one declaration, while the returned certificate still exposes the closure domain and the +square-moment domain equality separately. -/ +theorem unboundedSpectralTheorem_of_essentiallySelfAdjoint + (T : H →ₗ.[ℂ] H) (hT : LinearPMap.IsEssentiallySelfAdjoint T) : + DomainAwareSelfAdjointSpectralTheorem T.closure + (cayleyRealSpectralMeasure T.closure hT) := by + exact cayleyDomainAwareSelfAdjointSpectralTheorem T.closure hT + +end QuantumMechanics + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Conjugation.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Conjugation.lean new file mode 100644 index 0000000000..7f27ee4b2d --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Conjugation.lean @@ -0,0 +1,192 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.ScalarMeasure + +/-! + +# Transporting a weak spectral measure through a Hilbert-space unitary + +A Hilbert-space isometric isomorphism `u : H ≃ₗᵢ[ℂ] H'` conjugates bounded operators on `H` to +bounded operators on `H'` (`A ↦ u A u⁻¹`), and this conjugation is a `*`-algebra isomorphism +between the two weak-operator-topology spaces. Composing a `WOTSpectralMeasure α H` with it +therefore gives a `WOTSpectralMeasure α H'` — the spectral measure "carried across" the unitary. +This is the tool that lets a spectral measure constructed on one concrete representation be +transported to any unitarily equivalent one, and it also transports the associated scalar and +diagonal measures from `ScalarMeasure.lean` (`unitaryConjSpectralMeasure_scalarMeasure`, +`unitaryConjSpectralMeasure_diagonalMeasure`). + +## Main definitions + +- `unitaryConj` : conjugation of a single bounded WOT operator by `u`. +- `unitaryConjSpectralMeasure` : conjugation of a whole `WOTSpectralMeasure` by `u`. +- `unitaryConjSpectralMeasure_scalarMeasure`, `_diagonalMeasure` : the transported measure's + scalar/diagonal measures, in terms of the original. + +-/ + +@[expose] public section + +noncomputable section + +open scoped Topology InnerProductSpace Function +open ContinuousLinearMap ContinuousLinearMapWOT MeasureTheory Set + +namespace QuantumMechanics + +namespace WOTSpectralMeasure + +variable {α : Type*} [MeasurableSpace α] +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-! ## A. Conjugation of a single operator -/ + +/-- Conjugation of a bounded operator by a Hilbert-space unitary, viewed in the WOT type. -/ +@[nolint unusedArguments] +def unitaryConj {H' : Type*} [NormedAddCommGroup H'] [InnerProductSpace ℂ H'] + [CompleteSpace H'] (u : H ≃ₗᵢ[ℂ] H') (A : H →WOT[ℂ] H) : H' →WOT[ℂ] H' := + ContinuousLinearMapWOT.ofCLM + (u.toLinearIsometry.toContinuousLinearMap.comp + ((ContinuousLinearMapWOT.toCLM A).comp u.symm.toLinearIsometry.toContinuousLinearMap)) + +/-- Unitary conjugation is additive on WOT operators. -/ +def unitaryConjAddHom {H' : Type*} [NormedAddCommGroup H'] [InnerProductSpace ℂ H'] + [CompleteSpace H'] (u : H ≃ₗᵢ[ℂ] H') : + (H →WOT[ℂ] H) →+ (H' →WOT[ℂ] H') where + toFun := unitaryConj u + map_zero' := by + apply ContinuousLinearMapWOT.toCLM_injective + simp [unitaryConj] + map_add' A B := by + apply ContinuousLinearMapWOT.toCLM_injective + simp [unitaryConj] + +lemma continuous_unitaryConjAddHom {H' : Type*} [NormedAddCommGroup H'] + [InnerProductSpace ℂ H'] [CompleteSpace H'] (u : H ≃ₗᵢ[ℂ] H') : + Continuous (unitaryConjAddHom u) := by + rw [ContinuousLinearMapWOT.continuous_iff] + intro x y + change Continuous (fun A : H →WOT[ℂ] H ↦ ⟪y, (unitaryConj u A) x⟫_ℂ) + dsimp [unitaryConj] + change Continuous (fun A : H →WOT[ℂ] H ↦ + ⟪y, u ((ContinuousLinearMapWOT.toCLM A) (u.symm x))⟫_ℂ) + have heq : (fun A : H →WOT[ℂ] H ↦ + ⟪y, u ((ContinuousLinearMapWOT.toCLM A) (u.symm x))⟫_ℂ) = + fun A ↦ ⟪u.symm y, A (u.symm x)⟫_ℂ := by + funext A + exact (u.symm.inner_map_eq_flip y + ((ContinuousLinearMapWOT.toCLM A) (u.symm x))).symm + rw [heq] + fun_prop + +omit [CompleteSpace H] in +@[nolint unusedArguments] +lemma unitaryConj_mul {H' : Type*} [NormedAddCommGroup H'] [InnerProductSpace ℂ H'] + [CompleteSpace H'] (u : H ≃ₗᵢ[ℂ] H') (A B : H →WOT[ℂ] H) : + unitaryConj u (A * B) = unitaryConj u A * unitaryConj u B := by + apply ContinuousLinearMapWOT.toCLM_injective + ext x + simp [unitaryConj, ContinuousLinearMap.comp_apply] + +lemma unitaryConj_star {H' : Type*} [NormedAddCommGroup H'] [InnerProductSpace ℂ H'] + [CompleteSpace H'] (u : H ≃ₗᵢ[ℂ] H') (A : H →WOT[ℂ] H) : + unitaryConj u (star A) = star (unitaryConj u A) := by + apply ContinuousLinearMapWOT.ext_inner + intro x y + change ⟪y, u ((star (ContinuousLinearMapWOT.toCLM A)) (u.symm x))⟫_ℂ = + ⟪y, (star (ContinuousLinearMapWOT.toCLM (unitaryConj u A))) x⟫_ℂ + rw [ContinuousLinearMap.star_eq_adjoint, ContinuousLinearMap.star_eq_adjoint, + ContinuousLinearMap.adjoint_inner_right] + change ⟪y, u ((ContinuousLinearMap.adjoint + (ContinuousLinearMapWOT.toCLM A)) (u.symm x))⟫_ℂ = + ⟪u ((ContinuousLinearMapWOT.toCLM A) (u.symm y)), x⟫_ℂ + calc + _ = ⟪u.symm y, (ContinuousLinearMap.adjoint + (ContinuousLinearMapWOT.toCLM A)) (u.symm x)⟫_ℂ := + (u.symm.inner_map_eq_flip y _).symm + _ = ⟪(ContinuousLinearMapWOT.toCLM A) (u.symm y), u.symm x⟫_ℂ := + ContinuousLinearMap.adjoint_inner_right _ _ _ + _ = ⟪u ((ContinuousLinearMapWOT.toCLM A) (u.symm y)), x⟫_ℂ := + (u.inner_map_eq_flip _ _).symm + +omit [CompleteSpace H] in +@[nolint unusedArguments] +lemma unitaryConj_one {H' : Type*} [NormedAddCommGroup H'] [InnerProductSpace ℂ H'] + [CompleteSpace H'] (u : H ≃ₗᵢ[ℂ] H') : + unitaryConj u (1 : H →WOT[ℂ] H) = 1 := by + apply ContinuousLinearMapWOT.toCLM_injective + ext x + simp [unitaryConj] + +/-! ## B. Conjugation of a spectral measure -/ + +/-- Transport a WOT spectral measure through a Hilbert-space unitary. -/ +def unitaryConjSpectralMeasure {H' : Type*} [NormedAddCommGroup H'] + [InnerProductSpace ℂ H'] [CompleteSpace H'] (u : H ≃ₗᵢ[ℂ] H') : + WOTSpectralMeasure α H → WOTSpectralMeasure α H' := fun μS ↦ { + toVectorMeasure := μS.toVectorMeasure.mapRange (unitaryConjAddHom u) + (continuous_unitaryConjAddHom u) + isStarProjection' S := by + change IsStarProjection (unitaryConj u (μS S)) + refine { isIdempotentElem := ?_, isSelfAdjoint := ?_ } + · change unitaryConj u (μS S) * unitaryConj u (μS S) = unitaryConj u (μS S) + rw [← unitaryConj_mul] + exact congrArg (unitaryConj u) (μS.comp_self S) + · change star (unitaryConj u (μS S)) = unitaryConj u (μS S) + rw [← unitaryConj_star] + exact congrArg (unitaryConj u) (μS.isStarProjection S).isSelfAdjoint + univ' := by + change unitaryConj u (μS Set.univ) = 1 + rw [μS.univ, unitaryConj_one] } + +@[simp] +lemma unitaryConjSpectralMeasure_apply {H' : Type*} [NormedAddCommGroup H'] + [InnerProductSpace ℂ H'] [CompleteSpace H'] (u : H ≃ₗᵢ[ℂ] H') + (μS : WOTSpectralMeasure α H) (S : Set α) : + unitaryConjSpectralMeasure u μS S = unitaryConj u (μS S) := by + rfl + +/-! ## C. Interaction with the scalar and diagonal measures -/ + +lemma unitaryConjSpectralMeasure_scalarMeasure_apply + {H' : Type*} [NormedAddCommGroup H'] [InnerProductSpace ℂ H'] [CompleteSpace H'] + (u : H ≃ₗᵢ[ℂ] H') (μS : WOTSpectralMeasure α H) (x y : H') (S : Set α) : + (unitaryConjSpectralMeasure u μS).scalarMeasure x y S = + μS.scalarMeasure (u.symm x) (u.symm y) S := by + rw [scalarMeasure_apply, scalarMeasure_apply] + change ⟪y, u ((ContinuousLinearMapWOT.toCLM (μS S)) (u.symm x))⟫_ℂ = _ + exact (u.symm.inner_map_eq_flip _ _).symm + +lemma unitaryConjSpectralMeasure_scalarMeasure + {H' : Type*} [NormedAddCommGroup H'] [InnerProductSpace ℂ H'] [CompleteSpace H'] + (u : H ≃ₗᵢ[ℂ] H') (μS : WOTSpectralMeasure α H) (x y : H') : + (unitaryConjSpectralMeasure u μS).scalarMeasure x y = + μS.scalarMeasure (u.symm x) (u.symm y) := by + apply MeasureTheory.VectorMeasure.ext + intro S hS + exact unitaryConjSpectralMeasure_scalarMeasure_apply u μS x y S + +lemma unitaryConjSpectralMeasure_diagonalMeasure + {H' : Type*} [NormedAddCommGroup H'] [InnerProductSpace ℂ H'] [CompleteSpace H'] + (u : H ≃ₗᵢ[ℂ] H') (μS : WOTSpectralMeasure α H) (x : H') : + (unitaryConjSpectralMeasure u μS).diagonalMeasure x = + μS.diagonalMeasure (u.symm x) := by + apply Measure.ext + intro S hS + rw [(unitaryConjSpectralMeasure u μS).diagonalMeasure_apply_eq_norm_sq x S hS, + μS.diagonalMeasure_apply_eq_norm_sq (u.symm x) S hS, + unitaryConjSpectralMeasure_apply] + change ENNReal.ofReal + (‖u ((ContinuousLinearMapWOT.toCLM (μS S)) (u.symm x))‖ ^ 2) = _ + rw [u.norm_map] + rfl + +end WOTSpectralMeasure + +end QuantumMechanics + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/EssentialSpectrum/Closed.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/EssentialSpectrum/Closed.lean new file mode 100644 index 0000000000..0dc514c522 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/EssentialSpectrum/Closed.lean @@ -0,0 +1,178 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem, Adam Bornemann +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.EssentialSpectrum.Defs +public import Mathlib.Analysis.InnerProductSpace.Projection.Basic +public import Mathlib.Topology.Sequences +public import Mathlib.Analysis.SpecificLimits.Basic + +/-! + +# The essential spectrum is closed + +Ported, essentially verbatim, from `adambornemann-glitch/Spectra`'s +`SpectralTheory/Essential/Closed.lean` (Apache 2.0). + +`isClosed_essSpectrum` : for a self-adjoint operator `A`, `essSpectrum hA` is a closed subset +of `ℝ`. + +The proof is the standard diagonal argument. Given `λ_k ∈ essSpectrum` with `λ_k → λ`, each `λ_k` +carries a singular sequence `(ψ_{k,n})_n`. All these vectors lie in a **separable** closed subspace +`K` (the closed span of the countable family), which has a countable dense subset `{d_j}`. Choosing +`n_k` so that `ψ_{k,n_k}` is simultaneously an approximate eigenvector of quality `1/(k+1)`, +approximately normalized, and almost orthogonal to `d_0,…,d_k`, the diagonal sequence +`φ_k := ψ_{k,n_k}` is a singular sequence for `λ` — weak nullness following from the orthogonal +projection onto `K` together with the dense subset. + +-/ + +@[expose] public section + +noncomputable section + +open Filter Topology TopologicalSpace +open scoped InnerProductSpace + +namespace QuantumMechanics.Essential + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-- The essential spectrum is closed. -/ +theorem isClosed_essSpectrum {A : H →ₗ.[ℂ] H} (hA : IsSelfAdjoint A) : + IsClosed (essSpectrum hA) := by + rw [← isSeqClosed_iff_isClosed] + intro lamSeq lamLim hmem hlim + simp only [essSpectrum, Set.mem_setOf_eq] at hmem + choose ψ hψnorm hψweak hψeig using hmem + -- The countable family of all vectors, and its separable closed span `K`. + set S : Set H := Set.range (fun p : ℕ × ℕ => ((ψ p.1 p.2 : H))) with _hSdef + have hScount : S.Countable := Set.countable_range _ + set K : Submodule ℂ H := (Submodule.span ℂ S).topologicalClosure with hKdef + have hmemK : ∀ k n, ((ψ k n : H)) ∈ K := + fun k n => Submodule.le_topologicalClosure _ (Submodule.subset_span ⟨(k, n), rfl⟩) + have hsep : IsSeparable (K : Set H) := by + rw [hKdef, Submodule.topologicalClosure_coe] + exact (hScount.isSeparable.span).closure + obtain ⟨D, hDcount, hDsub⟩ := hsep + have hDne : D.Nonempty := + closure_nonempty_iff.mp ⟨(0 : H), hDsub K.zero_mem⟩ + obtain ⟨d, hd⟩ := hDcount.exists_eq_range hDne + -- Diagonal selection of indices `n_k`. + have hchoose : ∀ k, ∃ n, + ‖A (ψ k n) - (lamSeq k : ℂ) • (ψ k n : H)‖ < 1 / (k + 1) ∧ + |‖(ψ k n : H)‖ - 1| < 1 / (k + 1) ∧ + ∀ j ∈ Finset.range (k + 1), ‖⟪d j, (ψ k n : H)⟫_ℂ‖ < 1 / (k + 1) := by + intro k + have hpos : (0 : ℝ) < 1 / (k + 1) := by positivity + have hlt : ∀ {f : ℕ → ℝ}, Tendsto f atTop (𝓝 0) → ∀ᶠ n in atTop, f n < 1 / (k + 1) := + fun {f} hf => (hf.eventually_mem (isOpen_Iio.mem_nhds (Set.mem_Iio.mpr hpos))).mono + fun n hn => Set.mem_Iio.mp hn + have E1 := hlt (hψeig k) + have E2 : ∀ᶠ n in atTop, |‖(ψ k n : H)‖ - 1| < 1 / (k + 1) := by + have h0 : Tendsto (fun n => |‖(ψ k n : H)‖ - 1|) atTop (𝓝 0) := by + have := (hψnorm k).sub tendsto_const_nhds (b := (1 : ℝ)) + simpa using this.abs + exact hlt h0 + have E3 : ∀ᶠ n in atTop, ∀ j ∈ Finset.range (k + 1), + ‖⟪d j, (ψ k n : H)⟫_ℂ‖ < 1 / (k + 1) := by + rw [eventually_all_finset] + exact fun j _ => hlt (by simpa using (hψweak k (d j)).norm) + obtain ⟨n, ⟨hn1, hn2⟩, hn3⟩ := ((E1.and E2).and E3).exists + exact ⟨n, hn1, hn2, hn3⟩ + choose nidx hEig hNorm hWeak using hchoose + -- The diagonal sequence. + refine ⟨fun k => ψ k (nidx k), ?_, ?_, ?_⟩ + · -- `‖φ k‖ → 1`. + rw [Metric.tendsto_atTop] + intro ε hε + obtain ⟨N, hN⟩ := (tendsto_one_div_add_atTop_nhds_zero_nat.eventually + (isOpen_Iio.mem_nhds (Set.mem_Iio.mpr hε))).exists_forall_of_atTop + refine ⟨N, fun k hk => ?_⟩ + have := hNorm k + rw [Real.dist_eq, abs_sub_comm] + calc |1 - ‖(ψ k (nidx k) : H)‖| = |‖(ψ k (nidx k) : H)‖ - 1| := abs_sub_comm _ _ + _ < 1 / (k + 1) := this + _ < ε := Set.mem_Iio.mp (hN k hk) + · -- `φ` weakly null. + intro g + set pg : H := K.starProjection g with _hpgdef + have hproj : ∀ k, ⟪g, (ψ k (nidx k) : H)⟫_ℂ = ⟪pg, (ψ k (nidx k) : H)⟫_ℂ := by + intro k + have h0 : ⟪g - pg, (ψ k (nidx k) : H)⟫_ℂ = 0 := + K.starProjection_inner_eq_zero g (ψ k (nidx k) : H) (hmemK k (nidx k)) + rw [inner_sub_left, sub_eq_zero] at h0 + exact h0 + have hpgK : pg ∈ closure D := hDsub (K.starProjection_apply_mem g) + have hbound : ∀ k, ‖(ψ k (nidx k) : H)‖ ≤ 2 := by + intro k + have h := abs_lt.mp (hNorm k) + have hle1 : (1 : ℝ) / (k + 1) ≤ 1 := by + rw [div_le_one (by positivity)]; have : (0 : ℝ) ≤ k := by positivity + linarith + linarith [h.2] + rw [Metric.tendsto_atTop] + intro ε hε + rw [Metric.mem_closure_iff] at hpgK + obtain ⟨y, hyD, hy⟩ := hpgK (ε / 4) (by positivity) + rw [hd] at hyD + obtain ⟨jj, rfl⟩ := hyD + obtain ⟨N₁, hN₁⟩ := (tendsto_one_div_add_atTop_nhds_zero_nat.eventually + (isOpen_Iio.mem_nhds + (Set.mem_Iio.mpr (show (0 : ℝ) < ε / 2 by positivity)))).exists_forall_of_atTop + refine ⟨max jj N₁, fun k hk => ?_⟩ + have hkj : jj ≤ k := le_of_max_le_left hk + have hkN : N₁ ≤ k := le_of_max_le_right hk + rw [dist_eq_norm, sub_zero, hproj k] + have hsplit : ⟪pg, (ψ k (nidx k) : H)⟫_ℂ + = ⟪d jj, (ψ k (nidx k) : H)⟫_ℂ + ⟪pg - d jj, (ψ k (nidx k) : H)⟫_ℂ := by + rw [← inner_add_left]; congr 1; abel + calc ‖⟪pg, (ψ k (nidx k) : H)⟫_ℂ‖ + ≤ ‖⟪d jj, (ψ k (nidx k) : H)⟫_ℂ‖ + ‖⟪pg - d jj, (ψ k (nidx k) : H)⟫_ℂ‖ := by + rw [hsplit]; exact norm_add_le _ _ + _ ≤ 1 / (k + 1) + ‖pg - d jj‖ * ‖(ψ k (nidx k) : H)‖ := by + gcongr + · exact le_of_lt (hWeak k jj (Finset.mem_range.mpr (by omega))) + · exact norm_inner_le_norm _ _ + _ < ε / 2 + ε / 4 * 2 := by + have h1 : 1 / (k + 1) < ε / 2 := Set.mem_Iio.mp (hN₁ k hkN) + have h2 : ‖pg - d jj‖ * ‖(ψ k (nidx k) : H)‖ ≤ ε / 4 * 2 := by + apply mul_le_mul (le_of_lt _) (hbound k) (norm_nonneg _) (by positivity) + rwa [← dist_eq_norm] + linarith + _ = ε := by ring + · -- `(A − λ) φ k → 0`. + have hbnd : ∀ k, ‖A (ψ k (nidx k)) - (lamLim : ℂ) • (ψ k (nidx k) : H)‖ + ≤ 1 / (k + 1) + |lamSeq k - lamLim| * (1 + 1 / (k + 1)) := by + intro k + have key : A (ψ k (nidx k)) - (lamLim : ℂ) • (ψ k (nidx k) : H) + = (A (ψ k (nidx k)) - (lamSeq k : ℂ) • (ψ k (nidx k) : H)) + + ((lamSeq k : ℂ) - lamLim) • (ψ k (nidx k) : H) := by module + rw [key] + refine (norm_add_le _ _).trans ?_ + gcongr + · exact le_of_lt (hEig k) + · rw [norm_smul] + have hnk := abs_lt.mp (hNorm k) + have hcast : ‖((lamSeq k : ℂ) - (lamLim : ℂ))‖ = |lamSeq k - lamLim| := by + rw [← Complex.ofReal_sub, Complex.norm_real, Real.norm_eq_abs] + rw [hcast] + gcongr + linarith [hnk.2] + have hrhs : Tendsto (fun k => 1 / (k + 1) + |lamSeq k - lamLim| * (1 + 1 / (k + 1))) + atTop (𝓝 0) := by + have ha : Tendsto (fun k : ℕ => (1 : ℝ) / (k + 1)) atTop (𝓝 0) := + tendsto_one_div_add_atTop_nhds_zero_nat + have hb : Tendsto (fun k => |lamSeq k - lamLim|) atTop (𝓝 0) := by + have h := hlim.sub (tendsto_const_nhds : Tendsto (fun _ : ℕ => lamLim) atTop (𝓝 lamLim)) + simpa using h.abs + have hsum : Tendsto (fun k => (1 : ℝ) / (k + 1) + |lamSeq k - lamLim| * (1 + 1 / (k + 1))) + atTop (𝓝 (0 + 0 * (1 + 0))) := + ha.add (hb.mul ((tendsto_const_nhds : Tendsto (fun _ : ℕ => (1 : ℝ)) atTop (𝓝 1)).add ha)) + simpa using hsum + exact squeeze_zero (fun k => norm_nonneg _) hbnd hrhs + +end QuantumMechanics.Essential diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/EssentialSpectrum/Defs.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/EssentialSpectrum/Defs.lean new file mode 100644 index 0000000000..0bc8b0c60d --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/EssentialSpectrum/Defs.lean @@ -0,0 +1,69 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem, Adam Bornemann +-/ +module + +public import Physlib.QuantumMechanics.Operators.SpectralTheory.SelfAdjoint +public import Mathlib.Analysis.InnerProductSpace.Basic + +/-! + +# The essential spectrum (singular/Weyl-sequence definition) + +Ported from `adambornemann-glitch/Spectra`'s `SpectralTheory/Essential/Defs.lean` (Apache 2.0), +restated against this repo's own unbounded self-adjoint operator type `H →ₗ.[ℂ] H` / +`LinearPMap.IsSelfAdjoint` (`Physlib.QuantumMechanics.Operators.SpectralTheory.SelfAdjoint`) +instead of introducing a parallel one. See `EXTERNAL_INTEGRATION_PLAN.md` §3.4. + +For a self-adjoint operator `A` (an unbounded `LinearPMap`) we define the **essential spectrum** +`essSpectrum hA : Set ℝ` by *singular (Weyl) sequences*: `λ ∈ essSpectrum hA` iff there is a +sequence `ψ : ℕ → A.domain` that is + +* asymptotically normalized (`‖ψ n‖ → 1`), +* weakly null (`⟪g, ψ n⟫ → 0` for every `g`), and +* an approximate eigensequence (`‖A ψ n − λ ψ n‖ → 0`). + +Weak nullness is exactly what is needed for the perturbation theorem (Weyl's theorem, see +`Weyl.lean`): a relatively compact perturbation does not see a weakly-null approximate-eigenvector +sequence. An *orthonormal* approximate eigensequence is a special case — orthonormal sequences are +weakly null (`WeakCompact.lean`) — so this matches the classical Weyl-criterion definition. + +- `essSpectrum` : the essential spectrum of a self-adjoint `LinearPMap`. +- `mem_essSpectrum_of_seq` : build membership from an `H`-valued Weyl sequence. +- `essSpectrum_subset_spectrum` : the essential spectrum is contained in the spectrum. + +-/ + +@[expose] public section + +noncomputable section + +open Filter Topology +open scoped InnerProductSpace + +namespace QuantumMechanics.Essential + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-- The **essential spectrum** of a self-adjoint operator `A`, defined by singular (Weyl) +sequences: `λ ∈ essSpectrum hA` iff there is `ψ : ℕ → A.domain` with `‖ψ n‖ → 1`, `ψ` weakly null, +and `‖A ψ n − λ ψ n‖ → 0`. (`hA` is carried for discoverability; the set depends only on `A`.) -/ +def essSpectrum {A : H →ₗ.[ℂ] H} (_hA : IsSelfAdjoint A) : Set ℝ := + { lam | ∃ ψ : ℕ → A.domain, + Tendsto (fun n => ‖(ψ n : H)‖) atTop (𝓝 1) ∧ + (∀ g : H, Tendsto (fun n => ⟪g, (ψ n : H)⟫_ℂ) atTop (𝓝 0)) ∧ + Tendsto (fun n => ‖A (ψ n) - (lam : ℂ) • (ψ n : H)‖) atTop (𝓝 0) } + +/-- Membership in `essSpectrum` from an `H`-valued Weyl sequence together with a domain-membership +witness. This packages the `ℕ → A.domain` data so callers can work with plain vectors. -/ +theorem mem_essSpectrum_of_seq {A : H →ₗ.[ℂ] H} (hA : IsSelfAdjoint A) (lam : ℝ) + (φ : ℕ → H) (hmem : ∀ n, φ n ∈ A.domain) + (hnorm : Tendsto (fun n => ‖φ n‖) atTop (𝓝 1)) + (hweak : ∀ g : H, Tendsto (fun n => ⟪g, φ n⟫_ℂ) atTop (𝓝 0)) + (heig : Tendsto (fun n => ‖A ⟨φ n, hmem n⟩ - (lam : ℂ) • φ n‖) atTop (𝓝 0)) : + lam ∈ essSpectrum hA := + ⟨fun n => ⟨φ n, hmem n⟩, hnorm, hweak, heig⟩ + +end QuantumMechanics.Essential diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/EssentialSpectrum/Discrete.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/EssentialSpectrum/Discrete.lean new file mode 100644 index 0000000000..4cdc19b0c0 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/EssentialSpectrum/Discrete.lean @@ -0,0 +1,79 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem, Adam Bornemann +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.EssentialSpectrum.Defs + +/-! + +# Discreteness theorem (not ported — recorded as a gap) + +`adambornemann-glitch/Spectra`'s `SpectralTheory/Essential/Discrete.lean` proves the hard half of +the Weyl theory: + +> A spectral point of a self-adjoint operator that is **not** in the essential spectrum is an +> eigenvalue of finite type — `∃ ψ ∈ A.domain, ψ ≠ 0 ∧ A ψ = λ • ψ`. + +This is deliberately **not** ported here (not even as a `sorry`'d restatement against this repo's +own `LinearPMap`/`IsSelfAdjoint` types), for a specific reason: + +## Why this one is skipped + +Spectra's proof (`mem_essSpectrum_of_proj_singleton_eq_zero`) is not self-contained within +`SpectralTheory/Essential/` — it is built entirely on top of Spectra's own bespoke +projection-valued-measure infrastructure: `Spectra.ProjValMeasure`, `PVM.spectralPVM hA` (the +spectral measure of a self-adjoint operator, with its diagonal measures `P.diag`), the +Stone-generator correspondence `genToGroup`/`generator_genToGroup`, and the localization bound +`generator_sub_smul_norm_le_Icc` from Spectra's `Measure/GeneratorLink.lean` and `Eigenspace.lean`. + +`EXTERNAL_INTEGRATION_PLAN.md` §4 explicitly rules out reusing Spectra's `ProjValMeasure`/POVM +wrapper types (this repo's own architecture decision forbids a second Hilbert-space PVM hierarchy), +and this port deliberately excludes pulling in unrelated Spectra subtrees beyond +`SpectralTheory/Essential/` and `SpectralTheory/` itself. Reproving this theorem against this +repo's *own* spectral-measure apparatus (`HilbertSpace/Unbounded/WOTSpectralMeasure`, +`SpectralIntegral/{Construction,SpecTheorem}.lean`) is real, substantial work — identifying the +right "spectral projection at a point/interval" primitives in this repo's own construction and +re-deriving the localization estimate — not a mechanical restatement, and out of scope for this +port. + +## What the theorem would give, if ported + +Restated against this repo's types, the target statement is: + +``` +theorem mem_pointSpectrum_of_mem_spectrum_notMem_essSpectrum {A : H →ₗ.[ℂ] H} + (hA : IsSelfAdjoint A) {lam : ℝ} (hspec : (lam : ℂ) ∈ LinearPMap.spectrum A) + (hne : lam ∉ essSpectrum hA) : + ∃ ψ : A.domain, (ψ : H) ≠ 0 ∧ A ψ = (lam : ℂ) • (ψ : H) +``` + +## The connection to `JordanOrderUnit/SpectralDecomposition.lean`'s `discreteSpectrum` gap + +Per `EXTERNAL_INTEGRATION_PLAN.md` §3.4, this theorem combined with `Weyl.lean`'s invariance +theorem and `HilbertSpace/TraceClass/Basic.lean`'s `HasFiniteMultiplicity` is exactly the tool that +gap needs: "discrete spectrum" done honestly is "spectrum outside `essSpectrum`", and each such +point is then an eigenvalue (this theorem) whose eigenspace projection is shown separately to be +trace class (`HasFiniteMultiplicity`) — giving Murray–von Neumann finite multiplicity without ever +invoking a purely topological/isolated-point notion of "discrete". + +**Caveat found during this port**: no file named `JordanOrderUnit/SpectralDecomposition.lean`, and +no occurrence of `discreteSpectrum`, currently exists anywhere in this checkout +(`physlib-agent/pr-1602-reconcile`) — only `EXTERNAL_INTEGRATION_PLAN.md`'s own prose mentions it. +So this file records the intended bridge for when that file is written, rather than connecting to +an existing declaration. + +**The exact remaining bridge**, once both pieces above are available: + +1. Build the `H →L[ℂ] H`-bundling of `𝑅 A z` noted in `Weyl.lean`'s docstring (or otherwise supply + an `IsResolventAt` witness), so `essSpectrum` invariance is usable on concrete operators. +2. Port (or re-derive against this repo's own spectral-measure machinery) the theorem stated above. +3. Define `discreteSpectrum hA := (LinearPMap.spectrum A ∩ Set.range ((↑) : ℝ → ℂ)) \ (essSpectrum + hA image)` (or however `SpectralDecomposition.lean` ends up phrasing it) and show each of its + points is an eigenvalue (step 2) with `HasFiniteMultiplicity` eigenprojection — the latter needs + a separate, model-dependent finiteness argument (e.g. from a trace-class resolvent), not supplied + by Weyl's theorem itself. + +-/ diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/EssentialSpectrum/Smul.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/EssentialSpectrum/Smul.lean new file mode 100644 index 0000000000..1c5ac0b3b5 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/EssentialSpectrum/Smul.lean @@ -0,0 +1,178 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem, Adam Bornemann +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.EssentialSpectrum.Defs +public import Physlib.QuantumMechanics.Operators.SpectralTheory.Symmetric + +/-! + +# Real scaling of self-adjoint operators: self-adjointness and essential spectrum + +Adapted from `adambornemann-glitch/Spectra`'s `SpectralTheory/Essential/Smul.lean` (Apache 2.0). +Only the two lemmas that need no resolvent construction are ported here (**L1**, **L2** below); +Spectra's third lemma, resolvent scaling (`selfAdjointResolvent (c•A − z)⁻¹ = c⁻¹•(A − z/c)⁻¹`), +is **not** ported — this repo does not yet have a bounded-operator resolvent built directly from +`IsSelfAdjoint` (see the docstring gap in `Weyl.lean`), and resolvent scaling itself is not needed +for Weyl's theorem. See `EXTERNAL_INTEGRATION_PLAN.md` §3.4. + +For an unbounded self-adjoint operator `A : H →ₗ.[ℂ] H` and a **real** nonzero scalar `c`: + +* **L1** `isSelfAdjoint_smul_real` — `(c : ℂ) • A` is self-adjoint (formal self-adjointness for + real `c` + surjectivity of `(c•A) ± i` via von Neumann's criterion, + `IsSymmetric.isSelfAdjoint_of_range_eq_top`). +* **L2** `essSpectrum_smul_real` — `essSpectrum (c • A) = (· * c) '' essSpectrum A` (Weyl + sequences transfer: `(c•A − cλ)ψ = c•(A − λ)ψ`). + +-/ + +@[expose] public section + +noncomputable section + +open Filter Topology Complex +open scoped InnerProductSpace ComplexConjugate + +namespace QuantumMechanics.Essential + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-! ## L1: self-adjointness under real scaling -/ + +omit [CompleteSpace H] in +/-- For a real scalar `c`, `c • A` is formally self-adjoint when `A` is. -/ +lemma isFormalAdjoint_smul_real {A : H →ₗ.[ℂ] H} (hsym : A.IsFormalAdjoint A) + (c : ℝ) : (((c : ℂ)) • A).IsFormalAdjoint (((c : ℂ)) • A) := by + intro x y + rw [LinearPMap.smul_apply, LinearPMap.smul_apply, inner_smul_left, inner_smul_right, + Complex.conj_ofReal, hsym x y] + +/-- Repackaging of `LinearPMap.IsSelfAdjoint.sub_smul_surjective` (which is surjectivity of the raw +`(A - z•1).toFun`, on the domain `(A - z•1).domain`) as surjectivity onto `A.domain` directly: +`A ψ - z • ψ = φ` for `ψ : A.domain`. Needed since `(A - z • 1).domain = A.domain ⊓ ⊤ = A.domain` +only up to a rewrite, not definitionally. -/ +lemma exists_apply_sub_smul_eq {A : H →ₗ.[ℂ] H} (hA : IsSelfAdjoint A) {z : ℂ} (hz : z.im ≠ 0) + (φ : H) : ∃ ψ : A.domain, A ψ - z • (ψ : H) = φ := by + have hdom : (A - z • (1 : H →ₗ.[ℂ] H)).domain = A.domain := by + simp [LinearPMap.sub_domain, LinearPMap.smul_domain] + obtain ⟨x, hx⟩ := LinearPMap.IsSelfAdjoint.sub_smul_surjective hA hz φ + refine ⟨⟨(x : H), by rw [← hdom]; exact x.2⟩, ?_⟩ + rw [LinearPMap.toFun_eq_coe, LinearPMap.sub_apply] at hx + simpa using hx + +/-- Surjectivity of `c•A - w` reduces to surjectivity of `A - w/c` (real `c ≠ 0`). -/ +lemma smul_surjective_sub_smul {A : H →ₗ.[ℂ] H} (hA : IsSelfAdjoint A) + (c : ℝ) (hc : c ≠ 0) (w : ℂ) (hw : w.im ≠ 0) : + ∀ φ : H, ∃ ψ : ((c : ℂ) • A).domain, ((c : ℂ) • A) ψ - w • (ψ : H) = φ := by + intro φ + have hcℂ : (c : ℂ) ≠ 0 := by exact_mod_cast hc + have hwc : (w / (c : ℂ)).im ≠ 0 := by + rw [Complex.div_ofReal_im] + exact div_ne_zero hw hc + obtain ⟨ψ, hψ⟩ := exists_apply_sub_smul_eq hA hwc ((c : ℂ)⁻¹ • φ) + have hdomeq : ((c : ℂ) • A).domain = A.domain := LinearPMap.smul_domain (c : ℂ) A + have hψmem : (ψ : H) ∈ ((c : ℂ) • A).domain := by rw [hdomeq]; exact ψ.2 + refine ⟨⟨(ψ : H), hψmem⟩, ?_⟩ + rw [LinearPMap.smul_apply] + have hAeq : A ⟨(ψ : H), hψmem⟩ = A ψ := by congr + rw [hAeq] + have hkey : (c : ℂ) • (A ψ - (w / (c : ℂ)) • (ψ : H)) = (c : ℂ) • ((c : ℂ)⁻¹ • φ) := + congrArg (fun v => (c : ℂ) • v) hψ + rw [smul_sub, smul_smul, smul_smul] at hkey + rw [mul_div_cancel₀ _ hcℂ, mul_inv_cancel₀ hcℂ, one_smul] at hkey + exact hkey + +/-- **L1.** If `A` is self-adjoint and `c : ℝ` is nonzero, then `(c : ℂ) • A` is self-adjoint. -/ +theorem isSelfAdjoint_smul_real {A : H →ₗ.[ℂ] H} (hA : IsSelfAdjoint A) + (c : ℝ) (hc : c ≠ 0) : IsSelfAdjoint ((c : ℂ) • A) := by + have hsymA : A.IsFormalAdjoint A := LinearPMap.IsSelfAdjoint.isSymmetric hA + have hsym : ((c : ℂ) • A).IsFormalAdjoint ((c : ℂ) • A) := isFormalAdjoint_smul_real hsymA c + have hdense : Dense (((c : ℂ) • A).domain : Set H) := by + rw [LinearPMap.smul_domain]; exact hA.dense_domain + have hplusRaw : ∀ φ : H, ∃ ψ : ((c : ℂ) • A).domain, ((c : ℂ) • A) ψ + I • (ψ : H) = φ := by + intro φ + obtain ⟨ψ, hψ⟩ := smul_surjective_sub_smul hA c hc (-I) (by simp) φ + exact ⟨ψ, by rw [← hψ, neg_smul, sub_neg_eq_add]⟩ + have hminusRaw : ∀ φ : H, ∃ ψ : ((c : ℂ) • A).domain, ((c : ℂ) • A) ψ - I • (ψ : H) = φ := + smul_surjective_sub_smul hA c hc I (by simp) + have hplus : Function.Surjective (((c : ℂ) • A) + I • (1 : H →ₗ.[ℂ] H)).toFun := by + intro φ + obtain ⟨ψ, hψ⟩ := hplusRaw φ + refine ⟨⟨(ψ : H), by simp [LinearPMap.add_domain, LinearPMap.smul_domain]⟩, ?_⟩ + rw [LinearPMap.toFun_eq_coe, LinearPMap.add_apply] + simpa using hψ + have hminus : Function.Surjective (((c : ℂ) • A) - I • (1 : H →ₗ.[ℂ] H)).toFun := by + intro φ + obtain ⟨ψ, hψ⟩ := hminusRaw φ + refine ⟨⟨(ψ : H), by simp [LinearPMap.sub_domain, LinearPMap.smul_domain]⟩, ?_⟩ + rw [LinearPMap.toFun_eq_coe, LinearPMap.sub_apply] + simpa using hψ + exact LinearPMap.IsSymmetric.isSelfAdjoint_of_range_eq_top hsym hdense + (LinearMap.range_eq_top.mpr hplus) (LinearMap.range_eq_top.mpr hminus) + +/-! ## L2: essential spectrum under real scaling -/ + +/-- A Weyl sequence for `A` at `λ` is a Weyl sequence for `c • A` at `c·λ` (real `c`). -/ +lemma mem_essSpectrum_smul_real {A : H →ₗ.[ℂ] H} (hA : IsSelfAdjoint A) + (c : ℝ) (hc : c ≠ 0) {lam : ℝ} (hlam : lam ∈ essSpectrum hA) : + c * lam ∈ essSpectrum (isSelfAdjoint_smul_real hA c hc) := by + obtain ⟨ψ, hnorm, hweak, heig⟩ := hlam + have hmem : ∀ n, (ψ n : H) ∈ ((c : ℂ) • A).domain := by + intro n; rw [LinearPMap.smul_domain]; exact (ψ n).2 + refine mem_essSpectrum_of_seq (isSelfAdjoint_smul_real hA c hc) (c * lam) + (fun n => (ψ n : H)) hmem hnorm hweak ?_ + have hrw : ∀ n, + ‖((c : ℂ) • A) ⟨(ψ n : H), hmem n⟩ - ((c * lam : ℝ) : ℂ) • (ψ n : H)‖ + = |c| * ‖A (ψ n) - (lam : ℂ) • (ψ n : H)‖ := by + intro n + rw [LinearPMap.smul_apply] + have hAeq : A ⟨(ψ n : H), hmem n⟩ = A (ψ n) := by congr + rw [hAeq] + have hsm : (c : ℂ) • A (ψ n) - ((c * lam : ℝ) : ℂ) • (ψ n : H) + = (c : ℂ) • (A (ψ n) - (lam : ℂ) • (ψ n : H)) := by + rw [smul_sub, smul_smul]; push_cast; ring_nf + rw [hsm, norm_smul] + congr 1 + exact RCLike.norm_ofReal c + rw [show (𝓝 (0 : ℝ)) = 𝓝 (|c| * 0) by rw [mul_zero]] + simp_rw [hrw] + exact heig.const_mul |c| + +/-- `essSpectrum` depends only on the operator, not on the self-adjointness witness. -/ +lemma essSpectrum_congr_op {A B : H →ₗ.[ℂ] H} (hA : IsSelfAdjoint A) (hB : IsSelfAdjoint B) + (h : A = B) : essSpectrum hA = essSpectrum hB := by + subst h; rfl + +omit [CompleteSpace H] in +/-- Scaling by `c` then by `c⁻¹` is the identity operator (real `c ≠ 0`). -/ +lemma smul_inv_smul_pmap {A : H →ₗ.[ℂ] H} (c : ℝ) (hc : c ≠ 0) : + ((c⁻¹ : ℝ) : ℂ) • (((c : ℂ)) • A) = A := by + have hcℂ : (c : ℂ) ≠ 0 := by exact_mod_cast hc + rw [smul_smul] + rw [show (((c⁻¹ : ℝ) : ℂ)) * (c : ℂ) = 1 by push_cast; field_simp] + exact one_smul _ A + +/-- **L2.** The essential spectrum scales by a real nonzero `c`: +`essSpectrum (c • A) = (· * c) '' essSpectrum A`. -/ +theorem essSpectrum_smul_real {A : H →ₗ.[ℂ] H} (hA : IsSelfAdjoint A) + (c : ℝ) (hc : c ≠ 0) : + essSpectrum (isSelfAdjoint_smul_real hA c hc) = (fun μ => c * μ) '' essSpectrum hA := by + apply Set.eq_of_subset_of_subset + · intro μ hμ + have _hcℂ : (c : ℂ) ≠ 0 := by exact_mod_cast hc + have hcA_SA : IsSelfAdjoint ((c : ℂ) • A) := isSelfAdjoint_smul_real hA c hc + have hstep := mem_essSpectrum_smul_real hcA_SA c⁻¹ (inv_ne_zero hc) hμ + have hop : ((c⁻¹ : ℝ) : ℂ) • (((c : ℂ)) • A) = A := smul_inv_smul_pmap c hc + refine ⟨c⁻¹ * μ, ?_, by field_simp⟩ + have hess : essSpectrum (isSelfAdjoint_smul_real hcA_SA c⁻¹ (inv_ne_zero hc)) + = essSpectrum hA := + essSpectrum_congr_op _ hA hop + rw [hess] at hstep + exact hstep + · rintro μ ⟨lam, hlam, rfl⟩ + exact mem_essSpectrum_smul_real hA c hc hlam + +end QuantumMechanics.Essential diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/EssentialSpectrum/WeakCompact.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/EssentialSpectrum/WeakCompact.lean new file mode 100644 index 0000000000..9f258ba151 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/EssentialSpectrum/WeakCompact.lean @@ -0,0 +1,111 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem, Adam Bornemann +-/ +module + +public import Mathlib.Analysis.InnerProductSpace.Adjoint +public import Mathlib.Analysis.InnerProductSpace.Orthonormal +public import Mathlib.Analysis.Normed.Operator.Compact.Basic +public import Mathlib.Topology.Sequences + +/-! + +# Compact operators kill weakly-null sequences + +Ported, essentially verbatim, from `adambornemann-glitch/Spectra`'s +`SpectralTheory/Essential/WeakCompact.lean` (Apache 2.0). Self-contained Hilbert-space facts, not +tied to any particular unbounded-operator type — the two analytic linchpins behind Weyl's theorem +on the essential spectrum (`Weyl.lean`): + +* `Orthonormal.tendsto_inner_atTop_zero` — an orthonormal sequence is *weakly null*: for every + fixed `g`, `⟪g, ψ n⟫ → 0`. This is Bessel's inequality plus "summable ⟹ terms → 0". + +* `IsCompactOperator.tendsto_norm_apply_of_weaklyNull` — a **compact** operator maps a bounded + weakly-null sequence to a norm-null sequence. This is the single fact that makes the + perturbation argument work: a compact piece does not see the (weakly vanishing) approximate + eigenvectors. + +Both statements phrase weak convergence *concretely* (`∀ g, ⟪g, u n⟫ → 0`), never via the weak +topology — so the proofs use only `IsCompact.tendsto_subseq` and the continuity of the inner +product, avoiding Banach–Alaoglu entirely. + +-/ + +@[expose] public section + +noncomputable section + +open Filter Topology +open scoped InnerProductSpace + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +omit [CompleteSpace H] in +/-- An orthonormal sequence is **weakly null**: for every fixed `g`, the inner products +`⟪g, ψ n⟫` tend to `0`. (Bessel's inequality makes `∑ ‖⟪ψ n, g⟫‖²` summable, so its terms — hence +`‖⟪g, ψ n⟫‖` — tend to `0`.) -/ +theorem Orthonormal.tendsto_inner_atTop_zero {ψ : ℕ → H} (hψ : Orthonormal ℂ ψ) (g : H) : + Tendsto (fun n => ⟪g, ψ n⟫_ℂ) atTop (𝓝 0) := by + have hsq : Tendsto (fun n => ‖⟪ψ n, g⟫_ℂ‖ ^ 2) atTop (𝓝 0) := + (hψ.inner_products_summable g).tendsto_atTop_zero + have hnorm : Tendsto (fun n => ‖⟪ψ n, g⟫_ℂ‖) atTop (𝓝 0) := by + have key : (fun n => ‖⟪ψ n, g⟫_ℂ‖) = fun n => Real.sqrt (‖⟪ψ n, g⟫_ℂ‖ ^ 2) := by + funext n; rw [Real.sqrt_sq (norm_nonneg _)] + rw [key] + exact Real.sqrt_zero ▸ (Real.continuous_sqrt.tendsto 0).comp hsq + rw [tendsto_zero_iff_norm_tendsto_zero] + have heq : (fun n => ‖⟪g, ψ n⟫_ℂ‖) = fun n => ‖⟪ψ n, g⟫_ℂ‖ := + funext fun n => norm_inner_symm g (ψ n) + rw [heq]; exact hnorm + +/-- A **compact** operator maps a bounded weakly-null sequence to a norm-null sequence. + +`hbdd` bounds the sequence (`‖u n‖ ≤ C`); `hweak` is weak nullness stated concretely as +`∀ g, ⟪g, u n⟫ → 0`. The proof: if `‖K (u n)‖` does *not* tend to `0`, extract a subsequence on +which it stays `≥ ε`; it lands in the compact set `closure (K '' closedBall 0 C)`, so a further +subsequence converges in norm to some `a`; weak nullness (via the adjoint) forces `⟪a, a⟫ = 0`, +i.e. `a = 0`, contradicting `ε ≤ ‖a‖`. -/ +theorem IsCompactOperator.tendsto_norm_apply_of_weaklyNull + {K : H →L[ℂ] H} (hK : IsCompactOperator (K : H → H)) {u : ℕ → H} {C : ℝ} + (hbdd : ∀ n, ‖u n‖ ≤ C) + (hweak : ∀ g : H, Tendsto (fun n => ⟪g, u n⟫_ℂ) atTop (𝓝 0)) : + Tendsto (fun n => ‖K (u n)‖) atTop (𝓝 0) := by + by_contra hcon + rw [Metric.tendsto_atTop] at hcon + push Not at hcon + obtain ⟨ε, hε, hfreq⟩ := hcon + -- Frequently, `‖K (u n)‖ ≥ ε`. + have hfreq' : ∃ᶠ n in atTop, ε ≤ ‖K (u n)‖ := by + rw [frequently_atTop] + intro N + obtain ⟨n, hn, hdist⟩ := hfreq N + exact ⟨n, hn, by rwa [Real.dist_eq, sub_zero, abs_of_nonneg (norm_nonneg _)] at hdist⟩ + obtain ⟨φ, hφ_mono, hφ⟩ := extraction_of_frequently_atTop hfreq' + -- The tail lands in a fixed compact set. + obtain ⟨S, hS_compact, hS_sub⟩ := + IsCompactOperator.image_closedBall_subset_compact (f := (K : H →ₗ[ℂ] H)) hK C + have hmem : ∀ n, K (u (φ n)) ∈ S := by + intro n + apply hS_sub + exact ⟨u (φ n), by simpa [Metric.mem_closedBall, dist_eq_norm, sub_zero] using hbdd (φ n), rfl⟩ + obtain ⟨a, _, ψ, hψ_mono, hψ_tend⟩ := hS_compact.tendsto_subseq hmem + -- Weak nullness identifies the limit as `0`. + have ha0 : a = 0 := by + have h1 : Tendsto (fun n => ⟪a, K (u (φ (ψ n)))⟫_ℂ) atTop (𝓝 ⟪a, a⟫_ℂ) := + Tendsto.inner tendsto_const_nhds hψ_tend + have h2 : Tendsto (fun n => ⟪a, K (u (φ (ψ n)))⟫_ℂ) atTop (𝓝 0) := by + have hcomp : Tendsto (fun n => φ (ψ n)) atTop atTop := + (hφ_mono.comp hψ_mono).tendsto_atTop + have hw : Tendsto (fun n => ⟪ContinuousLinearMap.adjoint K a, u (φ (ψ n))⟫_ℂ) atTop (𝓝 0) := + (hweak (ContinuousLinearMap.adjoint K a)).comp hcomp + refine hw.congr (fun n => ?_) + exact ContinuousLinearMap.adjoint_inner_left K (u (φ (ψ n))) a + have hzero : ⟪a, a⟫_ℂ = 0 := tendsto_nhds_unique h1 h2 + exact inner_self_eq_zero.mp hzero + -- But the norm along the subsequence stays `≥ ε`. + have hnorm_tend : Tendsto (fun n => ‖K (u (φ (ψ n)))‖) atTop (𝓝 ‖a‖) := hψ_tend.norm + have hε_le : ε ≤ ‖a‖ := ge_of_tendsto' hnorm_tend (fun n => hφ (ψ n)) + rw [ha0, norm_zero] at hε_le + exact absurd hε_le (not_le.mpr hε) diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/EssentialSpectrum/Weyl.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/EssentialSpectrum/Weyl.lean new file mode 100644 index 0000000000..7a8fc39398 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/EssentialSpectrum/Weyl.lean @@ -0,0 +1,257 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem, Adam Bornemann +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.EssentialSpectrum.Defs +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.EssentialSpectrum.WeakCompact + +/-! + +# Weyl's theorem: invariance of the essential spectrum under a compact resolvent perturbation + +Ported and adapted from `adambornemann-glitch/Spectra`'s `SpectralTheory/Essential/Weyl.lean` +(Apache 2.0). See `EXTERNAL_INTEGRATION_PLAN.md` §3.4. + +If `A`, `B` are self-adjoint operators whose resolvents at `i` differ by a **compact** operator, +then `essSpectrum hA = essSpectrum hB`. + +## The missing bridge (honesty note) + +Spectra proves this against its own `selfAdjointResolvent hA z hz : H →L[ℂ] H`, a genuine bounded +operator built elsewhere in Spectra (`Spectra.Resolvent`) from `IsSelfAdjoint` alone: injectivity +of `A − z•1` off the real axis (from symmetry) plus surjectivity (already available here, +`LinearPMap.IsSelfAdjoint.sub_smul_surjective`) give a linear bijection `H ≃ A.domain`, and then a +**closed graph theorem** argument upgrades continuity of the inverse to boundedness. + +This repo already has the *partial-operator* resolvent `𝑅 T z := (T - z • 1).inverse` +(`Physlib.QuantumMechanics.Operators.SpectralTheory.Basic`), and knows `𝑅 A z` is total (domain +`⊤`) and continuous whenever `z ∈ resolventSet A` — but does not yet package "total + continuous" +into a `H →L[ℂ] H` bundled continuous linear map (the last, purely bureaucratic step of the closed +graph argument: `LinearMap.mkContinuous`-style repackaging of a `LinearPMap` with domain `⊤`). +Building that packaging is a well-scoped, non-heroic remaining task (bounded by the 20–30 minute +budget for this port, this file does not attempt it) — once it exists, `IsResolventAt` below +becomes a *derived* fact about `𝑅 A I` rather than a standing hypothesis, and every theorem in +this file specializes immediately (no proof surgery needed: only the hypothesis `hRA`/`hRB` needs +discharging). + +In the meantime, `IsResolventAt` axiomatizes exactly the three properties Spectra's +`selfAdjointResolvent` is proved to have (`selfAdjointResolvent_mem_domain`, +`selfAdjointResolvent_solves`, `selfAdjointResolvent_left_inverse`) and every theorem below is +proved from those three properties alone — so the mathematical content of Weyl's theorem is fully +ported and machine-checked; only the *existence* of a bounded resolvent operator satisfying them is +left as a hypothesis instead of a constructed witness. + +## Main results + +* `essSpectrum_subset_of_isCompactOperator_resolvent_sub` — one inclusion. +* `essSpectrum_eq_of_isCompactOperator_resolvent_sub` — **Weyl's theorem**. +* `essSpectrum_eq_of_isCompactOperator_perturb` — the relatively-compact-perturbation form + (`B = A + (compact)·(resolvent)`), the form that applies to Schrödinger operators. + +-/ + +@[expose] public section + +noncomputable section + +open Filter Topology Complex +open scoped InnerProductSpace + +namespace QuantumMechanics.Essential + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-- `i` is off the real axis, the spectral parameter used throughout. -/ +theorem I_im_ne_zero : (Complex.I).im ≠ 0 := by rw [Complex.I_im]; exact one_ne_zero + +/-! ### The bounded resolvent, axiomatized by its three defining properties + +See the module docstring: this is the honesty-note bridge in place of a constructed bounded +resolvent operator. -/ + +/-- `R` is *the* (bounded) resolvent of the self-adjoint operator `A` at `z`: it lands in +`A.domain`, solves `(A - z)(Rφ) = φ`, and is a left inverse of `A - z` on `A.domain`. Once this +repo has a `H →L[ℂ] H` packaging of the existing partial resolvent `𝑅 A z` +(`Physlib.QuantumMechanics.Operators.SpectralTheory.Basic`), `𝑅 A z` will satisfy this predicate +and can replace the standing hypothesis everywhere below. -/ +structure IsResolventAt {A : H →ₗ.[ℂ] H} (_hA : IsSelfAdjoint A) (z : ℂ) + (R : H →L[ℂ] H) : Prop where + mem_domain : ∀ φ, R φ ∈ A.domain + solves : ∀ φ, A ⟨R φ, mem_domain φ⟩ - z • R φ = φ + left_inverse : ∀ ψ : A.domain, R (A ψ - z • (ψ : H)) = (ψ : H) + +/-! ### Weyl's theorem -/ + +/-- **One inclusion of Weyl's theorem.** If the resolvent difference `R_B(i) − R_A(i)` is compact, +then `essSpectrum hA ⊆ essSpectrum hB`. -/ +theorem essSpectrum_subset_of_isCompactOperator_resolvent_sub + {A B : H →ₗ.[ℂ] H} (hA : IsSelfAdjoint A) (hB : IsSelfAdjoint B) + {RA RB : H →L[ℂ] H} (hRA : IsResolventAt hA I RA) (hRB : IsResolventAt hB I RB) + (hcompact : IsCompactOperator ((RB - RA : H →L[ℂ] H) : H → H)) : + essSpectrum hA ⊆ essSpectrum hB := by + intro lam hlam + obtain ⟨ψ, hψ_norm, hψ_weak, hψ_eig⟩ := hlam + -- `R_A(i)·(A − i)ψ n = ψ n`. + have hRAinv : ∀ n, RA (A (ψ n) - I • (ψ n : H)) = (ψ n : H) := + fun n => hRA.left_inverse (ψ n) + -- `R_B(i)·(A − i)ψ n = ψ n + K·(A − i)ψ n`. + have hΦval : ∀ n, RB (A (ψ n) - I • (ψ n : H)) + = (ψ n : H) + (RB - RA) (A (ψ n) - I • (ψ n : H)) := by + intro n + rw [sub_apply, hRAinv n]; abel + -- `(A − λ)ψ n → 0` as vectors. + have hAeig : Tendsto (fun n => A (ψ n) - (lam : ℂ) • (ψ n : H)) atTop (𝓝 0) := + tendsto_zero_iff_norm_tendsto_zero.mpr hψ_eig + -- `(A − i)ψ n` is weakly null. + have hw_weak : ∀ g : H, Tendsto (fun n => ⟪g, A (ψ n) - I • (ψ n : H)⟫_ℂ) atTop (𝓝 0) := by + intro g + have e1 : Tendsto (fun n => ⟪g, A (ψ n) - (lam : ℂ) • (ψ n : H)⟫_ℂ) atTop (𝓝 0) := by + have h : Tendsto (fun n => ⟪g, A (ψ n) - (lam : ℂ) • (ψ n : H)⟫_ℂ) atTop + (𝓝 (⟪g, (0 : H)⟫_ℂ)) := Tendsto.inner tendsto_const_nhds hAeig + simpa only [inner_zero_right] using h + have e2 : Tendsto (fun n => ((lam : ℂ) - I) * ⟪g, (ψ n : H)⟫_ℂ) atTop (𝓝 0) := by + simpa using (hψ_weak g).const_mul ((lam : ℂ) - I) + have hsum := e1.add e2 + rw [add_zero] at hsum + refine hsum.congr (fun n => ?_) + rw [inner_sub_right, inner_smul_right, inner_sub_right, inner_smul_right]; ring + -- `(A − i)ψ n` is bounded. + have hw_bdd : ∃ C, ∀ n, ‖A (ψ n) - I • (ψ n : H)‖ ≤ C := by + have hb : Tendsto (fun n => ‖A (ψ n) - (lam : ℂ) • (ψ n : H)‖ + + ‖(lam : ℂ) - I‖ * ‖(ψ n : H)‖) atTop (𝓝 (0 + ‖(lam : ℂ) - I‖ * 1)) := + hψ_eig.add (hψ_norm.const_mul ‖(lam : ℂ) - I‖) + obtain ⟨C, hC⟩ := hb.bddAbove_range + refine ⟨C, fun n => le_trans ?_ (hC (Set.mem_range_self n))⟩ + calc ‖A (ψ n) - I • (ψ n : H)‖ + = ‖(A (ψ n) - (lam : ℂ) • (ψ n : H)) + ((lam : ℂ) - I) • (ψ n : H)‖ := by + congr 1; module + _ ≤ ‖A (ψ n) - (lam : ℂ) • (ψ n : H)‖ + ‖((lam : ℂ) - I) • (ψ n : H)‖ := norm_add_le _ _ + _ = ‖A (ψ n) - (lam : ℂ) • (ψ n : H)‖ + ‖(lam : ℂ) - I‖ * ‖(ψ n : H)‖ := by rw [norm_smul] + -- `K·(A − i)ψ n → 0`. + obtain ⟨C, hC⟩ := hw_bdd + have hKw : Tendsto (fun n => ‖(RB - RA) (A (ψ n) - I • (ψ n : H))‖) atTop (𝓝 0) := + IsCompactOperator.tendsto_norm_apply_of_weaklyNull hcompact hC hw_weak + have hKw0 : Tendsto (fun n => (RB - RA) (A (ψ n) - I • (ψ n : H))) atTop (𝓝 0) := + tendsto_zero_iff_norm_tendsto_zero.mpr hKw + -- `R_B(i)·(A − i)ψ n − ψ n = K·(A − i)ψ n`. + have hsub : ∀ n, RB (A (ψ n) - I • (ψ n : H)) - (ψ n : H) + = (RB - RA) (A (ψ n) - I • (ψ n : H)) := fun n => by rw [hΦval n]; abel + -- Assemble the perturbed Weyl sequence `φ n := R_B(i)·(A − i)ψ n`. + refine mem_essSpectrum_of_seq hB lam + (fun n => RB (A (ψ n) - I • (ψ n : H))) + (fun n => hRB.mem_domain _) ?_ ?_ ?_ + · -- `‖φ n‖ → 1`. + have hgtend : Tendsto (fun n => -‖(RB - RA) (A (ψ n) - I • (ψ n : H))‖) atTop (𝓝 0) := by + simpa only [neg_zero] using hKw.neg + have hnormdiff : Tendsto (fun n => ‖RB (A (ψ n) - I • (ψ n : H))‖ - ‖(ψ n : H)‖) + atTop (𝓝 0) := by + refine tendsto_of_tendsto_of_tendsto_of_le_of_le hgtend hKw ?_ ?_ + · intro n + have hb := abs_norm_sub_norm_le (RB (A (ψ n) - I • (ψ n : H))) ((ψ n : H)) + rw [hsub n] at hb + exact (abs_le.mp hb).1 + · intro n + have hb := abs_norm_sub_norm_le (RB (A (ψ n) - I • (ψ n : H))) ((ψ n : H)) + rw [hsub n] at hb + exact (abs_le.mp hb).2 + have hfin := hnormdiff.add hψ_norm + rw [zero_add] at hfin + exact hfin.congr (fun n => by ring) + · -- `φ` weakly null. + intro g + have e1 : Tendsto (fun n => ⟪g, (ψ n : H)⟫_ℂ) atTop (𝓝 0) := hψ_weak g + have e2 : Tendsto (fun n => ⟪g, (RB - RA) (A (ψ n) - I • (ψ n : H))⟫_ℂ) atTop (𝓝 0) := by + have h : Tendsto (fun n => ⟪g, (RB - RA) (A (ψ n) - I • (ψ n : H))⟫_ℂ) atTop + (𝓝 (⟪g, (0 : H)⟫_ℂ)) := Tendsto.inner tendsto_const_nhds hKw0 + simpa only [inner_zero_right] using h + have hsum := e1.add e2 + rw [add_zero] at hsum + refine hsum.congr (fun n => ?_) + rw [← inner_add_right, ← hΦval n] + · -- `(B − λ)φ n → 0`. + have hKterm : Tendsto (fun n => ((lam : ℂ) - I) • (RB - RA) (A (ψ n) - I • (ψ n : H))) + atTop (𝓝 0) := by + simpa only [smul_zero] using hKw0.const_smul ((lam : ℂ) - I) + have hc_vec : Tendsto (fun n => + B ⟨RB (A (ψ n) - I • (ψ n : H)), hRB.mem_domain _⟩ + - (lam : ℂ) • RB (A (ψ n) - I • (ψ n : H))) + atTop (𝓝 0) := by + have hsum := hAeig.sub hKterm + rw [sub_zero] at hsum + refine hsum.congr (fun n => ?_) + have hsolve := hRB.solves (A (ψ n) - I • (ψ n : H)) + have hBΦ : B ⟨RB (A (ψ n) - I • (ψ n : H)), hRB.mem_domain _⟩ + = (A (ψ n) - I • (ψ n : H)) + I • RB (A (ψ n) - I • (ψ n : H)) := + sub_eq_iff_eq_add.mp hsolve + rw [hBΦ, hΦval n]; module + exact tendsto_zero_iff_norm_tendsto_zero.mp hc_vec + +/-- **Weyl's theorem.** If the resolvents `R_A(i)`, `R_B(i)` of two self-adjoint operators differ +by a compact operator, then `A` and `B` have the same essential spectrum. -/ +theorem essSpectrum_eq_of_isCompactOperator_resolvent_sub + {A B : H →ₗ.[ℂ] H} (hA : IsSelfAdjoint A) (hB : IsSelfAdjoint B) + {RA RB : H →L[ℂ] H} (hRA : IsResolventAt hA I RA) (hRB : IsResolventAt hB I RB) + (hcompact : IsCompactOperator ((RB - RA : H →L[ℂ] H) : H → H)) : + essSpectrum hA = essSpectrum hB := by + apply Set.Subset.antisymm + · exact essSpectrum_subset_of_isCompactOperator_resolvent_sub hA hB hRA hRB hcompact + · apply essSpectrum_subset_of_isCompactOperator_resolvent_sub hB hA hRB hRA + have hCLM : (RA - RB : H →L[ℂ] H) = -(RB - RA) := by abel + rw [hCLM] + exact hcompact.neg + +/-! ### On-ramp: relatively compact perturbations -/ + +/-- **On-ramp from a relatively compact perturbation.** If `B − A` is represented on `D(A)` by a +*bounded compact* operator post-composed with `(A − i)` — i.e. there is a compact +`W : H →L[ℂ] H` with `(B − A)χ = W ((A − i)χ)` for every `χ ∈ D(A)` (think `W = V·R_A(i)`) — then +the resolvent difference `R_B(i) − R_A(i)` is compact. The proof is the second resolvent identity +in disguise: `R_B(i)ψ = R_A(i)ψ − R_B(i)(W ψ)`, so `R_B(i) − R_A(i) = −R_B(i) ∘ W`, compact +because `W` is. -/ +theorem isCompactOperator_resolvent_sub_of_isCompactOperator_perturb + {A B : H →ₗ.[ℂ] H} (hA : IsSelfAdjoint A) (hB : IsSelfAdjoint B) + {RA RB : H →L[ℂ] H} (hRA : IsResolventAt hA I RA) (hRB : IsResolventAt hB I RB) + (hdom : A.domain = B.domain) (W : H →L[ℂ] H) (hW : IsCompactOperator (W : H → H)) + (hVW : ∀ (χ : H) (hχ : χ ∈ A.domain), + B ⟨χ, hdom ▸ hχ⟩ - A ⟨χ, hχ⟩ = W (A ⟨χ, hχ⟩ - I • χ)) : + IsCompactOperator ((RB - RA : H →L[ℂ] H) : H → H) := by + have key : (RB - RA) = -(RB.comp W) := by + ext ψ + simp only [sub_apply, neg_apply, + ContinuousLinearMap.comp_apply] + set χ := RA ψ with _hχ + have memA : χ ∈ A.domain := hRA.mem_domain ψ + have hsolveA : A ⟨χ, memA⟩ - I • χ = ψ := hRA.solves ψ + have hinvB : RB (B ⟨χ, hdom ▸ memA⟩ - I • χ) = χ := + hRB.left_inverse ⟨χ, hdom ▸ memA⟩ + have hWχ : B ⟨χ, hdom ▸ memA⟩ - A ⟨χ, memA⟩ = W ψ := by rw [hVW χ memA, hsolveA] + have hRBψ : RB ψ = χ - RB (W ψ) := by + have h1 : ψ = (B ⟨χ, hdom ▸ memA⟩ - I • χ) - (B ⟨χ, hdom ▸ memA⟩ - A ⟨χ, memA⟩) := by + rw [← hsolveA]; abel + calc RB ψ + = RB ((B ⟨χ, hdom ▸ memA⟩ - I • χ) - (B ⟨χ, hdom ▸ memA⟩ - A ⟨χ, memA⟩)) := by rw [h1] + _ = RB (B ⟨χ, hdom ▸ memA⟩ - I • χ) - RB (B ⟨χ, hdom ▸ memA⟩ - A ⟨χ, memA⟩) := by + rw [map_sub] + _ = χ - RB (W ψ) := by rw [hinvB, hWχ] + rw [hRBψ]; abel + rw [key] + exact (hW.clm_comp RB).neg + +/-- **Weyl's theorem for relatively compact perturbations.** If `B − A` is given on `D(A)` by a +compact `W = V·R_A(i)` (see `isCompactOperator_resolvent_sub_of_isCompactOperator_perturb`), then +`A` and `B` have the same essential spectrum. This is the form that applies to Schrödinger +operators `B = −Δ + V` with `V` relatively compact (e.g. the hydrogen Hamiltonian). -/ +theorem essSpectrum_eq_of_isCompactOperator_perturb + {A B : H →ₗ.[ℂ] H} (hA : IsSelfAdjoint A) (hB : IsSelfAdjoint B) + {RA RB : H →L[ℂ] H} (hRA : IsResolventAt hA I RA) (hRB : IsResolventAt hB I RB) + (hdom : A.domain = B.domain) (W : H →L[ℂ] H) (hW : IsCompactOperator (W : H → H)) + (hVW : ∀ (χ : H) (hχ : χ ∈ A.domain), + B ⟨χ, hdom ▸ hχ⟩ - A ⟨χ, hχ⟩ = W (A ⟨χ, hχ⟩ - I • χ)) : + essSpectrum hA = essSpectrum hB := + essSpectrum_eq_of_isCompactOperator_resolvent_sub hA hB hRA hRB + (isCompactOperator_resolvent_sub_of_isCompactOperator_perturb hA hB hRA hRB hdom W hW hVW) + +end QuantumMechanics.Essential diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/CandidateGenerator.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/CandidateGenerator.lean new file mode 100644 index 0000000000..af7c7baab8 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/CandidateGenerator.lean @@ -0,0 +1,177 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Mathlib.LinearAlgebra.LinearPMap +public import Mathlib.Analysis.InnerProductSpace.Calculus +public import Mathlib.Analysis.InnerProductSpace.Adjoint +public import Mathlib.Analysis.Calculus.Deriv.Add +public import Mathlib.Analysis.Calculus.Deriv.Mul +public import Mathlib.Algebra.Star.Unitary +public import Physlib.QuantumMechanics.Operators.SpectralTheory.Symmetric + +/-! +# The candidate Stone generator of an abstract unitary group + +Milestone 2 of `STONE_GENERATOR_EXISTENCE_PLAN.md`: given a strongly continuous one-parameter +unitary group `U`, define the candidate self-adjoint generator as a `LinearPMap`, whose domain is +exactly the set of vectors along whose orbit `U` is differentiable at `t = 0`, and whose action is +`-i` times that derivative (matching the `U t = exp(-it Hgen)` convention already used in +`DynamicsTransport.lean`). + +This file only builds the *definition* and proves it is well-formed (domain is a submodule, the +action is linear) and *symmetric*. It does **not** prove the domain is dense (that's +`GardingVectors.lean`, a separate file with no dependency on this one beyond sharing the same +domain predicate verbatim) and does **not** prove self-adjointness (that needs the resolvent +construction, Milestone 3). + +## Main definitions + +- `stoneCandidateDomain` : the submodule of vectors differentiable at `t = 0` along `U`'s orbit. +- `stoneCandidateGenerator` : the `LinearPMap` sending such a vector to `-i` times its derivative. +- `stoneCandidateGenerator_isSymmetric` : this `LinearPMap` is symmetric. +-/ + +@[expose] public section + +namespace QuantumMechanics + +noncomputable section + +open scoped InnerProductSpace + +universe u + +variable {H : Type u} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] +variable {U : ℝ → H →L[ℂ] H} (hU0 : U 0 = 1) (hUmul : ∀ s t, U (s + t) = U s * U t) + (hUunit : ∀ t, U t ∈ unitary (H →L[ℂ] H)) (hUcont : ∀ ξ : H, Continuous (fun t : ℝ => U t ξ)) + +/-- A vector is in the candidate generator's domain when `U`'s orbit through it is differentiable +at `t = 0`. This exact predicate is shared verbatim with `GardingVectors.lean`'s density lemma. -/ +def stoneCandidateDomainPred (ψ : H) : Prop := ∃ φ : H, HasDerivAt (fun t : ℝ => U t ψ) φ 0 + +omit [CompleteSpace H] in +include hUmul in +/-- The candidate domain is closed under addition: if `U`'s orbit is differentiable at `0` along +`ψ₁` and `ψ₂` separately, it is differentiable along `ψ₁ + ψ₂`, with derivative the sum — because +`U t` is linear, `U t (ψ₁ + ψ₂) = U t ψ₁ + U t ψ₂` for every `t`, not just at `t = 0`, so the two +orbit functions agree identically and `HasDerivAt.add` applies directly. + +`hUmul` is not used in this proof, but is retained so this lemma has the same group parameter as +`stoneCandidateDomain`. -/ +@[nolint unusedArguments] +theorem stoneCandidateDomainPred_add {ψ₁ ψ₂ : H} + (h₁ : stoneCandidateDomainPred (U := U) ψ₁) (h₂ : stoneCandidateDomainPred (U := U) ψ₂) : + stoneCandidateDomainPred (U := U) (ψ₁ + ψ₂) := by + obtain ⟨φ₁, hφ₁⟩ := h₁ + obtain ⟨φ₂, hφ₂⟩ := h₂ + refine ⟨φ₁ + φ₂, ?_⟩ + have hsum : HasDerivAt (fun t : ℝ => U t ψ₁ + U t ψ₂) (φ₁ + φ₂) 0 := hφ₁.add hφ₂ + simpa [map_add] using hsum + +omit [CompleteSpace H] in +/-- The candidate domain is closed under scalar multiplication, by the same linearity argument. -/ +theorem stoneCandidateDomainPred_smul {ψ : H} (c : ℂ) + (h : stoneCandidateDomainPred (U := U) ψ) : + stoneCandidateDomainPred (U := U) (c • ψ) := by + obtain ⟨φ, hφ⟩ := h + refine ⟨c • φ, ?_⟩ + have hsmul : HasDerivAt (fun t : ℝ => c • U t ψ) (c • φ) 0 := hφ.const_smul c + simpa [map_smul] using hsmul + +omit [CompleteSpace H] in +theorem stoneCandidateDomainPred_zero : stoneCandidateDomainPred (U := U) (0 : H) := + ⟨0, by simpa using (hasDerivAt_const (0 : ℝ) (0 : H))⟩ + +variable (U) in +/-- The candidate generator's domain, as a submodule. -/ +def stoneCandidateDomain : Submodule ℂ H where + carrier := {ψ | stoneCandidateDomainPred (U := U) ψ} + zero_mem' := stoneCandidateDomainPred_zero + add_mem' h₁ h₂ := stoneCandidateDomainPred_add hUmul h₁ h₂ + smul_mem' c _ h := stoneCandidateDomainPred_smul c h + +/-- The derivative witness for a vector in the candidate domain, chosen once and for all via +choice; `-Complex.I` times this is the candidate generator's action. -/ +def stoneCandidateDeriv (ψ : stoneCandidateDomain (U := U) hUmul) : H := + ψ.property.choose + +omit [CompleteSpace H] in +theorem stoneCandidateDeriv_spec (ψ : stoneCandidateDomain (U := U) hUmul) : + HasDerivAt (fun t : ℝ => U t (ψ : H)) (stoneCandidateDeriv hUmul ψ) 0 := + ψ.property.choose_spec + +omit [CompleteSpace H] in +theorem stoneCandidateDeriv_add (ψ₁ ψ₂ : stoneCandidateDomain (U := U) hUmul) : + stoneCandidateDeriv hUmul (ψ₁ + ψ₂) = + stoneCandidateDeriv hUmul ψ₁ + stoneCandidateDeriv hUmul ψ₂ := by + apply HasDerivAt.unique (stoneCandidateDeriv_spec hUmul (ψ₁ + ψ₂)) + have hsum : HasDerivAt (fun t : ℝ => U t (ψ₁ : H) + U t (ψ₂ : H)) + (stoneCandidateDeriv hUmul ψ₁ + stoneCandidateDeriv hUmul ψ₂) 0 := + (stoneCandidateDeriv_spec hUmul ψ₁).add (stoneCandidateDeriv_spec hUmul ψ₂) + have hco : ((ψ₁ + ψ₂ : stoneCandidateDomain (U := U) hUmul) : H) = (ψ₁ : H) + (ψ₂ : H) := rfl + simpa [hco, map_add] using hsum + +omit [CompleteSpace H] in +theorem stoneCandidateDeriv_smul (c : ℂ) (ψ : stoneCandidateDomain (U := U) hUmul) : + stoneCandidateDeriv hUmul (c • ψ) = c • stoneCandidateDeriv hUmul ψ := by + apply HasDerivAt.unique (stoneCandidateDeriv_spec hUmul (c • ψ)) + have hsmul : HasDerivAt (fun t : ℝ => c • U t (ψ : H)) (c • stoneCandidateDeriv hUmul ψ) 0 := + (stoneCandidateDeriv_spec hUmul ψ).const_smul c + have hco : ((c • ψ : stoneCandidateDomain (U := U) hUmul) : H) = c • (ψ : H) := rfl + simpa [hco, map_smul] using hsmul + +/-- The candidate generator's action as a genuine `ℂ`-linear map on its domain. -/ +def stoneCandidateLinearMap : + stoneCandidateDomain (U := U) hUmul →ₗ[ℂ] H where + toFun ψ := (-Complex.I) • stoneCandidateDeriv hUmul ψ + map_add' ψ₁ ψ₂ := by rw [stoneCandidateDeriv_add, smul_add] + map_smul' c ψ := by + simp only [RingHom.id_apply, stoneCandidateDeriv_smul, smul_comm (-Complex.I) c] + +/-- The candidate Stone generator: a `LinearPMap` whose domain is exactly the vectors along which +`U`'s orbit is differentiable at `0`, sending such a vector to `-i` times that derivative. -/ +def stoneCandidateGenerator : H →ₗ.[ℂ] H where + domain := stoneCandidateDomain (U := U) hUmul + toFun := stoneCandidateLinearMap hUmul + +omit [CompleteSpace H] in +theorem stoneCandidateGenerator_apply (ψ : (stoneCandidateGenerator (U := U) hUmul).domain) : + stoneCandidateGenerator (U := U) hUmul ψ = (-Complex.I) • stoneCandidateDeriv hUmul ψ := rfl + +include hU0 hUunit in +/-- The candidate generator is symmetric: `⟪Aψ₁, ψ₂⟫ = ⟪ψ₁, Aψ₂⟫` for `ψ₁, ψ₂` in its domain. + +Proof sketch: `t ↦ ⟪U t ψ₁, U t ψ₂⟫` is constant (unitarity), so its derivative at `0` vanishes; +the product rule turns that into `⟪φ₁, ψ₂⟫ + ⟪ψ₁, φ₂⟫ = 0` where `φᵢ` is the derivative witness for +`ψᵢ`, which rearranges to the symmetry statement for `A = -i • φ`. The two genuinely analytic +inputs (constancy of the inner product along the group, and the product-rule derivative of an +inner product of two `H`-valued curves) are isolated below rather than reproven inline. -/ +theorem stoneCandidateGenerator_isSymmetric : + (stoneCandidateGenerator (U := U) hUmul).IsSymmetric := by + intro ψ₁ ψ₂ + set φ₁ := stoneCandidateDeriv hUmul ψ₁ + set φ₂ := stoneCandidateDeriv hUmul ψ₂ + have hconst : ∀ t : ℝ, ⟪U t (ψ₁ : H), U t (ψ₂ : H)⟫_ℂ = ⟪(ψ₁ : H), (ψ₂ : H)⟫_ℂ := by + intro t + exact ContinuousLinearMap.inner_map_map_of_mem_unitary (hUunit t) (ψ₁ : H) (ψ₂ : H) + have hderiv0 : HasDerivAt (fun t : ℝ => ⟪U t (ψ₁ : H), U t (ψ₂ : H)⟫_ℂ) + (⟪φ₁, (ψ₂ : H)⟫_ℂ + ⟪(ψ₁ : H), φ₂⟫_ℂ) 0 := by + have hraw := (stoneCandidateDeriv_spec hUmul ψ₁).inner ℂ (stoneCandidateDeriv_spec hUmul ψ₂) + simp only [hU0, one_apply_eq_self] at hraw + rw [add_comm] at hraw + exact hraw + have hconstfun : HasDerivAt (fun t : ℝ => ⟪U t (ψ₁ : H), U t (ψ₂ : H)⟫_ℂ) 0 0 := by + have hfun : (fun t : ℝ => ⟪U t (ψ₁ : H), U t (ψ₂ : H)⟫_ℂ) = + fun _ : ℝ => ⟪(ψ₁ : H), (ψ₂ : H)⟫_ℂ := funext hconst + rw [hfun] + exact hasDerivAt_const 0 _ + have hzero : ⟪φ₁, (ψ₂ : H)⟫_ℂ + ⟪(ψ₁ : H), φ₂⟫_ℂ = 0 := hderiv0.unique hconstfun + show ⟪(-Complex.I) • φ₁, (ψ₂ : H)⟫_ℂ = ⟪(ψ₁ : H), (-Complex.I) • φ₂⟫_ℂ + rw [inner_smul_left, inner_smul_right] + have hconjI : (starRingEnd ℂ) (-Complex.I) = Complex.I := by simp + rw [hconjI] + linear_combination Complex.I * hzero diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/GardingVectorWitness.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/GardingVectorWitness.lean new file mode 100644 index 0000000000..beeb2dc2c6 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/GardingVectorWitness.lean @@ -0,0 +1,173 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Existence.IteratedKernelGrowth +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.AnalyticVector.Basic + +/-! +# The full `IsAnalyticVector` witness for Gårding vectors (Milestone 2 of Track A, completed) + +The capstone of `STONE_GENERATOR_EXISTENCE_PLAN.md`'s Milestone 1′: `analyticGardingVector U ε ψ` +is a genuine `LinearPMap.IsAnalyticVector` of `stoneCandidateGenerator`, for *every* strongly +continuous one-parameter unitary group `U` and every `ψ`. Combined with the ported Nelson's +analytic-vector theorem (`AnalyticVector/Nelson.lean`), this is the existence direction of Stone's +theorem via Gårding vectors, entirely avoiding the classical Bochner/spectral-measure route. + +## The assembly + +Write `Gₙ := gardingVectorAt U (iteratedDeriv n (gaussianKernel ε)) ψ` (so `G₀ = +analyticGardingVector U ε ψ`, `rfl`). `gardingVectorAt_iteratedKernel_hasDerivAt` +(`IteratedKernelGrowth.lean`) gives, for +every `n`: `Gₙ ∈ (stoneCandidateGenerator hUmul).domain` and +`stoneCandidateGenerator hUmul Gₙ = I • Gₙ₊₁` (the same argument as +`stoneCandidateGenerator_analyticGardingVector`, one order at a time). Since `T` is linear on its +domain, `v n := Iⁿ • ⟨Gₙ, _⟩` then satisfies the `IteratesSeq` recursion exactly (the factor of `I` +at each step is absorbed by the extra power of `I` on the left): `T (v n) = Iⁿ • (T Gₙ) = Iⁿ • (I • +Gₙ₊₁) = Iⁿ⁺¹ • Gₙ₊₁ = v (n+1)`. Since `|I| = 1`, `‖(v n : H)‖ = ‖Gₙ‖`, bounded via +`gaussianKernel_iteratedDeriv_L1_bound` and unitarity by `‖ψ‖ · C^(n+1) · √(n!)`. Choosing `t` +small enough that `C·t < 1` turns the majorant series into a genuine geometric series (dominating +the `1/√(n!) ≤ 1` factor crudely, which is all that is needed for the analytic-vector radius, even +though the true series is far better than geometric) — summable, completing the witness. +-/ + +@[expose] public section + +namespace QuantumMechanics + +noncomputable section + +open scoped InnerProductSpace +open MeasureTheory LinearPMap + +universe u + +variable {H : Type u} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] +variable {U : ℝ → H →L[ℂ] H} (hUmul : ∀ s t, U (s + t) = U s * U t) + +include hUmul in +/-- Domain membership of the `n`-th iterated-kernel Gårding vector, derived (not assumed) from the +differentiability of its orbit — the same pattern as +`analyticGardingVector_mem_stoneCandidateDomain`, one order at a time. -/ +theorem gardingVectorAt_iteratedKernel_mem_stoneCandidateDomain + (hUunit : ∀ t, U t ∈ unitary (H →L[ℂ] H)) (hUcont : ∀ ξ : H, Continuous (fun t : ℝ => U t ξ)) + (n : ℕ) {ε : ℝ} (hε : 0 < ε) (ψ : H) : + gardingVectorAt U (iteratedDeriv n (gaussianKernel ε)) ψ ∈ + (stoneCandidateGenerator (U := U) hUmul).domain := + ⟨_, gardingVectorAt_iteratedKernel_hasDerivAt hUmul hUunit hUcont n hε ψ⟩ + +include hUmul in +/-- The commutation identity at every order: applying `stoneCandidateGenerator` to `Gₙ` gives (up +to the factor `I`) `Gₙ₊₁`. Exactly `stoneCandidateGenerator_analyticGardingVector`'s proof, one +order at a time. -/ +theorem stoneCandidateGenerator_gardingVectorAt_iteratedKernel + (hUunit : ∀ t, U t ∈ unitary (H →L[ℂ] H)) (hUcont : ∀ ξ : H, Continuous (fun t : ℝ => U t ξ)) + (n : ℕ) {ε : ℝ} (hε : 0 < ε) (ψ : H) : + stoneCandidateGenerator (U := U) hUmul + ⟨gardingVectorAt U (iteratedDeriv n (gaussianKernel ε)) ψ, + gardingVectorAt_iteratedKernel_mem_stoneCandidateDomain hUmul hUunit hUcont n hε ψ⟩ = + (Complex.I : ℂ) • gardingVectorAt U (iteratedDeriv (n + 1) (gaussianKernel ε)) ψ := by + set hmem := gardingVectorAt_iteratedKernel_mem_stoneCandidateDomain hUmul hUunit hUcont n hε ψ + have hspec := stoneCandidateDeriv_spec (U := U) hUmul + (ψ := ⟨gardingVectorAt U (iteratedDeriv n (gaussianKernel ε)) ψ, hmem⟩) + have hderiv_eq := hspec.unique + (gardingVectorAt_iteratedKernel_hasDerivAt hUmul hUunit hUcont n hε ψ) + refine (stoneCandidateGenerator_apply (U := U) hUmul + ⟨gardingVectorAt U (iteratedDeriv n (gaussianKernel ε)) ψ, hmem⟩).trans ?_ + show (-Complex.I) • stoneCandidateDeriv hUmul + (⟨gardingVectorAt U (iteratedDeriv n (gaussianKernel ε)) ψ, hmem⟩ : + stoneCandidateDomain (U := U) hUmul) = + Complex.I • gardingVectorAt U (iteratedDeriv (n + 1) (gaussianKernel ε)) ψ + rw [hderiv_eq] + have hneg : (∫ u : ℝ, ((-(iteratedDeriv (n + 1) (gaussianKernel ε) u) : ℝ) : ℂ) • U u ψ) = + -(gardingVectorAt U (iteratedDeriv (n + 1) (gaussianKernel ε)) ψ) := by + unfold gardingVectorAt + rw [← MeasureTheory.integral_neg] + congr 1 + funext u + push_cast + rw [neg_smul] + rw [hneg, smul_neg, neg_smul, neg_neg] + +include hUmul in +/-- **The full analytic-vector witness.** `analyticGardingVector U ε ψ` is a genuine +`LinearPMap.IsAnalyticVector` of `stoneCandidateGenerator`, for every strongly continuous +one-parameter unitary group `U` and every `ψ` — Milestone 1′ of +`STONE_GENERATOR_EXISTENCE_PLAN.md`, completed. -/ +theorem analyticGardingVector_isAnalyticVector (hUunit : ∀ t, U t ∈ unitary (H →L[ℂ] H)) + (hUcont : ∀ ξ : H, Continuous (fun t : ℝ => U t ξ)) {ε : ℝ} (hε : 0 < ε) (ψ : H) : + (stoneCandidateGenerator (U := U) hUmul).IsAnalyticVector (analyticGardingVector U ε ψ) := by + set T := stoneCandidateGenerator (U := U) hUmul with hT_def + set G : ℕ → H := fun n => gardingVectorAt U (iteratedDeriv n (gaussianKernel ε)) ψ with hG_def + set hmem : ∀ n, G n ∈ T.domain := fun n => + gardingVectorAt_iteratedKernel_mem_stoneCandidateDomain hUmul hUunit hUcont n hε ψ with hmem_def + set v : ℕ → T.domain := fun n => (Complex.I : ℂ) ^ n • (⟨G n, hmem n⟩ : T.domain) with hv_def + have hGval : ∀ n, T ⟨G n, hmem n⟩ = (Complex.I : ℂ) • G (n + 1) := + fun n => stoneCandidateGenerator_gardingVectorAt_iteratedKernel hUmul hUunit hUcont n hε ψ + have hv_coe : ∀ n, (v n : H) = (Complex.I : ℂ) ^ n • G n := fun n => by + rw [hv_def]; simp + have hG0 : G 0 = analyticGardingVector U ε ψ := by + rw [hG_def]; simp [gardingVectorAt, analyticGardingVector] + have hiter : IteratesSeq T (analyticGardingVector U ε ψ) v := by + constructor + · rw [hv_coe, pow_zero, one_smul, hG0] + · intro n + show (v (n + 1) : H) = T (v n) + have hTv : T (v n) = (Complex.I : ℂ) ^ n • T ⟨G n, hmem n⟩ := by + rw [hv_def] + exact LinearPMap.map_smul T ((Complex.I : ℂ) ^ n) ⟨G n, hmem n⟩ + rw [hTv, hGval n, smul_smul, hv_coe, pow_succ] + refine ⟨v, hiter, ?_⟩ + obtain ⟨C, hC_pos, hC⟩ := gaussianKernel_iteratedDeriv_L1_bound (ε := ε) hε + set t : ℝ := 1 / (2 * (C + 1)) with ht_def + have ht_pos : 0 < t := by rw [ht_def]; positivity + have hCt : C * t < 1 := by + have heq : C * t = C / (2 * (C + 1)) := by rw [ht_def]; ring + rw [heq, div_lt_one (by positivity)] + linarith + refine ⟨t, ht_pos, ?_⟩ + have hGnorm : ∀ n, ‖G n‖ ≤ ‖ψ‖ * (C ^ (n + 1) * Real.sqrt n.factorial) := by + intro n + obtain ⟨hint, hbound⟩ := hC n + have hnorm_le : ‖G n‖ ≤ ∫ u : ℝ, |iteratedDeriv n (gaussianKernel ε) u| * ‖ψ‖ := by + rw [hG_def] + unfold gardingVectorAt + refine (norm_integral_le_integral_norm _).trans_eq ?_ + refine integral_congr_ae (ae_of_all _ fun u => ?_) + show ‖((iteratedDeriv n (gaussianKernel ε) u : ℝ) : ℂ) • U u ψ‖ = + |iteratedDeriv n (gaussianKernel ε) u| * ‖ψ‖ + rw [norm_smul, Complex.norm_real, Real.norm_eq_abs, + ContinuousLinearMap.norm_map_of_mem_unitary (hUunit u)] + calc ‖G n‖ ≤ ∫ u : ℝ, |iteratedDeriv n (gaussianKernel ε) u| * ‖ψ‖ := hnorm_le + _ = (∫ u : ℝ, |iteratedDeriv n (gaussianKernel ε) u|) * ‖ψ‖ := + MeasureTheory.integral_mul_const _ _ + _ ≤ (C ^ (n + 1) * Real.sqrt n.factorial) * ‖ψ‖ := + mul_le_mul_of_nonneg_right hbound (norm_nonneg ψ) + _ = ‖ψ‖ * (C ^ (n + 1) * Real.sqrt n.factorial) := by ring + have hv_norm : ∀ n, ‖(v n : H)‖ = ‖G n‖ := fun n => by + rw [hv_coe, norm_smul, norm_pow, Complex.norm_I, one_pow, one_mul] + have hterm_le : ∀ n, ‖(v n : H)‖ * t ^ n / n.factorial ≤ (‖ψ‖ * C) * (C * t) ^ n := by + intro n + have hnfact_pos : (0 : ℝ) < n.factorial := by exact_mod_cast n.factorial_pos + have hsqrt_le : Real.sqrt n.factorial ≤ n.factorial := by + have h1 : (1 : ℝ) ≤ (n.factorial : ℝ) := by exact_mod_cast n.factorial_pos + calc Real.sqrt (n.factorial : ℝ) ≤ Real.sqrt ((n.factorial : ℝ) * n.factorial) := by + apply Real.sqrt_le_sqrt; nlinarith + _ = n.factorial := by rw [← sq]; exact Real.sqrt_sq (by positivity) + have hGn_le : ‖G n‖ ≤ ‖ψ‖ * (C ^ (n + 1) * n.factorial) := by + calc ‖G n‖ ≤ ‖ψ‖ * (C ^ (n + 1) * Real.sqrt n.factorial) := hGnorm n + _ ≤ ‖ψ‖ * (C ^ (n + 1) * n.factorial) := by gcongr + rw [hv_norm, div_le_iff₀ hnfact_pos] + calc ‖G n‖ * t ^ n ≤ (‖ψ‖ * (C ^ (n + 1) * n.factorial)) * t ^ n := + mul_le_mul_of_nonneg_right hGn_le (by positivity) + _ = (‖ψ‖ * C) * (C * t) ^ n * n.factorial := by rw [mul_pow, pow_succ]; ring + apply Summable.of_nonneg_of_le (fun n => by positivity) hterm_le + exact Summable.mul_left _ (summable_geometric_of_lt_one (by positivity) hCt) + +end + +end QuantumMechanics + diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/GardingVectors.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/GardingVectors.lean new file mode 100644 index 0000000000..562bdd7bbf --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/GardingVectors.lean @@ -0,0 +1,447 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Existence.CandidateGenerator +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Existence.GenericGardingKernel +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.AnalyticVector.Basic +public import Mathlib.Analysis.SpecialFunctions.Gaussian.GaussianIntegral +public import Mathlib.Analysis.Calculus.ParametricIntegral + +/-! +# Analytic Gårding vectors for the candidate Stone generator (Milestone 1′) + +`STONE_GENERATOR_EXISTENCE_PLAN.md`'s revised Milestone 1: instead of a compactly-supported bump +(which can never be real-analytic, so its Gårding vectors cannot be analytic vectors of the +generator), mollify against the normalized heat kernel + +`gaussianKernel ε t := (π * ε)⁻¹ᐟ² * Real.exp (-(t ^ 2) / ε)` (`ε > 0`), + +whose Gårding vectors `analyticGardingVector ε ψ := ∫ t, gaussianKernel ε t • U t ψ` are meant to +be simultaneously (a) genuine analytic vectors of `stoneCandidateGenerator` (fed to the ported +Nelson's theorem, Milestone 3′) and (b) dense as `ε → 0` (the heat kernel is an approximate +identity). + +**(b) is fully proved** (`analyticGardingVector_tendsto`), via a scaling change of variables +`t = √ε x` that rewrites the `ε`-dependent Gaussian as a *fixed* kernel (`standardGaussianKernel`) +with all the `ε`-dependence pushed into `U (√ε x) ψ`'s argument — turning the approximate-identity +limit into ordinary dominated convergence instead of an explicit Gaussian-tail estimate. + +**(a) is partially proved**: the commutation identity +`stoneCandidateGenerator_analyticGardingVector` (one derivative) is fully proved via +differentiation under the integral sign, and domain membership +(`analyticGardingVector_mem_stoneCandidateDomain`) is derived from it rather than assumed. The full +`IsAnalyticVector` conclusion (`LinearPMap.IsAnalyticVector`, from the landed Nelson port, +`AnalyticVector/Basic.lean`) needs the same argument iterated to every derivative order plus a +factorial-type `L¹` growth bound on the kernel's iterated derivatives — see +`GaussianKernelGrowth.lean` and `STONE_GENERATOR_EXISTENCE_PLAN.md`'s status log. + +## Main definitions + +- `gaussianKernel` : the normalized heat kernel on `ℝ`. +- `analyticGardingVector` : its Gårding vector, `∫ t, gaussianKernel ε t • U t ψ`. +- `analyticGardingVector_tendsto` : it tends to `ψ` as `ε → 0⁺`. +- `stoneCandidateGenerator_analyticGardingVector` : the one-derivative commutation identity. +- `analyticGardingVector_mem_stoneCandidateDomain` : membership, derived from the above. +-/ + +@[expose] public section + +namespace QuantumMechanics + +noncomputable section + +open scoped InnerProductSpace Topology +open MeasureTheory Filter Real + +universe u + +variable {H : Type u} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] +variable {U : ℝ → H →L[ℂ] H} (hU0 : U 0 = 1) (hUmul : ∀ s t, U (s + t) = U s * U t) + (hUunit : ∀ t, U t ∈ unitary (H →L[ℂ] H)) (hUcont : ∀ ξ : H, Continuous (fun t : ℝ => U t ξ)) + +/-- The normalized heat kernel: a Gaussian of variance `ε / 2`, normalized to integrate to `1`. +Unlike a compactly-supported bump, this is real-analytic in `t` for every fixed `ε > 0` — the +whole point of switching kernels for Milestone 1′. -/ +def gaussianKernel (ε t : ℝ) : ℝ := (Real.pi * ε) ^ (-(1 : ℝ) / 2) * Real.exp (-(t ^ 2) / ε) + +theorem gaussianKernel_pos {ε : ℝ} (hε : 0 < ε) (t : ℝ) : 0 < gaussianKernel ε t := by + unfold gaussianKernel + have hbase : (0 : ℝ) < Real.pi * ε := by positivity + positivity + +theorem gaussianKernel_integral {ε : ℝ} (hε : 0 < ε) : + ∫ t : ℝ, gaussianKernel ε t = 1 := by + unfold gaussianKernel + rw [MeasureTheory.integral_const_mul] + have hrw : (fun t : ℝ => Real.exp (-(t ^ 2) / ε)) = fun t : ℝ => Real.exp (-(1 / ε) * t ^ 2) := by + funext t; ring_nf + rw [hrw, integral_gaussian (1 / ε)] + rw [show Real.pi / (1 / ε) = Real.pi * ε by field_simp] + rw [Real.sqrt_eq_rpow, ← Real.rpow_add (by positivity : (0:ℝ) < Real.pi * ε)] + norm_num + +/-- The heat kernel is integrable against any bounded continuous function, in particular against +`t ↦ U t ψ` (bounded because `U t` is unitary, `‖U t ψ‖ = ‖ψ‖`). -/ +theorem gaussianKernel_smul_integrable (hUunit : ∀ t, U t ∈ unitary (H →L[ℂ] H)) + (hUcont : ∀ ξ : H, Continuous (fun t : ℝ => U t ξ)) + {ε : ℝ} (hε : 0 < ε) (ψ : H) : + Integrable (fun t : ℝ => (gaussianKernel ε t : ℂ) • U t ψ) := by + have hexp_int : Integrable (fun t : ℝ => Real.exp (-(t ^ 2) / ε)) := by + have heq : (fun t : ℝ => Real.exp (-(t ^ 2) / ε)) = + fun t : ℝ => Real.exp (-(1 / ε) * t ^ 2) := by + funext t; ring_nf + rw [heq] + exact integrable_exp_neg_mul_sq (by positivity) + have hkernel_int : Integrable (gaussianKernel ε) := by + unfold gaussianKernel + exact hexp_int.const_mul _ + have hg_int : Integrable (fun t : ℝ => gaussianKernel ε t * ‖ψ‖) := hkernel_int.mul_const _ + have hmeas : AEStronglyMeasurable (fun t : ℝ => (gaussianKernel ε t : ℂ) • U t ψ) volume := by + have hcont1 : Continuous (fun t : ℝ => (gaussianKernel ε t : ℂ)) := by + unfold gaussianKernel; fun_prop + exact (hcont1.smul (hUcont ψ)).aestronglyMeasurable + refine Integrable.mono' hg_int hmeas (ae_of_all _ fun t => le_of_eq ?_) + rw [norm_smul, Complex.norm_of_nonneg (gaussianKernel_pos hε t).le, + ContinuousLinearMap.norm_map_of_mem_unitary (hUunit t)] + +variable (U) in +/-- The Gårding vector of `ψ` mollified against the heat kernel of width `ε`. -/ +def analyticGardingVector (ε : ℝ) (ψ : H) : H := ∫ t : ℝ, (gaussianKernel ε t : ℂ) • U t ψ + +/-- The standard (`ε = 1`, unnormalized-width) Gaussian: `gaussianKernel ε` rescaled by +`t = √ε x` becomes a copy of this *fixed* kernel, independent of `ε`. Rewriting +`analyticGardingVector` through it (`analyticGardingVector_eq_standardGaussian`) turns the +`ε → 0⁺` approximate-identity limit into an ordinary dominated-convergence argument with a single, +`ε`-independent dominating function — avoiding an explicit Gaussian-tail estimate entirely. -/ +private def standardGaussianKernel (x : ℝ) : ℝ := Real.pi ^ (-(1 : ℝ) / 2) * Real.exp (-(x ^ 2)) + +private theorem standardGaussianKernel_pos (x : ℝ) : 0 < standardGaussianKernel x := by + unfold standardGaussianKernel; positivity + +private theorem standardGaussianKernel_eq_gaussianKernel_one : + standardGaussianKernel = gaussianKernel 1 := by + funext t; unfold standardGaussianKernel gaussianKernel; norm_num + +private theorem standardGaussianKernel_integral : ∫ x : ℝ, standardGaussianKernel x = 1 := by + rw [standardGaussianKernel_eq_gaussianKernel_one]; exact gaussianKernel_integral one_pos + +private theorem standardGaussianKernel_integrable : Integrable standardGaussianKernel := by + rw [standardGaussianKernel_eq_gaussianKernel_one] + have hexp : Integrable (fun t : ℝ => Real.exp (-(t ^ 2) / (1 : ℝ))) := by + have heq : (fun t : ℝ => Real.exp (-(t ^ 2) / (1 : ℝ))) = + fun t : ℝ => Real.exp (-(1 : ℝ) * t ^ 2) := by + funext t; ring_nf + rw [heq]; exact integrable_exp_neg_mul_sq one_pos + unfold gaussianKernel; exact hexp.const_mul _ + +/-- The rescaling identity at the level of the kernel itself: `√ε · gaussianKernel ε (√ε x) = +standardGaussianKernel x`, i.e. the `ε`-dependence exactly cancels once the extra `√ε` from the +change-of-variables Jacobian is absorbed. -/ +private theorem gaussianKernel_scale_eq_standardGaussianKernel {ε : ℝ} (hε : 0 < ε) (x : ℝ) : + Real.sqrt ε * gaussianKernel ε (Real.sqrt ε * x) = standardGaussianKernel x := by + unfold gaussianKernel standardGaussianKernel + have hsq : -(Real.sqrt ε * x) ^ 2 / ε = -(x ^ 2) := by + rw [neg_div, neg_inj, mul_pow, Real.sq_sqrt hε.le] + field_simp + have hkey : Real.sqrt ε * (Real.pi * ε) ^ (-(1 : ℝ) / 2) = Real.pi ^ (-(1 : ℝ) / 2) := by + rw [Real.mul_rpow Real.pi_pos.le hε.le, Real.sqrt_eq_rpow, mul_comm (Real.pi ^ (-(1 : ℝ) / 2)), + ← mul_assoc, ← Real.rpow_add hε, show (1 : ℝ) / 2 + -(1 : ℝ) / 2 = 0 by ring, + Real.rpow_zero, one_mul] + rw [hsq, ← mul_assoc, hkey] + +omit [CompleteSpace H] in +/-- `analyticGardingVector` rewritten via `t = √ε x`: the `ε`-dependent Gaussian becomes the fixed +`standardGaussianKernel`, with all of the `ε`-dependence pushed into the orbit's argument +`√ε x → 0`. This is the substitution suggested to replace an explicit Gaussian-tail estimate with +ordinary dominated convergence. -/ +private theorem analyticGardingVector_eq_standardGaussian {ε : ℝ} (hε : 0 < ε) (ψ : H) : + analyticGardingVector U ε ψ = + ∫ x : ℝ, (standardGaussianKernel x : ℂ) • U (Real.sqrt ε * x) ψ := by + have hsq_pos : 0 < Real.sqrt ε := Real.sqrt_pos.mpr hε + unfold analyticGardingVector + have step1 : (∫ x : ℝ, (standardGaussianKernel x : ℂ) • U (Real.sqrt ε * x) ψ) = + (Real.sqrt ε : ℂ) • + ∫ x : ℝ, (gaussianKernel ε (Real.sqrt ε * x) : ℂ) • U (Real.sqrt ε * x) ψ := by + rw [← MeasureTheory.integral_smul] + congr 1 + funext x + rw [← gaussianKernel_scale_eq_standardGaussianKernel hε x] + push_cast + rw [smul_smul] + rw [step1, MeasureTheory.Measure.integral_comp_mul_left + (fun t : ℝ => (gaussianKernel ε t : ℂ) • U t ψ) (Real.sqrt ε), + abs_of_pos (inv_pos.mpr hsq_pos)] + have hcast := RCLike.real_smul_eq_coe_smul (K := ℂ) (E := H) (Real.sqrt ε)⁻¹ + (∫ y : ℝ, (gaussianKernel ε y : ℂ) • U y ψ) + rw [hcast, smul_smul] + simp [hsq_pos.ne'] + +include hUunit in +/-- The heat kernel is an approximate identity: `analyticGardingVector ε ψ → ψ` as `ε → 0⁺`. +Rewritten via `analyticGardingVector_eq_standardGaussian` into a fixed-kernel integral whose only +`ε`-dependence is in `U (√ε x) ψ`'s argument, this becomes ordinary dominated convergence: for each +fixed `x`, `√ε x → 0` so `U (√ε x) ψ → U 0 ψ = ψ` by continuity, dominated by the `ε`-independent +bound `standardGaussianKernel x * ‖ψ‖` (using unitarity, `‖U t ψ‖ = ‖ψ‖`). -/ +theorem analyticGardingVector_tendsto (hU0 : U 0 = 1) + (hUcont : ∀ ξ : H, Continuous (fun t : ℝ => U t ξ)) (ψ : H) : + Tendsto (fun ε : ℝ => analyticGardingVector U ε ψ) (𝓝[>] (0 : ℝ)) (𝓝 ψ) := by + have hev : ∀ᶠ ε : ℝ in 𝓝[>] (0 : ℝ), 0 < ε := self_mem_nhdsWithin + have hrw : (fun ε : ℝ => ∫ x : ℝ, (standardGaussianKernel x : ℂ) • U (Real.sqrt ε * x) ψ) =ᶠ[ + 𝓝[>] (0 : ℝ)] fun ε : ℝ => analyticGardingVector U ε ψ := + hev.mono (fun ε hε => (analyticGardingVector_eq_standardGaussian hε ψ).symm) + refine Tendsto.congr' hrw ?_ + have hbound_int : Integrable (fun x : ℝ => standardGaussianKernel x * ‖ψ‖) := + standardGaussianKernel_integrable.mul_const _ + have hmeas : ∀ ε : ℝ, AEStronglyMeasurable + (fun x : ℝ => (standardGaussianKernel x : ℂ) • U (Real.sqrt ε * x) ψ) volume := by + intro ε + have h1 : Continuous (fun x : ℝ => (standardGaussianKernel x : ℂ)) := by + unfold standardGaussianKernel; fun_prop + have h2 : Continuous (fun x : ℝ => U (Real.sqrt ε * x) ψ) := + (hUcont ψ).comp (continuous_const.mul continuous_id) + exact (h1.smul h2).aestronglyMeasurable + have hbound : ∀ ε x : ℝ, ‖(standardGaussianKernel x : ℂ) • U (Real.sqrt ε * x) ψ‖ ≤ + standardGaussianKernel x * ‖ψ‖ := by + intro ε x + rw [norm_smul, Complex.norm_of_nonneg (standardGaussianKernel_pos x).le, + ContinuousLinearMap.norm_map_of_mem_unitary (hUunit _)] + have hlim : ∀ x : ℝ, Tendsto (fun ε : ℝ => (standardGaussianKernel x : ℂ) • U (Real.sqrt ε * x) ψ) + (𝓝[>] (0 : ℝ)) (𝓝 ((standardGaussianKernel x : ℂ) • ψ)) := by + intro x + have hsq : Tendsto (fun ε : ℝ => Real.sqrt ε * x) (𝓝[>] (0 : ℝ)) (𝓝 (0 : ℝ)) := by + have h0 : Tendsto (fun ε : ℝ => Real.sqrt ε) (𝓝[>] (0 : ℝ)) (𝓝 (Real.sqrt 0)) := + (Real.continuous_sqrt.tendsto 0).mono_left nhdsWithin_le_nhds + simpa using h0.mul_const x + have hUlim : Tendsto (fun ε : ℝ => U (Real.sqrt ε * x) ψ) (𝓝[>] (0 : ℝ)) (𝓝 (U 0 ψ)) := + ((hUcont ψ).tendsto 0).comp hsq + rw [hU0, one_apply_eq_self] at hUlim + exact hUlim.const_smul _ + have key := tendsto_integral_filter_of_dominated_convergence + (μ := volume) (l := 𝓝[>] (0 : ℝ)) + (F := fun ε x : ℝ => (standardGaussianKernel x : ℂ) • U (Real.sqrt ε * x) ψ) + (f := fun x : ℝ => (standardGaussianKernel x : ℂ) • ψ) + (fun x : ℝ => standardGaussianKernel x * ‖ψ‖) + (Filter.Eventually.of_forall (fun ε => hmeas ε)) + (Filter.Eventually.of_forall (fun ε => ae_of_all _ (fun x => hbound ε x))) + hbound_int + (ae_of_all _ hlim) + have hval : (∫ x : ℝ, (standardGaussianKernel x : ℂ)) = (1 : ℂ) := by + rw [integral_complex_ofReal, standardGaussianKernel_integral, Complex.ofReal_one] + rw [integral_smul_const, hval, one_smul] at key + exact key + +/-! ## Towards `analyticGardingVector_isAnalyticVector` + +The classical Gårding-vector commutation identity `A (gardingVector f ψ) = -gardingVector f' ψ` +(up to the `-i` convention) is proved in two stages: first a purely algebraic translation identity +(no calculus, just `U`'s group law and translation-invariance of Lebesgue measure — proved below, +`analyticGardingVector_translate`), then a genuine differentiation-under-the-integral-sign step +(stated but not yet proved, `stoneCandidateGenerator_analyticGardingVector` below) that turns the +translation identity's `s`-dependence into a derivative of the smooth kernel. -/ + +include hUmul in +/-- Translating the orbit: `U s` applied to a Gårding vector is again a Gårding vector, but of the +kernel shifted by `s`. This is the algebraic heart of the commutation identity — everything here is +just `U`'s group law (`hUmul`) plus translation-invariance of the Lebesgue integral +(`MeasureTheory.integral_add_right_eq_self`); no differentiability of `t ↦ U t ψ` is needed, which +is the whole point: it lets the derivative be taken on the smooth kernel instead. -/ +theorem analyticGardingVector_translate (hUunit : ∀ t, U t ∈ unitary (H →L[ℂ] H)) + (hUcont : ∀ ξ : H, Continuous (fun t : ℝ => U t ξ)) {ε : ℝ} (hε : 0 < ε) (ψ : H) (s : ℝ) : + U s (analyticGardingVector U ε ψ) = ∫ u : ℝ, (gaussianKernel ε (u - s) : ℂ) • U u ψ := by + unfold analyticGardingVector + rw [← ContinuousLinearMap.integral_comp_comm (U s) + (gaussianKernel_smul_integrable hUunit hUcont hε ψ)] + have hpt : ∀ t : ℝ, U s ((gaussianKernel ε t : ℂ) • U t ψ) = + (gaussianKernel ε t : ℂ) • U (t + s) ψ := by + intro t + rw [ContinuousLinearMap.map_smul] + congr 1 + rw [← mul_apply_eq_comp, ← hUmul s t, add_comm s t] + simp_rw [hpt] + rw [← MeasureTheory.integral_add_right_eq_self + (fun u : ℝ => (gaussianKernel ε (u - s) : ℂ) • U u ψ) s] + simp only [add_sub_cancel_right] + +/-- Explicit `HasDerivAt` for the heat kernel: `gaussianKernel ε` is differentiable everywhere, +with derivative `gaussianKernel ε t * (-(2 * t) / ε)` (the usual `d/dt exp(-t²/ε) = (-2t/ε) +exp(-t²/ε)` computation, scaled by the front normalization constant). -/ +private theorem gaussianKernel_hasDerivAt {ε : ℝ} (_hε : 0 < ε) (t : ℝ) : + HasDerivAt (gaussianKernel ε) (gaussianKernel ε t * (-(2 * t) / ε)) t := by + unfold gaussianKernel + have hpow : HasDerivAt (fun t : ℝ => t ^ 2) (2 * t) t := by + simpa using hasDerivAt_pow 2 t + have hquad : HasDerivAt (fun t : ℝ => -(t ^ 2) / ε) (-(2 * t) / ε) t := by + simpa [div_eq_mul_inv] using hpow.neg.div_const ε + have hexp : HasDerivAt (fun t : ℝ => Real.exp (-(t ^ 2) / ε)) + (Real.exp (-(t ^ 2) / ε) * (-(2 * t) / ε)) t := hquad.exp + have hker := hexp.const_mul ((Real.pi * ε) ^ (-(1 : ℝ) / 2)) + exact hker.congr_deriv (by ring) + +/-- Corollary of `gaussianKernel_hasDerivAt` as a `deriv` equation. -/ +private theorem gaussianKernel_deriv {ε : ℝ} (hε : 0 < ε) (t : ℝ) : + deriv (gaussianKernel ε) t = gaussianKernel ε t * (-(2 * t) / ε) := + (gaussianKernel_hasDerivAt hε t).deriv + +/-- `deriv (gaussianKernel ε)` is continuous. -/ +private theorem gaussianKernel_deriv_continuous {ε : ℝ} (hε : 0 < ε) : + Continuous (deriv (gaussianKernel ε)) := by + have heq : deriv (gaussianKernel ε) = fun t => gaussianKernel ε t * (-(2 * t) / ε) := + funext (gaussianKernel_deriv hε) + rw [heq] + have hcont : Continuous (gaussianKernel ε) := by unfold gaussianKernel; fun_prop + fun_prop + +/-- A uniform Gaussian-type envelope, over a bounded shift `x` with `x ^ 2 ≤ 1`, dominating +`|deriv (gaussianKernel ε) (u - x)|`: the shifted derivative-of-Gaussian is bounded by a constant +times `(|u| + 1) * exp (-(u ^ 2) / (2 * ε))`, which decays fast enough in `u` to be integrable +(`gaussianKernel_deriv_bound_integrable` below). -/ +private theorem gaussianKernel_deriv_shift_bound {ε : ℝ} (hε : 0 < ε) {x : ℝ} (hx : x ^ 2 ≤ 1) + (u : ℝ) : + |deriv (gaussianKernel ε) (u - x)| ≤ + (2 * (Real.pi * ε) ^ (-(1 : ℝ) / 2) * Real.exp (1 / ε) / ε) * + ((|u| + 1) * Real.exp (-(u ^ 2) / (2 * ε))) := by + set t := u - x with ht + rw [gaussianKernel_deriv hε t, abs_mul, abs_of_pos (gaussianKernel_pos hε t)] + have habs_div : |(-(2 * t)) / ε| = 2 * |t| / ε := by + rw [abs_div, abs_neg, abs_mul, abs_of_pos hε, abs_of_pos (show (0 : ℝ) < 2 by norm_num)] + rw [habs_div] + have hsq : u ^ 2 / 2 - 1 ≤ t ^ 2 := by nlinarith [sq_nonneg (u - 2 * x), hx] + have hexp_le : Real.exp (-(t ^ 2) / ε) ≤ Real.exp (1 / ε) * Real.exp (-(u ^ 2) / (2 * ε)) := by + rw [← Real.exp_add] + apply Real.exp_le_exp.mpr + rw [div_add_div _ _ (ne_of_gt hε) (by positivity : (2 : ℝ) * ε ≠ 0), + div_le_div_iff₀ hε (by positivity : (0 : ℝ) < ε * (2 * ε))] + nlinarith [mul_le_mul_of_nonneg_right hsq (sq_nonneg ε)] + have hCpos : (0 : ℝ) < (Real.pi * ε) ^ (-(1 : ℝ) / 2) := by positivity + have htu : |t| ≤ |u| + 1 := by + have h1 : |t| ≤ |u| + |x| := by + have h0 := abs_add_le u (-x) + simpa [ht, sub_eq_add_neg] using h0 + have h2 : |x| ≤ 1 := by nlinarith [sq_abs x, hx] + linarith + have hstep1 : (Real.pi * ε) ^ (-(1 : ℝ) / 2) * Real.exp (-(t ^ 2) / ε) * (2 * |t| / ε) ≤ + (Real.pi * ε) ^ (-(1 : ℝ) / 2) * (Real.exp (1 / ε) * Real.exp (-(u ^ 2) / (2 * ε))) * + (2 * (|u| + 1) / ε) := by + gcongr + calc gaussianKernel ε t * (2 * |t| / ε) + = (Real.pi * ε) ^ (-(1 : ℝ) / 2) * Real.exp (-(t ^ 2) / ε) * (2 * |t| / ε) := by + rfl + _ ≤ (Real.pi * ε) ^ (-(1 : ℝ) / 2) * (Real.exp (1 / ε) * Real.exp (-(u ^ 2) / (2 * ε))) * + (2 * (|u| + 1) / ε) := hstep1 + _ = (2 * (Real.pi * ε) ^ (-(1 : ℝ) / 2) * Real.exp (1 / ε) / ε) * + ((|u| + 1) * Real.exp (-(u ^ 2) / (2 * ε))) := by ring + +/-- The `L¹` domination bound is itself integrable in `u`: it is `const * ((|u|+1) * +Gaussian(u))`, and `|u| * Gaussian(u)` and `Gaussian(u)` are each classically integrable +(`integrable_mul_exp_neg_mul_sq`, `integrable_exp_neg_mul_sq`). -/ +private theorem gaussianKernel_deriv_bound_integrable {ε : ℝ} (hε : 0 < ε) (c : ℝ) : + Integrable (fun u : ℝ => c * ((|u| + 1) * Real.exp (-(u ^ 2) / (2 * ε)))) := by + have hb : (0 : ℝ) < 1 / (2 * ε) := by positivity + have h1 : Integrable (fun u : ℝ => u * Real.exp (-(1 / (2 * ε)) * u ^ 2)) := + integrable_mul_exp_neg_mul_sq hb + have h1' : Integrable (fun u : ℝ => |u| * Real.exp (-(1 / (2 * ε)) * u ^ 2)) := by + have := h1.abs + simpa [abs_mul, abs_of_nonneg (Real.exp_pos _).le] using this + have h2 : Integrable (fun u : ℝ => Real.exp (-(1 / (2 * ε)) * u ^ 2)) := + integrable_exp_neg_mul_sq hb + have hsum : Integrable (fun u : ℝ => |u| * Real.exp (-(1 / (2 * ε)) * u ^ 2) + + Real.exp (-(1 / (2 * ε)) * u ^ 2)) := h1'.add h2 + have heq : (fun u : ℝ => c * ((|u| + 1) * Real.exp (-(u ^ 2) / (2 * ε)))) = + fun u : ℝ => c * (|u| * Real.exp (-(1 / (2 * ε)) * u ^ 2) + + Real.exp (-(1 / (2 * ε)) * u ^ 2)) := by + funext u; rw [show -(u ^ 2) / (2 * ε) = -(1 / (2 * ε)) * u ^ 2 by ring]; ring + rw [heq] + exact hsum.const_mul c + +include hUmul in +/-- The heart of the commutation identity, factored out so it can feed both the domain-membership +fact (`analyticGardingVector_mem_stoneCandidateDomain`) and the generator's actual value +(`stoneCandidateGenerator_analyticGardingVector`) without proving the same +differentiation-under-the-integral argument twice: the orbit `s ↦ U s (analyticGardingVector U ε ψ)` +literally has a derivative at `0`, namely `∫ u, -(deriv (gaussianKernel ε) u) • U u ψ` — this alone +already witnesses `analyticGardingVector U ε ψ ∈ stoneCandidateDomain` (whose defining predicate is +exactly "the orbit is differentiable at `0`"), which is why `hmem` should never need to be an +independent hypothesis: it's precisely the byproduct of this computation, not extra data. Proved by +differentiating `analyticGardingVector_translate`'s RHS in `s` at `s = 0` via +`hasDerivAt_integral_of_dominated_loc_of_deriv_le` (`Analysis/Calculus/ParametricIntegral.lean`), +using `gaussianKernel_deriv_shift_bound` as the domination bound. -/ +private theorem analyticGardingVector_hasDerivAt + (hUunit : ∀ t, U t ∈ unitary (H →L[ℂ] H)) + (hUcont : ∀ ξ : H, Continuous (fun t : ℝ => U t ξ)) {ε : ℝ} (hε : 0 < ε) (ψ : H) : + HasDerivAt (fun s : ℝ => U s (analyticGardingVector U ε ψ)) + (∫ u : ℝ, ((-(deriv (gaussianKernel ε) u) : ℝ) : ℂ) • U u ψ) 0 := by + have hgvEq : gardingVectorAt U (gaussianKernel ε) ψ = analyticGardingVector U ε ψ := rfl + rw [← hgvEq] + have hgk_cont : Continuous (gaussianKernel ε) := by unfold gaussianKernel; fun_prop + have hgk'_cont : Continuous (deriv (gaussianKernel ε)) := gaussianKernel_deriv_continuous hε + set c : ℝ := 2 * (Real.pi * ε) ^ (-(1 : ℝ) / 2) * Real.exp (1 / ε) / ε * ‖ψ‖ with hc + refine gardingVectorAt_hasDerivAt hUmul hUunit hUcont (gaussianKernel ε) + (deriv (gaussianKernel ε)) + hgk_cont hgk'_cont + (fun t => (gaussianKernel_hasDerivAt hε t).congr_deriv (gaussianKernel_deriv hε t).symm) ψ + (gaussianKernel_smul_integrable hUunit hUcont hε ψ) + (fun u => c * ((|u| + 1) * Real.exp (-(u ^ 2) / (2 * ε)))) + (gaussianKernel_deriv_bound_integrable hε c) (fun u x hx => ?_) + have hx2 : x ^ 2 ≤ 1 := by + have := Metric.mem_ball.mp hx + rw [Real.dist_eq, sub_zero] at this + nlinarith [abs_nonneg x, sq_abs x, this] + calc |deriv (gaussianKernel ε) (u - x)| * ‖ψ‖ + ≤ (2 * (Real.pi * ε) ^ (-(1 : ℝ) / 2) * Real.exp (1 / ε) / ε) * + ((|u| + 1) * Real.exp (-(u ^ 2) / (2 * ε))) * ‖ψ‖ := + mul_le_mul_of_nonneg_right (gaussianKernel_deriv_shift_bound hε hx2 u) (norm_nonneg ψ) + _ = c * ((|u| + 1) * Real.exp (-(u ^ 2) / (2 * ε))) := by rw [hc]; ring + +/-- The Gaussian construction doesn't just *use* domain membership, it *proves* it: this is exactly +the content of `analyticGardingVector_hasDerivAt`, since `stoneCandidateDomain`'s membership +predicate is precisely "the orbit is differentiable at `0`". No `hmem` hypothesis needed anywhere — +smoothing against the heat kernel constructs a domain vector, it doesn't merely happen to land in +one that was assumed to exist. -/ +theorem analyticGardingVector_mem_stoneCandidateDomain (hUunit : ∀ t, U t ∈ unitary (H →L[ℂ] H)) + (hUcont : ∀ ξ : H, Continuous (fun t : ℝ => U t ξ)) {ε : ℝ} (hε : 0 < ε) (ψ : H) : + analyticGardingVector U ε ψ ∈ (stoneCandidateGenerator (U := U) hUmul).domain := + ⟨_, analyticGardingVector_hasDerivAt hUmul hUunit hUcont hε ψ⟩ + +/-- The commutation identity itself: applying the candidate generator to a Gårding vector smears +the *derivative* of the kernel instead. Membership in the generator's domain is derived, not +assumed (`analyticGardingVector_mem_stoneCandidateDomain`), and the value follows from +`analyticGardingVector_hasDerivAt` by uniqueness of `HasDerivAt`. -/ +theorem stoneCandidateGenerator_analyticGardingVector (hUunit : ∀ t, U t ∈ unitary (H →L[ℂ] H)) + (hUcont : ∀ ξ : H, Continuous (fun t : ℝ => U t ξ)) {ε : ℝ} (hε : 0 < ε) (ψ : H) : + stoneCandidateGenerator (U := U) hUmul + ⟨analyticGardingVector U ε ψ, analyticGardingVector_mem_stoneCandidateDomain hUmul + hUunit hUcont hε ψ⟩ = + (Complex.I : ℂ) • ∫ u : ℝ, ((deriv (gaussianKernel ε) u : ℝ) : ℂ) • U u ψ := by + set hmem := analyticGardingVector_mem_stoneCandidateDomain hUmul hUunit hUcont hε ψ + have hspec := stoneCandidateDeriv_spec (U := U) hUmul + (ψ := ⟨analyticGardingVector U ε ψ, hmem⟩) + have hderiv_eq := hspec.unique (analyticGardingVector_hasDerivAt hUmul hUunit hUcont hε ψ) + refine (stoneCandidateGenerator_apply (U := U) hUmul ⟨analyticGardingVector U ε ψ, hmem⟩).trans ?_ + show (-Complex.I) • stoneCandidateDeriv hUmul + (⟨analyticGardingVector U ε ψ, hmem⟩ : stoneCandidateDomain (U := U) hUmul) = + Complex.I • ∫ u : ℝ, ((deriv (gaussianKernel ε) u : ℝ) : ℂ) • U u ψ + rw [hderiv_eq] + have hneg : (∫ u : ℝ, ((-(deriv (gaussianKernel ε) u) : ℝ) : ℂ) • U u ψ) = + -(∫ u : ℝ, ((deriv (gaussianKernel ε) u : ℝ) : ℂ) • U u ψ) := by + rw [← MeasureTheory.integral_neg] + congr 1 + funext u + push_cast + rw [neg_smul] + rw [hneg, smul_neg, neg_smul, neg_neg] + +/-! ## Milestone 2 of Track A: assembling the full `IsAnalyticVector` witness + +`stoneCandidateGenerator_analyticGardingVector` proves the *single-derivative* commutation +identity. The generalization to every derivative order (needed for the full `IsAnalyticVector` +witness) is assembled in `IteratedKernelGrowth.lean` and `GardingVectorWitness.lean`, +which live downstream of this file (they need `GaussianKernelGrowth.lean`'s growth bound, which +itself imports this file) — see `analyticGardingVector_isAnalyticVector` there. -/ + +end + +end QuantumMechanics diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/GaussianKernelGrowth.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/GaussianKernelGrowth.lean new file mode 100644 index 0000000000..924c8a742f --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/GaussianKernelGrowth.lean @@ -0,0 +1,494 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Existence.GardingVectors +public import Mathlib.Analysis.Calculus.IteratedDeriv.Lemmas +public import Mathlib.RingTheory.Polynomial.Hermite.Gaussian +public import Mathlib.Analysis.SpecialFunctions.Gaussian.GaussianIntegral +public import Mathlib.MeasureTheory.Integral.IntegralEqImproper +public import Mathlib.Topology.Algebra.Polynomial +public import Mathlib.MeasureTheory.Function.L2Space + +/-! +# Growth of the heat kernel's derivatives (Milestone 1′, Track A) + +A **self-contained real-analysis fact**, with no dependence on the unitary group `U`, the Hilbert +space `H`, or any operator machinery: a uniform factorial-type bound on the `L¹` norm of the +`n`-th derivative of the normalized heat kernel `gaussianKernel ε` (`GardingVectors.lean`). + +This is exactly the estimate needed to make `analyticGardingVector ε ψ` a genuine +`LinearPMap.IsAnalyticVector` of `stoneCandidateGenerator` once combined with the (separately +tracked) commutation identity `stoneCandidateGenerator_analyticGardingVector`: that identity turns +`Aⁿ (analyticGardingVector ε ψ)` into (up to a unimodular scalar) `analyticGardingVector`-of-the- +`n`-th-derivative-kernel smeared against `ψ`, whose norm is bounded by +`(L¹ norm of the n-th kernel derivative) * ‖ψ‖` (since `‖U t ψ‖ = ‖ψ‖`); this file's bound is what +then makes `∑ ‖Aⁿ (analyticGardingVector ε ψ)‖ tⁿ / n!` summable for suitable `t`. + +## Strategy (revised — thanks to a user suggestion pointing at the right Mathlib lemma) + +Mathlib already has the exact structural identity needed, so there is no need to invent a +polynomial recursion from scratch: `Polynomial.deriv_gaussian_eq_hermite_mul_gaussian`, + +`deriv^[n] (fun y => exp (-(y^2/2))) x = (-1)^n * aeval x (hermite n) * exp (-(x^2/2))`, + +where `hermite n` is the *probabilists'* Hermite polynomial. Combined with the scaling +`x = √(2/ε) t` (which turns `gaussianKernel ε`'s `exp(-t²/ε)` into the standard-variance +`exp(-x²/2)` this identity is stated for), this reduces `gaussianKernel_iteratedDeriv_L1_bound` +to a single genuinely new fact: + +**the weighted `L¹` growth of Hermite polynomials against the standard Gaussian**, +`∫ |Hₙ(x)| exp(-x²/2) dx ≤ √(2π) · √(n!)`. + +Rather than an `L^∞`-type Hermite bound (which Mathlib does not have, and which is arguably a +harder classical fact than needed), this follows from **Cauchy–Schwarz** applied to +`|Hₙ(x)| exp(-x²/2) = (|Hₙ(x)| exp(-x²/4)) · exp(-x²/4)`, reducing everything to the single +**weighted `L²` norm identity** `∫ Hₙ(x)² exp(-x²/2) dx = √(2π) · n!` (the standard Hermite +orthonormality fact, absent from Mathlib — checked directly, `Hermite/Basic.lean` has only +algebraic/coefficient facts, `Hermite/Gaussian.lean` only the derivative identity above). + +That `L²` identity is now **fully proved** (no `sorry`, no axioms beyond the standard +`propext`/`Classical.choice`/`Quot.sound`), by a single-step recursion `Iₙ = n · Iₙ₋₁` rather than +`n`-fold integration by parts: + +* `hermite_derivative_succ`: the polynomial identity `Hₙ₊₁' = (n+1) · Hₙ` (absent from Mathlib; + proved here by induction directly from the defining recursion `hermite_succ`, + `Hₙ₊₁ = X·Hₙ - Hₙ'`). +* `hermite_aeval_succ`/`hermite_aeval_deriv_succ`: the real-valued (`aeval`) specializations of + `hermite_succ` and `hermite_derivative_succ`. +* `integrable_aeval_mul_gaussian`: any polynomial times a Gaussian weight is integrable (proved by + `Polynomial.induction_on'`, reducing to the monomial case via + `integrable_rpow_mul_exp_neg_mul_sq`). +* `hermite_gaussian_sq_integral_succ`: the recursion itself. With `u := Hₙ₊₁`, + `v := Hₙ · exp(-x²/2)`, the defining recursion gives `v' = -u·exp(-x²/2)`, so integration by + parts on `(-∞,∞)` (`integral_mul_deriv_eq_deriv_mul_of_integrable` — the "of_integrable" + variant needs no explicit boundary-vanishing argument, only integrability of the three + relevant products) turns `∫ Hₙ₊₁² exp(-x²/2)` into `∫ Hₙ₊₁' · Hₙ · exp(-x²/2)`, which + `hermite_derivative_succ` identifies with `(n+1) · ∫ Hₙ² exp(-x²/2)`. +* `hermite_gaussian_sq_integral`: assembled from the recursion by induction on `n`, with base case + `∫ exp(-x²/2) = √(2π)` (`integral_gaussian` at `b = 1/2`). + +An alternative strategy worth recording (suggested, not yet attempted): since +`s ↦ g_ε(u - s)` is entire in a *complex* `s`, `analyticGardingVector`'s orbit +`s ↦ U_s ψ_ε = ∫ g_ε(u-s) U_u ψ \, du` may extend to an entire `H`-valued function of a complex +variable, from which analytic-vector status could follow via Taylor theory directly — potentially +avoiding this whole Hermite apparatus. This would need a new general theorem ("entire orbit +extension ⟹ `IsAnalyticVector`") that does not currently exist in the ported `AnalyticVector/*` +files (checked: their API is purely series/growth-based), so it is not obviously smaller work; not +pursued for now, and moot in any case now that the Hermite route is fully closed. +-/ + +@[expose] public section + +namespace QuantumMechanics + +noncomputable section + +open MeasureTheory Polynomial + +/-- The polynomial identity `Hₙ₊₁' = (n+1) · Hₙ`, absent from Mathlib, proved directly from the +defining recursion `hermite_succ : Hₙ₊₁ = X·Hₙ - Hₙ'` by induction. -/ +private theorem hermite_derivative_succ : + ∀ n : ℕ, derivative (hermite (n + 1)) = C ((n : ℤ) + 1) * hermite n + | 0 => by simp [hermite_zero] + | (n + 1) => by + have ih := hermite_derivative_succ n + have hsucc1 : hermite (n + 1 + 1) = X * hermite (n + 1) - derivative (hermite (n + 1)) := + hermite_succ (n + 1) + have hsucc0 : hermite (n + 1) = X * hermite n - derivative (hermite n) := + hermite_succ n + have key : derivative (hermite (n + 1 + 1)) = + derivative (X * hermite (n + 1)) - derivative (derivative (hermite (n + 1))) := by + rw [hsucc1, derivative_sub] + rw [derivative_mul, derivative_X, one_mul] at key + rw [ih, derivative_C_mul] at key + have hCsplit : C ((n : ℤ) + 1 + 1) = C ((n : ℤ) + 1) + 1 := by rw [← C_1, ← map_add] + have hfin : hermite (n + 1) + X * (C ((n : ℤ) + 1) * hermite n) - + C ((n : ℤ) + 1) * derivative (hermite n) = C ((n : ℤ) + 1 + 1) * hermite (n + 1) := by + rw [hCsplit, hsucc0]; ring + rw [key, hfin] + push_cast + ring + +/-- The `aeval`/real-valued specialization of `hermite_derivative_succ`. -/ +private theorem hermite_aeval_deriv_succ (n : ℕ) (x : ℝ) : + aeval x (derivative (hermite (n + 1))) = ((n : ℝ) + 1) * aeval x (hermite n) := by + have h := congrArg (fun p : Polynomial ℤ => aeval x p) (hermite_derivative_succ n) + simpa using h + +/-- The `aeval`/real-valued specialization of the defining recursion `hermite_succ`. -/ +private theorem hermite_aeval_succ (n : ℕ) (x : ℝ) : + aeval x (hermite (n + 1)) = x * aeval x (hermite n) - aeval x (derivative (hermite n)) := by + simp [hermite_succ] + +/-- A monomial times a Gaussian weight is integrable (the `n`-th-power case of +`integrable_aeval_mul_gaussian`, via the real-exponent Gaussian-tail estimate specialized to a +natural-number exponent through `Real.rpow_natCast`). -/ +theorem integrable_pow_mul_exp_neg_mul_sq (n : ℕ) {c : ℝ} (hc : 0 < c) : + Integrable (fun x : ℝ => x ^ n * Real.exp (-(c * x ^ 2))) := by + have hs : (-1 : ℝ) < (n : ℝ) := by + have := Nat.cast_nonneg (α := ℝ) n + linarith + have h := integrable_rpow_mul_exp_neg_mul_sq (b := c) hc hs + simpa [Real.rpow_natCast, neg_mul] using h + +/-- Any (integer) polynomial times a Gaussian weight is integrable — the integrability fact needed +throughout `hermite_gaussian_sq_integral_succ`'s integration-by-parts argument. Proved by +`Polynomial.induction_on'`, reducing to the monomial case. -/ +theorem integrable_aeval_mul_gaussian (q : Polynomial ℤ) {c : ℝ} (hc : 0 < c) : + Integrable (fun x : ℝ => aeval x q * Real.exp (-(c * x ^ 2))) := by + induction q using Polynomial.induction_on' with + | add p r hp hr => + have h : Integrable (fun x : ℝ => + aeval x p * Real.exp (-(c * x ^ 2)) + aeval x r * Real.exp (-(c * x ^ 2))) := + hp.add hr + simpa [add_mul] using h + | monomial n a => + have := (integrable_pow_mul_exp_neg_mul_sq n hc).const_mul (a : ℝ) + simpa [mul_assoc] using this + +/-- The derivative of the standard Gaussian, packaged as `HasDerivAt` (Mathlib only records the +`deriv`-value form privately, inside the proof of `deriv_gaussian_eq_hermite_mul_gaussian`). -/ +private theorem gaussian_hasDerivAt (x : ℝ) : + HasDerivAt (fun y : ℝ => Real.exp (-(y ^ 2 / 2))) (-x * Real.exp (-(x ^ 2 / 2))) x := by + have hdiff : DifferentiableAt ℝ (fun y : ℝ => Real.exp (-(y ^ 2 / 2))) x := + DifferentiableAt.exp (by fun_prop) + have heq : deriv (fun y : ℝ => Real.exp (-(y ^ 2 / 2))) x = -x * Real.exp (-(x ^ 2 / 2)) := by + rw [deriv_exp (by fun_prop)] + simp [mul_comm] + have h := hdiff.hasDerivAt + rwa [heq] at h + +/-- **The key induction step**: `Iₙ = n · Iₙ₋₁` for `Iₙ := ∫ Hₙ(x)² exp(-x²/2) dx`, via a single +integration by parts on `(-∞, ∞)` using `v' = -Hₙ₊₁ · exp(-x²/2)` for `v := Hₙ · exp(-x²/2)` +(a consequence of the defining recursion `hermite_succ`, not the derivative identity +`hermite_derivative_succ`, which is used only afterwards to identify `∫ Hₙ₊₁' · Hₙ · exp(-x²/2)` +with `(n+1) · Iₙ`). -/ +private theorem hermite_gaussian_sq_integral_succ (n : ℕ) : + (∫ x : ℝ, (aeval x (hermite (n + 1))) ^ 2 * Real.exp (-(x ^ 2 / 2))) = + ((n : ℝ) + 1) * ∫ x : ℝ, (aeval x (hermite n)) ^ 2 * Real.exp (-(x ^ 2 / 2)) := by + set u : ℝ → ℝ := fun x => aeval x (hermite (n + 1)) with hu_def + set v : ℝ → ℝ := fun x => aeval x (hermite n) * Real.exp (-(x ^ 2 / 2)) with hv_def + set u' : ℝ → ℝ := fun x => aeval x (derivative (hermite (n + 1))) with hu'_def + set v' : ℝ → ℝ := fun x => -(aeval x (hermite (n + 1)) * Real.exp (-(x ^ 2 / 2))) with hv'_def + have hu : ∀ x ∈ tsupport v, HasDerivAt u (u' x) x := fun x _ => + Polynomial.hasDerivAt_aeval (hermite (n + 1)) x + have hv : ∀ x ∈ tsupport u, HasDerivAt v (v' x) x := by + intro x _ + have h1 : HasDerivAt (fun y : ℝ => aeval y (hermite n)) (aeval x (derivative (hermite n))) x := + Polynomial.hasDerivAt_aeval (hermite n) x + have h2 := h1.mul (gaussian_hasDerivAt x) + have heq : aeval x (derivative (hermite n)) * Real.exp (-(x ^ 2 / 2)) + + aeval x (hermite n) * (-x * Real.exp (-(x ^ 2 / 2))) = v' x := by + simp only [hv'_def] + have hsucc : aeval x (hermite (n + 1)) = + x * aeval x (hermite n) - aeval x (derivative (hermite n)) := hermite_aeval_succ n x + rw [hsucc]; ring + rw [← heq] + exact h2 + have huv' : Integrable (u * v') := by + have hbase := (integrable_aeval_mul_gaussian ((hermite (n + 1)) ^ 2) (c := 1 / 2) + (by norm_num)).neg + have heq : (u * v') = + -fun x => aeval x ((hermite (n + 1)) ^ 2) * Real.exp (-(1 / 2 * x ^ 2)) := by + funext x + simp only [hu_def, hv'_def, Pi.mul_apply, Pi.neg_apply, map_pow] + ring_nf + rwa [heq] + have hu'v : Integrable (u' * v) := by + have hbase := integrable_aeval_mul_gaussian (derivative (hermite (n + 1)) * hermite n) + (c := 1 / 2) (by norm_num) + have heq : (u' * v) = fun x => + aeval x (derivative (hermite (n + 1)) * hermite n) * Real.exp (-(1 / 2 * x ^ 2)) := by + funext x + simp only [hu'_def, hv_def, Pi.mul_apply, map_mul] + ring_nf + rwa [heq] + have huv : Integrable (u * v) := by + have hbase := integrable_aeval_mul_gaussian (hermite (n + 1) * hermite n) + (c := 1 / 2) (by norm_num) + have heq : (u * v) = fun x => + aeval x (hermite (n + 1) * hermite n) * Real.exp (-(1 / 2 * x ^ 2)) := by + funext x + simp only [hu_def, hv_def, Pi.mul_apply, map_mul] + ring_nf + rwa [heq] + have hIBP := integral_mul_deriv_eq_deriv_mul_of_integrable hu hv huv' hu'v huv + have hlhs : (∫ x : ℝ, u x * v' x) = + -(∫ x : ℝ, (aeval x (hermite (n + 1))) ^ 2 * Real.exp (-(x ^ 2 / 2))) := by + have heq : (fun x => u x * v' x) = + fun x => -((aeval x (hermite (n + 1))) ^ 2 * Real.exp (-(x ^ 2 / 2))) := by + funext x; simp only [hu_def, hv'_def]; ring + rw [show (∫ x : ℝ, u x * v' x) = ∫ x : ℝ, (fun x => u x * v' x) x from rfl, heq] + exact MeasureTheory.integral_neg _ + have hrhs : (∫ x : ℝ, u' x * v x) = + ((n : ℝ) + 1) * ∫ x : ℝ, (aeval x (hermite n)) ^ 2 * Real.exp (-(x ^ 2 / 2)) := by + have heq : (fun x => u' x * v x) = + fun x => ((n : ℝ) + 1) * ((aeval x (hermite n)) ^ 2 * Real.exp (-(x ^ 2 / 2))) := by + funext x + simp only [hu'_def, hv_def] + rw [hermite_aeval_deriv_succ n x] + ring + rw [show (∫ x : ℝ, u' x * v x) = ∫ x : ℝ, (fun x => u' x * v x) x from rfl, heq] + exact MeasureTheory.integral_const_mul _ _ + rw [hlhs, hrhs] at hIBP + linarith + +/-- **The one genuinely new classical fact this file needs**: the weighted `L²` norm of the +`n`-th (probabilists') Hermite polynomial against the standard Gaussian is `√(2π) · n!`. Absent +from Mathlib (`RingTheory/Polynomial/Hermite/{Basic,Gaussian}.lean` checked directly — only +algebraic/coefficient facts and the derivative identity are there, no orthogonality/norm result). +Proved by induction via `hermite_gaussian_sq_integral_succ`, with base case `∫exp(-x²/2)=√(2π)` +(`integral_gaussian` at `b=1/2`). -/ +private theorem hermite_gaussian_sq_integral (n : ℕ) : + ∫ x : ℝ, (aeval x (hermite n)) ^ 2 * Real.exp (-(x ^ 2 / 2)) = + Real.sqrt (2 * Real.pi) * n.factorial := by + induction n with + | zero => + simp only [hermite_zero, map_one, one_pow, one_mul, Nat.factorial_zero, Nat.cast_one, + mul_one] + have h := integral_gaussian (1 / 2 : ℝ) + have hb : Real.pi / (1 / 2 : ℝ) = 2 * Real.pi := by ring + rw [hb] at h + convert h using 2 + ring + | succ n ih => + rw [hermite_gaussian_sq_integral_succ n, ih] + push_cast [Nat.factorial_succ] + ring + +/-- The Cauchy–Schwarz consequence of `hermite_gaussian_sq_integral`: a weighted `L¹`, rather +than `L^∞`, growth bound on Hermite polynomials — exactly what feeds +`gaussianKernel_iteratedDeriv_L1_bound` via the scaling substitution, and what was suggested +in place of an `L^∞` Hermite estimate. -/ +private theorem hermite_gaussian_L1_bound (n : ℕ) : + ∫ x : ℝ, |aeval x (hermite n)| * Real.exp (-(x ^ 2 / 2)) ≤ + Real.sqrt (2 * Real.pi) * Real.sqrt n.factorial := by + set A : ℝ := Real.sqrt (2 * Real.pi) with hA + set f : ℝ → ℝ := fun x => |aeval x (hermite n)| * Real.exp (-(x ^ 2 / 4)) with hf + set g : ℝ → ℝ := fun x => Real.exp (-(x ^ 2 / 4)) with hg + have hfg : ∀ x : ℝ, f x * g x = |aeval x (hermite n)| * Real.exp (-(x ^ 2 / 2)) := by + intro x + simp only [hf, hg, mul_assoc, ← Real.exp_add] + congr 2 + ring + have hf_nonneg : 0 ≤ᵐ[volume] f := ae_of_all _ fun x => by positivity + have hg_nonneg : 0 ≤ᵐ[volume] g := ae_of_all _ fun x => (Real.exp_pos _).le + have hf_cont : Continuous f := by rw [hf]; fun_prop + have hg_cont : Continuous g := by rw [hg]; fun_prop + have hAsq_int : Integrable + (fun x : ℝ => (aeval x (hermite n)) ^ 2 * Real.exp (-(x ^ 2 / 2))) := by + by_contra hni + have h0 := MeasureTheory.integral_undef hni + rw [hermite_gaussian_sq_integral n] at h0 + have hpos : (0 : ℝ) < A * n.factorial := by rw [hA]; positivity + linarith + have hf_sq_int : Integrable (fun x : ℝ => f x ^ 2) := by + have heq : (fun x : ℝ => f x ^ 2) = + fun x : ℝ => (aeval x (hermite n)) ^ 2 * Real.exp (-(x ^ 2 / 2)) := by + funext x + simp only [hf, pow_two] + rw [mul_mul_mul_comm, abs_mul_abs_self, ← Real.exp_add] + congr 2 + ring + rwa [heq] + have hg_sq_int : Integrable (fun x : ℝ => g x ^ 2) := by + have heq : (fun x : ℝ => g x ^ 2) = fun x : ℝ => Real.exp (-(1 / 2) * x ^ 2) := by + funext x; simp only [hg, pow_two, ← Real.exp_add]; congr 1; ring + rw [heq] + exact integrable_exp_neg_mul_sq (by norm_num) + have hfMemLp : MemLp f 2 volume := (memLp_two_iff_integrable_sq hf_cont.aestronglyMeasurable).mpr + hf_sq_int + have hgMemLp : MemLp g 2 volume := (memLp_two_iff_integrable_sq hg_cont.aestronglyMeasurable).mpr + hg_sq_int + have hEOfReal : ENNReal.ofReal (2 : ℝ) = (2 : ENNReal) := by norm_num + have hCS := integral_mul_le_Lp_mul_Lq_of_nonneg Real.HolderConjugate.two_two + hf_nonneg hg_nonneg (hEOfReal ▸ hfMemLp) (hEOfReal ▸ hgMemLp) + have hcongr : (∫ x : ℝ, f x * g x) = ∫ x : ℝ, |aeval x (hermite n)| * Real.exp (-(x ^ 2 / 2)) := + integral_congr_ae (ae_of_all _ hfg) + rw [hcongr] at hCS + have hf2 : (∫ x : ℝ, f x ^ 2) = A * n.factorial := by + have heq : (fun x : ℝ => f x ^ 2) = + fun x : ℝ => (aeval x (hermite n)) ^ 2 * Real.exp (-(x ^ 2 / 2)) := by + funext x + simp only [hf, pow_two] + rw [mul_mul_mul_comm, abs_mul_abs_self, ← Real.exp_add] + congr 2 + ring + rw [heq, hermite_gaussian_sq_integral] + have hg2 : (∫ x : ℝ, g x ^ 2) = A := by + have heq : (fun x : ℝ => g x ^ 2) = fun x : ℝ => Real.exp (-(1 / 2) * x ^ 2) := by + funext x; simp only [hg, pow_two, ← Real.exp_add]; congr 1; ring + rw [heq, integral_gaussian, hA] + norm_num + ring + have hApos : 0 ≤ A := by rw [hA]; positivity + have hRHS_eq : (∫ a : ℝ, f a ^ (2 : ℝ)) ^ ((1 : ℝ) / 2) * + (∫ a : ℝ, g a ^ (2 : ℝ)) ^ ((1 : ℝ) / 2) = A * Real.sqrt n.factorial := by + simp only [Real.rpow_two] + rw [hf2, hg2, ← Real.sqrt_eq_rpow (A * n.factorial), ← Real.sqrt_eq_rpow A, + ← Real.sqrt_mul (by positivity : (0 : ℝ) ≤ A * (n.factorial : ℝ)), + mul_comm (A * (n.factorial : ℝ)) A, ← mul_assoc, ← pow_two, Real.sqrt_mul (sq_nonneg A), + Real.sqrt_sq hApos] + exact hCS.trans_eq hRHS_eq + +/-- **The closed-form identity** for the `n`-th derivative of the heat kernel, extracted as a +standalone reusable fact (it is proved inline again, as a `have`, inside +`gaussianKernel_iteratedDeriv_L1_bound` below — kept separate rather than refactored to share the +proof, to avoid touching that already-verified theorem): via `iteratedDeriv_comp_const_mul` and +`Polynomial.deriv_gaussian_eq_hermite_mul_gaussian` at the scaling `t ↦ √(2/ε)·t`. This is exactly +what a future generalization of `analyticGardingVector_hasDerivAt` to `k := iteratedDeriv n +(gaussianKernel ε)` needs as its explicit closed form, e.g. to state a pointwise (not just `L¹`) +growth bound. -/ +theorem gaussianKernel_iteratedDeriv_eq {ε : ℝ} (hε : 0 < ε) (n : ℕ) (t : ℝ) : + iteratedDeriv n (gaussianKernel ε) t = + (Real.pi * ε) ^ (-(1 : ℝ) / 2) * (Real.sqrt (2 / ε) ^ n * + ((-1 : ℝ) ^ n * aeval (Real.sqrt (2 / ε) * t) (hermite n) * + Real.exp (-((Real.sqrt (2 / ε) * t) ^ 2 / 2)))) := by + set c : ℝ := Real.sqrt (2 / ε) with hc_def + set K : ℝ := (Real.pi * ε) ^ (-(1 : ℝ) / 2) with hK_def + set ψ : ℝ → ℝ := fun x => Real.exp (-(x ^ 2 / 2)) with hψ_def + have hc_sq : c ^ 2 = 2 / ε := by rw [hc_def, Real.sq_sqrt (by positivity)] + have hgk_eq : gaussianKernel ε = fun t => K * ψ (c * t) := by + funext t + show gaussianKernel ε t = K * ψ (c * t) + unfold gaussianKernel + rw [hK_def, hψ_def] + congr 1 + have hexp_eq : -(t ^ 2) / ε = -((c * t) ^ 2 / 2) := by + rw [mul_pow, hc_sq]; field_simp + rw [hexp_eq] + have hψ_smooth : ContDiff ℝ n ψ := by rw [hψ_def]; fun_prop + rw [hgk_eq] + have step1 : iteratedDeriv n (fun t => K * ψ (c * t)) t + = K * iteratedDeriv n (fun t => ψ (c * t)) t := + iteratedDeriv_const_mul_field (n := n) (x := t) K (fun t => ψ (c * t)) + have step2 : iteratedDeriv n (fun t => ψ (c * t)) t = c ^ n * iteratedDeriv n ψ (c * t) := + congrFun (iteratedDeriv_comp_const_mul (n := n) hψ_smooth c) t + rw [step1, step2, iteratedDeriv_eq_iterate, hψ_def, deriv_gaussian_eq_hermite_mul_gaussian] + +/-- **Track A of Milestone 1′.** A uniform bound, `n`-independent in its constant `C`, on the `L¹` +norm of the `n`-th derivative of the heat kernel, growing like `C^(n+1) √(n!)`. Reduces to +`hermite_gaussian_L1_bound` via `Polynomial.deriv_gaussian_eq_hermite_mul_gaussian` and the scaling +`x = √(2/ε) t` — the remaining bookkeeping (connecting `iteratedDeriv n (gaussianKernel ε)` to the +scaled Hermite-Gaussian identity) is itself real work, not yet done, but no longer needs any new +mathematical content once `hermite_gaussian_L1_bound` lands. -/ +theorem gaussianKernel_iteratedDeriv_L1_bound {ε : ℝ} (hε : 0 < ε) : + ∃ C : ℝ, 0 < C ∧ ∀ n : ℕ, + Integrable (iteratedDeriv n (gaussianKernel ε)) ∧ + ∫ t : ℝ, |iteratedDeriv n (gaussianKernel ε) t| ≤ C ^ (n + 1) * Real.sqrt n.factorial := by + set c : ℝ := Real.sqrt (2 / ε) with hc_def + have hc_pos : 0 < c := Real.sqrt_pos.mpr (by positivity) + set K : ℝ := (Real.pi * ε) ^ (-(1 : ℝ) / 2) with hK_def + have hK_pos : 0 < K := by rw [hK_def]; positivity + set ψ : ℝ → ℝ := fun x => Real.exp (-(x ^ 2 / 2)) with hψ_def + have hc_sq : c ^ 2 = 2 / ε := by + rw [hc_def, Real.sq_sqrt (by positivity)] + -- `gaussianKernel ε` is `K` times `ψ` rescaled by `c`. + have hgk_eq : gaussianKernel ε = fun t => K * ψ (c * t) := by + funext t + show gaussianKernel ε t = K * ψ (c * t) + unfold gaussianKernel + rw [hK_def, hψ_def] + congr 1 + have hexp_eq : -(t ^ 2) / ε = -((c * t) ^ 2 / 2) := by + rw [mul_pow, hc_sq]; field_simp + rw [hexp_eq] + -- `ψ` is smooth, so `iteratedDeriv_comp_const_mul` applies at every order. + have hψ_smooth : ∀ n : ℕ, ContDiff ℝ n ψ := fun n => by rw [hψ_def]; fun_prop + -- The `n`-th derivative identity, reducing `iteratedDeriv n (gaussianKernel ε)` to Hermite data. + have hderiv_eq : ∀ n : ℕ, iteratedDeriv n (gaussianKernel ε) = + fun t => K * (c ^ n * ((-1 : ℝ) ^ n * aeval (c * t) (hermite n) * ψ (c * t))) := by + intro n + rw [hgk_eq] + funext t + have step1 : iteratedDeriv n (fun t => K * ψ (c * t)) t + = K * iteratedDeriv n (fun t => ψ (c * t)) t := + iteratedDeriv_const_mul_field (n := n) (x := t) K (fun t => ψ (c * t)) + have step2 : iteratedDeriv n (fun t => ψ (c * t)) t = c ^ n * iteratedDeriv n ψ (c * t) := + congrFun (iteratedDeriv_comp_const_mul (n := n) (hψ_smooth n) c) t + rw [step1, step2, iteratedDeriv_eq_iterate, hψ_def, deriv_gaussian_eq_hermite_mul_gaussian] + -- The exact normalization constant: `K · c⁻¹ · √(2π) = 1`. + have hKe : K * Real.sqrt (Real.pi * ε) = 1 := by + rw [hK_def, Real.sqrt_eq_rpow, ← Real.rpow_add (by positivity : (0 : ℝ) < Real.pi * ε)] + norm_num + have hcinv : c⁻¹ = Real.sqrt (ε / 2) := by + rw [hc_def, ← Real.sqrt_inv] + congr 1 + field_simp + have hsplit : Real.sqrt (Real.pi * ε) = Real.sqrt (2 * Real.pi) * Real.sqrt (ε / 2) := by + rw [← Real.sqrt_mul (by positivity)] + congr 1 + ring + have hKc : K * c⁻¹ * Real.sqrt (2 * Real.pi) = 1 := by + rw [hcinv] + calc K * Real.sqrt (ε / 2) * Real.sqrt (2 * Real.pi) + = K * (Real.sqrt (2 * Real.pi) * Real.sqrt (ε / 2)) := by ring + _ = K * Real.sqrt (Real.pi * ε) := by rw [← hsplit] + _ = 1 := hKe + refine ⟨max c 1, lt_max_of_lt_right one_pos, fun n => ?_⟩ + have hg_integrable : Integrable (fun x : ℝ => aeval x (hermite n) * ψ x) := by + have h := integrable_aeval_mul_gaussian (hermite n) (c := 1 / 2) (by norm_num) + have heq : (fun x : ℝ => aeval x (hermite n) * Real.exp (-(1 / 2 * x ^ 2))) = + fun x : ℝ => aeval x (hermite n) * ψ x := by + funext x; rw [hψ_def]; congr 2; ring + rwa [heq] at h + have hpt : ∀ t : ℝ, iteratedDeriv n (gaussianKernel ε) t = + K * (c ^ n * ((-1 : ℝ) ^ n * aeval (c * t) (hermite n) * ψ (c * t))) := + fun t => congrFun (hderiv_eq n) t + refine ⟨?_, ?_⟩ + · have heq : iteratedDeriv n (gaussianKernel ε) = + fun t => (K * c ^ n * (-1 : ℝ) ^ n) * (fun x => aeval x (hermite n) * ψ x) (c * t) := by + funext t; rw [hpt]; ring + rw [heq] + exact (hg_integrable.comp_mul_left' hc_pos.ne').const_mul _ + · set g : ℝ → ℝ := fun x => |aeval x (hermite n)| * ψ x with hg_def + have habs_eq : (fun t => |iteratedDeriv n (gaussianKernel ε) t|) + = fun t => K * c ^ n * g (c * t) := by + funext t + rw [hpt, hg_def] + have hψ_pos : 0 < ψ (c * t) := by rw [hψ_def]; positivity + have h1 : |(-1 : ℝ) ^ n * aeval (c * t) (hermite n) * ψ (c * t)| + = |aeval (c * t) (hermite n)| * ψ (c * t) := by + rw [abs_mul, abs_mul, abs_of_pos hψ_pos] + norm_num + rw [abs_mul, abs_mul, h1, abs_of_pos hK_pos, abs_of_pos (pow_pos hc_pos n)] + ring + have hscale : (∫ t : ℝ, g (c * t)) = c⁻¹ * ∫ x : ℝ, g x := by + have h := MeasureTheory.Measure.integral_comp_mul_left g c + simpa [abs_of_pos (inv_pos.mpr hc_pos)] using h + have hL1 : (∫ x : ℝ, g x) ≤ Real.sqrt (2 * Real.pi) * Real.sqrt n.factorial := by + have heq2 : g = fun x : ℝ => |aeval x (hermite n)| * Real.exp (-(x ^ 2 / 2)) := by + rw [hg_def, hψ_def] + rw [heq2] + exact hermite_gaussian_L1_bound n + calc ∫ t : ℝ, |iteratedDeriv n (gaussianKernel ε) t| + = ∫ t : ℝ, K * c ^ n * g (c * t) := by rw [habs_eq] + _ = K * c ^ n * ∫ t : ℝ, g (c * t) := MeasureTheory.integral_const_mul _ _ + _ = K * c ^ n * (c⁻¹ * ∫ x : ℝ, g x) := by rw [hscale] + _ = (K * c⁻¹) * (c ^ n * ∫ x : ℝ, g x) := by ring + _ ≤ (K * c⁻¹) * (c ^ n * (Real.sqrt (2 * Real.pi) * Real.sqrt n.factorial)) := by + have hKcinv_nonneg : (0 : ℝ) ≤ K * c⁻¹ := (mul_pos hK_pos (inv_pos.mpr hc_pos)).le + have hcn_nonneg : (0 : ℝ) ≤ c ^ n := (pow_pos hc_pos n).le + exact mul_le_mul_of_nonneg_left (mul_le_mul_of_nonneg_left hL1 hcn_nonneg) hKcinv_nonneg + _ = c ^ n * Real.sqrt n.factorial := by + have h1 : K * c⁻¹ * (c ^ n * (Real.sqrt (2 * Real.pi) * Real.sqrt n.factorial)) + = (K * c⁻¹ * Real.sqrt (2 * Real.pi)) * (c ^ n * Real.sqrt n.factorial) := by ring + rw [h1, hKc, one_mul] + _ ≤ (max c 1) ^ (n + 1) * Real.sqrt n.factorial := by + have h1 : c ^ n ≤ (max c 1) ^ n := + pow_le_pow_left₀ hc_pos.le (le_max_left c 1) n + have hge1 : (1 : ℝ) ≤ max c 1 := le_max_right c 1 + have h2 : (max c 1 : ℝ) ^ n ≤ (max c 1) ^ (n + 1) := by + calc (max c 1 : ℝ) ^ n = (max c 1) ^ n * 1 := (mul_one _).symm + _ ≤ (max c 1) ^ n * (max c 1) := + mul_le_mul_of_nonneg_left hge1 (pow_nonneg (zero_le_one.trans hge1) n) + _ = (max c 1) ^ (n + 1) := (pow_succ _ _).symm + exact mul_le_mul_of_nonneg_right (h1.trans h2) (Real.sqrt_nonneg _) + +end + +end QuantumMechanics diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/GeneratorInvariance.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/GeneratorInvariance.lean new file mode 100644 index 0000000000..5b0e4d48d9 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/GeneratorInvariance.lean @@ -0,0 +1,154 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Existence.CandidateGenerator + +/-! +# The candidate Stone generator's domain is invariant under its own group + +Toward the *reconstruction* half of Stone's theorem (`U t = exp(-it Hgen)`, not attempted by +`StoneGenerator.lean`, which only gives existence of `Hgen`): the first genuinely new +ingredient reconstruction needs is that the candidate generator `T := stoneCandidateGenerator +hUmul` commutes with the group it was built from, i.e. `U` preserves `T`'s domain and +`T (U t ψ) = U t (T ψ)` for `ψ ∈ T.domain`. Consequently `U`'s orbit through any `ψ ∈ T.domain` is +differentiable at *every* time, not just `t = 0`, with derivative `i • T (U t ψ)` — matching the +shape of `Unbounded.Flow.Stone`'s `expUnitaryGroup_hasDerivAt` for the spectral-integral group, and +the natural next input toward an ODE-uniqueness argument identifying the two. + +## Main definitions + +- `stoneCandidateGenerator_translate_hasDerivAt` : `U t` applied to the `t = 0` derivative witness + of `ψ`'s orbit is again a `t = 0` derivative witness, this time for `U t ψ`'s orbit. +- `stoneCandidateDomain_translate` : `T.domain` is invariant under every `U t`. +- `stoneCandidateGenerator_translate` : `T` commutes with `U t` on `T.domain`. +- `stoneCandidateGenerator_hasDerivAt` : the orbit of `ψ ∈ T.domain` is differentiable at every + real time `s`, with derivative `i • T (U s ψ)`. +-/ + +@[expose] public section + +namespace QuantumMechanics + +noncomputable section + +open scoped InnerProductSpace + +universe u + +variable {H : Type u} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] +variable {U : ℝ → H →L[ℂ] H} (hUmul : ∀ s t, U (s + t) = U s * U t) + +omit [CompleteSpace H] in +include hUmul in +/-- `U t (U s ψ)` and `U s (U t ψ)` agree as functions of `s`, since `s + t = t + s`. -/ +theorem stoneCandidateGenerator_translate_comm (ψ : H) (t : ℝ) : + (fun s : ℝ => (U t : H →L[ℂ] H) (U s ψ)) = (fun s : ℝ => (U s : H →L[ℂ] H) (U t ψ)) := by + funext s + have h1 : (U t : H →L[ℂ] H) (U s ψ) = U (t + s) ψ := by + rw [hUmul t s, ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply] + have h2 : (U s : H →L[ℂ] H) (U t ψ) = U (s + t) ψ := by + rw [hUmul s t, ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply] + rw [h1, h2, add_comm t s] + +omit [CompleteSpace H] in +include hUmul in +/-- If `ψ`'s orbit is differentiable at `0` with witness `φ`, then `U t ψ`'s orbit is again +differentiable at `0`, with witness `U t φ` — the group law turns the fixed continuous linear map +`U t` applied to `ψ`'s derivative witness into a derivative witness for `U t ψ`. -/ +theorem stoneCandidateGenerator_translate_hasDerivAt {ψ φ : H} (t : ℝ) + (hφ : HasDerivAt (fun s : ℝ => U s ψ) φ 0) : + HasDerivAt (fun s : ℝ => U s (U t ψ)) (U t φ) 0 := by + let L' : H →L[ℝ] H := (U t).restrictScalars ℝ + have hconst : HasDerivAt (fun _ : ℝ => L') 0 0 := hasDerivAt_const 0 L' + have happly := hconst.clm_apply hφ + have happly' : HasDerivAt (fun s : ℝ => (U t : H →L[ℂ] H) (U s ψ)) (U t φ) 0 := by + simpa [L'] using happly + rw [stoneCandidateGenerator_translate_comm hUmul ψ t] at happly' + exact happly' + +omit [CompleteSpace H] in +include hUmul in +/-- The candidate domain is invariant under every `U t`. -/ +theorem stoneCandidateDomain_translate {ψ : H} (hψ : stoneCandidateDomainPred (U := U) ψ) + (t : ℝ) : stoneCandidateDomainPred (U := U) (U t ψ) := by + obtain ⟨φ, hφ⟩ := hψ + exact ⟨U t φ, stoneCandidateGenerator_translate_hasDerivAt hUmul t hφ⟩ + +omit [CompleteSpace H] in +include hUmul in +/-- The candidate domain, packaged as a `Submodule`-invariance statement under every `U t`. -/ +theorem stoneCandidateDomain_translate_mem (ψ : stoneCandidateDomain (U := U) hUmul) (t : ℝ) : + (U t (ψ : H)) ∈ stoneCandidateDomain (U := U) hUmul := + stoneCandidateDomain_translate hUmul ψ.property t + +omit [CompleteSpace H] in +include hUmul in +/-- The candidate generator commutes with the group it was built from: for `ψ` in `T.domain`, +`U t ψ` is again in `T.domain`, and `T (U t ψ) = U t (T ψ)`. -/ +theorem stoneCandidateGenerator_translate (ψ : stoneCandidateDomain (U := U) hUmul) (t : ℝ) : + stoneCandidateGenerator (U := U) hUmul + ⟨U t (ψ : H), stoneCandidateDomain_translate_mem hUmul ψ t⟩ = + U t (stoneCandidateGenerator (U := U) hUmul ψ) := by + set φ := stoneCandidateDeriv hUmul ψ with hφ_def + have hφ : HasDerivAt (fun s : ℝ => U s (ψ : H)) φ 0 := stoneCandidateDeriv_spec hUmul ψ + have htψ : HasDerivAt (fun s : ℝ => U s (U t (ψ : H))) (U t φ) 0 := + stoneCandidateGenerator_translate_hasDerivAt hUmul t hφ + have hderiv_eq : stoneCandidateDeriv hUmul + ⟨U t (ψ : H), stoneCandidateDomain_translate_mem hUmul ψ t⟩ = U t φ := + HasDerivAt.unique + (stoneCandidateDeriv_spec hUmul ⟨U t (ψ : H), stoneCandidateDomain_translate_mem hUmul ψ t⟩) + htψ + show (-Complex.I) • stoneCandidateDeriv hUmul + ⟨U t (ψ : H), stoneCandidateDomain_translate_mem hUmul ψ t⟩ = U t ((-Complex.I) • φ) + rw [hderiv_eq, map_smul] + +omit [CompleteSpace H] in +include hUmul in +/-- The orbit of `ψ ∈ T.domain` is differentiable at every real time `s`, not just `s = 0`, with +derivative `i • T (U s ψ)` — the "everywhere differentiable" form of Stone's generator relation, +matching `Unbounded.Flow.Stone.expUnitaryGroup_hasDerivAt`'s shape for the spectral-integral +group. This is exactly the ingredient an ODE-uniqueness argument identifying `U` with the +spectral-integral group generated by `T`'s essential self-adjoint closure would need on both +sides. -/ +theorem stoneCandidateGenerator_hasDerivAt (ψ : stoneCandidateDomain (U := U) hUmul) (s : ℝ) : + HasDerivAt (fun r : ℝ => U r (ψ : H)) + (Complex.I • U s (stoneCandidateGenerator (U := U) hUmul ψ)) s := by + set φ := stoneCandidateDeriv hUmul ψ with hφ_def + have hφ : HasDerivAt (fun r : ℝ => U r (ψ : H)) φ 0 := stoneCandidateDeriv_spec hUmul ψ + have hshift : HasDerivAt (fun r : ℝ => U (r - s) (ψ : H)) φ s := by + have hsub : HasDerivAt (fun r : ℝ => r - s) 1 s := by + simpa using (hasDerivAt_id' (𝕜 := ℝ) s).sub_const s + simpa [Function.comp_def] using hφ.scomp_of_eq s hsub (by ring) + let L : H →L[ℂ] H := U s + let L' : H →L[ℝ] H := L.restrictScalars ℝ + have hconst : HasDerivAt (fun _ : ℝ => L') 0 s := hasDerivAt_const s L' + have happly := hconst.clm_apply hshift + have happly' : HasDerivAt (fun r : ℝ => L' (U (r - s) (ψ : H))) (L' φ) s := by + simpa using happly + have hcongr : HasDerivAt (fun r : ℝ => U r (ψ : H)) (L' φ) s := by + apply happly'.congr_of_eventuallyEq + filter_upwards [] with r + show U r (ψ : H) = L' (U (r - s) (ψ : H)) + have hL'_eq : L' (U (r - s) (ψ : H)) = (U s : H →L[ℂ] H) (U (r - s) (ψ : H)) := rfl + rw [hL'_eq] + have hgroup := hUmul s (r - s) + have hrs : s + (r - s) = r := by ring + calc + U r (ψ : H) = U (s + (r - s)) (ψ : H) := by rw [hrs] + _ = (U s * U (r - s)) (ψ : H) := by rw [hgroup] + _ = (U s : H →L[ℂ] H) (U (r - s) (ψ : H)) := by + rw [ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply] + have hLφ : L' φ = U s φ := rfl + rw [hLφ] at hcongr + have hTψ : stoneCandidateGenerator (U := U) hUmul ψ = (-Complex.I) • φ := rfl + have : U s φ = Complex.I • U s (stoneCandidateGenerator (U := U) hUmul ψ) := by + rw [hTψ, map_smul, smul_smul] + norm_num + rwa [this] at hcongr + +end +end QuantumMechanics diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/GenericGardingKernel.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/GenericGardingKernel.lean new file mode 100644 index 0000000000..fc45bcecb8 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/GenericGardingKernel.lean @@ -0,0 +1,137 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Existence.CandidateGenerator +public import Mathlib.Analysis.Calculus.ParametricIntegral +public import Mathlib.Analysis.Complex.RealDeriv +public import Mathlib.MeasureTheory.Group.Integral + +/-! +# The Gårding-vector commutation identity for a generic smooth kernel + +Milestone 2 of Track A (`STONE_GENERATOR_EXISTENCE_PLAN.md`): `GardingVectors.lean` proves +the single-derivative commutation identity `stoneCandidateGenerator_analyticGardingVector` for the +*specific* kernel `gaussianKernel ε`, via a differentiation-under-the-integral-sign argument +(`analyticGardingVector_hasDerivAt`) whose proof only ever uses four structural facts about the +kernel: it is continuous, it has an everywhere-defined derivative, that derivative is dominated +locally (near a shift `x` in a bounded neighborhood of `0`) by an integrable function, and the +kernel itself is integrable against `t ↦ U t ψ`. This file factors that argument out to apply to +*any* kernel `k` satisfying those four properties, so that assembling the full +`IsAnalyticVector` witness (which needs the *same* argument applied to `k := iteratedDeriv n +(gaussianKernel ε)` at every order `n`) does not need to re-derive +`hasDerivAt_integral_of_dominated_loc_of_deriv_le`'s application from scratch at each order — only +the four hypotheses need to be checked for `iteratedDeriv n (gaussianKernel ε)`, which is genuine +new work (`GaussianKernelGrowth.lean`'s companion file) but is now decoupled from this +differentiation-under-the-integral machinery itself. + +## Main results + +- `gardingVectorAt` : the Gårding vector of `ψ` against a generic kernel `k`. +- `gardingVectorAt_translate` : the algebraic translation identity, for any `k`. +- `gardingVectorAt_hasDerivAt` : the differentiation-under-the-integral commutation identity, for + any kernel `k` satisfying the four structural hypotheses above. +-/ + +@[expose] public section + +namespace QuantumMechanics + +noncomputable section + +open scoped InnerProductSpace Topology +open MeasureTheory Filter + +universe u + +variable {H : Type u} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] +variable {U : ℝ → H →L[ℂ] H} (hUmul : ∀ s t, U (s + t) = U s * U t) + +variable (U) in +/-- The Gårding vector of `ψ` against a generic (real-valued) kernel `k`, generalizing +`analyticGardingVector U ε ψ = gardingVectorAt U (gaussianKernel ε) ψ`. -/ +def gardingVectorAt (k : ℝ → ℝ) (ψ : H) : H := ∫ t : ℝ, (k t : ℂ) • U t ψ + +include hUmul in +/-- The algebraic translation identity for a generic kernel: `U s` applied to `gardingVectorAt k ψ` +is again a Gårding vector, of the kernel `k` shifted by `s`. Exactly +`analyticGardingVector_translate`'s proof with `gaussianKernel ε` replaced by an arbitrary `k` +(nothing in that proof used any special property of the Gaussian). -/ +theorem gardingVectorAt_translate (k : ℝ → ℝ) (ψ : H) + (hk_integrable : Integrable (fun t : ℝ => (k t : ℂ) • U t ψ)) (s : ℝ) : + U s (gardingVectorAt U k ψ) = ∫ u : ℝ, (k (u - s) : ℂ) • U u ψ := by + unfold gardingVectorAt + rw [← ContinuousLinearMap.integral_comp_comm (U s) hk_integrable] + have hpt : ∀ t : ℝ, U s ((k t : ℂ) • U t ψ) = (k t : ℂ) • U (t + s) ψ := by + intro t + rw [ContinuousLinearMap.map_smul] + congr 1 + rw [← mul_apply_eq_comp, ← hUmul s t, add_comm s t] + simp_rw [hpt] + rw [← integral_add_right_eq_self (fun u : ℝ => (k (u - s) : ℂ) • U u ψ) s] + simp only [add_sub_cancel_right] + +include hUmul in +/-- **The generic commutation-identity engine.** If a kernel `k` is continuous, has an everywhere +`HasDerivAt` derivative `k'` which is itself continuous, is integrable against `t ↦ U t ψ`, and +`k'` is dominated near a shift `x ∈ (-1,1)` by a fixed integrable function of `u`, then the orbit +`s ↦ U s (gardingVectorAt U k ψ)` is differentiable at `0` with derivative +`∫ u, -k' u • U u ψ` — exactly `analyticGardingVector_hasDerivAt`'s conclusion, with `gaussianKernel +ε` replaced by `k` throughout. The proof is verbatim the same differentiation-under-the-integral +argument (`hasDerivAt_integral_of_dominated_loc_of_deriv_le`), so this lemma need only be proved +once. -/ +theorem gardingVectorAt_hasDerivAt (hUunit : ∀ t, U t ∈ unitary (H →L[ℂ] H)) + (hUcont : ∀ ξ : H, Continuous (fun t : ℝ => U t ξ)) (k k' : ℝ → ℝ) + (hk_cont : Continuous k) (hk'_cont : Continuous k') (hk_deriv : ∀ t, HasDerivAt k (k' t) t) + (ψ : H) (hk_integrable : Integrable (fun t : ℝ => (k t : ℂ) • U t ψ)) + (bound : ℝ → ℝ) (hbound_int : Integrable bound) + (hbound : ∀ u : ℝ, ∀ x ∈ Metric.ball (0 : ℝ) 1, |k' (u - x)| * ‖ψ‖ ≤ bound u) : + HasDerivAt (fun s : ℝ => U s (gardingVectorAt U k ψ)) + (∫ u : ℝ, ((-(k' u) : ℝ) : ℂ) • U u ψ) 0 := by + -- The orbit function, rewritten via the translation identity. + have horbit : (fun s : ℝ => U s (gardingVectorAt U k ψ)) = + fun s : ℝ => ∫ u : ℝ, (k (u - s) : ℂ) • U u ψ := + funext (gardingVectorAt_translate hUmul k ψ hk_integrable) + -- Per-point derivative in `s`, for every `u`, at every `s`. + have hpt_deriv : ∀ u s : ℝ, HasDerivAt (fun s : ℝ => (k (u - s) : ℂ) • U u ψ) + (((-(k' (u - s)) : ℝ) : ℂ) • U u ψ) s := by + intro u s + have hf1 := hk_deriv (u - s) + have hcomp : HasDerivAt (fun s : ℝ => u - s) (-1 : ℝ) s := (hasDerivAt_id s).const_sub u + have hg : HasDerivAt (fun s : ℝ => k (u - s)) (k' (u - s) * (-1)) s := hf1.comp s hcomp + have hgcs := hg.ofReal_comp.smul_const (U u ψ) + have heq : ((-(k' (u - s)) : ℝ) : ℂ) • U u ψ = ((k' (u - s) * (-1) : ℝ) : ℂ) • U u ψ := by + congr 1; push_cast; ring + rw [heq]; exact hgcs + -- Continuity facts feeding measurability. + have hFmeas : ∀ s : ℝ, Continuous (fun u : ℝ => (k (u - s) : ℂ) • U u ψ) := by + intro s + have h1 : Continuous (fun u : ℝ => (k (u - s) : ℂ)) := by fun_prop + exact h1.smul (hUcont ψ) + have hF'meas : Continuous (fun u : ℝ => ((-(k' u) : ℝ) : ℂ) • U u ψ) := by + have h1 : Continuous (fun u : ℝ => ((-(k' u) : ℝ) : ℂ)) := by fun_prop + exact h1.smul (hUcont ψ) + -- Assemble via the dominated-derivative theorem. + obtain ⟨-, hderiv⟩ := hasDerivAt_integral_of_dominated_loc_of_deriv_le + (F := fun s u : ℝ => (k (u - s) : ℂ) • U u ψ) + (F' := fun s u : ℝ => ((-(k' (u - s)) : ℝ) : ℂ) • U u ψ) + (x₀ := (0 : ℝ)) (bound := bound) + (Metric.ball_mem_nhds 0 one_pos) + (Filter.Eventually.of_forall (fun s => (hFmeas s).aestronglyMeasurable)) + (by simpa using hk_integrable) + (by simpa using hF'meas.aestronglyMeasurable) + (ae_of_all _ (fun u => fun x hx => by + rw [norm_smul, Complex.norm_real, Real.norm_eq_abs, abs_neg, + ContinuousLinearMap.norm_map_of_mem_unitary (hUunit u)] + exact hbound u x hx)) + hbound_int + (ae_of_all _ (fun u => fun x _ => hpt_deriv u x)) + rw [← horbit] at hderiv + simpa only [sub_zero] using hderiv + +end + +end QuantumMechanics diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/IteratedKernelGrowth.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/IteratedKernelGrowth.lean new file mode 100644 index 0000000000..78ba6b4277 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/IteratedKernelGrowth.lean @@ -0,0 +1,270 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Existence.GaussianKernelGrowth +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Existence.GenericGardingKernel + +/-! +# Pointwise (not just `L¹`) growth of the heat kernel's iterated derivatives + +Milestone 2 of Track A (`STONE_GENERATOR_EXISTENCE_PLAN.md`): `gardingVectorAt_hasDerivAt` +(`GenericGardingKernel.lean`) needs, for `k := iteratedDeriv n (gaussianKernel ε)`, a **local +pointwise** domination bound on `k' = iteratedDeriv (n+1) (gaussianKernel ε)` near a shift `x` in +a bounded neighborhood of `0` — materially different from `GaussianKernelGrowth.lean`'s *global* +`L¹`-norm bound on `iteratedDeriv n (gaussianKernel ε)` itself. This file supplies that pointwise +bound, via a simple coefficient-sum estimate on Hermite polynomials (weaker than, and much easier +than, the `L¹` growth-rate estimate already proved) combined with +`gaussianKernel_iteratedDeriv_eq`'s closed form. + +## Main results + +- `hermite_aeval_le_poly_growth` : `|Hₙ(y)| ≤ Cₙ (1+|y|)ⁿ` for an explicit `n`-dependent constant. +- `gaussianKernel_iteratedDeriv_shift_bound` : the local domination bound needed by + `gardingVectorAt_hasDerivAt`, generalizing `gaussianKernel_deriv_shift_bound` to every order. +-/ + +@[expose] public section + +namespace QuantumMechanics + +noncomputable section + +open MeasureTheory Polynomial + +/-- **A simple pointwise coefficient-sum bound** on Hermite polynomials: `|Hₙ(y)| ≤ Cₙ (1+|y|)ⁿ`, +where `Cₙ` is the sum of the absolute values of `Hₙ`'s coefficients. Much weaker than (and much +easier to prove than) `hermite_gaussian_L1_bound`'s weighted `L¹` growth rate, but exactly the +*pointwise* statement `gardingVectorAt_hasDerivAt`'s local domination hypothesis needs. -/ +theorem hermite_aeval_le_poly_growth (n : ℕ) : + ∃ C : ℝ, 0 ≤ C ∧ ∀ y : ℝ, |aeval y (hermite n)| ≤ C * (1 + |y|) ^ n := by + set C : ℝ := ∑ i ∈ Finset.range (n + 1), |((hermite n).coeff i : ℝ)| with hC_def + have hC_nonneg : 0 ≤ C := Finset.sum_nonneg fun i _ => abs_nonneg _ + refine ⟨C, hC_nonneg, fun y => ?_⟩ + have hsum : aeval y (hermite n) = + ∑ i ∈ Finset.range ((hermite n).natDegree + 1), ((hermite n).coeff i : ℝ) * y ^ i := by + rw [aeval_eq_sum_range] + simp [zsmul_eq_mul] + rw [natDegree_hermite] at hsum + rw [hsum] + calc |∑ i ∈ Finset.range (n + 1), ((hermite n).coeff i : ℝ) * y ^ i| + ≤ ∑ i ∈ Finset.range (n + 1), |((hermite n).coeff i : ℝ) * y ^ i| := + Finset.abs_sum_le_sum_abs _ _ + _ = ∑ i ∈ Finset.range (n + 1), |((hermite n).coeff i : ℝ)| * |y| ^ i := by + simp [abs_mul, abs_pow] + _ ≤ ∑ i ∈ Finset.range (n + 1), |((hermite n).coeff i : ℝ)| * (1 + |y|) ^ n := by + refine Finset.sum_le_sum fun i hi => ?_ + have hi' : i ≤ n := Nat.lt_succ_iff.mp (Finset.mem_range.mp hi) + have h1 : |y| ≤ 1 + |y| := by linarith [abs_nonneg y] + have h2 : |y| ^ i ≤ (1 + |y|) ^ i := pow_le_pow_left₀ (abs_nonneg y) h1 i + have h3 : (1 + |y|) ^ i ≤ (1 + |y|) ^ n := + pow_le_pow_right₀ (by linarith [abs_nonneg y]) hi' + exact mul_le_mul_of_nonneg_left (h2.trans h3) (abs_nonneg _) + _ = C * (1 + |y|) ^ n := by rw [← Finset.sum_mul] + +/-- **The local pointwise domination bound**, generalizing `gaussianKernel_deriv_shift_bound` +(order `1`) to every order: for `x` in the closed unit ball, `iteratedDeriv (n+1) (gaussianKernel +ε) (u - x)` is dominated by a constant (depending on `n`, `ε`, but not `x` or `u`) times a +polynomial-times-Gaussian envelope in `u`. Proved from `gaussianKernel_iteratedDeriv_eq`'s closed +form and `hermite_aeval_le_poly_growth`, using `(u-x)² ≥ u²/2 - 1` for `x² ≤ 1` (the same +inequality `gaussianKernel_deriv_shift_bound` uses) to push the shift onto a Gaussian-tail loss of +a fixed multiplicative factor `exp(1/ε)`. -/ +theorem gaussianKernel_iteratedDeriv_shift_bound (n : ℕ) {ε : ℝ} (hε : 0 < ε) : + ∃ D : ℝ, 0 ≤ D ∧ ∀ {x : ℝ}, x ^ 2 ≤ 1 → ∀ u : ℝ, + |iteratedDeriv (n + 1) (gaussianKernel ε) (u - x)| ≤ + D * ((1 + |u|) ^ (n + 1) * Real.exp (-(u ^ 2) / (2 * ε))) := by + set c : ℝ := Real.sqrt (2 / ε) with hc_def + have hc_pos : 0 < c := Real.sqrt_pos.mpr (by positivity) + have hc_sq : c ^ 2 = 2 / ε := Real.sq_sqrt (by positivity) + set K : ℝ := (Real.pi * ε) ^ (-(1 : ℝ) / 2) with hK_def + have hK_pos : 0 < K := by rw [hK_def]; positivity + obtain ⟨Cn, hCn_nonneg, hCn⟩ := hermite_aeval_le_poly_growth (n + 1) + set D : ℝ := K * c ^ (n + 1) * Cn * (1 + c) ^ (n + 1) * Real.exp (1 / ε) with hD_def + refine ⟨D, by positivity, fun {x} hx u => ?_⟩ + rw [gaussianKernel_iteratedDeriv_eq hε (n + 1) (u - x)] + have hval : |K * (c ^ (n + 1) * ((-1 : ℝ) ^ (n + 1) * + aeval (c * (u - x)) (hermite (n + 1)) * Real.exp (-((c * (u - x)) ^ 2 / 2))))| = + K * c ^ (n + 1) * (|aeval (c * (u - x)) (hermite (n + 1))| * + Real.exp (-((c * (u - x)) ^ 2 / 2))) := by + rw [abs_mul, abs_mul, abs_mul, abs_mul, abs_of_pos hK_pos, abs_of_pos (pow_pos hc_pos (n + 1)), + abs_pow, abs_neg, abs_one, one_pow, one_mul, + abs_of_pos (Real.exp_pos _), mul_assoc] + rw [hval] + have hshift_arg : 1 + |c * (u - x)| ≤ (1 + c) * (1 + |u|) := by + have h1 : |c * (u - x)| ≤ c * (|u| + 1) := by + rw [abs_mul, abs_of_pos hc_pos] + have h2 : |u - x| ≤ |u| + 1 := by + have h3 : |u - x| ≤ |u| + |x| := by + have := abs_add_le u (-x) + simpa [sub_eq_add_neg] using this + have h4 : |x| ≤ 1 := by nlinarith [sq_abs x, hx] + linarith + exact mul_le_mul_of_nonneg_left h2 hc_pos.le + nlinarith [abs_nonneg u, h1] + have hpoly_bound : |aeval (c * (u - x)) (hermite (n + 1))| ≤ + Cn * ((1 + c) * (1 + |u|)) ^ (n + 1) := by + calc |aeval (c * (u - x)) (hermite (n + 1))| + ≤ Cn * (1 + |c * (u - x)|) ^ (n + 1) := hCn _ + _ ≤ Cn * ((1 + c) * (1 + |u|)) ^ (n + 1) := by + gcongr + have hexp_bound : Real.exp (-((c * (u - x)) ^ 2 / 2)) ≤ + Real.exp (1 / ε) * Real.exp (-(u ^ 2) / (2 * ε)) := by + rw [← Real.exp_add] + apply Real.exp_le_exp.mpr + have hsq : u ^ 2 / 2 - 1 ≤ (u - x) ^ 2 := by nlinarith [sq_nonneg (u - 2 * x), hx] + have hkey : (c * (u - x)) ^ 2 = c ^ 2 * (u - x) ^ 2 := by ring + have heq1 : -((c * (u - x)) ^ 2 / 2) = -((u - x) ^ 2) / ε := by + rw [hkey, hc_sq]; field_simp + have heq2 : (1 : ℝ) / ε + -u ^ 2 / (2 * ε) = (1 - u ^ 2 / 2) / ε := by field_simp; ring + rw [heq1, heq2] + gcongr + linarith [hsq] + calc K * c ^ (n + 1) * (|aeval (c * (u - x)) (hermite (n + 1))| * + Real.exp (-((c * (u - x)) ^ 2 / 2))) + ≤ K * c ^ (n + 1) * ((Cn * ((1 + c) * (1 + |u|)) ^ (n + 1)) * + (Real.exp (1 / ε) * Real.exp (-(u ^ 2) / (2 * ε)))) := by + apply mul_le_mul_of_nonneg_left _ (by positivity : (0:ℝ) ≤ K * c ^ (n + 1)) + apply mul_le_mul hpoly_bound hexp_bound (Real.exp_pos _).le + positivity + _ = D * ((1 + |u|) ^ (n + 1) * Real.exp (-(u ^ 2) / (2 * ε))) := by + rw [hD_def, mul_pow]; ring + +/-- `|u|^n` times a Gaussian weight is integrable — the `abs`-of-argument variant of +`integrable_pow_mul_exp_neg_mul_sq`, obtained via `Integrable.abs` since `|u^n * exp(-cu²)| = +|u|^n * exp(-cu²)`. -/ +theorem integrable_abs_pow_mul_exp_neg_mul_sq (n : ℕ) {c : ℝ} (hc : 0 < c) : + Integrable (fun u : ℝ => |u| ^ n * Real.exp (-(c * u ^ 2))) := by + have h := integrable_pow_mul_exp_neg_mul_sq n hc + have habs := h.abs + have heq : (fun u : ℝ => |u ^ n * Real.exp (-(c * u ^ 2))|) = + fun u : ℝ => |u| ^ n * Real.exp (-(c * u ^ 2)) := by + funext u; rw [abs_mul, abs_pow, abs_of_pos (Real.exp_pos _)] + rwa [heq] at habs + +/-- **The integrability of the domination bound's envelope** `(1+|u|)ⁿ · exp(-cu²)`, via the +binomial theorem reducing to `integrable_abs_pow_mul_exp_neg_mul_sq` term by term — exactly the +integrability fact `gardingVectorAt_hasDerivAt` needs for its `bound_int` hypothesis, feeding +`gaussianKernel_iteratedDeriv_shift_bound`. -/ +theorem integrable_one_add_abs_pow_mul_exp_neg_mul_sq (n : ℕ) {c : ℝ} (hc : 0 < c) : + Integrable (fun u : ℝ => (1 + |u|) ^ n * Real.exp (-(c * u ^ 2))) := by + have heq : (fun u : ℝ => (1 + |u|) ^ n * Real.exp (-(c * u ^ 2))) = + fun u : ℝ => (∑ m ∈ Finset.range (n + 1), + |u| ^ m * (1 : ℝ) ^ (n - m) * n.choose m) * Real.exp (-(c * u ^ 2)) := by + funext u + rw [add_comm (1 : ℝ) |u|, add_pow] + rw [heq] + have heq2 : (fun u : ℝ => (∑ m ∈ Finset.range (n + 1), + |u| ^ m * (1 : ℝ) ^ (n - m) * n.choose m) * Real.exp (-(c * u ^ 2))) = + fun u : ℝ => ∑ m ∈ Finset.range (n + 1), + (n.choose m : ℝ) * (|u| ^ m * Real.exp (-(c * u ^ 2))) := by + funext u + rw [Finset.sum_mul] + congr 1 + funext m + ring + rw [heq2] + apply integrable_finsetSum + intro m _ + exact (integrable_abs_pow_mul_exp_neg_mul_sq m hc).const_mul _ + +/-- `gaussianKernel ε` is smooth to every order (used to get `Continuous`/`Differentiable` facts +about its iterated derivatives via the generic `ContDiff.continuous_iteratedDeriv`/ +`ContDiff.differentiable_iteratedDeriv`). -/ +theorem gaussianKernel_contDiff {ε : ℝ} (_hε : 0 < ε) : ContDiff ℝ (⊤ : ℕ∞) (gaussianKernel ε) := by + unfold gaussianKernel + fun_prop + +/-- `iteratedDeriv n (gaussianKernel ε)` is continuous, for every `n`. -/ +theorem gaussianKernel_iteratedDeriv_continuous (n : ℕ) {ε : ℝ} (hε : 0 < ε) : + Continuous (iteratedDeriv n (gaussianKernel ε)) := + ContDiff.continuous_iteratedDeriv' n + ((gaussianKernel_contDiff hε).of_le (by exact_mod_cast le_top)) + +/-- The successor identity `HasDerivAt (iteratedDeriv n (gaussianKernel ε)) (iteratedDeriv (n+1) +(gaussianKernel ε) t) t`, connecting consecutive orders — exactly the `hk_deriv` hypothesis +`gardingVectorAt_hasDerivAt` needs when instantiated at `k := iteratedDeriv n (gaussianKernel +ε)`. -/ +theorem gaussianKernel_iteratedDeriv_hasDerivAt (n : ℕ) {ε : ℝ} (hε : 0 < ε) (t : ℝ) : + HasDerivAt (iteratedDeriv n (gaussianKernel ε)) + (iteratedDeriv (n + 1) (gaussianKernel ε) t) t := by + have hdiff : DifferentiableAt ℝ (iteratedDeriv n (gaussianKernel ε)) t := by + have h := ContDiff.differentiable_iteratedDeriv' n + ((gaussianKernel_contDiff hε).of_le (by exact_mod_cast le_top)) + exact h.differentiableAt + have heq : deriv (iteratedDeriv n (gaussianKernel ε)) t = + iteratedDeriv (n + 1) (gaussianKernel ε) t := by + rw [iteratedDeriv_succ] + rw [← heq] + exact hdiff.hasDerivAt + +/-- `iteratedDeriv n (gaussianKernel ε)` is integrable against `t ↦ U t ψ`, exactly like +`gaussianKernel_smul_integrable` at order `0`: bounded by `|iteratedDeriv n (gaussianKernel ε) t| · +‖ψ‖` via unitarity, and `Integrable (iteratedDeriv n (gaussianKernel ε))` itself is +`gaussianKernel_iteratedDeriv_L1_bound`'s first component. -/ +theorem gaussianKernel_iteratedDeriv_smul_integrable {H : Type*} [NormedAddCommGroup H] + [InnerProductSpace ℂ H] [CompleteSpace H] {U : ℝ → H →L[ℂ] H} + (hUunit : ∀ t, U t ∈ unitary (H →L[ℂ] H)) (hUcont : ∀ ξ : H, Continuous (fun t : ℝ => U t ξ)) + (n : ℕ) {ε : ℝ} (hε : 0 < ε) (ψ : H) : + Integrable (fun t : ℝ => ((iteratedDeriv n (gaussianKernel ε) t : ℝ) : ℂ) • U t ψ) := by + obtain ⟨C, hC, hall⟩ := gaussianKernel_iteratedDeriv_L1_bound (ε := ε) hε + have hkernel_int : Integrable (iteratedDeriv n (gaussianKernel ε)) := (hall n).1 + have hg_int : Integrable (fun t : ℝ => |iteratedDeriv n (gaussianKernel ε) t| * ‖ψ‖) := + hkernel_int.abs.mul_const _ + have hmeas : AEStronglyMeasurable (fun t : ℝ => + ((iteratedDeriv n (gaussianKernel ε) t : ℝ) : ℂ) • U t ψ) volume := by + have hcont0 : Continuous (iteratedDeriv n (gaussianKernel ε)) := + gaussianKernel_iteratedDeriv_continuous n hε + have hcont1 : Continuous (fun t : ℝ => ((iteratedDeriv n (gaussianKernel ε) t : ℝ) : ℂ)) := + Complex.continuous_ofReal.comp hcont0 + exact (hcont1.smul (hUcont ψ)).aestronglyMeasurable + refine Integrable.mono' hg_int hmeas (ae_of_all _ fun t => le_of_eq ?_) + rw [norm_smul, Complex.norm_real, Real.norm_eq_abs, + ContinuousLinearMap.norm_map_of_mem_unitary (hUunit t)] + +/-- **The generalized single-derivative commutation identity, at every order `n`.** Instantiating +`gardingVectorAt_hasDerivAt` at `k := iteratedDeriv n (gaussianKernel ε)` — the whole point of +`GenericGardingKernel.lean`'s abstraction — using `gaussianKernel_iteratedDeriv_hasDerivAt` for the +derivative identity and `gaussianKernel_iteratedDeriv_shift_bound` (turned into an integrable +domination function via `integrable_one_add_abs_pow_mul_exp_neg_mul_sq`) for the local domination +hypothesis. This is the engine `analyticGardingVector_isAnalyticVector` (Milestone 2 of Track A) +needs, applied for every `n` to build the `IteratesSeq` witness. -/ +theorem gardingVectorAt_iteratedKernel_hasDerivAt {H : Type*} [NormedAddCommGroup H] + [InnerProductSpace ℂ H] [CompleteSpace H] {U : ℝ → H →L[ℂ] H} + (hUmul : ∀ s t, U (s + t) = U s * U t) (hUunit : ∀ t, U t ∈ unitary (H →L[ℂ] H)) + (hUcont : ∀ ξ : H, Continuous (fun t : ℝ => U t ξ)) (n : ℕ) {ε : ℝ} (hε : 0 < ε) (ψ : H) : + HasDerivAt (fun s : ℝ => U s (gardingVectorAt U (iteratedDeriv n (gaussianKernel ε)) ψ)) + (∫ u : ℝ, ((-(iteratedDeriv (n + 1) (gaussianKernel ε) u) : ℝ) : ℂ) • U u ψ) 0 := by + obtain ⟨D, hD_nonneg, hD⟩ := gaussianKernel_iteratedDeriv_shift_bound n hε + have hbound_int : Integrable (fun u : ℝ => + D * ‖ψ‖ * ((1 + |u|) ^ (n + 1) * Real.exp (-(u ^ 2) / (2 * ε)))) := by + have hbase : Integrable (fun u : ℝ => + (1 + |u|) ^ (n + 1) * Real.exp (-(u ^ 2) / (2 * ε))) := by + have heq : (fun u : ℝ => (1 + |u|) ^ (n + 1) * Real.exp (-(u ^ 2) / (2 * ε))) = + fun u : ℝ => (1 + |u|) ^ (n + 1) * Real.exp (-(1 / (2 * ε) * u ^ 2)) := by + funext u; rw [show -(u ^ 2) / (2 * ε) = -(1 / (2 * ε) * u ^ 2) by ring] + rw [heq] + exact integrable_one_add_abs_pow_mul_exp_neg_mul_sq (n + 1) (c := 1 / (2 * ε)) (by positivity) + exact hbase.const_mul _ + exact gardingVectorAt_hasDerivAt hUmul hUunit hUcont (iteratedDeriv n (gaussianKernel ε)) + (iteratedDeriv (n + 1) (gaussianKernel ε)) (gaussianKernel_iteratedDeriv_continuous n hε) + (gaussianKernel_iteratedDeriv_continuous (n + 1) hε) + (gaussianKernel_iteratedDeriv_hasDerivAt n hε) ψ + (gaussianKernel_iteratedDeriv_smul_integrable hUunit hUcont n hε ψ) + (fun u => D * ‖ψ‖ * ((1 + |u|) ^ (n + 1) * Real.exp (-(u ^ 2) / (2 * ε)))) + hbound_int (fun u x hx => by + have hx2 : x ^ 2 ≤ 1 := by + have hxb := Metric.mem_ball.mp hx + rw [Real.dist_eq, sub_zero] at hxb + nlinarith [abs_nonneg x, sq_abs x, hxb] + have := hD hx2 u + calc |iteratedDeriv (n + 1) (gaussianKernel ε) (u - x)| * ‖ψ‖ + ≤ (D * ((1 + |u|) ^ (n + 1) * Real.exp (-(u ^ 2) / (2 * ε)))) * ‖ψ‖ := + mul_le_mul_of_nonneg_right this (norm_nonneg ψ) + _ = D * ‖ψ‖ * ((1 + |u|) ^ (n + 1) * Real.exp (-(u ^ 2) / (2 * ε))) := by ring) + +end + +end QuantumMechanics diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/StoneGenerator.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/StoneGenerator.lean new file mode 100644 index 0000000000..667eea9fb4 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/StoneGenerator.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Existence.GardingVectorWitness +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.AnalyticVector.Nelson + +/-! +# Stone's theorem, existence direction: every strongly continuous unitary group has a +self-adjoint generator + +The capstone of Track A (`STONE_GENERATOR_EXISTENCE_PLAN.md`): for *any* strongly continuous +one-parameter unitary group `U` on a Hilbert space `H` — no spectral measure, no boundedness, no +prior structure assumed — the candidate generator `stoneCandidateGenerator hUmul` is essentially +self-adjoint, i.e. its closure is a genuine self-adjoint (unbounded) operator. This is the classical +"hard" direction of Stone's theorem, proved here entirely via **Gårding vectors + Nelson's +analytic-vector theorem**, avoiding the usual Bochner/spectral-integral route. + +## The last step + +Nelson's theorem (`IsSymmetric.isEssentiallySelfAdjoint_of_denseAnalyticVectors`) needs a symmetric +operator with a *dense* set of analytic vectors. `stoneCandidateGenerator_isSymmetric` +(`CandidateGenerator.lean`) gives symmetry. Density follows from combining this Track's two main +results: `analyticGardingVector_isAnalyticVector` (every Gårding vector `analyticGardingVector U ε +ψ` is an analytic vector) and `analyticGardingVector_tendsto` (`analyticGardingVector U ε ψ → ψ` as +`ε → 0⁺`, for *every* `ψ`) — so every vector in `H` is a limit of analytic vectors, hence lies in +the closure of their span, hence that closure is all of `H`. +-/ + +@[expose] public section + +namespace QuantumMechanics + +noncomputable section + +open scoped InnerProductSpace Topology +open LinearPMap + +universe u + +variable {H : Type u} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] +variable {U : ℝ → H →L[ℂ] H} (hUmul : ∀ s t, U (s + t) = U s * U t) + +include hUmul in +/-- **Density of analytic vectors.** Every `ψ : H` is a limit of Gårding vectors +`analyticGardingVector U ε ψ` as `ε → 0⁺` (`analyticGardingVector_tendsto`), each of which is an +analytic vector of `stoneCandidateGenerator` (`analyticGardingVector_isAnalyticVector`); hence +`ψ` lies in the closure of the analytic vectors, and since this holds for every `ψ`, the span of +the analytic vectors is dense. -/ +theorem stoneCandidateGenerator_denseAnalyticVectors (hU0 : U 0 = 1) + (hUunit : ∀ t, U t ∈ unitary (H →L[ℂ] H)) (hUcont : ∀ ξ : H, Continuous (fun t : ℝ => U t ξ)) : + (Submodule.span ℂ + {x : H | (stoneCandidateGenerator (U := U) hUmul).IsAnalyticVector x}).topologicalClosure = + (⊤ : Submodule ℂ H) := by + rw [Submodule.eq_top_iff'] + intro ψ + apply Submodule.closure_subset_topologicalClosure_span + refine mem_closure_of_tendsto + (analyticGardingVector_tendsto (U := U) (hUunit := hUunit) hU0 hUcont ψ) ?_ + have hev : ∀ᶠ ε : ℝ in nhdsWithin (0 : ℝ) (Set.Ioi 0), (0 : ℝ) < ε := self_mem_nhdsWithin + filter_upwards [hev] with ε hε + exact analyticGardingVector_isAnalyticVector hUmul hUunit hUcont hε ψ + +include hUmul in +/-- **Stone's theorem, existence direction.** Every strongly continuous one-parameter unitary +group `U` on a Hilbert space has an essentially self-adjoint generator: the closure of +`stoneCandidateGenerator hUmul` is a genuine self-adjoint (generally unbounded) operator. Proved +via Nelson's analytic-vector theorem, fed by density of Gårding vectors +(`stoneCandidateGenerator_denseAnalyticVectors`) — the culmination of Track A. -/ +theorem stoneCandidateGenerator_isEssentiallySelfAdjoint (hU0 : U 0 = 1) + (hUunit : ∀ t, U t ∈ unitary (H →L[ℂ] H)) (hUcont : ∀ ξ : H, Continuous (fun t : ℝ => U t ξ)) : + (stoneCandidateGenerator (U := U) hUmul).IsEssentiallySelfAdjoint := + LinearPMap.IsSymmetric.isEssentiallySelfAdjoint_of_denseAnalyticVectors + (stoneCandidateGenerator_isSymmetric (U := U) hU0 hUmul hUunit) + (stoneCandidateGenerator_denseAnalyticVectors hUmul hU0 hUunit hUcont) + +end + +end QuantumMechanics diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/StoneReconstruction.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/StoneReconstruction.lean new file mode 100644 index 0000000000..55f386ffde --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Existence/StoneReconstruction.lean @@ -0,0 +1,243 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Existence.GeneratorInvariance +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Existence.StoneGenerator +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.CayleySpectralData.SpecTheorem +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Flow.StoneInvariance + +/-! +# Stone's theorem, reconstruction direction: `U t = exp(-it Hgen)` + +The second half of Stone's theorem, completing `StoneGenerator.lean`'s existence result: +the strongly continuous unitary group `U` a candidate generator `T := stoneCandidateGenerator +hUmul` was built from is *recovered* from that generator's essential self-adjoint closure via the +Cayley-transform spectral integral (`unboundedSpectralTheorem_of_essentiallySelfAdjoint`, +`CayleySpectralData/SpecTheorem.lean`) and its associated unitary group +(`WOTSpectralMeasure.expUnitaryGroup`, `StoneUnitaryGroup.lean`). + +## Strategy + +For `V t := ContinuousLinearMapWOT.toCLM (D.expUnitaryGroup t)`, both `t ↦ U t x` and +`t ↦ V t x` satisfy the same "Schrödinger equation" `w'(t) = i • T.closure (w t)` for `x` in the +(dense) domain of `T := stoneCandidateGenerator hUmul`: + +- the `U`-side derivative relation is `GeneratorInvariance.stoneCandidateGenerator_hasDerivAt`; +- the `V`-side one combines `Flow.Stone`'s `expUnitaryGroup_hasDerivAt` with this Track's own + `Flow.StoneInvariance.expUnitaryGroup_translate`. + +Given that, `g(t) := ⟪U t x - V t x, U t x - V t x⟫_ℂ` has zero derivative everywhere (using that +`T.closure` is self-adjoint, hence symmetric, so `⟪w, T.closure w⟫` is always real and the two +cross terms of the product rule cancel exactly), hence is the constant `g(0) = 0`, hence `U t x = +V t x` for every `t`. Density of `T`'s domain (already established in +`StoneGenerator.lean`, since the analytic vectors used there are a subset of it) then +extends this identity from the domain to all of `H`, using continuity of both `U t` and `V t`. + +## Main definitions + +- `stoneReconstructionSpectralMeasure`, `stoneReconstructionData` : the Cayley-transform spectral + measure and domain-aware spectral theorem for `stoneCandidateGenerator hUmul`'s closure. +- `stoneReconstructionUnitaryGroup` : the resulting concrete `exp(itT)`, as a genuine + `H →L[ℂ] H`-valued function of `t`. +- `stoneCandidateGenerator_reconstruction` : `U t = stoneReconstructionUnitaryGroup t` for every + `t` — the reconstruction theorem itself. +-/ + +@[expose] public section + +namespace QuantumMechanics + +noncomputable section + +open scoped InnerProductSpace Topology + +universe u + +variable {H : Type u} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] +variable {U : ℝ → H →L[ℂ] H} (hU0 : U 0 = 1) (hUmul : ∀ s t, U (s + t) = U s * U t) + (hUunit : ∀ t, U t ∈ unitary (H →L[ℂ] H)) (hUcont : ∀ ξ : H, Continuous (fun t : ℝ => U t ξ)) + +include hU0 hUmul hUunit hUcont in +/-- The Cayley-transform spectral measure for `stoneCandidateGenerator hUmul`'s essential +self-adjoint closure. -/ +noncomputable def stoneReconstructionSpectralMeasure : WOTSpectralMeasure ℝ H := + cayleyRealSpectralMeasure (stoneCandidateGenerator (U := U) hUmul).closure + (stoneCandidateGenerator_isEssentiallySelfAdjoint hUmul hU0 hUunit hUcont) + +include hU0 hUmul hUunit hUcont in +/-- The domain-aware spectral theorem for `stoneCandidateGenerator hUmul`'s closure, built via the +Cayley transform from this Track's essential self-adjointness result. -/ +theorem stoneReconstructionData : + DomainAwareSelfAdjointSpectralTheorem (stoneCandidateGenerator (U := U) hUmul).closure + (stoneReconstructionSpectralMeasure hU0 hUmul hUunit hUcont) := + unboundedSpectralTheorem_of_essentiallySelfAdjoint (stoneCandidateGenerator (U := U) hUmul) + (stoneCandidateGenerator_isEssentiallySelfAdjoint hUmul hU0 hUunit hUcont) + +include hU0 hUmul hUunit hUcont in +/-- The concrete unitary group `exp(itT)` reconstructed from `T`'s spectral measure, as a genuine +`H →L[ℂ] H`-valued function of `t`. -/ +noncomputable def stoneReconstructionUnitaryGroup (t : ℝ) : H →L[ℂ] H := + ContinuousLinearMapWOT.toCLM ((stoneReconstructionData hU0 hUmul hUunit hUcont).expUnitaryGroup t) + +section Uniqueness + +variable {T : H →ₗ.[ℂ] H} + +omit [CompleteSpace H] in +/-- Two curves through the same starting point, both solving `w' = i • T w` while remaining in +`T`'s domain, coincide everywhere: the standard Schrödinger-equation uniqueness argument, using +only that `T` is symmetric (so `⟪w, T w⟫` is real, killing the cross terms in `d/dt‖w‖²`). -/ +theorem hasDerivAt_generator_unique {y z : ℝ → H} (hTsym : T.IsSymmetric) + (hy_mem : ∀ t, y t ∈ T.domain) (hz_mem : ∀ t, z t ∈ T.domain) + (hy_deriv : ∀ t, HasDerivAt y (Complex.I • T ⟨y t, hy_mem t⟩) t) + (hz_deriv : ∀ t, HasDerivAt z (Complex.I • T ⟨z t, hz_mem t⟩) t) + (h0 : y 0 = z 0) : ∀ t, y t = z t := by + set w : ℝ → H := fun t => y t - z t with hw_def + have hw_mem : ∀ t, w t ∈ T.domain := fun t => + T.domain.sub_mem (hy_mem t) (hz_mem t) + have hw_val : ∀ t, ((⟨w t, hw_mem t⟩ : T.domain) : H) = (⟨y t, hy_mem t⟩ : T.domain) - + (⟨z t, hz_mem t⟩ : T.domain) := fun t => rfl + have hw_apply : ∀ t, T ⟨w t, hw_mem t⟩ = T ⟨y t, hy_mem t⟩ - T ⟨z t, hz_mem t⟩ := by + intro t + have := T.map_sub ⟨y t, hy_mem t⟩ ⟨z t, hz_mem t⟩ + rwa [show (⟨y t, hy_mem t⟩ : T.domain) - ⟨z t, hz_mem t⟩ = ⟨w t, hw_mem t⟩ from rfl] at this + have hw_deriv : ∀ t, HasDerivAt w (Complex.I • T ⟨w t, hw_mem t⟩) t := by + intro t + have hsub := (hy_deriv t).sub (hz_deriv t) + rw [hw_apply t, smul_sub] + exact hsub + set g : ℝ → ℂ := fun t => ⟪w t, w t⟫_ℂ with hg_def + have hg_deriv : ∀ t, HasDerivAt g 0 t := by + intro t + have hprod := (hw_deriv t).inner ℂ (hw_deriv t) + have hval : ⟪w t, Complex.I • T ⟨w t, hw_mem t⟩⟫_ℂ + + ⟪Complex.I • T ⟨w t, hw_mem t⟩, w t⟫_ℂ = 0 := by + rw [inner_smul_left, inner_smul_right] + have hreal_t := LinearPMap.isSymmetric_iff_inner_map_self_real.mp hTsym ⟨w t, hw_mem t⟩ + have hswap : ⟪(w t : H), T ⟨w t, hw_mem t⟩⟫_ℂ = ⟪T ⟨w t, hw_mem t⟩, (w t : H)⟫_ℂ := by + rw [← inner_conj_symm (w t : H) (T ⟨w t, hw_mem t⟩), hreal_t] + rw [hswap] + have hconjI : (starRingEnd ℂ) Complex.I = -Complex.I := Complex.conj_I + rw [hconjI] + ring + rwa [hval] at hprod + have hg_const : ∀ t, g t = g 0 := fun t => + is_const_of_deriv_eq_zero (fun t => (hg_deriv t).differentiableAt) + (fun t => (hg_deriv t).deriv) t 0 + have hg0 : g 0 = 0 := by + show ⟪w 0, w 0⟫_ℂ = 0 + have : w 0 = 0 := by rw [hw_def]; simp [h0] + rw [this]; simp + intro t + have hgt0 : g t = 0 := (hg_const t).trans hg0 + have hw0 : w t = 0 := inner_self_eq_zero.mp hgt0 + exact sub_eq_zero.mp hw0 + +end Uniqueness + +include hU0 hUmul hUunit hUcont in +/-- **Stone's theorem, reconstruction direction.** `U` agrees with the concrete unitary group +`stoneReconstructionUnitaryGroup` on every vector in `stoneCandidateGenerator hUmul`'s domain. -/ +theorem stoneCandidateGenerator_reconstruction_of_mem_domain + (x : (stoneCandidateGenerator (U := U) hUmul).domain) (t : ℝ) : + U t (x : H) = stoneReconstructionUnitaryGroup hU0 hUmul hUunit hUcont t (x : H) := by + have hle := (stoneCandidateGenerator (U := U) hUmul).le_closure + have hTsym : (stoneCandidateGenerator (U := U) hUmul).closure.IsSymmetric := + LinearPMap.IsSelfAdjoint.isSymmetric (LinearPMap.isEssentiallySelfAdjoint_def.mp + (stoneCandidateGenerator_isEssentiallySelfAdjoint hUmul hU0 hUunit hUcont)) + have hx_dom : (x : H) ∈ (stoneCandidateGenerator (U := U) hUmul).closure.domain := + hle.1 x.property + set D := stoneReconstructionData (U := U) hU0 hUmul hUunit hUcont with hD_def + set x' : (stoneCandidateGenerator (U := U) hUmul).closure.domain := ⟨(x : H), hx_dom⟩ + with hx'_def + -- The `U`-side orbit and its everywhere-derivative, transported from `X` to `X.closure`. + have hUorbit_mem : ∀ t, U t (x : H) ∈ (stoneCandidateGenerator (U := U) hUmul).closure.domain := + fun t => hle.1 (stoneCandidateDomain_translate_mem hUmul x t) + have hUorbit_deriv : ∀ t, HasDerivAt (fun r : ℝ => U r (x : H)) + (Complex.I • (stoneCandidateGenerator (U := U) hUmul).closure + ⟨U t (x : H), hUorbit_mem t⟩) t := by + intro t + have hraw := stoneCandidateGenerator_hasDerivAt hUmul x t + have heq : (stoneCandidateGenerator (U := U) hUmul).closure ⟨U t (x : H), hUorbit_mem t⟩ = + stoneCandidateGenerator (U := U) hUmul + ⟨U t (x : H), stoneCandidateDomain_translate_mem hUmul x t⟩ := + (LinearPMap.apply_comp_inclusion hle + ⟨U t (x : H), stoneCandidateDomain_translate_mem hUmul x t⟩).symm + rw [heq, stoneCandidateGenerator_translate hUmul x t] + exact hraw + -- The `V`-side orbit and its everywhere-derivative. + have hVorbit_mem : ∀ t, D.expUnitaryGroup t (x : H) ∈ + (stoneCandidateGenerator (U := U) hUmul).closure.domain := + fun t => D.expUnitaryGroup_translate_mem x' t + have hVorbit_deriv : ∀ t, HasDerivAt (fun r : ℝ => D.expUnitaryGroup r (x : H)) + (Complex.I • (stoneCandidateGenerator (U := U) hUmul).closure + ⟨D.expUnitaryGroup t (x : H), hVorbit_mem t⟩) t := by + intro t + have hraw : HasDerivAt (fun r : ℝ => D.expUnitaryGroup r (x : H)) + (D.expUnitaryGroup t (Complex.I • (stoneCandidateGenerator (U := U) hUmul).closure x')) t := + D.expUnitaryGroup_hasDerivAt x' t + have hcomm : D.expUnitaryGroup t ((stoneCandidateGenerator (U := U) hUmul).closure x') = + (stoneCandidateGenerator (U := U) hUmul).closure + ⟨D.expUnitaryGroup t (x : H), hVorbit_mem t⟩ := + (D.expUnitaryGroup_translate x' t).symm + have hscalar : D.expUnitaryGroup t + (Complex.I • (stoneCandidateGenerator (U := U) hUmul).closure x') = + Complex.I • D.expUnitaryGroup t + ((stoneCandidateGenerator (U := U) hUmul).closure x') := map_smul _ _ _ + rw [hscalar, hcomm] at hraw + exact hraw + have h0 : U 0 (x : H) = D.expUnitaryGroup 0 (x : H) := by + rw [hU0] + simp [D.expUnitaryGroup_zero] + have hVt := hasDerivAt_generator_unique hTsym hUorbit_mem hVorbit_mem + hUorbit_deriv hVorbit_deriv h0 t + show U t (x : H) = ContinuousLinearMapWOT.toCLM (D.expUnitaryGroup t) (x : H) + rw [hVt] + rfl + +include hU0 hUunit hUcont in +/-- `stoneCandidateGenerator hUmul`'s domain is dense: every analytic vector lies in it (an +analytic vector's iterate sequence starts at the vector itself, so `v 0 = x` with +`v 0 : T.domain`), so the domain, a submodule, contains the span of the analytic vectors; density +of that span's topological closure (`stoneCandidateGenerator_denseAnalyticVectors`) then forces +the domain's own topological closure to be everything too, by monotonicity. -/ +theorem stoneCandidateGenerator_domain_dense : + Dense ((stoneCandidateGenerator (U := U) hUmul).domain : Set H) := by + have hsub : {x : H | (stoneCandidateGenerator (U := U) hUmul).IsAnalyticVector x} ⊆ + ((stoneCandidateGenerator (U := U) hUmul).domain : Set H) := by + rintro x ⟨v, ⟨hv0, -⟩, -⟩ + rw [← hv0] + exact (v 0).property + have hspan_le : Submodule.span ℂ + {x : H | (stoneCandidateGenerator (U := U) hUmul).IsAnalyticVector x} ≤ + (stoneCandidateGenerator (U := U) hUmul).domain := + Submodule.span_le.mpr hsub + have hmono := Submodule.topologicalClosure_mono hspan_le + rw [stoneCandidateGenerator_denseAnalyticVectors hUmul hU0 hUunit hUcont] at hmono + exact Submodule.dense_iff_topologicalClosure_eq_top.mpr (top_le_iff.mp hmono) + +include hU0 hUmul hUunit hUcont in +/-- **Stone's theorem, in full: existence and reconstruction.** Every strongly continuous +one-parameter unitary group `U` on a Hilbert space equals `exp(itHgen)` for its own essentially +self-adjoint generator `Hgen := stoneCandidateGenerator hUmul`, reconstructed via the Cayley +transform's spectral integral (`stoneReconstructionUnitaryGroup`) — for *every* vector, not just +those in `Hgen`'s domain: `stoneCandidateGenerator_reconstruction_of_mem_domain` extended from the +(dense, `stoneCandidateGenerator_domain_dense`) domain to all of `H` by continuity of both sides. -/ +theorem stoneCandidateGenerator_reconstruction (x : H) (t : ℝ) : + U t x = stoneReconstructionUnitaryGroup hU0 hUmul hUunit hUcont t x := by + have hdense := stoneCandidateGenerator_domain_dense hU0 hUmul hUunit hUcont + have heq : Set.EqOn (fun ξ : H => U t ξ) + (fun ξ : H => stoneReconstructionUnitaryGroup hU0 hUmul hUunit hUcont t ξ) + ((stoneCandidateGenerator (U := U) hUmul).domain : Set H) := by + intro ξ hξ + exact stoneCandidateGenerator_reconstruction_of_mem_domain hU0 hUmul hUunit hUcont ⟨ξ, hξ⟩ t + have hext := Continuous.ext_on hdense (U t).continuous + (stoneReconstructionUnitaryGroup hU0 hUmul hUunit hUcont t).continuous heq + exact congrFun hext x + +end +end QuantumMechanics diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Flow/Stone.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Flow/Stone.lean new file mode 100644 index 0000000000..914f5737ff --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Flow/Stone.lean @@ -0,0 +1,276 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.SelfAdjointSpectralTheorem +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Stone + +/-! +# Stone generator of a domain-aware spectral theorem + +This file is the operator-level hand-off from the real spectral integral to Stone's theorem. +The scalar and Hilbert-space limit is proved in `Stone`; the theorem below uses the domain +equality and self-adjoint uniqueness package from `SelfAdjointSpectralTheorem` to identify the +maximal spectral integral with the given unbounded operator. +-/ + +@[expose] public section + +noncomputable section + +open MeasureTheory Set +open scoped Topology InnerProductSpace Function +open QuantumMechanics.WOTSpectralMeasure + +namespace QuantumMechanics + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] +variable {T : H →ₗ.[ℂ] H} +variable {μS : QuantumMechanics.WOTSpectralMeasure ℝ H} + +namespace DomainAwareSelfAdjointSpectralTheorem + +/-- The spectral unitary group has strong derivative `iT` on the domain of its self-adjoint +generator. This is the usable unbounded Stone theorem for a domain-aware spectral theorem. + +The sign convention is the one used by `expIntegral`: the group is `exp (itT)`, so its generator +as a real-time derivative is `iT`. -/ +theorem expUnitaryGroup_strong_slope_tendsto + (D : DomainAwareSelfAdjointSpectralTheorem T μS) (x : T.domain) : + Filter.Tendsto + (fun t : ℝ => t⁻¹ • (D.expUnitaryGroup t x - x)) + (𝓝[≠] (0 : ℝ)) + (𝓝 (Complex.I • T x)) := by + have hdom : ∀ y : T.domain, (y : H) ∈ spectralSquareMomentDomain μS := by + intro y + have hy : (y : H) ∈ (T.domain : Set H) := y.property + rw [D.domain_eq_squareMoment] at hy + exact hy + have heq : maximalSpectralIntegral μS = T := + maximalSpectralIntegral_eq_of_isSelfAdjoint_of_isWeakSpectralResolution + T D.isSelfAdjoint_of D.reconstruction_of hdom + have hxmax : (x : H) ∈ + (QuantumMechanics.WOTSpectralMeasure.maximalSpectralIntegral μS).domain := by + rw [heq] + exact x.property + have hstrong := + QuantumMechanics.WOTSpectralMeasure.expIntegral_strong_slope_tendsto μS (x : H) hxmax + change Filter.Tendsto + (fun t : ℝ => t⁻¹ • + (QuantumMechanics.WOTSpectralMeasure.expIntegral μS t (x : H) - (x : H))) + (𝓝[≠] (0 : ℝ)) + (𝓝 (Complex.I • T x)) + have hval : + (QuantumMechanics.WOTSpectralMeasure.maximalSpectralIntegral μS) + ⟨(x : H), hxmax⟩ = T x := by + cases heq + rfl + rw [hval] at hstrong + exact hstrong + +theorem expUnitaryGroup_hasDerivAt_zero + (D : DomainAwareSelfAdjointSpectralTheorem T μS) (x : T.domain) : + HasDerivAt (fun t : ℝ => D.expUnitaryGroup t (x : H)) + (Complex.I • T x) 0 := by + rw [hasDerivAt_iff_tendsto_slope] + convert D.expUnitaryGroup_strong_slope_tendsto x using 1 + funext t + simp [slope, D.expUnitaryGroup_zero] + +/-- The Stone derivative at every time, not just at the identity. + +The proof uses only the group law and the zero-time derivative. In particular, no invariance +of the unbounded domain under the unitary group is needed: the translated difference quotient is +`U(s)` applied to the zero-time difference quotient of the original vector. -/ +theorem expUnitaryGroup_hasDerivAt + (D : DomainAwareSelfAdjointSpectralTheorem T μS) (x : T.domain) (s : ℝ) : + HasDerivAt (fun t : ℝ => D.expUnitaryGroup t (x : H)) + (D.expUnitaryGroup s (Complex.I • T x)) s := by + let U : H →L[ℂ] H := + ContinuousLinearMapWOT.toCLM + (D.expUnitaryGroup s) + have hzero : HasDerivAt + (fun t : ℝ => D.expUnitaryGroup t (x : H)) + (Complex.I • T x) 0 := D.expUnitaryGroup_hasDerivAt_zero x + have hshift : HasDerivAt + (fun t : ℝ => D.expUnitaryGroup (t - s) (x : H)) + (Complex.I • T x) s := by + have hsub : HasDerivAt (fun t : ℝ => t - s) 1 s := by + simpa using (hasDerivAt_id' (𝕜 := ℝ) s).sub_const s + simpa [Function.comp_def] using hzero.scomp_of_eq s hsub (by ring) + let U' : H →L[ℝ] H := U.restrictScalars ℝ + have hconst : HasDerivAt (fun _ : ℝ => U') 0 s := hasDerivAt_const s U' + have happly := hconst.clm_apply hshift + have happly' : HasDerivAt + (fun t : ℝ => U' (D.expUnitaryGroup (t - s) (x : H))) + (D.expUnitaryGroup s (Complex.I • T x)) s := by + simpa [U', U] using happly + apply happly'.congr_of_eventuallyEq + filter_upwards [] with t + have hgroup := D.expUnitaryGroup_add s (t - s) + calc + D.expUnitaryGroup t (x : H) = D.expUnitaryGroup (s + (t - s)) (x : H) := by + exact congrArg (fun r : ℝ => D.expUnitaryGroup r (x : H)) (by ring) + _ = (D.expUnitaryGroup s * D.expUnitaryGroup (t - s)) (x : H) := by + rw [hgroup] + _ = U' (D.expUnitaryGroup (t - s) (x : H)) := by + rfl + +theorem mem_domain_iff_expUnitaryGroup_strong_slope + (D : DomainAwareSelfAdjointSpectralTheorem T μS) (x : H) : + x ∈ T.domain ↔ + ∃ y : H, Filter.Tendsto + (fun t : ℝ => t⁻¹ • (D.expUnitaryGroup t x - x)) + (𝓝[≠] (0 : ℝ)) (𝓝 y) := by + constructor + · intro hx + let x' : T.domain := ⟨x, hx⟩ + refine ⟨Complex.I • T x', ?_⟩ + exact D.expUnitaryGroup_strong_slope_tendsto x' + · rintro ⟨y, hlim⟩ + change Filter.Tendsto + (fun t : ℝ => t⁻¹ • + (QuantumMechanics.WOTSpectralMeasure.expIntegral μS t x - x)) + (𝓝[≠] (0 : ℝ)) (𝓝 y) at hlim + let τ : ℕ → ℝ := fun n => ((n + 1 : ℕ) : ℝ)⁻¹ + have hτ0 : Filter.Tendsto τ Filter.atTop (𝓝 (0 : ℝ)) := by + dsimp [τ] + have hnat : Filter.Tendsto (fun n : ℕ => ((n + 1 : ℕ) : ℝ)) + Filter.atTop Filter.atTop := + (tendsto_natCast_atTop_atTop (R := ℝ)).comp (Filter.tendsto_add_atTop_nat 1) + exact tendsto_inv_atTop_zero.comp hnat + have hτ : Filter.Tendsto τ Filter.atTop (𝓝[≠] (0 : ℝ)) := by + refine tendsto_nhdsWithin_iff.mpr ⟨hτ0, ?_⟩ + filter_upwards [] with n + simp only [Set.mem_compl_iff, Set.mem_singleton_iff] + dsimp [τ] + positivity + let F : ℕ → ℝ → ENNReal := fun n r => + ENNReal.ofReal (‖expSlope (τ n) r‖ ^ 2) + have hF_meas : ∀ n, Measurable (F n) := by + intro n + exact ENNReal.continuous_ofReal.measurable.comp + ((expSlope_measurable (τ n)).norm.pow_const 2) + have hpoint : ∀ r : ℝ, + Filter.Tendsto (fun n => ‖expSlope (τ n) r‖ ^ 2) + Filter.atTop (𝓝 (r ^ 2)) := by + intro r + have h := (expSlope_tendsto r).comp hτ + have h' := h.norm.mul h.norm + simpa [Complex.norm_real, Real.norm_eq_abs, pow_two] using h' + have hF_lim : ∀ r : ℝ, + Filter.Tendsto (fun n => F n r) Filter.atTop + (𝓝 (ENNReal.ofReal (r ^ 2))) := by + intro r + exact ENNReal.continuous_ofReal.continuousAt.tendsto.comp (hpoint r) + have hfatou : + (∫⁻ r, Filter.liminf (fun n => F n r) Filter.atTop ∂μS.diagonalMeasure x) ≤ + Filter.liminf (fun n => ∫⁻ r, F n r ∂μS.diagonalMeasure x) Filter.atTop := + MeasureTheory.lintegral_liminf_le (μ := μS.diagonalMeasure x) hF_meas + have hleft : + (∫⁻ r, ENNReal.ofReal (r ^ 2) ∂μS.diagonalMeasure x) ≤ + Filter.liminf (fun n => ∫⁻ r, F n r ∂μS.diagonalMeasure x) Filter.atTop := by + calc + (∫⁻ r, ENNReal.ofReal (r ^ 2) ∂μS.diagonalMeasure x) = + ∫⁻ r, Filter.liminf (fun n => F n r) Filter.atTop ∂μS.diagonalMeasure x := by + apply MeasureTheory.lintegral_congr_ae + filter_upwards [] with r + exact (hF_lim r).liminf_eq.symm + _ ≤ _ := hfatou + have hgb : ∀ n, ∃ C : ℝ, ∀ r, ‖expSlope (τ n) r‖ ≤ C := by + intro n + refine ⟨2 * |τ n|⁻¹, fun r => ?_⟩ + rw [expSlope, norm_smul, Real.norm_eq_abs, abs_inv] + calc + |τ n|⁻¹ * ‖expFunction (τ n) r - 1‖ ≤ |τ n|⁻¹ * 2 := + mul_le_mul_of_nonneg_left + (by + calc + ‖expFunction (τ n) r - 1‖ ≤ + ‖expFunction (τ n) r‖ + ‖(1 : ℂ)‖ := norm_sub_le _ _ + _ = 2 := by rw [expFunction_modulus]; norm_num) + (by positivity) + _ = 2 * |τ n|⁻¹ := by ring + have hF_norm_sq : ∀ n, + ∫⁻ r, F n r ∂μS.diagonalMeasure x = + ENNReal.ofReal (‖(τ n)⁻¹ • + (QuantumMechanics.WOTSpectralMeasure.expIntegral μS (τ n) x - x)‖ ^ 2) := by + intro n + have hnorm := QuantumMechanics.WOTSpectralMeasure.boundedIntegral_norm_sq μS + (expSlope_measurable (τ n)) (hgb n) x + have hq := QuantumMechanics.WOTSpectralMeasure.expIntegral_slope_eq_boundedIntegral + μS (τ n) x (hgb n) + calc + ∫⁻ r, F n r ∂μS.diagonalMeasure x = + ∫⁻ r, ENNReal.ofReal (‖expSlope (τ n) r‖ ^ 2) + ∂μS.diagonalMeasure x := by rfl + _ = ENNReal.ofReal (‖QuantumMechanics.WOTSpectralMeasure.boundedIntegral μS + (expSlope (τ n)) (expSlope_measurable (τ n)) (hgb n) x‖ ^ 2) := + hnorm.symm + _ = ENNReal.ofReal (‖(τ n)⁻¹ • + (QuantumMechanics.WOTSpectralMeasure.expIntegral μS (τ n) x - x)‖ ^ 2) := by + rw [← hq] + have hq_lim : Filter.Tendsto + (fun n : ℕ => (τ n)⁻¹ • + (QuantumMechanics.WOTSpectralMeasure.expIntegral μS (τ n) x - x)) + Filter.atTop (𝓝 y) := hlim.comp hτ + have hq_norm_lim := hq_lim.norm.mul hq_lim.norm + have hq_ennreal_lim : Filter.Tendsto + (fun n : ℕ => ENNReal.ofReal (‖(τ n)⁻¹ • + (QuantumMechanics.WOTSpectralMeasure.expIntegral μS (τ n) x - x)‖ ^ 2)) + Filter.atTop (𝓝 (ENNReal.ofReal (‖y‖ ^ 2))) := + ENNReal.continuous_ofReal.continuousAt.tendsto.comp + (by simpa [pow_two] using hq_norm_lim) + have hright : + Filter.liminf (fun n => ∫⁻ r, F n r ∂μS.diagonalMeasure x) Filter.atTop ≠ ⊤ := by + rw [show (fun n => ∫⁻ r, F n r ∂μS.diagonalMeasure x) = + (fun n => ENNReal.ofReal (‖(τ n)⁻¹ • + (QuantumMechanics.WOTSpectralMeasure.expIntegral μS (τ n) x - x)‖ ^ 2)) + from funext hF_norm_sq] + rw [hq_ennreal_lim.liminf_eq] + exact ENNReal.ofReal_ne_top + have hfinite : + (∫⁻ r, ENNReal.ofReal (r ^ 2) ∂μS.diagonalMeasure x) < ⊤ := + lt_of_le_of_lt hleft (lt_top_iff_ne_top.mpr hright) + have hxspec : x ∈ spectralSquareMomentDomain μS := by + rw [mem_spectralSquareMomentDomain_iff] + refine ⟨(measurable_id.pow_const 2).aestronglyMeasurable, ?_⟩ + rw [hasFiniteIntegral_iff_enorm] + convert hfinite using 1 + apply MeasureTheory.lintegral_congr + intro r + rw [Real.enorm_eq_ofReal_abs, abs_of_nonneg (sq_nonneg r)] + exact (D.mem_domain_iff x).2 hxspec + +theorem mem_domain_iff_expUnitaryGroup_hasDerivAt_zero + (D : DomainAwareSelfAdjointSpectralTheorem T μS) (x : H) : + x ∈ T.domain ↔ + ∃ y : H, HasDerivAt (fun t : ℝ => D.expUnitaryGroup t x) y 0 := by + constructor + · intro hx + let x' : T.domain := ⟨x, hx⟩ + exact ⟨Complex.I • T x', D.expUnitaryGroup_hasDerivAt_zero x'⟩ + · rintro ⟨y, hy⟩ + apply (D.mem_domain_iff_expUnitaryGroup_strong_slope x).2 + rw [hasDerivAt_iff_tendsto_slope] at hy + refine ⟨y, ?_⟩ + convert hy using 1 + funext t + simp [slope, D.expUnitaryGroup_zero] + +/-- The Stone unitary group satisfies the star/inverse law: the adjoint of `expUnitaryGroup t` is +`expUnitaryGroup (-t)`. Both `star` and `⁻¹` agree here because every value lies in +`unitary (H →WOT[ℂ] H)`; this is the exact `WOT`-level identity `expIntegral_star` transported to +the domain-aware group. -/ +theorem expUnitaryGroup_star (D : DomainAwareSelfAdjointSpectralTheorem T μS) (t : ℝ) : + star (D.expUnitaryGroup t) = D.expUnitaryGroup (-t) := + QuantumMechanics.WOTSpectralMeasure.expIntegral_star μS t + +end DomainAwareSelfAdjointSpectralTheorem + +end QuantumMechanics + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Flow/StoneAPI.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Flow/StoneAPI.lean new file mode 100644 index 0000000000..47c47c4456 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Flow/StoneAPI.lean @@ -0,0 +1,121 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Flow.Stone + +/-! +# Public generator API for an unbounded spectral theorem + +`Unbounded.Flow.Stone` proves the analytic limit statements for the unitary group attached to a +domain-aware spectral theorem. This file packages the most useful interface theorem: a vector is +in the generator domain exactly when its orbit is differentiable at time zero. The result is +stated with an existential derivative so that it is independent of the sign convention chosen for +the group; a companion theorem identifies the derivative as `Complex.I • T x`. + +This is only packaging. The actual work is the square-moment argument and the maximal-integral +operator equality proved in `Unbounded.Flow.Stone` and `UnboundedSpectralIntegral`. +-/ + +@[expose] public section + +noncomputable section + +open Filter +open scoped Topology InnerProductSpace Function + +namespace QuantumMechanics + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] +variable {T : H →ₗ.[ℂ] H} +variable {μS : QuantumMechanics.WOTSpectralMeasure ℝ H} + +namespace DomainAwareSelfAdjointSpectralTheorem + +variable (D : DomainAwareSelfAdjointSpectralTheorem T μS) + +include D + +/-- If the orbit is differentiable at zero, its derivative is forced by the operator. -/ +theorem expUnitaryGroup_hasDerivAt_zero_iff (x : H) (y : H) : + HasDerivAt (fun t : ℝ => D.expUnitaryGroup t x) y 0 ↔ + ∃ hx : x ∈ T.domain, y = Complex.I • T ⟨x, hx⟩ := by + constructor + · intro hy + have hsl : Tendsto + (fun t : ℝ => t⁻¹ • (D.expUnitaryGroup t x - x)) + (𝓝[≠] (0 : ℝ)) (𝓝 y) := by + rw [hasDerivAt_iff_tendsto_slope] at hy + convert hy using 1 + funext t + simp [slope, D.expUnitaryGroup_zero] + have hx := (D.mem_domain_iff_expUnitaryGroup_strong_slope x).2 ⟨y, hsl⟩ + let x' : T.domain := ⟨x, hx⟩ + have hcanonical := D.expUnitaryGroup_strong_slope_tendsto x' + have heq : y = Complex.I • T x' := tendsto_nhds_unique hsl hcanonical + exact ⟨hx, heq⟩ + · rintro ⟨hx, rfl⟩ + exact D.expUnitaryGroup_hasDerivAt_zero ⟨x, hx⟩ + +/-- The generator domain is independent of the time at which differentiability is tested. This +is the orbit-level form of Stone's theorem used by evolution arguments. -/ +theorem mem_domain_iff_expUnitaryGroup_hasDerivAt (x : H) (s : ℝ) : + x ∈ T.domain ↔ + ∃ y : H, HasDerivAt (fun t : ℝ => D.expUnitaryGroup t x) y s := by + constructor + · intro hx + let x' : T.domain := ⟨x, hx⟩ + exact ⟨D.expUnitaryGroup s (Complex.I • T x'), + D.expUnitaryGroup_hasDerivAt x' s⟩ + · rintro ⟨y, hy⟩ + let U : H →L[ℂ] H := + ContinuousLinearMapWOT.toCLM (D.expUnitaryGroup (-s)) + let U' : H →L[ℝ] H := U.restrictScalars ℝ + have hshift : HasDerivAt + (fun t : ℝ => D.expUnitaryGroup (t + s) x) y 0 := by + have hadd : HasDerivAt (fun t : ℝ => t + s) 1 0 := by + simpa using (hasDerivAt_id' (𝕜 := ℝ) 0).add_const s + simpa [Function.comp_def] using hy.scomp_of_eq 0 hadd (by ring) + have hconst : HasDerivAt (fun _ : ℝ => U') 0 0 := hasDerivAt_const 0 U' + have happly := hconst.clm_apply hshift + have happly' : HasDerivAt + (fun t : ℝ => U' (D.expUnitaryGroup (t + s) x)) (U' y) 0 := by + simpa using happly + have hzero : HasDerivAt + (fun t : ℝ => D.expUnitaryGroup t x) (U' y) 0 := by + apply happly'.congr_of_eventuallyEq + filter_upwards [] with t + have hgroup := D.expUnitaryGroup_add (-s) (t + s) + calc + D.expUnitaryGroup t x = + D.expUnitaryGroup (-s + (t + s)) x := by + exact congrArg (fun r : ℝ => D.expUnitaryGroup r x) (by ring) + _ = (D.expUnitaryGroup (-s) * D.expUnitaryGroup (t + s)) x := by + rw [hgroup] + _ = U' (D.expUnitaryGroup (t + s) x) := by + rfl + exact (D.mem_domain_iff_expUnitaryGroup_hasDerivAt_zero x).2 + ⟨U' y, hzero⟩ + +/-- The derivative at an arbitrary time is uniquely the evolved generator vector. -/ +theorem expUnitaryGroup_hasDerivAt_iff (x : H) (y : H) (s : ℝ) : + HasDerivAt (fun t : ℝ => D.expUnitaryGroup t x) y s ↔ + ∃ hx : x ∈ T.domain, + y = D.expUnitaryGroup s (Complex.I • T ⟨x, hx⟩) := by + constructor + · intro hy + have hx := (D.mem_domain_iff_expUnitaryGroup_hasDerivAt x s).2 ⟨y, hy⟩ + let x' : T.domain := ⟨x, hx⟩ + have hcanonical := D.expUnitaryGroup_hasDerivAt x' s + have heq : y = D.expUnitaryGroup s (Complex.I • T x') := + hy.unique hcanonical + exact ⟨hx, heq⟩ + · rintro ⟨hx, rfl⟩ + exact D.expUnitaryGroup_hasDerivAt ⟨x, hx⟩ s + +end DomainAwareSelfAdjointSpectralTheorem + +end QuantumMechanics diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Flow/StoneInvariance.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Flow/StoneInvariance.lean new file mode 100644 index 0000000000..566a5cf3a8 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Flow/StoneInvariance.lean @@ -0,0 +1,116 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Flow.StoneAPI + +/-! +# The spectral-integral group's generator domain is invariant under its own group + +The `V`-side counterpart of +`StoneExistence.GeneratorInvariance.stoneCandidateGenerator_translate`: for a domain-aware +spectral theorem `D : DomainAwareSelfAdjointSpectralTheorem T μS`, the operator `T` commutes with +the unitary group `D.expUnitaryGroup` it generates — `D.expUnitaryGroup s` preserves `T.domain` +and `T` commutes with it there. Combined with the `U`-side lemma, this is exactly the missing +ingredient an ODE-uniqueness argument identifying an abstract strongly continuous unitary group +with the spectral-integral group of its own generator would need on both sides (see +`Existence/STONE_GENERATOR_EXISTENCE_PLAN.md`, milestone M5). + +The proof is the same "shift the known derivative-at-`s`" argument `expUnitaryGroup_hasDerivAt` +itself already uses internally, applied once more: differentiability of `t ↦ D.expUnitaryGroup t x` +at `t = s` is exactly differentiability of `t ↦ D.expUnitaryGroup t (D.expUnitaryGroup s x)` at +`t = 0`, via the group law `D.expUnitaryGroup t (D.expUnitaryGroup s x) = D.expUnitaryGroup (t + s) +x`. + +## Main definitions + +- `expUnitaryGroup_translate_mem` : `D.expUnitaryGroup s` preserves `T.domain`. +- `expUnitaryGroup_translate` : `T` commutes with `D.expUnitaryGroup s` on `T.domain`. +-/ + +@[expose] public section + +noncomputable section + +open scoped Topology InnerProductSpace Function +open QuantumMechanics.WOTSpectralMeasure + +namespace QuantumMechanics + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] +variable {T : H →ₗ.[ℂ] H} +variable {μS : QuantumMechanics.WOTSpectralMeasure ℝ H} + +namespace DomainAwareSelfAdjointSpectralTheorem + +variable (D : DomainAwareSelfAdjointSpectralTheorem T μS) + +include D + +/-- The group law: `D.expUnitaryGroup t (D.expUnitaryGroup s x) = D.expUnitaryGroup (t + s) x`, +via `expUnitaryGroup_add` and the (definitional) fact that `WOT`-multiplication is composition. -/ +theorem expUnitaryGroup_translate_comm (x : H) (s t : ℝ) : + D.expUnitaryGroup t (D.expUnitaryGroup s x) = D.expUnitaryGroup (t + s) x := by + rw [D.expUnitaryGroup_add t s] + rfl + +/-- `D.expUnitaryGroup s` preserves `T`'s domain: if `x ∈ T.domain`, so is `D.expUnitaryGroup s x`. + +Proof: `x`'s orbit is differentiable at `t = s` (`expUnitaryGroup_hasDerivAt`); shifting by `s` +turns this into differentiability of `t ↦ D.expUnitaryGroup t (D.expUnitaryGroup s x)` at `t = 0`, +which is exactly membership of `D.expUnitaryGroup s x` in `T.domain` +(`mem_domain_iff_expUnitaryGroup_hasDerivAt_zero`). -/ +theorem expUnitaryGroup_translate_mem (x : T.domain) (s : ℝ) : + D.expUnitaryGroup s (x : H) ∈ T.domain := by + have hf : HasDerivAt (fun r : ℝ => D.expUnitaryGroup r (x : H)) + (D.expUnitaryGroup s (Complex.I • T x)) s := + D.expUnitaryGroup_hasDerivAt x s + have hadd : HasDerivAt (fun t : ℝ => t + s) 1 0 := by + simpa using (hasDerivAt_id' (𝕜 := ℝ) 0).add_const s + have hshift : HasDerivAt (fun t : ℝ => D.expUnitaryGroup (t + s) (x : H)) + (D.expUnitaryGroup s (Complex.I • T x)) 0 := by + simpa [Function.comp_def] using hf.scomp_of_eq 0 hadd (by ring) + have hfun_eq : (fun t : ℝ => D.expUnitaryGroup (t + s) (x : H)) = + (fun t : ℝ => D.expUnitaryGroup t (D.expUnitaryGroup s (x : H))) := by + funext t + exact (D.expUnitaryGroup_translate_comm (x : H) s t).symm + rw [hfun_eq] at hshift + exact (D.mem_domain_iff_expUnitaryGroup_hasDerivAt_zero _).2 ⟨_, hshift⟩ + +/-- `T` commutes with `D.expUnitaryGroup s` on `T.domain`: for `x ∈ T.domain`, +`D.expUnitaryGroup s x ∈ T.domain` and `T (D.expUnitaryGroup s x) = D.expUnitaryGroup s (T x)`. -/ +theorem expUnitaryGroup_translate (x : T.domain) (s : ℝ) : + T ⟨D.expUnitaryGroup s (x : H), D.expUnitaryGroup_translate_mem x s⟩ = + D.expUnitaryGroup s (T x) := by + set y : T.domain := ⟨D.expUnitaryGroup s (x : H), D.expUnitaryGroup_translate_mem x s⟩ with hy_def + have hcanonical : HasDerivAt (fun t : ℝ => D.expUnitaryGroup t (y : H)) + (Complex.I • T y) 0 := + D.expUnitaryGroup_hasDerivAt_zero y + have hf : HasDerivAt (fun r : ℝ => D.expUnitaryGroup r (x : H)) + (D.expUnitaryGroup s (Complex.I • T x)) s := + D.expUnitaryGroup_hasDerivAt x s + have hadd : HasDerivAt (fun t : ℝ => t + s) 1 0 := by + simpa using (hasDerivAt_id' (𝕜 := ℝ) 0).add_const s + have hshift : HasDerivAt (fun t : ℝ => D.expUnitaryGroup (t + s) (x : H)) + (D.expUnitaryGroup s (Complex.I • T x)) 0 := by + simpa [Function.comp_def] using hf.scomp_of_eq 0 hadd (by ring) + have hfun_eq : (fun t : ℝ => D.expUnitaryGroup (t + s) (x : H)) = + (fun t : ℝ => D.expUnitaryGroup t (y : H)) := by + funext t + rw [hy_def] + exact (D.expUnitaryGroup_translate_comm (x : H) s t).symm + rw [hfun_eq] at hshift + have heq : Complex.I • T y = D.expUnitaryGroup s (Complex.I • T x) := + hcanonical.unique hshift + have hscalar : D.expUnitaryGroup s (Complex.I • T x) = Complex.I • D.expUnitaryGroup s (T x) := + map_smul _ _ _ + rw [hscalar] at heq + have hI : (Complex.I : ℂ) ≠ 0 := Complex.I_ne_zero + exact smul_right_injective H hI heq + +end DomainAwareSelfAdjointSpectralTheorem + +end QuantumMechanics diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/RealAnalytic.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/RealAnalytic.lean new file mode 100644 index 0000000000..5721a04ccb --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/RealAnalytic.lean @@ -0,0 +1,231 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Physlib.QuantumMechanics.Operators.Unbounded +public import Physlib.QuantumMechanics.Operators.SpectralTheory.Symmetric +public import Physlib.QuantumMechanics.Operators.SpectralTheory.SelfAdjoint +public import Mathlib.Analysis.InnerProductSpace.l2Space + +/-! # Reusable real-analytic certificates for unbounded observables + +Contains only the represented operator facts needed to identify a self-adjoint (or essentially +self-adjoint) `LinearPMap`: density, symmetry, defect indices, and the canonical closed extension. +Keeping these certificates separate lets multiplication, Schrödinger, and oscillator models share +the same analytic pipeline. + +## Main definitions + +- `DefectIndexCertificate` / `DefectIndexCertificate.essentiallySelfAdjoint` : the von Neumann + defect-index criterion for essential self-adjointness. +- `isEssentiallySelfAdjoint_of_hilbertBasis_eigenvectors` : a symmetric operator whose domain is + exactly the span of a Hilbert basis of eigenvectors with real eigenvalues is essentially + self-adjoint (the "eigenbasis density" criterion). +-/ + +@[expose] public section + +namespace QuantumMechanics + +noncomputable section + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-! ## Von Neumann's defect criterion -/ + +/-- A checkable certificate that a symmetric represented operator has self-adjoint closure. + +The two defect-number equalities are the analytic input. The conclusion is deliberately stored +as a theorem rather than as an axiom or an unproved declaration; `LinearPMap` supplies the von +Neumann criterion used in the proof. -/ +structure DefectIndexCertificate (T : H →ₗ.[ℂ] H) where + symmetric : T.IsSymmetric + dense : T.HasDenseDomain + plus : T.defectNumber Complex.I = 0 + minus : T.defectNumber (-Complex.I) = 0 + +lemma DefectIndexCertificate.essentiallySelfAdjoint + {T : H →ₗ.[ℂ] H} (C : DefectIndexCertificate T) : + T.IsEssentiallySelfAdjoint := + C.symmetric.isEssentiallySelfAdjoint_of_defectNumber_eq_zero C.dense C.plus C.minus + +lemma DefectIndexCertificate.closure_isSelfAdjoint + {T : H →ₗ.[ℂ] H} (C : DefectIndexCertificate T) : + IsSelfAdjoint T.closure := + C.essentiallySelfAdjoint + +/-- A self-adjoint operator is automatically an essentially self-adjoint core for itself. -/ +lemma ofSelfAdjoint_isEssentiallySelfAdjoint + {T : H →ₗ.[ℂ] H} (hT : IsSelfAdjoint T) : T.IsEssentiallySelfAdjoint := + LinearPMap.IsSelfAdjoint.isEssentiallySelfAdjoint hT + +/-! ## Essential self-adjointness from a Hilbert basis of eigenvectors + +A symmetric operator whose domain is *exactly* the (algebraic) span of a Hilbert basis of +eigenvectors with real eigenvalues is essentially self-adjoint. This is the standard "eigenbasis +density" criterion for essential self-adjointness (see e.g. Reed–Simon, *Methods of Modern +Mathematical Physics I: Functional Analysis*, Theorem VIII.3): reality of the eigenvalues makes +`T ∓ i` bounded below by `1` on the eigenbasis span, and the Hilbert-basis expansion of an +arbitrary `y : H` (with coefficients divided by `λ - z`) produces, in the limit of its partial +sums, an explicit preimage of `y` under `T.closure ∓ i`. +-/ + +section HilbertBasisCriterion + +open Finsupp Filter Complex LinearPMap +open scoped ENNReal Topology + +variable {ι : Type*} + +/-- **Essential self-adjointness from a Hilbert basis of eigenvectors.** If `T`'s domain is exactly +the (algebraic) span of a Hilbert basis `e`, and each basis vector `e i` is an eigenvector of `T` +with *real* eigenvalue `lam i`, then `T` is essentially self-adjoint. -/ +theorem isEssentiallySelfAdjoint_of_hilbertBasis_eigenvectors + (e : HilbertBasis ι ℂ H) (T : H →ₗ.[ℂ] H) (lam : ι → ℝ) + (hdom : T.domain = Submodule.span ℂ (Set.range e)) + (heig : ∀ i, T ⟨e i, hdom ▸ Submodule.subset_span ⟨i, rfl⟩⟩ = (lam i : ℂ) • e i) : + T.IsEssentiallySelfAdjoint := by + classical + have hmem : ∀ i, e i ∈ T.domain := fun i ↦ hdom ▸ Submodule.subset_span ⟨i, rfl⟩ + set v : ι → T.domain := fun i ↦ (⟨e i, hmem i⟩ : T.domain) with hv_def + set w : ι → H := fun i ↦ (lam i : ℂ) • e i with hw_def + -- `Finsupp.linearCombination` computes `T` on finite eigenbasis combinations. + have hcomp : (T.domain.subtype : T.domain →ₗ[ℂ] H) ∘ v = (⇑e) := by + funext i; simp [hv_def] + have hcomp2 : (T.toFun : T.domain →ₗ[ℂ] H) ∘ v = w := by + funext i; simp only [Function.comp_apply, hv_def]; exact heig i + have hv_coe : ∀ l : ι →₀ ℂ, + ((Finsupp.linearCombination ℂ v l : T.domain) : H) = Finsupp.linearCombination ℂ (⇑e) l := by + intro l + have h := Finsupp.apply_linearCombination ℂ T.domain.subtype v l + rw [hcomp] at h + exact h + have hTapply : ∀ l : ι →₀ ℂ, + T (Finsupp.linearCombination ℂ v l) = Finsupp.linearCombination ℂ w l := by + intro l + rw [← toFun_eq_coe] + have h := Finsupp.apply_linearCombination ℂ T.toFun v l + rw [hcomp2] at h + exact h + have hspan : ∀ x : T.domain, ∃ l : ι →₀ ℂ, Finsupp.linearCombination ℂ v l = x := by + intro x + have hx : (x : H) ∈ Submodule.span ℂ (Set.range e) := hdom ▸ x.2 + rw [← Finsupp.range_linearCombination] at hx + obtain ⟨l, hl⟩ := LinearMap.mem_range.mp hx + exact ⟨l, Subtype.ext (by rw [hv_coe, hl])⟩ + -- Symmetry: on eigenbasis combinations `⟪T x, x⟫` reduces to a manifestly real sum. + have hsym : T.IsSymmetric := by + rw [LinearPMap.isSymmetric_iff_inner_map_self_real] + intro x + obtain ⟨l, hl⟩ := hspan x + have hlH : (x : H) = Finsupp.linearCombination ℂ (⇑e) l := by rw [← hv_coe l, hl] + have hTx : T x = Finsupp.linearCombination ℂ w l := hl ▸ hTapply l + have hTx' : Finsupp.linearCombination ℂ w l + = ∑ i ∈ l.support, (l i * (lam i : ℂ)) • e i := by + rw [Finsupp.linearCombination_apply, Finsupp.sum] + exact Finset.sum_congr rfl fun i _ ↦ by rw [hw_def, smul_smul] + have hlH' : Finsupp.linearCombination ℂ (⇑e) l = ∑ i ∈ l.support, l i • e i := by + rw [Finsupp.linearCombination_apply, Finsupp.sum] + rw [hTx, hlH, hTx', hlH', e.orthonormal.inner_sum (fun i ↦ l i * (lam i : ℂ)) (fun i ↦ l i) + l.support, map_sum] + refine Finset.sum_congr rfl fun i _ ↦ ?_ + simp only [map_mul, Complex.conj_conj, Complex.conj_ofReal] + ring + have hdense : T.HasDenseDomain := by + rw [LinearPMap.hasDenseDomain_def, hdom, dense_iff_closure_eq, + ← Submodule.topologicalClosure_coe, e.dense_span, Submodule.top_coe] + have hTclosable : T.IsClosable := hsym.isClosable hdense + have hTclosure_sym : T.closure.IsSymmetric := hsym.closure hdense + have hTclosure_dense : T.closure.HasDenseDomain := hdense.closure + -- For `ζ = ± I`, real eigenvalues satisfy `|lam i - ζ| ≥ 1`. + have hbound : ∀ {ζ : ℂ}, ζ.re = 0 → normSq ζ = 1 → ∀ r : ℝ, 1 ≤ ‖(r : ℂ) - ζ‖ := by + intro ζ hre hsq r + have hns : (1 : ℝ) ≤ normSq ((r : ℂ) - ζ) := by + have h1 : ((r : ℂ) - ζ).re = r := by simp [hre] + have h2 : ((r : ℂ) - ζ).im = -ζ.im := by simp + rw [normSq_apply, h1, h2] + nlinarith [sq_nonneg r, normSq_apply ζ, hsq, hre] + calc (1 : ℝ) = Real.sqrt 1 := (Real.sqrt_one).symm + _ ≤ Real.sqrt (normSq ((r : ℂ) - ζ)) := Real.sqrt_le_sqrt hns + _ = ‖(r : ℂ) - ζ‖ := (Complex.norm_def _).symm + have hne : ∀ {ζ : ℂ}, ζ.re = 0 → normSq ζ = 1 → ∀ i, (lam i : ℂ) - ζ ≠ 0 := by + intro ζ hre hsq i h + have := hbound hre hsq (lam i) + rw [h, norm_zero] at this + linarith + -- The core surjectivity fact: `(T.closure - ζ • 1).range = ⊤` for `ζ = ± I`. + have hrange : ∀ {ζ : ℂ}, ζ.re = 0 → normSq ζ = 1 → + (T.closure - ζ • (1 : H →ₗ.[ℂ] H)).toFun.range = ⊤ := by + intro ζ hre hsq + rw [LinearMap.range_eq_top] + intro y + set c : ι → ℂ := fun i ↦ (inner (𝕜 := ℂ) (e i) y) with hc_def + have hy_sum : HasSum (fun i ↦ c i • e i) y := by + have h := e.hasSum_repr y + simpa [hc_def, HilbertBasis.repr_apply_apply] using h + have hc_summable : Summable fun i ↦ ‖c i‖ ^ 2 := e.orthonormal.inner_products_summable y + set g : ι → ℂ := fun i ↦ c i / ((lam i : ℂ) - ζ) with hg_def + have hg_le : ∀ i, ‖g i‖ ≤ ‖c i‖ := fun i ↦ by + rw [hg_def, Complex.norm_div] + exact div_le_self (norm_nonneg _) (hbound hre hsq (lam i)) + have hg_summable : Summable fun i ↦ ‖g i‖ ^ 2 := + Summable.of_nonneg_of_le (fun i ↦ sq_nonneg _) + (fun i ↦ pow_le_pow_left₀ (norm_nonneg _) (hg_le i) 2) hc_summable + have hg_mem : Memℓp g 2 := by + apply memℓp_gen + have hp2 : (2 : ℝ≥0∞).toReal = 2 := by norm_num + rw [hp2] + simpa [Real.rpow_natCast] using hg_summable + set z : H := e.repr.symm ⟨g, hg_mem⟩ with hz_def + have hz_sum : HasSum (fun i ↦ g i • e i) z := e.hasSum_repr_symm ⟨g, hg_mem⟩ + have hterm : ∀ i, g i * (lam i : ℂ) = c i + ζ * g i := fun i ↦ by + have hdiv : g i * ((lam i : ℂ) - ζ) = c i := by + rw [hg_def]; exact div_mul_cancel₀ (c i) (hne hre hsq i) + ring_nf + ring_nf at hdiv + linear_combination hdiv + -- Each single eigenbasis term already lies in `T`'s graph. + have hmem_graph_single : + ∀ i, ((g i • e i : H), (c i • e i + ζ • (g i • e i) : H)) ∈ T.graph := by + intro i + have hTvi : T (v i) = (lam i : ℂ) • e i := heig i + have hTe : T (g i • v i) = c i • e i + ζ • (g i • e i) := by + rw [LinearPMap.map_smul, hTvi, smul_smul, hterm i, add_smul, smul_smul] + have hco : ((g i • v i : T.domain) : H) = g i • e i := by + rw [SetLike.val_smul, hv_def] + simpa [hco, hTe] using T.mem_graph (g i • v i) + have hu := hz_sum.prodMk (hy_sum.add (hz_sum.const_smul ζ)) + have hgraph_closure : (z, y + ζ • z) ∈ T.graph.topologicalClosure := by + rw [← SetLike.mem_coe, Submodule.topologicalClosure_coe] + refine mem_closure_of_tendsto hu (Eventually.of_forall fun s ↦ ?_) + exact Submodule.sum_mem _ fun i _ ↦ hmem_graph_single i + rw [hTclosable.graph_closure_eq_closure_graph] at hgraph_closure + have hzdom : z ∈ T.closure.domain := mem_domain_of_mem_graph hgraph_closure + have hTz : T.closure ⟨z, hzdom⟩ = y + ζ • z := + ((image_iff hzdom).mpr hgraph_closure).symm + have hzdom' : z ∈ (T.closure - ζ • (1 : H →ₗ.[ℂ] H)).domain := by + rw [LinearPMap.sub_domain, LinearPMap.smul_domain, LinearPMap.one_domain, inf_top_eq] + exact hzdom + refine ⟨⟨z, hzdom'⟩, ?_⟩ + show (T.closure - ζ • (1 : H →ₗ.[ℂ] H)) ⟨z, hzdom'⟩ = y + rw [LinearPMap.sub_apply, LinearPMap.smul_apply] + have h1 : (1 : H →ₗ.[ℂ] H) ⟨z, (Submodule.mem_inf.mp hzdom').2⟩ = z := rfl + rw [h1, show T.closure ⟨z, (Submodule.mem_inf.mp hzdom').1⟩ = T.closure ⟨z, hzdom⟩ from rfl, + hTz] + abel + refine hTclosure_sym.isSelfAdjoint_of_range_eq_top hTclosure_dense ?_ ?_ + · have hI : T.closure + I • (1 : H →ₗ.[ℂ] H) = T.closure - (-I) • (1 : H →ₗ.[ℂ] H) := + LinearPMap.ext rfl fun x hf hg ↦ by + simp [LinearPMap.sub_apply, LinearPMap.add_apply, LinearPMap.smul_apply, sub_neg_eq_add] + rw [hI] + exact hrange (by simp) (by simp [normSq_apply]) + · exact hrange (by simp) (by simp [normSq_apply]) + +end HilbertBasisCriterion + +end + +end QuantumMechanics diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/ScalarMeasure.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/ScalarMeasure.lean new file mode 100644 index 0000000000..bcdbd85339 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/ScalarMeasure.lean @@ -0,0 +1,321 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Basic +public import Mathlib.MeasureTheory.Measure.Complex + +/-! + +# Scalar and diagonal measures of a weak spectral measure + +Testing `μS : WOTSpectralMeasure α H` against a pair of vectors `x, y : H` gives a complex +*scalar* measure `S ↦ ⟪y, μS S x⟫`, and testing against a single vector `x` on the diagonal +gives a positive, finite `Measure α`, `x`'s *diagonal* measure `S ↦ ‖μS S x‖² = re ⟪x, μS S x⟫`. +These are the measure-theoretic inputs to the bounded spectral integral built in +`BoundedIntegral.lean`; they are recorded here first, on their own, because the extensionality +principle `ext_of_scalarMeasure_eq` below — a weak spectral measure is determined by all of its +scalar matrix-coefficient measures — is the basic uniqueness tool used throughout the rest of +this development. + +## Main definitions + +- `scalarMeasure`, `scalarMeasure_apply` : `μS.scalarMeasure x y S = ⟪y, μS S x⟫`. +- `ext_of_scalarMeasure_eq` : a weak spectral measure is determined by its scalar measures. +- `diagonalMeasure`, `diagonalMeasure_apply_eq_norm_sq` : the vector-state spectral measure + `μₓ S = ‖μS S x‖²`, and its basic identities (`univ`, `map`, finiteness, homogeneity, the + parallelogram law). + +-/ + +@[expose] public section + +noncomputable section + +open scoped Topology InnerProductSpace Function +open ContinuousLinearMap ContinuousLinearMapWOT MeasureTheory Set + +namespace QuantumMechanics + +namespace WOTSpectralMeasure + +variable {α : Type*} [MeasurableSpace α] +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] +variable (μS : WOTSpectralMeasure α H) + +/-! ## A. The scalar (matrix-coefficient) measure and extensionality -/ + +/-- Evaluation of a WOT operator between two test vectors. -/ +def innerEvaluation (x y : H) : (H →WOT[ℂ] H) →+ ℂ where + toFun A := ⟪y, A x⟫_ℂ + map_zero' := by simp + map_add' A B := by + change ⟪y, (A + B) x⟫_ℂ = _ + rw [ContinuousLinearMapWOT.add_apply, inner_add_right] + +lemma continuous_innerEvaluation (x y : H) : + Continuous (innerEvaluation (H := H) x y) := by + change Continuous (fun A : H →WOT[ℂ] H ↦ ⟪y, A x⟫_ℂ) + fun_prop + +/-- The complex scalar measure obtained by testing a WOT spectral measure against `x` and `y`. +This is the measure used to state the unbounded reconstruction law weakly. -/ +def scalarMeasure (x y : H) : ComplexMeasure α := + μS.toVectorMeasure.mapRange (innerEvaluation (H := H) x y) + (continuous_innerEvaluation x y) + +@[simp] +lemma scalarMeasure_apply (x y : H) (S : Set α) : + μS.scalarMeasure x y S = ⟪y, μS S x⟫_ℂ := by + simp [scalarMeasure, innerEvaluation] + +lemma scalarMeasure_map {β : Type*} [MeasurableSpace β] + (f : α → β) (hf : Measurable f) (x y : H) : + (μS.map f hf).scalarMeasure x y = (μS.scalarMeasure x y).map f := by + apply VectorMeasure.ext + intro S hS + rw [scalarMeasure_apply] + rw [μS.map_apply f hf hS] + rw [MeasureTheory.VectorMeasure.map_apply _ hf hS] + rw [scalarMeasure_apply] + +/-- A weak spectral measure is determined by all of its scalar matrix-coefficient measures. +This is the extensionality principle used when comparing two spectral constructions obtained by +different bounded or unbounded routes. -/ +theorem ext_of_scalarMeasure_eq {μS νS : WOTSpectralMeasure α H} + (h : ∀ x y : H, μS.scalarMeasure x y = νS.scalarMeasure x y) : μS = νS := by + rw [WOTSpectralMeasure.mk.injEq] + apply MeasureTheory.VectorMeasure.ext + intro S hS + apply ContinuousLinearMapWOT.ext_inner + intro x y + change μS.scalarMeasure x y S = νS.scalarMeasure x y S + rw [h x y] + +/-! ## B. Positivity on the diagonal + +A weak PVM gives a positive scalar measure on every vector state. This is the measure-theoretic +input for the bounded and unbounded spectral integrals; it is deliberately proved here, before any +operator-valued integral is introduced. -/ + +lemma re_inner_nonneg (S : Set α) (x : H) : + 0 ≤ (⟪x, μS S x⟫_ℂ).re := by + let p : H →L[ℂ] H := (ContinuousLinearMapWOT.toCLM (μS S)) + have hp := μS.isStarProjection S + have hmul : p * p = p := by + exact congrArg ContinuousLinearMapWOT.toCLM hp.isIdempotentElem + have hstar : ContinuousLinearMap.adjoint p = p := by + rw [← ContinuousLinearMap.star_eq_adjoint] + exact congrArg ContinuousLinearMapWOT.toCLM hp.isSelfAdjoint + have hinner : ⟪x, p x⟫_ℂ = ⟪p x, p x⟫_ℂ := by + calc + ⟪x, p x⟫_ℂ = ⟪x, p (p x)⟫_ℂ := by + congr 1 + exact (congrArg (fun q : H →L[ℂ] H => q x) hmul).symm + _ = ⟪x, ContinuousLinearMap.adjoint p (p x)⟫_ℂ := by rw [hstar] + _ = ⟪p x, p x⟫_ℂ := ContinuousLinearMap.adjoint_inner_right p x (p x) + change 0 ≤ (⟪x, p x⟫_ℂ).re + rw [hinner] + exact inner_self_nonneg (𝕜 := ℂ) (x := p x) + +lemma re_inner_eq_norm_sq (S : Set α) (x : H) : + (⟪x, μS S x⟫_ℂ).re = ‖μS S x‖ ^ 2 := by + let p : H →L[ℂ] H := (ContinuousLinearMapWOT.toCLM (μS S)) + have hp := μS.isStarProjection S + have hmul : p * p = p := by + exact congrArg ContinuousLinearMapWOT.toCLM hp.isIdempotentElem + have hstar : ContinuousLinearMap.adjoint p = p := by + rw [← ContinuousLinearMap.star_eq_adjoint] + exact congrArg ContinuousLinearMapWOT.toCLM hp.isSelfAdjoint + have hinner : ⟪x, p x⟫_ℂ = ⟪p x, p x⟫_ℂ := by + calc + ⟪x, p x⟫_ℂ = ⟪x, p (p x)⟫_ℂ := by + congr 1 + exact (congrArg (fun q : H →L[ℂ] H => q x) hmul).symm + _ = ⟪x, ContinuousLinearMap.adjoint p (p x)⟫_ℂ := by rw [hstar] + _ = ⟪p x, p x⟫_ℂ := ContinuousLinearMap.adjoint_inner_right p x (p x) + change (⟪x, p x⟫_ℂ).re = ‖p x‖ ^ 2 + rw [hinner] + have hi : (⟪p x, p x⟫_ℂ).re = ‖p x‖ ^ 2 := + inner_self_eq_norm_sq (𝕜 := ℂ) (p x) + exact hi + +lemma inner_eq_inner_projection (S : Set α) (x : H) : + ⟪x, μS S x⟫_ℂ = ⟪μS S x, μS S x⟫_ℂ := by + let p : H →L[ℂ] H := (ContinuousLinearMapWOT.toCLM (μS S)) + have hp := μS.isStarProjection S + have hmul : p * p = p := by + exact congrArg ContinuousLinearMapWOT.toCLM hp.isIdempotentElem + have hstar : ContinuousLinearMap.adjoint p = p := by + rw [← ContinuousLinearMap.star_eq_adjoint] + exact congrArg ContinuousLinearMapWOT.toCLM hp.isSelfAdjoint + change ⟪x, p x⟫_ℂ = ⟪p x, p x⟫_ℂ + calc + ⟪x, p x⟫_ℂ = ⟪x, p (p x)⟫_ℂ := by + congr 1 + exact (congrArg (fun q : H →L[ℂ] H => q x) hmul).symm + _ = ⟪x, ContinuousLinearMap.adjoint p (p x)⟫_ℂ := by rw [hstar] + _ = ⟪p x, p x⟫_ℂ := ContinuousLinearMap.adjoint_inner_right p x (p x) + +lemma inner_eq_zero_of_disjoint {A B : Set α} (h : Disjoint A B) + (hA : MeasurableSet A) (hB : MeasurableSet B) (x : H) : + ⟪μS A x, μS B x⟫_ℂ = 0 := by + let pA : H →L[ℂ] H := (ContinuousLinearMapWOT.toCLM (μS A)) + let pB : H →L[ℂ] H := (ContinuousLinearMapWOT.toCLM (μS B)) + have hcomp : pA * pB = 0 := by + exact congrArg ContinuousLinearMapWOT.toCLM (μS.comp_of_disjoint h hA hB) + have hstar : ContinuousLinearMap.adjoint pA = pA := by + rw [← ContinuousLinearMap.star_eq_adjoint] + exact congrArg ContinuousLinearMapWOT.toCLM (μS.isStarProjection A).isSelfAdjoint + change ⟪pA x, pB x⟫_ℂ = 0 + calc + ⟪pA x, pB x⟫_ℂ = ⟪x, ContinuousLinearMap.adjoint pA (pB x)⟫_ℂ := + (ContinuousLinearMap.adjoint_inner_right pA x (pB x)).symm + _ = ⟪x, pA (pB x)⟫_ℂ := by rw [hstar] + _ = ⟪x, (pA * pB) x⟫_ℂ := by rfl + _ = 0 := by rw [hcomp]; simp + +lemma diagonal_tsum {f : ℕ → Set α} (hf : ∀ i, MeasurableSet (f i)) + (hdisj : Pairwise (Disjoint on f)) (x : H) : + ENNReal.ofReal (⟪x, μS (⋃ i, f i) x⟫_ℂ).re = + ∑' i, ENNReal.ofReal (⟪x, μS (f i) x⟫_ℂ).re := by + have hs := μS.hasSum_inner hf hdisj x x + have hre : HasSum (fun i ↦ (⟪x, μS (f i) x⟫_ℂ).re) + (⟪x, μS (⋃ i, f i) x⟫_ℂ).re := + hs.map Complex.reCLM.toAddMonoidHom Complex.reCLM.continuous + have hnonneg : ∀ i, 0 ≤ (⟪x, μS (f i) x⟫_ℂ).re := + fun i ↦ μS.re_inner_nonneg (f i) x + calc + ENNReal.ofReal (⟪x, μS (⋃ i, f i) x⟫_ℂ).re = + ENNReal.ofReal (∑' i, (⟪x, μS (f i) x⟫_ℂ).re) := + congrArg ENNReal.ofReal hre.tsum_eq.symm + _ = ∑' i, ENNReal.ofReal (⟪x, μS (f i) x⟫_ℂ).re := + ENNReal.ofReal_tsum_of_nonneg hnonneg hre.summable + +/-! ## C. The diagonal (vector-state) measure -/ + +/-- The positive scalar measure obtained by testing a weak PVM on a vector. + +Its value on a measurable set is `ofReal (re ⟪x,E(S)x⟫)`. The projection identity below shows +that this is the usual vector-state spectral measure. -/ +noncomputable def diagonalMeasure (x : H) : Measure α := by + let m : ∀ S : Set α, MeasurableSet S → ENNReal := + fun S _ => ENNReal.ofReal (⟪x, μS S x⟫_ℂ).re + have hm_empty : m ∅ MeasurableSet.empty = 0 := by simp [m] + have hm_iUnion : ∀ ⦃f : ℕ → Set α⦄ (hf : ∀ i, MeasurableSet (f i)), + Pairwise (Disjoint on f) → + m (⋃ i, f i) (MeasurableSet.iUnion hf) = ∑' i, m (f i) (hf i) := by + intro f hf hdisj + simpa [m] using μS.diagonal_tsum hf hdisj x + exact Measure.ofMeasurable m hm_empty hm_iUnion + +lemma diagonalMeasure_apply (x : H) (S : Set α) (hS : MeasurableSet S) : + μS.diagonalMeasure x S = ENNReal.ofReal (⟪x, μS S x⟫_ℂ).re := by + simp only [diagonalMeasure, Measure.ofMeasurable_apply _ hS] + +lemma diagonalMeasure_apply_eq_norm_sq (x : H) (S : Set α) (hS : MeasurableSet S) : + μS.diagonalMeasure x S = ENNReal.ofReal (‖μS S x‖ ^ 2) := by + rw [μS.diagonalMeasure_apply x S hS, μS.re_inner_eq_norm_sq S x] + +lemma diagonalMeasure_univ (x : H) : + μS.diagonalMeasure x Set.univ = ENNReal.ofReal (‖x‖ ^ 2) := by + rw [μS.diagonalMeasure_apply x Set.univ MeasurableSet.univ, μS.univ] + change ENNReal.ofReal (⟪x, x⟫_ℂ).re = _ + have hi : (⟪x, x⟫_ℂ).re = ‖x‖ ^ 2 := inner_self_eq_norm_sq (𝕜 := ℂ) x + rw [hi] + +lemma diagonalMeasure_map {β : Type*} [MeasurableSpace β] + (f : α → β) (hf : Measurable f) (x : H) : + (μS.map f hf).diagonalMeasure x = Measure.map f (μS.diagonalMeasure x) := by + apply Measure.ext + intro S hS + rw [(μS.map f hf).diagonalMeasure_apply x S hS, + Measure.map_apply hf hS, + μS.diagonalMeasure_apply x (f ⁻¹' S) (hS.preimage hf)] + have hmap : μS.map f hf S = μS (f ⁻¹' S) := μS.map_apply f hf hS + rw [hmap] + +instance diagonalMeasure_isFinite (x : H) : IsFiniteMeasure (μS.diagonalMeasure x) where + measure_univ_lt_top := by + rw [μS.diagonalMeasure_univ] + exact ENNReal.ofReal_lt_top + +lemma diagonalMeasure_neg (x : H) : + μS.diagonalMeasure (-x) = μS.diagonalMeasure x := by + apply Measure.ext + intro S hS + rw [μS.diagonalMeasure_apply _ _ hS, μS.diagonalMeasure_apply _ _ hS] + simp [inner_neg_left, inner_neg_right] + +lemma diagonalMeasure_I_smul (x : H) : + μS.diagonalMeasure (Complex.I • x) = μS.diagonalMeasure x := by + apply Measure.ext + intro S hS + rw [μS.diagonalMeasure_apply _ _ hS, μS.diagonalMeasure_apply _ _ hS] + simp [inner_smul_left, inner_smul_right] + +lemma diagonalMeasure_smul (c : ℂ) (x : H) : + μS.diagonalMeasure (c • x) = ENNReal.ofReal (‖c‖ ^ 2) • μS.diagonalMeasure x := by + apply Measure.ext + intro S hS + rw [Measure.smul_apply, μS.diagonalMeasure_apply _ _ hS, + μS.diagonalMeasure_apply _ _ hS] + have hinner : + (⟪c • x, μS S (c • x)⟫_ℂ).re = + ‖c‖ ^ 2 * (⟪x, μS S x⟫_ℂ).re := by + simp only [map_smul, inner_smul_left, inner_smul_right] + simp [Complex.mul_re, Complex.mul_im] + rw [Complex.sq_norm, Complex.normSq_apply] + ring + rw [hinner] + change ENNReal.ofReal (‖c‖ ^ 2 * (⟪x, μS S x⟫_ℂ).re) = + ENNReal.ofReal (‖c‖ ^ 2) * ENNReal.ofReal (⟪x, μS S x⟫_ℂ).re + rw [ENNReal.ofReal_mul (sq_nonneg ‖c‖)] + +lemma diagonalMeasure_parallelogram (x y : H) : + μS.diagonalMeasure (x + y) + μS.diagonalMeasure (x - y) = + (μS.diagonalMeasure x + μS.diagonalMeasure x) + + (μS.diagonalMeasure y + μS.diagonalMeasure y) := by + apply Measure.ext + intro S hS + rw [Measure.add_apply, Measure.add_apply, Measure.add_apply, Measure.add_apply, + μS.diagonalMeasure_apply (x + y) S hS, μS.diagonalMeasure_apply (x - y) S hS, + μS.diagonalMeasure_apply x S hS, μS.diagonalMeasure_apply y S hS] + have h₁ : 0 ≤ (⟪x + y, μS S (x + y)⟫_ℂ).re := μS.re_inner_nonneg S (x + y) + have h₂ : 0 ≤ (⟪x - y, μS S (x - y)⟫_ℂ).re := μS.re_inner_nonneg S (x - y) + have h₃ : 0 ≤ (⟪x, μS S x⟫_ℂ).re := μS.re_inner_nonneg S x + have h₄ : 0 ≤ (⟪y, μS S y⟫_ℂ).re := μS.re_inner_nonneg S y + rw [← ENNReal.ofReal_add h₁ h₂] + have hreal : + (⟪x + y, μS S (x + y)⟫_ℂ).re + + (⟪x - y, μS S (x - y)⟫_ℂ).re = + 2 * (⟪x, μS S x⟫_ℂ).re + 2 * (⟪y, μS S y⟫_ℂ).re := by + simp only [map_add, map_sub, inner_add_left, inner_add_right, inner_sub_left, + inner_sub_right, Complex.add_re, Complex.sub_re] + ring + rw [hreal] + calc + ENNReal.ofReal (2 * (⟪x, μS S x⟫_ℂ).re + 2 * (⟪y, μS S y⟫_ℂ).re) = + ENNReal.ofReal (2 * (⟪x, μS S x⟫_ℂ).re) + + ENNReal.ofReal (2 * (⟪y, μS S y⟫_ℂ).re) := + ENNReal.ofReal_add + (mul_nonneg (by norm_num : (0 : ℝ) ≤ 2) h₃) + (mul_nonneg (by norm_num : (0 : ℝ) ≤ 2) h₄) + _ = ENNReal.ofReal (⟪x, μS S x⟫_ℂ).re + + ENNReal.ofReal (⟪x, μS S x⟫_ℂ).re + + (ENNReal.ofReal (⟪y, μS S y⟫_ℂ).re + + ENNReal.ofReal (⟪y, μS S y⟫_ℂ).re) := by + rw [show 2 * (⟪x, μS S x⟫_ℂ).re = + (⟪x, μS S x⟫_ℂ).re + (⟪x, μS S x⟫_ℂ).re by ring] + rw [show 2 * (⟪y, μS S y⟫_ℂ).re = + (⟪y, μS S y⟫_ℂ).re + (⟪y, μS S y⟫_ℂ).re by ring] + rw [ENNReal.ofReal_add h₃ h₃, ENNReal.ofReal_add h₄ h₄] + +end WOTSpectralMeasure + +end QuantumMechanics + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/SelfAdjointSpectralTheorem.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/SelfAdjointSpectralTheorem.lean new file mode 100644 index 0000000000..5c73d99b56 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/SelfAdjointSpectralTheorem.lean @@ -0,0 +1,334 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.RealAnalytic +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.StoneUnitaryGroup +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.WeakIntegral + +/-! + +# The operator-to-spectrum interface + +This is a purely Hilbert-space-level treatment: it deliberately omits the algebra-parametrized +layer (`ConcreteAffiliatedObservable`, `RepresentedAffiliatedObservable`, `AffiliationBridge`, +`FaithfulAffiliationBridge`, and the `SelfAdjointSpectralData`/`EssentialSelfAdjointSpectralData` +endpoint), which is out of scope for this development. + +## Essential self-adjointness and closure + +For a core operator `T`, essential self-adjointness is precisely the assertion that the canonical +graph closure `T.closure` is self-adjoint. Keeping this as a small data structure +(`SelfAdjointClosureData`) gives concrete constructions (the oscillator, multiplication operators, +and later Schrödinger operators) one common entry point without smuggling a spectral measure into +the definition. + +## The domain-aware boundary + +`SelfAdjointSpectralTheorem` deliberately records only the weak identity-integral law +(`IsWeakSpectralResolution`). That law is enough for matrix-element reconstruction on the given +domain, but it does not say which vectors belong to the domain. The latter is the square-moment +condition (`spectralSquareMomentDomain`) and must be stated separately before an equality of +unbounded operators can be claimed; `DomainAwareSelfAdjointSpectralTheorem` records both. + +## Main definitions + +- `SelfAdjointClosureData` : essential self-adjointness of a core, and the uniqueness of its + self-adjoint closure. +- `IsWeakSpectralResolution` : the weak matrix-element reconstruction law `⟪y, T x⟫ = ∫ λ dμS`. +- `SelfAdjointSpectralTheorem` : self-adjointness plus weak reconstruction against a spectral + measure, and its transport `unitaryConj` along a Hilbert-space unitary. +- `DomainAwareSelfAdjointSpectralTheorem` : the same, plus the exact domain identification with + the square-moment domain of the spectral measure; exposes the generated + `expUnitaryGroup : StrongUnitaryOneParameterGroup H`. + +-/ + +@[expose] public section + +noncomputable section + +open scoped Topology InnerProductSpace Function +open MeasureTheory Set + +namespace QuantumMechanics + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-! ## Essential self-adjointness and closure + +The closure is not an extra choice. For a core operator `T`, essential self-adjointness is +precisely the assertion that the canonical graph closure `T.closure` is self-adjoint. Keeping +this as a small data structure gives concrete constructions (the oscillator, multiplication +operators, and later Schrödinger operators) one common entry point without smuggling a spectral +measure into the definition. +-/ + +/-- The analytic input needed before applying the unbounded spectral theorem. -/ +structure SelfAdjointClosureData + (T : H →ₗ.[ℂ] H) where + essentiallySelfAdjoint : LinearPMap.IsEssentiallySelfAdjoint T + +namespace SelfAdjointClosureData + +variable {T : H →ₗ.[ℂ] H} (D : SelfAdjointClosureData T) + +include D + +/-- Essential self-adjointness makes the canonical closure self-adjoint. -/ +lemma closure_isSelfAdjoint : IsSelfAdjoint T.closure := + D.essentiallySelfAdjoint + +/-- In particular, the canonical closure is closed. -/ +lemma closure_isClosed : T.closure.IsClosed := + D.closure_isSelfAdjoint.isClosed + +omit [CompleteSpace H] D in +/-- The core operator is contained in its canonical self-adjoint closure. -/ +@[nolint unusedArguments] +lemma le_closure : T ≤ T.closure := + T.le_closure + +/-- The canonical closure is the unique self-adjoint extension of the core. -/ +lemma unique_selfAdjoint_extension {S : H →ₗ.[ℂ] H} + (hTS : T ≤ S) (hS : IsSelfAdjoint S) : S = T.closure := + LinearPMap.IsEssentiallySelfAdjoint.unique_self_adjoint_extension + D.essentiallySelfAdjoint hTS hS + +omit D in +/-- Build closure data from the von Neumann defect-number criterion. -/ +theorem ofDefectNumberEqZero + (hT : T.IsSymmetric) + (hdense : T.HasDenseDomain) + (hpos : T.defectNumber Complex.I = 0) + (hneg : T.defectNumber (-Complex.I) = 0) : + SelfAdjointClosureData T := + ⟨hT.isEssentiallySelfAdjoint_of_defectNumber_eq_zero hdense hpos hneg⟩ + +omit D in +/-- Package the reusable defect-index certificate as closure data. -/ +theorem ofDefectIndexCertificate {T : H →ₗ.[ℂ] H} + (C : DefectIndexCertificate T) : SelfAdjointClosureData T := + ⟨C.essentiallySelfAdjoint⟩ + +end SelfAdjointClosureData + +/-- The data a concrete unbounded spectral theorem must provide for a self-adjoint `LinearPMap`. +This is an interface, not an axiom hidden in an example: the operator, essential +self-adjointness, and its weak-operator spectral measure are explicit fields. Construction +theorems (multiplication, oscillator, Schrödinger operators) can implement this interface +independently and then reuse all affiliated-observable lemmas. -/ +def IsWeakSpectralResolution + (T : H →ₗ.[ℂ] H) + (μS : WOTSpectralMeasure ℝ H) : Prop := + ∀ x : T.domain, + (∀ y : H, (μS.scalarMeasure (x : H) y).Integrable id) ∧ + ∀ y : H, ⟪y, T x⟫_ℂ = μS.weakIntegral id (x : H) y + +/-- The self-adjoint operator is reconstructed from its spectral measure in the weak sense. +The integrability clause is essential: the identity function is generally unbounded, so this +cannot be replaced by the bounded PVM axioms alone. -/ +structure SelfAdjointSpectralTheorem + (T : H →ₗ.[ℂ] H) + (μS : WOTSpectralMeasure ℝ H) where + isSelfAdjoint : IsSelfAdjoint T + reconstruction : IsWeakSpectralResolution T μS + +/-! +### The domain-aware boundary + +`SelfAdjointSpectralTheorem` deliberately records only the weak identity-integral law. That law +is enough for matrix-element reconstruction on the given domain, but it does not say which +vectors belong to the domain. The latter is the square-moment condition and must be stated +separately before we can claim an equality of unbounded operators. +-/ + +/-- The square-moment domain associated to a real weak spectral measure. + +For a projection-valued measure this is the usual condition +`∫ λ² d⟪x, E(λ)x⟫ < ∞`. It is expressed using the positive diagonal measure, rather than the +variation of a complex off-diagonal scalar measure; this is the measure that controls the actual +graph norm of the unbounded operator. -/ +def spectralSquareMomentDomain + (μS : WOTSpectralMeasure ℝ H) : Set H := + {x | Integrable (fun (r : ℝ) ↦ r ^ 2) (μS.diagonalMeasure x)} + +lemma mem_spectralSquareMomentDomain_iff + (μS : WOTSpectralMeasure ℝ H) (x : H) : + x ∈ spectralSquareMomentDomain μS ↔ + Integrable (fun (r : ℝ) ↦ r ^ 2) (μS.diagonalMeasure x) := + Iff.rfl + +/-- A boundedly supported spectral measure has no domain restriction: every vector has a finite +second spectral moment. This is the domain half of the bounded/unbounded interface and is useful +even before a spectral measure has been identified with an operator. -/ +def HasBoundedSpectralSupport + (μS : WOTSpectralMeasure ℝ H) (C : ℝ) : Prop := + 0 ≤ C ∧ ∀ S : Set ℝ, MeasurableSet S → Disjoint S (Set.Icc (-C) C) → μS S = 0 + +lemma spectralSquareMomentDomain_eq_univ_of_boundedSupport + (μS : WOTSpectralMeasure ℝ H) {C : ℝ} + (hC : HasBoundedSpectralSupport μS C) : + spectralSquareMomentDomain μS = Set.univ := by + ext x + constructor + · intro _ + trivial + · intro _ + rw [mem_spectralSquareMomentDomain_iff] + have hK : MeasurableSet (Set.Icc (-C) C) := measurableSet_Icc + have hKc : MeasurableSet (Set.Icc (-C) C)ᶜ := hK.compl + have hμKc : μS (Set.Icc (-C) C)ᶜ = 0 := + hC.2 _ hKc disjoint_compl_left + have hdiagKc : μS.diagonalMeasure x (Set.Icc (-C) C)ᶜ = 0 := by + rw [μS.diagonalMeasure_apply x _ hKc, hμKc] + simp + have hK_ae : ∀ᵐ r ∂μS.diagonalMeasure x, r ∈ Set.Icc (-C) C := by + rw [ae_iff] + have hset : {r : ℝ | r ∉ Set.Icc (-C) C} = (Set.Icc (-C) C)ᶜ := by + rfl + rw [hset] + exact hdiagKc + apply Integrable.of_bound (by fun_prop) (C ^ 2) + filter_upwards [hK_ae] with r hr + change |r ^ 2| ≤ C ^ 2 + rw [abs_of_nonneg (sq_nonneg r)] + exact sq_le_sq' hr.1 hr.2 + +/-- A domain-aware concrete spectral theorem. + +This is the interface required by measurable functional calculus: in addition to +self-adjointness and weak reconstruction, it identifies the operator domain with the +square-moment domain of the PVM. The Cayley spectral-data theorem and the maximal-integral +uniqueness theorem construct this package for every self-adjoint `LinearPMap`; model-specific +work remains only for proving self-adjointness of a smaller core and identifying its closure. -/ +structure DomainAwareSelfAdjointSpectralTheorem + (T : H →ₗ.[ℂ] H) + (μS : WOTSpectralMeasure ℝ H) + extends SelfAdjointSpectralTheorem T μS where + domain_eq_squareMoment : T.domain = spectralSquareMomentDomain μS + +namespace DomainAwareSelfAdjointSpectralTheorem + +variable {T : H →ₗ.[ℂ] H} +variable {μS : WOTSpectralMeasure ℝ H} + +/-- A bounded self-adjoint realization automatically has the maximal square-moment domain when +its spectral measure is boundedly supported. -/ +theorem ofBoundedSupport (D : SelfAdjointSpectralTheorem T μS) + (hdom : (T.domain : Set H) = Set.univ) {C : ℝ} + (hC : HasBoundedSpectralSupport μS C) : + DomainAwareSelfAdjointSpectralTheorem T μS where + toSelfAdjointSpectralTheorem := D + domain_eq_squareMoment := + hdom.trans (spectralSquareMomentDomain_eq_univ_of_boundedSupport μS hC).symm + +/-- The self-adjointness part of a domain-aware spectral theorem. -/ +lemma isSelfAdjoint_of (D : DomainAwareSelfAdjointSpectralTheorem T μS) : + IsSelfAdjoint T := + D.toSelfAdjointSpectralTheorem.isSelfAdjoint + +/-- The weak reconstruction part of a domain-aware spectral theorem. -/ +lemma reconstruction_of (D : DomainAwareSelfAdjointSpectralTheorem T μS) : + IsWeakSpectralResolution T μS := + D.toSelfAdjointSpectralTheorem.reconstruction + +/-- The domain is exactly the vectors with finite second spectral moment. -/ +lemma mem_domain_iff (D : DomainAwareSelfAdjointSpectralTheorem T μS) (x : H) : + x ∈ T.domain ↔ x ∈ spectralSquareMomentDomain μS := by + change x ∈ (T.domain : Set H) ↔ x ∈ spectralSquareMomentDomain μS + rw [D.domain_eq_squareMoment] + +/-- The strongly continuous unitary group attached to a domain-aware spectral theorem. Its strong +Stone generator and exact generator domain are the remaining content of Stone's theorem's converse +direction. -/ +@[nolint unusedArguments] +noncomputable def expUnitaryGroup + (_D : DomainAwareSelfAdjointSpectralTheorem T μS) : + WOTSpectralMeasure.StrongUnitaryOneParameterGroup H := + QuantumMechanics.WOTSpectralMeasure.expUnitaryGroup μS + +lemma expUnitaryGroup_zero (D : DomainAwareSelfAdjointSpectralTheorem T μS) : + D.expUnitaryGroup 0 = 1 := by + exact WOTSpectralMeasure.StrongUnitaryOneParameterGroup.zero _ + +lemma expUnitaryGroup_add (D : DomainAwareSelfAdjointSpectralTheorem T μS) (t s : ℝ) : + D.expUnitaryGroup (t + s) = D.expUnitaryGroup t * D.expUnitaryGroup s := by + exact WOTSpectralMeasure.StrongUnitaryOneParameterGroup.add _ t s + +lemma expUnitaryGroup_continuous_apply + (D : DomainAwareSelfAdjointSpectralTheorem T μS) (x : H) : + Continuous (fun t => D.expUnitaryGroup t x) := by + exact WOTSpectralMeasure.StrongUnitaryOneParameterGroup.continuous_apply _ x + +end DomainAwareSelfAdjointSpectralTheorem + +namespace SelfAdjointSpectralTheorem + +variable {T : H →ₗ.[ℂ] H} {μS : WOTSpectralMeasure ℝ H} + +/-- Transport an unbounded spectral theorem through a Hilbert-space unitary. This is the +representation-level engine: once the theorem is proved for a multiplication model, this +constructor gives it for every unitarily equivalent self-adjoint operator. -/ +theorem unitaryConj {H' : Type*} [NormedAddCommGroup H'] [InnerProductSpace ℂ H'] + [CompleteSpace H'] (D : SelfAdjointSpectralTheorem T μS) (u : H ≃ₗᵢ[ℂ] H') : + SelfAdjointSpectralTheorem (LinearPMap.unitaryConj u T) + (WOTSpectralMeasure.unitaryConjSpectralMeasure u μS) where + isSelfAdjoint := LinearPMap.unitaryConj_isSelfAdjoint u D.isSelfAdjoint + reconstruction := by + intro x + let x' : T.domain := + ⟨u.symm (x : H'), (LinearPMap.mem_unitaryConj_domain_iff u T).mp x.2⟩ + refine ⟨?_, ?_⟩ + · intro y + rw [WOTSpectralMeasure.unitaryConjSpectralMeasure_scalarMeasure] + exact (D.reconstruction x').1 (u.symm y) + · intro y + have h := (D.reconstruction x').2 (u.symm y) + calc + ⟪y, LinearPMap.unitaryConj u T x⟫_ℂ = ⟪u.symm y, T x'⟫_ℂ := by + rw [LinearPMap.unitaryConj_apply] + exact (u.symm.inner_map_eq_flip _ _).symm + _ = μS.weakIntegral id (x' : H) (u.symm y) := h + _ = (WOTSpectralMeasure.unitaryConjSpectralMeasure u μS).weakIntegral + id (x : H') y := by + symm + exact WOTSpectralMeasure.unitaryConjSpectralMeasure_weakIntegral + u μS id x y + +end SelfAdjointSpectralTheorem + +namespace DomainAwareSelfAdjointSpectralTheorem + +variable {T : H →ₗ.[ℂ] H} +variable {μS : WOTSpectralMeasure ℝ H} + +/-- Transport the domain-aware theorem through a Hilbert-space unitary. The only additional input +beyond the weak transport is the diagonal-measure equivariance lemma, which makes the +square-moment domain equivariant as well. -/ +theorem unitaryConj {H' : Type*} [NormedAddCommGroup H'] [InnerProductSpace ℂ H'] + [CompleteSpace H'] (D : DomainAwareSelfAdjointSpectralTheorem T μS) + (u : H ≃ₗᵢ[ℂ] H') : + DomainAwareSelfAdjointSpectralTheorem (LinearPMap.unitaryConj u T) + (WOTSpectralMeasure.unitaryConjSpectralMeasure u μS) where + toSelfAdjointSpectralTheorem := D.toSelfAdjointSpectralTheorem.unitaryConj u + domain_eq_squareMoment := by + ext x + change x ∈ (LinearPMap.unitaryConj u T).domain ↔ + x ∈ spectralSquareMomentDomain + (WOTSpectralMeasure.unitaryConjSpectralMeasure u μS) + rw [LinearPMap.mem_unitaryConj_domain_iff] + change u.symm x ∈ T.domain ↔ + Integrable (fun r : ℝ ↦ r ^ 2) + ((WOTSpectralMeasure.unitaryConjSpectralMeasure u μS).diagonalMeasure x) + rw [WOTSpectralMeasure.unitaryConjSpectralMeasure_diagonalMeasure] + exact D.mem_domain_iff (u.symm x) + +end DomainAwareSelfAdjointSpectralTheorem + +end QuantumMechanics + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/SpectralIntegral/Construction.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/SpectralIntegral/Construction.lean new file mode 100644 index 0000000000..c273366b88 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/SpectralIntegral/Construction.lean @@ -0,0 +1,1192 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.SelfAdjointSpectralTheorem +public import Mathlib.MeasureTheory.Integral.Lebesgue.DominatedConvergence +public import Mathlib.MeasureTheory.VectorMeasure.Variation.SignedMeasure +public import Mathlib.MeasureTheory.VectorMeasure.SetIntegral + +/-! +# Canonical unbounded spectral integrals: construction + +Builds the maximal spectral integral of a real-valued measurable function against a +`WOTSpectralMeasure`, as the limit of its truncations, and shows the resulting operator is +densely defined, closable, symmetric, and essentially self-adjoint. Continued in +`SpectralIntegral/SpecTheorem.lean`, which proves this operator is in fact self-adjoint and +assembles the domain-aware self-adjoint spectral theorem. +-/ + +@[expose] public section + +noncomputable section + +open scoped Topology InnerProductSpace Function +open ContinuousLinearMap ContinuousLinearMapWOT MeasureTheory Set +open QuantumMechanics.WOTSpectralMeasure + +namespace QuantumMechanics.WOTSpectralMeasure + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] +/-- The bounded real spectral variable truncated to `[-n,n]`. -/ +def truncationFunction (n : ℕ) : ℝ → ℂ := + (Set.Icc (-(n : ℝ)) (n : ℝ)).indicator (fun r : ℝ => (r : ℂ)) + +/-- The real-truncation indicator function, real-valued, at cutoff `n`. -/ +def realTruncationFunction (n : ℕ) : ℝ → ℝ := + (Set.Icc (-(n : ℝ)) (n : ℝ)).indicator id + +/-- The spectral cutoff set `[-n, n]`. -/ +def spectralCutoffSet (n : ℕ) : Set ℝ := Set.Icc (-(n : ℝ)) (n : ℝ) + +lemma spectralCutoffSet_mono : Monotone spectralCutoffSet := by + intro n m hnm r hr + have hnmR : (n : ℝ) ≤ (m : ℝ) := by exact_mod_cast hnm + exact ⟨le_trans (neg_le_neg hnmR) hr.1, le_trans hr.2 hnmR⟩ + +lemma spectralCutoffSet_iUnion : ⋃ n, spectralCutoffSet n = Set.univ := by + ext r + simp only [mem_iUnion, mem_Icc, mem_univ, iff_true] + obtain ⟨n, hn⟩ := exists_nat_ge |r| + exact ⟨n, neg_le_of_abs_le hn, le_trans (le_abs_self r) hn⟩ + +lemma truncationFunction_measurable (n : ℕ) : Measurable (truncationFunction n) := by + exact Complex.measurable_ofReal.indicator measurableSet_Icc + +lemma truncationFunction_bounded (n : ℕ) : + ∃ C : ℝ, ∀ r, ‖truncationFunction n r‖ ≤ C := by + refine ⟨n, fun r => ?_⟩ + by_cases hr : r ∈ Set.Icc (-(n : ℝ)) (n : ℝ) + · rw [truncationFunction, Set.indicator_of_mem hr] + rw [Complex.norm_real, Real.norm_eq_abs] + exact abs_le.mpr hr + · simp [truncationFunction, hr] + +lemma realTruncationFunction_measurable (n : ℕ) : + Measurable (realTruncationFunction n) := by + exact measurable_id.indicator measurableSet_Icc + +lemma realTruncationFunction_bounded (n : ℕ) : + ∃ C : ℝ, ∀ r, |realTruncationFunction n r| ≤ C := by + refine ⟨n, fun r => ?_⟩ + by_cases hr : r ∈ Set.Icc (-(n : ℝ)) (n : ℝ) + · rw [realTruncationFunction, Set.indicator_of_mem hr] + exact abs_le.mpr hr + · simp [realTruncationFunction, hr] + +lemma realTruncationFunction_complex_eq (n : ℕ) : + (fun r => (realTruncationFunction n r : ℂ)) = truncationFunction n := by + funext r + by_cases hr : r ∈ Set.Icc (-(n : ℝ)) (n : ℝ) <;> + simp [realTruncationFunction, truncationFunction, hr] + +lemma truncationFunction_eventually_eq (r : ℝ) : + ∀ᶠ n : ℕ in Filter.atTop, truncationFunction n r = (r : ℂ) := by + obtain ⟨N, hN⟩ := exists_nat_ge |r| + filter_upwards [Filter.eventually_ge_atTop N] with n hn + have hnr : |r| ≤ (n : ℝ) := le_trans hN (by exact_mod_cast hn) + rw [truncationFunction, Set.indicator_of_mem] + exact abs_le.mp hnr + +lemma truncationFunction_tendsto (r : ℝ) : + Filter.Tendsto (fun n : ℕ => truncationFunction n r) Filter.atTop (𝓝 (r : ℂ)) := by + exact tendsto_nhds_of_eventually_eq (truncationFunction_eventually_eq r) + +lemma truncationIntegral_inner_tendsto_complexWeakIntegral + (μS : WOTSpectralMeasure ℝ H) (x y : H) + (hfi : (μS.scalarMeasure x y).Integrable id) : + Filter.Tendsto + (fun n : ℕ => ∫ᵛ r, truncationFunction n r ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); μS.scalarMeasure x y]) + Filter.atTop (𝓝 (μS.complexWeakIntegral (fun r : ℝ => (r : ℂ)) x y)) := by + let ν := μS.scalarMeasure x y + have hbound : Integrable (fun r : ℝ => |r|) ν.variation := by + simpa [ν, Real.norm_eq_abs] using hfi.norm + have hdom : Filter.Tendsto + (fun n : ℕ => ∫ᵛ r, truncationFunction n r ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν]) + Filter.atTop (𝓝 (∫ᵛ r, (r : ℂ) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν])) := by + apply MeasureTheory.VectorMeasure.tendsto_integral_of_dominated_convergence + (μ := ν) (B := ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ)) + (fun r : ℝ => |r|) + · intro n + exact (truncationFunction_measurable n).aestronglyMeasurable + · exact hbound + · intro n + filter_upwards [] with r + by_cases hr : r ∈ Set.Icc (-(n : ℝ)) (n : ℝ) + · simp [truncationFunction, Set.indicator_of_mem hr, Complex.norm_real, + Real.norm_eq_abs] + · simp [truncationFunction, Set.indicator, hr] + · filter_upwards [] with r + exact truncationFunction_tendsto r + convert hdom using 1 + simpa [WOTSpectralMeasure.complexWeakIntegral, ν] using hdom + +@[nolint synTaut] +lemma integral_indicator_real_eq_complex + {α : Type*} [MeasurableSpace α] (μ : MeasureTheory.VectorMeasure α ℂ) + (c : ℝ) (s : Set α) : + (∫ᵛ x, s.indicator (fun _ => (c : ℂ)) x + ∂[ContinuousLinearMap.lsmul ℝ ℂ; μ]) = + ∫ᵛ x, (s.indicator (fun _ => c) x : ℂ) + ∂[ContinuousLinearMap.lsmul ℝ ℂ; μ] := by + have hfun : (fun x => s.indicator (fun _ => (c : ℂ)) x) = + (fun x => (s.indicator (fun _ => c) x : ℂ)) := by + simpa [Function.comp_def] using + (Set.indicator_comp_of_zero (s := s) (f := fun _ : α => c) + (g := Complex.ofRealCLM) Complex.ofRealCLM.map_zero) + exact congrArg (fun f : α → ℂ => + ∫ᵛ x, f x ∂[ContinuousLinearMap.lsmul ℝ ℂ; μ]) hfun + +lemma integral_real_eq_complex + {α : Type*} [MeasurableSpace α] (μ : MeasureTheory.VectorMeasure α ℂ) + {g : α → ℝ} (hg : μ.Integrable g) : + ∫ᵛ x, g x ∂[ContinuousLinearMap.lsmul ℝ ℝ (E := ℂ); μ] = + ∫ᵛ x, (g x : ℂ) ∂[ContinuousLinearMap.lsmul ℝ ℂ; μ] := by + apply hg.induction (P := fun f => + ∫ᵛ x, f x ∂[ContinuousLinearMap.lsmul ℝ ℝ (E := ℂ); μ] = + ∫ᵛ x, Complex.ofRealCLM (f x) + ∂[ContinuousLinearMap.lsmul ℝ ℂ; μ]) + · intro c s hs hfinite + change μ.variation s < ⊤ at hfinite + have hfinite' : IsFiniteMeasure (μ.variation.restrict s) := by + exact MeasureTheory.isFiniteMeasure_restrict.mpr hfinite.ne + letI := hfinite' + calc + ∫ᵛ x, s.indicator (fun _ => c) x + ∂[ContinuousLinearMap.lsmul ℝ ℝ (E := ℂ); μ] = + (ContinuousLinearMap.lsmul ℝ ℝ (E := ℂ)) c (μ s) := + VectorMeasure.integral_indicator_const c hs + _ = (ContinuousLinearMap.lsmul ℝ ℂ) (c : ℂ) (μ s) := by + simp [ContinuousLinearMap.lsmul_apply] + _ = ∫ᵛ x, s.indicator (fun _ => (c : ℂ)) x + ∂[ContinuousLinearMap.lsmul ℝ ℂ; μ] := + (VectorMeasure.integral_indicator_const (c : ℂ) hs).symm + _ = ∫ᵛ x, Complex.ofRealCLM (s.indicator (fun _ => c) x) + ∂[ContinuousLinearMap.lsmul ℝ ℂ; μ] := by + simpa [Function.comp_def] using congrArg (fun f : α → ℂ => + ∫ᵛ x, f x ∂[ContinuousLinearMap.lsmul ℝ ℂ; μ]) + (Set.indicator_comp_of_zero (s := s) (f := fun _ : α => c) + (g := Complex.ofRealCLM) Complex.ofRealCLM.map_zero) + · intro f k _ hf hk hfP hkP + change (∫ᵛ x, f x + k x ∂[ContinuousLinearMap.lsmul ℝ ℝ (E := ℂ); μ]) = _ + rw [VectorMeasure.integral_fun_add (μ := μ) + (B := ContinuousLinearMap.lsmul ℝ ℝ (E := ℂ)) hf hk] + have hfunadd : (fun x => Complex.ofRealCLM ((f + k) x)) = + (fun x => Complex.ofRealCLM (f x) + Complex.ofRealCLM (k x)) := by + funext x + simp [Pi.add_apply, map_add] + rw [hfunadd] + have hfC : μ.Integrable (fun x => Complex.ofRealCLM (f x)) := by + exact hf.norm.mono' + (Complex.ofRealCLM.continuous.comp_aestronglyMeasurable hf.aestronglyMeasurable) + (by + filter_upwards with x + simp [Complex.norm_real, Real.norm_eq_abs]) + have hkC : μ.Integrable (fun x => Complex.ofRealCLM (k x)) := by + exact hk.norm.mono' + (Complex.ofRealCLM.continuous.comp_aestronglyMeasurable hk.aestronglyMeasurable) + (by + filter_upwards with x + simp [Complex.norm_real, Real.norm_eq_abs]) + rw [VectorMeasure.integral_fun_add (μ := μ) + (B := ContinuousLinearMap.lsmul ℝ ℂ) hfC hkC] + rw [hfP, hkP] + · apply isClosed_eq + · exact MeasureTheory.VectorMeasure.continuous_integral + · have hcont := (MeasureTheory.VectorMeasure.continuous_integral + (μ := μ) (B := ContinuousLinearMap.lsmul ℝ ℂ)).comp + (Complex.ofRealCLM.compLpL 1 μ.variation).continuous + convert hcont using 1 + funext f + apply VectorMeasure.integral_congr_ae + exact (Complex.ofRealCLM.coeFn_compLpL f).symm + · intro f k hfk hf hfP + calc + ∫ᵛ x, k x ∂[ContinuousLinearMap.lsmul ℝ ℝ (E := ℂ); μ] = + ∫ᵛ x, f x ∂[ContinuousLinearMap.lsmul ℝ ℝ (E := ℂ); μ] := + VectorMeasure.integral_congr_ae (μ := μ) + (B := ContinuousLinearMap.lsmul ℝ ℝ (E := ℂ)) hfk.symm + _ = ∫ᵛ x, (f x : ℂ) ∂[ContinuousLinearMap.lsmul ℝ ℂ; μ] := hfP + _ = ∫ᵛ x, (k x : ℂ) ∂[ContinuousLinearMap.lsmul ℝ ℂ; μ] := by + apply VectorMeasure.integral_congr_ae (μ := μ) + (B := ContinuousLinearMap.lsmul ℝ ℂ) + filter_upwards [hfk] with x hx + exact congrArg Complex.ofReal hx + +/-- The bounded operator obtained by integrating the `n`-th truncated spectral variable. -/ +noncomputable def truncationIntegral (μS : WOTSpectralMeasure ℝ H) (n : ℕ) : H →WOT[ℂ] H := + boundedIntegral μS (truncationFunction n) (truncationFunction_measurable n) + (truncationFunction_bounded n) + +lemma truncationIntegral_sub_apply (μS : WOTSpectralMeasure ℝ H) (n m : ℕ) (x : H) : + truncationIntegral μS n x - truncationIntegral μS m x = + boundedIntegral μS (fun r => truncationFunction n r - truncationFunction m r) + ((truncationFunction_measurable n).sub (truncationFunction_measurable m)) + (by + rcases truncationFunction_bounded n with ⟨Cn, hCn⟩ + rcases truncationFunction_bounded m with ⟨Cm, hCm⟩ + refine ⟨Cn + Cm, fun r => ?_⟩ + exact (norm_sub_le _ _).trans (add_le_add (hCn r) (hCm r))) x := by + change truncationIntegral μS n x - truncationIntegral μS m x = + boundedIntegral μS (truncationFunction n - truncationFunction m) _ _ x + exact (congrArg (fun A : H →WOT[ℂ] H => A x) + (boundedIntegral_sub μS (truncationFunction_measurable n) + (truncationFunction_measurable m) (truncationFunction_bounded n) + (truncationFunction_bounded m))).symm + +lemma diagonalMeasure_add_le (μS : WOTSpectralMeasure ℝ H) (x y : H) : + μS.diagonalMeasure (x + y) ≤ + (μS.diagonalMeasure x + μS.diagonalMeasure x) + + (μS.diagonalMeasure y + μS.diagonalMeasure y) := by + refine (Measure.le_iff').2 (fun S => ?_) + have h := congrArg (fun ν : Measure ℝ => ν S) + (μS.diagonalMeasure_parallelogram x y) + rw [Measure.add_apply, Measure.add_apply, Measure.add_apply, Measure.add_apply] at h + calc + μS.diagonalMeasure (x + y) S ≤ + μS.diagonalMeasure (x + y) S + μS.diagonalMeasure (x - y) S := + le_add_of_nonneg_right (by positivity) + _ = ((μS.diagonalMeasure x + μS.diagonalMeasure x) + + (μS.diagonalMeasure y + μS.diagonalMeasure y)) S := h + +lemma spectralSquareMomentDomain_zero (μS : WOTSpectralMeasure ℝ H) : + (0 : H) ∈ spectralSquareMomentDomain μS := by + rw [mem_spectralSquareMomentDomain_iff] + have hzero : (0 : H) = (0 : ℂ) • (0 : H) := by simp + rw [hzero, μS.diagonalMeasure_smul] + simpa [norm_zero, pow_two] using (integrable_zero_measure : + Integrable (fun r : ℝ => r ^ 2) (0 : Measure ℝ)) + +lemma spectralSquareMomentDomain_add (μS : WOTSpectralMeasure ℝ H) {x y : H} + (hx : x ∈ spectralSquareMomentDomain μS) + (hy : y ∈ spectralSquareMomentDomain μS) : + x + y ∈ spectralSquareMomentDomain μS := by + rw [mem_spectralSquareMomentDomain_iff] at hx hy ⊢ + apply Integrable.mono_measure + ((hx.add_measure hx).add_measure (hy.add_measure hy)) + exact diagonalMeasure_add_le μS x y + +lemma spectralSquareMomentDomain_smul (μS : WOTSpectralMeasure ℝ H) (c : ℂ) {x : H} + (hx : x ∈ spectralSquareMomentDomain μS) : + c • x ∈ spectralSquareMomentDomain μS := by + rw [mem_spectralSquareMomentDomain_iff, μS.diagonalMeasure_smul] + apply Integrable.mono_measure (hx.smul_measure ENNReal.ofReal_ne_top) + exact le_rfl + +/-- The square-moment domain is a complex submodule, so the maximal spectral integral can be +defined as a `LinearPMap` rather than merely as a pointwise partial function. -/ +def spectralSquareMomentSubmodule (μS : WOTSpectralMeasure ℝ H) : Submodule ℂ H where + carrier := spectralSquareMomentDomain μS + zero_mem' := spectralSquareMomentDomain_zero μS + add_mem' := spectralSquareMomentDomain_add μS + smul_mem' := spectralSquareMomentDomain_smul μS + +lemma truncationIntegral_sub_norm_sq (μS : WOTSpectralMeasure ℝ H) (n m : ℕ) (x : H) : + ENNReal.ofReal (‖truncationIntegral μS n x - truncationIntegral μS m x‖ ^ 2) = + ∫⁻ r, ENNReal.ofReal + (‖truncationFunction n r - truncationFunction m r‖ ^ 2) + ∂μS.diagonalMeasure x := by + rw [truncationIntegral_sub_apply] + exact boundedIntegral_norm_sq μS + ((truncationFunction_measurable n).sub (truncationFunction_measurable m)) + (by + rcases truncationFunction_bounded n with ⟨Cn, hCn⟩ + rcases truncationFunction_bounded m with ⟨Cm, hCm⟩ + exact ⟨Cn + Cm, fun r => + (norm_sub_le _ _).trans (add_le_add (hCn r) (hCm r))⟩) x + +lemma truncationIntegral_sub_norm_sq_le (μS : WOTSpectralMeasure ℝ H) (n m : ℕ) (x : H) : + ENNReal.ofReal (‖truncationIntegral μS n x - truncationIntegral μS m x‖ ^ 2) ≤ + 2 * (∫⁻ r, ENNReal.ofReal + (‖truncationFunction n r - (r : ℂ)‖ ^ 2) ∂μS.diagonalMeasure x) + + 2 * (∫⁻ r, ENNReal.ofReal + (‖truncationFunction m r - (r : ℂ)‖ ^ 2) ∂μS.diagonalMeasure x) := by + let a : ℝ → ℝ := fun r => ‖truncationFunction n r - (r : ℂ)‖ ^ 2 + let b : ℝ → ℝ := fun r => ‖truncationFunction m r - (r : ℂ)‖ ^ 2 + have ha : Measurable a := + (((truncationFunction_measurable n).sub Complex.measurable_ofReal).norm.pow_const 2) + have hb : Measurable b := + (((truncationFunction_measurable m).sub Complex.measurable_ofReal).norm.pow_const 2) + have hpoint : ∀ r, ENNReal.ofReal + (‖truncationFunction n r - truncationFunction m r‖ ^ 2) ≤ + ENNReal.ofReal (2 * a r + 2 * b r) := by + intro r + apply ENNReal.ofReal_le_ofReal + have hnorm : ‖truncationFunction n r - truncationFunction m r‖ ≤ + ‖truncationFunction n r - (r : ℂ)‖ + + ‖truncationFunction m r - (r : ℂ)‖ := by + calc + ‖truncationFunction n r - truncationFunction m r‖ = + ‖(truncationFunction n r - (r : ℂ)) - + (truncationFunction m r - (r : ℂ))‖ := by + congr 1 <;> ring + _ ≤ _ := norm_sub_le _ _ + dsimp [a, b] + have hc : 0 ≤ ‖truncationFunction n r - truncationFunction m r‖ := norm_nonneg _ + have hab : 0 ≤ ‖truncationFunction n r - (r : ℂ)‖ + + ‖truncationFunction m r - (r : ℂ)‖ := by positivity + have hsquare := (sq_le_sq₀ hc hab).2 hnorm + nlinarith [sq_nonneg + (‖truncationFunction n r - (r : ℂ)‖ - + ‖truncationFunction m r - (r : ℂ)‖)] + calc + ENNReal.ofReal (‖truncationIntegral μS n x - truncationIntegral μS m x‖ ^ 2) = + ∫⁻ r, ENNReal.ofReal + (‖truncationFunction n r - truncationFunction m r‖ ^ 2) + ∂μS.diagonalMeasure x := truncationIntegral_sub_norm_sq μS n m x + _ ≤ ∫⁻ r, ENNReal.ofReal (2 * a r + 2 * b r) ∂μS.diagonalMeasure x := + lintegral_mono hpoint + _ = 2 * (∫⁻ r, ENNReal.ofReal (a r) ∂μS.diagonalMeasure x) + + 2 * (∫⁻ r, ENNReal.ofReal (b r) ∂μS.diagonalMeasure x) := by + have hsplit : ∀ r, ENNReal.ofReal (2 * a r + 2 * b r) = + 2 * ENNReal.ofReal (a r) + 2 * ENNReal.ofReal (b r) := by + intro r + rw [ENNReal.ofReal_add (by positivity) (by positivity)] + rw [ENNReal.ofReal_mul (by positivity), ENNReal.ofReal_mul (by positivity)] + norm_num + have hameas : Measurable (fun r => ENNReal.ofReal (a r)) := + ENNReal.continuous_ofReal.measurable.comp ha + have hbmeas : Measurable (fun r => ENNReal.ofReal (b r)) := + ENNReal.continuous_ofReal.measurable.comp hb + simp_rw [hsplit] + rw [lintegral_add_left (by fun_prop), lintegral_const_mul 2 hameas, + lintegral_const_mul 2 hbmeas] + +lemma truncation_error_lintegral_tendsto_zero + (μS : WOTSpectralMeasure ℝ H) (x : H) + (hx : Integrable (fun r : ℝ => r ^ 2) (μS.diagonalMeasure x)) : + Filter.Tendsto + (fun n : ℕ => ∫⁻ r, ENNReal.ofReal + (‖truncationFunction n r - (r : ℂ)‖ ^ 2) ∂μS.diagonalMeasure x) + Filter.atTop (𝓝 0) := by + let μ : Measure ℝ := μS.diagonalMeasure x + let F : ℕ → ℝ → ENNReal := fun n r => + ENNReal.ofReal (‖truncationFunction n r - (r : ℂ)‖ ^ 2) + have hFmeas : ∀ n, Measurable (F n) := by + intro n + change Measurable (fun r : ℝ => ENNReal.ofReal + (‖truncationFunction n r - (r : ℂ)‖ ^ 2)) + exact ENNReal.continuous_ofReal.measurable.comp + (((truncationFunction_measurable n).sub Complex.measurable_ofReal).norm.pow_const 2) + have hbound : ∀ n, ∀ᵐ r ∂μ, F n r ≤ ENNReal.ofReal (4 * r ^ 2) := by + intro n + filter_upwards [] with r + dsimp [F] + apply ENNReal.ofReal_le_ofReal + by_cases hr : r ∈ Set.Icc (-(n : ℝ)) (n : ℝ) + · simp [truncationFunction, Set.indicator_of_mem hr] + positivity + · simp [truncationFunction, Set.indicator, hr] + have hsq : ‖(r : ℂ)‖ ^ 2 ≤ 4 * r ^ 2 := by + rw [Complex.norm_real, Real.norm_eq_abs] + rw [sq_abs] + nlinarith [sq_nonneg r] + simpa [norm_neg] using hsq + have hdom : Integrable (fun r : ℝ => 4 * r ^ 2) μ := by + simpa only [smul_eq_mul] using hx.const_mul 4 + have hfin : (∫⁻ r, ENNReal.ofReal (4 * r ^ 2) ∂μ) ≠ (⊤ : ENNReal) := by + exact (hdom.lintegral_lt_top).ne + let F₀ : ℝ → ENNReal := fun _ => 0 + have hlim : ∀ᵐ r ∂μ, Filter.Tendsto (fun n : ℕ => F n r) Filter.atTop (𝓝 (F₀ r)) := by + filter_upwards [] with r + have htrunc := truncationFunction_tendsto r + have hdiff : Filter.Tendsto + (fun n : ℕ => truncationFunction n r - (r : ℂ)) Filter.atTop (𝓝 0) := by + simpa using htrunc.sub (tendsto_const_nhds : + Filter.Tendsto (fun _ : ℕ => (r : ℂ)) Filter.atTop (𝓝 (r : ℂ))) + have hnorm : Filter.Tendsto + (fun n : ℕ => ‖truncationFunction n r - (r : ℂ)‖ ^ 2) + Filter.atTop (𝓝 (0 ^ 2)) := by + simpa [Function.comp_def] using + (continuous_norm.pow 2).continuousAt.tendsto.comp hdiff + change Filter.Tendsto (fun n : ℕ => ENNReal.ofReal + (‖truncationFunction n r - (r : ℂ)‖ ^ 2)) Filter.atTop (𝓝 (F₀ r)) + have hout := ENNReal.continuous_ofReal.continuousAt.tendsto.comp hnorm + simpa [F, F₀, Function.comp_def] using hout + have hmain : Filter.Tendsto (fun n : ℕ => ∫⁻ r, F n r ∂μ) Filter.atTop + (𝓝 (∫⁻ r, F₀ r ∂μ)) := by + apply MeasureTheory.tendsto_lintegral_filter_of_dominated_convergence + (fun r => ENNReal.ofReal (4 * r ^ 2)) + · filter_upwards [] with n + exact hFmeas n + · filter_upwards [] with n + exact hbound n + · exact hfin + · exact hlim + simpa [F, F₀, μ] using hmain + +lemma truncationIntegral_cauchy (μS : WOTSpectralMeasure ℝ H) {x : H} + (hx : x ∈ spectralSquareMomentDomain μS) : + CauchySeq (fun n : ℕ => truncationIntegral μS n x) := by + rw [Metric.cauchySeq_iff] + intro ε hε + let A : ℕ → ENNReal := fun n => ∫⁻ r, ENNReal.ofReal + (‖truncationFunction n r - (r : ℂ)‖ ^ 2) ∂μS.diagonalMeasure x + have hA : Filter.Tendsto A Filter.atTop (𝓝 0) := by + simpa [A] using truncation_error_lintegral_tendsto_zero μS x hx + have hq : 0 < ε ^ 2 / 8 := by positivity + have hsmall : ∀ᶠ n : ℕ in Filter.atTop, A n < ENNReal.ofReal (ε ^ 2 / 8) := by + apply hA.eventually + exact Iio_mem_nhds ((ENNReal.ofReal_pos).2 hq) + rcases (Filter.eventually_atTop.1 hsmall) with ⟨N, hN⟩ + refine ⟨N, ?_⟩ + intro n hn m hm + have hnA := hN n hn + have hmA := hN m hm + have hsum : 2 * A n + 2 * A m < ENNReal.ofReal (ε ^ 2) := by + calc + 2 * A n + 2 * A m < + 2 * ENNReal.ofReal (ε ^ 2 / 8) + + 2 * ENNReal.ofReal (ε ^ 2 / 8) := by + gcongr <;> norm_num + _ = ENNReal.ofReal (ε ^ 2 / 2) := by + have htwo (q : ℝ) : (2 : ENNReal) * ENNReal.ofReal q = + ENNReal.ofReal (2 * q) := by + calc + (2 : ENNReal) * ENNReal.ofReal q = + ENNReal.ofReal 2 * ENNReal.ofReal q := by norm_num + _ = ENNReal.ofReal (2 * q) := + (ENNReal.ofReal_mul (by positivity : (0 : ℝ) ≤ 2)).symm + calc + 2 * ENNReal.ofReal (ε ^ 2 / 8) + + 2 * ENNReal.ofReal (ε ^ 2 / 8) = + ENNReal.ofReal (2 * (ε ^ 2 / 8)) + + ENNReal.ofReal (2 * (ε ^ 2 / 8)) := by + congr 1 + · exact htwo _ + · exact htwo _ + _ = ENNReal.ofReal (2 * (ε ^ 2 / 8) + 2 * (ε ^ 2 / 8)) := + (ENNReal.ofReal_add (by positivity) (by positivity)).symm + _ = ENNReal.ofReal (ε ^ 2 / 2) := by congr 1 <;> ring + _ < ENNReal.ofReal (ε ^ 2) := by + exact (ENNReal.ofReal_lt_ofReal_iff (by positivity)).2 (by nlinarith) + have hnormsq : ENNReal.ofReal + (‖truncationIntegral μS n x - truncationIntegral μS m x‖ ^ 2) < + ENNReal.ofReal (ε ^ 2) := + (truncationIntegral_sub_norm_sq_le μS n m x).trans_lt hsum + have hnormsq' : ‖truncationIntegral μS n x - truncationIntegral μS m x‖ ^ 2 < ε ^ 2 := + (ENNReal.ofReal_lt_ofReal_iff (by positivity)).mp hnormsq + have hnorm : ‖truncationIntegral μS n x - truncationIntegral μS m x‖ < ε := + (sq_lt_sq₀ (norm_nonneg _) (le_of_lt hε)).mp hnormsq' + simpa [dist_eq_norm] using hnorm + +lemma truncation_norm_lintegral_tendsto + (μS : WOTSpectralMeasure ℝ H) (x : H) + (hx : Integrable (fun r : ℝ => r ^ 2) (μS.diagonalMeasure x)) : + Filter.Tendsto + (fun n : ℕ => ∫⁻ r, ENNReal.ofReal + (‖truncationFunction n r‖ ^ 2) ∂μS.diagonalMeasure x) + Filter.atTop + (𝓝 (∫⁻ r, ENNReal.ofReal (r ^ 2) ∂μS.diagonalMeasure x)) := by + let μ : Measure ℝ := μS.diagonalMeasure x + let F : ℕ → ℝ → ENNReal := fun n r => + ENNReal.ofReal (‖truncationFunction n r‖ ^ 2) + let F₀ : ℝ → ENNReal := fun r => ENNReal.ofReal (r ^ 2) + have hFmeas : ∀ n, Measurable (F n) := by + intro n + exact ENNReal.continuous_ofReal.measurable.comp + ((truncationFunction_measurable n).norm.pow_const 2) + have hbound : ∀ n, ∀ᵐ r ∂μ, F n r ≤ F₀ r := by + intro n + filter_upwards [] with r + dsimp [F, F₀] + apply ENNReal.ofReal_le_ofReal + by_cases hr : r ∈ Set.Icc (-(n : ℝ)) (n : ℝ) + · simp [truncationFunction, Set.indicator_of_mem hr, Complex.norm_real, + Real.norm_eq_abs] + · simp [truncationFunction, Set.indicator, hr] + positivity + have hfin : (∫⁻ r, F₀ r ∂μ) ≠ (⊤ : ENNReal) := by + exact (hx.lintegral_lt_top).ne + have hlim : ∀ᵐ r ∂μ, Filter.Tendsto (fun n : ℕ => F n r) Filter.atTop + (𝓝 (F₀ r)) := by + filter_upwards [] with r + exact tendsto_nhds_of_eventually_eq (by + filter_upwards [truncationFunction_eventually_eq r] with n hn + have hnormsq : ‖(r : ℂ)‖ₑ ^ 2 = ENNReal.ofReal (r ^ 2) := by + rw [← ofReal_norm_eq_enorm (r : ℂ), pow_two, + ← ENNReal.ofReal_mul (norm_nonneg (r : ℂ))] + simp [Complex.norm_real, Real.norm_eq_abs] + congr 1 + ring + simp [F, F₀, hn, hnormsq]) + have hmain : Filter.Tendsto (fun n : ℕ => ∫⁻ r, F n r ∂μ) Filter.atTop + (𝓝 (∫⁻ r, F₀ r ∂μ)) := by + apply MeasureTheory.tendsto_lintegral_filter_of_dominated_convergence + (fun r => ENNReal.ofReal (r ^ 2)) + · filter_upwards [] with n + exact hFmeas n + · filter_upwards [] with n + exact hbound n + · exact hfin + · exact hlim + simpa [F, F₀, μ] using hmain + +/-- The limit of the truncated spectral integrals, for `x` in the finite-second-moment domain. -/ +noncomputable def truncationLimit (μS : WOTSpectralMeasure ℝ H) + (x : spectralSquareMomentSubmodule μS) : H := + Filter.atTop.limUnder (fun n : ℕ => truncationIntegral μS n x) + +lemma truncationLimit_tendsto (μS : WOTSpectralMeasure ℝ H) + (x : spectralSquareMomentSubmodule μS) : + Filter.Tendsto (fun n : ℕ => truncationIntegral μS n x) Filter.atTop + (𝓝 (truncationLimit μS x)) := by + exact (truncationIntegral_cauchy μS x.property).tendsto_limUnder + +lemma truncationLimit_add (μS : WOTSpectralMeasure ℝ H) + (x y : spectralSquareMomentSubmodule μS) : + truncationLimit μS (x + y) = truncationLimit μS x + truncationLimit μS y := by + have hxy := (truncationLimit_tendsto μS x).add (truncationLimit_tendsto μS y) + exact tendsto_nhds_unique (truncationLimit_tendsto μS (x + y)) + (by + convert hxy using 1 + funext n + simpa using (ContinuousLinearMapWOT.toCLM (truncationIntegral μS n)).map_add + (x : H) (y : H)) + +lemma truncationLimit_smul (μS : WOTSpectralMeasure ℝ H) + (c : ℂ) (x : spectralSquareMomentSubmodule μS) : + truncationLimit μS (c • x) = c • truncationLimit μS x := by + have hcx := (truncationLimit_tendsto μS x).const_smul c + exact tendsto_nhds_unique (truncationLimit_tendsto μS (c • x)) + (by + convert hcx using 1 + funext n + simpa using (ContinuousLinearMapWOT.toCLM (truncationIntegral μS n)).map_smul c + (x : H)) + +lemma truncationIntegral_norm_sq (μS : WOTSpectralMeasure ℝ H) (n : ℕ) (x : H) : + ENNReal.ofReal (‖truncationIntegral μS n x‖ ^ 2) = + ∫⁻ r, ENNReal.ofReal (‖truncationFunction n r‖ ^ 2) + ∂μS.diagonalMeasure x := by + exact boundedIntegral_norm_sq μS (truncationFunction_measurable n) + (truncationFunction_bounded n) x + +lemma truncationIntegral_star (μS : WOTSpectralMeasure ℝ H) (n : ℕ) : + star (truncationIntegral μS n) = truncationIntegral μS n := by + rw [truncationIntegral] + have h := boundedIntegral_star μS (truncationFunction_measurable n) + (truncationFunction_bounded n) + symm + calc + boundedIntegral μS (truncationFunction n) (truncationFunction_measurable n) + (truncationFunction_bounded n) = + boundedIntegral μS (fun r => star (truncationFunction n r)) _ _ := by + congr 1 + funext r + by_cases hr : r ∈ Set.Icc (-(n : ℝ)) (n : ℝ) + · simp [truncationFunction, Set.indicator_of_mem hr] + · simp [truncationFunction, Set.indicator, hr] + _ = star (boundedIntegral μS (truncationFunction n) + (truncationFunction_measurable n) (truncationFunction_bounded n)) := h + +lemma truncationIntegral_inner_swap (μS : WOTSpectralMeasure ℝ H) (n : ℕ) + (x y : H) : + ⟪truncationIntegral μS n x, y⟫_ℂ = ⟪x, truncationIntegral μS n y⟫_ℂ := by + have hstar := congrArg (fun A : H →WOT[ℂ] H => A y) (truncationIntegral_star μS n) + rw [ContinuousLinearMapWOT.star_apply] at hstar + exact (ContinuousLinearMap.adjoint_inner_right + (ContinuousLinearMapWOT.toCLM (truncationIntegral μS n)) x y).symm.trans + (by rw [← ContinuousLinearMap.star_eq_adjoint, hstar]) + +/-- The maximal operator obtained from a real weak spectral measure by norm convergence of bounded +truncations. Its domain is exactly the square-moment submodule. -/ +noncomputable def maximalSpectralIntegral + (μS : WOTSpectralMeasure ℝ H) : H →ₗ.[ℂ] H := + LinearPMap.mk (spectralSquareMomentSubmodule μS) + { toFun := truncationLimit μS + map_add' := truncationLimit_add μS + map_smul' := truncationLimit_smul μS } + +lemma maximalSpectralIntegral_isSymmetric (μS : WOTSpectralMeasure ℝ H) : + (maximalSpectralIntegral μS).IsSymmetric := by + change (maximalSpectralIntegral μS).IsFormalAdjoint (maximalSpectralIntegral μS) + intro x y + have htx : Filter.Tendsto (fun n : ℕ => truncationIntegral μS n x) Filter.atTop + (𝓝 (truncationLimit μS x)) := truncationLimit_tendsto μS x + have hty : Filter.Tendsto (fun n : ℕ => truncationIntegral μS n y) Filter.atTop + (𝓝 (truncationLimit μS y)) := truncationLimit_tendsto μS y + have hxy := Filter.Tendsto.inner (𝕜 := ℂ) htx + (tendsto_const_nhds : Filter.Tendsto (fun _ : ℕ => (y : H)) Filter.atTop + (𝓝 (y : H))) + have hyx := Filter.Tendsto.inner (𝕜 := ℂ) + (tendsto_const_nhds : Filter.Tendsto (fun _ : ℕ => (x : H)) Filter.atTop + (𝓝 (x : H))) hty + have hseq : (fun n : ℕ => ⟪truncationIntegral μS n (x : H), (y : H)⟫_ℂ) = + (fun n : ℕ => ⟪(x : H), truncationIntegral μS n (y : H)⟫_ℂ) := by + funext n + exact truncationIntegral_inner_swap μS n (x : H) (y : H) + have hyx' := hyx + rw [← hseq] at hyx' + exact tendsto_nhds_unique hxy hyx' +@[nolint unusedArguments] + +lemma spectralCutoff_mem_spectralSquareMomentDomain + (μS : WOTSpectralMeasure ℝ H) (x : H) {C : ℝ} (hC : 0 ≤ C) : + μS (Set.Icc (-C) C) x ∈ spectralSquareMomentDomain μS := by + let K : Set ℝ := Set.Icc (-C) C + have hK : MeasurableSet K := measurableSet_Icc + have hKc : MeasurableSet Kᶜ := hK.compl + have hzero : μS Kᶜ (μS K x) = 0 := by + have hmul : μS Kᶜ * μS K = 0 := + μS.comp_of_disjoint disjoint_compl_left hKc hK + exact congrArg (fun A : H →WOT[ℂ] H => A x) hmul + have hdiagKc : μS.diagonalMeasure (μS K x) Kᶜ = 0 := by + rw [μS.diagonalMeasure_apply_eq_norm_sq _ _ hKc, hzero] + simp + rw [mem_spectralSquareMomentDomain_iff] + have hK_ae : ∀ᵐ r ∂μS.diagonalMeasure (μS K x), r ∈ K := by + rw [ae_iff] + have hset : {r : ℝ | r ∉ K} = Kᶜ := by rfl + rw [hset] + exact hdiagKc + apply Integrable.of_bound (by fun_prop) (C ^ 2) + filter_upwards [hK_ae] with r hr + change |r ^ 2| ≤ C ^ 2 + rw [abs_of_nonneg (sq_nonneg r)] + exact sq_le_sq' hr.1 hr.2 + +lemma diagonalMeasure_cutoff_compl_tendsto_zero + (μS : WOTSpectralMeasure ℝ H) (x : H) : + Filter.Tendsto + (fun n : ℕ => μS.diagonalMeasure x (spectralCutoffSet n)ᶜ) + Filter.atTop (𝓝 0) := by + have hμ := MeasureTheory.tendsto_measure_iUnion_atTop + (μ := μS.diagonalMeasure x) spectralCutoffSet_mono + have hμ' : Filter.Tendsto + (fun n : ℕ => μS.diagonalMeasure x (spectralCutoffSet n)) Filter.atTop + (𝓝 (μS.diagonalMeasure x Set.univ)) := by + simpa [Function.comp_def, spectralCutoffSet_iUnion] using hμ + have hcomp : ∀ n, μS.diagonalMeasure x (spectralCutoffSet n)ᶜ = + μS.diagonalMeasure x Set.univ - μS.diagonalMeasure x (spectralCutoffSet n) := by + intro n + exact MeasureTheory.measure_compl measurableSet_Icc + (measure_lt_top (μS.diagonalMeasure x) (spectralCutoffSet n)).ne + have hpair : Filter.Tendsto + (fun n : ℕ => (μS.diagonalMeasure x Set.univ, + μS.diagonalMeasure x (spectralCutoffSet n))) Filter.atTop + (𝓝 (μS.diagonalMeasure x Set.univ, μS.diagonalMeasure x Set.univ)) := by + exact tendsto_const_nhds.prodMk_nhds hμ' + have hsub' := (ENNReal.tendsto_sub + (Or.inl (μS.diagonalMeasure_isFinite x).measure_univ_lt_top.ne)).comp hpair + simpa [Function.comp_def, hcomp] using hsub' + +lemma spectralCutoff_tendsto (μS : WOTSpectralMeasure ℝ H) (x : H) : + Filter.Tendsto + (fun n : ℕ => μS (spectralCutoffSet n) x) Filter.atTop (𝓝 x) := by + apply (Metric.tendsto_atTop.2) + intro ε hε + have htail := (diagonalMeasure_cutoff_compl_tendsto_zero μS x).eventually + (Iio_mem_nhds ((ENNReal.ofReal_pos).2 (sq_pos_of_pos hε))) + rcases Filter.eventually_atTop.1 htail with ⟨N, hN⟩ + refine ⟨N, fun n hn => ?_⟩ + have hdecomp : μS (spectralCutoffSet n) x + + μS (spectralCutoffSet n)ᶜ x = x := by + have h := congrArg (fun A : H →WOT[ℂ] H => A x) + (MeasureTheory.VectorMeasure.of_union + (v := μS.toVectorMeasure) (A := spectralCutoffSet n) + (B := (spectralCutoffSet n)ᶜ) disjoint_compl_right measurableSet_Icc + measurableSet_Icc.compl) + simpa [Set.union_compl_self, μS.univ] using h.symm + have hdiff : x - μS (spectralCutoffSet n) x = + μS (spectralCutoffSet n)ᶜ x := by + calc + x - μS (spectralCutoffSet n) x = + (μS (spectralCutoffSet n) x + μS (spectralCutoffSet n)ᶜ x) - + μS (spectralCutoffSet n) x := by rw [hdecomp] + _ = μS (spectralCutoffSet n)ᶜ x := by abel + have hnormsq : ENNReal.ofReal + (‖x - μS (spectralCutoffSet n) x‖ ^ 2) = + μS.diagonalMeasure x (spectralCutoffSet n)ᶜ := by + rw [hdiff] + exact (μS.diagonalMeasure_apply_eq_norm_sq x (spectralCutoffSet n)ᶜ + measurableSet_Icc.compl).symm + have hlt : ENNReal.ofReal + (‖x - μS (spectralCutoffSet n) x‖ ^ 2) < ENNReal.ofReal (ε ^ 2) := by + rw [hnormsq] + exact hN n hn + have hsq : ‖x - μS (spectralCutoffSet n) x‖ ^ 2 < ε ^ 2 := + (ENNReal.ofReal_lt_ofReal_iff (by positivity)).mp hlt + simpa [dist_eq_norm, norm_sub_rev] using + (sq_lt_sq₀ (norm_nonneg _) (le_of_lt hε)).mp hsq + +lemma maximalSpectralIntegral_hasDenseDomain (μS : WOTSpectralMeasure ℝ H) : + (maximalSpectralIntegral μS).HasDenseDomain := by + rw [LinearPMap.hasDenseDomain_def, Metric.dense_iff] + intro x ε hε + rcases (Metric.tendsto_atTop.1 (spectralCutoff_tendsto μS x) ε hε) with ⟨N, hN⟩ + let z := μS (spectralCutoffSet N) x + refine ⟨z, hN N le_rfl, ?_⟩ + exact spectralCutoff_mem_spectralSquareMomentDomain μS x + (by positivity) + +lemma maximalSpectralIntegral_isClosable (μS : WOTSpectralMeasure ℝ H) : + (maximalSpectralIntegral μS).IsClosable := by + apply LinearPMap.isClosable_of_exists_dense_formalAdjoint + (maximalSpectralIntegral_hasDenseDomain μS) + exact ⟨maximalSpectralIntegral μS, + maximalSpectralIntegral_hasDenseDomain μS, + LinearPMap.isSymmetric_def.mp (maximalSpectralIntegral_isSymmetric μS)⟩ + +lemma maximalSpectralIntegral_isUnbounded (μS : WOTSpectralMeasure ℝ H) : + (maximalSpectralIntegral μS).IsUnbounded := + ⟨maximalSpectralIntegral_hasDenseDomain μS, + maximalSpectralIntegral_isClosable μS⟩ + +lemma maximalSpectralIntegral_closure_isClosed (μS : WOTSpectralMeasure ℝ H) : + (maximalSpectralIntegral μS).closure.IsClosed := + (maximalSpectralIntegral_isClosable μS).closure_isClosed + +lemma maximalSpectralIntegral_closure_isSymmetric (μS : WOTSpectralMeasure ℝ H) : + (maximalSpectralIntegral μS).closure.IsSymmetric := + (maximalSpectralIntegral_isSymmetric μS).closure + (maximalSpectralIntegral_hasDenseDomain μS) + +lemma maximalSpectralIntegral_isEssentiallySelfAdjoint_iff (μS : WOTSpectralMeasure ℝ H) : + (maximalSpectralIntegral μS).IsEssentiallySelfAdjoint ↔ + IsSelfAdjoint (maximalSpectralIntegral μS).closure := Iff.rfl + +/-- The Cayley/resolvent endpoint for the canonical PVM realization. + +The measure-theoretic construction supplies symmetry and density. Once a concrete argument proves +that both shifted operators have full range, the standard von Neumann range criterion turns the +canonical realization itself into a self-adjoint operator. This is the reusable interface for +ODE, Nelson, and multiplication-model proofs of essential self-adjointness. -/ +lemma maximalSpectralIntegral_isSelfAdjoint_of_range_eq_top + (μS : WOTSpectralMeasure ℝ H) + (hadd : (maximalSpectralIntegral μS + Complex.I • (1 : H →ₗ.[ℂ] H)).toFun.range = ⊤) + (hsub : (maximalSpectralIntegral μS - Complex.I • (1 : H →ₗ.[ℂ] H)).toFun.range = ⊤) : + IsSelfAdjoint (maximalSpectralIntegral μS) := by + exact LinearPMap.IsSymmetric.isSelfAdjoint_of_range_eq_top + (maximalSpectralIntegral_isSymmetric μS) + (maximalSpectralIntegral_hasDenseDomain μS) hadd hsub + +/-- The closure of the canonical PVM realization is self-adjoint under the same resolvent +surjectivity hypotheses. The stronger conclusion is exposed separately because downstream +models usually start with an operator on a smaller core and identify its closure with this +canonical realization. -/ +lemma maximalSpectralIntegral_closure_eq_self + (μS : WOTSpectralMeasure ℝ H) + (hadd : (maximalSpectralIntegral μS + Complex.I • (1 : H →ₗ.[ℂ] H)).toFun.range = ⊤) + (hsub : (maximalSpectralIntegral μS - Complex.I • (1 : H →ₗ.[ℂ] H)).toFun.range = ⊤) : + (maximalSpectralIntegral μS).closure = maximalSpectralIntegral μS := by + have hself := maximalSpectralIntegral_isSelfAdjoint_of_range_eq_top μS hadd hsub + exact hself.isClosed.closure_eq + +lemma maximalSpectralIntegral_isEssentiallySelfAdjoint_of_range_eq_top + (μS : WOTSpectralMeasure ℝ H) + (hadd : (maximalSpectralIntegral μS + Complex.I • (1 : H →ₗ.[ℂ] H)).toFun.range = ⊤) + (hsub : (maximalSpectralIntegral μS - Complex.I • (1 : H →ₗ.[ℂ] H)).toFun.range = ⊤) : + (maximalSpectralIntegral μS).IsEssentiallySelfAdjoint := by + rw [maximalSpectralIntegral_isEssentiallySelfAdjoint_iff] + rw [maximalSpectralIntegral_closure_eq_self μS hadd hsub] + exact maximalSpectralIntegral_isSelfAdjoint_of_range_eq_top μS hadd hsub + +lemma maximalSpectralIntegral_norm_sq (μS : WOTSpectralMeasure ℝ H) + (x : H) (hx : x ∈ (maximalSpectralIntegral μS).domain) : + ENNReal.ofReal (‖(maximalSpectralIntegral μS) ⟨x, hx⟩‖ ^ 2) = + ∫⁻ r, ENNReal.ofReal (r ^ 2) ∂μS.diagonalMeasure x := by + let xd : spectralSquareMomentSubmodule μS := ⟨x, hx⟩ + have hvec := truncationLimit_tendsto μS xd + have hnorm : Filter.Tendsto + (fun n : ℕ => ENNReal.ofReal (‖truncationIntegral μS n x‖ ^ 2)) + Filter.atTop (𝓝 (ENNReal.ofReal (‖truncationLimit μS xd‖ ^ 2))) := by + exact ENNReal.continuous_ofReal.continuousAt.tendsto.comp + ((continuous_norm.pow 2).continuousAt.tendsto.comp hvec) + have hleft : Filter.Tendsto + (fun n : ℕ => ENNReal.ofReal (‖truncationIntegral μS n x‖ ^ 2)) + Filter.atTop (𝓝 (∫⁻ r, ENNReal.ofReal (r ^ 2) ∂μS.diagonalMeasure x)) := by + convert truncation_norm_lintegral_tendsto μS x xd.property using 1 + funext n + exact truncationIntegral_norm_sq μS n x + have heq := tendsto_nhds_unique hnorm hleft + simpa [maximalSpectralIntegral, xd] using heq + +@[simp] lemma maximalSpectralIntegral_domain (μS : WOTSpectralMeasure ℝ H) : + (maximalSpectralIntegral μS).domain = spectralSquareMomentSubmodule μS := rfl + +lemma maximalSpectralIntegral_apply (μS : WOTSpectralMeasure ℝ H) + (x : H) (hx : x ∈ (maximalSpectralIntegral μS).domain) : + (maximalSpectralIntegral μS) ⟨x, hx⟩ = truncationLimit μS ⟨x, hx⟩ := rfl +@[nolint unusedArguments] + +lemma scalarMeasure_inner_projection (μS : WOTSpectralMeasure ℝ H) + (x y : H) (S : Set ℝ) (hS : MeasurableSet S) : + ⟪y, μS S x⟫_ℂ = ⟪μS S y, μS S x⟫_ℂ := by + let p : H →L[ℂ] H := ContinuousLinearMapWOT.toCLM (μS S) + have hmul : p * p = p := by + exact congrArg ContinuousLinearMapWOT.toCLM (μS.isStarProjection S).isIdempotentElem + have hstar : ContinuousLinearMap.adjoint p = p := by + rw [← ContinuousLinearMap.star_eq_adjoint] + exact congrArg ContinuousLinearMapWOT.toCLM (μS.isStarProjection S).isSelfAdjoint + change ⟪y, p x⟫_ℂ = ⟪p y, p x⟫_ℂ + calc + ⟪y, p x⟫_ℂ = ⟪ContinuousLinearMap.adjoint p y, x⟫_ℂ := + (ContinuousLinearMap.adjoint_inner_left p x y).symm + _ = ⟪p y, x⟫_ℂ := by rw [hstar] + _ = ⟪p y, p x⟫_ℂ := by + have h := ContinuousLinearMap.adjoint_inner_right p (p y) x + rw [hstar] at h + have hpy : p (p y) = p y := by + exact congrArg (fun q : H →L[ℂ] H => q y) hmul + rw [hpy] at h + exact h.symm + +lemma scalarMeasure_variation_le_diagonal_add (μS : WOTSpectralMeasure ℝ H) + (x y : H) : + (μS.scalarMeasure x y).variation ≤ μS.diagonalMeasure x + μS.diagonalMeasure y := by + apply MeasureTheory.VectorMeasure.variation_le_of_forall_enorm_le + intro S hS + rw [μS.scalarMeasure_apply x y S] + rw [← ofReal_norm] + rw [MeasureTheory.Measure.add_apply _ _ S, μS.diagonalMeasure_apply_eq_norm_sq x S hS, + μS.diagonalMeasure_apply_eq_norm_sq y S hS] + rw [← ENNReal.ofReal_add (sq_nonneg _) (sq_nonneg _)] + apply ENNReal.ofReal_le_ofReal + have hinner := norm_inner_le_norm (𝕜 := ℂ) (μS S y) (μS S x) + have hproj := scalarMeasure_inner_projection μS x y S hS + rw [hproj] + nlinarith [sq_nonneg ‖μS S y‖, sq_nonneg ‖μS S x‖] + +lemma scalarMeasure_isFiniteVariation (μS : WOTSpectralMeasure ℝ H) + (x y : H) : IsFiniteMeasure (μS.scalarMeasure x y).variation := by + apply MeasureTheory.isFiniteMeasure_of_le + (μS.diagonalMeasure x + μS.diagonalMeasure y) + exact scalarMeasure_variation_le_diagonal_add μS x y + +lemma truncationIntegral_inner_tendsto_weakIntegral + (μS : WOTSpectralMeasure ℝ H) (x y : H) + (hfi : (μS.scalarMeasure x y).Integrable id) : + Filter.Tendsto + (fun n : ℕ => ∫ᵛ r, realTruncationFunction n r ∂[ + ContinuousLinearMap.lsmul ℝ ℝ (E := ℂ); μS.scalarMeasure x y]) + Filter.atTop (𝓝 (μS.weakIntegral id x y)) := by + let ν := μS.scalarMeasure x y + letI := scalarMeasure_isFiniteVariation μS x y + have hlimit : μS.complexWeakIntegral (fun r : ℝ => (r : ℂ)) x y = + μS.weakIntegral id x y := by + unfold WOTSpectralMeasure.complexWeakIntegral WOTSpectralMeasure.weakIntegral + exact (integral_real_eq_complex ν hfi).symm + have hcomplex := truncationIntegral_inner_tendsto_complexWeakIntegral μS x y hfi + rw [hlimit] at hcomplex + apply hcomplex.congr' + filter_upwards [] with n + have htrunc : ν.Integrable (realTruncationFunction n) := by + rcases realTruncationFunction_bounded n with ⟨C, hC⟩ + apply Integrable.of_bound + (realTruncationFunction_measurable n).aestronglyMeasurable C + filter_upwards [] with r + simpa [Real.norm_eq_abs] using hC r + have hreal := integral_real_eq_complex ν htrunc + calc + ∫ᵛ r, truncationFunction n r ∂[ + ContinuousLinearMap.lsmul ℝ ℂ; ν] = + ∫ᵛ r, Complex.ofRealCLM (realTruncationFunction n r) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ; ν] := by + have hfun : (fun r => truncationFunction n r) = + (fun r => Complex.ofRealCLM (realTruncationFunction n r)) := by + funext r + simpa [Complex.ofRealCLM_apply] using + congrFun (realTruncationFunction_complex_eq n).symm r + exact congrArg (fun f : ℝ → ℂ => + ∫ᵛ r, f r ∂[ContinuousLinearMap.lsmul ℝ ℂ; ν]) hfun + _ = ∫ᵛ r, realTruncationFunction n r ∂[ + ContinuousLinearMap.lsmul ℝ ℝ (E := ℂ); ν] := hreal.symm + +lemma boundedIntegral_inner + {α : Type*} [MeasurableSpace α] [Nonempty α] + (μS : WOTSpectralMeasure α H) {f : α → ℂ} (hf : Measurable f) + (hfb : ∃ C : ℝ, ∀ a, ‖f a‖ ≤ C) (x y : H) + (hfinite : IsFiniteMeasure (μS.scalarMeasure x y).variation) : + ⟪y, boundedIntegral μS f hf hfb x⟫_ℂ = + ∫ᵛ a, f a ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); + μS.scalarMeasure x y] := by + let s : ℕ → SimpleFunc α ℂ := + Classical.choose (exists_uniform_simple_approx hf hfb) + have hs : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ a, ‖s n a - f a‖ < ε := + (Classical.choose_spec (exists_uniform_simple_approx hf hfb)).1 + have hsBound : ∃ C : ℝ, ∀ n a, ‖s n a‖ ≤ C := + (Classical.choose_spec (exists_uniform_simple_approx hf hfb)).2 + rw [boundedIntegral_eq_of_uniform_approx μS hf hfb hs] + exact boundedIntegralOfUniformApprox_inner μS hs hsBound x y hfinite + +lemma truncationIntegral_inner (μS : WOTSpectralMeasure ℝ H) (n : ℕ) + (x y : H) : + ⟪y, truncationIntegral μS n x⟫_ℂ = + ∫ᵛ r, truncationFunction n r ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); + μS.scalarMeasure x y] := by + exact boundedIntegral_inner μS (truncationFunction_measurable n) + (truncationFunction_bounded n) x y (scalarMeasure_isFiniteVariation μS x y) + +lemma maximalSpectralIntegral_weak_truncation_reconstruction + (μS : WOTSpectralMeasure ℝ H) (x : H) + (hx : x ∈ (maximalSpectralIntegral μS).domain) (y : H) : + Filter.Tendsto + (fun n : ℕ => ∫ᵛ r, truncationFunction n r ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); μS.scalarMeasure x y]) + Filter.atTop (𝓝 (⟪y, (maximalSpectralIntegral μS) ⟨x, hx⟩⟫_ℂ)) := by + have hvec := truncationLimit_tendsto μS + (⟨x, hx⟩ : spectralSquareMomentSubmodule μS) + have hinner := Filter.Tendsto.inner (𝕜 := ℂ) + (tendsto_const_nhds : Filter.Tendsto (fun _ : ℕ => (y : H)) Filter.atTop (𝓝 y)) hvec + have hinner' : Filter.Tendsto + (fun n : ℕ => ⟪y, truncationIntegral μS n x⟫_ℂ) Filter.atTop + (𝓝 (⟪y, (maximalSpectralIntegral μS) ⟨x, hx⟩⟫_ℂ)) := by + simpa [maximalSpectralIntegral, truncationLimit] using hinner + apply hinner'.congr' + filter_upwards [] with n + exact truncationIntegral_inner μS n x y + +/-! ### Measurable real functional calculus + +The maximal construction is not tied to the coordinate function. For a measurable real +multiplier `f`, push the PVM forward along `f` and apply the same construction to the new +spectral variable. This is the concrete operator realization of the representation-free +`PVM.map` operation used by the affiliated-observable API. -/ + +/-- The maximal unbounded operator obtained by integrating a measurable real function against a +weak spectral measure. It is defined by PVM pushforward, so no second truncation construction is +needed for each multiplier. -/ +noncomputable def measurableSpectralIntegral (μS : WOTSpectralMeasure ℝ H) + (f : ℝ → ℝ) (hf : Measurable f) : H →ₗ.[ℂ] H := + maximalSpectralIntegral (μS.map f hf) + +@[simp] +theorem measurableSpectralIntegral_id (μS : WOTSpectralMeasure ℝ H) : + measurableSpectralIntegral μS id measurable_id = maximalSpectralIntegral μS := by + unfold measurableSpectralIntegral + rw [μS.map_id] + +lemma measurableSpectralIntegral_comp + (μS : WOTSpectralMeasure ℝ H) (f g : ℝ → ℝ) + (hf : Measurable f) (hg : Measurable g) : + measurableSpectralIntegral (μS.map f hf) g hg = + measurableSpectralIntegral μS (g ∘ f) (hg.comp hf) := by + change maximalSpectralIntegral ((μS.map f hf).map g hg) = + maximalSpectralIntegral (μS.map (g ∘ f) (hg.comp hf)) + apply congrArg maximalSpectralIntegral + exact WOTSpectralMeasure.map_map (μS := μS) (f := f) (g := g) hf hg + +@[simp] +lemma measurableSpectralIntegral_domain (μS : WOTSpectralMeasure ℝ H) + (f : ℝ → ℝ) (hf : Measurable f) : + (measurableSpectralIntegral μS f hf).domain = + spectralSquareMomentSubmodule (μS.map f hf) := by + rfl + +/-- The domain of `∫ f dE` is exactly the square-integrability domain of `f` against every +vector-state spectral measure. -/ +lemma mem_measurableSpectralIntegral_domain_iff (μS : WOTSpectralMeasure ℝ H) + (f : ℝ → ℝ) (hf : Measurable f) (x : H) : + x ∈ (measurableSpectralIntegral μS f hf).domain ↔ + Integrable (fun r : ℝ => f r ^ 2) (μS.diagonalMeasure x) := by + change x ∈ spectralSquareMomentDomain (μS.map f hf) ↔ _ + rw [mem_spectralSquareMomentDomain_iff, + μS.diagonalMeasure_map f hf] + have h := integrable_map_measure (μ := μS.diagonalMeasure x) + ((measurable_id.pow_const 2).aestronglyMeasurable) hf.aemeasurable + simpa [Function.comp_def] using h + +/-- A bounded measurable real multiplier has no unbounded domain restriction. This is the +bounded-to-unbounded boundary in the reusable calculus: the same pushforward construction handles +both cases, and boundedness turns its square-moment domain into `⊤`. -/ +lemma measurableSpectralIntegral_domain_eq_top_of_bounded + (μS : WOTSpectralMeasure ℝ H) (f : ℝ → ℝ) (hf : Measurable f) + (hfb : ∃ C : ℝ, 0 ≤ C ∧ ∀ r : ℝ, |f r| ≤ C) : + (measurableSpectralIntegral μS f hf).domain = ⊤ := by + apply Submodule.eq_top_iff'.2 + intro x + rw [mem_measurableSpectralIntegral_domain_iff μS f hf x] + rcases hfb with ⟨C, hC, hfb⟩ + apply Integrable.of_bound (hf.pow_const 2).aestronglyMeasurable (C ^ 2) + filter_upwards [] with r + simpa [Real.norm_eq_abs, abs_pow] using + (sq_le_sq₀ (abs_nonneg (f r)) hC).2 (hfb r) + +/-- Weak reconstruction for a measurable real multiplier. The only integrability assumption is +the natural one on the original scalar spectral measure; the pushforward identity transports it +to the coordinate function of the new PVM. -/ +lemma measurableSpectralIntegral_inner_eq_complexWeakIntegral + (μS : WOTSpectralMeasure ℝ H) (f : ℝ → ℝ) (hf : Measurable f) + (x : H) (hx : x ∈ (measurableSpectralIntegral μS f hf).domain) (y : H) + (hfi : (μS.scalarMeasure x y).Integrable f) : + ⟪y, (measurableSpectralIntegral μS f hf) ⟨x, hx⟩⟫_ℂ = + μS.complexWeakIntegral (fun r : ℝ => (f r : ℂ)) x y := by + have hfi' : ((μS.map f hf).scalarMeasure x y).Integrable id := by + rw [μS.scalarMeasure_map f hf] + have h := VectorMeasure.Integrable.map + (measurable_id.aestronglyMeasurable) hfi + simpa [Function.comp_def] using h + have hmax := maximalSpectralIntegral_weak_truncation_reconstruction + (μS.map f hf) x hx y + have hlim := truncationIntegral_inner_tendsto_complexWeakIntegral + (μS.map f hf) x y hfi' + have hinner : + ⟪y, (maximalSpectralIntegral (μS.map f hf)) ⟨x, hx⟩⟫_ℂ = + (μS.map f hf).complexWeakIntegral (fun r : ℝ => (r : ℂ)) x y := + tendsto_nhds_unique hmax hlim + have hfiC : (μS.scalarMeasure x y).Integrable (fun r : ℝ => (f r : ℂ)) := by + exact hfi.ofReal + have hmap := μS.complexWeakIntegral_map f hf + (fun r : ℝ => (r : ℂ)) x y + Complex.measurable_ofReal.aestronglyMeasurable hfiC + simpa [measurableSpectralIntegral, Function.comp_def] using hinner.trans hmap + +/-- On bounded real multipliers, the bounded WOT integral and the maximal unbounded +realization are the same operator. This is the concrete bridge between the bounded Borel +calculus and the square-moment construction; the proof is by matrix coefficients, using the +bounded integral's weak integral formula and the measurable multiplier reconstruction theorem. -/ +theorem boundedIntegral_ofReal_eq_measurableSpectralIntegral + (μS : WOTSpectralMeasure ℝ H) (f : ℝ → ℝ) (hf : Measurable f) + (hfb : ∃ C : ℝ, 0 ≤ C ∧ ∀ r : ℝ, |f r| ≤ C) (x : H) : + boundedIntegral μS (fun r : ℝ => (f r : ℂ)) + (Complex.measurable_ofReal.comp hf) + (by + rcases hfb with ⟨C, hC, hCbound⟩ + exact ⟨C, fun r => by + simpa [Complex.norm_real, Real.norm_eq_abs] using hCbound r⟩) x = + (measurableSpectralIntegral μS f hf) + ⟨x, by + rw [measurableSpectralIntegral_domain_eq_top_of_bounded μS f hf hfb] + exact Submodule.mem_top⟩ := by + apply ext_inner_left ℂ + intro y + letI : IsFiniteMeasure (μS.scalarMeasure x y).variation := + scalarMeasure_isFiniteVariation μS x y + have hfi : (μS.scalarMeasure x y).Integrable f := by + rcases hfb with ⟨C, hC, hCbound⟩ + have hnorm : ∀ r : ℝ, ‖f r‖ ≤ C := by + intro r + simpa [Real.norm_eq_abs] using hCbound r + apply Integrable.of_bound hf.aestronglyMeasurable C + exact Filter.Eventually.of_forall hnorm + have hbounded := boundedIntegral_inner μS + (Complex.measurable_ofReal.comp hf) + (by + rcases hfb with ⟨C, hC, hCbound⟩ + exact ⟨C, fun r => by + simpa [Complex.norm_real, Real.norm_eq_abs] using hCbound r⟩) x y + (scalarMeasure_isFiniteVariation μS x y) + have hunbounded := measurableSpectralIntegral_inner_eq_complexWeakIntegral μS f hf x + (by + rw [measurableSpectralIntegral_domain_eq_top_of_bounded μS f hf hfb] + exact Submodule.mem_top) y hfi + exact hbounded.trans hunbounded.symm + +/-! ### Convergence of bounded spectral multipliers + +The next lemma is the reusable norm-convergence principle behind the resolvent construction. It +only uses the PVM norm-square identity, so it is also useful for bounded functional calculus +approximations unrelated to the Cayley transform. +-/ + +lemma boundedIntegral_tendsto_of_pointwise_tendsto_of_bound + {α : Type*} [MeasurableSpace α] [Nonempty α] + (μS : WOTSpectralMeasure α H) + {f : α → ℂ} {g : ℕ → α → ℂ} (x : H) + (hf : Measurable f) (hg : ∀ n, Measurable (g n)) + (hfb : ∃ C : ℝ, ∀ a, ‖f a‖ ≤ C) + (hgb : ∃ C : ℝ, ∀ n a, ‖g n a‖ ≤ C) + (hlim : ∀ a, Filter.Tendsto (fun n => g n a) Filter.atTop (𝓝 (f a))) : + Filter.Tendsto + (fun n => boundedIntegral μS (g n) (hg n) (by + rcases hgb with ⟨C, hC⟩ + exact ⟨C, hC n⟩) x) + Filter.atTop + (𝓝 (boundedIntegral μS f hf hfb x)) := by + have hfb_keep := hfb + rcases hfb with ⟨Cf, hCf⟩ + rcases hgb with ⟨Cg, hCg⟩ + let C : ℝ := max Cf Cg + have hC0 : 0 ≤ C := by + let a₀ : α := Classical.choice (inferInstance : Nonempty α) + exact (norm_nonneg (f a₀)).trans ((hCf a₀).trans (le_max_left _ _)) + have hCfC : ∀ a, ‖f a‖ ≤ C := fun a => (hCf a).trans (le_max_left _ _) + have hCgC : ∀ n a, ‖g n a‖ ≤ C := fun n a => (hCg n a).trans (le_max_right _ _) + let μ : Measure α := μS.diagonalMeasure x + let F : ℕ → α → ENNReal := fun n a => + ENNReal.ofReal (‖g n a - f a‖ ^ 2) + have hFmeas : ∀ n, Measurable (F n) := by + intro n + exact ENNReal.continuous_ofReal.measurable.comp + (((hg n).sub hf).norm.pow_const 2) + have hbound : ∀ n, ∀ᵐ a ∂μ, F n a ≤ ENNReal.ofReal ((2 * C) ^ 2) := by + intro n + filter_upwards [] with a + dsimp [F] + apply ENNReal.ofReal_le_ofReal + have hnorm : ‖g n a - f a‖ ≤ 2 * C := by + exact (norm_sub_le _ _).trans (by linarith [hCgC n a, hCfC a]) + exact (sq_le_sq₀ (norm_nonneg _) (by positivity)).mpr hnorm + have hfin : (∫⁻ a, ENNReal.ofReal ((2 * C) ^ 2) ∂μ) ≠ (⊤ : ENNReal) := by + rw [lintegral_const, μS.diagonalMeasure_univ] + apply ENNReal.mul_ne_top ENNReal.ofReal_ne_top + exact ENNReal.ofReal_ne_top + have hpoint : ∀ᵐ a ∂μ, + Filter.Tendsto (fun n : ℕ => F n a) Filter.atTop (𝓝 0) := by + filter_upwards [] with a + have hdiff : Filter.Tendsto (fun n : ℕ => g n a - f a) + Filter.atTop (𝓝 0) := by + simpa using (hlim a).sub (tendsto_const_nhds : + Filter.Tendsto (fun _ : ℕ => f a) Filter.atTop (𝓝 (f a))) + have hnorm : Filter.Tendsto (fun n : ℕ => ‖g n a - f a‖ ^ 2) + Filter.atTop (𝓝 (0 ^ 2)) := by + convert (continuous_norm.pow 2).continuousAt.tendsto.comp hdiff using 1 + congr 1 + norm_num + change Filter.Tendsto (fun n : ℕ => ENNReal.ofReal + (‖g n a - f a‖ ^ 2)) Filter.atTop (𝓝 0) + convert ENNReal.continuous_ofReal.continuousAt.tendsto.comp hnorm using 1 + simp [Function.comp_def] + norm_num + have hlin : Filter.Tendsto (fun n : ℕ => ∫⁻ a, F n a ∂μ) + Filter.atTop (𝓝 0) := by + simpa using + (MeasureTheory.tendsto_lintegral_filter_of_dominated_convergence + (fun _ : α => ENNReal.ofReal ((2 * C) ^ 2)) + (by filter_upwards [] with n; exact hFmeas n) + (by filter_upwards [] with n; exact hbound n) hfin hpoint) + have hnormsq : ∀ n, ENNReal.ofReal + (‖boundedIntegral μS (g n) (hg n) (⟨C, hCgC n⟩) x - + boundedIntegral μS f hf (⟨C, hCfC⟩) x‖ ^ 2) = ∫⁻ a, F n a ∂μ := by + intro n + have hsub := boundedIntegral_sub μS (hg n) hf (⟨C, hCgC n⟩) (⟨C, hCfC⟩) + have heq := congrArg (fun A : H →WOT[ℂ] H => A x) hsub + calc + _ = ENNReal.ofReal + (‖boundedIntegral μS (g n - f) ((hg n).sub hf) _ x‖ ^ 2) := by + rw [heq] + rfl + _ = ∫⁻ a, ENNReal.ofReal (‖(g n - f) a‖ ^ 2) + ∂μS.diagonalMeasure x := boundedIntegral_norm_sq μS ((hg n).sub hf) _ x + _ = ∫⁻ a, F n a ∂μ := by rfl + have hnorm : Filter.Tendsto (fun n : ℕ => + ‖boundedIntegral μS (g n) (hg n) (⟨C, hCgC n⟩) x - + boundedIntegral μS f hf (⟨C, hCfC⟩) x‖) Filter.atTop (𝓝 0) := by + rw [Metric.tendsto_atTop] + intro ε hε + have hsmall := hlin.eventually (Iio_mem_nhds + ((ENNReal.ofReal_pos).2 (sq_pos_of_pos hε))) + rcases Filter.eventually_atTop.1 hsmall with ⟨N, hN⟩ + refine ⟨N, fun n hn => ?_⟩ + have hlt : ENNReal.ofReal + (‖boundedIntegral μS (g n) (hg n) (⟨C, hCgC n⟩) x - + boundedIntegral μS f hf (⟨C, hCfC⟩) x‖ ^ 2) < + ENNReal.ofReal (ε ^ 2) := by + rw [hnormsq n] + exact hN n hn + have hsq : ‖boundedIntegral μS (g n) (hg n) (⟨C, hCgC n⟩) x - + boundedIntegral μS f hf (⟨C, hCfC⟩) x‖ ^ 2 < ε ^ 2 := + (ENNReal.ofReal_lt_ofReal_iff (by positivity)).mp hlt + simpa [dist_eq_norm] using + (sq_lt_sq₀ (norm_nonneg _) (le_of_lt hε)).mp hsq + rw [tendsto_iff_norm_sub_tendsto_zero] + convert hnorm using 1 + +end QuantumMechanics.WOTSpectralMeasure diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/SpectralIntegral/SpecTheorem.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/SpectralIntegral/SpecTheorem.lean new file mode 100644 index 0000000000..41f7476db9 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/SpectralIntegral/SpecTheorem.lean @@ -0,0 +1,1224 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.SpectralIntegral.Construction + +/-! +# Canonical unbounded spectral integrals: the self-adjoint spectral theorem + +Continues `SpectralIntegral/Construction.lean`: shows the maximal spectral integral has full +resolvent range off the real axis and is therefore self-adjoint (not merely essentially so), then +assembles `domainAwareSelfAdjointSpectralTheorem_of_isWeakSpectralResolution`, identifying the +operator's domain with the square-moment domain of its spectral measure. +-/ + +@[expose] public section + +noncomputable section + +open scoped Topology InnerProductSpace Function +open ContinuousLinearMap ContinuousLinearMapWOT MeasureTheory Set +open QuantumMechanics.WOTSpectralMeasure + +namespace QuantumMechanics.WOTSpectralMeasure + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-! ### Weighted diagonal measures + +Applying a bounded spectral multiplier changes the vector spectral measure by the squared +multiplier. This is the measure-level statement that turns bounded resolvents into vectors in the +maximal square-moment domain. +-/ + +lemma diagonalMeasure_boundedIntegral_eq_withDensity + {α : Type*} [MeasurableSpace α] [Nonempty α] + (μS : WOTSpectralMeasure α H) {g : α → ℂ} (hg : Measurable g) + (hgb : ∃ C : ℝ, ∀ a, ‖g a‖ ≤ C) (x : H) : + μS.diagonalMeasure (boundedIntegral μS g hg hgb x) = + Measure.withDensity (μS.diagonalMeasure x) + (fun a => ENNReal.ofReal (‖g a‖ ^ 2)) := by + apply Measure.ext + intro S hS + rw [μS.diagonalMeasure_apply_eq_norm_sq _ _ hS] + let iS : α → ℂ := S.indicator (fun _ => (1 : ℂ)) + have hiS : Measurable iS := measurable_const.indicator hS + have hiSb : ∃ C : ℝ, ∀ a, ‖iS a‖ ≤ C := by + refine ⟨1, fun a => ?_⟩ + by_cases ha : a ∈ S <;> simp [iS, ha] + have hmul := boundedIntegral_mul μS hiS hg hiSb hgb + have hind := boundedIntegral_indicator μS hS + have happly : μS S (boundedIntegral μS g hg hgb x) = + boundedIntegral μS (iS * g) (hiS.mul hg) + (by + rcases hiSb with ⟨Ci, hCi⟩ + rcases hgb with ⟨Cg, hCg⟩ + refine ⟨Ci * Cg, fun a => ?_⟩ + rw [Pi.mul_apply, norm_mul] + exact mul_le_mul (hCi a) (hCg a) (norm_nonneg _) (by + exact (norm_nonneg (iS (Classical.choice (inferInstance : Nonempty α)))).trans + (hCi _))) x := by + rw [← hind] + have h := congrArg (fun A : H →WOT[ℂ] H => A x) hmul + simpa [ContinuousLinearMapWOT.mul_apply, iS] using h.symm + rw [happly] + rw [boundedIntegral_norm_sq μS (hiS.mul hg) _ x] + rw [MeasureTheory.withDensity_apply _ hS] + rw [← lintegral_indicator hS] + congr 1 + funext a + by_cases ha : a ∈ S + · simp [iS, ha] + · simp [iS, ha] + +lemma expIntegral_mem_spectralSquareMomentDomain + (μS : WOTSpectralMeasure ℝ H) (t : ℝ) (x : H) + (hx : x ∈ spectralSquareMomentDomain μS) : + expIntegral μS t x ∈ spectralSquareMomentDomain μS := by + rw [mem_spectralSquareMomentDomain_iff] at hx ⊢ + have hmeasure : μS.diagonalMeasure (expIntegral μS t x) = μS.diagonalMeasure x := by + rw [show expIntegral μS t x = + boundedIntegral μS (expFunction t) (expFunction_measurable t) + (expFunction_bounded t) x by rfl] + rw [diagonalMeasure_boundedIntegral_eq_withDensity μS + (expFunction_measurable t) (expFunction_bounded t) x] + apply Measure.ext + intro S hS + rw [MeasureTheory.withDensity_apply _ hS] + simp only [expFunction_modulus] + norm_num [MeasureTheory.setLIntegral_one] + rw [hmeasure] + exact hx +@[nolint unusedArguments] + +lemma boundedMultiplier_mem_spectralSquareMomentDomain + {α : Type*} [MeasurableSpace α] [Nonempty α] + (μS : WOTSpectralMeasure ℝ H) {g : ℝ → ℂ} (hg : Measurable g) + (hgb : ∃ C : ℝ, ∀ a, ‖g a‖ ≤ C) + (hcoord : ∀ a : ℝ, ‖(a : ℂ) * g a‖ ≤ 1) (x : H) : + boundedIntegral μS g hg hgb x ∈ spectralSquareMomentDomain μS := by + rw [mem_spectralSquareMomentDomain_iff] + rw [diagonalMeasure_boundedIntegral_eq_withDensity μS hg hgb x] + let d : ℝ → ENNReal := fun a => ENNReal.ofReal (‖g a‖ ^ 2) + have hd : Measurable d := ENNReal.continuous_ofReal.measurable.comp + (hg.norm.pow_const 2) + have hd_top : ∀ᵐ a ∂μS.diagonalMeasure x, d a < (⊤ : ENNReal) := by + filter_upwards [] with a + exact (lt_top_iff_ne_top).2 (ENNReal.ofReal_ne_top) + apply (integrable_withDensity_iff_integrable_smul₀' hd.aemeasurable hd_top).2 + apply Integrable.of_bound (by fun_prop) 1 + filter_upwards [] with a + have hsq : ‖(a : ℂ) * g a‖ ^ 2 ≤ (1 : ℝ) ^ 2 := by + exact (sq_le_sq₀ (norm_nonneg _) (by norm_num)).mpr (hcoord a) + rw [show d a = ENNReal.ofReal (‖g a‖ ^ 2) by rfl] + rw [ENNReal.toReal_ofReal (sq_nonneg (‖g a‖))] + simp only [smul_eq_mul] + rw [Real.norm_eq_abs, abs_of_nonneg + (mul_nonneg (sq_nonneg (‖g a‖)) (sq_nonneg a))] + rw [norm_mul, Complex.norm_real, Real.norm_eq_abs] at hsq + nlinarith [sq_abs a] + +/-! The unit bound used by the first resolvent construction is convenient, but it is not +mathematically essential. Keeping the finite-bound version separate makes the later general +resolvent API usable at arbitrary non-real parameters without weakening any of the existing +callers. -/ +@[nolint unusedArguments] + +lemma boundedMultiplier_mem_spectralSquareMomentDomain_of_bound + {α : Type*} [MeasurableSpace α] [Nonempty α] + (μS : WOTSpectralMeasure ℝ H) {g : ℝ → ℂ} (hg : Measurable g) + (hgb : ∃ C : ℝ, ∀ a, ‖g a‖ ≤ C) + (hcoord : ∃ C : ℝ, 0 ≤ C ∧ ∀ a : ℝ, ‖(a : ℂ) * g a‖ ≤ C) (x : H) : + boundedIntegral μS g hg hgb x ∈ spectralSquareMomentDomain μS := by + rw [mem_spectralSquareMomentDomain_iff] + rw [diagonalMeasure_boundedIntegral_eq_withDensity μS hg hgb x] + let d : ℝ → ENNReal := fun a => ENNReal.ofReal (‖g a‖ ^ 2) + have hd : Measurable d := ENNReal.continuous_ofReal.measurable.comp + (hg.norm.pow_const 2) + have hd_top : ∀ᵐ a ∂μS.diagonalMeasure x, d a < (⊤ : ENNReal) := by + filter_upwards [] with a + exact (lt_top_iff_ne_top).2 (ENNReal.ofReal_ne_top) + apply (integrable_withDensity_iff_integrable_smul₀' hd.aemeasurable hd_top).2 + rcases hcoord with ⟨C, hC0, hC⟩ + apply Integrable.of_bound (by fun_prop) (C ^ 2) + filter_upwards [] with a + have hsq : ‖(a : ℂ) * g a‖ ^ 2 ≤ C ^ 2 := by + exact (sq_le_sq₀ (norm_nonneg _) hC0).mpr (hC a) + rw [show d a = ENNReal.ofReal (‖g a‖ ^ 2) by rfl] + rw [ENNReal.toReal_ofReal (sq_nonneg (‖g a‖))] + simp only [smul_eq_mul] + rw [Real.norm_eq_abs, abs_of_nonneg + (mul_nonneg (sq_nonneg (‖g a‖)) (sq_nonneg a))] + rw [norm_mul, Complex.norm_real, Real.norm_eq_abs] at hsq + nlinarith [sq_abs a] + +lemma maximalSpectralIntegral_apply_boundedMultiplier + (μS : WOTSpectralMeasure ℝ H) {g : ℝ → ℂ} (hg : Measurable g) + (hgb : ∃ C : ℝ, ∀ a, ‖g a‖ ≤ C) + (hcoord : ∀ a : ℝ, ‖(a : ℂ) * g a‖ ≤ 1) + (hcoord_meas : Measurable (fun a : ℝ => (a : ℂ) * g a)) + (x : H) : + (maximalSpectralIntegral μS) + ⟨boundedIntegral μS g hg hgb x, + boundedMultiplier_mem_spectralSquareMomentDomain (α := ℝ) μS hg hgb hcoord x⟩ = + boundedIntegral μS (fun a : ℝ => (a : ℂ) * g a) hcoord_meas + ⟨1, hcoord⟩ x := by + let y : H := boundedIntegral μS g hg hgb x + have hy : y ∈ spectralSquareMomentDomain μS := + boundedMultiplier_mem_spectralSquareMomentDomain (α := ℝ) μS hg hgb hcoord x + let fn : ℕ → ℝ → ℂ := fun n a => truncationFunction n a * g a + have hfn : ∀ n, Measurable (fn n) := by + intro n + exact (truncationFunction_measurable n).mul hg + have hfn_bound_one : ∀ n a, ‖fn n a‖ ≤ (1 : ℝ) := by + intro n a + change ‖truncationFunction n a * g a‖ ≤ 1 + by_cases ha : a ∈ Set.Icc (-(n : ℝ)) (n : ℝ) + · rw [show truncationFunction n a = (a : ℂ) by + simp [truncationFunction, Set.indicator_of_mem ha]] + exact hcoord a + · simp [truncationFunction, ha] + have hfn_bound : ∀ n, ∃ C : ℝ, ∀ a, ‖fn n a‖ ≤ C := by + intro n + exact ⟨1, hfn_bound_one n⟩ + have hfn_lim : ∀ a : ℝ, Filter.Tendsto (fun n : ℕ => fn n a) + Filter.atTop (𝓝 ((a : ℂ) * g a)) := by + intro a + have htrunc := truncationFunction_tendsto a + exact htrunc.mul (tendsto_const_nhds : + Filter.Tendsto (fun _ : ℕ => g a) Filter.atTop (𝓝 (g a))) + have hconv : Filter.Tendsto + (fun n : ℕ => boundedIntegral μS (fn n) (hfn n) (hfn_bound n) x) + Filter.atTop + (𝓝 (boundedIntegral μS (fun a : ℝ => (a : ℂ) * g a) + hcoord_meas ⟨1, hcoord⟩ x)) := + boundedIntegral_tendsto_of_pointwise_tendsto_of_bound μS x hcoord_meas hfn + ⟨1, hcoord⟩ ⟨1, hfn_bound_one⟩ hfn_lim + have htrunc : Filter.Tendsto + (fun n : ℕ => truncationIntegral μS n y) Filter.atTop (𝓝 (truncationLimit μS ⟨y, hy⟩)) := + truncationLimit_tendsto μS ⟨y, hy⟩ + have heq : ∀ n, truncationIntegral μS n y = boundedIntegral μS (fn n) + (hfn n) (hfn_bound n) x := by + intro n + have hmul := boundedIntegral_mul μS (truncationFunction_measurable n) hg + (truncationFunction_bounded n) hgb + have happly := congrArg (fun A : H →WOT[ℂ] H => A x) hmul + change truncationIntegral μS n (boundedIntegral μS g hg hgb x) = _ + change truncationIntegral μS n (boundedIntegral μS g hg hgb x) = + boundedIntegral μS (truncationFunction n * g) (hfn n) (hfn_bound n) x + convert happly.symm using 1; + simp [truncationIntegral, ContinuousLinearMapWOT.mul_apply] + have htrunc' : Filter.Tendsto + (fun n : ℕ => boundedIntegral μS (fn n) (hfn n) (hfn_bound n) x) Filter.atTop + (𝓝 (maximalSpectralIntegral μS ⟨y, hy⟩)) := by + change Filter.Tendsto + (fun n : ℕ => boundedIntegral μS (fn n) (hfn n) (hfn_bound n) x) Filter.atTop + (𝓝 (truncationLimit μS ⟨y, hy⟩)) + exact htrunc.congr' (Filter.Eventually.of_forall fun n => heq n) + exact tendsto_nhds_unique htrunc' hconv + +lemma maximalSpectralIntegral_apply_boundedMultiplier_of_bound + (μS : WOTSpectralMeasure ℝ H) {g : ℝ → ℂ} (hg : Measurable g) + (hgb : ∃ C : ℝ, ∀ a, ‖g a‖ ≤ C) + (hcoord : ∃ C : ℝ, 0 ≤ C ∧ ∀ a : ℝ, ‖(a : ℂ) * g a‖ ≤ C) + (hcoord_meas : Measurable (fun a : ℝ => (a : ℂ) * g a)) + (x : H) : + (maximalSpectralIntegral μS) + ⟨boundedIntegral μS g hg hgb x, + boundedMultiplier_mem_spectralSquareMomentDomain_of_bound + (α := ℝ) μS hg hgb hcoord x⟩ = + boundedIntegral μS (fun a : ℝ => (a : ℂ) * g a) hcoord_meas + (by + rcases hcoord with ⟨C, _hC0, hC⟩ + exact ⟨C, hC⟩) x := by + rcases hcoord with ⟨C, hC0, hcoord⟩ + let y : H := boundedIntegral μS g hg hgb x + have hy : y ∈ spectralSquareMomentDomain μS := + boundedMultiplier_mem_spectralSquareMomentDomain_of_bound (α := ℝ) μS hg hgb + ⟨C, hC0, hcoord⟩ x + let fn : ℕ → ℝ → ℂ := fun n a => truncationFunction n a * g a + have hfn : ∀ n, Measurable (fn n) := by + intro n + exact (truncationFunction_measurable n).mul hg + have hfn_bound_C : ∀ n a, ‖fn n a‖ ≤ C := by + intro n a + change ‖truncationFunction n a * g a‖ ≤ C + by_cases ha : a ∈ Set.Icc (-(n : ℝ)) (n : ℝ) + · rw [show truncationFunction n a = (a : ℂ) by + simp [truncationFunction, Set.indicator_of_mem ha]] + exact hcoord a + · simp [truncationFunction, ha, hC0] + have hfn_bound : ∀ n, ∃ C' : ℝ, ∀ a, ‖fn n a‖ ≤ C' := by + intro n + exact ⟨C, hfn_bound_C n⟩ + have hfn_lim : ∀ a : ℝ, Filter.Tendsto (fun n : ℕ => fn n a) + Filter.atTop (𝓝 ((a : ℂ) * g a)) := by + intro a + have htrunc := truncationFunction_tendsto a + exact htrunc.mul (tendsto_const_nhds : + Filter.Tendsto (fun _ : ℕ => g a) Filter.atTop (𝓝 (g a))) + have hconv : Filter.Tendsto + (fun n : ℕ => boundedIntegral μS (fn n) (hfn n) (hfn_bound n) x) + Filter.atTop + (𝓝 (boundedIntegral μS (fun a : ℝ => (a : ℂ) * g a) hcoord_meas + ⟨C, hcoord⟩ x)) := + boundedIntegral_tendsto_of_pointwise_tendsto_of_bound μS x hcoord_meas hfn + ⟨C, hcoord⟩ ⟨C, hfn_bound_C⟩ hfn_lim + have htrunc : Filter.Tendsto + (fun n : ℕ => truncationIntegral μS n y) Filter.atTop + (𝓝 (truncationLimit μS ⟨y, hy⟩)) := + truncationLimit_tendsto μS ⟨y, hy⟩ + have heq : ∀ n, truncationIntegral μS n y = boundedIntegral μS (fn n) + (hfn n) (hfn_bound n) x := by + intro n + have hmul := boundedIntegral_mul μS (truncationFunction_measurable n) hg + (truncationFunction_bounded n) hgb + have happly := congrArg (fun A : H →WOT[ℂ] H => A x) hmul + change truncationIntegral μS n (boundedIntegral μS g hg hgb x) = _ + change truncationIntegral μS n (boundedIntegral μS g hg hgb x) = + boundedIntegral μS (truncationFunction n * g) (hfn n) (hfn_bound n) x + convert happly.symm using 1; + simp [truncationIntegral, ContinuousLinearMapWOT.mul_apply] + have htrunc' : Filter.Tendsto + (fun n : ℕ => boundedIntegral μS (fn n) (hfn n) (hfn_bound n) x) Filter.atTop + (𝓝 (maximalSpectralIntegral μS ⟨y, hy⟩)) := by + change Filter.Tendsto + (fun n : ℕ => boundedIntegral μS (fn n) (hfn n) (hfn_bound n) x) Filter.atTop + (𝓝 (truncationLimit μS ⟨y, hy⟩)) + exact htrunc.congr' (Filter.Eventually.of_forall fun n => heq n) + exact tendsto_nhds_unique htrunc' hconv + +/-! ### The two Cayley resolvents + +These are the bounded multipliers which realize the inverse of the shifts by `± i`. Their +construction is independent of any pre-existing self-adjoint operator; it is purely the real PVM +calculus applied to the scalar functions `(r ± i)⁻¹`. +-/ + +/-- The scalar multiplier `r ↦ (r + i)⁻¹`. -/ +def plusResolventMultiplier (r : ℝ) : ℂ := ((r : ℂ) + Complex.I)⁻¹ + +/-- The scalar multiplier `r ↦ (r - i)⁻¹`. -/ +def minusResolventMultiplier (r : ℝ) : ℂ := ((r : ℂ) - Complex.I)⁻¹ + +/-- The scalar resolvent multiplier at an arbitrary non-real parameter. -/ +def resolventMultiplier (z : ℂ) (r : ℝ) : ℂ := ((r : ℂ) - z)⁻¹ + +lemma resolventMultiplier_measurable (z : ℂ) : + Measurable (resolventMultiplier z) := by + unfold resolventMultiplier + fun_prop + +lemma resolventMultiplier_denom_ne_zero {z : ℂ} (hz : z.im ≠ 0) (r : ℝ) : + (r : ℂ) - z ≠ 0 := by + intro h + have hi := congrArg Complex.im h + exact hz (by simpa using hi) + +lemma resolventMultiplier_bounded {z : ℂ} (hz : z.im ≠ 0) : + ∃ C : ℝ, ∀ r, ‖resolventMultiplier z r‖ ≤ C := by + let d : ℝ := ‖(z.im : ℂ)‖ + have hd : 0 < d := by + dsimp [d] + exact norm_pos_iff.mpr (Complex.ofReal_ne_zero.mpr hz) + refine ⟨d⁻¹, fun r => ?_⟩ + have hden : d ≤ ‖(r : ℂ) - z‖ := by + dsimp [d] + simpa [Complex.norm_real, abs_neg] using + (Complex.abs_im_le_norm ((r : ℂ) - z)) + rw [resolventMultiplier, norm_inv] + exact (inv_le_inv₀ (norm_pos_iff.mpr (resolventMultiplier_denom_ne_zero hz r)) hd).2 hden + +lemma resolventMultiplier_coordinate_bounded {z : ℂ} (hz : z.im ≠ 0) : + ∃ C : ℝ, 0 ≤ C ∧ ∀ r : ℝ, + ‖(r : ℂ) * resolventMultiplier z r‖ ≤ C := by + let d : ℝ := ‖(z.im : ℂ)‖ + have hd : 0 < d := by + dsimp [d] + exact norm_pos_iff.mpr (Complex.ofReal_ne_zero.mpr hz) + refine ⟨1 + ‖z‖ * d⁻¹, by positivity, fun r => ?_⟩ + have hdenpos : 0 < ‖(r : ℂ) - z‖ := + norm_pos_iff.mpr (resolventMultiplier_denom_ne_zero hz r) + have hden : d ≤ ‖(r : ℂ) - z‖ := by + dsimp [d] + simpa [Complex.norm_real, abs_neg] using + (Complex.abs_im_le_norm ((r : ℂ) - z)) + have hr : ‖(r : ℂ)‖ ≤ ‖(r : ℂ) - z‖ + ‖z‖ := by + calc + ‖(r : ℂ)‖ = ‖((r : ℂ) - z) + z‖ := by congr 1; ring + _ ≤ ‖(r : ℂ) - z‖ + ‖z‖ := norm_add_le _ _ + rw [resolventMultiplier, norm_mul, norm_inv] + calc + ‖(r : ℂ)‖ * ‖(↑r - z)‖⁻¹ ≤ + (‖(r : ℂ) - z‖ + ‖z‖) * ‖(↑r - z)‖⁻¹ := + mul_le_mul_of_nonneg_right hr (inv_nonneg.mpr (le_of_lt hdenpos)) + _ = 1 + ‖z‖ / ‖(r : ℂ) - z‖ := by + field_simp + _ ≤ 1 + ‖z‖ * d⁻¹ := by + have hterm : ‖z‖ * ‖(r : ℂ) - z‖⁻¹ ≤ ‖z‖ * d⁻¹ := + mul_le_mul_of_nonneg_left ((inv_le_inv₀ hdenpos hd).2 hden) + (norm_nonneg z) + simpa [div_eq_mul_inv] using add_le_add_left hterm 1 + +lemma resolventMultiplier_coordinate_measurable (z : ℂ) : + Measurable (fun r : ℝ => (r : ℂ) * resolventMultiplier z r) := by + unfold resolventMultiplier + fun_prop + +lemma resolventMultiplier_identity {z : ℂ} (hz : z.im ≠ 0) (r : ℝ) : + (r : ℂ) * resolventMultiplier z r - z * resolventMultiplier z r = 1 := by + unfold resolventMultiplier + rw [← sub_mul] + have hne := resolventMultiplier_denom_ne_zero hz r + exact mul_inv_cancel₀ hne + +lemma plusResolventMultiplier_measurable : + Measurable plusResolventMultiplier := by + unfold plusResolventMultiplier + fun_prop + +lemma minusResolventMultiplier_measurable : + Measurable minusResolventMultiplier := by + unfold minusResolventMultiplier + fun_prop + +lemma plusResolventMultiplier_bounded : + ∃ C : ℝ, ∀ r, ‖plusResolventMultiplier r‖ ≤ C := by + refine ⟨1, fun r => ?_⟩ + have hne : (r : ℂ) + Complex.I ≠ 0 := by + intro h + have hi := congrArg Complex.im h + norm_num at hi + have hpos : 0 < ‖(r : ℂ) + Complex.I‖ := norm_pos_iff.mpr hne + have hden : (1 : ℝ) ≤ ‖(r : ℂ) + Complex.I‖ := by + simpa using Complex.abs_im_le_norm ((r : ℂ) + Complex.I) + rw [plusResolventMultiplier, norm_inv] + exact (inv_le_one₀ hpos).2 hden + +lemma minusResolventMultiplier_bounded : + ∃ C : ℝ, ∀ r, ‖minusResolventMultiplier r‖ ≤ C := by + refine ⟨1, fun r => ?_⟩ + have hne : (r : ℂ) - Complex.I ≠ 0 := by + intro h + have hi := congrArg Complex.im h + norm_num at hi + have hpos : 0 < ‖(r : ℂ) - Complex.I‖ := norm_pos_iff.mpr hne + have hden : (1 : ℝ) ≤ ‖(r : ℂ) - Complex.I‖ := by + simpa using Complex.abs_im_le_norm ((r : ℂ) - Complex.I) + rw [minusResolventMultiplier, norm_inv] + exact (inv_le_one₀ hpos).2 hden + +lemma plusResolventMultiplier_coordinate_bounded : + ∀ r : ℝ, ‖(r : ℂ) * plusResolventMultiplier r‖ ≤ 1 := by + intro r + have hne : (r : ℂ) + Complex.I ≠ 0 := by + intro h + have hi := congrArg Complex.im h + norm_num at hi + have hpos : 0 < ‖(r : ℂ) + Complex.I‖ := norm_pos_iff.mpr hne + have hden : ‖(r : ℂ)‖ ≤ ‖(r : ℂ) + Complex.I‖ := by + simpa using Complex.abs_re_le_norm ((r : ℂ) + Complex.I) + rw [plusResolventMultiplier, norm_mul, norm_inv] + apply (div_le_one hpos).2 + exact hden + +lemma minusResolventMultiplier_coordinate_bounded : + ∀ r : ℝ, ‖(r : ℂ) * minusResolventMultiplier r‖ ≤ 1 := by + intro r + have hne : (r : ℂ) - Complex.I ≠ 0 := by + intro h + have hi := congrArg Complex.im h + norm_num at hi + have hpos : 0 < ‖(r : ℂ) - Complex.I‖ := norm_pos_iff.mpr hne + have hden : ‖(r : ℂ)‖ ≤ ‖(r : ℂ) - Complex.I‖ := by + simpa using Complex.abs_re_le_norm ((r : ℂ) - Complex.I) + rw [minusResolventMultiplier, norm_mul, norm_inv] + apply (div_le_one hpos).2 + exact hden + +lemma plusResolventMultiplier_coordinate_measurable : + Measurable (fun r : ℝ => (r : ℂ) * plusResolventMultiplier r) := by + unfold plusResolventMultiplier + fun_prop + +lemma minusResolventMultiplier_coordinate_measurable : + Measurable (fun r : ℝ => (r : ℂ) * minusResolventMultiplier r) := by + unfold minusResolventMultiplier + fun_prop + +lemma maximalSpectralIntegral_shift_range_of_multiplier + (μS : WOTSpectralMeasure ℝ H) (c : ℂ) {g : ℝ → ℂ} (hg : Measurable g) + (hgb : ∃ C : ℝ, ∀ a, ‖g a‖ ≤ C) + (hcoord : ∀ a : ℝ, ‖(a : ℂ) * g a‖ ≤ 1) + (hcoord_meas : Measurable (fun a : ℝ => (a : ℂ) * g a)) + (hidentity : ∀ a : ℝ, (a : ℂ) * g a + c * g a = 1) : + (maximalSpectralIntegral μS + c • (1 : H →ₗ.[ℂ] H)).toFun.range = ⊤ := by + rw [LinearMap.range_eq_top] + intro x + let y : H := boundedIntegral μS g hg hgb x + have hy : y ∈ spectralSquareMomentDomain μS := + boundedMultiplier_mem_spectralSquareMomentDomain (α := ℝ) μS hg hgb hcoord x + have haction := maximalSpectralIntegral_apply_boundedMultiplier μS hg hgb hcoord + hcoord_meas x + have hgbc : ∃ C : ℝ, ∀ a, ‖c * g a‖ ≤ C := by + rcases hgb with ⟨C, hC⟩ + refine ⟨‖c‖ * C, fun a => ?_⟩ + rw [norm_mul] + exact mul_le_mul_of_nonneg_left (hC a) (norm_nonneg c) + have hg_c : Measurable (fun a : ℝ => c * g a) := measurable_const.mul hg + have hadd := boundedIntegral_add μS hcoord_meas hg_c + (⟨1, hcoord⟩) hgbc + have hsmul := boundedIntegral_smul μS c hg hgb + have hsum_bound : ∃ C : ℝ, ∀ a : ℝ, ‖(a : ℂ) * g a + c * g a‖ ≤ C := by + rcases hgbc with ⟨C, hC⟩ + refine ⟨1 + C, fun a => ?_⟩ + exact (norm_add_le _ _).trans (add_le_add (hcoord a) (hC a)) + have hsum : boundedIntegral μS (fun a : ℝ => (a : ℂ) * g a) + hcoord_meas ⟨1, hcoord⟩ x + c • y = x := by + calc + _ = boundedIntegral μS (fun a : ℝ => (a : ℂ) * g a) + hcoord_meas ⟨1, hcoord⟩ x + + boundedIntegral μS (fun a : ℝ => c * g a) hg_c hgbc x := by + rw [hsmul] + simp [y, ContinuousLinearMapWOT.smul_apply] + _ = boundedIntegral μS + ((fun a : ℝ => (a : ℂ) * g a) + (fun a : ℝ => c * g a)) + (hcoord_meas.add hg_c) _ x := by + rw [hadd] + simp [ContinuousLinearMapWOT.add_apply] + _ = boundedIntegral μS (fun _ : ℝ => (1 : ℂ)) measurable_const + (⟨1, fun _ => by simp⟩) x := by + have hcongr := boundedIntegral_congr μS (hcoord_meas.add hg_c) measurable_const + hsum_bound (⟨1, fun _ => norm_one.le⟩) + (fun a => by simp only [Pi.add_apply]; exact hidentity a) + exact congrArg (fun A : H →WOT[ℂ] H => A x) hcongr + _ = x := by + rw [boundedIntegral_const] + simp [ContinuousLinearMapWOT.one_apply] + let yz : (maximalSpectralIntegral μS + c • (1 : H →ₗ.[ℂ] H)).domain := + ⟨y, Submodule.mem_inf.mpr ⟨hy, Submodule.mem_top⟩⟩ + refine ⟨yz, ?_⟩ + change (maximalSpectralIntegral μS) ⟨y, hy⟩ + c • y = x + rw [haction] + exact hsum + +lemma maximalSpectralIntegral_shift_range_of_multiplier_of_bound + (μS : WOTSpectralMeasure ℝ H) (c : ℂ) {g : ℝ → ℂ} (hg : Measurable g) + (hgb : ∃ C : ℝ, ∀ a, ‖g a‖ ≤ C) + (hcoord : ∃ C : ℝ, 0 ≤ C ∧ ∀ a : ℝ, ‖(a : ℂ) * g a‖ ≤ C) + (hcoord_meas : Measurable (fun a : ℝ => (a : ℂ) * g a)) + (hidentity : ∀ a : ℝ, (a : ℂ) * g a + c * g a = 1) : + (maximalSpectralIntegral μS + c • (1 : H →ₗ.[ℂ] H)).toFun.range = ⊤ := by + rcases hcoord with ⟨C, hC0, hcoord⟩ + rw [LinearMap.range_eq_top] + intro x + let y : H := boundedIntegral μS g hg hgb x + have hy : y ∈ spectralSquareMomentDomain μS := + boundedMultiplier_mem_spectralSquareMomentDomain_of_bound (α := ℝ) μS hg hgb + ⟨C, hC0, hcoord⟩ x + have haction := maximalSpectralIntegral_apply_boundedMultiplier_of_bound μS hg hgb + ⟨C, hC0, hcoord⟩ hcoord_meas x + have hgbc : ∃ C' : ℝ, ∀ a, ‖c * g a‖ ≤ C' := by + rcases hgb with ⟨Cg, hCg⟩ + refine ⟨‖c‖ * Cg, fun a => ?_⟩ + rw [norm_mul] + exact mul_le_mul_of_nonneg_left (hCg a) (norm_nonneg c) + have hg_c : Measurable (fun a : ℝ => c * g a) := measurable_const.mul hg + have hadd := boundedIntegral_add μS hcoord_meas hg_c + (⟨C, hcoord⟩) hgbc + have hsmul := boundedIntegral_smul μS c hg hgb + have hsum_bound : ∃ C' : ℝ, ∀ a : ℝ, + ‖(a : ℂ) * g a + c * g a‖ ≤ C' := by + rcases hgbc with ⟨Cc, hCc⟩ + refine ⟨C + Cc, fun a => ?_⟩ + exact (norm_add_le _ _).trans (add_le_add (hcoord a) (hCc a)) + have hsum : boundedIntegral μS (fun a : ℝ => (a : ℂ) * g a) + hcoord_meas ⟨C, hcoord⟩ x + c • y = x := by + calc + _ = boundedIntegral μS (fun a : ℝ => (a : ℂ) * g a) + hcoord_meas ⟨C, hcoord⟩ x + + boundedIntegral μS (fun a : ℝ => c * g a) hg_c hgbc x := by + rw [hsmul] + simp [y, ContinuousLinearMapWOT.smul_apply] + _ = boundedIntegral μS + ((fun a : ℝ => (a : ℂ) * g a) + (fun a : ℝ => c * g a)) + (hcoord_meas.add hg_c) _ x := by + rw [hadd] + simp [ContinuousLinearMapWOT.add_apply] + _ = boundedIntegral μS (fun _ : ℝ => (1 : ℂ)) measurable_const + (⟨1, fun _ => by simp⟩) x := by + have hcongr := boundedIntegral_congr μS (hcoord_meas.add hg_c) measurable_const + hsum_bound (⟨1, fun _ => norm_one.le⟩) + (fun a => by simp only [Pi.add_apply]; exact hidentity a) + exact congrArg (fun A : H →WOT[ℂ] H => A x) hcongr + _ = x := by + rw [boundedIntegral_const] + simp [ContinuousLinearMapWOT.one_apply] + let yz : (maximalSpectralIntegral μS + c • (1 : H →ₗ.[ℂ] H)).domain := + ⟨y, Submodule.mem_inf.mpr ⟨hy, Submodule.mem_top⟩⟩ + refine ⟨yz, ?_⟩ + change (maximalSpectralIntegral μS) ⟨y, hy⟩ + c • y = x + rw [haction] + exact hsum + +/-- Every non-real shift of the canonical spectral integral is onto. This is the concrete range +form of the resolvent theorem, proved directly from the bounded scalar multiplier +`r ↦ (r - z)⁻¹`. -/ +lemma maximalSpectralIntegral_resolvent_range {z : ℂ} (hz : z.im ≠ 0) : + (maximalSpectralIntegral μS - z • (1 : H →ₗ.[ℂ] H)).toFun.range = ⊤ := by + have hidentity : ∀ r : ℝ, + (r : ℂ) * resolventMultiplier z r + (-z) * resolventMultiplier z r = 1 := by + intro r + simpa [neg_mul, sub_eq_add_neg] using resolventMultiplier_identity hz r + have hplus : (maximalSpectralIntegral μS + (-z) • (1 : H →ₗ.[ℂ] H)).toFun.range = ⊤ := + maximalSpectralIntegral_shift_range_of_multiplier_of_bound μS (-z) + (resolventMultiplier_measurable z) (resolventMultiplier_bounded hz) + (resolventMultiplier_coordinate_bounded hz) + (resolventMultiplier_coordinate_measurable z) hidentity + have heq : maximalSpectralIntegral μS - z • (1 : H →ₗ.[ℂ] H) = + maximalSpectralIntegral μS + (-z) • (1 : H →ₗ.[ℂ] H) := by + exact LinearPMap.ext rfl fun x hx₁ hx₂ => by + simp only [LinearPMap.sub_apply, LinearPMap.add_apply, LinearPMap.smul_apply, + neg_smul] + module + rw [heq] + exact hplus + +/-- The value of the inverse of a general non-real shift is the corresponding bounded spectral +multiplier. This is the operator-level resolvent formula, including its domain proof. -/ +lemma maximalSpectralIntegral_resolvent_inverse_apply {z : ℂ} (hz : z.im ≠ 0) (x : H) : + (maximalSpectralIntegral μS - z • (1 : H →ₗ.[ℂ] H)).inverse + ⟨x, by + rw [LinearPMap.inverse_domain, maximalSpectralIntegral_resolvent_range hz] + exact Submodule.mem_top⟩ = + boundedIntegral μS (resolventMultiplier z) (resolventMultiplier_measurable z) + (resolventMultiplier_bounded hz) x := by + let M := maximalSpectralIntegral μS + let g := resolventMultiplier z + have htarget := maximalSpectralIntegral_resolvent_range (μS := μS) hz + have hself : IsSelfAdjoint M := by + apply maximalSpectralIntegral_isSelfAdjoint_of_range_eq_top μS + · have h := maximalSpectralIntegral_resolvent_range + (μS := μS) (z := -Complex.I) (by norm_num) + have heq : M + Complex.I • (1 : H →ₗ.[ℂ] H) = + M - (-Complex.I) • (1 : H →ₗ.[ℂ] H) := by + exact LinearPMap.ext rfl fun y hy₁ hy₂ => by + simp only [LinearPMap.sub_apply, LinearPMap.add_apply, LinearPMap.smul_apply, + neg_smul] + module + change (M + Complex.I • (1 : H →ₗ.[ℂ] H)).toFun.range = ⊤ + rw [heq] + exact h + · simpa [M] using (maximalSpectralIntegral_resolvent_range + (μS := μS) (z := Complex.I) (by norm_num)) + have hker : (M - z • (1 : H →ₗ.[ℂ] H)).toFun.ker = ⊥ := by + have hres := LinearPMap.IsSelfAdjoint.mem_resolventSet_of_im_ne_zero + hself hz + exact hres.1 + have hcoord := resolventMultiplier_coordinate_bounded hz + have hy : boundedIntegral μS g (resolventMultiplier_measurable z) + (resolventMultiplier_bounded hz) x ∈ + spectralSquareMomentDomain μS := + boundedMultiplier_mem_spectralSquareMomentDomain_of_bound (α := ℝ) μS + (resolventMultiplier_measurable z) (resolventMultiplier_bounded hz) hcoord x + let yM : M.domain := + ⟨boundedIntegral μS g (resolventMultiplier_measurable z) + (resolventMultiplier_bounded hz) x, by + change boundedIntegral μS g (resolventMultiplier_measurable z) + (resolventMultiplier_bounded hz) x ∈ + spectralSquareMomentDomain μS + exact hy⟩ + let y : (M - z • (1 : H →ₗ.[ℂ] H)).domain := + ⟨(yM : H), Submodule.mem_inf.mpr ⟨hy, Submodule.mem_top⟩⟩ + have haction := maximalSpectralIntegral_apply_boundedMultiplier_of_bound μS + (resolventMultiplier_measurable z) (resolventMultiplier_bounded hz) hcoord + (resolventMultiplier_coordinate_measurable z) x + have hzg_bound : ∃ C : ℝ, ∀ r : ℝ, + ‖z * g r‖ ≤ C := by + rcases resolventMultiplier_bounded hz with ⟨C, hC⟩ + refine ⟨‖z‖ * C, fun r => ?_⟩ + rw [norm_mul] + exact mul_le_mul_of_nonneg_left (hC r) (norm_nonneg z) + have hsum : (M - z • (1 : H →ₗ.[ℂ] H)) y = x := by + change M yM - z • (y : H) = x + have hscaled : z • (y : H) = + boundedIntegral μS (fun r : ℝ => z * g r) + (measurable_const.mul (resolventMultiplier_measurable z)) hzg_bound x := by + have h := congrArg (fun A : H →WOT[ℂ] H => A x) + (boundedIntegral_smul μS z (resolventMultiplier_measurable z) + (resolventMultiplier_bounded hz)) + simpa [y, yM, Pi.mul_apply] using h.symm + rw [haction, hscaled] + have hsub := boundedIntegral_sub μS + (f := fun r : ℝ => (r : ℂ) * g r) + (g := fun r : ℝ => z * g r) + (resolventMultiplier_coordinate_measurable z) + (measurable_const.mul (resolventMultiplier_measurable z)) + (by rcases hcoord with ⟨C, hC0, hC⟩; exact ⟨C, hC⟩) hzg_bound + have hsubx := congrArg (fun A : H →WOT[ℂ] H => A x) hsub + rw [← ContinuousLinearMapWOT.sub_apply, ← hsubx] + have hcongr : ∀ r : ℝ, + (r : ℂ) * g r - z * g r = (1 : ℂ) := by + intro r + exact resolventMultiplier_identity hz r + have hfunit : Measurable (fun r : ℝ => (r : ℂ) * g r - z * g r) := by + exact (resolventMultiplier_coordinate_measurable z).sub + (measurable_const.mul (resolventMultiplier_measurable z)) + have hbunit : ∃ C : ℝ, ∀ r : ℝ, + ‖(r : ℂ) * g r - z * g r‖ ≤ C := by + rcases hcoord with ⟨C, hC0, hC⟩ + rcases hzg_bound with ⟨Cz, hCz⟩ + refine ⟨C + Cz, fun r => ?_⟩ + exact (norm_sub_le _ _).trans (add_le_add (hC r) (hCz r)) + have hunit : boundedIntegral μS + ((fun r : ℝ => (r : ℂ) * g r) - (fun r : ℝ => z * g r)) + ((resolventMultiplier_coordinate_measurable z).sub + (measurable_const.mul (resolventMultiplier_measurable z))) hbunit = + boundedIntegral μS (fun _ : ℝ => (1 : ℂ)) measurable_const + ⟨1, fun _ => by simp⟩ := by + apply boundedIntegral_congr + intro r + simpa [Pi.sub_apply] using hcongr r + have hunitx := congrArg (fun A : H →WOT[ℂ] H => A x) hunit + convert hunitx using 1 + simp only [boundedIntegral_const] + simp only [one_smul, ContinuousLinearMapWOT.one_apply] + let x' : (M - z • (1 : H →ₗ.[ℂ] H)).inverse.domain := + ⟨x, by + rw [LinearPMap.inverse_domain, htarget] + exact Submodule.mem_top⟩ + have hxy : (M - z • (1 : H →ₗ.[ℂ] H)) y = x' := by + simpa [x'] using hsum + exact LinearPMap.inverse_apply_eq hker hxy + +lemma maximalSpectralIntegral_plus_resolvent_range : + (maximalSpectralIntegral μS + Complex.I • (1 : H →ₗ.[ℂ] H)).toFun.range = ⊤ := by + have hidentity : ∀ a : ℝ, + (a : ℂ) * plusResolventMultiplier a + Complex.I * plusResolventMultiplier a = 1 := by + intro a + unfold plusResolventMultiplier + have hne : (a : ℂ) + Complex.I ≠ 0 := by + intro h + have hi := congrArg Complex.im h + norm_num at hi + calc + (a : ℂ) * ((a : ℂ) + Complex.I)⁻¹ + Complex.I * + ((a : ℂ) + Complex.I)⁻¹ = + ((a : ℂ) + Complex.I) * ((a : ℂ) + Complex.I)⁻¹ := by ring + _ = 1 := mul_inv_cancel₀ hne + exact maximalSpectralIntegral_shift_range_of_multiplier μS Complex.I + plusResolventMultiplier_measurable plusResolventMultiplier_bounded + plusResolventMultiplier_coordinate_bounded + plusResolventMultiplier_coordinate_measurable hidentity + +lemma maximalSpectralIntegral_minus_resolvent_range : + (maximalSpectralIntegral μS - Complex.I • (1 : H →ₗ.[ℂ] H)).toFun.range = ⊤ := by + have hidentity : ∀ a : ℝ, + (a : ℂ) * minusResolventMultiplier a + (-Complex.I) * minusResolventMultiplier a = 1 := by + intro a + unfold minusResolventMultiplier + have hne : (a : ℂ) - Complex.I ≠ 0 := by + intro h + have hi := congrArg Complex.im h + norm_num at hi + calc + (a : ℂ) * ((a : ℂ) - Complex.I)⁻¹ + (-Complex.I) * + ((a : ℂ) - Complex.I)⁻¹ = + ((a : ℂ) - Complex.I) * ((a : ℂ) - Complex.I)⁻¹ := by ring + _ = 1 := mul_inv_cancel₀ hne + have hplus : (maximalSpectralIntegral μS + (-Complex.I) • + (1 : H →ₗ.[ℂ] H)).toFun.range = ⊤ := + maximalSpectralIntegral_shift_range_of_multiplier μS (-Complex.I) + minusResolventMultiplier_measurable minusResolventMultiplier_bounded + minusResolventMultiplier_coordinate_bounded + minusResolventMultiplier_coordinate_measurable hidentity + have heq : maximalSpectralIntegral μS - Complex.I • (1 : H →ₗ.[ℂ] H) = + maximalSpectralIntegral μS + (-Complex.I) • (1 : H →ₗ.[ℂ] H) := by + exact LinearPMap.ext rfl fun x hx₁ hx₂ => by + simp only [LinearPMap.sub_apply, LinearPMap.add_apply, LinearPMap.smul_apply, + neg_smul] + module + rw [heq] + exact hplus + +/-! ### Resolvent values of the maximal realization + +The range statements above show that the two shifted maximal realizations are onto. The +following sharpen them to an actual value formula for their partial inverses. This is the +operator-level form of the bounded Borel identities + +`(λ + i)⁻¹ (λ + i) = 1` and `(λ - i)⁻¹ (λ - i) = 1`. + +These lemmas are intentionally stated for `LinearPMap.inverse`: they do not introduce a second +unbounded-operator hierarchy, and they are exactly what the Cayley adapter needs when converting +between a self-adjoint operator and its bounded unitary transform. -/ + +lemma maximalSpectralIntegral_plus_resolvent_inverse_apply (x : H) : + (maximalSpectralIntegral μS + Complex.I • (1 : H →ₗ.[ℂ] H)).inverse + ⟨x, by + rw [LinearPMap.inverse_domain, maximalSpectralIntegral_plus_resolvent_range] + exact Submodule.mem_top⟩ = + boundedIntegral μS plusResolventMultiplier plusResolventMultiplier_measurable + plusResolventMultiplier_bounded x := by + let M := maximalSpectralIntegral μS + let g := plusResolventMultiplier + have hker : (M + Complex.I • (1 : H →ₗ.[ℂ] H)).toFun.ker = ⊥ := by + have hres := LinearPMap.IsSelfAdjoint.mem_resolventSet_of_im_ne_zero + (maximalSpectralIntegral_isSelfAdjoint_of_range_eq_top μS + (maximalSpectralIntegral_plus_resolvent_range (μS := μS)) + (maximalSpectralIntegral_minus_resolvent_range (μS := μS))) + (z := -Complex.I) (by norm_num) + have heq : M - (-Complex.I) • (1 : H →ₗ.[ℂ] H) = + M + Complex.I • (1 : H →ₗ.[ℂ] H) := by + exact LinearPMap.ext rfl fun y hy₁ hy₂ => by + simp [LinearPMap.sub_apply, LinearPMap.add_apply, LinearPMap.smul_apply, + neg_smul] + rw [← heq] + exact hres.1 + have hy : boundedIntegral μS g plusResolventMultiplier_measurable + plusResolventMultiplier_bounded x ∈ + spectralSquareMomentDomain μS := + boundedMultiplier_mem_spectralSquareMomentDomain (α := ℝ) μS + plusResolventMultiplier_measurable plusResolventMultiplier_bounded + plusResolventMultiplier_coordinate_bounded x + let yM : M.domain := ⟨boundedIntegral μS g plusResolventMultiplier_measurable + plusResolventMultiplier_bounded x, hy⟩ + let y : (M + Complex.I • (1 : H →ₗ.[ℂ] H)).domain := + ⟨(yM : H), Submodule.mem_inf.mpr ⟨hy, Submodule.mem_top⟩⟩ + have haction := maximalSpectralIntegral_apply_boundedMultiplier μS + plusResolventMultiplier_measurable plusResolventMultiplier_bounded + plusResolventMultiplier_coordinate_bounded + plusResolventMultiplier_coordinate_measurable x + have hIbound : ∃ C : ℝ, ∀ a : ℝ, ‖Complex.I * g a‖ ≤ C := by + rcases plusResolventMultiplier_bounded with ⟨C, hC⟩ + refine ⟨C, fun a => ?_⟩ + simpa [norm_mul] using hC a + have hsum : (M + Complex.I • (1 : H →ₗ.[ℂ] H)) y = x := by + change M yM + Complex.I • (y : H) = x + have hscaled : Complex.I • (y : H) = + boundedIntegral μS (fun a : ℝ => Complex.I * g a) + (measurable_const.mul plusResolventMultiplier_measurable) hIbound x := by + have h := congrArg (fun A : H →WOT[ℂ] H => A x) + (boundedIntegral_smul μS Complex.I plusResolventMultiplier_measurable + plusResolventMultiplier_bounded) + simpa [y, yM, Pi.mul_apply] using h.symm + rw [haction, hscaled] + have hadd := boundedIntegral_add μS + (f := fun a : ℝ => (a : ℂ) * g a) + (g := fun a : ℝ => Complex.I * g a) + plusResolventMultiplier_coordinate_measurable + (measurable_const.mul plusResolventMultiplier_measurable) + (⟨1, plusResolventMultiplier_coordinate_bounded⟩) hIbound + have haddx := congrArg (fun A : H →WOT[ℂ] H => A x) hadd + rw [← ContinuousLinearMapWOT.add_apply, ← haddx] + have hcongr : ∀ a : ℝ, (a : ℂ) * g a + Complex.I * g a = (1 : ℂ) := by + intro a + unfold g plusResolventMultiplier + have hne : (a : ℂ) + Complex.I ≠ 0 := by + intro h + have hi := congrArg Complex.im h + norm_num at hi + field_simp [hne] + have hfunit : Measurable (fun a : ℝ => (a : ℂ) * g a + Complex.I * g a) := by + have heqfun : + ((fun a : ℝ => (a : ℂ) * plusResolventMultiplier a) + + (fun a : ℝ => Complex.I * plusResolventMultiplier a)) = + (fun a : ℝ => (a : ℂ) * plusResolventMultiplier a + + Complex.I * plusResolventMultiplier a) := by + funext a + rfl + change Measurable (fun a : ℝ => (a : ℂ) * plusResolventMultiplier a + + Complex.I * plusResolventMultiplier a) + rw [← heqfun] + exact plusResolventMultiplier_coordinate_measurable.add + (measurable_const.mul plusResolventMultiplier_measurable) + have hbunit : ∃ C : ℝ, ∀ a : ℝ, + ‖(fun a : ℝ => (a : ℂ) * g a + Complex.I * g a) a‖ ≤ C := by + rcases plusResolventMultiplier_bounded with ⟨C, hC⟩ + refine ⟨1 + C, fun a => ?_⟩ + exact (norm_add_le _ _).trans (add_le_add + (by simpa [g] using plusResolventMultiplier_coordinate_bounded a) + (by simpa [g, norm_mul] using hC a)) + have hunit : + boundedIntegral μS (fun a : ℝ => (a : ℂ) * g a + Complex.I * g a) + hfunit hbunit = + boundedIntegral μS (fun _ : ℝ => (1 : ℂ)) measurable_const + ⟨1, fun _ => by simp⟩ := by + apply boundedIntegral_congr + exact fun a => hcongr a + have hsumfun : + (fun a : ℝ => (a : ℂ) * g a) + (fun a : ℝ => Complex.I * g a) = + (fun a : ℝ => (a : ℂ) * g a + Complex.I * g a) := by + funext a + simp [Pi.add_apply] + have hunitx := congrArg (fun A : H →WOT[ℂ] H => A x) hunit + convert hunitx using 1 <;> + simp only [hsumfun, boundedIntegral_const] + simp [ContinuousLinearMapWOT.one_apply] + let x' : (M + Complex.I • (1 : H →ₗ.[ℂ] H)).inverse.domain := + ⟨x, by + rw [LinearPMap.inverse_domain, maximalSpectralIntegral_plus_resolvent_range] + exact Submodule.mem_top⟩ + have hxy : (M + Complex.I • (1 : H →ₗ.[ℂ] H)) y = x' := by + simpa [x'] using hsum + exact LinearPMap.inverse_apply_eq hker hxy + +lemma maximalSpectralIntegral_minus_resolvent_inverse_apply (x : H) : + (maximalSpectralIntegral μS - Complex.I • (1 : H →ₗ.[ℂ] H)).inverse + ⟨x, by + rw [LinearPMap.inverse_domain, maximalSpectralIntegral_minus_resolvent_range] + exact Submodule.mem_top⟩ = + boundedIntegral μS minusResolventMultiplier minusResolventMultiplier_measurable + minusResolventMultiplier_bounded x := by + let M := maximalSpectralIntegral μS + let g := minusResolventMultiplier + have hker : (M - Complex.I • (1 : H →ₗ.[ℂ] H)).toFun.ker = ⊥ := by + have hres := LinearPMap.IsSelfAdjoint.mem_resolventSet_of_im_ne_zero + (maximalSpectralIntegral_isSelfAdjoint_of_range_eq_top μS + (maximalSpectralIntegral_plus_resolvent_range (μS := μS)) + (maximalSpectralIntegral_minus_resolvent_range (μS := μS))) + (z := Complex.I) (by norm_num) + exact hres.1 + have hy : boundedIntegral μS g minusResolventMultiplier_measurable + minusResolventMultiplier_bounded x ∈ + spectralSquareMomentDomain μS := + boundedMultiplier_mem_spectralSquareMomentDomain (α := ℝ) μS + minusResolventMultiplier_measurable minusResolventMultiplier_bounded + minusResolventMultiplier_coordinate_bounded x + let yM : M.domain := ⟨boundedIntegral μS g minusResolventMultiplier_measurable + minusResolventMultiplier_bounded x, hy⟩ + let y : (M - Complex.I • (1 : H →ₗ.[ℂ] H)).domain := + ⟨(yM : H), Submodule.mem_inf.mpr ⟨hy, Submodule.mem_top⟩⟩ + have haction := maximalSpectralIntegral_apply_boundedMultiplier μS + minusResolventMultiplier_measurable minusResolventMultiplier_bounded + minusResolventMultiplier_coordinate_bounded + minusResolventMultiplier_coordinate_measurable x + have hIbound : ∃ C : ℝ, ∀ a : ℝ, ‖Complex.I * g a‖ ≤ C := by + rcases minusResolventMultiplier_bounded with ⟨C, hC⟩ + refine ⟨C, fun a => ?_⟩ + simpa [norm_mul] using hC a + have hsum : (M - Complex.I • (1 : H →ₗ.[ℂ] H)) y = x := by + change M yM - Complex.I • (y : H) = x + have hscaled : Complex.I • (y : H) = + boundedIntegral μS (fun a : ℝ => Complex.I * g a) + (measurable_const.mul minusResolventMultiplier_measurable) hIbound x := by + have h := congrArg (fun A : H →WOT[ℂ] H => A x) + (boundedIntegral_smul μS Complex.I minusResolventMultiplier_measurable + minusResolventMultiplier_bounded) + simpa [y, yM, Pi.mul_apply] using h.symm + rw [haction, hscaled] + have hadd := boundedIntegral_sub μS + (f := fun a : ℝ => (a : ℂ) * g a) + (g := fun a : ℝ => Complex.I * g a) + minusResolventMultiplier_coordinate_measurable + (measurable_const.mul minusResolventMultiplier_measurable) + (⟨1, minusResolventMultiplier_coordinate_bounded⟩) hIbound + have haddx := congrArg (fun A : H →WOT[ℂ] H => A x) hadd + rw [← ContinuousLinearMapWOT.sub_apply, ← haddx] + have hcongr : ∀ a : ℝ, (a : ℂ) * g a - Complex.I * g a = (1 : ℂ) := by + intro a + unfold g minusResolventMultiplier + have hne : (a : ℂ) - Complex.I ≠ 0 := by + intro h + have hi := congrArg Complex.im h + norm_num at hi + field_simp [hne] + have hfunit : Measurable (fun a : ℝ => (a : ℂ) * g a - Complex.I * g a) := by + have heqfun : + ((fun a : ℝ => (a : ℂ) * minusResolventMultiplier a) - + (fun a : ℝ => Complex.I * minusResolventMultiplier a)) = + (fun a : ℝ => (a : ℂ) * minusResolventMultiplier a - + Complex.I * minusResolventMultiplier a) := by + funext a + rfl + change Measurable (fun a : ℝ => (a : ℂ) * minusResolventMultiplier a - + Complex.I * minusResolventMultiplier a) + rw [← heqfun] + exact minusResolventMultiplier_coordinate_measurable.sub + (measurable_const.mul minusResolventMultiplier_measurable) + have hbunit : ∃ C : ℝ, ∀ a : ℝ, + ‖(fun a : ℝ => (a : ℂ) * g a - Complex.I * g a) a‖ ≤ C := by + rcases minusResolventMultiplier_bounded with ⟨C, hC⟩ + refine ⟨1 + C, fun a => ?_⟩ + exact (norm_sub_le _ _).trans (add_le_add + (by simpa [g] using minusResolventMultiplier_coordinate_bounded a) + (by simpa [g, norm_mul] using hC a)) + have hunit : + boundedIntegral μS (fun a : ℝ => (a : ℂ) * g a - Complex.I * g a) + hfunit hbunit = + boundedIntegral μS (fun _ : ℝ => (1 : ℂ)) measurable_const + ⟨1, fun _ => by simp⟩ := by + apply boundedIntegral_congr + exact fun a => hcongr a + have hsubfun : + (fun a : ℝ => (a : ℂ) * g a) - (fun a : ℝ => Complex.I * g a) = + (fun a : ℝ => (a : ℂ) * g a - Complex.I * g a) := by + funext a + simp [Pi.sub_apply] + have hunitx := congrArg (fun A : H →WOT[ℂ] H => A x) hunit + convert hunitx using 1 <;> + simp only [hsubfun, boundedIntegral_const] + simp [ContinuousLinearMapWOT.one_apply] + let x' : (M - Complex.I • (1 : H →ₗ.[ℂ] H)).inverse.domain := + ⟨x, by + rw [LinearPMap.inverse_domain, maximalSpectralIntegral_minus_resolvent_range] + exact Submodule.mem_top⟩ + have hxy : (M - Complex.I • (1 : H →ₗ.[ℂ] H)) y = x' := by + simpa [x'] using hsum + exact LinearPMap.inverse_apply_eq hker hxy + +/-! ### The canonical self-adjoint realization + +The preceding two range lemmas are the concrete Cayley-resolvent calculation. They are worth +keeping separate from the abstract range criterion: this theorem is the point at which a real PVM +itself produces a self-adjoint (closed) unbounded operator, with no prior operator or domain datum. +-/ + +lemma maximalSpectralIntegral_isSelfAdjoint (μS : WOTSpectralMeasure ℝ H) : + IsSelfAdjoint (maximalSpectralIntegral μS) := by + apply maximalSpectralIntegral_isSelfAdjoint_of_range_eq_top μS + · exact maximalSpectralIntegral_plus_resolvent_range (μS := μS) + · exact maximalSpectralIntegral_minus_resolvent_range (μS := μS) + +/-- The canonical maximal realization has a surjective shifted operator at every non-real +spectral parameter. The preceding explicit `± Complex.I` calculations establish +self-adjointness; this general form then follows from the self-adjoint resolvent theorem. -/ +lemma maximalSpectralIntegral_sub_smul_surjective + (μS : WOTSpectralMeasure ℝ H) {z : ℂ} (hz : z.im ≠ 0) : + Function.Surjective + (maximalSpectralIntegral μS - z • (1 : H →ₗ.[ℂ] H)).toFun := + LinearPMap.IsSelfAdjoint.sub_smul_surjective + (maximalSpectralIntegral_isSelfAdjoint μS) hz + +/-- Every non-real point belongs to the resolvent set of the canonical maximal spectral +integral. This is the public `resolventSet` form of the preceding range theorem and the +self-adjoint resolvent criterion; downstream users can therefore use the ordinary resolvent API +without unpacking the Cayley shifts or the spectral multiplier construction. -/ +lemma maximalSpectralIntegral_mem_resolventSet + (μS : WOTSpectralMeasure ℝ H) {z : ℂ} (hz : z.im ≠ 0) : + z ∈ LinearPMap.resolventSet (maximalSpectralIntegral μS) := + LinearPMap.IsSelfAdjoint.mem_resolventSet_of_im_ne_zero + (maximalSpectralIntegral_isSelfAdjoint μS) hz + +/-- Resolvent notation for the canonical spectral integral is exactly the bounded spectral +multiplier `λ ↦ (λ - z)⁻¹`. The subtype in the left-hand side is the canonical full-domain +element supplied by the resolvent theorem. -/ +lemma maximalSpectralIntegral_resolvent_apply {z : ℂ} (hz : z.im ≠ 0) (x : H) : + LinearPMap.resolvent (maximalSpectralIntegral μS) z + ⟨x, by + rw [LinearPMap.inverse_domain, maximalSpectralIntegral_resolvent_range hz] + exact Submodule.mem_top⟩ = + boundedIntegral μS (resolventMultiplier z) (resolventMultiplier_measurable z) + (resolventMultiplier_bounded hz) x := + maximalSpectralIntegral_resolvent_inverse_apply hz x + +lemma maximalSpectralIntegral_closure_eq_self_adjoint (μS : WOTSpectralMeasure ℝ H) : + (maximalSpectralIntegral μS).closure = maximalSpectralIntegral μS := by + exact (maximalSpectralIntegral_isSelfAdjoint μS).isClosed.closure_eq + +lemma maximalSpectralIntegral_isEssentiallySelfAdjoint (μS : WOTSpectralMeasure ℝ H) : + (maximalSpectralIntegral μS).IsEssentiallySelfAdjoint := by + rw [maximalSpectralIntegral_isEssentiallySelfAdjoint_iff] + rw [maximalSpectralIntegral_closure_eq_self_adjoint μS] + exact maximalSpectralIntegral_isSelfAdjoint μS + +lemma measurableSpectralIntegral_isSelfAdjoint + (μS : WOTSpectralMeasure ℝ H) (f : ℝ → ℝ) (hf : Measurable f) : + _root_.IsSelfAdjoint (measurableSpectralIntegral μS f hf) := by + exact maximalSpectralIntegral_isSelfAdjoint (μS.map f hf) + +lemma measurableSpectralIntegral_closure_eq_self + (μS : WOTSpectralMeasure ℝ H) (f : ℝ → ℝ) (hf : Measurable f) : + (measurableSpectralIntegral μS f hf).closure = + measurableSpectralIntegral μS f hf := by + exact (measurableSpectralIntegral_isSelfAdjoint μS f hf).isClosed.closure_eq + +lemma measurableSpectralIntegral_isEssentiallySelfAdjoint + (μS : WOTSpectralMeasure ℝ H) (f : ℝ → ℝ) (hf : Measurable f) : + (measurableSpectralIntegral μS f hf).IsEssentiallySelfAdjoint := by + exact maximalSpectralIntegral_isEssentiallySelfAdjoint (μS.map f hf) + +lemma measurableSpectralIntegral_norm_sq + (μS : WOTSpectralMeasure ℝ H) (f : ℝ → ℝ) (hf : Measurable f) + (x : H) (hx : x ∈ (measurableSpectralIntegral μS f hf).domain) : + ENNReal.ofReal + (‖(measurableSpectralIntegral μS f hf) ⟨x, hx⟩‖ ^ 2) = + ∫⁻ r, ENNReal.ofReal ((f r) ^ 2) ∂μS.diagonalMeasure x := by + have h := maximalSpectralIntegral_norm_sq (μS.map f hf) x hx + rw [μS.diagonalMeasure_map f hf] at h + calc + ENNReal.ofReal + (‖(measurableSpectralIntegral μS f hf) ⟨x, hx⟩‖ ^ 2) = + ∫⁻ r, ENNReal.ofReal (r ^ 2) ∂Measure.map f (μS.diagonalMeasure x) := h + _ = ∫⁻ r, ENNReal.ofReal ((f r) ^ 2) ∂μS.diagonalMeasure x := by + simpa [Function.comp_def] using + (lintegral_map (μ := μS.diagonalMeasure x) + (ENNReal.continuous_ofReal.measurable.comp (measurable_id.pow_const 2)) hf) + +lemma measurableSpectralIntegral_norm_sq_eq_integral + (μS : WOTSpectralMeasure ℝ H) (f : ℝ → ℝ) (hf : Measurable f) + (x : H) (hx : x ∈ (measurableSpectralIntegral μS f hf).domain) : + ‖(measurableSpectralIntegral μS f hf) ⟨x, hx⟩‖ ^ 2 = + ∫ r, f r ^ 2 ∂μS.diagonalMeasure x := by + have hfi : Integrable (fun r : ℝ => f r ^ 2) (μS.diagonalMeasure x) := by + exact (mem_measurableSpectralIntegral_domain_iff μS f hf x).mp hx + have hpos : 0 ≤ᵐ[μS.diagonalMeasure x] (fun r : ℝ => f r ^ 2) := + Filter.Eventually.of_forall (fun r => sq_nonneg (f r)) + have hconvert : ENNReal.ofReal (∫ r, f r ^ 2 ∂μS.diagonalMeasure x) = + ∫⁻ r, ENNReal.ofReal (f r ^ 2) ∂μS.diagonalMeasure x := + ofReal_integral_eq_lintegral_ofReal hfi hpos + have hmain := measurableSpectralIntegral_norm_sq μS f hf x hx + rw [← hconvert] at hmain + exact (ENNReal.ofReal_eq_ofReal_iff (sq_nonneg _) + (integral_nonneg (fun r => sq_nonneg (f r)))).mp hmain + +/-! ### Uniqueness of the domain-aware realization + +The next theorem is the reusable endpoint of the PVM layer. It says that a self-adjoint partial +operator whose matrix elements are reconstructed by a real PVM is necessarily the canonical +square-moment realization of that PVM. The proof is deliberately here, rather than in a Cayley +adapter: Cayley, multiplication operators, and later concrete models can all use the same +domain-identification theorem. +-/ + +theorem maximalSpectralIntegral_eq_of_isSelfAdjoint_of_isWeakSpectralResolution + (T : H →ₗ.[ℂ] H) (hT : _root_.IsSelfAdjoint T) + (hres : IsWeakSpectralResolution T μS) + (hdom : ∀ x : T.domain, + (x : H) ∈ spectralSquareMomentDomain μS) : + maximalSpectralIntegral μS = T := by + let M := maximalSpectralIntegral μS + have hle : T ≤ M := by + refine ⟨?_, ?_⟩ + · intro x hx + exact hdom ⟨x, hx⟩ + · intro x z hxz + have hxM : (x : H) ∈ M.domain := by + change (x : H) ∈ spectralSquareMomentDomain μS + exact hdom x + let z₀ : M.domain := ⟨(x : H), hxM⟩ + have hz : z = z₀ := by + apply Subtype.ext + exact hxz.symm + apply ext_inner_left ℂ + intro y + have hfi : (μS.scalarMeasure (x : H) y).Integrable id := (hres ⟨x, x.property⟩).1 y + let := scalarMeasure_isFiniteVariation μS (x : H) y + have hweak := truncationIntegral_inner_tendsto_weakIntegral μS (x : H) y hfi + have hcomplex : Filter.Tendsto + (fun n : ℕ => ∫ᵛ r, truncationFunction n r ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); μS.scalarMeasure (x : H) y]) + Filter.atTop (𝓝 (μS.weakIntegral id (x : H) y)) := by + apply hweak.congr' + filter_upwards [] with n + have htrunc : (μS.scalarMeasure (x : H) y).Integrable (realTruncationFunction n) := by + rcases realTruncationFunction_bounded n with ⟨C, hC⟩ + apply Integrable.of_bound (realTruncationFunction_measurable n).aestronglyMeasurable C + filter_upwards [] with r + simpa [Real.norm_eq_abs] using hC r + have hreal := integral_real_eq_complex (μS.scalarMeasure (x : H) y) htrunc + have hfun : (fun r => truncationFunction n r) = + (fun r => Complex.ofRealCLM (realTruncationFunction n r)) := by + funext r + simpa [Complex.ofRealCLM_apply] using congrFun + (realTruncationFunction_complex_eq n).symm r + calc + ∫ᵛ r, realTruncationFunction n r ∂[ + ContinuousLinearMap.lsmul ℝ ℝ (E := ℂ); μS.scalarMeasure (x : H) y] = + ∫ᵛ r, Complex.ofRealCLM (realTruncationFunction n r) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ; μS.scalarMeasure (x : H) y] := hreal + _ = ∫ᵛ r, truncationFunction n r ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); μS.scalarMeasure (x : H) y] := + congrArg (fun f : ℝ → ℂ => ∫ᵛ r, f r ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); μS.scalarMeasure (x : H) y]) hfun.symm + have hmax := maximalSpectralIntegral_weak_truncation_reconstruction μS (x : H) hxM y + have hinner : ⟪y, M z₀⟫_ℂ = μS.weakIntegral id (x : H) y := + tendsto_nhds_unique hmax hcomplex + calc + ⟪y, T x⟫_ℂ = μS.weakIntegral id (x : H) y := (hres ⟨x, x.property⟩).2 y + _ = ⟪y, M z₀⟫_ℂ := hinner.symm + _ = ⟪y, M z⟫_ℂ := by rw [hz] + have hmax := maximalSpectralIntegral_isSelfAdjoint μS + have hTesa : T.IsEssentiallySelfAdjoint := + _root_.LinearPMap.IsSelfAdjoint.isEssentiallySelfAdjoint hT + have hclosure := LinearPMap.IsEssentiallySelfAdjoint.unique_self_adjoint_extension + hTesa hle hmax + rw [hT.isClosed.closure_eq] at hclosure + exact hclosure + +/-- Package the reusable PVM realization theorem together with its exact domain statement. + +The only model-specific input is the inclusion of the model domain into the square-moment domain; +the reverse inclusion is forced by self-adjoint uniqueness after the canonical maximal realization +has been constructed. -/ +theorem domainAwareSelfAdjointSpectralTheorem_of_isWeakSpectralResolution + (T : H →ₗ.[ℂ] H) (hT : _root_.IsSelfAdjoint T) + (hres : IsWeakSpectralResolution T μS) + (hdom : ∀ x : T.domain, + (x : H) ∈ spectralSquareMomentDomain μS) : + DomainAwareSelfAdjointSpectralTheorem T μS := by + have heq := maximalSpectralIntegral_eq_of_isSelfAdjoint_of_isWeakSpectralResolution + T hT hres hdom + refine + { toSelfAdjointSpectralTheorem := + { isSelfAdjoint := hT + reconstruction := hres } + domain_eq_squareMoment := ?_ } + have hdomains : (T.domain : Set H) = + ((maximalSpectralIntegral μS).domain : Set H) := + congrArg (fun D : Submodule ℂ H => (D : Set H)) + (congrArg LinearPMap.domain heq).symm + calc + (T.domain : Set H) = (maximalSpectralIntegral μS).domain := hdomains + _ = spectralSquareMomentDomain μS := by + exact congrArg (fun D : Submodule ℂ H => (D : Set H)) + (maximalSpectralIntegral_domain μS) + +end QuantumMechanics.WOTSpectralMeasure + +namespace QuantumMechanics + +namespace DomainAwareSelfAdjointSpectralTheorem + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] +variable {T : H →ₗ.[ℂ] H} +variable {μS : QuantumMechanics.WOTSpectralMeasure ℝ H} + +/-! ### The canonical operator equality + +The domain-aware certificate contains exactly the extra hypothesis needed by the uniqueness +theorem: its operator domain is the square-moment domain of its PVM. Exposing this equality as a +method keeps later Cayley and representation proofs from reconstructing the same argument. -/ + +theorem maximal_eq (D : DomainAwareSelfAdjointSpectralTheorem T μS) : + maximalSpectralIntegral μS = T := by + exact maximalSpectralIntegral_eq_of_isSelfAdjoint_of_isWeakSpectralResolution + T D.isSelfAdjoint D.reconstruction_of + (fun z => D.mem_domain_iff z |>.mp z.property) + +end DomainAwareSelfAdjointSpectralTheorem + +namespace SelfAdjointSpectralTheorem + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] +variable {T : H →ₗ.[ℂ] H} +variable {μS : QuantumMechanics.WOTSpectralMeasure ℝ H} + +/- The weak reconstruction certificate becomes an actual operator equality as soon as the model +supplies the one missing domain inclusion. This is the thin, non-domain-aware entry point used +by Cayley and model-specific closures. -/ +theorem maximal_eq_of_domain_inclusion + (D : SelfAdjointSpectralTheorem T μS) + (hdom : ∀ x : T.domain, + (x : H) ∈ spectralSquareMomentDomain μS) : + maximalSpectralIntegral μS = T := by + exact maximalSpectralIntegral_eq_of_isSelfAdjoint_of_isWeakSpectralResolution + T D.isSelfAdjoint D.reconstruction hdom + +end SelfAdjointSpectralTheorem + +end QuantumMechanics diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/SpectralPointMass.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/SpectralPointMass.lean new file mode 100644 index 0000000000..b28af11af2 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/SpectralPointMass.lean @@ -0,0 +1,341 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.BoundedSelfAdjointData +public import Mathlib.MeasureTheory.VectorMeasure.SetIntegral + +/-! + +# A `{0,1}`-valued, boundedly supported `WOTSpectralMeasure` is a point mass + +Stage one of the missing piece flagged in `Irreducible.lean`'s `key` lemma: a boundedly σ-additive +`{0,1}`-valued Borel measure on `ℝ` is a Dirac point mass. Built by bisecting the bounded support +interval, always keeping the half with measure `1`, and taking the (real-number) limit of the +resulting nested interval endpoints. + +## Main definitions + +- `WOTSpectralMeasure.exists_forall_notMem_measure_eq_zero` : given a bounded support and a + `{0,1}`-valued measure, there is a point `r` such that every measurable set avoiding `r` has + measure `0`. + +-/ + +@[expose] public section + +noncomputable section + +open MeasureTheory Set Filter Topology Classical + +namespace QuantumMechanics + +namespace WOTSpectralMeasure + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +section Bisect + +variable (μ : WOTSpectralMeasure ℝ H) + +/-- One bisection step: split `[p.1, p.2]` at its midpoint, and keep whichever half has +measure `1` (both halves are measurable, disjoint, and union to the whole interval, so by +`h01` and additivity exactly one of them does). `h01` itself is not needed to *define* this +step — only `Decidable`-free classical case analysis on `μ (Icc p.1 m) = 1` — it is only used +later to *prove properties* of the resulting sequence. -/ +private noncomputable def bisectStep (p : ℝ × ℝ) : ℝ × ℝ := + let m := (p.1 + p.2) / 2 + if μ (Icc p.1 m) = 1 then (p.1, m) else (m, p.2) + +/-- The `n`-th bisection interval's endpoints, starting from `(a, b)`. -/ +private noncomputable def bisect (a b : ℝ) : ℕ → ℝ × ℝ + | 0 => (a, b) + | n + 1 => bisectStep μ (bisect a b n) + +private theorem bisectStep_fst_le_snd {p : ℝ × ℝ} (h : p.1 ≤ p.2) : + (bisectStep μ p).1 ≤ (bisectStep μ p).2 := by + simp only [bisectStep] + split <;> dsimp <;> linarith + +private theorem bisectStep_sub (p : ℝ × ℝ) : + (bisectStep μ p).2 - (bisectStep μ p).1 = (p.2 - p.1) / 2 := by + simp only [bisectStep] + split <;> dsimp <;> ring + +private theorem bisectStep_fst_le {p : ℝ × ℝ} (h : p.1 ≤ p.2) : p.1 ≤ (bisectStep μ p).1 := by + simp only [bisectStep]; split <;> dsimp <;> linarith + +private theorem bisectStep_snd_le {p : ℝ × ℝ} (h : p.1 ≤ p.2) : (bisectStep μ p).2 ≤ p.2 := by + simp only [bisectStep]; split <;> dsimp <;> linarith + +private theorem bisectStep_subset {p : ℝ × ℝ} (h : p.1 ≤ p.2) : + Icc (bisectStep μ p).1 (bisectStep μ p).2 ⊆ Icc p.1 p.2 := + Icc_subset_Icc (bisectStep_fst_le μ h) (bisectStep_snd_le μ h) + +private theorem bisect_fst_le_snd {a b : ℝ} (hab : a ≤ b) : + ∀ n, (bisect μ a b n).1 ≤ (bisect μ a b n).2 + | 0 => hab + | n + 1 => bisectStep_fst_le_snd μ (bisect_fst_le_snd hab n) + +private theorem bisect_sub (a b : ℝ) : + ∀ n, (bisect μ a b n).2 - (bisect μ a b n).1 = (b - a) / 2 ^ n + | 0 => by simp [bisect] + | n + 1 => by + show (bisectStep μ (bisect μ a b n)).2 - (bisectStep μ (bisect μ a b n)).1 = _ + rw [bisectStep_sub, bisect_sub a b n] + ring + +private theorem bisect_fst_mono {a b : ℝ} (hab : a ≤ b) (n : ℕ) : + (bisect μ a b n).1 ≤ (bisect μ a b (n + 1)).1 := + bisectStep_fst_le μ (bisect_fst_le_snd μ hab n) + +private theorem bisect_snd_mono {a b : ℝ} (hab : a ≤ b) (n : ℕ) : + (bisect μ a b (n + 1)).2 ≤ (bisect μ a b n).2 := + bisectStep_snd_le μ (bisect_fst_le_snd μ hab n) + +private theorem bisect_subset {a b : ℝ} (hab : a ≤ b) (n : ℕ) : + Icc (bisect μ a b (n + 1)).1 (bisect μ a b (n + 1)).2 ⊆ + Icc (bisect μ a b n).1 (bisect μ a b n).2 := + bisectStep_subset μ (bisect_fst_le_snd μ hab n) + +/-- If the whole interval has measure `1`, the bisected interval does too: whichever half +`bisectStep` keeps is forced to have measure `1` by additivity across the (disjoint) split. -/ +private theorem bisectStep_measure_one (h01 : ∀ E : Set ℝ, MeasurableSet E → μ E = 0 ∨ μ E = 1) + {p : ℝ × ℝ} (h : p.1 ≤ p.2) (hμ : μ (Icc p.1 p.2) = 1) : + μ (Icc (bisectStep μ p).1 (bisectStep μ p).2) = 1 := by + simp only [bisectStep] + set m := (p.1 + p.2) / 2 with hm_def + have hm1 : p.1 ≤ m := by rw [hm_def]; linarith + have hm2 : m ≤ p.2 := by rw [hm_def]; linarith + by_cases hc : μ (Icc p.1 m) = 1 + · simpa [hc] + · simp only [hc, if_false] + have hc0 : μ (Icc p.1 m) = 0 := (h01 _ measurableSet_Icc).resolve_right hc + have hunion : Icc p.1 m ∪ Ioc m p.2 = Icc p.1 p.2 := Icc_union_Ioc_eq_Icc hm1 hm2 + have hdisj : Disjoint (Icc p.1 m) (Ioc m p.2) := by + rw [Set.disjoint_left] + rintro x ⟨-, hx2⟩ ⟨hx3, -⟩ + exact absurd hx2 (not_le.mpr hx3) + have heq : μ (Icc p.1 m) + μ (Ioc m p.2) = μ (Icc p.1 p.2) := by + rw [← hunion] + exact (μ.of_union hdisj measurableSet_Icc measurableSet_Ioc).symm + rw [hc0, hμ, zero_add] at heq + have hinter : Ioc m p.2 ∩ Icc m p.2 = Ioc m p.2 := by + rw [Set.inter_eq_left] + exact Ioc_subset_Icc_self + have hmul : μ (Ioc m p.2) * μ (Icc m p.2) = μ (Ioc m p.2) := by + rw [μ.comp_eq_of_inter measurableSet_Ioc measurableSet_Icc, hinter] + rw [heq, one_mul] at hmul + exact hmul + +private theorem bisect_measure_one (h01 : ∀ E : Set ℝ, MeasurableSet E → μ E = 0 ∨ μ E = 1) + {a b : ℝ} (hab : a ≤ b) (hμ : μ (Icc a b) = 1) : + ∀ n, μ (Icc (bisect μ a b n).1 (bisect μ a b n).2) = 1 + | 0 => by simpa [bisect] using hμ + | n + 1 => + bisectStep_measure_one μ h01 (bisect_fst_le_snd μ hab n) (bisect_measure_one h01 hab hμ n) + +/-- The half discarded at each bisection step has measure `0`. -/ +private theorem bisect_diff_measure_zero + (h01 : ∀ E : Set ℝ, MeasurableSet E → μ E = 0 ∨ μ E = 1) + {a b : ℝ} (hab : a ≤ b) (hμ : μ (Icc a b) = 1) (n : ℕ) : + μ (Icc (bisect μ a b n).1 (bisect μ a b n).2 \ + Icc (bisect μ a b (n + 1)).1 (bisect μ a b (n + 1)).2) = 0 := by + rw [μ.toVectorMeasure.of_sdiff measurableSet_Icc measurableSet_Icc (bisect_subset μ hab n), + bisect_measure_one μ h01 hab hμ (n + 1), bisect_measure_one μ h01 hab hμ n, sub_self] + +end Bisect + +section Limit + +variable (μ : WOTSpectralMeasure ℝ H) {a b : ℝ} + +private theorem bisectFst_mono (hab : a ≤ b) : Monotone (fun n => (bisect μ a b n).1) := + monotone_nat_of_le_succ (fun n => bisect_fst_mono μ hab n) + +private theorem bisectSnd_anti (hab : a ≤ b) : Antitone (fun n => (bisect μ a b n).2) := + antitone_nat_of_succ_le (fun n => bisect_snd_mono μ hab n) + +private theorem bisectSnd_le_start (hab : a ≤ b) (n : ℕ) : (bisect μ a b n).2 ≤ b := + bisectSnd_anti μ hab (Nat.zero_le n) |>.trans_eq (by simp [bisect]) + +private theorem bisectFst_ge_start (hab : a ≤ b) (n : ℕ) : a ≤ (bisect μ a b n).1 := + (by simp [bisect] : a = (bisect μ a b 0).1) ▸ bisectFst_mono μ hab (Nat.zero_le n) + +private theorem bddAbove_bisectFst (hab : a ≤ b) : + BddAbove (Set.range (fun n => (bisect μ a b n).1)) := + ⟨b, by rintro _ ⟨n, rfl⟩; exact (bisect_fst_le_snd μ hab n).trans (bisectSnd_le_start μ hab n)⟩ + +private theorem bddBelow_bisectSnd (hab : a ≤ b) : + BddBelow (Set.range (fun n => (bisect μ a b n).2)) := + ⟨a, by rintro _ ⟨n, rfl⟩; exact (bisectFst_ge_start μ hab n).trans (bisect_fst_le_snd μ hab n)⟩ + +/-- The bisection point: the common limit of the (monotone, bounded) left and (antitone, +bounded) right endpoints. `hab` is not needed to state the supremum, only to prove its +properties, but is kept explicit here for uniformity with the theorems about it below. -/ +private noncomputable def bisectPoint (_hab : a ≤ b) : ℝ := ⨆ n, (bisect μ a b n).1 + +private theorem tendsto_bisectFst (hab : a ≤ b) : + Tendsto (fun n => (bisect μ a b n).1) atTop (𝓝 (bisectPoint μ hab)) := + tendsto_atTop_ciSup (bisectFst_mono μ hab) (bddAbove_bisectFst μ hab) + +private theorem tendsto_bisectSub (a b : ℝ) : + Tendsto (fun n => (bisect μ a b n).2 - (bisect μ a b n).1) atTop (𝓝 0) := by + have heq : (fun n => (bisect μ a b n).2 - (bisect μ a b n).1) = + (fun n : ℕ => (b - a) / 2 ^ n) := funext (bisect_sub μ a b) + rw [heq] + simpa using tendsto_const_nhds.div_atTop + (tendsto_pow_atTop_atTop_of_one_lt (by norm_num : (1 : ℝ) < 2)) + +private theorem tendsto_bisectSnd (hab : a ≤ b) : + Tendsto (fun n => (bisect μ a b n).2) atTop (𝓝 (bisectPoint μ hab)) := by + have h := (tendsto_bisectSub μ a b).add (tendsto_bisectFst μ hab) + simp only [zero_add] at h + refine h.congr (fun n => ?_) + ring + +private theorem bisectFst_le_bisectPoint (hab : a ≤ b) (n : ℕ) : + (bisect μ a b n).1 ≤ bisectPoint μ hab := + le_ciSup (bddAbove_bisectFst μ hab) n + +private theorem bisectPoint_le_bisectSnd (hab : a ≤ b) (n : ℕ) : + bisectPoint μ hab ≤ (bisect μ a b n).2 := by + have hanti := bisectSnd_anti μ hab + have hlim := tendsto_bisectSnd μ hab + exact le_of_tendsto hlim (Filter.eventually_atTop.mpr ⟨n, fun m hm => hanti hm⟩) + +/-- The bisection intervals shrink to exactly the bisection point. -/ +private theorem iInter_bisectIcc (hab : a ≤ b) : + ⋂ n, Icc (bisect μ a b n).1 (bisect μ a b n).2 = {bisectPoint μ hab} := by + ext x + simp only [Set.mem_iInter, Set.mem_Icc, Set.mem_singleton_iff] + constructor + · intro hx + have h1 : bisectPoint μ hab ≤ x := + le_of_tendsto (tendsto_bisectFst μ hab) + (Filter.Eventually.of_forall (fun n => (hx n).1)) + have h2 : x ≤ bisectPoint μ hab := + ge_of_tendsto (tendsto_bisectSnd μ hab) + (Filter.Eventually.of_forall (fun n => (hx n).2)) + linarith + · rintro rfl + exact fun n => ⟨bisectFst_le_bisectPoint μ hab n, bisectPoint_le_bisectSnd μ hab n⟩ + +/-- **The bisection point carries the full measure.** Since every bisection interval has measure +`1` and the intervals shrink to exactly `{bisectPoint}`, continuity from above (`Mathlib`'s +`tendsto_vectorMeasure_iInter_atTop_nat`) forces `μ {bisectPoint} = 1`. -/ +private theorem measure_singleton_bisectPoint + (h01 : ∀ E : Set ℝ, MeasurableSet E → μ E = 0 ∨ μ E = 1) (hab : a ≤ b) + (hμ : μ (Icc a b) = 1) : + μ {bisectPoint μ hab} = 1 := by + have hanti : Antitone (fun n => Icc (bisect μ a b n).1 (bisect μ a b n).2) := + antitone_nat_of_succ_le (fun n => bisect_subset μ hab n) + have hmeas : ∀ n, MeasurableSet (Icc (bisect μ a b n).1 (bisect μ a b n).2) := + fun _ => measurableSet_Icc + have htendsto := μ.toVectorMeasure.tendsto_vectorMeasure_iInter_atTop_nat hanti hmeas + rw [iInter_bisectIcc μ hab] at htendsto + have hconst : (fun n => μ (Icc (bisect μ a b n).1 (bisect μ a b n).2)) = + fun _ : ℕ => (1 : H →WOT[ℂ] H) := funext (bisect_measure_one μ h01 hab hμ) + rw [hconst] at htendsto + exact tendsto_nhds_unique htendsto tendsto_const_nhds + +/-- **The point-mass theorem.** A boundedly σ-additive `{0,1}`-valued Borel measure on `ℝ` +concentrates all of its mass at a single point: every measurable set avoiding that point has +measure `0`. -/ +theorem exists_forall_notMem_measure_eq_zero + (h01 : ∀ E : Set ℝ, MeasurableSet E → μ E = 0 ∨ μ E = 1) (hab : a ≤ b) + (hμ : μ (Icc a b) = 1) : + ∃ r : ℝ, μ {r} = 1 ∧ ∀ E : Set ℝ, MeasurableSet E → r ∉ E → μ E = 0 := by + refine ⟨bisectPoint μ hab, measure_singleton_bisectPoint μ h01 hab hμ, fun E hE hrE => ?_⟩ + have hinter : E ∩ {bisectPoint μ hab} = (∅ : Set ℝ) := by + rw [Set.inter_singleton_eq_empty]; exact hrE + have hmul : μ E * μ {bisectPoint μ hab} = μ (∅ : Set ℝ) := by + rw [← hinter] + exact μ.comp_eq_of_inter hE (measurableSet_singleton (bisectPoint μ hab)) + rw [measure_singleton_bisectPoint μ h01 hab hμ, mul_one] at hmul + rw [hmul, μ.toVectorMeasure.empty] + +end Limit + +end WOTSpectralMeasure + +section ScalarOperator + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +open scoped InnerProductSpace + +/-- **Schur's-lemma capstone.** If every Borel spectral projection of a bounded self-adjoint +operator `S` is trivial (`0` or `1`), `S` is a scalar multiple of the identity — without ever +separately identifying `spectrum ℝ S`. Combined with irreducibility forcing every spectral +projection to be `0` or `1`, this finishes Schur's lemma for a Weyl-family representation. -/ +theorem eq_smul_one_of_forall_spectralMeasure_eq_zero_or_one + (S : H →L[ℂ] H) (hSA : IsSelfAdjoint S) + (h01 : ∀ E : Set ℝ, MeasurableSet E → + boundedSelfAdjointSpectralMeasure S hSA E = 0 ∨ + boundedSelfAdjointSpectralMeasure S hSA E = 1) : + ∃ c : ℂ, S = c • (1 : H →L[ℂ] H) := by + set μ := boundedSelfAdjointSpectralMeasure S hSA with hμ_def + obtain ⟨C, hC⟩ := exists_boundedSelfAdjointSpectralSupport S hSA + have hCicc : μ (Icc (-C) C) = 1 := by + have hcompl : μ (Icc (-C) C)ᶜ = 0 := hC.2 _ measurableSet_Icc.compl disjoint_compl_left + have heq := μ.toVectorMeasure.of_compl (measurableSet_Icc (a := -C) (b := C)) + rw [hcompl, μ.univ] at heq + exact (sub_eq_zero.mp heq.symm).symm + obtain ⟨r, hr1, hr0⟩ := WOTSpectralMeasure.exists_forall_notMem_measure_eq_zero μ h01 + (a := -C) (b := C) (by linarith [hC.1]) hCicc + refine ⟨(r : ℂ), ?_⟩ + have hSx : ∀ x : H, S x = (r : ℂ) • x := by + intro x + have hkey : ∀ y : H, ⟪y, S x⟫_ℂ = (r : ℂ) * ⟪y, x⟫_ℂ := by + intro y + have hrecon := boundedSelfAdjointSpectralMeasure_reconstruction S hSA x y + rw [← hrecon] + set ν := μ.scalarMeasure x y with hν_def + have hν0 : ∀ E : Set ℝ, MeasurableSet E → r ∉ E → ν E = 0 := by + intro E hE hrE + rw [hν_def, WOTSpectralMeasure.scalarMeasure_apply, hr0 E hE hrE] + simp + have hνr : ν {r} = ⟪y, x⟫_ℂ := by + rw [hν_def, WOTSpectralMeasure.scalarMeasure_apply, hr1] + simp + have hrestr0 : ν.restrict {r}ᶜ = 0 := by + apply MeasureTheory.VectorMeasure.ext + intro F hF + rw [MeasureTheory.VectorMeasure.restrict_apply _ (measurableSet_singleton r).compl hF, + zero_apply] + exact hν0 _ (hF.inter (measurableSet_singleton r).compl) (fun h => h.2 rfl) + have hvar0 : ν.variation {r}ᶜ = 0 := by + have hveq := MeasureTheory.VectorMeasure.variation_restrict + (μ := ν) (measurableSet_singleton r).compl + rw [hrestr0, MeasureTheory.VectorMeasure.variation_zero] at hveq + have h2 := congrArg (fun m : MeasureTheory.Measure ℝ => m Set.univ) hveq.symm + simpa [MeasureTheory.Measure.restrict_apply' (measurableSet_singleton r).compl] using h2 + have hae : ({r} : Set ℝ) =ᵐ[ν.variation] (Set.univ : Set ℝ) := by + rw [Filter.eventuallyEq_set, MeasureTheory.ae_iff] + have hset : {z : ℝ | ¬(z ∈ ({r} : Set ℝ) ↔ z ∈ (Set.univ : Set ℝ))} = {r}ᶜ := by + ext z; simp + rw [hset] + exact hvar0 + have hcongr := MeasureTheory.VectorMeasure.setIntegral_congr_set + (B := ContinuousLinearMap.lsmul ℝ ℂ) (f := fun z : ℝ => (z : ℂ)) (μ := ν) + (measurableSet_singleton r) MeasurableSet.univ hae + unfold WOTSpectralMeasure.complexWeakIntegral + rw [← MeasureTheory.VectorMeasure.setIntegral_univ, ← hcongr, + MeasureTheory.VectorMeasure.integral_singleton] + show (ContinuousLinearMap.lsmul ℝ ℂ) (r : ℂ) (ν {r}) = (r : ℂ) * ⟪y, x⟫_ℂ + rw [hνr] + rfl + have hzero : ⟪S x - (r : ℂ) • x, S x - (r : ℂ) • x⟫_ℂ = 0 := by + have h1 := hkey (S x - (r : ℂ) • x) + rw [inner_sub_right, inner_smul_right, h1] + ring + exact sub_eq_zero.mp (inner_self_eq_zero.mp hzero) + exact ContinuousLinearMap.ext (fun x => by simpa using hSx x) + +end ScalarOperator + +end QuantumMechanics diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Stone.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Stone.lean new file mode 100644 index 0000000000..e7d17845a5 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/Stone.lean @@ -0,0 +1,694 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.SpectralIntegral.Construction +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.SpectralIntegral.SpecTheorem +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.StoneUnitaryGroup +public import Mathlib.Analysis.Calculus.Deriv.Comp +public import Mathlib.Analysis.Calculus.Deriv.Mul +public import Mathlib.Analysis.Complex.RealDeriv +public import Mathlib.Analysis.SpecialFunctions.ExpDeriv + +/-! +# The scalar analytic kernel for Stone's theorem + +This file contains estimates for the multiplier `exp (I * t r)`. They are independent of a +particular operator or representation. In particular, the derivative is taken in the real +parameter `t` with values in `ℂ`; the strong Hilbert-space theorem lifts this scalar statement +through the spectral integral, while the operator-algebra packaging lives in `Unbounded.Stone`. +-/ + +@[expose] public section + +noncomputable section + +open MeasureTheory Set +open scoped Topology InnerProductSpace Function + +namespace QuantumMechanics.WOTSpectralMeasure + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +lemma expFunction_hasDerivAt (r : ℝ) : + HasDerivAt (fun t : ℝ => expFunction t r) (Complex.I * (r : ℂ)) 0 := by + have harg : HasDerivAt (fun t : ℝ => t • ((r : ℂ) * Complex.I)) + ((r : ℂ) * Complex.I) 0 := by + have h := HasDerivAt.smul_const (𝕜 := ℝ) (F := ℂ) + (hasDerivAt_id' (𝕜 := ℝ) (0 : ℝ)) ((r : ℂ) * Complex.I) + simpa only [one_smul] using h + have harg' : HasDerivAt (fun t : ℝ => ((t * r : ℝ) : ℂ) * Complex.I) + ((r : ℂ) * Complex.I) 0 := by + convert harg using 1 + · funext t + rw [Complex.real_smul] + push_cast + ring + have hexp := _root_.Complex.hasDerivAt_exp (0 : ℂ) + have hcomp := hexp.scomp_of_eq 0 harg' (by simp) + have hfun : (fun t : ℝ => expFunction t r) = + Complex.exp ∘ (fun t : ℝ => ((t * r : ℝ) : ℂ) * Complex.I) := by + funext t + unfold expFunction + rfl + have hcomp' : HasDerivAt (fun t : ℝ => expFunction t r) + (((r : ℂ) * Complex.I) • (Complex.exp 0)) 0 := + hcomp.congr_of_eventuallyEq + (Filter.Eventually.of_forall (fun t => congrFun hfun t)) + convert hcomp' using 1 + rw [Complex.exp_zero, smul_eq_mul, mul_one] + ring + +lemma expFunction_slope_tendsto (r : ℝ) : + Filter.Tendsto + (fun t : ℝ => t⁻¹ • (expFunction t r - expFunction 0 r)) + (𝓝[≠] (0 : ℝ)) (𝓝 (Complex.I * (r : ℂ))) := by + simpa only [zero_add] using (expFunction_hasDerivAt r).tendsto_slope_zero + +lemma expFunction_sub_one_norm_le (t r : ℝ) (ht : |t * r| ≤ 1) : + ‖expFunction t r - 1‖ ≤ 2 * |t * r| := by + unfold expFunction + have harg : ‖((t * r : ℝ) : ℂ) * Complex.I‖ ≤ 1 := by + simpa [Complex.norm_real, Real.norm_eq_abs] using ht + simpa [Complex.norm_real, Real.norm_eq_abs] using + (Complex.norm_exp_sub_one_le harg) + +@[nolint unusedArguments] +lemma expFunction_slope_norm_le {t r : ℝ} (ht : t ≠ 0) (_htsmall : |t| ≤ 1) : + ‖t⁻¹ • (expFunction t r - 1)‖ ≤ 2 * |r| := by + have ht' : 0 < |t| := abs_pos.mpr ht + by_cases hsmall : |t * r| ≤ 1 + · have hmain := expFunction_sub_one_norm_le t r hsmall + rw [norm_smul, Real.norm_eq_abs, abs_inv] + have htr : |t * r| = |t| * |r| := by rw [abs_mul] + rw [htr] at hmain + calc + |t|⁻¹ * ‖expFunction t r - 1‖ ≤ |t|⁻¹ * (2 * (|t| * |r|)) := + mul_le_mul_of_nonneg_left hmain (by positivity) + _ = 2 * |r| := by field_simp + · have hlarge : 1 < |t * r| := lt_of_not_ge hsmall + have htwo : ‖expFunction t r - 1‖ ≤ 2 := by + calc + ‖expFunction t r - 1‖ ≤ ‖expFunction t r‖ + ‖(1 : ℂ)‖ := norm_sub_le _ _ + _ = 2 := by rw [expFunction_modulus]; norm_num + rw [norm_smul, Real.norm_eq_abs, abs_inv] + have htr : |t * r| = |t| * |r| := by rw [abs_mul] + rw [htr] at hlarge + have hle : |t|⁻¹ ≤ |r| := by + rw [← one_div] + apply (div_le_iff₀ ht').2 + rw [mul_comm] at hlarge + exact le_of_lt hlarge + calc + |t|⁻¹ * ‖expFunction t r - 1‖ ≤ |t|⁻¹ * 2 := + mul_le_mul_of_nonneg_left htwo (by positivity) + _ ≤ |r| * 2 := mul_le_mul_of_nonneg_right hle (by positivity) + _ = 2 * |r| := by ring + +lemma expFunction_slope_sub_derivative_norm_le {t r : ℝ} (ht : t ≠ 0) + (htsmall : |t| ≤ 1) : + ‖t⁻¹ • (expFunction t r - 1) - Complex.I * (r : ℂ)‖ ≤ 3 * |r| := by + calc + ‖t⁻¹ • (expFunction t r - 1) - Complex.I * (r : ℂ)‖ ≤ + ‖t⁻¹ • (expFunction t r - 1)‖ + ‖Complex.I * (r : ℂ)‖ := norm_sub_le _ _ + _ ≤ 2 * |r| + |r| := by + gcongr + · exact expFunction_slope_norm_le ht htsmall + · simp [Complex.norm_real] + _ = 3 * |r| := by ring + +/-- The difference quotient `t⁻¹(exp(itr) - 1)` of `expFunction`. -/ +def expSlope (t r : ℝ) : ℂ := + t⁻¹ • (expFunction t r - 1) + +lemma expSlope_measurable (t : ℝ) : Measurable (expSlope t) := by + unfold expSlope + exact (measurable_const : Measurable (fun _ : ℝ => (t⁻¹ : ℝ))).smul + ((expFunction_measurable t).sub measurable_const) + +lemma expSlope_tendsto (r : ℝ) : + Filter.Tendsto (fun t : ℝ => expSlope t r) (𝓝[≠] (0 : ℝ)) + (𝓝 (Complex.I * (r : ℂ))) := by + simpa [expSlope, expFunction] using expFunction_slope_tendsto r + +lemma expSlope_sub_derivative_measurable (t : ℝ) : + Measurable (fun r : ℝ => expSlope t r - Complex.I * (r : ℂ)) := by + exact (expSlope_measurable t).sub + (measurable_const.mul Complex.measurable_ofReal) + +lemma expSlope_sub_derivative_norm_le {t r : ℝ} (ht : t ≠ 0) + (htsmall : |t| ≤ 1) : + ‖expSlope t r - Complex.I * (r : ℂ)‖ ≤ 3 * |r| := by + exact expFunction_slope_sub_derivative_norm_le ht htsmall + +lemma vectorMeasure_expSlope_sub_derivative_tendsto + {μ : MeasureTheory.VectorMeasure ℝ ℂ} (hxi : μ.Integrable id) : + Filter.Tendsto + (fun t : ℝ => ∫ᵛ r, expSlope t r - Complex.I * (r : ℂ) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); μ]) + (𝓝[≠] (0 : ℝ)) (𝓝 0) := by + let ν : Measure ℝ := μ.variation + have hnorm : Integrable (fun r : ℝ => |r|) ν := by + simpa [ν, Real.norm_eq_abs] using hxi.norm + have hbound : Integrable (fun r : ℝ => 3 * |r|) ν := by + simpa only [smul_eq_mul] using hnorm.const_mul 3 + have hmeas : ∀ᶠ t : ℝ in 𝓝[≠] (0 : ℝ), + AEStronglyMeasurable (fun r : ℝ => expSlope t r - Complex.I * (r : ℂ)) ν := by + filter_upwards [] with t + exact (expSlope_sub_derivative_measurable t).aestronglyMeasurable + have hdom : ∀ᶠ t : ℝ in 𝓝[≠] (0 : ℝ), + ∀ᵐ r : ℝ ∂ν, ‖expSlope t r - Complex.I * (r : ℂ)‖ ≤ 3 * |r| := by + rw [eventually_nhdsWithin_iff] + filter_upwards [Ioo_mem_nhds (by norm_num : (-1 : ℝ) < 0) + (by norm_num : (0 : ℝ) < 1)] with t ht htnz + filter_upwards [] with r + have htsmall : |t| ≤ 1 := by + rw [abs_le] + exact ⟨le_of_lt ht.1, le_of_lt ht.2⟩ + exact expSlope_sub_derivative_norm_le htnz + htsmall + have hlim : ∀ᵐ r : ℝ ∂ν, + Filter.Tendsto (fun t : ℝ => expSlope t r - Complex.I * (r : ℂ)) + (𝓝[≠] (0 : ℝ)) (𝓝 0) := by + filter_upwards [] with r + simpa using (expSlope_tendsto r).sub + (tendsto_const_nhds : Filter.Tendsto + (fun _ : ℝ => Complex.I * (r : ℂ)) (𝓝[≠] (0 : ℝ)) + (𝓝 (Complex.I * (r : ℂ)))) + simpa using + (MeasureTheory.VectorMeasure.tendsto_integral_filter_of_dominated_convergence + (μ := μ) (B := ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ)) + (fun r : ℝ => 3 * |r|) hmeas hdom hbound hlim) + +lemma maximalSpectralIntegral_inner_eq_complexWeakIntegral + (μS : WOTSpectralMeasure ℝ H) (x : H) + (hx : x ∈ (maximalSpectralIntegral μS).domain) (y : H) + (hfi : (μS.scalarMeasure x y).Integrable id) : + ⟪y, (maximalSpectralIntegral μS) ⟨x, hx⟩⟫_ℂ = + μS.complexWeakIntegral (fun r : ℝ => (r : ℂ)) x y := by + have hmax := maximalSpectralIntegral_weak_truncation_reconstruction μS x hx y + have hlim := truncationIntegral_inner_tendsto_complexWeakIntegral μS x y hfi + exact tendsto_nhds_unique hmax hlim + +lemma expIntegral_inner_slope_tendsto_complexWeakIntegral + (μS : WOTSpectralMeasure ℝ H) (x y : H) + (hfi : (μS.scalarMeasure x y).Integrable id) : + Filter.Tendsto + (fun t : ℝ => t⁻¹ • + (⟪y, expIntegral μS t x⟫_ℂ - ⟪y, x⟫_ℂ)) + (𝓝[≠] (0 : ℝ)) + (𝓝 (μS.complexWeakIntegral (fun r : ℝ => Complex.I * (r : ℂ)) x y)) := by + let ν := μS.scalarMeasure x y + let := scalarMeasure_isFiniteVariation μS x y + have hreal : ν.Integrable id := hfi + have hone : ν.Integrable (fun _ : ℝ => (1 : ℂ)) := by + exact MeasureTheory.integrable_const 1 + have habs : ν.Integrable (fun r : ℝ => |r|) := by + simpa only [Function.id_def, Real.norm_eq_abs] using hreal.norm + have hcomplex : ν.Integrable (fun r : ℝ => (r : ℂ)) := hreal.ofReal + have htarget : ν.Integrable (fun r : ℝ => Complex.I * (r : ℂ)) := by + exact hcomplex.const_mul Complex.I + have hzero : + μS.complexWeakIntegral (fun r : ℝ => Complex.I * (r : ℂ)) x y = + ∫ᵛ r, Complex.I * (r : ℂ) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν] := rfl + rw [hzero] + have hDCT := vectorMeasure_expSlope_sub_derivative_tendsto (μ := ν) hreal + have hquot : ∀ᶠ t : ℝ in 𝓝[≠] (0 : ℝ), + t⁻¹ • (⟪y, expIntegral μS t x⟫_ℂ - ⟪y, x⟫_ℂ) - + ∫ᵛ r, Complex.I * (r : ℂ) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν] = + ∫ᵛ r, expSlope t r - Complex.I * (r : ℂ) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν] := by + rw [eventually_nhdsWithin_iff] + filter_upwards [Ioo_mem_nhds (by norm_num : (-1 : ℝ) < 0) + (by norm_num : (0 : ℝ) < 1)] with t ht htnz + have htsmall : |t| ≤ 1 := by + rw [abs_le] + exact ⟨le_of_lt ht.1, le_of_lt ht.2⟩ + have hslope : ν.Integrable (expSlope t) := by + apply Integrable.mono' (habs.const_mul (2 : ℝ)) + · exact (expSlope_measurable t).aestronglyMeasurable + · filter_upwards [] with r + simpa [expSlope, norm_smul, Real.norm_eq_abs] using + (expFunction_slope_norm_le (r := r) htnz htsmall) + have hexpint : ν.Integrable (expFunction t) := by + apply Integrable.of_bound (expFunction_measurable t).aestronglyMeasurable 1 + filter_upwards [] with r + rw [expFunction_modulus] + have hExp := boundedIntegral_inner μS (expFunction_measurable t) + (expFunction_bounded t) x y (scalarMeasure_isFiniteVariation μS x y) + have hOne := boundedIntegral_inner μS (f := fun _ : ℝ => (1 : ℂ)) measurable_const + (⟨(1 : ℝ), fun _ => by norm_num⟩) x y + (scalarMeasure_isFiniteVariation μS x y) + have hExp' : ⟪y, expIntegral μS t x⟫_ℂ = + ∫ᵛ r, expFunction t r ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν] := by + exact hExp + have hOne' : ⟪y, x⟫_ℂ = + ∫ᵛ r, (1 : ℂ) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν] := by + rw [← hOne] + simp [boundedIntegral_const] + rw [hExp', hOne'] + have hExpSmul := MeasureTheory.VectorMeasure.integral_smul + (expFunction t) ν (ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ)) t⁻¹ + have hOneSmul := MeasureTheory.VectorMeasure.integral_smul + (fun _ : ℝ => (1 : ℂ)) ν + (ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ)) t⁻¹ + have hExpS : ν.Integrable (fun r : ℝ => t⁻¹ • expFunction t r) := + hexpint.smul t⁻¹ + have hOneS : ν.Integrable (fun _ : ℝ => t⁻¹ • (1 : ℂ)) := + hone.smul t⁻¹ + have hExpSmul' : + (∫ᵛ r, t⁻¹ • expFunction t r ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν]) = + t⁻¹ • ∫ᵛ r, expFunction t r ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν] := by + simpa only [Pi.smul_apply] using hExpSmul + have hOneSmul' : + (∫ᵛ r, t⁻¹ • (1 : ℂ) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν]) = + t⁻¹ • ∫ᵛ r, (1 : ℂ) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν] := by + simpa only [Pi.smul_apply] using hOneSmul + have hsubInt : + (∫ᵛ r, t⁻¹ • expFunction t r ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν]) - + ∫ᵛ r, t⁻¹ • (1 : ℂ) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν] = + ∫ᵛ r, (t⁻¹ • expFunction t r - t⁻¹ • (1 : ℂ)) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν] := by + simpa only [Pi.sub_apply] using + (MeasureTheory.VectorMeasure.integral_sub hExpS hOneS).symm + have hfinalInt : + (∫ᵛ r, (t⁻¹ • expFunction t r - t⁻¹ • (1 : ℂ)) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν]) - + ∫ᵛ r, Complex.I * (r : ℂ) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν] = + ∫ᵛ r, (t⁻¹ • expFunction t r - t⁻¹ • (1 : ℂ)) - + Complex.I * (r : ℂ) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν] := by + simpa only [Pi.sub_apply] using + (MeasureTheory.VectorMeasure.integral_sub (hExpS.sub hOneS) htarget).symm + calc + t⁻¹ • (∫ᵛ r, expFunction t r ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν] - + ∫ᵛ r, (1 : ℂ) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν]) - + ∫ᵛ r, Complex.I * (r : ℂ) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν] = + (t⁻¹ • ∫ᵛ r, expFunction t r ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν] - + t⁻¹ • ∫ᵛ r, (1 : ℂ) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν]) - + ∫ᵛ r, Complex.I * (r : ℂ) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν] := by rw [smul_sub] + _ = (∫ᵛ r, t⁻¹ • expFunction t r ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν] - + ∫ᵛ r, t⁻¹ • (1 : ℂ) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν]) - + ∫ᵛ r, Complex.I * (r : ℂ) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν] := by + rw [hExpSmul', hOneSmul'] + _ = (∫ᵛ r, (t⁻¹ • expFunction t r - t⁻¹ • (1 : ℂ)) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν]) - + ∫ᵛ r, Complex.I * (r : ℂ) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν] := by + exact congrArg (fun z : ℂ => z - + ∫ᵛ r, Complex.I * (r : ℂ) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν]) hsubInt + _ = ∫ᵛ r, expSlope t r - Complex.I * (r : ℂ) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν] := by + rw [hfinalInt] + congr 1 + funext r + simp [expSlope] + ring + have hdiff_tendsto : Filter.Tendsto + (fun t : ℝ => + t⁻¹ • (⟪y, expIntegral μS t x⟫_ℂ - ⟪y, x⟫_ℂ) - + ∫ᵛ r, Complex.I * (r : ℂ) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν]) + (𝓝[≠] (0 : ℝ)) (𝓝 0) := by + exact hDCT.congr' (hquot.mono fun _ h => h.symm) + have hadd := hdiff_tendsto.add (tendsto_const_nhds : + Filter.Tendsto (fun _ : ℝ => ∫ᵛ r, Complex.I * (r : ℂ) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν]) + (𝓝[≠] (0 : ℝ)) (𝓝 (∫ᵛ r, Complex.I * (r : ℂ) ∂[ + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); ν]))) + simpa [sub_add_cancel] using hadd + +lemma boundedIntegral_sub_maximal_norm_sq + (μS : WOTSpectralMeasure ℝ H) {g : ℝ → ℂ} (hg : Measurable g) + (hgb : ∃ C : ℝ, ∀ r, ‖g r‖ ≤ C) + (x : H) (hx : x ∈ (maximalSpectralIntegral μS).domain) : + ENNReal.ofReal (‖boundedIntegral μS g hg hgb x - + Complex.I • (maximalSpectralIntegral μS) ⟨x, hx⟩‖ ^ 2) = + ∫⁻ r, ENNReal.ofReal (‖g r - Complex.I * (r : ℂ)‖ ^ 2) + ∂μS.diagonalMeasure x := by + rcases hgb with ⟨C, hC⟩ + have hC0 : 0 ≤ C := by + exact (norm_nonneg (g 0)).trans (hC 0) + let μ := μS.diagonalMeasure x + have hdom : Integrable (fun r : ℝ => r ^ 2) μ := by + exact hx + have hbound : Integrable (fun r : ℝ => 2 * C ^ 2 + 2 * r ^ 2) μ := by + have hconst : Integrable (fun _ : ℝ => 2 * C ^ 2) μ := + MeasureTheory.integrable_const _ + exact hconst.add (hdom.const_mul 2) + have hfin : (∫⁻ r, ENNReal.ofReal (2 * C ^ 2 + 2 * r ^ 2) ∂μ) ≠ ⊤ := + (hbound.lintegral_lt_top).ne + let F : ℕ → ℝ → ENNReal := fun n r => + ENNReal.ofReal (‖g r - Complex.I * truncationFunction n r‖ ^ 2) + let F₀ : ℝ → ENNReal := fun r => + ENNReal.ofReal (‖g r - Complex.I * (r : ℂ)‖ ^ 2) + have hFmeas : ∀ n, Measurable (F n) := by + intro n + exact ENNReal.continuous_ofReal.measurable.comp + ((hg.sub ((measurable_const.mul (truncationFunction_measurable n)))).norm.pow_const 2) + have hFbound : ∀ n, ∀ᵐ r ∂μ, F n r ≤ + ENNReal.ofReal (2 * C ^ 2 + 2 * r ^ 2) := by + intro n + filter_upwards [] with r + dsimp [F] + apply ENNReal.ofReal_le_ofReal + have htrunc : ‖truncationFunction n r‖ ≤ |r| := by + by_cases hr : r ∈ spectralCutoffSet n + · change r ∈ Set.Icc (-(n : ℝ)) (n : ℝ) at hr + rw [truncationFunction, indicator_of_mem hr, Complex.norm_real, Real.norm_eq_abs] + · change r ∉ Set.Icc (-(n : ℝ)) (n : ℝ) at hr + simp [truncationFunction, hr] + have hnorm : ‖g r - Complex.I * truncationFunction n r‖ ≤ C + |r| := by + calc + _ ≤ ‖g r‖ + ‖Complex.I * truncationFunction n r‖ := norm_sub_le _ _ + _ = ‖g r‖ + ‖truncationFunction n r‖ := by simp + _ ≤ C + |r| := add_le_add (hC r) htrunc + have hsquare := (sq_le_sq₀ (norm_nonneg _) (by positivity)).2 hnorm + nlinarith [sq_nonneg (C - |r|), sq_abs r] + have hFlim : ∀ᵐ r ∂μ, Filter.Tendsto (fun n : ℕ => F n r) + Filter.atTop (𝓝 (F₀ r)) := by + filter_upwards [] with r + have htrunc := truncationFunction_tendsto r + have hdiff : Filter.Tendsto + (fun n : ℕ => g r - Complex.I * truncationFunction n r) + Filter.atTop (𝓝 (g r - Complex.I * (r : ℂ))) := by + exact tendsto_const_nhds.sub (tendsto_const_nhds.mul htrunc) + have hnorm : Filter.Tendsto + (fun n : ℕ => ‖g r - Complex.I * truncationFunction n r‖ ^ 2) + Filter.atTop (𝓝 (‖g r - Complex.I * (r : ℂ)‖ ^ 2)) := + (continuous_norm.pow 2).continuousAt.tendsto.comp hdiff + exact ENNReal.continuous_ofReal.continuousAt.tendsto.comp hnorm + have hlin : Filter.Tendsto (fun n : ℕ => ∫⁻ r, F n r ∂μ) + Filter.atTop (𝓝 (∫⁻ r, F₀ r ∂μ)) := + MeasureTheory.tendsto_lintegral_filter_of_dominated_convergence + (fun r : ℝ => ENNReal.ofReal (2 * C ^ 2 + 2 * r ^ 2)) + (by filter_upwards [] with n; exact hFmeas n) + (by filter_upwards [] with n; exact hFbound n) hfin hFlim + have hvec : Filter.Tendsto + (fun n : ℕ => boundedIntegral μS g hg ⟨C, hC⟩ x - + Complex.I • truncationIntegral μS n x) + Filter.atTop (𝓝 (boundedIntegral μS g hg ⟨C, hC⟩ x - + Complex.I • (maximalSpectralIntegral μS) ⟨x, hx⟩)) := by + have htr := truncationLimit_tendsto μS (⟨x, hx⟩ : spectralSquareMomentSubmodule μS) + have hsub := (tendsto_const_nhds : + Filter.Tendsto (fun _ : ℕ => boundedIntegral μS g hg ⟨C, hC⟩ x) + Filter.atTop (𝓝 (boundedIntegral μS g hg ⟨C, hC⟩ x))).sub + (htr.const_smul Complex.I) + simpa [maximalSpectralIntegral, truncationLimit] using hsub + have hnorm : Filter.Tendsto + (fun n : ℕ => ENNReal.ofReal (‖boundedIntegral μS g hg ⟨C, hC⟩ x - + Complex.I • truncationIntegral μS n x‖ ^ 2)) + Filter.atTop (𝓝 (ENNReal.ofReal (‖boundedIntegral μS g hg ⟨C, hC⟩ x - + Complex.I • (maximalSpectralIntegral μS) ⟨x, hx⟩‖ ^ 2))) := by + exact ENNReal.continuous_ofReal.continuousAt.tendsto.comp + ((continuous_norm.pow 2).continuousAt.tendsto.comp hvec) + have hnormsq : ∀ n : ℕ, + ENNReal.ofReal (‖boundedIntegral μS g hg ⟨C, hC⟩ x - + Complex.I • truncationIntegral μS n x‖ ^ 2) = + ∫⁻ r, F n r ∂μ := by + intro n + let gn : ℝ → ℂ := fun r => Complex.I * truncationFunction n r + have hgn : Measurable gn := by + exact measurable_const.mul (truncationFunction_measurable n) + have hgnbound : ∀ r, ‖gn r‖ ≤ (n : ℝ) := by + intro r + dsimp [gn] + rw [norm_mul, Complex.norm_I, one_mul] + by_cases hr : r ∈ Set.Icc (-(n : ℝ)) (n : ℝ) + · rw [truncationFunction, indicator_of_mem hr, Complex.norm_real, Real.norm_eq_abs] + exact abs_le.mpr hr + · simp [truncationFunction, hr] + have hgnb : ∃ K : ℝ, ∀ r, ‖gn r‖ ≤ K := ⟨n, hgnbound⟩ + have hdifff : Measurable (g - gn) := hg.sub hgn + have hdiffb : ∃ K : ℝ, ∀ r, ‖(g - gn) r‖ ≤ K := by + refine ⟨C + n, fun r => ?_⟩ + exact (norm_sub_le _ _).trans + (add_le_add (hC r) (hgnbound r)) + have hsubop := boundedIntegral_sub μS hg hgn ⟨C, hC⟩ hgnb + have hsmul := boundedIntegral_smul μS Complex.I + (truncationFunction_measurable n) (truncationFunction_bounded n) + have hsmulx : boundedIntegral μS gn hgn hgnb x = + Complex.I • truncationIntegral μS n x := by + have h := congrArg (fun A : H →WOT[ℂ] H => A x) hsmul + simpa [gn, truncationIntegral] using h + have hdiffEq : boundedIntegral μS (g - gn) hdifff hdiffb x = + boundedIntegral μS g hg ⟨C, hC⟩ x - + Complex.I • truncationIntegral μS n x := by + have h := congrArg (fun A : H →WOT[ℂ] H => A x) hsubop + have h' : boundedIntegral μS (g - gn) hdifff hdiffb x = + boundedIntegral μS g hg ⟨C, hC⟩ x - + boundedIntegral μS gn hgn hgnb x := by + simpa using h + rw [hsmulx] at h' + exact h' + have hnorm0 := boundedIntegral_norm_sq μS hdifff hdiffb x + rw [← hdiffEq] + simpa [F, μ, gn] using hnorm0 + have hlin' : Filter.Tendsto + (fun n : ℕ => ENNReal.ofReal (‖boundedIntegral μS g hg ⟨C, hC⟩ x - + Complex.I • truncationIntegral μS n x‖ ^ 2)) + Filter.atTop (𝓝 (∫⁻ r, F₀ r ∂μ)) := by + apply hlin.congr' + filter_upwards [] with n + rw [hnormsq n] + exact tendsto_nhds_unique hnorm hlin' + +lemma expIntegral_slope_eq_boundedIntegral + (μS : WOTSpectralMeasure ℝ H) (t : ℝ) (x : H) + (hgb : ∃ C : ℝ, ∀ r, ‖expSlope t r‖ ≤ C) : + t⁻¹ • (expIntegral μS t x - x) = + boundedIntegral μS (expSlope t) (expSlope_measurable t) hgb x := by + have hdiffb : ∃ C : ℝ, ∀ r, ‖(expFunction t - (fun _ : ℝ => (1 : ℂ))) r‖ ≤ C := by + refine ⟨2, fun r => ?_⟩ + calc + ‖(expFunction t - (fun _ : ℝ => (1 : ℂ))) r‖ = + ‖expFunction t r - 1‖ := by rfl + _ ≤ ‖expFunction t r‖ + ‖(1 : ℂ)‖ := norm_sub_le _ _ + _ = 2 := by rw [expFunction_modulus]; norm_num + have hdiff := boundedIntegral_sub μS (f := expFunction t) + (g := fun _ : ℝ => (1 : ℂ)) (expFunction_measurable t) measurable_const + (expFunction_bounded t) (⟨1, fun _ => by norm_num⟩) + have hscale := boundedIntegral_smul μS (t⁻¹ : ℂ) + ((expFunction_measurable t).sub measurable_const) hdiffb + have hscale' : boundedIntegral μS (expSlope t) (expSlope_measurable t) hgb x = + (t⁻¹ : ℂ) • + boundedIntegral μS (expFunction t - (fun _ : ℝ => (1 : ℂ))) + ((expFunction_measurable t).sub measurable_const) hdiffb x := by + have hfun : (fun r : ℝ => expSlope t r) = + (fun r : ℝ => (t⁻¹ : ℂ) * (expFunction t r - (1 : ℂ))) := by + funext r + simp [expSlope] + have h := congrArg (fun A : H →WOT[ℂ] H => A x) hscale + simpa [hfun, expSlope, smul_eq_mul] using h + have hdiff' : boundedIntegral μS (expFunction t - (fun _ : ℝ => (1 : ℂ))) + ((expFunction_measurable t).sub measurable_const) hdiffb x = + expIntegral μS t x - x := by + have h := congrArg (fun A : H →WOT[ℂ] H => A x) hdiff + simpa [expIntegral, boundedIntegral_const] using h + rw [hscale', hdiff'] + rw [← Complex.ofReal_inv] + exact RCLike.real_smul_eq_coe_smul (K := ℂ) (E := H) t⁻¹ + (expIntegral μS t x - x) + +lemma expIntegral_strong_slope_tendsto + (μS : WOTSpectralMeasure ℝ H) (x : H) + (hx : x ∈ (maximalSpectralIntegral μS).domain) : + Filter.Tendsto + (fun t : ℝ => t⁻¹ • (expIntegral μS t x - x)) + (𝓝[≠] (0 : ℝ)) + (𝓝 (Complex.I • (maximalSpectralIntegral μS) ⟨x, hx⟩)) := by + have hqeq : ∀ᶠ t : ℝ in 𝓝[≠] (0 : ℝ), + t⁻¹ • (expIntegral μS t x - x) = + boundedIntegral μS (expSlope t) (expSlope_measurable t) + (by + refine ⟨2 * |t|⁻¹, fun r => ?_⟩ + rw [expSlope, norm_smul, Real.norm_eq_abs, abs_inv] + calc + |t|⁻¹ * ‖expFunction t r - 1‖ ≤ |t|⁻¹ * 2 := + mul_le_mul_of_nonneg_left + (by + calc + ‖expFunction t r - 1‖ ≤ ‖expFunction t r‖ + ‖(1 : ℂ)‖ := + norm_sub_le _ _ + _ = 2 := by rw [expFunction_modulus]; norm_num) + (by positivity) + _ = 2 * |t|⁻¹ := by ring) + x := by + rw [eventually_nhdsWithin_iff] + filter_upwards [Ioo_mem_nhds (by norm_num : (-1 : ℝ) < 0) + (by norm_num : (0 : ℝ) < 1)] with t ht htnz + let hgb : ∃ C : ℝ, ∀ r, ‖expSlope t r‖ ≤ C := by + refine ⟨2 * |t|⁻¹, fun r => ?_⟩ + rw [expSlope, norm_smul, Real.norm_eq_abs, abs_inv] + calc + |t|⁻¹ * ‖expFunction t r - 1‖ ≤ |t|⁻¹ * 2 := + mul_le_mul_of_nonneg_left + (by + calc + ‖expFunction t r - 1‖ ≤ ‖expFunction t r‖ + ‖(1 : ℂ)‖ := + norm_sub_le _ _ + _ = 2 := by rw [expFunction_modulus]; norm_num) + (by positivity) + _ = 2 * |t|⁻¹ := by ring + have hdiffb : ∃ C : ℝ, ∀ r, ‖(expFunction t - (fun _ : ℝ => (1 : ℂ))) r‖ ≤ C := by + refine ⟨2, fun r => ?_⟩ + calc + ‖(expFunction t - (fun _ : ℝ => (1 : ℂ))) r‖ = + ‖expFunction t r - 1‖ := by rfl + _ ≤ ‖expFunction t r‖ + ‖(1 : ℂ)‖ := norm_sub_le _ _ + _ = 2 := by rw [expFunction_modulus]; norm_num + have hdiff := boundedIntegral_sub μS (f := expFunction t) + (g := fun _ : ℝ => (1 : ℂ)) (expFunction_measurable t) measurable_const + (expFunction_bounded t) (⟨1, fun _ => by norm_num⟩) + have hscale := boundedIntegral_smul μS (t⁻¹ : ℂ) + ((expFunction_measurable t).sub measurable_const) hdiffb + have hscale' : boundedIntegral μS (expSlope t) (expSlope_measurable t) hgb x = + (t⁻¹ : ℂ) • + boundedIntegral μS (expFunction t - (fun _ : ℝ => (1 : ℂ))) + ((expFunction_measurable t).sub measurable_const) hdiffb x := by + have hfun : (fun r : ℝ => expSlope t r) = + (fun r : ℝ => (t⁻¹ : ℂ) * + (expFunction t r - (1 : ℂ))) := by + funext r + simp [expSlope] + have h := congrArg (fun A : H →WOT[ℂ] H => A x) hscale + simpa [hfun, expSlope, smul_eq_mul] using h + have hdiff' : boundedIntegral μS (expFunction t - (fun _ : ℝ => (1 : ℂ))) + ((expFunction_measurable t).sub measurable_const) hdiffb x = + expIntegral μS t x - x := by + have h := congrArg (fun A : H →WOT[ℂ] H => A x) hdiff + simpa [expIntegral, boundedIntegral_const] using h + rw [hscale', hdiff'] + rw [← Complex.ofReal_inv] + exact RCLike.real_smul_eq_coe_smul (K := ℂ) (E := H) t⁻¹ + (expIntegral μS t x - x) + have hnormsq : ∀ᶠ t : ℝ in 𝓝[≠] (0 : ℝ), + ENNReal.ofReal (‖t⁻¹ • (expIntegral μS t x - x) - + Complex.I • (maximalSpectralIntegral μS) ⟨x, hx⟩‖ ^ 2) = + ∫⁻ r, ENNReal.ofReal (‖expSlope t r - Complex.I * (r : ℂ)‖ ^ 2) + ∂μS.diagonalMeasure x := by + filter_upwards [hqeq] with t hq + rw [hq] + exact boundedIntegral_sub_maximal_norm_sq μS + (expSlope_measurable t) + (by + refine ⟨2 * |t|⁻¹, fun r => ?_⟩ + rw [expSlope, norm_smul, Real.norm_eq_abs, abs_inv] + calc + |t|⁻¹ * ‖expFunction t r - 1‖ ≤ |t|⁻¹ * 2 := + mul_le_mul_of_nonneg_left + (by + calc + ‖expFunction t r - 1‖ ≤ ‖expFunction t r‖ + ‖(1 : ℂ)‖ := + norm_sub_le _ _ + _ = 2 := by rw [expFunction_modulus]; norm_num) + (by positivity) + _ = 2 * |t|⁻¹ := by ring) + x hx + let μ := μS.diagonalMeasure x + let G : ℝ → ℝ → ENNReal := fun t r => + ENNReal.ofReal (‖expSlope t r - Complex.I * (r : ℂ)‖ ^ 2) + let G₀ : ℝ → ENNReal := fun _ => 0 + have hdom : Integrable (fun r : ℝ => r ^ 2) μ := hx + have hbound : Integrable (fun r : ℝ => 9 * r ^ 2) μ := hdom.const_mul 9 + have hfin : (∫⁻ r, ENNReal.ofReal (9 * r ^ 2) ∂μ) ≠ ⊤ := + (hbound.lintegral_lt_top).ne + have hGmeas : ∀ t : ℝ, Measurable (G t) := by + intro t + exact ENNReal.continuous_ofReal.measurable.comp + ((expSlope_sub_derivative_measurable t).norm.pow_const 2) + have hGbound : ∀ᶠ t : ℝ in 𝓝[≠] (0 : ℝ), ∀ᵐ r ∂μ, G t r ≤ + ENNReal.ofReal (9 * r ^ 2) := by + rw [eventually_nhdsWithin_iff] + filter_upwards [Ioo_mem_nhds (by norm_num : (-1 : ℝ) < 0) + (by norm_num : (0 : ℝ) < 1)] with t ht htnz + filter_upwards [] with r + dsimp [G] + apply ENNReal.ofReal_le_ofReal + have htsmall : |t| ≤ 1 := by + rw [abs_le] + exact ⟨le_of_lt ht.1, le_of_lt ht.2⟩ + have hpoint := expFunction_slope_sub_derivative_norm_le + (r := r) htnz htsmall + have hpoint' : ‖expSlope t r - Complex.I * (r : ℂ)‖ ≤ 3 * |r| := by + simpa [expSlope] using hpoint + have hsquare := (sq_le_sq₀ (norm_nonneg _) (by positivity)).2 hpoint' + nlinarith [sq_abs r] + have hGlim : ∀ᵐ r ∂μ, Filter.Tendsto (fun t : ℝ => G t r) + (𝓝[≠] (0 : ℝ)) (𝓝 (G₀ r)) := by + filter_upwards [] with r + have hdiff : Filter.Tendsto + (fun t : ℝ => expSlope t r - Complex.I * (r : ℂ)) + (𝓝[≠] (0 : ℝ)) (𝓝 0) := by + simpa using (expSlope_tendsto r).sub + (tendsto_const_nhds : Filter.Tendsto + (fun _ : ℝ => Complex.I * (r : ℂ)) (𝓝[≠] (0 : ℝ)) + (𝓝 (Complex.I * (r : ℂ)))) + have hnorm : Filter.Tendsto + (fun t : ℝ => ‖expSlope t r - Complex.I * (r : ℂ)‖ ^ 2) + (𝓝[≠] (0 : ℝ)) (𝓝 (0 ^ 2)) := by + simpa [Function.comp_def] using + ((continuous_norm.pow 2).continuousAt.tendsto.comp hdiff) + simpa [G, G₀, Function.comp_def] using + (ENNReal.continuous_ofReal.continuousAt.tendsto.comp hnorm) + have hGint : Filter.Tendsto (fun t : ℝ => ∫⁻ r, G t r ∂μ) + (𝓝[≠] (0 : ℝ)) (𝓝 (∫⁻ r, G₀ r ∂μ)) := + MeasureTheory.tendsto_lintegral_filter_of_dominated_convergence + (fun r : ℝ => ENNReal.ofReal (9 * r ^ 2)) + (by filter_upwards [] with t; exact hGmeas t) + (by filter_upwards [hGbound] with t ht; exact ht) hfin hGlim + have henergy : Filter.Tendsto + (fun t : ℝ => ENNReal.ofReal (‖t⁻¹ • (expIntegral μS t x - x) - + Complex.I • (maximalSpectralIntegral μS) ⟨x, hx⟩‖ ^ 2)) + (𝓝[≠] (0 : ℝ)) (𝓝 0) := by + have hGint' : Filter.Tendsto (fun t : ℝ => ∫⁻ r, G t r ∂μ) + (𝓝[≠] (0 : ℝ)) (𝓝 0) := by + simpa [G₀, μ] using hGint + exact hGint'.congr' (hnormsq.mono fun _ h => h.symm) + rw [tendsto_iff_norm_sub_tendsto_zero] + apply Metric.tendsto_nhds.2 + intro ε hε + have hεsq : 0 < ε ^ 2 := sq_pos_of_pos hε + have hevent := henergy.eventually + (Iio_mem_nhds (ENNReal.ofReal_pos.mpr hεsq)) + filter_upwards [hevent] with t ht + have ht' : ENNReal.ofReal + (‖t⁻¹ • (expIntegral μS t x - x) - + Complex.I • (maximalSpectralIntegral μS) ⟨x, hx⟩‖ ^ 2) < + ENNReal.ofReal (ε ^ 2) := by + simpa using ht + have hsq : ‖t⁻¹ • (expIntegral μS t x - x) - + Complex.I • (maximalSpectralIntegral μS) ⟨x, hx⟩‖ ^ 2 < ε ^ 2 := by + exact (ENNReal.ofReal_lt_ofReal_iff (by positivity)).mp ht' + have hnormlt : ‖t⁻¹ • (expIntegral μS t x - x) - + Complex.I • (maximalSpectralIntegral μS) ⟨x, hx⟩‖ < ε := + (sq_lt_sq₀ (norm_nonneg _) (le_of_lt hε)).mp hsq + simpa [dist_eq_norm] using hnormlt + +end QuantumMechanics.WOTSpectralMeasure + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/StoneUnitaryGroup.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/StoneUnitaryGroup.lean new file mode 100644 index 0000000000..de8d407155 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/StoneUnitaryGroup.lean @@ -0,0 +1,342 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.BoundedIntegralAlgebra + +/-! + +# The strongly continuous unitary group generated by a real spectral measure + +Given `μS : WOTSpectralMeasure ℝ H`, exponentiating the bounded multiplier `x ↦ exp(itx)` against +`μS` (via `boundedIntegral`, `BoundedIntegral.lean`) produces, for each real `t`, a unitary +`expIntegral μS t = exp(itT) : H →WOT[ℂ] H` — "the unitary group generated by `μS`'s self-adjoint +operator", without ever needing to construct the (generally unbounded) operator `T` itself. The +group law `expIntegral μS (t + s) = expIntegral μS t * expIntegral μS s` follows from +`boundedIntegral_mul` and `exp(i(t+s)x) = exp(itx)·exp(isx)`; strong continuity in `t` follows +from the vector-state norm-square identity (`boundedIntegral_norm_sq_eq_integral`) and dominated +convergence. + +This packages exactly the representation-level half of Stone's theorem — "a (bounded, exponential) +spectral integral gives rise to a strongly continuous one-parameter unitary group" — as +`StrongUnitaryOneParameterGroup` and `expUnitaryGroup`. The converse direction (every strongly +continuous one-parameter unitary group arises this way, from the spectral measure of its +generator) is the remaining content of Stone's theorem; it needs the unbounded spectral theorem +itself to produce the generator's spectral measure in the first place, and is not built here. + +## Main definitions + +- `expIntegral` : `exp(itT)`, defined directly from `μS` via `boundedIntegral`. +- `expUnitaryGroup` : the resulting `StrongUnitaryOneParameterGroup`. + +-/ + +@[expose] public section + +noncomputable section + +open scoped Topology InnerProductSpace Function +open ContinuousLinearMap ContinuousLinearMapWOT MeasureTheory Set + +namespace QuantumMechanics + +namespace WOTSpectralMeasure + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-! ## A. The exponential multiplier -/ + +/-- The exponential multiplier `x ↦ exp(itx)`, at real time `t`. -/ +def expFunction (t : ℝ) : ℝ → ℂ := + fun x => Complex.exp ((t * x : ℝ) * Complex.I) + +lemma expFunction_measurable (t : ℝ) : Measurable (expFunction t) := by + change Measurable (fun x : ℝ => Complex.exp ((t * x : ℝ) * Complex.I)) + fun_prop + +lemma expFunction_bounded (t : ℝ) : ∃ C, ∀ x, ‖expFunction t x‖ ≤ C := by + refine ⟨1, fun x => ?_⟩ + exact (Complex.norm_exp_ofReal_mul_I (t * x)).le + +lemma expFunction_modulus (t : ℝ) : ∀ x, ‖expFunction t x‖ = 1 := by + intro x + exact Complex.norm_exp_ofReal_mul_I (t * x) + +lemma expFunction_neg_eq_star (t : ℝ) : expFunction (-t) = star (expFunction t) := by + funext x + change Complex.exp ((((-t) * x : ℝ) : ℂ) * Complex.I) = + starRingEnd ℂ (Complex.exp (((t * x : ℝ) : ℂ) * Complex.I)) + rw [← Complex.exp_conj] + congr 1 + simp + +lemma expFunction_diff_bounded (t s : ℝ) : + ∃ C, ∀ x, ‖expFunction t x - expFunction s x‖ ≤ C := by + refine ⟨2, fun x => ?_⟩ + calc + ‖expFunction t x - expFunction s x‖ ≤ + ‖expFunction t x‖ + ‖expFunction s x‖ := norm_sub_le _ _ + _ = 2 := by rw [expFunction_modulus, expFunction_modulus]; norm_num + +lemma expFunction_add (t s : ℝ) : expFunction (t + s) = expFunction t * expFunction s := by + funext x + change Complex.exp ((((t + s) * x : ℝ) : ℂ) * Complex.I) = + Complex.exp (((t * x : ℝ) : ℂ) * Complex.I) * + Complex.exp (((s * x : ℝ) : ℂ) * Complex.I) + have harg : (((t + s) * x : ℝ) : ℂ) * Complex.I = + ((t * x : ℝ) : ℂ) * Complex.I + ((s * x : ℝ) : ℂ) * Complex.I := by + push_cast + ring + rw [harg, Complex.exp_add] + +/-! ## B. The unitary group and its strong continuity -/ + +/-- The unitary group generated by `μS`'s self-adjoint operator: `expIntegral μS t = exp(itT)`. -/ +noncomputable def expIntegral (μS : WOTSpectralMeasure ℝ H) (t : ℝ) : H →WOT[ℂ] H := + boundedIntegral μS (expFunction t) (expFunction_measurable t) (expFunction_bounded t) + +lemma expIntegral_add (μS : WOTSpectralMeasure ℝ H) (t s : ℝ) : + expIntegral μS (t + s) = expIntegral μS t * expIntegral μS s := by + change boundedIntegral μS (expFunction (t + s)) (expFunction_measurable (t + s)) + (expFunction_bounded (t + s)) = + boundedIntegral μS (expFunction t) (expFunction_measurable t) (expFunction_bounded t) * + boundedIntegral μS (expFunction s) (expFunction_measurable s) (expFunction_bounded s) + have h := boundedIntegral_mul μS (expFunction_measurable t) (expFunction_measurable s) + (expFunction_bounded t) (expFunction_bounded s) + rw [← h] + apply boundedIntegral_congr μS (expFunction_measurable (t + s)) + ((expFunction_measurable t).mul (expFunction_measurable s)) + (expFunction_bounded (t + s)) + (by + rcases expFunction_bounded t with ⟨Ct, hCt⟩ + rcases expFunction_bounded s with ⟨Cs, hCs⟩ + refine ⟨Ct * Cs, fun x => ?_⟩ + simp only [Pi.mul_apply, norm_mul] + exact mul_le_mul (hCt x) (hCs x) (norm_nonneg _) (by + exact (norm_nonneg (expFunction t 0)).trans (hCt 0))) + (by + intro x + exact congrFun (expFunction_add t s) x) + +lemma expIntegral_zero (μS : WOTSpectralMeasure ℝ H) : + expIntegral μS 0 = (1 : H →WOT[ℂ] H) := by + change boundedIntegral μS (expFunction 0) (expFunction_measurable 0) + (expFunction_bounded 0) = (1 : H →WOT[ℂ] H) + calc + boundedIntegral μS (expFunction 0) (expFunction_measurable 0) + (expFunction_bounded 0) = + boundedIntegral μS (fun _ : ℝ => (1 : ℂ)) measurable_const + (⟨1, by simp⟩) := by + apply boundedIntegral_congr μS (expFunction_measurable 0) measurable_const + (expFunction_bounded 0) (⟨1, by simp⟩) + intro x + simp [expFunction] + _ = 1 := by rw [boundedIntegral_const]; simp + +lemma expIntegral_neg_mul (μS : WOTSpectralMeasure ℝ H) (t : ℝ) : + expIntegral μS (-t) * expIntegral μS t = (1 : H →WOT[ℂ] H) := by + calc + expIntegral μS (-t) * expIntegral μS t = expIntegral μS (-t + t) := + (expIntegral_add μS (-t) t).symm + _ = expIntegral μS 0 := by rw [neg_add_cancel] + _ = 1 := expIntegral_zero μS + +lemma expIntegral_mul_neg (μS : WOTSpectralMeasure ℝ H) (t : ℝ) : + expIntegral μS t * expIntegral μS (-t) = (1 : H →WOT[ℂ] H) := by + calc + expIntegral μS t * expIntegral μS (-t) = expIntegral μS (t + -t) := + (expIntegral_add μS t (-t)).symm + _ = expIntegral μS 0 := by rw [add_neg_cancel] + _ = 1 := expIntegral_zero μS + +lemma expIntegral_star (μS : WOTSpectralMeasure ℝ H) (t : ℝ) : + star (expIntegral μS t) = expIntegral μS (-t) := by + have h := boundedIntegral_star μS (expFunction_measurable t) (expFunction_bounded t) + calc + star (expIntegral μS t) = + boundedIntegral μS (fun x => star (expFunction t x)) + (continuous_star.measurable.comp (expFunction_measurable t)) + (by + rcases expFunction_bounded t with ⟨C, hC⟩ + exact ⟨C, fun x => by simpa using hC x⟩) := by + simpa only [expIntegral] using h.symm + _ = expIntegral μS (-t) := by + apply boundedIntegral_congr μS + (continuous_star.measurable.comp (expFunction_measurable t)) + (expFunction_measurable (-t)) + (by + rcases expFunction_bounded t with ⟨C, hC⟩ + exact ⟨C, fun x => by simpa using hC x⟩) + (expFunction_bounded (-t)) + intro x + exact congrFun (expFunction_neg_eq_star t).symm x + +lemma expIntegral_mem_unitary (μS : WOTSpectralMeasure ℝ H) (t : ℝ) : + expIntegral μS t ∈ unitary (H →WOT[ℂ] H) := by + let U : (H →WOT[ℂ] H)ˣ := + { val := expIntegral μS t + inv := expIntegral μS (-t) + val_inv := expIntegral_mul_neg μS t + inv_val := expIntegral_neg_mul μS t } + apply IsUnit.mem_unitary_of_star_mul_self ⟨U, rfl⟩ + rw [expIntegral_star] + exact expIntegral_neg_mul μS t + +@[nolint unusedArguments] +lemma expIntegral_sub_eq_boundedIntegral_diff [Nonempty H] (μS : WOTSpectralMeasure ℝ H) + (t s : ℝ) (x : H) : + expIntegral μS t x - expIntegral μS s x = + boundedIntegral μS (fun z => expFunction t z - expFunction s z) + ((expFunction_measurable t).sub (expFunction_measurable s)) + (expFunction_diff_bounded t s) x := by + have h := boundedIntegral_sub μS (expFunction_measurable t) (expFunction_measurable s) + (expFunction_bounded t) (expFunction_bounded s) + have hx := congrArg (fun A : H →WOT[ℂ] H => A x) h + change (boundedIntegral μS (expFunction t) (expFunction_measurable t) + (expFunction_bounded t) x - + boundedIntegral μS (expFunction s) (expFunction_measurable s) + (expFunction_bounded s) x) = + boundedIntegral μS (fun z => expFunction t z - expFunction s z) + ((expFunction_measurable t).sub (expFunction_measurable s)) + (expFunction_diff_bounded t s) x + exact hx.symm + +lemma expIntegral_continuous (μS : WOTSpectralMeasure ℝ H) (x : H) : + Continuous (fun t => expIntegral μS t x) := by + rw [continuous_iff_continuousAt] + intro t₀ + have hdiffNormSq : Filter.Tendsto + (fun t => ENNReal.ofReal + (‖expIntegral μS t x - expIntegral μS t₀ x‖ ^ 2)) (𝓝 t₀) (𝓝 0) := by + let μ : Measure ℝ := μS.diagonalMeasure x + let F : ℝ → ℝ → ENNReal := fun t z => + ENNReal.ofReal (‖expFunction t z - expFunction t₀ z‖ ^ 2) + let F₀ : ℝ → ENNReal := fun _ => 0 + have hFmeas : ∀ t, Measurable (F t) := by + intro t + change Measurable (fun z => ENNReal.ofReal + (‖expFunction t z - expFunction t₀ z‖ ^ 2)) + exact ENNReal.continuous_ofReal.measurable.comp + (((expFunction_measurable t).sub (expFunction_measurable t₀)).norm.pow_const 2) + have hbound : ∀ᶠ t in 𝓝 t₀, ∀ᵐ z ∂μ, F t z ≤ ENNReal.ofReal 4 := by + filter_upwards [] with t + filter_upwards [] with z + dsimp [F] + apply ENNReal.ofReal_le_ofReal + have hnorm : ‖expFunction t z - expFunction t₀ z‖ ≤ 2 := by + calc + ‖expFunction t z - expFunction t₀ z‖ ≤ + ‖expFunction t z‖ + ‖expFunction t₀ z‖ := norm_sub_le _ _ + _ = 2 := by rw [expFunction_modulus, expFunction_modulus]; norm_num + have hsq := (sq_le_sq₀ (norm_nonneg _) (by norm_num : (0 : ℝ) ≤ 2)).mpr hnorm + norm_num at hsq ⊢ + exact hsq + have hfin : (∫⁻ z, ENNReal.ofReal 4 ∂μ) ≠ (⊤ : ENNReal) := by + rw [lintegral_const, μS.diagonalMeasure_univ] + exact ENNReal.mul_ne_top ENNReal.ofReal_ne_top ENNReal.ofReal_ne_top + have hlim : ∀ᵐ z ∂μ, Filter.Tendsto (fun t => F t z) (𝓝 t₀) (𝓝 (F₀ z)) := by + filter_upwards [] with z + have hcont : Continuous (fun t : ℝ => expFunction t z) := by + unfold expFunction + fun_prop + have hdiff : Filter.Tendsto + (fun t => expFunction t z - expFunction t₀ z) (𝓝 t₀) (𝓝 0) := by + convert hcont.continuousAt.tendsto.sub + (tendsto_const_nhds : + Filter.Tendsto (fun _ : ℝ => expFunction t₀ z) (𝓝 t₀) (𝓝 (expFunction t₀ z))) using 1 + simp + have hnorm : Filter.Tendsto + (fun t => ‖expFunction t z - expFunction t₀ z‖ ^ 2) (𝓝 t₀) (𝓝 (0 ^ 2)) := by + convert (continuous_norm.pow 2).continuousAt.tendsto.comp hdiff using 1 + · rfl + · simp + change Filter.Tendsto + (fun t => ENNReal.ofReal (‖expFunction t z - expFunction t₀ z‖ ^ 2)) + (𝓝 t₀) (𝓝 0) + have hout := ENNReal.continuous_ofReal.continuousAt.tendsto.comp hnorm + convert hout using 1 + · funext t + rfl + · simp + have hlintegral : Filter.Tendsto + (fun t => ∫⁻ z, F t z ∂μ) (𝓝 t₀) (𝓝 (∫⁻ z, F₀ z ∂μ)) := + MeasureTheory.tendsto_lintegral_filter_of_dominated_convergence + (fun _ : ℝ => ENNReal.ofReal 4) + (by filter_upwards [] with t; exact hFmeas t) hbound hfin hlim + have hlintegral0 : Filter.Tendsto + (fun t => ∫⁻ z, F t z ∂μ) (𝓝 t₀) (𝓝 0) := by + simpa [F₀] using hlintegral + have hnormsq : ∀ t, ENNReal.ofReal + (‖expIntegral μS t x - expIntegral μS t₀ x‖ ^ 2) = ∫⁻ z, F t z ∂μ := by + intro t + rw [expIntegral_sub_eq_boundedIntegral_diff] + simpa [F, μ] using + (boundedIntegral_norm_sq μS (f := fun z => expFunction t z - expFunction t₀ z) + ((expFunction_measurable t).sub (expFunction_measurable t₀)) + (expFunction_diff_bounded t t₀) x) + exact hlintegral0.congr' (Filter.Eventually.of_forall fun t => (hnormsq t).symm) + apply Metric.tendsto_nhds.2 + intro ε hε + have hεsq : 0 < ε ^ 2 := sq_pos_of_pos hε + have hevent : ∀ᶠ t in 𝓝 t₀, + ENNReal.ofReal (‖expIntegral μS t x - expIntegral μS t₀ x‖ ^ 2) < + ENNReal.ofReal (ε ^ 2) := by + exact hdiffNormSq.eventually + (Iio_mem_nhds (ENNReal.ofReal_pos.mpr hεsq)) + filter_upwards [hevent] with t ht + rw [dist_eq_norm] + apply (sq_lt_sq₀ (norm_nonneg _) hε.le).mp + exact (ENNReal.ofReal_lt_ofReal_iff hεsq).mp ht + +/-- A strongly continuous one-parameter group of unitary bounded operators. + +The continuity is stated in the strong operator sense, pointwise on vectors. This is the natural +representation-level output of the bounded spectral integral; no unbounded generator is needed +in this interface. -/ +structure StrongUnitaryOneParameterGroup + (H : Type*) [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] where + /-- The unitary at each real time. -/ + toFun : ℝ → H →WOT[ℂ] H + mem_unitary : ∀ t, toFun t ∈ unitary (H →WOT[ℂ] H) + map_zero : toFun 0 = 1 + map_add : ∀ t s, toFun (t + s) = toFun t * toFun s + strong_continuous : ∀ x, Continuous (fun t => toFun t x) + +namespace StrongUnitaryOneParameterGroup + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +instance : CoeFun (StrongUnitaryOneParameterGroup H) + (fun _ => ℝ → H →WOT[ℂ] H) := ⟨StrongUnitaryOneParameterGroup.toFun⟩ + +@[simp] +lemma zero (G : StrongUnitaryOneParameterGroup H) : G 0 = 1 := G.map_zero + +lemma add (G : StrongUnitaryOneParameterGroup H) (t s : ℝ) : G (t + s) = G t * G s := + G.map_add t s + +lemma unitary (G : StrongUnitaryOneParameterGroup H) (t : ℝ) : G t ∈ unitary (H →WOT[ℂ] H) := + G.mem_unitary t + +lemma continuous_apply (G : StrongUnitaryOneParameterGroup H) (x : H) : + Continuous (fun t => G t x) := G.strong_continuous x + +end StrongUnitaryOneParameterGroup + +/-- The unitary group obtained by exponentiating a bounded real spectral integral. -/ +noncomputable def expUnitaryGroup (μS : WOTSpectralMeasure ℝ H) : + StrongUnitaryOneParameterGroup H where + toFun := expIntegral μS + mem_unitary := expIntegral_mem_unitary μS + map_zero := expIntegral_zero μS + map_add := expIntegral_add μS + strong_continuous := expIntegral_continuous μS + +end WOTSpectralMeasure + +end QuantumMechanics + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/UNBOUNDED_SPECTRAL_ROADMAP.md b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/UNBOUNDED_SPECTRAL_ROADMAP.md new file mode 100644 index 0000000000..e0b097a927 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/UNBOUNDED_SPECTRAL_ROADMAP.md @@ -0,0 +1,152 @@ +# Unbounded spectral theory: consolidation plan + +## Decision + +Keep `WOTSpectralMeasure` and the domain-aware spectral-integral construction as the canonical +unbounded layer. They already express strictly more of the information needed by applications +than a resolvent-only or bounded-Borel presentation: in particular, they retain the exact maximal +square-moment domain of an unbounded observable. + +The linked `adambornemann-glitch/Spectra` development is valuable as a source of proof +organization and as an independent validation of the Cayley route. It must not be imported or +copied as a second public operator/PVM hierarchy. Its `ProjValMeasure` and this project's +`WOTSpectralMeasure` overlap substantially but make different representation choices. The +existing local type already carries weak-operator countable additivity and supports the bounded +and unbounded integrals used below. + +The right common abstraction is nevertheless real and should be introduced before either the +abstract JBW Borel calculus or further concrete unbounded façades. It is **not** a Hilbert-space +operator-valued measure. + +```text +MeasurableProjectionResolution α J + E : measurable sets of α → projections of J + E(∅) = 0, E(univ) = 1, E(S ∩ T) = E(S) * E(T) + E(⋃ₙ Sₙ) = supₙ E(Sₙ) (disjoint measurable family) +``` + +Here the last equality is order convergence in a monotone-complete ordered Jordan algebra. This +interface is now implemented as `MeasurableProjectionResolution` in +`JordanOrderUnit/ProjectionResolution.lean`: it is an extension of the existing +`EffectValuedMeasure`, adding Jordan idempotence and the intersection-product law without +duplicating countable additivity. Its JBW companion supplies normal-state scalar probability +laws and the separating-family extensionality theorem. The interface is deliberately independent +of Hilbert spaces, complex scalars, Cayley maps, or an unbounded operator domain. + +`WOTSpectralMeasure α H` is then a **concrete realization target**, not the generic definition: +its values are weak-operator projections on a Hilbert space and its vector-measure countable +additivity proves the generic projection-resolution laws. Spectra's `ProjValMeasure` has the +same role, but is not imported because it is another Hilbert-special carrier. + +## What exists here + +```text +WOTSpectralMeasure α H + ├─ boundedIntegral: bounded measurable calculus + ├─ maximalSpectralIntegral: unbounded measurable calculus + ├─ spectralSquareMomentDomain: exact operator domain + └─ Cayley map/inverse map + +bounded normal CFC spectral data + └─ cayleyRealSpectralMeasure + └─ DomainAwareSelfAdjointSpectralTheorem T μ + ├─ T.domain = spectralSquareMomentDomain μ + ├─ maximal spectral integral realizes T + └─ expUnitaryGroup and the domain-aware Stone API +``` + +The public self-adjoint endpoint is `unboundedSpectralTheorem`; the reusable uniqueness endpoint +is the maximal-spectral-integral characterization in `SpectralIntegral/SpecTheorem.lean`. + +## What Spectra contributes conceptually + +Spectra's Cayley development isolates a useful three-stage proof spine: + +```text +self-adjoint LinearPMap + → bounded unitary Cayley transform + → bounded continuous/Borel calculus + → pushforward along the inverse Cayley map + → spectral theorem and Stone group +``` + +This project already implements the same mathematical route, but with a stronger final package: +the inverse-Cayley measure is tied to the square-moment domain and then to a maximal unbounded +integral. That extra domain equality must remain the non-negotiable boundary. A weak integral +identity alone cannot identify an unbounded operator. + +The directly reusable *ideas*, not a duplicate API, are: + +1. Treat the Cayley transform as the bounded-normal gateway and keep all Borel work downstream + of it. +2. State uniqueness through scalarization: diagonal/resolvent data determine the PVM by complex + polarization and Cauchy-transform injectivity. +3. Keep bounded calculus, unbounded measurable calculus, and the Stone-generator theorem as + separate vertical slices. +4. Expose a compact public resolvent API only after proving it agrees with the spectral + multiplier; do not make applications reconstruct domain witnesses. + +## Consolidation slices + +### U1 — make the existing public spectral theorem easy to consume + +Add a focused façade module with only these exports: + +- the canonical measure supplied by `unboundedSpectralTheorem`; +- the exact domain equivalence; +- the coordinate reconstruction theorem; +- the non-real resolvent multiplier formula; +- the bounded measurable calculus and its continuous restriction. + +This is packaging only: no new spectral representation is defined. + +### U2 — measurable functional calculus as a domain-aware construction + +For a measurable `f : ℝ → ℂ`, make the domain + +```text +{x | ∫ ‖f(λ)‖² dμ_x(λ) < ∞} +``` + +the public domain of `f(T)`, prove agreement with `maximalSpectralIntegral`, and provide the +bounded specialization through `boundedIntegral`. The coordinate function recovers `T`. + +### U3 — resolvent façade + +Specialize U2 to `(λ - z)⁻¹` for `Im z ≠ 0`. Prove the inverse/range formula once and package a +canonical bounded operator. This is where the concise Cayley/resolvent presentation used by +Spectra is useful, but the proof must go through the local maximal-integral domain theorem. + +### U4 — Stone equivalence + +Use the established `expUnitaryGroup` and its differentiability/domain API to state the exact +operator-level Stone theorem: the group generated by the spectral measure has generator `iT` on +precisely `T.domain`. Keep construction from a given self-adjoint operator distinct from the +converse construction of a generator from an arbitrary strongly continuous unitary group. + +### U5 — JBW connection + +Only after the abstract JB Stage C exact-cone and positive-root results are complete, define +`MeasurableProjectionResolution` and the **bounded** JBW Borel calculus by simple functions and +monotone completion. Its universal laws are addition, multiplication on each one-observable +commutative sector, positivity, and normal-state scalarization. The Hilbert-space +`WOTSpectralMeasure` development is then the concrete special-JBW realization, not an import of +operator/Cstar facts into abstract Jordan theory. + +Unbounded measurable functions are a separate, represented/affiliated-operator layer: their +domains are square-integrability domains of scalarized spectral measures. That construction is +meaningful for a Hilbert representation, but not for a bare JBW algebra; it must therefore sit +above the bounded JBW calculus rather than distort the JBW core. + +## Boundaries to preserve + +- No second `ProjValMeasure` type in PhyslibAlpha. +- No Cstar import into the abstract `JordanOrderUnit/JB` or `JBW` layers. +- No claim that a weak reconstruction formula determines an unbounded operator without the + square-moment-domain equality. +- No reverse normality-transport theorem until its directed-set domain is matched exactly. +- No unbounded calculus API with arbitrary functions unless its domain/integrability condition is + explicit. +- The Cayley transform is a complex Hilbert/operator realization technique, not an abstract-JBW + primitive. Abstract JBW spectral theory proceeds from order suprema and projections; Cayley + is used only to construct or compare its concrete special realization. diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/UnitaryInfra/SesquilinearForm.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/UnitaryInfra/SesquilinearForm.lean new file mode 100644 index 0000000000..0087dc44a6 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/UnitaryInfra/SesquilinearForm.lean @@ -0,0 +1,1391 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.WeakIntegral +public import Mathlib.MeasureTheory.Integral.RieszMarkovKakutani.Real +public import Mathlib.Analysis.InnerProductSpace.Positive +public import Mathlib.Analysis.RCLike.ContinuousMap +public import Mathlib.Topology.Instances.RealVectorSpace +public import Mathlib.Analysis.CStarAlgebra.ContinuousLinearMap +public import Mathlib.Analysis.CStarAlgebra.ContinuousFunctionalCalculus.Basic +public import Mathlib.Analysis.CStarAlgebra.ContinuousFunctionalCalculus.Order +public import Mathlib.Analysis.InnerProductSpace.StarOrder +public import Mathlib.MeasureTheory.Integral.Bochner.ContinuousLinearMap + +/-! +# Infrastructure for the bounded-unitary spectral theorem: the sesquilinear form + +Builds, from a bounded unitary `U`'s continuous functional calculus, the real-valued spectral +scalar measures `cfcScalarMeasure`/`polarizedCfcScalarMeasure` via the Riesz-Markov-Kakutani +theorem and polarization, proves their (sesqui)linearity and boundedness, and assembles them into +`cfcSesquilinearForm`. Continued in `UnitaryInfra/SpectralMeasure.lean`, which turns this +form into the projection-valued `cfcSpectralMeasure`. + +This file proves, for any bounded normal operator `U` on a complex Hilbert space, the +continuous-functional-calculus construction of its weak-operator spectral measure +(`WOTSpectralMeasure.cfcSpectralMeasure` and friends, completed in `SpectralMeasure.lean`) — the +existence half of the bounded spectral theorem that `Cayley/Certificate.lean`'s +`BoundedNormalSpectralData` and `BoundedUnitarySpectralData` interfaces record the shape of. +-/ + +@[expose] public section + +noncomputable section + +open MeasureTheory Set Topology +open scoped ComplexOrder CStarAlgebra InnerProductSpace + +namespace QuantumMechanics +variable {X : Type*} [TopologicalSpace X] [T2Space X] [MeasurableSpace X] + [BorelSpace X] [CompactSpace X] + +/-- A positive scalar functional on a compact spectrum. -/ +structure CompactPositiveFunctional where + /-- The underlying positive linear functional. -/ + functional : CompactlySupportedContinuousMap X ℝ →ₚ[ℝ] ℝ + +namespace CompactPositiveFunctional + +variable (Λ : CompactPositiveFunctional (X := X)) + +/-- The regular Borel measure represented by the scalar functional. -/ +noncomputable def measure : Measure X := RealRMK.rieszMeasure Λ.functional + +instance regular : (Λ.measure).Regular := by + dsimp [measure] + infer_instance + +lemma integral (f : CompactlySupportedContinuousMap X ℝ) : + ∫ x, f x ∂Λ.measure = Λ.functional f := by + exact RealRMK.integral_rieszMeasure Λ.functional f + +lemma integral_eq_zero_of_support_disjoint {f : CompactlySupportedContinuousMap X ℝ} + {S : Set X} (hS_meas : MeasurableSet S) (hS : ∀ x ∈ S, f x = 0) : + ∫ x, f x ∂(Λ.measure.restrict S) = 0 := by + apply MeasureTheory.integral_eq_zero_of_ae + filter_upwards [ae_restrict_mem hS_meas] with x hx + exact hS x hx + +lemma measure_ext {Λ₁ Λ₂ : CompactPositiveFunctional (X := X)} + (hΛ : ∀ f, Λ₁.functional f = Λ₂.functional f) : + Λ₁.measure = Λ₂.measure := by + apply MeasureTheory.Measure.ext_of_integral_eq_on_compactlySupported + intro f + rw [Λ₁.integral, Λ₂.integral, hΛ] + +end CompactPositiveFunctional + +/-! ## Range-map/vector-integral bridge -/ + +section VectorMeasureBridge + +variable {X E F G K : Type*} [MeasurableSpace X] + [NormedAddCommGroup E] [NormedSpace ℝ E] + [NormedAddCommGroup F] [NormedSpace ℝ F] + [NormedAddCommGroup G] [NormedSpace ℝ G] + [NormedAddCommGroup K] [NormedSpace ℝ K] [CompleteSpace K] + +/-- Pull a bilinear pairing back along a continuous linear map in its second argument. -/ +def pullbackPairing (L : F →L[ℝ] G) (B : E →L[ℝ] G →L[ℝ] K) : + E →L[ℝ] F →L[ℝ] K := + (B.flip.comp L).flip + +omit [CompleteSpace K] in +@[nolint unusedArguments] +lemma transpose_mapRange_pullback (μ : VectorMeasure X F) (L : F →L[ℝ] G) + (B : E →L[ℝ] G →L[ℝ] K) : + (μ.mapRange L.toAddMonoidHom L.continuous).transpose B = + μ.transpose (pullbackPairing L B) := by + ext s hs + simp [VectorMeasure.transpose, pullbackPairing, ContinuousLinearMap.flip_apply] + rfl + +omit [CompleteSpace K] in +lemma integral_mapRange_pullback (μ : VectorMeasure X F) (L : F →L[ℝ] G) + (B : E →L[ℝ] G →L[ℝ] K) (f : X → E) + (hfμ : μ.Integrable f) (hfL : (μ.mapRange L.toAddMonoidHom L.continuous).Integrable f) : + ∫ᵛ x, f x ∂[B; μ.mapRange L.toAddMonoidHom L.continuous] = + ∫ᵛ x, f x ∂[pullbackPairing L B; μ] := by + have hL := MeasureTheory.VectorMeasure.integral_eq_setToFun_transpose + (μ := μ.mapRange L.toAddMonoidHom L.continuous) (B := B) (f := f) hfL + have hμ := MeasureTheory.VectorMeasure.integral_eq_setToFun_transpose + (μ := μ) (B := pullbackPairing L B) (f := f) hfμ + have htranspose := transpose_mapRange_pullback (μ := μ) (L := L) (B := B) + calc + _ = _ := hL + _ = _ := by simp only [htranspose] + _ = _ := hμ.symm + +end VectorMeasureBridge + +/-! ## Complexification of finite signed measures -/ + +section Complexification + +/-- The pairing used for a complex-valued function against a real signed measure. -/ +def complexSignedPairing : ℂ →L[ℝ] ℝ →L[ℝ] ℂ := + (ContinuousLinearMap.lsmul ℝ ℝ (E := ℂ)).flip + +/-- Postcompose a pairing `E →L[ℝ] F →L[ℝ] G` with a continuous linear map `G →L[ℝ] K`, giving a +pairing `E →L[ℝ] F →L[ℝ] K`. -/ +def postcomposePairing {E F G K : Type*} + [NormedAddCommGroup E] [NormedSpace ℝ E] + [NormedAddCommGroup F] [NormedSpace ℝ F] + [NormedAddCommGroup G] [NormedSpace ℝ G] + [NormedAddCommGroup K] [NormedSpace ℝ K] + (C : G →L[ℝ] K) (B : E →L[ℝ] F →L[ℝ] G) : + E →L[ℝ] F →L[ℝ] K := + { toFun := fun e => C.comp (B e) + map_add' := by + intro x y + ext z + simp + map_smul' := by + intro c x + ext z + simp + cont := by fun_prop } + +lemma transpose_postcomposePairing_apply {X E F G K : Type*} [MeasurableSpace X] + [NormedAddCommGroup E] [NormedSpace ℝ E] + [NormedAddCommGroup F] [NormedSpace ℝ F] + [NormedAddCommGroup G] [NormedSpace ℝ G] + [NormedAddCommGroup K] [NormedSpace ℝ K] + (μ : VectorMeasure X F) (C : G →L[ℝ] K) (B : E →L[ℝ] F →L[ℝ] G) + (s : Set X) (x : E) : + μ.transpose (postcomposePairing C B) s x = C (μ.transpose B s x) := by + simp [VectorMeasure.transpose, postcomposePairing, ContinuousLinearMap.flip_apply, + ContinuousLinearMap.comp_apply, VectorMeasure.mapRange_apply] + rw [VectorMeasure.mapRange_apply (v := μ) (f := B.flip.toAddMonoidHom) + B.flip.continuous] + change C (B x (μ s)) = C (B x (μ s)) + rfl + +lemma setToL1S_compContinuousLinearMap {X E F G : Type*} [MeasurableSpace X] + [NormedAddCommGroup E] [NormedSpace ℝ E] + [NormedAddCommGroup F] [NormedSpace ℝ F] + [NormedAddCommGroup G] [NormedSpace ℝ G] + (T : Set X → E →L[ℝ] F) (T' : Set X → E →L[ℝ] G) (C : F →L[ℝ] G) + {μ : Measure X} + (h : ∀ s, MeasurableSet s → ∀ x, T' s x = C (T s x)) + (f : X →₁ₛ[μ] E) : + L1.SimpleFunc.setToL1S T' f = C (L1.SimpleFunc.setToL1S T f) := by + rw [L1.SimpleFunc.setToL1S_eq_setToSimpleFunc, + L1.SimpleFunc.setToL1S_eq_setToSimpleFunc] + simp only [SimpleFunc.setToSimpleFunc] + rw [map_sum] + apply Finset.sum_congr rfl + intro x hx + rw [h _ (SimpleFunc.measurableSet_fiber (Lp.simpleFunc.toSimpleFunc f) x)] + +lemma setToL1_compContinuousLinearMap {X E F G : Type*} [MeasurableSpace X] + [NormedAddCommGroup E] [NormedSpace ℝ E] + [NormedAddCommGroup F] [NormedSpace ℝ F] [CompleteSpace F] + [NormedAddCommGroup G] [NormedSpace ℝ G] [CompleteSpace G] + {μ : Measure X} {T : Set X → E →L[ℝ] F} {T' : Set X → E →L[ℝ] G} + {C₀ C₁ : ℝ} (hT : DominatedFinMeasAdditive μ T C₀) + (hT' : DominatedFinMeasAdditive μ T' C₁) (C : F →L[ℝ] G) + (h : ∀ s, MeasurableSet s → ∀ x, T' s x = C (T s x)) + (f : X →₁[μ] E) : + L1.setToL1 hT' f = C (L1.setToL1 hT f) := by + apply L1.setToL1_unique hT' (A := C.comp (L1.setToL1 hT)) + intro g + change L1.SimpleFunc.setToL1SCLM X E μ hT' g = + C (L1.setToL1 hT (Lp.simpleFunc.coeToLp X E ℝ g)) + rw [L1.setToL1_apply_coeToLp] + change L1.SimpleFunc.setToL1S T' g = C (L1.SimpleFunc.setToL1S T g) + exact setToL1S_compContinuousLinearMap T T' C h g + +lemma setToFun_compContinuousLinearMap {X E F G : Type*} [MeasurableSpace X] + [NormedAddCommGroup E] [NormedSpace ℝ E] + [NormedAddCommGroup F] [NormedSpace ℝ F] [CompleteSpace F] + [NormedAddCommGroup G] [NormedSpace ℝ G] [CompleteSpace G] + {μ : Measure X} {T : Set X → E →L[ℝ] F} {T' : Set X → E →L[ℝ] G} + {C₀ C₁ : ℝ} (hT : DominatedFinMeasAdditive μ T C₀) + (hT' : DominatedFinMeasAdditive μ T' C₁) (C : F →L[ℝ] G) + (h : ∀ s, MeasurableSet s → ∀ x, T' s x = C (T s x)) + {f : X → E} (hf : Integrable f μ) : + MeasureTheory.setToFun μ T' hT' f = C (MeasureTheory.setToFun μ T hT f) := by + rw [MeasureTheory.setToFun_eq hT' hf, MeasureTheory.setToFun_eq hT hf] + exact setToL1_compContinuousLinearMap hT hT' C h (hf.toL1 f) + +lemma integral_postcomposePairing {X E F G K : Type*} [MeasurableSpace X] + [NormedAddCommGroup E] [NormedSpace ℝ E] + [NormedAddCommGroup F] [NormedSpace ℝ F] + [NormedAddCommGroup G] [NormedSpace ℝ G] [CompleteSpace G] + [NormedAddCommGroup K] [NormedSpace ℝ K] [CompleteSpace K] + (μ : VectorMeasure X F) (B : E →L[ℝ] F →L[ℝ] G) (C : G →L[ℝ] K) + (f : X → E) (hf : μ.Integrable f) : + C (∫ᵛ x, f x ∂[B; μ]) = + ∫ᵛ x, f x ∂[postcomposePairing C B; μ] := by + rw [MeasureTheory.VectorMeasure.integral_eq_setToFun, + MeasureTheory.VectorMeasure.integral_eq_setToFun] + symm + exact setToFun_compContinuousLinearMap + (μ := μ.variation) (T := μ.transpose B) + (T' := μ.transpose (postcomposePairing C B)) + (hT := MeasureTheory.dominatedFinMeasAdditive_cbmApplyMeasure μ B) + (hT' := MeasureTheory.dominatedFinMeasAdditive_cbmApplyMeasure μ + (postcomposePairing C B)) C + (fun s hs x => transpose_postcomposePairing_apply μ C B s x) hf + +/-- Multiplication by `I`, followed by the canonical embedding of a real signed measure into a +complex vector measure. -/ +def imaginaryOfRealCLM : ℝ →L[ℝ] ℂ := + (ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ) Complex.I).comp Complex.ofRealCLM + +@[simp] +lemma imaginaryOfRealCLM_apply (r : ℝ) : imaginaryOfRealCLM r = Complex.I * r := by + simp [imaginaryOfRealCLM, ContinuousLinearMap.comp_apply] + +lemma signedMeasure_toComplexMeasure_eq_add_mapRange + {Y : Type*} [MeasurableSpace Y] (s t : SignedMeasure Y) : + s.toComplexMeasure t = + s.mapRange Complex.ofRealCLM.toAddMonoidHom Complex.ofRealCLM.continuous + + t.mapRange imaginaryOfRealCLM.toAddMonoidHom imaginaryOfRealCLM.continuous := by + ext S hS + simp only [SignedMeasure.toComplexMeasure_apply, + add_apply, VectorMeasure.mapRange_apply + (v := s) (f := Complex.ofRealCLM.toAddMonoidHom) Complex.ofRealCLM.continuous, + VectorMeasure.mapRange_apply (v := t) (f := imaginaryOfRealCLM.toAddMonoidHom) + imaginaryOfRealCLM.continuous] + change (⟨s S, t S⟩ : ℂ) = (s S : ℂ) + Complex.I * (t S : ℂ) + apply Complex.ext <;> simp + +lemma integral_toComplexMeasure_eq_add_mapRange + {X : Type*} [MeasurableSpace X] (s t : SignedMeasure X) (f : X → ℂ) + (hs : (s.mapRange Complex.ofRealCLM.toAddMonoidHom + Complex.ofRealCLM.continuous).Integrable f) + (ht : (t.mapRange imaginaryOfRealCLM.toAddMonoidHom + imaginaryOfRealCLM.continuous).Integrable f) : + ∫ᵛ x, f x ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); s.toComplexMeasure t] = + (∫ᵛ x, f x ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); + s.mapRange Complex.ofRealCLM.toAddMonoidHom Complex.ofRealCLM.continuous]) + + ∫ᵛ x, f x ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); + t.mapRange imaginaryOfRealCLM.toAddMonoidHom imaginaryOfRealCLM.continuous] := by + rw [signedMeasure_toComplexMeasure_eq_add_mapRange] + exact MeasureTheory.VectorMeasure.integral_add_vectorMeasure hs ht + +lemma pullbackPairing_ofReal_lsmul : + pullbackPairing Complex.ofRealCLM + (ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ)) = complexSignedPairing := by + ext z + simp [pullbackPairing, complexSignedPairing, ContinuousLinearMap.flip_apply, + ContinuousLinearMap.comp_apply] + +lemma integral_mapRange_ofReal_signedMeasure + {X : Type*} [MeasurableSpace X] (μ : Measure X) [IsFiniteMeasure μ] + (f : X → ℂ) (hf : Integrable f μ) : + ∫ᵛ x, f x ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); + μ.toSignedMeasure.mapRange Complex.ofRealCLM.toAddMonoidHom + Complex.ofRealCLM.continuous] = + ∫ᵛ x, f x ∂<•μ.toSignedMeasure := by + let μs := μ.toSignedMeasure + have hμ : μs.Integrable f := by + change Integrable f μs.variation + rw [MeasureTheory.Measure.variation_toSignedMeasure] + exact hf + have hvar : (μs.mapRange Complex.ofRealCLM.toAddMonoidHom + Complex.ofRealCLM.continuous).variation ≤ μs.variation := by + apply VectorMeasure.variation_le_of_forall_enorm_le + intro s hs + rw [VectorMeasure.mapRange_apply (v := μs) + (f := Complex.ofRealCLM.toAddMonoidHom) Complex.ofRealCLM.continuous] + change ‖(μs s : ℂ)‖ₑ ≤ _ + have hn : ‖(μs s : ℂ)‖ₑ = ‖μs s‖ₑ := by + rw [enorm_eq_nnnorm, enorm_eq_nnnorm] + apply congrArg ENNReal.ofNNReal + apply NNReal.eq + exact Complex.norm_real _ + rw [hn] + exact VectorMeasure.enorm_measure_le_variation μs s + have hmap : (μs.mapRange Complex.ofRealCLM.toAddMonoidHom + Complex.ofRealCLM.continuous).Integrable f := by + exact hf.mono_measure (hvar.trans_eq + (MeasureTheory.Measure.variation_toSignedMeasure (μ := μ))) + rw [integral_mapRange_pullback μs Complex.ofRealCLM + (ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ)) f hμ hmap] + rw [pullbackPairing_ofReal_lsmul] + change ∫ᵛ x, f x ∂<•μs = ∫ᵛ x, f x ∂<•μs + rfl + +lemma integrable_mapRange_toSignedMeasure + {X : Type*} [MeasurableSpace X] (μ : Measure X) [IsFiniteMeasure μ] + (L : ℝ →L[ℝ] ℂ) (hL : ∀ r : ℝ, ‖L r‖ = ‖r‖) + (f : X → ℂ) (hf : Integrable f μ) : + (μ.toSignedMeasure.mapRange L.toAddMonoidHom L.continuous).Integrable f := by + let μs := μ.toSignedMeasure + have hμ : μs.Integrable f := by + change Integrable f μs.variation + rw [MeasureTheory.Measure.variation_toSignedMeasure] + exact hf + have hvar : (μs.mapRange L.toAddMonoidHom L.continuous).variation ≤ μs.variation := by + apply VectorMeasure.variation_le_of_forall_enorm_le + intro s hs + rw [VectorMeasure.mapRange_apply (v := μs) (f := L.toAddMonoidHom) L.continuous] + change ‖L (μs s)‖ₑ ≤ _ + have hn : ‖L (μs s)‖ₑ = ‖μs s‖ₑ := by + rw [enorm_eq_nnnorm, enorm_eq_nnnorm] + apply congrArg ENNReal.ofNNReal + apply NNReal.eq + exact hL _ + rw [hn] + exact VectorMeasure.enorm_measure_le_variation μs s + exact hf.mono_measure (hvar.trans_eq + (MeasureTheory.Measure.variation_toSignedMeasure (μ := μ))) + +lemma integrable_mapRange_ofReal_signedMeasure + {X : Type*} [MeasurableSpace X] (μ : Measure X) [IsFiniteMeasure μ] + (f : X → ℂ) (hf : Integrable f μ) : + (μ.toSignedMeasure.mapRange Complex.ofRealCLM.toAddMonoidHom + Complex.ofRealCLM.continuous).Integrable f := by + apply integrable_mapRange_toSignedMeasure μ Complex.ofRealCLM (by + intro r + exact Complex.norm_real r) f hf + +lemma integrable_mapRange_imaginaryOfReal_signedMeasure + {X : Type*} [MeasurableSpace X] (μ : Measure X) [IsFiniteMeasure μ] + (f : X → ℂ) (hf : Integrable f μ) : + (μ.toSignedMeasure.mapRange imaginaryOfRealCLM.toAddMonoidHom + imaginaryOfRealCLM.continuous).Integrable f := by + apply integrable_mapRange_toSignedMeasure μ imaginaryOfRealCLM (by + intro r + rw [imaginaryOfRealCLM_apply] + simp) f hf + +lemma mapRange_sub_toSignedMeasure + {X : Type*} [MeasurableSpace X] (μ ν : Measure X) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] (L : ℝ →L[ℝ] ℂ) : + (μ.toSignedMeasure - ν.toSignedMeasure).mapRange L.toAddMonoidHom L.continuous = + μ.toSignedMeasure.mapRange L.toAddMonoidHom L.continuous - + ν.toSignedMeasure.mapRange L.toAddMonoidHom L.continuous := by + apply MeasureTheory.VectorMeasure.ext + intro S hS + change L ((μ.toSignedMeasure - ν.toSignedMeasure) S) = + L (μ.toSignedMeasure S) - L (ν.toSignedMeasure S) + rw [sub_apply] + simp + +lemma integral_mapRange_ofReal_signedDifference + {X : Type*} [MeasurableSpace X] + (μ ν : Measure X) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (c : ℝ) (f : X → ℂ) (hμ : Integrable f μ) (hν : Integrable f ν) : + ∫ᵛ x, f x ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); + (c • (μ.toSignedMeasure - ν.toSignedMeasure)).mapRange + Complex.ofRealCLM.toAddMonoidHom Complex.ofRealCLM.continuous] = + c • ((∫ x, f x ∂μ) - ∫ x, f x ∂ν) := by + have hμ' := integrable_mapRange_ofReal_signedMeasure μ f hμ + have hν' := integrable_mapRange_ofReal_signedMeasure ν f hν + rw [VectorMeasure.mapRange_smul, mapRange_sub_toSignedMeasure μ ν] + rw [MeasureTheory.VectorMeasure.integral_smul_vectorMeasure, + MeasureTheory.VectorMeasure.integral_sub_vectorMeasure hμ' hν'] + rw [integral_mapRange_ofReal_signedMeasure μ f hμ, + integral_mapRange_ofReal_signedMeasure ν f hν] + rw [MeasureTheory.VectorMeasure.integral_toSignedMeasure, + MeasureTheory.VectorMeasure.integral_toSignedMeasure] + +/-- Multiplication by `I`, as a continuous ℝ-linear map on `ℂ`. -/ +def imaginaryMulCLM : ℂ →L[ℝ] ℂ := + ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ) Complex.I + +@[simp] +lemma imaginaryMulCLM_apply (z : ℂ) : imaginaryMulCLM z = Complex.I * z := by + rfl + +/-- The `ℂ →L[ℝ] ℝ →L[ℝ] ℂ` pairing post-composed with multiplication by `I`. -/ +def imaginarySignedPairing : ℂ →L[ℝ] ℝ →L[ℝ] ℂ := + postcomposePairing imaginaryMulCLM complexSignedPairing + +lemma pullbackPairing_imaginaryOfReal_lsmul : + pullbackPairing imaginaryOfRealCLM + (ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ)) = imaginarySignedPairing := by + ext z + simp [pullbackPairing, imaginarySignedPairing, imaginaryMulCLM, + complexSignedPairing, postcomposePairing, ContinuousLinearMap.flip_apply, + ContinuousLinearMap.comp_apply] + ring + +lemma integral_mapRange_imaginaryOfReal_signedMeasure + {X : Type*} [MeasurableSpace X] (μ : Measure X) [IsFiniteMeasure μ] + (f : X → ℂ) (hf : Integrable f μ) : + ∫ᵛ x, f x ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); + μ.toSignedMeasure.mapRange imaginaryOfRealCLM.toAddMonoidHom + imaginaryOfRealCLM.continuous] = + Complex.I * (∫ x, f x ∂μ) := by + let μs := μ.toSignedMeasure + have hμ : μs.Integrable f := by + change Integrable f μs.variation + rw [MeasureTheory.Measure.variation_toSignedMeasure] + exact hf + have hvar : (μs.mapRange imaginaryOfRealCLM.toAddMonoidHom + imaginaryOfRealCLM.continuous).variation ≤ μs.variation := by + apply VectorMeasure.variation_le_of_forall_enorm_le + intro s hs + rw [VectorMeasure.mapRange_apply (v := μs) + (f := imaginaryOfRealCLM.toAddMonoidHom) imaginaryOfRealCLM.continuous] + change ‖imaginaryOfRealCLM (μs s)‖ₑ ≤ _ + rw [imaginaryOfRealCLM_apply] + have hn : ‖Complex.I * (μs s : ℂ)‖ₑ = ‖μs s‖ₑ := by + rw [enorm_eq_nnnorm, enorm_eq_nnnorm] + apply congrArg ENNReal.ofNNReal + apply NNReal.eq + simp + rw [hn] + exact VectorMeasure.enorm_measure_le_variation μs s + have hmap : (μs.mapRange imaginaryOfRealCLM.toAddMonoidHom + imaginaryOfRealCLM.continuous).Integrable f := by + exact hf.mono_measure (hvar.trans_eq + (MeasureTheory.Measure.variation_toSignedMeasure (μ := μ))) + rw [integral_mapRange_pullback μs imaginaryOfRealCLM + (ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ)) f hμ hmap] + rw [pullbackPairing_imaginaryOfReal_lsmul] + change (∫ᵛ x, f x ∂[postcomposePairing imaginaryMulCLM complexSignedPairing; μs]) = _ + rw [← integral_postcomposePairing μs complexSignedPairing imaginaryMulCLM f hμ] + change imaginaryMulCLM (∫ᵛ x, f x ∂<•μs) = _ + rw [MeasureTheory.VectorMeasure.integral_toSignedMeasure] + simp [imaginaryMulCLM] + +lemma integral_mapRange_imaginaryOfReal_signedDifference + {X : Type*} [MeasurableSpace X] + (μ ν : Measure X) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (c : ℝ) (f : X → ℂ) (hμ : Integrable f μ) (hν : Integrable f ν) : + ∫ᵛ x, f x ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); + (c • (μ.toSignedMeasure - ν.toSignedMeasure)).mapRange + imaginaryOfRealCLM.toAddMonoidHom imaginaryOfRealCLM.continuous] = + c • (Complex.I * ((∫ x, f x ∂μ) - ∫ x, f x ∂ν)) := by + have hμ' := integrable_mapRange_imaginaryOfReal_signedMeasure μ f hμ + have hν' := integrable_mapRange_imaginaryOfReal_signedMeasure ν f hν + rw [VectorMeasure.mapRange_smul, mapRange_sub_toSignedMeasure μ ν] + rw [MeasureTheory.VectorMeasure.integral_smul_vectorMeasure, + MeasureTheory.VectorMeasure.integral_sub_vectorMeasure hμ' hν'] + rw [integral_mapRange_imaginaryOfReal_signedMeasure μ f hμ, + integral_mapRange_imaginaryOfReal_signedMeasure ν f hν] + simp [sub_eq_add_neg] + ring + +end Complexification + +/-! ## Finiteness of the polarized scalar measures -/ + +set_option maxHeartbeats 3000000 in +lemma isFiniteMeasure_toComplexMeasure + {X : Type*} [MeasurableSpace X] (s t : MeasureTheory.SignedMeasure X) + [IsFiniteMeasure s.variation] [IsFiniteMeasure t.variation] : + IsFiniteMeasure (s.toComplexMeasure t).variation := by + apply isFiniteMeasure_of_le (s.variation + t.variation) + apply MeasureTheory.VectorMeasure.variation_le_of_forall_enorm_le + intro A hA + calc + ‖(s.toComplexMeasure t) A‖ₑ = ‖(⟨s A, t A⟩ : ℂ)‖ₑ := rfl + _ = ‖(s A : ℂ) + (t A : ℂ) * Complex.I‖ₑ := by + congr 1 + apply Complex.ext <;> simp + _ ≤ ‖(s A : ℂ)‖ₑ + ‖(t A : ℂ) * Complex.I‖ₑ := enorm_add_le _ _ + _ = ‖s A‖ₑ + ‖t A‖ₑ := by + simp [enorm_eq_nnnorm] + _ ≤ s.variation A + t.variation A := + add_le_add (MeasureTheory.VectorMeasure.enorm_measure_le_variation s A) + (MeasureTheory.VectorMeasure.enorm_measure_le_variation t A) + +/-! ## A general positive-contraction norm estimate + +This is a standalone fact about `H →L[ℂ] H` for any complex Hilbert space `H`, not specific to the +continuous functional calculus of a fixed normal operator: it is Step 2 of the idempotency +argument below, quantifying `0 ≤ A ≤ 1 ⟹ A ^ 2 ≤ A` into a norm bound. -/ + +section PositiveContraction + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-- **The positive-contraction norm estimate.** If `0 ≤ A ≤ 1` in the Loewner order on +`H →L[ℂ] H`, then `‖A x‖ ^ 2 ≤ re ⟪x, A x⟫` for every `x`. Proved from `A ^ 2 ≤ A` +(`CStarAlgebra.pow_antitone`, using the `CStarAlgebra (H →L[ℂ] H)` instance) and self-adjointness +of `A` to identify `⟪x, A ^ 2 x⟫` with `⟪A x, A x⟫ = ‖A x‖ ^ 2`. -/ +lemma norm_sq_le_inner_of_isPositive_of_le_one {A : H →L[ℂ] H} + (hA0 : 0 ≤ A) (hA1 : A ≤ 1) (x : H) : + ‖A x‖ ^ 2 ≤ RCLike.re ⟪x, A x⟫_ℂ := by + have hApos : A.IsPositive := (ContinuousLinearMap.nonneg_iff_isPositive A).mp hA0 + have hAsa : IsSelfAdjoint A := hApos.isSelfAdjoint + have hanti : Antitone (A ^ · : ℕ → H →L[ℂ] H) := CStarAlgebra.pow_antitone hA0 hA1 + have hsq_le : A ^ 2 ≤ A ^ 1 := hanti (by norm_num) + rw [pow_one] at hsq_le + have hpos_diff : ContinuousLinearMap.IsPositive (A - A ^ 2) := + (ContinuousLinearMap.le_def _ _).mp hsq_le + have hre : 0 ≤ RCLike.re ⟪x, (A - A ^ 2) x⟫_ℂ := hpos_diff.re_inner_nonneg_right x + have hexpand : ⟪x, (A - A ^ 2) x⟫_ℂ = ⟪x, A x⟫_ℂ - ⟪x, (A ^ 2) x⟫_ℂ := by + rw [sub_apply, inner_sub_right] + have hAsq : (A ^ 2) x = A (A x) := by + rw [sq, ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_apply] + have hsym : ⟪A x, A x⟫_ℂ = ⟪x, A (A x)⟫_ℂ := hAsa.isSymmetric x (A x) + have hnormsq : ⟪A x, A x⟫_ℂ = ((‖A x‖ ^ 2 : ℝ) : ℂ) := by + rw [inner_self_eq_norm_sq_to_K] + norm_cast + rw [hexpand, hAsq, ← hsym, hnormsq, map_sub] at hre + simp only [Complex.ofReal_re, show ∀ z : ℂ, RCLike.re z = z.re from fun _ => rfl] at hre + show ‖A x‖ ^ 2 ≤ (⟪x, A x⟫_ℂ).re + linarith [hre] + +end PositiveContraction + +/-! ## Positive scalar functionals from the continuous functional calculus -/ + +section CFCScalar + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] +variable (U : H →L[ℂ] H) (hU : IsStarNormal U) + +/-- Regard a real-valued continuous function on the spectrum of a normal operator as a complex +valued one. Keeping this map explicit prevents the real/complex scalar changes in the Riesz +construction from being hidden in coercions. -/ +noncomputable def realToComplexContinuousMap + (f : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ) : + C(spectrum ℂ U, ℂ) := + ContinuousMap.compStarAlgHom (spectrum ℂ U) (RCLike.ofRealStarAlgHom ℂ) + RCLike.continuous_ofReal f.toContinuousMap + +omit [CompleteSpace H] in +@[nolint unusedArguments, simp] +lemma realToComplexContinuousMap_apply + (f : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ) (z : spectrum ℂ U) : + realToComplexContinuousMap U f z = f z := by + rfl + +omit [CompleteSpace H] in +lemma realToComplexContinuousMap_add + (f g : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ) : + realToComplexContinuousMap U (f + g) = + realToComplexContinuousMap U f + realToComplexContinuousMap U g := by + ext z + simp + +omit [CompleteSpace H] in +lemma realToComplexContinuousMap_smul (r : ℝ) + (f : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ) : + realToComplexContinuousMap U (r • f) = + (r : ℂ) • realToComplexContinuousMap U f := by + ext z + simp + +/-- The operator obtained by applying the complex continuous functional calculus to a real test +function. -/ +noncomputable def cfcRealOperator + (f : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ) : H →L[ℂ] H := + cfcHom hU (realToComplexContinuousMap U f) + +lemma cfcRealOperator_isSelfAdjoint + (f : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ) : + IsSelfAdjoint (cfcRealOperator U hU f) := by + have hfstar : star (realToComplexContinuousMap U f) = + realToComplexContinuousMap U f := by + ext z + change starRingEnd ℂ (f z : ℂ) = f z + simp + change star (cfcHom hU (realToComplexContinuousMap U f)) = _ + rw [← map_star, hfstar] + rfl + +lemma cfcRealOperator_nonneg + (f : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ) + (hf : ∀ z, 0 ≤ f z) : + ContinuousLinearMap.IsPositive (cfcRealOperator U hU f) := by + let gR : C(spectrum ℂ U, ℝ) := + ⟨fun z ↦ Real.sqrt (f z), Real.continuous_sqrt.comp f.continuous⟩ + let g : C(spectrum ℂ U, ℂ) := + ContinuousMap.compStarAlgHom (spectrum ℂ U) (RCLike.ofRealStarAlgHom ℂ) + RCLike.continuous_ofReal gR + have hsq : realToComplexContinuousMap U f = star g * g := by + ext z + change (f z : ℂ) = starRingEnd ℂ (Real.sqrt (f z) : ℂ) * Real.sqrt (f z) + simp [← Complex.ofReal_mul, Real.mul_self_sqrt (hf z)] + change ContinuousLinearMap.IsPositive (cfcHom hU (realToComplexContinuousMap U f)) + rw [hsq, map_mul, map_star] + simpa only [ContinuousLinearMap.star_eq_adjoint, ContinuousLinearMap.mul_def] using + ContinuousLinearMap.isPositive_adjoint_comp_self (cfcHom hU g) + +/-- The vector state of the continuous functional calculus, restricted to real test functions. +The positivity proof is the square-root argument above; this is the exact input required by +Riesz--Markov. -/ +noncomputable def cfcScalarFunctional (x : H) : + CompactPositiveFunctional (X := spectrum ℂ U) where + functional := PositiveLinearMap.mk₀ + { toFun := fun f ↦ RCLike.re ⟪x, cfcRealOperator U hU f x⟫_ℂ + map_add' := by + intro f g + change RCLike.re ⟪x, cfcRealOperator U hU (f + g) x⟫_ℂ = _ + rw [cfcRealOperator, realToComplexContinuousMap_add, map_add, + add_apply, inner_add_right] + simp [cfcRealOperator] + map_smul' := by + intro r f + change RCLike.re ⟪x, cfcRealOperator U hU (r • f) x⟫_ℂ = _ + rw [cfcRealOperator, realToComplexContinuousMap_smul, map_smul, + smul_apply, inner_smul_right] + simp [cfcRealOperator] } + (fun f hf ↦ (cfcRealOperator_nonneg U hU f hf).re_inner_nonneg_right x) + +lemma cfcScalarFunctional_apply (x : H) + (f : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ) : + (cfcScalarFunctional (hU := hU) U x).functional f = + RCLike.re ⟪x, cfcRealOperator U hU f x⟫_ℂ := by + rfl + +/-- The scalar spectral measure supplied by Riesz--Markov for the vector state at `x`. -/ +noncomputable def cfcScalarMeasure (x : H) : Measure (spectrum ℂ U) := + (cfcScalarFunctional (hU := hU) U x).measure + +instance cfcScalarMeasure_isFinite (x : H) : IsFiniteMeasure (cfcScalarMeasure U hU x) := by + dsimp [cfcScalarMeasure, CompactPositiveFunctional.measure] + infer_instance + +lemma cfcScalarMeasure_integral (x : H) + (f : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ) : + ∫ z, f z ∂cfcScalarMeasure U hU x = + RCLike.re ⟪x, cfcRealOperator U hU f x⟫_ℂ := by + exact CompactPositiveFunctional.integral (cfcScalarFunctional (hU := hU) U x) f + +lemma cfcScalarMeasure_integral_complex (x : H) + (f : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ) : + ((∫ z, f z ∂cfcScalarMeasure U hU x : ℝ) : ℂ) = + ⟪cfcRealOperator U hU f x, x⟫_ℂ := by + rw [cfcScalarMeasure_integral] + let A := cfcRealOperator U hU f + have hA : IsSelfAdjoint A := cfcRealOperator_isSelfAdjoint U hU f + have hreal : + (RCLike.re ⟪x, A x⟫_ℂ : ℂ) = ⟪A x, x⟫_ℂ := by + calc + (RCLike.re ⟪x, A x⟫_ℂ : ℂ) = + (RCLike.re ⟪A x, x⟫_ℂ : ℂ) := by + rw [inner_re_symm] + _ = ⟪A x, x⟫_ℂ := + Complex.conj_eq_iff_re.mp (hA.isSymmetric.conj_inner_sym x x) + exact hreal + +/-- The scalar integral of a real test function against the polarized candidate. This is written +explicitly while the general vector-measure integral bridge is being proved. -/ +noncomputable def polarizedCfcRealIntegral + (f : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ) (x y : H) : ℂ := + ((1 / 4 : ℝ) * + ((∫ z, f z ∂cfcScalarMeasure U hU (x + y)) - + ∫ z, f z ∂cfcScalarMeasure U hU (x - y)) : ℂ) + + Complex.I * ((1 / 4 : ℝ) * + ((∫ z, f z ∂cfcScalarMeasure U hU (x + Complex.I • y)) - + ∫ z, f z ∂cfcScalarMeasure U hU (x - Complex.I • y)) : ℂ) + +lemma polarizedCfcRealIntegral_eq_inner + (f : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ) (x y : H) : + polarizedCfcRealIntegral U hU f x y = + ⟪y, cfcRealOperator U hU f x⟫_ℂ := by + let A := cfcRealOperator U hU f + have hdiag (v : H) : + ((∫ z, f z ∂cfcScalarMeasure U hU v : ℝ) : ℂ) = ⟪A v, v⟫_ℂ := by + exact cfcScalarMeasure_integral_complex U hU v f + have hpolar := inner_map_polarization (A : H →ₗ[ℂ] H) x y + have hsym : ⟪A y, x⟫_ℂ = ⟪y, A x⟫_ℂ := + (cfcRealOperator_isSelfAdjoint U hU f).isSymmetric y x + rw [← hsym] + simp only [polarizedCfcRealIntegral, hdiag (x + y), hdiag (x - y), + hdiag (x + Complex.I • y), hdiag (x - Complex.I • y)] + calc + _ = (⟪A (x + y), x + y⟫_ℂ - ⟪A (x - y), x - y⟫_ℂ + + Complex.I * ⟪A (x + Complex.I • y), x + Complex.I • y⟫_ℂ - + Complex.I * ⟪A (x - Complex.I • y), x - Complex.I • y⟫_ℂ) / 4 := by + norm_num + ring + _ = _ := hpolar.symm + +/-- The scalar half of the normal-operator spectral construction. The operator-valued assembly +below uses this data to build the actual weak-operator spectral measure. -/ +structure VectorStateSpectralData where + /-- The scalar measure attached to each vector `x`. -/ + measure : H → Measure (spectrum ℂ U) + integral_identity : ∀ x f, + ∫ z, f z ∂measure x = RCLike.re ⟪x, cfcRealOperator U hU f x⟫_ℂ + +/-- The scalar spectral data of `U`'s continuous functional calculus. -/ +noncomputable def cfcVectorStateSpectralData : VectorStateSpectralData U hU where + measure := cfcScalarMeasure U hU + integral_identity := cfcScalarMeasure_integral U hU + +lemma cfcScalarMeasure_parallelogram (x y : H) : + cfcScalarMeasure U hU (x + y) + cfcScalarMeasure U hU (x - y) = + (cfcScalarMeasure U hU x + cfcScalarMeasure U hU x) + + (cfcScalarMeasure U hU y + cfcScalarMeasure U hU y) := by + apply MeasureTheory.Measure.ext_of_integral_eq_on_compactlySupported + intro f + have hf : ∀ v : H, Integrable (f : spectrum ℂ U → ℝ) (cfcScalarMeasure U hU v) := by + intro v + rw [← integrableOn_univ] + exact f.continuous.continuousOn.integrableOn_compact isCompact_univ + have hxx : Integrable (f : spectrum ℂ U → ℝ) + (cfcScalarMeasure U hU x + cfcScalarMeasure U hU x) := + integrable_add_measure.mpr ⟨hf x, hf x⟩ + have hyy : Integrable (f : spectrum ℂ U → ℝ) + (cfcScalarMeasure U hU y + cfcScalarMeasure U hU y) := + integrable_add_measure.mpr ⟨hf y, hf y⟩ + rw [integral_add_measure (hf (x + y)) (hf (x - y)), + integral_add_measure hxx hyy, + integral_add_measure (hf x) (hf x), integral_add_measure (hf y) (hf y)] + simp only [cfcScalarMeasure_integral] + let A := cfcRealOperator U hU f + have hA : IsSelfAdjoint A := cfcRealOperator_isSelfAdjoint U hU f + change RCLike.re ⟪x + y, A (x + y)⟫_ℂ + + RCLike.re ⟪x - y, A (x - y)⟫_ℂ = + (RCLike.re ⟪x, A x⟫_ℂ + RCLike.re ⟪x, A x⟫_ℂ) + + (RCLike.re ⟪y, A y⟫_ℂ + RCLike.re ⟪y, A y⟫_ℂ) + simp only [map_add, map_neg, inner_add_left, inner_add_right, sub_eq_add_neg, + inner_neg_left, inner_neg_right] + ring + +lemma cfcScalarMeasure_neg (x : H) : + cfcScalarMeasure U hU (-x) = cfcScalarMeasure U hU x := by + apply MeasureTheory.Measure.ext_of_integral_eq_on_compactlySupported + intro f + have hfx : Integrable (f : spectrum ℂ U → ℝ) (cfcScalarMeasure U hU x) := by + rw [← integrableOn_univ] + exact f.continuous.continuousOn.integrableOn_compact isCompact_univ + simp only [cfcScalarMeasure_integral] + simp [inner_neg_left, inner_neg_right] + +lemma cfcScalarMeasure_I_smul (x : H) : + cfcScalarMeasure U hU (Complex.I • x) = cfcScalarMeasure U hU x := by + apply MeasureTheory.Measure.ext_of_integral_eq_on_compactlySupported + intro f + have hfx : Integrable (f : spectrum ℂ U → ℝ) (cfcScalarMeasure U hU x) := by + rw [← integrableOn_univ] + exact f.continuous.continuousOn.integrableOn_compact isCompact_univ + have hix : Integrable (f : spectrum ℂ U → ℝ) + (cfcScalarMeasure U hU (Complex.I • x)) := by + rw [← integrableOn_univ] + exact f.continuous.continuousOn.integrableOn_compact isCompact_univ + simp only [cfcScalarMeasure_integral] + simp [inner_smul_left, inner_smul_right] + +/-- The complex scalar measure obtained by polarizing the four diagonal Riesz measures. This is +the canonical candidate for `⟪y, E(·) x⟫`; the next assembly theorem must prove that these +candidates are sesquilinear and have the required weak σ-additivity. -/ +noncomputable def polarizedCfcScalarMeasure (x y : H) : ComplexMeasure (spectrum ℂ U) := + let muPlus := (cfcScalarMeasure U hU (x + y)).toSignedMeasure + let muMinus := (cfcScalarMeasure U hU (x - y)).toSignedMeasure + let nuPlus := (cfcScalarMeasure U hU (x + Complex.I • y)).toSignedMeasure + let nuMinus := (cfcScalarMeasure U hU (x - Complex.I • y)).toSignedMeasure + ((1 / 4 : ℝ) • (muPlus - muMinus)).toComplexMeasure + ((1 / 4 : ℝ) • (nuPlus - nuMinus)) + +set_option maxHeartbeats 1000000 in +lemma polarizedCfcScalarMeasure_isFiniteMeasure (x y : H) : + IsFiniteMeasure + (polarizedCfcScalarMeasure (hU := hU) U x y).variation := by + unfold polarizedCfcScalarMeasure + have hsub (a b : H) : IsFiniteMeasure + (((1 / 4 : ℝ) • ((cfcScalarMeasure U hU a).toSignedMeasure - + (cfcScalarMeasure U hU b).toSignedMeasure)).variation) := by + let : IsFiniteMeasure (cfcScalarMeasure U hU a).toSignedMeasure.variation := by + rw [Measure.variation_toSignedMeasure] + infer_instance + let : IsFiniteMeasure (cfcScalarMeasure U hU b).toSignedMeasure.variation := by + rw [Measure.variation_toSignedMeasure] + infer_instance + apply isFiniteMeasure_of_le (cfcScalarMeasure U hU a + cfcScalarMeasure U hU b) + rw [MeasureTheory.VectorMeasure.variation_smul] + have hv : ((cfcScalarMeasure U hU a).toSignedMeasure - + (cfcScalarMeasure U hU b).toSignedMeasure).variation ≤ + cfcScalarMeasure U hU a + cfcScalarMeasure U hU b := by + simpa only [Measure.variation_toSignedMeasure] using + (MeasureTheory.VectorMeasure.variation_sub_le + (μ := (cfcScalarMeasure U hU a).toSignedMeasure) + (ν := (cfcScalarMeasure U hU b).toSignedMeasure)) + calc + ‖(1 / 4 : ℝ)‖₊ • + ((cfcScalarMeasure U hU a).toSignedMeasure - + (cfcScalarMeasure U hU b).toSignedMeasure).variation ≤ + (1 : ENNReal) • ((cfcScalarMeasure U hU a).toSignedMeasure - + (cfcScalarMeasure U hU b).toSignedMeasure).variation := by + change ((‖(1 / 4 : ℝ)‖₊ : NNReal) : ENNReal) • + ((cfcScalarMeasure U hU a).toSignedMeasure - + (cfcScalarMeasure U hU b).toSignedMeasure).variation ≤ + (1 : ENNReal) • ((cfcScalarMeasure U hU a).toSignedMeasure - + (cfcScalarMeasure U hU b).toSignedMeasure).variation + gcongr + norm_num + _ ≤ (1 : ENNReal) • (cfcScalarMeasure U hU a + cfcScalarMeasure U hU b) := by + simpa only [one_smul] using hv + _ = cfcScalarMeasure U hU a + cfcScalarMeasure U hU b := by simp + let hplus : IsFiniteMeasure + (((1 / 4 : ℝ) • ((cfcScalarMeasure U hU (x + y)).toSignedMeasure - + (cfcScalarMeasure U hU (x - y)).toSignedMeasure)).variation) := + hsub (x + y) (x - y) + let hminus : IsFiniteMeasure + (((1 / 4 : ℝ) • ((cfcScalarMeasure U hU (x + Complex.I • y)).toSignedMeasure - + (cfcScalarMeasure U hU (x - Complex.I • y)).toSignedMeasure)).variation) := + hsub (x + Complex.I • y) (x - Complex.I • y) + exact isFiniteMeasure_toComplexMeasure + (((1 / 4 : ℝ) • ((cfcScalarMeasure U hU (x + y)).toSignedMeasure - + (cfcScalarMeasure U hU (x - y)).toSignedMeasure))) + (((1 / 4 : ℝ) • ((cfcScalarMeasure U hU (x + Complex.I • y)).toSignedMeasure - + (cfcScalarMeasure U hU (x - Complex.I • y)).toSignedMeasure))) + +lemma polarizedCfcScalarMeasure_complexIntegral + (f : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ) (x y : H) : + ∫ᵛ z, (f z : ℂ) ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); + polarizedCfcScalarMeasure (hU := hU) U x y] = + polarizedCfcRealIntegral U hU f x y := by + let fC : spectrum ℂ U → ℂ := fun z ↦ f z + have hfC : Continuous fC := by + fun_prop + have hplus : Integrable fC (cfcScalarMeasure U hU (x + y)) := by + rw [← integrableOn_univ] + exact hfC.continuousOn.integrableOn_compact isCompact_univ + have hminus : Integrable fC (cfcScalarMeasure U hU (x - y)) := by + rw [← integrableOn_univ] + exact hfC.continuousOn.integrableOn_compact isCompact_univ + have hip : Integrable fC + (cfcScalarMeasure U hU (x + Complex.I • y)) := by + rw [← integrableOn_univ] + exact hfC.continuousOn.integrableOn_compact isCompact_univ + have him : Integrable fC + (cfcScalarMeasure U hU (x - Complex.I • y)) := by + rw [← integrableOn_univ] + exact hfC.continuousOn.integrableOn_compact isCompact_univ + let μplus := cfcScalarMeasure U hU (x + y) + let μminus := cfcScalarMeasure U hU (x - y) + let νplus := cfcScalarMeasure U hU (x + Complex.I • y) + let νminus := cfcScalarMeasure U hU (x - Complex.I • y) + change ∫ᵛ z, fC z ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); + ((1 / 4 : ℝ) • (μplus.toSignedMeasure - μminus.toSignedMeasure)).toComplexMeasure + ((1 / 4 : ℝ) • (νplus.toSignedMeasure - νminus.toSignedMeasure))] = _ + have hreal : + (((1 / 4 : ℝ) • (μplus.toSignedMeasure - μminus.toSignedMeasure)).mapRange + Complex.ofRealCLM.toAddMonoidHom Complex.ofRealCLM.continuous).Integrable fC := by + rw [VectorMeasure.mapRange_smul, mapRange_sub_toSignedMeasure μplus μminus] + exact (integrable_mapRange_ofReal_signedMeasure μplus fC hplus).sub_vectorMeasure + (integrable_mapRange_ofReal_signedMeasure μminus fC hminus) |>.smul_vectorMeasure _ + have himag : + (((1 / 4 : ℝ) • (νplus.toSignedMeasure - νminus.toSignedMeasure)).mapRange + imaginaryOfRealCLM.toAddMonoidHom imaginaryOfRealCLM.continuous).Integrable fC := by + rw [VectorMeasure.mapRange_smul, mapRange_sub_toSignedMeasure νplus νminus] + exact (integrable_mapRange_imaginaryOfReal_signedMeasure νplus fC hip).sub_vectorMeasure + (integrable_mapRange_imaginaryOfReal_signedMeasure νminus fC him) |>.smul_vectorMeasure _ + rw [integral_toComplexMeasure_eq_add_mapRange _ _ fC hreal himag] + rw [integral_mapRange_ofReal_signedDifference μplus μminus (1 / 4 : ℝ) fC hplus hminus, + integral_mapRange_imaginaryOfReal_signedDifference νplus νminus (1 / 4 : ℝ) fC hip him] + dsimp [fC] + simp only [integral_complex_ofReal] + simp [polarizedCfcRealIntegral, μplus, μminus, νplus, νminus] + ring + +lemma polarizedCfcScalarMeasure_complexIntegral_eq_inner + (f : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ) (x y : H) : + ∫ᵛ z, (f z : ℂ) ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); + polarizedCfcScalarMeasure (hU := hU) U x y] = + ⟪y, cfcRealOperator U hU f x⟫_ℂ := by + rw [polarizedCfcScalarMeasure_complexIntegral] + exact polarizedCfcRealIntegral_eq_inner U hU f x y + +lemma polarizedCfcScalarMeasure_apply {x y : H} + {S : Set (spectrum ℂ U)} (hS : MeasurableSet S) : + polarizedCfcScalarMeasure (hU := hU) U x y S = + ((1 / 4 : ℝ) * + ((cfcScalarMeasure U hU (x + y)).real S - + (cfcScalarMeasure U hU (x - y)).real S) : ℂ) + + Complex.I * ((1 / 4 : ℝ) * + ((cfcScalarMeasure U hU (x + Complex.I • y)).real S - + (cfcScalarMeasure U hU (x - Complex.I • y)).real S) : ℂ) := by + simp [polarizedCfcScalarMeasure, MeasureTheory.SignedMeasure.toComplexMeasure_apply, + MeasureTheory.Measure.toSignedMeasure_apply_measurable hS] + apply Complex.ext <;> simp + +/-! ## Sesquilinearity of the polarized measure -/ + +/-- The real-valued version of the parallelogram law, at a fixed (not necessarily measurable) +set `S`. This is the algebraic engine behind the sesquilinearity proofs below. -/ +lemma cfcScalarMeasure_real_parallelogram (a b : H) (S : Set (spectrum ℂ U)) : + (cfcScalarMeasure U hU (a + b)).real S + (cfcScalarMeasure U hU (a - b)).real S = + 2 * (cfcScalarMeasure U hU a).real S + 2 * (cfcScalarMeasure U hU b).real S := by + have hS : cfcScalarMeasure U hU (a + b) S + cfcScalarMeasure U hU (a - b) S = + cfcScalarMeasure U hU a S + cfcScalarMeasure U hU a S + + (cfcScalarMeasure U hU b S + cfcScalarMeasure U hU b S) := + congrArg (fun μ : Measure (spectrum ℂ U) => μ S) (cfcScalarMeasure_parallelogram U hU a b) + have hne : ∀ v : H, cfcScalarMeasure U hU v S ≠ ⊤ := fun v => measure_ne_top _ S + have hreal := congrArg ENNReal.toReal hS + rw [ENNReal.toReal_add (hne _) (hne _)] at hreal + rw [ENNReal.toReal_add (ENNReal.add_ne_top.mpr ⟨hne _, hne _⟩) + (ENNReal.add_ne_top.mpr ⟨hne _, hne _⟩)] at hreal + rw [ENNReal.toReal_add (hne _) (hne _), ENNReal.toReal_add (hne _) (hne _)] at hreal + simpa [measureReal_def, two_mul] using hreal + +lemma cfcScalarMeasure_real_neg (a : H) (S : Set (spectrum ℂ U)) : + (cfcScalarMeasure U hU (-a)).real S = (cfcScalarMeasure U hU a).real S := by + rw [cfcScalarMeasure_neg] + +lemma cfcScalarMeasure_real_I_smul (a : H) (S : Set (spectrum ℂ U)) : + (cfcScalarMeasure U hU (Complex.I • a)).real S = (cfcScalarMeasure U hU a).real S := by + rw [cfcScalarMeasure_I_smul] + +lemma cfcScalarMeasure_real_nonneg (a : H) (S : Set (spectrum ℂ U)) : + 0 ≤ (cfcScalarMeasure U hU a).real S := ENNReal.toReal_nonneg + +/-- The Riesz measure for the vector state at `x` has total mass `‖x‖ ^ 2`: the vector-state +counterpart of `cfcHom hU 1 = 1`. -/ +lemma cfcScalarMeasure_real_univ (x : H) : + (cfcScalarMeasure U hU x).real Set.univ = ‖x‖ ^ 2 := by + let f1 : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ := + { toFun := fun _ => 1 + continuous_toFun := continuous_const + hasCompactSupport' := HasCompactSupport.of_compactSpace _ } + have hf1val : ∀ z, f1 z = 1 := fun _ => rfl + have hop : cfcRealOperator U hU f1 = 1 := by + have hone : realToComplexContinuousMap U f1 = 1 := by + ext z + simp [realToComplexContinuousMap_apply, hf1val] + unfold cfcRealOperator + rw [hone, map_one] + have hint := cfcScalarMeasure_integral U hU x f1 + rw [hop] at hint + have hint2 : ∫ z, f1 z ∂cfcScalarMeasure U hU x = (cfcScalarMeasure U hU x).real Set.univ := by + simp only [hf1val] + rw [MeasureTheory.integral_const] + simp [measureReal_def] + rw [hint2] at hint + rw [hint, one_apply_eq_self, inner_self_eq_norm_sq] + +lemma cfcScalarMeasure_real_le_univ (a : H) (S : Set (spectrum ℂ U)) : + (cfcScalarMeasure U hU a).real S ≤ ‖a‖ ^ 2 := by + rw [← cfcScalarMeasure_real_univ U hU a] + apply MeasureTheory.measureReal_mono (Set.subset_univ S) + +/-- The real polarization `Q(a+b) - Q(a-b)` is symmetric in `a b`, where +`Q v := (cfcScalarMeasure U hU v).real S`. This is where `cfcScalarMeasure_neg` enters: it turns +the parallelogram law into a genuine (conjugate-)symmetric pairing. -/ +lemma cfcScalarMeasure_real_polar_symm (a b : H) (S : Set (spectrum ℂ U)) : + (cfcScalarMeasure U hU (a + b)).real S - (cfcScalarMeasure U hU (a - b)).real S = + (cfcScalarMeasure U hU (b + a)).real S - (cfcScalarMeasure U hU (b - a)).real S := by + have hba : b - a = -(a - b) := by abel + rw [add_comm b a, hba, cfcScalarMeasure_real_neg] + +/-- First-argument additivity of the real polarization `Q(a+b) - Q(a-b)`, established by pure +algebra from the parallelogram law (`cfcScalarMeasure_real_parallelogram`); no continuity is +needed for this step, matching the classical Jordan--von Neumann polarization argument +(`Mathlib.Analysis.InnerProductSpace.OfNorm`). -/ +lemma cfcScalarMeasure_real_polar_add_left (x y z : H) (S : Set (spectrum ℂ U)) : + (cfcScalarMeasure U hU (x + y + z)).real S - (cfcScalarMeasure U hU (x + y - z)).real S = + ((cfcScalarMeasure U hU (x + z)).real S - (cfcScalarMeasure U hU (x - z)).real S) + + ((cfcScalarMeasure U hU (y + z)).real S - (cfcScalarMeasure U hU (y - z)).real S) := by + have h1 := cfcScalarMeasure_real_parallelogram U hU (x + y + z) (x - z) S + have h2 := cfcScalarMeasure_real_parallelogram U hU (x + y - z) (x + z) S + have h3 := cfcScalarMeasure_real_parallelogram U hU (y + z) z S + have h4 := cfcScalarMeasure_real_parallelogram U hU (y - z) z S + have e1 : x + y + z + (x - z) = 2 • x + y := by abel + have e2 : x + y + z - (x - z) = y + 2 • z := by abel + have e3 : x + y - z + (x + z) = 2 • x + y := by abel + have e4 : x + y - z - (x + z) = y - 2 • z := by abel + have e5 : y + z + z = y + 2 • z := by abel + have e6 : y + z - z = y := by abel + have e7 : y - z + z = y := by abel + have e8 : y - z - z = y - 2 • z := by abel + rw [e1, e2] at h1 + rw [e3, e4] at h2 + rw [e5, e6] at h3 + rw [e7, e8] at h4 + linarith [h1, h2, h3, h4] + +/-- Second-argument additivity of the real polarization, obtained from first-argument additivity +(`cfcScalarMeasure_real_polar_add_left`) via the symmetry `cfcScalarMeasure_real_polar_symm`. -/ +lemma cfcScalarMeasure_real_polar_add_right (a b c : H) (S : Set (spectrum ℂ U)) : + (cfcScalarMeasure U hU (a + (b + c))).real S - + (cfcScalarMeasure U hU (a - (b + c))).real S = + ((cfcScalarMeasure U hU (a + b)).real S - (cfcScalarMeasure U hU (a - b)).real S) + + ((cfcScalarMeasure U hU (a + c)).real S - (cfcScalarMeasure U hU (a - c)).real S) := by + have hadd := cfcScalarMeasure_real_polar_add_left U hU b c a S + have e1 : a + (b + c) = b + c + a := by abel + have e2 : b + c - a = -(a - (b + c)) := by abel + have e3 : b + a = a + b := by abel + have e4 : b - a = -(a - b) := by abel + have e5 : c + a = a + c := by abel + have e6 : c - a = -(a - c) := by abel + rw [← e1, e2, e3, e4, e5, e6, cfcScalarMeasure_real_neg, cfcScalarMeasure_real_neg, + cfcScalarMeasure_real_neg] at hadd + linarith [hadd] + +/-- Additivity of the polarized measure in its second (right) vector argument, for a fixed +measurable set `S`. This is the sesquilinearity step promised in the module docstring: it +follows from the parallelogram law by pure algebra, with no continuity or Riesz-representation +machinery required. -/ +lemma polarizedCfcScalarMeasure_add_right (x y₁ y₂ : H) {S : Set (spectrum ℂ U)} + (hS : MeasurableSet S) : + polarizedCfcScalarMeasure (hU := hU) U x (y₁ + y₂) S = + polarizedCfcScalarMeasure (hU := hU) U x y₁ S + + polarizedCfcScalarMeasure (hU := hU) U x y₂ S := by + rw [polarizedCfcScalarMeasure_apply U hU hS, polarizedCfcScalarMeasure_apply U hU hS, + polarizedCfcScalarMeasure_apply U hU hS] + have hR := cfcScalarMeasure_real_polar_add_right U hU x y₁ y₂ S + have hI : (cfcScalarMeasure U hU (x + Complex.I • (y₁ + y₂))).real S - + (cfcScalarMeasure U hU (x - Complex.I • (y₁ + y₂))).real S = + ((cfcScalarMeasure U hU (x + Complex.I • y₁)).real S - + (cfcScalarMeasure U hU (x - Complex.I • y₁)).real S) + + ((cfcScalarMeasure U hU (x + Complex.I • y₂)).real S - + (cfcScalarMeasure U hU (x - Complex.I • y₂)).real S) := by + have h := cfcScalarMeasure_real_polar_add_right U hU x (Complex.I • y₁) (Complex.I • y₂) S + rwa [← smul_add] at h + have hRc := congrArg (fun r : ℝ => (r : ℂ)) hR + have hIc := congrArg (fun r : ℝ => (r : ℂ)) hI + push_cast at hRc hIc + rw [hRc, hIc] + ring + +/-- Additivity of the polarized measure in its first (left) vector argument, for a fixed +measurable set `S`. -/ +lemma polarizedCfcScalarMeasure_add_left (x₁ x₂ y : H) {S : Set (spectrum ℂ U)} + (hS : MeasurableSet S) : + polarizedCfcScalarMeasure (hU := hU) U (x₁ + x₂) y S = + polarizedCfcScalarMeasure (hU := hU) U x₁ y S + + polarizedCfcScalarMeasure (hU := hU) U x₂ y S := by + rw [polarizedCfcScalarMeasure_apply U hU hS, polarizedCfcScalarMeasure_apply U hU hS, + polarizedCfcScalarMeasure_apply U hU hS] + have hR := cfcScalarMeasure_real_polar_add_left U hU x₁ x₂ y S + have hI : (cfcScalarMeasure U hU (x₁ + x₂ + Complex.I • y)).real S - + (cfcScalarMeasure U hU (x₁ + x₂ - Complex.I • y)).real S = + ((cfcScalarMeasure U hU (x₁ + Complex.I • y)).real S - + (cfcScalarMeasure U hU (x₁ - Complex.I • y)).real S) + + ((cfcScalarMeasure U hU (x₂ + Complex.I • y)).real S - + (cfcScalarMeasure U hU (x₂ - Complex.I • y)).real S) := + cfcScalarMeasure_real_polar_add_left U hU x₁ x₂ (Complex.I • y) S + have hRc := congrArg (fun r : ℝ => (r : ℂ)) hR + have hIc := congrArg (fun r : ℝ => (r : ℂ)) hI + push_cast at hRc hIc + rw [hRc, hIc] + ring + +/-- `Complex.I`-homogeneity in the right (second) argument. Because the second slot of the +target inner product `⟪y, cfcRealOperator U hU f x⟫_ℂ` is conjugate-linear (Mathlib's inner +product is conjugate-linear in its *first* argument), the correct identity has a `conj I = -I` +factor, not `I`; `polarizedCfcScalarMeasure_I_smul_left` below is the linear (non-conjugated) +counterpart in the first argument. -/ +lemma polarizedCfcScalarMeasure_I_smul_right (x y : H) {S : Set (spectrum ℂ U)} + (hS : MeasurableSet S) : + polarizedCfcScalarMeasure (hU := hU) U x (Complex.I • y) S = + -Complex.I * polarizedCfcScalarMeasure (hU := hU) U x y S := by + rw [polarizedCfcScalarMeasure_apply U hU hS, polarizedCfcScalarMeasure_apply U hU hS] + have e1 : Complex.I • (Complex.I • y) = -y := by + rw [smul_smul, Complex.I_mul_I, neg_one_smul] + rw [e1] + have e2 : x + -y = x - y := by abel + have e3 : x - -y = x + y := by abel + rw [e2, e3] + push_cast + linear_combination ((1 : ℂ) / 4) * + (((cfcScalarMeasure U hU (x + Complex.I • y)).real S : ℂ) - + ((cfcScalarMeasure U hU (x - Complex.I • y)).real S : ℂ)) * Complex.I_sq + +/-- `Complex.I`-homogeneity in the left (first) argument: this slot is genuinely `ℂ`-linear. -/ +lemma polarizedCfcScalarMeasure_I_smul_left (x y : H) {S : Set (spectrum ℂ U)} + (hS : MeasurableSet S) : + polarizedCfcScalarMeasure (hU := hU) U (Complex.I • x) y S = + Complex.I * polarizedCfcScalarMeasure (hU := hU) U x y S := by + rw [polarizedCfcScalarMeasure_apply U hU hS, polarizedCfcScalarMeasure_apply U hU hS] + have e1 : Complex.I • x + y = Complex.I • (x - Complex.I • y) := by + rw [smul_sub, smul_smul, Complex.I_mul_I, neg_one_smul]; abel + have e2 : Complex.I • x - y = Complex.I • (x + Complex.I • y) := by + rw [smul_add, smul_smul, Complex.I_mul_I, neg_one_smul]; abel + have e3 : Complex.I • x + Complex.I • y = Complex.I • (x + y) := by rw [smul_add] + have e4 : Complex.I • x - Complex.I • y = Complex.I • (x - y) := by rw [smul_sub] + rw [e1, e2, e3, e4, cfcScalarMeasure_real_I_smul, cfcScalarMeasure_real_I_smul, + cfcScalarMeasure_real_I_smul, cfcScalarMeasure_real_I_smul] + push_cast + linear_combination ((1 : ℂ) / 4) * + (((cfcScalarMeasure U hU (x - Complex.I • y)).real S : ℂ) - + ((cfcScalarMeasure U hU (x + Complex.I • y)).real S : ℂ)) * Complex.I_sq + +/-- A crude but sufficient bound on the polarized measure, from the parallelogram law and +`cfcScalarMeasure_real_le_univ`. This is enough to see `(x, y) ↦ polarizedCfcScalarMeasure U hU +x y S` is jointly bounded, the input a Riesz-representation argument needs. -/ +lemma polarizedCfcScalarMeasure_norm_le (x y : H) {S : Set (spectrum ℂ U)} + (hS : MeasurableSet S) : + ‖polarizedCfcScalarMeasure (hU := hU) U x y S‖ ≤ ‖x‖ ^ 2 + ‖y‖ ^ 2 := by + rw [polarizedCfcScalarMeasure_apply U hU hS] + have hbound : ∀ a b : H, |(cfcScalarMeasure U hU (a + b)).real S - + (cfcScalarMeasure U hU (a - b)).real S| ≤ 2 * ‖a‖ ^ 2 + 2 * ‖b‖ ^ 2 := by + intro a b + have hpar := cfcScalarMeasure_real_parallelogram U hU a b S + have hnn1 := cfcScalarMeasure_real_nonneg U hU (a + b) S + have hnn2 := cfcScalarMeasure_real_nonneg U hU (a - b) S + have hle1 := cfcScalarMeasure_real_le_univ U hU a S + have hle2 := cfcScalarMeasure_real_le_univ U hU b S + rw [abs_le] + constructor <;> linarith + have h1 := hbound x y + have h2 := hbound x (Complex.I • y) + rw [norm_smul] at h2 + simp only [Complex.norm_I, one_mul] at h2 + calc ‖((1 / 4 : ℝ) * ((cfcScalarMeasure U hU (x + y)).real S - + (cfcScalarMeasure U hU (x - y)).real S) : ℂ) + + Complex.I * ((1 / 4 : ℝ) * ((cfcScalarMeasure U hU (x + Complex.I • y)).real S - + (cfcScalarMeasure U hU (x - Complex.I • y)).real S) : ℂ)‖ + ≤ ‖((1 / 4 : ℝ) * ((cfcScalarMeasure U hU (x + y)).real S - + (cfcScalarMeasure U hU (x - y)).real S) : ℂ)‖ + + ‖Complex.I * ((1 / 4 : ℝ) * ((cfcScalarMeasure U hU (x + Complex.I • y)).real S - + (cfcScalarMeasure U hU (x - Complex.I • y)).real S) : ℂ)‖ := norm_add_le _ _ + _ = (1 / 4) * |(cfcScalarMeasure U hU (x + y)).real S - + (cfcScalarMeasure U hU (x - y)).real S| + + (1 / 4) * |(cfcScalarMeasure U hU (x + Complex.I • y)).real S - + (cfcScalarMeasure U hU (x - Complex.I • y)).real S| := by + simp [← Complex.ofReal_sub, Complex.norm_real, Real.norm_eq_abs] + _ ≤ (1 / 4) * (2 * ‖x‖ ^ 2 + 2 * ‖y‖ ^ 2) + (1 / 4) * (2 * ‖x‖ ^ 2 + 2 * ‖y‖ ^ 2) := by + gcongr + _ = ‖x‖ ^ 2 + ‖y‖ ^ 2 := by ring + +/-- An additive `ℝ → ℂ` function that is bounded on `[-1, 1]` is automatically `ℝ`-linear. This +packages the classical "Cauchy's functional equation" regularity argument (additive + locally +bounded ⟹ continuous, then continuous additive between real topological vector spaces ⟹ +`ℝ`-linear via `map_real_smul`) that both real-scalar-homogeneity lemmas below reduce to. -/ +lemma real_linear_of_additive_bounded {φ : ℝ → ℂ} + (hadd : ∀ a b : ℝ, φ (a + b) = φ a + φ b) + {C : ℝ} (hbound : ∀ t : ℝ, |t| ≤ 1 → ‖φ t‖ ≤ C) (r : ℝ) : + φ r = (r : ℂ) * φ 1 := by + let φHom : ℝ →+ ℂ := AddMonoidHom.mk' φ hadd + have hφHom : ∀ t : ℝ, φHom t = φ t := fun _ => rfl + have hCnonneg : 0 ≤ C := (norm_nonneg (φ 0)).trans (hbound 0 (by norm_num)) + have hcont0 : ContinuousAt φHom 0 := by + rw [Metric.continuousAt_iff] + intro ε hε + obtain ⟨n, hn⟩ := exists_nat_gt (C / ε) + have hn0 : 0 < n := by + rcases Nat.eq_zero_or_pos n with h0 | h0 + · rw [h0, Nat.cast_zero] at hn + exact absurd hn (not_lt.mpr (div_nonneg hCnonneg hε.le)) + · exact h0 + have hnpos : (0 : ℝ) < (n : ℝ) := by exact_mod_cast hn0 + refine ⟨1 / n, by positivity, fun t ht => ?_⟩ + rw [Real.dist_eq, sub_zero] at ht + have habs : (n : ℝ) * t ∈ Set.Icc (-1 : ℝ) 1 := by + rw [abs_lt] at ht + have h1 : (n : ℝ) * t < (n : ℝ) * (1 / (n : ℝ)) := mul_lt_mul_of_pos_left ht.2 hnpos + have h2 : (n : ℝ) * (-(1 / (n : ℝ))) < (n : ℝ) * t := mul_lt_mul_of_pos_left ht.1 hnpos + have h1' : (n : ℝ) * (1 / (n : ℝ)) = 1 := by field_simp + have h2' : (n : ℝ) * (-(1 / (n : ℝ))) = -1 := by field_simp + constructor <;> linarith + have hnt_le : |(n : ℝ) * t| ≤ 1 := abs_le.mpr habs + have hval : φHom ((n : ℝ) * t) = (n : ℂ) * φHom t := by + have h' := map_nsmul φHom n t + rwa [nsmul_eq_mul, nsmul_eq_mul] at h' + have hne : (n : ℂ) ≠ 0 := by exact_mod_cast hn0.ne' + have hφt : φHom t = φHom ((n : ℝ) * t) / (n : ℂ) := by + rw [hval, mul_div_cancel_left₀ _ hne] + have hφnt_bound : ‖φHom ((n : ℝ) * t)‖ ≤ C := hbound _ hnt_le + have hCn : C / n < ε := by + rw [div_lt_iff₀ hnpos, mul_comm] + exact (div_lt_iff₀ hε).mp hn + rw [map_zero, Complex.dist_eq, sub_zero, hφt, norm_div, Complex.norm_natCast] + calc ‖φHom ((n : ℝ) * t)‖ / (n : ℝ) ≤ C / (n : ℝ) := by gcongr + _ < ε := hCn + have hcont : Continuous φHom := continuous_of_continuousAt_zero φHom hcont0 + have hmap := map_real_smul φHom hcont r (1 : ℝ) + rw [smul_eq_mul, mul_one, Complex.real_smul] at hmap + rw [hφHom r, hφHom 1] at hmap + exact hmap + +/-- Real-scalar homogeneity in the right (second) argument: `B(x, r • y) = r * B(x, y)` for +`r : ℝ`. Unlike additivity and `Complex.I`-homogeneity above (pure algebra from the +parallelogram law, see `polarizedCfcScalarMeasure_add_right` and +`polarizedCfcScalarMeasure_I_smul_right`), this reduces to the continuity argument packaged in +`real_linear_of_additive_bounded`. -/ +theorem polarizedCfcScalarMeasure_real_smul_right (x y : H) (r : ℝ) {S : Set (spectrum ℂ U)} + (hS : MeasurableSet S) : + polarizedCfcScalarMeasure (hU := hU) U x (r • y) S = + (r : ℂ) * polarizedCfcScalarMeasure (hU := hU) U x y S := by + have hadd : ∀ a b : ℝ, polarizedCfcScalarMeasure (hU := hU) U x ((a + b) • y) S = + polarizedCfcScalarMeasure (hU := hU) U x (a • y) S + + polarizedCfcScalarMeasure (hU := hU) U x (b • y) S := by + intro a b + rw [add_smul] + exact polarizedCfcScalarMeasure_add_right U hU x (a • y) (b • y) hS + have hbound : ∀ t : ℝ, |t| ≤ 1 → + ‖polarizedCfcScalarMeasure (hU := hU) U x (t • y) S‖ ≤ ‖x‖ ^ 2 + ‖y‖ ^ 2 := by + intro t ht + have h := polarizedCfcScalarMeasure_norm_le (hU := hU) U x (t • y) hS + have h2 : ‖t • y‖ ^ 2 ≤ ‖y‖ ^ 2 := by + rw [norm_smul, Real.norm_eq_abs] + have hty : |t| * ‖y‖ ≤ ‖y‖ := by nlinarith [norm_nonneg y] + gcongr + linarith + have h := real_linear_of_additive_bounded hadd hbound r + rwa [one_smul] at h + +/-- Real-scalar homogeneity in the left (first) argument, the counterpart of +`polarizedCfcScalarMeasure_real_smul_right` needed for conjugate-linearity in `x` (real scalars +are self-conjugate, so the same statement serves both roles). -/ +theorem polarizedCfcScalarMeasure_real_smul_left (x y : H) (r : ℝ) {S : Set (spectrum ℂ U)} + (hS : MeasurableSet S) : + polarizedCfcScalarMeasure (hU := hU) U (r • x) y S = + (r : ℂ) * polarizedCfcScalarMeasure (hU := hU) U x y S := by + have hadd : ∀ a b : ℝ, polarizedCfcScalarMeasure (hU := hU) U ((a + b) • x) y S = + polarizedCfcScalarMeasure (hU := hU) U (a • x) y S + + polarizedCfcScalarMeasure (hU := hU) U (b • x) y S := by + intro a b + rw [add_smul] + exact polarizedCfcScalarMeasure_add_left U hU (a • x) (b • x) y hS + have hbound : ∀ t : ℝ, |t| ≤ 1 → + ‖polarizedCfcScalarMeasure (hU := hU) U (t • x) y S‖ ≤ ‖x‖ ^ 2 + ‖y‖ ^ 2 := by + intro t ht + have h := polarizedCfcScalarMeasure_norm_le (hU := hU) U (t • x) y hS + have h2 : ‖t • x‖ ^ 2 ≤ ‖x‖ ^ 2 := by + rw [norm_smul, Real.norm_eq_abs] + have htx : |t| * ‖x‖ ≤ ‖x‖ := by nlinarith [norm_nonneg x] + gcongr + linarith + have h := real_linear_of_additive_bounded hadd hbound r + rwa [one_smul] at h + +/-! ## Polarization boundary -/ + +omit [CompleteSpace H] in +/-- The standard complex polarization identity, exposed at the continuous-operator level for the +assembly proof. The scalar measures obtained above will be polarized with precisely these four +diagonal terms. -/ +@[nolint unusedArguments] +lemma inner_map_polarization_continuous (A : H →L[ℂ] H) (x y : H) : + ⟪A y, x⟫_ℂ = + (⟪A (x + y), x + y⟫_ℂ - ⟪A (x - y), x - y⟫_ℂ + + Complex.I * ⟪A (x + Complex.I • y), x + Complex.I • y⟫_ℂ - + Complex.I * ⟪A (x - Complex.I • y), x - Complex.I • y⟫_ℂ) / 4 := by + exact inner_map_polarization (A : H →ₗ[ℂ] H) x y + +/-! ## Full complex sesquilinearity of the polarized measure + +The homogeneity lemmas above only cover real scalars and `Complex.I`. Combining them via the +decomposition `c = c.re + c.im * I` upgrades them to genuine `ℂ`-linearity in the first argument +and conjugate-`ℂ`-linearity in the second, which is exactly the shape Mathlib's +`InnerProductSpace.continuousLinearMapOfBilin` (Fréchet--Riesz for bounded sesquilinear forms) +consumes. -/ + +/-- Full `ℂ`-linearity of the polarized measure in its first (left) argument. -/ +lemma polarizedCfcScalarMeasure_smul_left (c : ℂ) (x y : H) {S : Set (spectrum ℂ U)} + (hS : MeasurableSet S) : + polarizedCfcScalarMeasure (hU := hU) U (c • x) y S = + c * polarizedCfcScalarMeasure (hU := hU) U x y S := by + have hc : (c.re : ℝ) • x + (c.im : ℝ) • (Complex.I • x) = c • x := by + rw [RCLike.real_smul_eq_coe_smul (K := ℂ), RCLike.real_smul_eq_coe_smul (K := ℂ), + smul_smul, ← add_smul] + congr 1 + exact_mod_cast Complex.re_add_im c + rw [← hc, polarizedCfcScalarMeasure_add_left U hU _ _ y hS, + polarizedCfcScalarMeasure_real_smul_left U hU x y c.re hS, + polarizedCfcScalarMeasure_real_smul_left U hU (Complex.I • x) y c.im hS, + polarizedCfcScalarMeasure_I_smul_left U hU x y hS] + have hcre : (c.re : ℂ) + (c.im : ℂ) * Complex.I = c := Complex.re_add_im c + linear_combination (polarizedCfcScalarMeasure (hU := hU) U x y S) * hcre + +/-- Full conjugate-`ℂ`-linearity of the polarized measure in its second (right) argument. -/ +lemma polarizedCfcScalarMeasure_smul_right (c : ℂ) (x y : H) {S : Set (spectrum ℂ U)} + (hS : MeasurableSet S) : + polarizedCfcScalarMeasure (hU := hU) U x (c • y) S = + (starRingEnd ℂ c) * polarizedCfcScalarMeasure (hU := hU) U x y S := by + have hc : (c.re : ℝ) • y + (c.im : ℝ) • (Complex.I • y) = c • y := by + rw [RCLike.real_smul_eq_coe_smul (K := ℂ), RCLike.real_smul_eq_coe_smul (K := ℂ), + smul_smul, ← add_smul] + congr 1 + exact_mod_cast Complex.re_add_im c + rw [← hc, polarizedCfcScalarMeasure_add_right U hU x _ _ hS, + polarizedCfcScalarMeasure_real_smul_right U hU x y c.re hS, + polarizedCfcScalarMeasure_real_smul_right U hU x (Complex.I • y) c.im hS, + polarizedCfcScalarMeasure_I_smul_right U hU x y hS] + have hcc : (c.re : ℂ) - (c.im : ℂ) * Complex.I = starRingEnd ℂ c := by + have h := Complex.re_add_im (starRingEnd ℂ c) + rw [Complex.conj_re, Complex.conj_im] at h + push_cast at h + linear_combination h + linear_combination (polarizedCfcScalarMeasure (hU := hU) U x y S) * hcc + +lemma polarizedCfcScalarMeasure_zero_left (y : H) {S : Set (spectrum ℂ U)} + (hS : MeasurableSet S) : polarizedCfcScalarMeasure (hU := hU) U 0 y S = 0 := by + have h := polarizedCfcScalarMeasure_smul_left U hU 0 0 y hS + simpa using h + +lemma polarizedCfcScalarMeasure_zero_right (x : H) {S : Set (spectrum ℂ U)} + (hS : MeasurableSet S) : polarizedCfcScalarMeasure (hU := hU) U x 0 S = 0 := by + have h := polarizedCfcScalarMeasure_smul_right U hU 0 x 0 hS + simpa using h + +/-- A product (rather than sum-of-squares) bound on the polarized measure, obtained from +`polarizedCfcScalarMeasure_norm_le` by a homogeneity-rescaling trick: apply the sum bound to +`(t • x, t⁻¹ • y)` for the real `t` minimizing `t ^ 2 ‖x‖ ^ 2 + t⁻² ‖y‖ ^ 2`. This is the bound a +Riesz-representation argument needs (`LinearMap.mkContinuous₂`). -/ +lemma polarizedCfcScalarMeasure_norm_le_mul (x y : H) {S : Set (spectrum ℂ U)} + (hS : MeasurableSet S) : + ‖polarizedCfcScalarMeasure (hU := hU) U x y S‖ ≤ 2 * ‖x‖ * ‖y‖ := by + rcases eq_or_ne x 0 with hx0 | hx0 + · simp [hx0, polarizedCfcScalarMeasure_zero_left U hU y hS] + rcases eq_or_ne y 0 with hy0 | hy0 + · simp [hy0, polarizedCfcScalarMeasure_zero_right U hU x hS] + set t : ℝ := Real.sqrt (‖y‖ / ‖x‖) with ht_def + have hxpos : 0 < ‖x‖ := norm_pos_iff.mpr hx0 + have hypos : 0 < ‖y‖ := norm_pos_iff.mpr hy0 + have ht : 0 < t := Real.sqrt_pos.mpr (div_pos hypos hxpos) + have htsq : t ^ 2 = ‖y‖ / ‖x‖ := Real.sq_sqrt (div_pos hypos hxpos).le + have hkey : polarizedCfcScalarMeasure (hU := hU) U x y S = + polarizedCfcScalarMeasure (hU := hU) U (t • x) (t⁻¹ • y) S := by + rw [polarizedCfcScalarMeasure_real_smul_left U hU x (t⁻¹ • y) t hS, + polarizedCfcScalarMeasure_real_smul_right U hU x y t⁻¹ hS] + have ht1 : (t : ℂ) * ((t⁻¹ : ℝ) : ℂ) = 1 := by + rw [← Complex.ofReal_mul, mul_inv_cancel₀ ht.ne', Complex.ofReal_one] + rw [← mul_assoc, ht1, one_mul] + rw [hkey] + have hbound := polarizedCfcScalarMeasure_norm_le (hU := hU) U (t • x) (t⁻¹ • y) hS + have h1 : ‖t • x‖ ^ 2 = t ^ 2 * ‖x‖ ^ 2 := by + rw [norm_smul, Real.norm_eq_abs, abs_of_pos ht]; ring + have h2 : ‖t⁻¹ • y‖ ^ 2 = t⁻¹ ^ 2 * ‖y‖ ^ 2 := by + rw [norm_smul, Real.norm_eq_abs, abs_of_pos (inv_pos.mpr ht)]; ring + rw [h1, h2, htsq] at hbound + have h3 : t⁻¹ ^ 2 = ‖x‖ / ‖y‖ := by + rw [inv_pow, htsq, inv_div] + rw [h3] at hbound + have e1 : ‖y‖ / ‖x‖ * ‖x‖ ^ 2 = ‖x‖ * ‖y‖ := by field_simp + have e2 : ‖x‖ / ‖y‖ * ‖y‖ ^ 2 = ‖x‖ * ‖y‖ := by field_simp + rw [e1, e2] at hbound + linarith [hbound] + +/-! ## Step B: Riesz representation of the polarized measure -/ + +/-- The algebraic (not-yet-continuous) sesquilinear form representing `S`, conjugate-linear in the +first argument and linear in the second — the convention Mathlib's +`InnerProductSpace.continuousLinearMapOfBilin` expects. -/ +noncomputable def cfcSesquilinearFormAux (S : Set (spectrum ℂ U)) (hS : MeasurableSet S) : + H →ₛₗ[starRingEnd ℂ] H →ₗ[ℂ] ℂ := + LinearMap.mk₂'ₛₗ (starRingEnd ℂ) (RingHom.id ℂ) + (fun x y => starRingEnd ℂ (polarizedCfcScalarMeasure (hU := hU) U x y S)) + (fun x₁ x₂ y => by + rw [polarizedCfcScalarMeasure_add_left U hU x₁ x₂ y hS, map_add]) + (fun c x y => by + simp only [smul_eq_mul] + rw [polarizedCfcScalarMeasure_smul_left U hU c x y hS, map_mul]) + (fun x y₁ y₂ => by + rw [polarizedCfcScalarMeasure_add_right U hU x y₁ y₂ hS, map_add]) + (fun c x y => by + simp only [RingHom.id_apply, smul_eq_mul] + rw [polarizedCfcScalarMeasure_smul_right U hU c x y hS, map_mul, Complex.conj_conj]) + +lemma cfcSesquilinearFormAux_apply (S : Set (spectrum ℂ U)) (hS : MeasurableSet S) (x y : H) : + cfcSesquilinearFormAux U hU S hS x y = + starRingEnd ℂ (polarizedCfcScalarMeasure (hU := hU) U x y S) := rfl + +/-- The continuous sesquilinear form, in the shape `InnerProductSpace.continuousLinearMapOfBilin` +consumes. -/ +noncomputable def cfcSesquilinearForm (S : Set (spectrum ℂ U)) (hS : MeasurableSet S) : + H →L⋆[ℂ] H →L[ℂ] ℂ := + LinearMap.mkContinuous₂ (cfcSesquilinearFormAux U hU S hS) 2 (fun x y => by + rw [cfcSesquilinearFormAux_apply, RCLike.norm_conj] + exact polarizedCfcScalarMeasure_norm_le_mul U hU x y hS) + +@[simp] +lemma cfcSesquilinearForm_apply (S : Set (spectrum ℂ U)) (hS : MeasurableSet S) (x y : H) : + cfcSesquilinearForm U hU S hS x y = + starRingEnd ℂ (polarizedCfcScalarMeasure (hU := hU) U x y S) := rfl + +end CFCScalar + +end QuantumMechanics + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/UnitaryInfra/SpectralMeasure.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/UnitaryInfra/SpectralMeasure.lean new file mode 100644 index 0000000000..2f3f187520 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/UnitaryInfra/SpectralMeasure.lean @@ -0,0 +1,992 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.UnitaryInfra.SesquilinearForm +public import Mathlib.Analysis.CStarAlgebra.ContinuousFunctionalCalculus.Commute +public import Mathlib.Algebra.Star.Unitary + +/-! +# Infrastructure for the bounded-unitary spectral theorem: the spectral measure + +Continues `UnitaryInfra/SesquilinearForm.lean`: turns `cfcSesquilinearForm` into +projection-valued operators `cfcSpectralOperator`, proves they are idempotent star-projections +that add over disjoint sets, and assembles the final `cfcSpectralMeasure` — the weak-operator +spectral measure of a bounded normal operator — together with its reconstruction theorem. +-/ + +@[expose] public section + +noncomputable section + +open MeasureTheory Set Topology +open scoped ComplexOrder CStarAlgebra InnerProductSpace + +namespace QuantumMechanics + +section CFCScalar + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] +variable (U : H →L[ℂ] H) (hU : IsStarNormal U) + +/-- The Riesz-represented operator at the measurable set `S`. -/ +noncomputable def cfcSpectralOperatorAux (S : Set (spectrum ℂ U)) (hS : MeasurableSet S) : + H →L[ℂ] H := + InnerProductSpace.continuousLinearMapOfBilin (cfcSesquilinearForm U hU S hS) + +lemma cfcSpectralOperatorAux_inner (S : Set (spectrum ℂ U)) (hS : MeasurableSet S) (x y : H) : + ⟪y, cfcSpectralOperatorAux U hU S hS x⟫_ℂ = + polarizedCfcScalarMeasure (hU := hU) U x y S := by + have h := InnerProductSpace.continuousLinearMapOfBilin_apply (cfcSesquilinearForm U hU S hS) x y + rw [cfcSesquilinearForm_apply] at h + change ⟪cfcSpectralOperatorAux U hU S hS x, y⟫_ℂ = _ at h + rw [← inner_conj_symm, h, Complex.conj_conj] + +open scoped Classical in +/-- The Riesz-represented operator on every set, `0` off the measurable sets so that this +directly matches `MeasureTheory.VectorMeasure`'s `not_measurable'` convention. -/ +noncomputable def cfcSpectralOperator (S : Set (spectrum ℂ U)) : H →L[ℂ] H := + if hS : MeasurableSet S then cfcSpectralOperatorAux U hU S hS else 0 + +lemma cfcSpectralOperator_inner (S : Set (spectrum ℂ U)) (x y : H) : + ⟪y, cfcSpectralOperator U hU S x⟫_ℂ = polarizedCfcScalarMeasure (hU := hU) U x y S := by + unfold cfcSpectralOperator + split_ifs with hS + · exact cfcSpectralOperatorAux_inner U hU S hS x y + · simp [(polarizedCfcScalarMeasure (hU := hU) U x y).not_measurable hS] + +lemma cfcSpectralOperator_apply_eq_zero_of_not_measurableSet {S : Set (spectrum ℂ U)} + (hS : ¬MeasurableSet S) : cfcSpectralOperator U hU S = 0 := by + unfold cfcSpectralOperator + rw [dif_neg hS] + +set_option maxHeartbeats 1000000 in +/-- The `Complex.I`-inversion companion of `cfcScalarMeasure_real_I_smul`: rewrites a Riesz +measure at `v` as the Riesz measure at `(-I) • v`. This is the algebraic engine behind +Hermitian symmetry of the polarized measure below. -/ +theorem cfcScalarMeasure_real_eq_negI_smul (v : H) (S : Set (spectrum ℂ U)) : + (cfcScalarMeasure U hU v).real S = (cfcScalarMeasure U hU ((-Complex.I) • v)).real S := by + have hv : Complex.I • ((-Complex.I) • v) = v := by + rw [smul_smul, show Complex.I * (-Complex.I) = 1 by rw [mul_neg, Complex.I_mul_I, neg_neg], + one_smul] + conv_lhs => rw [← hv] + exact cfcScalarMeasure_real_I_smul U hU ((-Complex.I) • v) S + +set_option maxHeartbeats 1000000 in +/-- Hermitian symmetry of the polarized measure: `B(y,x,S) = conj (B(x,y,S))`, matching the +convention that `B` is exactly `⟪y, cfcRealOperator U hU f x⟫` in the limit and inner products +are conjugate-symmetric. This is the input `cfcSpectralOperator_isSelfAdjoint` needs. -/ +lemma polarizedCfcScalarMeasure_conj_symm (x y : H) (S : Set (spectrum ℂ U)) : + polarizedCfcScalarMeasure (hU := hU) U y x S = + starRingEnd ℂ (polarizedCfcScalarMeasure (hU := hU) U x y S) := by + by_cases hS : MeasurableSet S + · rw [polarizedCfcScalarMeasure_apply U hU hS, polarizedCfcScalarMeasure_apply U hU hS] + have hcomm : (cfcScalarMeasure U hU (y + x)).real S = + (cfcScalarMeasure U hU (x + y)).real S := by rw [add_comm y x] + have hnegcomm : (cfcScalarMeasure U hU (y - x)).real S = + (cfcScalarMeasure U hU (x - y)).real S := by + rw [show y - x = -(x - y) by abel, cfcScalarMeasure_real_neg] + have hnegI : (-Complex.I) • (Complex.I • x) = x := by + rw [smul_smul, show (-Complex.I) * Complex.I = 1 by + rw [neg_mul, Complex.I_mul_I, neg_neg], one_smul] + have hA : (cfcScalarMeasure U hU (y + Complex.I • x)).real S = + (cfcScalarMeasure U hU (x - Complex.I • y)).real S := by + have heq : (-Complex.I) • (y + Complex.I • x) = x - Complex.I • y := by + rw [smul_add, hnegI]; module + rw [cfcScalarMeasure_real_eq_negI_smul U hU (y + Complex.I • x) S, heq] + have hB : (cfcScalarMeasure U hU (y - Complex.I • x)).real S = + (cfcScalarMeasure U hU (x + Complex.I • y)).real S := by + have heq : (-Complex.I) • (y - Complex.I • x) = -(x + Complex.I • y) := by + rw [smul_sub, hnegI]; module + rw [cfcScalarMeasure_real_eq_negI_smul U hU (y - Complex.I • x) S, heq, + cfcScalarMeasure_real_neg] + rw [hcomm, hnegcomm, hA, hB] + simp only [map_add, map_mul, map_sub, Complex.conj_ofReal, Complex.conj_I] + ring + · simp [(polarizedCfcScalarMeasure (hU := hU) U y x).not_measurable hS, + (polarizedCfcScalarMeasure (hU := hU) U x y).not_measurable hS] + +/-- `cfcSpectralOperator U hU S` is self-adjoint, for every `S` (measurable or not — the +non-measurable case is trivial since the operator is `0`). This follows from +`polarizedCfcScalarMeasure_conj_symm` via `LinearMap.IsSymmetric`. -/ +lemma cfcSpectralOperator_isSelfAdjoint (S : Set (spectrum ℂ U)) : + IsSelfAdjoint (cfcSpectralOperator U hU S) := by + rw [ContinuousLinearMap.isSelfAdjoint_iff_isSymmetric] + intro x y + show ⟪cfcSpectralOperator U hU S x, y⟫_ℂ = ⟪x, cfcSpectralOperator U hU S y⟫_ℂ + rw [← inner_conj_symm (cfcSpectralOperator U hU S x) y, cfcSpectralOperator_inner, + cfcSpectralOperator_inner U hU S y x, polarizedCfcScalarMeasure_conj_symm, Complex.conj_conj] + +/-- `polarizedCfcScalarMeasure U hU x y` reproduces `⟪y, x⟫` at `S = univ` — the vector-state +counterpart of `cfcHom hU 1 = 1`, and the exact fact `cfcSpectralOperator_univ` needs. (Moved +ahead of Step E's original position: it has no dependency on the idempotency gap and the +Step 0–4 order/positivity infrastructure below needs `cfcSpectralOperator_univ` early.) -/ +lemma polarizedCfcScalarMeasure_univ (x y : H) : + polarizedCfcScalarMeasure (hU := hU) U x y Set.univ = ⟪y, x⟫_ℂ := by + have hsq : ∀ v : H, ⟪v, v⟫_ℂ = ((‖v‖ ^ 2 : ℝ) : ℂ) := by + intro v + rw [inner_self_eq_norm_sq_to_K] + norm_cast + have hpol := inner_map_polarization_continuous (1 : H →L[ℂ] H) x y + simp only [one_apply_eq_self, hsq] at hpol + rw [polarizedCfcScalarMeasure_apply U hU MeasurableSet.univ] + simp only [cfcScalarMeasure_real_univ] + rw [hpol] + push_cast + ring + +lemma cfcSpectralOperator_univ_apply (x : H) : + cfcSpectralOperator U hU Set.univ x = x := by + apply ext_inner_left ℂ + intro v + rw [cfcSpectralOperator_inner] + exact polarizedCfcScalarMeasure_univ U hU x v + +lemma cfcSpectralOperator_univ : cfcSpectralOperator U hU Set.univ = 1 := by + ext x + rw [cfcSpectralOperator_univ_apply U hU x, one_apply_eq_self] + +/-- **The diagonal quadratic form.** Evaluating the reconstruction identity +`cfcSpectralOperator_inner` on the diagonal `y = x` collapses the four-term polarization to the +single vector-state Riesz measure `(cfcScalarMeasure U hU x).real S`: a polarization identity +applied to its own diagonal always recovers the original quadratic form. The mechanical work is +in showing `μ_{x-x} = μ_0 = 0` (from the parallelogram law at `a = b = 0`), `μ_{x+x} = 4 μ_x` +(parallelogram law at `a = b = x`), and `μ_{x+I•x} = μ_{x-I•x}` (from `Complex.I`-invariance, +`cfcScalarMeasure_real_I_smul`, applied to `x - I • x`). -/ +lemma cfcSpectralOperator_inner_self {S : Set (spectrum ℂ U)} (hS : MeasurableSet S) (x : H) : + ⟪x, cfcSpectralOperator U hU S x⟫_ℂ = ((cfcScalarMeasure U hU x).real S : ℂ) := by + rw [cfcSpectralOperator_inner, polarizedCfcScalarMeasure_apply U hU hS] + have hzero : (cfcScalarMeasure U hU (0 : H)).real S = 0 := by + have h := cfcScalarMeasure_real_parallelogram U hU (0 : H) 0 S + simp only [add_zero, sub_self] at h + linarith + have hxx : x - x = (0 : H) := sub_self x + have hdouble : (cfcScalarMeasure U hU (x + x)).real S = 4 * (cfcScalarMeasure U hU x).real S := by + have h := cfcScalarMeasure_real_parallelogram U hU x x S + rw [hxx, hzero] at h + linarith + have hIeq : Complex.I • (x - Complex.I • x) = x + Complex.I • x := by + rw [smul_sub, smul_smul, Complex.I_mul_I, neg_one_smul, sub_neg_eq_add, add_comm] + have himag : (cfcScalarMeasure U hU (x + Complex.I • x)).real S = + (cfcScalarMeasure U hU (x - Complex.I • x)).real S := by + have h := cfcScalarMeasure_real_I_smul U hU (x - Complex.I • x) S + rwa [hIeq] at h + rw [hxx, hzero, hdouble, himag, sub_self] + push_cast + ring + +/-- `reApplyInnerSelf` version of `cfcSpectralOperator_inner_self`, in the exact shape +`ContinuousLinearMap.IsPositive` consumes. -/ +lemma cfcSpectralOperator_reApplyInnerSelf {S : Set (spectrum ℂ U)} (hS : MeasurableSet S) + (x : H) : + (cfcSpectralOperator U hU S).reApplyInnerSelf x = (cfcScalarMeasure U hU x).real S := by + rw [ContinuousLinearMap.reApplyInnerSelf_apply, ← RCLike.conj_re, inner_conj_symm, + cfcSpectralOperator_inner_self U hU hS x] + simp + +/-! ## Step 1: elementary order API for `cfcSpectralOperator` -/ + +/-- `cfcSpectralOperator U hU S` is a positive operator, for measurable `S`. -/ +lemma cfcSpectralOperator_isPositive {S : Set (spectrum ℂ U)} (hS : MeasurableSet S) : + ContinuousLinearMap.IsPositive (cfcSpectralOperator U hU S) := by + rw [ContinuousLinearMap.isPositive_def'] + refine ⟨cfcSpectralOperator_isSelfAdjoint U hU S, fun x => ?_⟩ + rw [cfcSpectralOperator_reApplyInnerSelf U hU hS x] + exact cfcScalarMeasure_real_nonneg U hU x S + +lemma cfcSpectralOperator_nonneg {S : Set (spectrum ℂ U)} (hS : MeasurableSet S) : + 0 ≤ cfcSpectralOperator U hU S := + (ContinuousLinearMap.nonneg_iff_isPositive _).mpr (cfcSpectralOperator_isPositive U hU hS) + +/-- `cfcSpectralOperator U hU S` is monotone in `S`, for measurable sets, in the Loewner order on +`H →L[ℂ] H`. -/ +lemma cfcSpectralOperator_mono {S T : Set (spectrum ℂ U)} (hS : MeasurableSet S) + (hT : MeasurableSet T) (hST : S ⊆ T) : + cfcSpectralOperator U hU S ≤ cfcSpectralOperator U hU T := by + rw [ContinuousLinearMap.le_def, ContinuousLinearMap.isPositive_def'] + refine ⟨(cfcSpectralOperator_isSelfAdjoint U hU T).sub + (cfcSpectralOperator_isSelfAdjoint U hU S), fun x => ?_⟩ + show 0 ≤ (cfcSpectralOperator U hU T - cfcSpectralOperator U hU S).reApplyInnerSelf x + have hTx := cfcSpectralOperator_reApplyInnerSelf U hU hT x + have hSx := cfcSpectralOperator_reApplyInnerSelf U hU hS x + have hre : (cfcSpectralOperator U hU T - cfcSpectralOperator U hU S).reApplyInnerSelf x = + (cfcSpectralOperator U hU T).reApplyInnerSelf x - + (cfcSpectralOperator U hU S).reApplyInnerSelf x := by + simp only [ContinuousLinearMap.reApplyInnerSelf_apply, sub_apply, + inner_sub_left] + rfl + rw [hre, hTx, hSx, sub_nonneg] + exact MeasureTheory.measureReal_mono hST + +lemma cfcSpectralOperator_le_one {S : Set (spectrum ℂ U)} (hS : MeasurableSet S) : + cfcSpectralOperator U hU S ≤ 1 := by + rw [← cfcSpectralOperator_univ U hU] + exact cfcSpectralOperator_mono U hU hS MeasurableSet.univ (Set.subset_univ S) + +lemma cfcSpectralOperator_empty : cfcSpectralOperator U hU ∅ = 0 := by + ext x + apply ext_inner_left ℂ + intro y + rw [cfcSpectralOperator_inner, zero_apply, inner_zero_right, + (polarizedCfcScalarMeasure (hU := hU) U x y).empty] + +/-- Finite additivity of `cfcSpectralOperator` on disjoint measurable sets. -/ +lemma cfcSpectralOperator_add_of_disjoint {S T : Set (spectrum ℂ U)} (hS : MeasurableSet S) + (hT : MeasurableSet T) (hdisj : Disjoint S T) : + cfcSpectralOperator U hU (S ∪ T) = cfcSpectralOperator U hU S + cfcSpectralOperator U hU T := by + ext x + apply ext_inner_left ℂ + intro y + rw [cfcSpectralOperator_inner, add_apply, inner_add_right, + cfcSpectralOperator_inner, cfcSpectralOperator_inner, + (polarizedCfcScalarMeasure (hU := hU) U x y).of_union hdisj hS hT] + +/-! ## Step C: weak σ-additivity -/ + +/-- The operator at `S`, valued in the weak-operator-topology type. -/ +noncomputable def cfcSpectralMeasureFun (S : Set (spectrum ℂ U)) : H →WOT[ℂ] H := + ContinuousLinearMapWOT.ofCLM (cfcSpectralOperator U hU S) + +@[simp] +lemma cfcSpectralMeasureFun_inner (S : Set (spectrum ℂ U)) (x y : H) : + ⟪y, cfcSpectralMeasureFun U hU S x⟫_ℂ = polarizedCfcScalarMeasure (hU := hU) U x y S := by + simp only [cfcSpectralMeasureFun, ContinuousLinearMapWOT.ofCLM_apply] + exact cfcSpectralOperator_inner U hU S x y + +/-- The Riesz-represented family of operators assembled into a genuine +`MeasureTheory.VectorMeasure`, valued in the weak-operator-topology type `H →WOT[ℂ] H`. Weak +σ-additivity is transported directly from each `polarizedCfcScalarMeasure U hU x y`'s genuine +`ComplexMeasure` σ-additivity, through + `ContinuousLinearMapWOT.tendsto_iff_forall_inner_apply_tendsto` +(the defining property of the weak operator topology) and the additivity of the evaluation +functional `⟪y, · x⟫` over finite sums. -/ +noncomputable def cfcSpectralVectorMeasure : + VectorMeasure (spectrum ℂ U) (H →WOT[ℂ] H) where + measureOf' := cfcSpectralMeasureFun U hU + empty' := by + apply ContinuousLinearMapWOT.ext_inner + intro x y + rw [cfcSpectralMeasureFun_inner] + simp + not_measurable' S hS := by + show cfcSpectralMeasureFun U hU S = 0 + unfold cfcSpectralMeasureFun + rw [cfcSpectralOperator_apply_eq_zero_of_not_measurableSet U hU hS] + simp + m_iUnion' f hf hdisj := by + apply ContinuousLinearMapWOT.tendsto_iff_forall_inner_apply_tendsto.mpr + intro x y + have heq : ∀ s : Finset ℕ, + ⟪y, (∑ i ∈ s, cfcSpectralMeasureFun U hU (f i)) x⟫_ℂ = + ∑ i ∈ s, ⟪y, cfcSpectralMeasureFun U hU (f i) x⟫_ℂ := + fun s => map_sum (QuantumMechanics.WOTSpectralMeasure.innerEvaluation x y) _ s + simp_rw [heq, cfcSpectralMeasureFun_inner] + exact (polarizedCfcScalarMeasure (hU := hU) U x y).m_iUnion hf hdisj + +@[simp] +lemma cfcSpectralVectorMeasure_apply (S : Set (spectrum ℂ U)) : + cfcSpectralVectorMeasure U hU S = cfcSpectralMeasureFun U hU S := rfl + +/-! ## Step D: `E(S)` is a star-projection + +The idempotency proof follows the order/regularity route. We do not approximate indicator +functions by a sequence and then multiply weak limits. Instead, the scalar-measure quadratic +form first gives positivity, monotonicity, and the contraction bound for `E(S)`. For a compact +`K`, a Urysohn function supported in an open `V ⊇ K` gives an order sandwich +`E(K) ≤ f(U) ≤ E(V)`. The positive-contraction estimate above converts the resulting quadratic +form bounds into vector-norm bounds. Outer regularity of the finite measure +`μ_x + μ_{E(K)x}` then proves compact-set idempotence by an epsilon argument. Inner regularity +of `μ_x + μ_{E(S)x}` extends this to arbitrary measurable `S`. Set multiplicativity is derived +afterwards from finite additivity and orthogonality of projections on disjoint sets. +-/ + +set_option maxHeartbeats 1000000 + +section OrderRegularityHelpers + +variable {X : Type*} [TopologicalSpace X] [T2Space X] [MeasurableSpace X] + [BorelSpace X] [CompactSpace X] + +omit [CompactSpace X] in +/-- A continuous compactly supported function which is one on a compact set dominates that +compact set's measure in the scalar integral. This is the lower half of the Urysohn sandwich. -/ +@[nolint unusedArguments] +lemma measureReal_compact_le_integral_of_eqOn_one + (μ : Measure X) [IsFiniteMeasure μ] {K : Set X} (hK : IsCompact K) + (f : CompactlySupportedContinuousMap X ℝ) (hfK : Set.EqOn f 1 K) + (hf0 : ∀ x, 0 ≤ f x) : + μ.real K ≤ ∫ x, f x ∂μ := by + calc + μ.real K = ∫ x, K.indicator 1 x ∂μ := + MeasureTheory.integral_indicator_one hK.measurableSet |>.symm + _ ≤ ∫ x, f x ∂μ := by + refine MeasureTheory.integral_mono ?_ f.integrable ?_ + · exact (continuousOn_const.integrableOn_compact hK).integrable_indicator hK.measurableSet + · intro x + by_cases hx : x ∈ K + · simp [hx, hfK hx] + · simp [hx, hf0 x] + +omit [T2Space X] [CompactSpace X] in +/-- A nonnegative `[0,1]`-valued continuous compactly supported function supported in an open set +is dominated in integral by the indicator of that open set. This is the upper half of the Urysohn +sandwich. -/ +@[nolint unusedArguments] +lemma integral_le_measureReal_of_support_subset + (μ : Measure X) [IsFiniteMeasure μ] {V : Set X} (hV : IsOpen V) + (f : CompactlySupportedContinuousMap X ℝ) (hfV : tsupport f ⊆ V) + (hf : ∀ x, f x ∈ Set.Icc 0 1) : + (∫ x, f x ∂μ) ≤ μ.real V := by + calc + (∫ x, f x ∂μ) ≤ ∫ x, V.indicator 1 x ∂μ := by + refine MeasureTheory.integral_mono f.integrable ?_ ?_ + · exact IntegrableOn.integrable_indicator integrableOn_const hV.measurableSet + · intro x + by_cases hx : x ∈ tsupport f + · simp [hfV hx, (hf x).2] + · simp [image_eq_zero_of_notMem_tsupport hx, Set.indicator_nonneg] + _ = μ.real V := by + rw [MeasureTheory.integral_indicator_one hV.measurableSet] + +omit [T2Space X] [CompactSpace X] in +@[nolint unusedArguments] +lemma integral_le_measureReal_of_le_indicator + (μ : Measure X) [IsFiniteMeasure μ] {D : Set X} (hD : MeasurableSet D) + (f : CompactlySupportedContinuousMap X ℝ) (_hf : ∀ x, 0 ≤ f x) + (hfd : ∀ x, f x ≤ D.indicator 1 x) : + (∫ x, f x ∂μ) ≤ μ.real D := by + calc + (∫ x, f x ∂μ) ≤ ∫ x, D.indicator 1 x ∂μ := by + refine MeasureTheory.integral_mono f.integrable ?_ hfd + exact IntegrableOn.integrable_indicator integrableOn_const hD + _ = μ.real D := by + rw [MeasureTheory.integral_indicator_one hD] + +end OrderRegularityHelpers + +variable {X : Type*} [TopologicalSpace X] [T2Space X] [MeasurableSpace X] + +omit [TopologicalSpace X] [T2Space X] in +@[nolint unusedArguments] +lemma measureReal_lt_of_measure_lt_of_pos + (μ : Measure X) [IsFiniteMeasure μ] {S : Set X} {ε : ℝ} (hε : 0 < ε) + (hμε : μ S < ENNReal.ofReal ε) : μ.real S < ε := by + rw [measureReal_def] + have h := (ENNReal.toReal_lt_toReal (measure_ne_top μ S) ENNReal.ofReal_ne_top).2 hμε + simpa [ENNReal.toReal_ofReal hε.le] using h + +lemma cfcSpectralOperatorAux_nonneg {S : Set (spectrum ℂ U)} (hS : MeasurableSet S) : + 0 ≤ cfcSpectralOperatorAux U hU S hS := by + simpa [cfcSpectralOperator, hS] using cfcSpectralOperator_nonneg U hU hS + +lemma cfcSpectralOperatorAux_le_one {S : Set (spectrum ℂ U)} (hS : MeasurableSet S) : + cfcSpectralOperatorAux U hU S hS ≤ 1 := by + simpa [cfcSpectralOperator, hS] using cfcSpectralOperator_le_one U hU hS + +lemma cfcSpectralOperatorAux_mono {S T : Set (spectrum ℂ U)} (hS : MeasurableSet S) + (hT : MeasurableSet T) (hST : S ⊆ T) : + cfcSpectralOperatorAux U hU S hS ≤ cfcSpectralOperatorAux U hU T hT := by + simpa [cfcSpectralOperator, hS, hT] using cfcSpectralOperator_mono U hU hS hT hST + +lemma cfcRealOperator_reApplyInnerSelf + (f : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ) (x : H) : + (cfcRealOperator U hU f).reApplyInnerSelf x = + ∫ z, f z ∂cfcScalarMeasure U hU x := by + rw [ContinuousLinearMap.reApplyInnerSelf_apply, inner_re_symm] + exact (cfcScalarMeasure_integral U hU x f).symm + +@[nolint unusedArguments] +lemma cfcSpectralOperator_le_cfcRealOperator_of_compact_subset_open + {K V : Set (spectrum ℂ U)} (hK : IsCompact K) (_hV : IsOpen V) (_hKV : K ⊆ V) + (f : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ) + (hfK : Set.EqOn f 1 K) (_hfV : tsupport f ⊆ V) (hf : ∀ z, f z ∈ Set.Icc 0 1) : + cfcSpectralOperator U hU K ≤ cfcRealOperator U hU f := by + rw [ContinuousLinearMap.le_def, ContinuousLinearMap.isPositive_def'] + refine ⟨(cfcRealOperator_isSelfAdjoint U hU f).sub + (cfcSpectralOperator_isSelfAdjoint U hU K), fun x => ?_⟩ + rw [ContinuousLinearMap.reApplyInnerSelf_apply, sub_apply, + inner_sub_left, map_sub, inner_re_symm, ← cfcScalarMeasure_integral U hU x f] + rw [inner_re_symm (cfcSpectralOperator U hU K x) x, + cfcSpectralOperator_inner_self U hU hK.measurableSet x] + simpa using sub_nonneg.mpr (measureReal_compact_le_integral_of_eqOn_one + (cfcScalarMeasure U hU x) hK f hfK fun z => (hf z).1) + +lemma cfcRealOperator_le_cfcSpectralOperator_of_support_subset + {V : Set (spectrum ℂ U)} (hV : IsOpen V) + (f : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ) + (hfV : tsupport f ⊆ V) (hf : ∀ z, f z ∈ Set.Icc 0 1) : + cfcRealOperator U hU f ≤ cfcSpectralOperator U hU V := by + rw [ContinuousLinearMap.le_def, ContinuousLinearMap.isPositive_def'] + refine ⟨(cfcSpectralOperator_isSelfAdjoint U hU V).sub + (cfcRealOperator_isSelfAdjoint U hU f), fun x => ?_⟩ + rw [ContinuousLinearMap.reApplyInnerSelf_apply, sub_apply, + inner_sub_left, map_sub, inner_re_symm, + cfcSpectralOperator_inner_self U hU hV.measurableSet x] + rw [inner_re_symm (cfcRealOperator U hU f x) x, + ← cfcScalarMeasure_integral U hU x f] + simpa using sub_nonneg.mpr (integral_le_measureReal_of_support_subset + (cfcScalarMeasure U hU x) hV f hfV hf) + +lemma cfcRealOperator_mul_self + (f : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ) : + cfcRealOperator U hU (f * f) = cfcRealOperator U hU f * cfcRealOperator U hU f := by + have hmul : realToComplexContinuousMap U (f * f) = + realToComplexContinuousMap U f * realToComplexContinuousMap U f := by + ext z + simp [realToComplexContinuousMap_apply] + unfold cfcRealOperator + rw [hmul, map_mul] + +lemma cfcRealOperator_sub_mul_self + (f : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ) : + cfcRealOperator U hU (f - f * f) = + cfcRealOperator U hU f - cfcRealOperator U hU f * cfcRealOperator U hU f := by + have hmul : realToComplexContinuousMap U (f * f) = + realToComplexContinuousMap U f * realToComplexContinuousMap U f := by + ext z + simp [realToComplexContinuousMap_apply] + have hsub : realToComplexContinuousMap U (f - f * f) = + realToComplexContinuousMap U f - realToComplexContinuousMap U (f * f) := by + ext z + simp [realToComplexContinuousMap_apply] + unfold cfcRealOperator + rw [hsub, hmul, map_sub, map_mul] + +lemma cfcSpectralOperator_isIdempotent_of_isCompact + {K : Set (spectrum ℂ U)} (hK : IsCompact K) : + IsIdempotentElem (cfcSpectralOperator U hU K) := by + let A : H →L[ℂ] H := cfcSpectralOperator U hU K + have hA0 : 0 ≤ A := by + dsimp [A] + exact cfcSpectralOperator_nonneg U hU hK.measurableSet + have hA1 : A ≤ 1 := by + dsimp [A] + exact cfcSpectralOperator_le_one U hU hK.measurableSet + have hF1 (f : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ) + (hf : ∀ z, f z ∈ Set.Icc 0 1) : + cfcRealOperator U hU f ≤ 1 := by + calc + cfcRealOperator U hU f ≤ cfcSpectralOperator U hU Set.univ := + cfcRealOperator_le_cfcSpectralOperator_of_support_subset + U hU isOpen_univ f (Set.subset_univ _) hf + _ = 1 := cfcSpectralOperator_univ U hU + have hD_order (V : Set (spectrum ℂ U)) (hV : IsOpen V) + (hKV : K ⊆ V) + (f : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ) + (hfK : Set.EqOn f 1 K) (hfV : tsupport f ⊆ V) (hf : ∀ z, f z ∈ Set.Icc 0 1) : + 0 ≤ cfcRealOperator U hU f - A ∧ + cfcRealOperator U hU f - A ≤ 1 := by + have hAF : A ≤ cfcRealOperator U hU f := by + dsimp [A] + exact cfcSpectralOperator_le_cfcRealOperator_of_compact_subset_open + U hU hK hV hKV f hfK hfV hf + have hF0 : 0 ≤ cfcRealOperator U hU f := + (ContinuousLinearMap.nonneg_iff_isPositive _).mpr + (cfcRealOperator_nonneg U hU f (fun z => (hf z).1)) + have hFone := hF1 f hf + constructor + · exact sub_nonneg.mpr hAF + · calc + cfcRealOperator U hU f - A ≤ cfcRealOperator U hU f - 0 := + sub_le_sub_left hA0 _ + _ ≤ 1 := by simpa using hFone + have hcompact : ∀ (x : H), + (cfcSpectralOperator U hU K) (cfcSpectralOperator U hU K x) = + cfcSpectralOperator U hU K x := by + intro x + apply eq_of_sub_eq_zero + rw [← norm_eq_zero] + refine le_antisymm (le_of_forall_pos_le_add fun ε hε => ?_) (norm_nonneg _) + let μx := cfcScalarMeasure U hU x + let μAx := cfcScalarMeasure U hU (A x) + let ν := μx + μAx + let δ : ℝ := (ε / 4) ^ 2 + have hδ : 0 < δ := by dsimp [δ]; positivity + obtain ⟨V, hKV, hV, hνV⟩ := + hK.measurableSet.exists_isOpen_sdiff_lt (μ := ν) + (measure_ne_top ν K) (ENNReal.ofReal_pos.mpr hδ).ne' + let ug : C(spectrum ℂ U, ℝ) := + Classical.choose (exists_continuousMap_one_of_isCompact_subset_isOpen hK hV hKV) + have hug := Classical.choose_spec + (exists_continuousMap_one_of_isCompact_subset_isOpen hK hV hKV) + let f0 : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ := + ⟨ug, hasCompactSupport_def.mpr hug.2.1⟩ + have hf0K : Set.EqOn f0 1 K := by simpa [f0, ug] using hug.1 + have hf0V : tsupport f0 ⊆ V := by simpa [f0, ug] using hug.2.2.1 + have hf0 : ∀ z, f0 z ∈ Set.Icc 0 1 := by simpa [f0, ug] using hug.2.2.2 + let F := cfcRealOperator U hU f0 + let D := F - A + have hD0 : 0 ≤ D := by + dsimp [D, F] + exact (hD_order V hV hKV f0 hf0K hf0V hf0).1 + have hD1 : D ≤ 1 := by + dsimp [D, F] + exact (hD_order V hV hKV f0 hf0K hf0V hf0).2 + have hD_est (z : H) (hz : z = x ∨ z = A x) : + ‖D z‖ ^ 2 ≤ (cfcScalarMeasure U hU z).real (V \ K) := by + have hpc := norm_sq_le_inner_of_isPositive_of_le_one hD0 hD1 z + have hupper : (∫ y, f0 y ∂cfcScalarMeasure U hU z) ≤ + (cfcScalarMeasure U hU z).real V := by + exact integral_le_measureReal_of_support_subset + (cfcScalarMeasure U hU z) hV f0 hf0V hf0 + have hsplit : (cfcScalarMeasure U hU z).real K + + (cfcScalarMeasure U hU z).real (V \ K) = + (cfcScalarMeasure U hU z).real V := by + rw [measureReal_add_sdiff hK.measurableSet (measure_ne_top _ _) + (measure_ne_top _ _), union_eq_right.mpr hKV] + have hinner : RCLike.re ⟪z, D z⟫_ℂ = + (∫ y, f0 y ∂cfcScalarMeasure U hU z) - + (cfcScalarMeasure U hU z).real K := by + dsimp [D, F] + rw [sub_apply, inner_sub_right] + change (⟪z, (cfcRealOperator U hU f0) z⟫_ℂ - ⟪z, A z⟫_ℂ).re = _ + change RCLike.re ⟪z, (cfcRealOperator U hU f0) z⟫_ℂ - + RCLike.re ⟪z, A z⟫_ℂ = _ + rw [← cfcScalarMeasure_integral U hU z f0, + cfcSpectralOperator_inner_self U hU hK.measurableSet z] + norm_num + calc + ‖D z‖ ^ 2 ≤ RCLike.re ⟪z, D z⟫_ℂ := hpc + _ = (∫ y, f0 y ∂cfcScalarMeasure U hU z) - + (cfcScalarMeasure U hU z).real K := hinner + _ ≤ (cfcScalarMeasure U hU z).real (V \ K) := by linarith + have hD_lt (z : H) (hz : z = x ∨ z = A x) : ‖D z‖ < ε / 4 := by + have hνlt : ν.real (V \ K) < δ := + measureReal_lt_of_measure_lt_of_pos ν hδ hνV.2 + have hzν : (cfcScalarMeasure U hU z).real (V \ K) ≤ ν.real (V \ K) := by + rcases hz with rfl | rfl + · rw [measureReal_def, measureReal_def] + exact ENNReal.toReal_mono (measure_ne_top ν (V \ K)) + ((MeasureTheory.Measure.le_add_right le_rfl) (V \ K)) + · rw [measureReal_def, measureReal_def] + exact ENNReal.toReal_mono (measure_ne_top ν (V \ K)) + ((MeasureTheory.Measure.le_add_left le_rfl) (V \ K)) + have hs := (hD_est z hz).trans_lt (hzν.trans_lt hνlt) + dsimp [δ] at hs + nlinarith [norm_nonneg (D z)] + let q : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ := f0 - f0 * f0 + have hq (z : spectrum ℂ U) : q z ∈ Set.Icc 0 1 := by + dsimp [q] + have hz := hf0 z + constructor <;> nlinarith [hz.1, hz.2] + have hq_ind (z : spectrum ℂ U) : q z ≤ (V \ K).indicator 1 z := by + by_cases hz : z ∈ V \ K + · simp [hz, (hq z).2] + · have hz' : z ∉ V ∨ z ∈ K := by + by_cases hzV : z ∈ V + · right + by_contra hzK + exact hz ⟨hzV, hzK⟩ + · exact Or.inl hzV + rcases hz' with hzV | hzK + · have hzsupport : z ∉ tsupport f0 := fun hz' => hzV (hf0V hz') + have hfz : f0 z = 0 := image_eq_zero_of_notMem_tsupport hzsupport + simp [q, hfz, hzV] + · have hfz : f0 z = 1 := hf0K hzK + dsimp [q] + simp [hfz, hzK] + let Q := cfcRealOperator U hU q + have hQ0 : 0 ≤ Q := by + dsimp [Q] + exact (ContinuousLinearMap.nonneg_iff_isPositive _).mpr + (cfcRealOperator_nonneg U hU q (fun z => (hq z).1)) + have hQ1 : Q ≤ 1 := by + dsimp [Q] + exact hF1 q hq + have hQ_est : ‖Q x‖ ^ 2 ≤ μx.real (V \ K) := by + have hpc := norm_sq_le_inner_of_isPositive_of_le_one hQ0 hQ1 x + have hinner : RCLike.re ⟪x, Q x⟫_ℂ = ∫ z, q z ∂μx := by + dsimp [Q, μx] + exact (cfcScalarMeasure_integral U hU x q).symm + calc + ‖Q x‖ ^ 2 ≤ RCLike.re ⟪x, Q x⟫_ℂ := hpc + _ = ∫ z, q z ∂μx := hinner + _ ≤ μx.real (V \ K) := integral_le_measureReal_of_le_indicator μx + (hV.sdiff hK.isClosed).measurableSet q (fun z => (hq z).1) hq_ind + have hQ_lt : ‖Q x‖ < ε / 4 := by + have hνlt : ν.real (V \ K) < δ := + measureReal_lt_of_measure_lt_of_pos ν hδ hνV.2 + have hμν : μx.real (V \ K) ≤ ν.real (V \ K) := by + rw [measureReal_def, measureReal_def] + exact ENNReal.toReal_mono (measure_ne_top ν (V \ K)) + ((MeasureTheory.Measure.le_add_right le_rfl) (V \ K)) + have hs := hQ_est.trans_lt (hμν.trans_lt hνlt) + dsimp [δ] at hs + nlinarith [norm_nonneg (Q x)] + have hFop : ‖F‖ ≤ 1 := by + exact (CStarAlgebra.norm_le_one_iff_of_nonneg F + ((ContinuousLinearMap.nonneg_iff_isPositive _).mpr + (cfcRealOperator_nonneg U hU f0 (fun z => (hf0 z).1)))).2 + (hF1 f0 hf0) + have hexpand : A * A - A = + (A - F) * A + F * (A - F) + (F * F - F) + (F - A) := by + noncomm_ring + have hbound : ‖(A * A - A) x‖ ≤ ε := by + rw [hexpand] + change ‖(A - F) (A x) + F ((A - F) x) + + (F (F x) - F x) + (F x - A x)‖ ≤ ε + calc + ‖(A - F) (A x) + F ((A - F) x) + (F (F x) - F x) + (F x - A x)‖ ≤ + ‖(A - F) (A x)‖ + ‖F ((A - F) x)‖ + + ‖F (F x) - F x‖ + ‖F x - A x‖ := by + calc + _ ≤ ‖(A - F) (A x) + F ((A - F) x) + (F (F x) - F x)‖ + + ‖F x - A x‖ := norm_add_le _ _ + _ ≤ (‖(A - F) (A x) + F ((A - F) x)‖ + + ‖F (F x) - F x‖) + ‖F x - A x‖ := by + gcongr + exact norm_add_le _ _ + _ ≤ ((‖(A - F) (A x)‖ + ‖F ((A - F) x)‖) + + ‖F (F x) - F x‖) + ‖F x - A x‖ := by + gcongr + exact norm_add_le _ _ + _ ≤ ε / 4 + ε / 4 + ε / 4 + ε / 4 := by + have h1 : ‖(A - F) (A x)‖ < ε / 4 := by + have h' := hD_lt (A x) (Or.inr rfl) + change ‖F (A x) - A (A x)‖ < ε / 4 at h' + change ‖A (A x) - F (A x)‖ < ε / 4 + rw [show A (A x) - F (A x) = -(F (A x) - A (A x)) by abel, norm_neg] + exact h' + have h2 : ‖F ((A - F) x)‖ ≤ ‖(A - F) x‖ := by + calc + ‖F ((A - F) x)‖ ≤ ‖F‖ * ‖(A - F) x‖ := F.le_opNorm _ + _ ≤ ‖(A - F) x‖ := by + nlinarith [hFop, norm_nonneg ((A - F) x)] + have h2' : ‖F ((A - F) x)‖ < ε / 4 := + h2.trans_lt (by + have h' := hD_lt x (Or.inl rfl) + change ‖F x - A x‖ < ε / 4 at h' + change ‖A x - F x‖ < ε / 4 + rw [show A x - F x = -(F x - A x) by abel, norm_neg] + exact h') + have hQeq : Q = F - F * F := by + dsimp [Q, F] + exact cfcRealOperator_sub_mul_self U hU f0 + have h3 : ‖F (F x) - F x‖ < ε / 4 := by + have heq : F (F x) - F x = -Q x := by + calc + F (F x) - F x = -(F - F * F) x := by + simp [ContinuousLinearMap.mul_def, sub_eq_add_neg] + _ = -Q x := by rw [hQeq] + rw [heq] + simpa [norm_neg] using hQ_lt + have h4 : ‖F x - A x‖ < ε / 4 := by + have h' := hD_lt x (Or.inl rfl) + change ‖F x - A x‖ < ε / 4 at h' + exact h' + linarith only [h1, h2', h3, h4] + _ ≤ ε := by + ring_nf + exact le_rfl + simpa using hbound + apply ContinuousLinearMap.ext + intro x + exact hcompact x + +/-- **Idempotency of `cfcSpectralOperator` at a measurable set.** The proof is deliberately +order-theoretic: first establish the compact-set case using a Urysohn function and outer +regularity, then extend to arbitrary measurable sets using inner regularity. The estimates are +obtained from `0 ≤ A ≤ 1 ⟹ ‖A x‖² ≤ re ⟪x, A x⟫`; no weak/strong operator topology or +multiplication of limits is needed. -/ +lemma cfcSpectralOperatorAux_isIdempotentElem (S : Set (spectrum ℂ U)) (hS : MeasurableSet S) : + cfcSpectralOperatorAux U hU S hS * cfcSpectralOperatorAux U hU S hS = + cfcSpectralOperatorAux U hU S hS := by + let A : H →L[ℂ] H := cfcSpectralOperator U hU S + have hA0 : 0 ≤ A := cfcSpectralOperator_nonneg U hU hS + have hA1 : A ≤ 1 := cfcSpectralOperator_le_one U hU hS + have hA_id : A * A = A := by + apply ContinuousLinearMap.ext + intro x + apply eq_of_sub_eq_zero + rw [← norm_eq_zero] + refine le_antisymm (le_of_forall_pos_le_add fun ε hε => ?_) (norm_nonneg _) + let μx := cfcScalarMeasure U hU x + let μAx := cfcScalarMeasure U hU (A x) + let ν := μx + μAx + let δ : ℝ := (ε / 4) ^ 2 + have hδ : 0 < δ := by dsimp [δ]; positivity + obtain ⟨K, hKS, hK, hνK⟩ := hS.exists_isCompact_sdiff_lt + (measure_ne_top ν S) (ENNReal.ofReal_pos.mpr hδ).ne' + let P : H →L[ℂ] H := cfcSpectralOperator U hU K + have hP0 : 0 ≤ P := cfcSpectralOperator_nonneg U hU hK.measurableSet + have hP1 : P ≤ 1 := cfcSpectralOperator_le_one U hU hK.measurableSet + have hP_id : P * P = P := cfcSpectralOperator_isIdempotent_of_isCompact U hU hK + have hPA : P ≤ A := by + dsimp [P, A] + exact cfcSpectralOperator_mono U hU hK.measurableSet hS hKS + let D : H →L[ℂ] H := A - P + have hD0 : 0 ≤ D := by + dsimp [D] + exact sub_nonneg.mpr hPA + have hD1 : D ≤ 1 := by + dsimp [D] + calc + A - P ≤ A - 0 := sub_le_sub_left hP0 _ + _ ≤ 1 := by simpa using hA1 + have hD_est (z : H) (hz : z = x ∨ z = A x) : + ‖D z‖ ^ 2 ≤ (cfcScalarMeasure U hU z).real (S \ K) := by + have hpc := norm_sq_le_inner_of_isPositive_of_le_one hD0 hD1 z + have hsplit : (cfcScalarMeasure U hU z).real K + + (cfcScalarMeasure U hU z).real (S \ K) = + (cfcScalarMeasure U hU z).real S := by + rw [measureReal_add_sdiff hK.measurableSet (measure_ne_top _ _) + (measure_ne_top _ _), union_eq_right.mpr hKS] + have hinner : RCLike.re ⟪z, D z⟫_ℂ = + (cfcScalarMeasure U hU z).real S - + (cfcScalarMeasure U hU z).real K := by + dsimp [D] + rw [sub_apply, inner_sub_right] + change (⟪z, A z⟫_ℂ - ⟪z, P z⟫_ℂ).re = _ + change RCLike.re ⟪z, A z⟫_ℂ - RCLike.re ⟪z, P z⟫_ℂ = _ + rw [cfcSpectralOperator_inner_self U hU hS z, + cfcSpectralOperator_inner_self U hU hK.measurableSet z] + norm_num + calc + ‖D z‖ ^ 2 ≤ RCLike.re ⟪z, D z⟫_ℂ := hpc + _ = (cfcScalarMeasure U hU z).real S - + (cfcScalarMeasure U hU z).real K := hinner + _ ≤ (cfcScalarMeasure U hU z).real (S \ K) := by linarith [hsplit] + have hD_lt (z : H) (hz : z = x ∨ z = A x) : ‖D z‖ < ε / 4 := by + have hνlt : ν.real (S \ K) < δ := + measureReal_lt_of_measure_lt_of_pos ν hδ hνK + have hzν : (cfcScalarMeasure U hU z).real (S \ K) ≤ ν.real (S \ K) := by + rcases hz with rfl | rfl + · rw [measureReal_def, measureReal_def] + exact ENNReal.toReal_mono (measure_ne_top ν (S \ K)) + ((MeasureTheory.Measure.le_add_right le_rfl) (S \ K)) + · rw [measureReal_def, measureReal_def] + exact ENNReal.toReal_mono (measure_ne_top ν (S \ K)) + ((MeasureTheory.Measure.le_add_left le_rfl) (S \ K)) + have hs := (hD_est z hz).trans_lt (hzν.trans_lt hνlt) + dsimp [δ] at hs + nlinarith [norm_nonneg (D z)] + have hPop : ‖P‖ ≤ 1 := by + exact (CStarAlgebra.norm_le_one_iff_of_nonneg P + ((ContinuousLinearMap.nonneg_iff_isPositive _).mpr + (cfcSpectralOperator_isPositive U hU hK.measurableSet))).2 hP1 + have hexpand : A * A - A = (A - P) * A + P * (A - P) - (A - P) := by + calc + A * A - A = A * A - A + (P - P * P) := by rw [hP_id]; simp + _ = (A - P) * A + P * (A - P) - (A - P) := by noncomm_ring + have hbound : ‖(A * A - A) x‖ ≤ ε := by + rw [hexpand] + change ‖(A - P) (A x) + P ((A - P) x) - (A - P) x‖ ≤ ε + calc + ‖(A - P) (A x) + P ((A - P) x) - (A - P) x‖ ≤ + ‖(A - P) (A x)‖ + ‖P ((A - P) x)‖ + ‖(A - P) x‖ := by + calc + _ ≤ ‖(A - P) (A x) + P ((A - P) x)‖ + ‖(A - P) x‖ := norm_sub_le _ _ + _ ≤ (‖(A - P) (A x)‖ + ‖P ((A - P) x)‖) + ‖(A - P) x‖ := by + gcongr + exact norm_add_le _ _ + _ ≤ ε / 4 + ε / 4 + ε / 4 := by + have h1 : ‖(A - P) (A x)‖ < ε / 4 := by + have h' := hD_lt (A x) (Or.inr rfl) + change ‖(A - P) (A x)‖ < ε / 4 at h' + exact h' + have h2 : ‖P ((A - P) x)‖ ≤ ‖(A - P) x‖ := by + calc + ‖P ((A - P) x)‖ ≤ ‖P‖ * ‖(A - P) x‖ := P.le_opNorm _ + _ ≤ ‖(A - P) x‖ := by + nlinarith [hPop, norm_nonneg ((A - P) x)] + have h2' : ‖P ((A - P) x)‖ < ε / 4 := + h2.trans_lt (by + have h' := hD_lt x (Or.inl rfl) + change ‖(A - P) x‖ < ε / 4 at h' + exact h') + have h3 : ‖(A - P) x‖ < ε / 4 := by + have h' := hD_lt x (Or.inl rfl) + change ‖(A - P) x‖ < ε / 4 at h' + exact h' + linarith only [h1, h2', h3] + _ ≤ ε := by + ring_nf + nlinarith [hε] + simpa [sub_apply] using hbound + simpa [A, cfcSpectralOperator, hS] using hA_id + +/-! The idempotency proof above is the reusable order/regularity construction. It first proves +the compact case with an Urysohn cutoff and outer regularity, then approximates an arbitrary +measurable set from inside by compact sets. The only analytic estimate is the positive +contraction inequality `0 ≤ A ≤ 1 ⟹ ‖A x‖² ≤ re ⟪x, A x⟫`; no weak/strong operator topology +argument or multiplication of operator limits is involved. -/ + +/-- Idempotency of `cfcSpectralOperator` on every set — `0` (hence trivially idempotent) off the +measurable sets, and the order/regularity theorem above on measurable sets. -/ +lemma cfcSpectralOperator_isIdempotentElem (S : Set (spectrum ℂ U)) : + IsIdempotentElem (cfcSpectralOperator U hU S) := by + unfold cfcSpectralOperator IsIdempotentElem + split_ifs with hS + · exact cfcSpectralOperatorAux_isIdempotentElem U hU S hS + · simp + +/-- `cfcSpectralOperator U hU S` is a star-projection, for every `S`; both self-adjointness and +idempotency are proved. -/ +lemma cfcSpectralOperator_isStarProjection (S : Set (spectrum ℂ U)) : + IsStarProjection (cfcSpectralOperator U hU S) := + ⟨cfcSpectralOperator_isIdempotentElem U hU S, cfcSpectralOperator_isSelfAdjoint U hU S⟩ + +/-! ## Step E: final assembly -/ + +/-- **The weak-operator spectral measure of a bounded normal operator.** Assembled from the +Riesz-represented, weakly σ-additive family `cfcSpectralOperator` (Steps B–C, fully proved) and +the star-projection property (Step D), including the order/regularity proof of idempotency. -/ +noncomputable def cfcSpectralMeasure : QuantumMechanics.WOTSpectralMeasure (spectrum ℂ U) H where + toVectorMeasure := cfcSpectralVectorMeasure U hU + isStarProjection' S := by + show IsStarProjection (cfcSpectralMeasureFun U hU S) + unfold cfcSpectralMeasureFun + refine ⟨?_, ?_⟩ + · show ContinuousLinearMapWOT.ofCLM (cfcSpectralOperator U hU S) * + ContinuousLinearMapWOT.ofCLM (cfcSpectralOperator U hU S) = + ContinuousLinearMapWOT.ofCLM (cfcSpectralOperator U hU S) + rw [← ContinuousLinearMapWOT.ofCLM_mul] + exact congrArg ContinuousLinearMapWOT.ofCLM (cfcSpectralOperator_isIdempotentElem U hU S) + · apply ContinuousLinearMapWOT.toCLM_injective + change star (cfcSpectralOperator U hU S) = cfcSpectralOperator U hU S + exact cfcSpectralOperator_isSelfAdjoint U hU S + univ' := by + show cfcSpectralMeasureFun U hU Set.univ = 1 + unfold cfcSpectralMeasureFun + rw [cfcSpectralOperator_univ, ContinuousLinearMapWOT.ofCLM_one] + +@[simp] +lemma cfcSpectralMeasure_apply (S : Set (spectrum ℂ U)) : + cfcSpectralMeasure U hU S = cfcSpectralMeasureFun U hU S := rfl + +/-- The scalar measure attached to `cfcSpectralMeasure` is exactly the polarized Riesz measure it +was built from. -/ +lemma cfcSpectralMeasure_scalarMeasure (x y : H) : + (cfcSpectralMeasure U hU).scalarMeasure x y = polarizedCfcScalarMeasure (hU := hU) U x y := by + apply MeasureTheory.VectorMeasure.ext + intro S _ + rw [QuantumMechanics.WOTSpectralMeasure.scalarMeasure_apply, cfcSpectralMeasure_apply] + exact cfcSpectralMeasureFun_inner U hU S x y + +/-- **Reconstruction**: `cfcSpectralMeasure` genuinely is the spectral measure of `U` in the +weak sense — its weak integral against any continuous test function reproduces the continuous +functional calculus applied to `U`. -/ +theorem cfcSpectralMeasure_reconstruction + (f : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ) (x y : H) : + (cfcSpectralMeasure U hU).complexWeakIntegral (fun z => (f z : ℂ)) x y = + ⟪y, cfcRealOperator U hU f x⟫_ℂ := by + unfold QuantumMechanics.WOTSpectralMeasure.complexWeakIntegral + rw [cfcSpectralMeasure_scalarMeasure] + exact polarizedCfcScalarMeasure_complexIntegral_eq_inner U hU f x y + +/-! ## Step F: commutation with the commutant of `U` + +Everything above builds `cfcSpectralMeasure` as the genuine Borel/PVM spectral measure of the +normal operator `U`. This section shows that every spectral projection commutes with anything +that commutes with `U` (and its adjoint) — the fact needed to run Schur's lemma with genuine +spectral (rather than merely continuous-functional-calculus) projections. The key input is +Mathlib's `Commute.cfcHom`, which gives commutation with `cfcHom hU g` for every *continuous* +`g`; the commutation is transported to arbitrary measurable sets via the Riesz–Markov measure +uniqueness already used throughout this file +(`MeasureTheory.Measure.ext_of_integral_eq_on_compactlySupported`), using that a unitary +intertwiner preserves the defining vector-state functional. -/ + +/-- An operator commuting with `U` and `star U` commutes with the continuous functional calculus +of `U` at every real test function. -/ +lemma commute_cfcRealOperator {T : H →L[ℂ] H} (hTU : Commute U T) (hTU' : Commute (star U) T) + (f : CompactlySupportedContinuousMap (spectrum ℂ U) ℝ) : + Commute (cfcRealOperator U hU f) T := + hTU.cfcHom hU hTU' (realToComplexContinuousMap U f) + +/-- If `T` is an isometry (`star T * T = 1`) commuting with `U` and `star U`, the vector-state +Riesz measure at `T v` agrees with the one at `v`: an isometric intertwiner of `U` leaves the +diagonal spectral measure unchanged. -/ +lemma cfcScalarMeasure_eq_of_commute_isometry + {T : H →L[ℂ] H} (hTU : Commute U T) (hTU' : Commute (star U) T) + (hTiso : star T * T = 1) (v : H) : + cfcScalarMeasure U hU (T v) = cfcScalarMeasure U hU v := by + apply MeasureTheory.Measure.ext_of_integral_eq_on_compactlySupported + intro f + rw [cfcScalarMeasure_integral, cfcScalarMeasure_integral] + have hcomm : cfcRealOperator U hU f * T = T * cfcRealOperator U hU f := + commute_cfcRealOperator U hU hTU hTU' f + have hcommv : cfcRealOperator U hU f (T v) = T (cfcRealOperator U hU f v) := by + have h := congrArg (fun A : H →L[ℂ] H => A v) hcomm + simpa using h + rw [hcommv] + have hTT : ⟪T v, T (cfcRealOperator U hU f v)⟫_ℂ = ⟪v, cfcRealOperator U hU f v⟫_ℂ := by + have h := ContinuousLinearMap.adjoint_inner_right T v (T (cfcRealOperator U hU f v)) + rw [← h, ← ContinuousLinearMap.star_eq_adjoint] + have hw : star T (T (cfcRealOperator U hU f v)) = cfcRealOperator U hU f v := by + have := congrArg (fun A : H →L[ℂ] H => A (cfcRealOperator U hU f v)) hTiso + simpa using this + rw [hw] + rw [hTT] + +/-- If `T` is unitary and commutes with `U` and `star U`, the polarized Riesz measure intertwines: +testing at `(T x, y)` matches testing at `(x, star T y)`. This is the sesquilinear form of the +commutation identity, and is exactly what `cfcSpectralOperator_inner` needs to see commutation of +each spectral projection with `T`. -/ +lemma polarizedCfcScalarMeasure_eq_of_commute_unitary + {T : H →L[ℂ] H} (hTU : Commute U T) (hTU' : Commute (star U) T) + (hTunit : T ∈ unitary (H →L[ℂ] H)) (x y : H) : + polarizedCfcScalarMeasure (hU := hU) U (T x) y = + polarizedCfcScalarMeasure (hU := hU) U x (star T y) := by + have hTT : star T * T = (1 : H →L[ℂ] H) := Unitary.star_mul_self_of_mem hTunit + have hTT' : T * star T = (1 : H →L[ℂ] H) := Unitary.mul_star_self_of_mem hTunit + set w : H := star T y with hw_def + have hTw : T w = y := by + have h := congrArg (fun A : H →L[ℂ] H => A y) hTT' + simpa [hw_def] using h + have hTxw : T x + y = T (x + w) := by rw [map_add, hTw] + have hTxw' : T x - y = T (x - w) := by rw [map_sub, hTw] + have hTxIw : T x + Complex.I • y = T (x + Complex.I • w) := by + rw [map_add, map_smul, hTw] + have hTxIw' : T x - Complex.I • y = T (x - Complex.I • w) := by + rw [map_sub, map_smul, hTw] + apply MeasureTheory.VectorMeasure.ext + intro S hS + rw [polarizedCfcScalarMeasure_apply U hU hS, polarizedCfcScalarMeasure_apply U hU hS, + hTxw, hTxw', hTxIw, hTxIw', + cfcScalarMeasure_eq_of_commute_isometry U hU hTU hTU' hTT (x + w), + cfcScalarMeasure_eq_of_commute_isometry U hU hTU hTU' hTT (x - w), + cfcScalarMeasure_eq_of_commute_isometry U hU hTU hTU' hTT (x + Complex.I • w), + cfcScalarMeasure_eq_of_commute_isometry U hU hTU hTU' hTT (x - Complex.I • w)] + +/-- Every spectral operator `cfcSpectralOperator U hU S` commutes with any unitary intertwiner of +`U` (i.e. any unitary commuting with both `U` and `star U`). Holds for *every* `S`, measurable or +not, since `cfcSpectralOperator_inner` itself needs no measurability hypothesis. -/ +lemma cfcSpectralOperator_commute_of_commute_unitary + {T : H →L[ℂ] H} (hTU : Commute U T) (hTU' : Commute (star U) T) + (hTunit : T ∈ unitary (H →L[ℂ] H)) (S : Set (spectrum ℂ U)) : + cfcSpectralOperator U hU S * T = T * cfcSpectralOperator U hU S := by + ext v + apply ext_inner_left ℂ + intro y + show ⟪y, (cfcSpectralOperator U hU S * T) v⟫_ℂ = ⟪y, (T * cfcSpectralOperator U hU S) v⟫_ℂ + rw [show (cfcSpectralOperator U hU S * T) v = cfcSpectralOperator U hU S (T v) from rfl, + show (T * cfcSpectralOperator U hU S) v = T (cfcSpectralOperator U hU S v) from rfl, + cfcSpectralOperator_inner U hU S (T v) y, + polarizedCfcScalarMeasure_eq_of_commute_unitary U hU hTU hTU' hTunit v y, + ← cfcSpectralOperator_inner U hU S v (star T y), + ContinuousLinearMap.star_eq_adjoint] + exact ContinuousLinearMap.adjoint_inner_left T (cfcSpectralOperator U hU S v) y + +/-- The weak-operator spectral measure `cfcSpectralMeasure U hU` commutes with any unitary +intertwiner of `U`, at every set (measurable or not). -/ +lemma cfcSpectralMeasure_commute_of_commute_unitary + {T : H →L[ℂ] H} (hTU : Commute U T) (hTU' : Commute (star U) T) + (hTunit : T ∈ unitary (H →L[ℂ] H)) (S : Set (spectrum ℂ U)) : + cfcSpectralMeasure U hU S * ContinuousLinearMapWOT.ofCLM T = + ContinuousLinearMapWOT.ofCLM T * cfcSpectralMeasure U hU S := by + rw [cfcSpectralMeasure_apply] + show ContinuousLinearMapWOT.ofCLM (cfcSpectralOperator U hU S) * + ContinuousLinearMapWOT.ofCLM T = + ContinuousLinearMapWOT.ofCLM T * ContinuousLinearMapWOT.ofCLM (cfcSpectralOperator U hU S) + rw [← ContinuousLinearMapWOT.ofCLM_mul, ← ContinuousLinearMapWOT.ofCLM_mul] + exact congrArg ContinuousLinearMapWOT.ofCLM + (cfcSpectralOperator_commute_of_commute_unitary U hU hTU hTU' hTunit S) + +end CFCScalar + +end QuantumMechanics + +end diff --git a/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/WeakIntegral.lean b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/WeakIntegral.lean new file mode 100644 index 0000000000..bbb2183d55 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/HilbertSpace/Unbounded/WeakIntegral.lean @@ -0,0 +1,162 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.BoundedIntegral +public import PhyslibAlpha.AlgebraicFramework.HilbertSpace.Unbounded.Conjugation +public import Mathlib.MeasureTheory.VectorMeasure.SetIntegral + +/-! + +# The vector-measure integral against a scalar matrix coefficient + +`boundedIntegral` computes the operator `∫ f dμS` and then pairs it against test vectors; this +file records that, for a *bounded* multiplier, testing first and integrating second gives the +same answer: `⟪y, (∫ f dμS) x⟫ = ∫ f d(μS.scalarMeasure x y)`, where the right-hand side is +Mathlib's `VectorMeasure.integral` against the complex scalar measure `μS.scalarMeasure x y` +(`ScalarMeasure.lean`). That identity, `boundedIntegralOfUniformApprox_inner`, is what lets +`weakIntegral`/`complexWeakIntegral` be defined directly as ordinary vector-measure integrals of +possibly-*unbounded* multipliers `f` — the weak statement of the eventual unbounded reconstruction +law `T = ∫ λ dE(λ)`, testable on a single pair of vectors without needing `f(T)` itself to be a +bounded (or even densely-defined) operator on all of `H`. + +## Main definitions + +- `weakIntegral`, `complexWeakIntegral` : `∫ f d⟪y, μS(·)x⟫`, for real- and complex-valued `f`. +- `unitaryConjSpectralMeasure_weakIntegral` : compatibility with unitary transport + (`Conjugation.lean`). + +-/ + +@[expose] public section + +noncomputable section + +open scoped Topology InnerProductSpace Function +open ContinuousLinearMap ContinuousLinearMapWOT MeasureTheory Set + +namespace QuantumMechanics + +namespace WOTSpectralMeasure + +variable {α : Type*} [MeasurableSpace α] +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] +variable (μS : WOTSpectralMeasure α H) + +/-! ## A. Bounded integrals agree with the vector-measure integral -/ + +lemma boundedIntegralOfUniformApprox_inner + [Nonempty α] + {f : α → ℂ} {s : ℕ → SimpleFunc α ℂ} + (hs : ∀ ε > 0, ∃ N, ∀ n ≥ N, ∀ x, ‖s n x - f x‖ < ε) + (hsBound : ∃ C : ℝ, ∀ n x, ‖s n x‖ ≤ C) + (x y : H) + (hfinite : IsFiniteMeasure (μS.scalarMeasure x y).variation) : + ⟪y, boundedIntegralOfUniformApprox μS f s hs x⟫_ℂ = + ∫ᵛ z, f z ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); + μS.scalarMeasure x y] := by + let μ := μS.scalarMeasure x y + let B : ℂ →L[ℝ] ℂ →L[ℝ] ℂ := ContinuousLinearMap.lsmul ℝ ℂ + let _ : IsFiniteMeasure μ.variation := hfinite + have hmeas : ∀ n, AEStronglyMeasurable (s n) μ.variation := by + intro n + exact (s n).measurable.aestronglyMeasurable + have hbound : ∃ C : ℝ, ∀ᶠ n in Filter.atTop, ∀ᵐ z ∂μ.variation, ‖s n z‖ ≤ C := by + rcases hsBound with ⟨C, hC⟩ + exact ⟨C, Filter.Eventually.of_forall (fun n => Filter.Eventually.of_forall (hC n))⟩ + have hlim : ∀ᵐ z ∂μ.variation, + Filter.Tendsto (fun n => s n z) Filter.atTop (𝓝 (f z)) := by + filter_upwards [] with z + rw [Metric.tendsto_atTop] + intro ε hε + rcases hs ε hε with ⟨N, hN⟩ + exact ⟨N, fun n hn => by simpa only [dist_eq_norm] using hN n hn z⟩ + have hint : + Filter.Tendsto (fun n => ∫ᵛ z, s n z ∂[B; μ]) Filter.atTop + (𝓝 (∫ᵛ z, f z ∂[B; μ])) := by + exact MeasureTheory.VectorMeasure.tendsto_integral_filter_of_norm_le_const + (μ := μ) (B := B) (Filter.Eventually.of_forall hmeas) hbound hlim + have hsimple : ∀ n, + ∫ᵛ z, s n z ∂[B; μ] = + ⟪y, simpleIntegral μS (s n) x⟫_ℂ := by + intro n + rcases hsBound with ⟨C, hC⟩ + let a₀ : α := Classical.choice (inferInstance : Nonempty α) + have hC0 : 0 ≤ C := (norm_nonneg (s n a₀)).trans (hC n a₀) + have hi : Integrable (s n) μ.variation := + Integrable.of_bound (s n).measurable.aestronglyMeasurable C + (Filter.Eventually.of_forall (hC n)) + rw [VectorMeasure.integral_eq_setToFun] + rw [setToFun_simpleFunc (dominatedFinMeasAdditive_cbmApplyMeasure μ B) (s n) hi] + rw [simpleIntegral_inner] + apply Finset.sum_congr rfl + intro z hz + rfl + have hclm := (simpleIntegral_toCLM_cauchySeq μS hs).tendsto_limUnder + have hclm' : Filter.Tendsto + (fun n => ContinuousLinearMapWOT.toCLM (simpleIntegral μS (s n))) Filter.atTop + (𝓝 (ContinuousLinearMapWOT.toCLM + (boundedIntegralOfUniformApprox μS f s hs))) := by + rw [boundedIntegralOfUniformApprox_eq_limUnder] + exact hclm + have hoperator : + Filter.Tendsto + (fun n => ⟪y, simpleIntegral μS (s n) x⟫_ℂ) Filter.atTop + (𝓝 (⟪y, boundedIntegralOfUniformApprox μS f s hs x⟫_ℂ)) := by + have hev : Continuous (fun A : H →L[ℂ] H => ⟪y, A x⟫_ℂ) := by fun_prop + exact hev.continuousAt.tendsto.comp hclm' + have hsimple' : + Filter.Tendsto (fun n => ∫ᵛ z, s n z ∂[B; μ]) Filter.atTop + (𝓝 (⟪y, boundedIntegralOfUniformApprox μS f s hs x⟫_ℂ)) := by + simpa only [hsimple] using hoperator + exact tendsto_nhds_unique hsimple' hint + +/-! ## B. The weak integral of a possibly-unbounded multiplier -/ + +/-- The pairing is real-scalar multiplication on the complex scalar measure. -/ +def weakIntegral (f : α → ℝ) (x y : H) : ℂ := + ∫ᵛ z, f z ∂[ContinuousLinearMap.lsmul ℝ ℝ (E := ℂ); + μS.scalarMeasure x y] + +/-- The complex weak integral of a complex-valued spectral multiplier. The real-valued integral +above is retained for the self-adjoint reconstruction API; this companion is the bounded-unitary +side of the Cayley construction. -/ +def complexWeakIntegral (f : α → ℂ) (x y : H) : ℂ := + ∫ᵛ z, f z ∂[ContinuousLinearMap.lsmul ℝ ℂ (E := ℂ); + μS.scalarMeasure x y] + +lemma weakIntegral_map {β : Type*} [MeasurableSpace β] + (f : α → β) (hf : Measurable f) (g : β → ℝ) + (x y : H) (hgm : AEStronglyMeasurable g ((μS.scalarMeasure x y).variation.map f)) + (hgi : (μS.scalarMeasure x y).Integrable (g ∘ f)) : + (μS.map f hf).weakIntegral g x y = μS.weakIntegral (g ∘ f) x y := by + unfold weakIntegral + rw [scalarMeasure_map] + exact VectorMeasure.integral_map hf hgm hgi + +lemma complexWeakIntegral_map {β : Type*} [MeasurableSpace β] + (f : α → β) (hf : Measurable f) (g : β → ℂ) + (x y : H) (hgm : AEStronglyMeasurable g ((μS.scalarMeasure x y).variation.map f)) + (hgi : (μS.scalarMeasure x y).Integrable (g ∘ f)) : + (μS.map f hf).complexWeakIntegral g x y = + μS.complexWeakIntegral (g ∘ f) x y := by + unfold complexWeakIntegral + rw [scalarMeasure_map] + exact VectorMeasure.integral_map hf hgm hgi + +lemma unitaryConjSpectralMeasure_weakIntegral + {H' : Type*} [NormedAddCommGroup H'] [InnerProductSpace ℂ H'] [CompleteSpace H'] + (u : H ≃ₗᵢ[ℂ] H') (μS : WOTSpectralMeasure α H) (f : α → ℝ) (x y : H') : + (unitaryConjSpectralMeasure u μS).weakIntegral f x y = + μS.weakIntegral f (u.symm x) (u.symm y) := by + unfold weakIntegral + rw [unitaryConjSpectralMeasure_scalarMeasure] + +end WOTSpectralMeasure + +end QuantumMechanics + +end diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Basic.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Basic.lean new file mode 100644 index 0000000000..1cd931e857 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Basic.lean @@ -0,0 +1,75 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Mathlib.Algebra.Jordan.Basic +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Norm + +/-! + +# Jordan order-unit spaces + +## i. Overview + +This is the next rung above `OrderUnit`, per the architecture + +`AOU → JordanOrderUnit → JB → JBW (later)`. + +An order-unit space only remembers `≤` and `1`. Quantum observables carry one more +piece of structure that is *not* the full associative operator product (which loses +self-adjointness for non-commuting `a`, `b`): the Jordan product `a ∘ b`, a commutative, +generally non-associative multiplication satisfying the weak-associativity Jordan identity. This +file adds the minimal compatibility condition: every square is a possible outcome, +`0 ≤ a ∘ a`. In the operator picture `a ∘ a = a²`, and +`⟨ψ, a²ψ⟩ = ‖aψ‖² ≥ 0` is the reason variances are never negative. Identifying *every* positive +element with a square is deliberately not assumed here; that is a stronger spectral theorem of +the JB layer. + +We do not redefine Jordan algebras: `IsCommJordan` and the surrounding non-unital, non-associative +commutative ring axioms are exactly mathlib's `Mathlib.Algebra.Jordan.Basic`, together with the +real-linearity hypotheses (`Module ℝ E`, `SMulCommClass`, `IsScalarTower`) that its own module +docstring already names as the standard setting for a *real* Jordan algebra. This file only adds +this one order-compatibility axiom. + +## ii. Key definitions and results + +- `IsJordanOrderUnit E` +- `IsJordanOrderUnit.mul_one` +- `IsJordanOrderUnit.mul_self_nonneg` + +## iii. Table of contents + +- A. The compatibility class +- B. Consequences + +-/ + +@[expose] public section + +/-! ## A. The compatibility class -/ + +/-- `E` carries a unital Jordan product compatible with its order unit: every square is positive. +The multiplicative unit laws belong to `NonAssocCommRing`; they are deliberately not duplicated +here. Archimedeanness is not needed for this algebraic-order compatibility. -/ +class IsJordanOrderUnit (E : Type*) [NonAssocCommRing E] [PartialOrder E] + [IsOrderedAddMonoid E] [Module ℝ E] [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] + [IsCommJordan E] [IsOrderUnit E] : Prop where + /-- Every Jordan square is a possible measurement outcome. -/ + mul_self_nonneg : ∀ a : E, 0 ≤ a * a + +namespace IsJordanOrderUnit + +variable {E : Type*} [NonAssocCommRing E] [PartialOrder E] [IsOrderedAddMonoid E] + [Module ℝ E] [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] [IsCommJordan E] + [IsOrderUnit E] [IsJordanOrderUnit E] + +/-! ## B. Consequences -/ + +/-- Every Jordan square is a possible measurement outcome (unprimed re-export of the field, for +uniform dot-notation with the rest of this file's API). -/ +theorem sq_nonneg (a : E) : 0 ≤ a * a := mul_self_nonneg a + +end IsJordanOrderUnit diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Compatibility.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Compatibility.lean new file mode 100644 index 0000000000..791a10b242 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Compatibility.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Operator + +/-! + +# Jordan-intrinsic compatibility of observables + +## i. Overview + +The physical notion of two observables being "compatible" (jointly measurable, simultaneously +sharp) should not need the C⋆-commutator to state — that commutator does not exist at the bare +Jordan level, and defining compatibility via it would put the cart before the horse (compatibility +is exactly the *classical*, commuting fragment of the theory, the fragment that should not need the +full C⋆ apparatus to talk about). The standard Jordan-algebraic substitute is **operator +commutativity**: `a` and `b` are Jordan-compatible when their multiplication operators commute, +`L_a ∘ L_b = L_b ∘ L_a`. + +`CStarAlgebra/JordanCompatibility.lean` shows this is no idle abstraction: for `a`, `b` self-adjoint +elements of a C⋆-algebra that already commute in the ordinary associative sense (`ab = ba`), `L_a` +and `L_b` commute as Jordan operators too — so every associatively-compatible pair of observables +is automatically Jordan-compatible, recovering the expected physics. The converse (Jordan +compatibility implies associative commutativity) is *not* claimed here; it is a separate, harder +question left open. + +A genuinely stronger notion — that `a` and `b` *jointly generate an associative Jordan subalgebra*, +giving a two-observable joint functional calculus — needs a two-generator analogue of +`Power/GeneratedByOne.lean` and, in turn, a two-variable strengthening of +`Power/Associative.lean`'s open power-associativity theorem. That is real, disconnected future +work, not attempted here (see `JB_ROADMAP.md` item 10). + +## ii. Key definitions and results + +- `IsJordanOrderUnit.IsJordanCompatible` +- `IsJordanOrderUnit.isJordanCompatible_comm`, `.isJordanCompatible_one_left/right` + +## iii. Table of contents + +- A. The compatibility predicate + +-/ + +@[expose] public section + +namespace JordanAlgebra + +variable {E : Type*} [NonAssocCommRing E] [Module ℝ E] [SMulCommClass ℝ E E] + +open scoped JordanAlgebra + +/-! ## A. The compatibility predicate -/ + +/-- `a` and `b` are Jordan-compatible: their multiplication operators commute, +`L_a \circ L_b = L_b \circ L_a`. The Jordan-intrinsic substitute for "`a` and `b` commute", not +needing an associative product to state. -/ +def IsJordanCompatible (a b : E) : Prop := Commute (L a) (L b) + +theorem isJordanCompatible_self (a : E) : IsJordanCompatible a a := Commute.refl _ + +theorem isJordanCompatible_comm {a b : E} (h : IsJordanCompatible a b) : + IsJordanCompatible b a := h.symm + +/-- `L 1` is the identity operator (`mulLeft_one_apply` upgraded from pointwise to a genuine +operator equality). -/ +theorem mulLeft_one_eq_id : (L (1 : E) : E →ₗ[ℝ] E) = LinearMap.id := + LinearMap.ext mulLeft_one_apply + +/-- The order unit is Jordan-compatible with everything: `L_1 = id` commutes with any operator. -/ +theorem isJordanCompatible_one_left (a : E) : IsJordanCompatible 1 a := by + unfold IsJordanCompatible + rw [mulLeft_one_eq_id] + exact Commute.one_left _ + +theorem isJordanCompatible_one_right (a : E) : IsJordanCompatible a 1 := + (isJordanCompatible_one_left a).symm + +end JordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Conditioning.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Conditioning.lean new file mode 100644 index 0000000000..746d1c2d94 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Conditioning.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Observable +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Quadratic.Order + +/-! + +# Conditioning a state by a Jordan projection + +For a projection `p`, quadratic compression is `U_p`. Whenever `U_p` is positive and the state +assigns nonzero probability to `p`, the normalized functional + +`x ↦ ω(U_p x) / ω(p)` + +is again a state. Positivity of `U_p` is an explicit hypothesis here: it is a theorem of JB +spectral theory, not part of the weak `IsJordanOrderUnit` interface. This separation lets the +conditioning construction live at its true level without postulating the missing JB theorem. + +-/ + +@[expose] public section + +open JordanAlgebra +open scoped JordanAlgebra + +variable {E : Type*} [NonAssocCommRing E] [PartialOrder E] [IsOrderedAddMonoid E] + [Module ℝ E] [SMulCommClass ℝ E E] [IsOrderUnit E] + +/-! ## Quadratic conditioning -/ + +namespace JordanAlgebra + +/-- Condition a state on a Jordan projection. Positivity of the quadratic representation is +kept explicit, since it does not follow from the weak `IsJordanOrderUnit` interface. -/ +noncomputable def IsJordanProjection.condition {p : E} + (hp : IsJordanProjection p) (ω : 𝓢[ℝ, E]) (hmass : 0 < ω p) + (hU : ∀ x, 0 ≤ x → 0 ≤ U p x) : 𝓢[ℝ, E] := + UnitalPositiveLinearMap.ofLinearMap + ((ω p)⁻¹ • (ω.toLinearMap.comp (U p))) + (fun x hx => by + change 0 ≤ (ω p)⁻¹ * ω (U p x) + exact mul_nonneg (inv_nonneg.mpr hmass.le) (ω.map_nonneg (hU x hx))) + (by + change (ω p)⁻¹ * ω (U p 1) = 1 + rw [hp.quadRep_one] + exact inv_mul_cancel₀ hmass.ne') + +omit [IsOrderUnit E] in +@[simp] +theorem IsJordanProjection.condition_apply {p : E} + (hp : IsJordanProjection p) (ω : 𝓢[ℝ, E]) (hmass : 0 < ω p) + (hU : ∀ x, 0 ≤ x → 0 ≤ U p x) (x : E) : + hp.condition ω hmass hU x = (ω p)⁻¹ * ω (U p x) := + rfl + +omit [IsOrderUnit E] in +theorem IsJordanProjection.condition_one {p : E} + (hp : IsJordanProjection p) (ω : 𝓢[ℝ, E]) (hmass : 0 < ω p) + (hU : ∀ x, 0 ≤ x → 0 ≤ U p x) : + hp.condition ω hmass hU 1 = 1 := by + rw [hp.condition_apply, hp.quadRep_one] + exact inv_mul_cancel₀ hmass.ne' + +omit [IsOrderUnit E] in +theorem IsJordanProjection.condition_nonneg {p : E} + (hp : IsJordanProjection p) (ω : 𝓢[ℝ, E]) (hmass : 0 < ω p) + (hU : ∀ x, 0 ≤ x → 0 ≤ U p x) {x : E} (hx : 0 ≤ x) : + 0 ≤ hp.condition ω hmass hU x := + (hp.condition ω hmass hU).map_nonneg hx + +omit [IsOrderUnit E] in +/-- Conditioning on `p` makes `p` certain. -/ +theorem IsJordanProjection.condition_self {p : E} + (hp : IsJordanProjection p) (ω : 𝓢[ℝ, E]) (hmass : 0 < ω p) + (hU : ∀ x, 0 ≤ x → 0 ≤ U p x) : + hp.condition ω hmass hU p = 1 := by + rw [hp.condition_apply, hp.quadRep_self] + exact inv_mul_cancel₀ hmass.ne' + +omit [IsOrderUnit E] in +/-- Conditioning on `p` assigns probability zero to every projection Jordan-orthogonal to `p`. -/ +theorem IsJordanProjection.condition_apply_of_jordanOrthogonal {p q : E} + (hp : IsJordanProjection p) (ω : 𝓢[ℝ, E]) (hmass : 0 < ω p) + (hU : ∀ x, 0 ≤ x → 0 ≤ U p x) (horth : p * q = 0) : + hp.condition ω hmass hU q = 0 := by + rw [hp.condition_apply, hp.quadRep_jordanOrthogonal horth, map_zero, mul_zero] + +omit [IsOrderUnit E] in +/-- Conditioning on a projection assigns probability zero to its algebraic complement. -/ +theorem IsJordanProjection.condition_complement {p : E} + (hp : IsJordanProjection p) (ω : 𝓢[ℝ, E]) (hmass : 0 < ω p) + (hU : ∀ x, 0 ≤ x → 0 ≤ U p x) : + hp.condition ω hmass hU (1 - p) = 0 := + hp.condition_apply_of_jordanOrthogonal ω hmass hU hp.jordanOrthogonal_complement + +/-- Condition a state on a Jordan projection using the ambient quadratic-order capability. +This is the physics-facing form of `condition`: its only non-algebraic input is exactly the +positivity of quadratic representations, bundled by `IsQuadraticallyPositive`. -/ +noncomputable def IsJordanProjection.conditionOfQuadraticPositive {p : E} + (hp : IsJordanProjection p) (ω : 𝓢[ℝ, E]) (hmass : 0 < ω p) + [IsQuadraticallyPositive E] : 𝓢[ℝ, E] := + hp.condition ω hmass fun _ hx => quadRep_nonneg p hx + +omit [IsOrderUnit E] in +@[simp] +theorem IsJordanProjection.conditionOfQuadraticPositive_apply {p : E} + (hp : IsJordanProjection p) (ω : 𝓢[ℝ, E]) (hmass : 0 < ω p) + [IsQuadraticallyPositive E] (x : E) : + hp.conditionOfQuadraticPositive ω hmass x = (ω p)⁻¹ * ω (U p x) := + by rw [conditionOfQuadraticPositive, condition_apply] + +end JordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Covariance.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Covariance.lean new file mode 100644 index 0000000000..0e3e905346 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Covariance.lean @@ -0,0 +1,113 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Observable + +/-! + +# Covariance, and positivity of the covariance matrix + +## i. Overview + +At the bare order-unit level, a state only sees first moments, `ω(a)`. The Jordan +product is exactly what supplies second moments, `ω(a ∘ b)`, and hence a genuine symmetric +covariance +$$ \operatorname{Cov}_\omega(a, b) = \omega(a \circ b) - \omega(a)\,\omega(b), $$ +specializing to the variance already defined in `Observable.lean` on the diagonal, +`Var_ω(a) = Cov_ω(a, a)`. In the canonical C⋆-algebra realization (`CStarAlgebra/Jordan.lean`, +`a ∘ b = ½(ab+ba)`) this is exactly the usual symmetrized quantum covariance +`½⟨AB+BA⟩_ρ - ⟨A⟩_ρ⟨B⟩_ρ`. + +The point of building this at the Jordan level rather than waiting for the full associative +product: positivity of Jordan squares (`sq_nonneg`) is *exactly* enough to prove that every +covariance matrix `Γᵢⱼ = Cov_ω(aᵢ, aⱼ)` of a finite family of observables is positive +semidefinite, `Γ ⪰ 0` — apply `moment_two_nonneg` to the single observable +`x = ∑ᵢ cᵢ (aᵢ - ω(aᵢ) 1)` and expand `ω(x ∘ x)` bilinearly. This is the Jordan-algebraic core of +uncertainty theory (variance nonnegativity, Cauchy–Schwarz-type consequences for covariance); the +genuinely non-Jordan remainder, the antisymmetric commutator piece `ω([a,b])/2i` of the *full* +(non-symmetrized) product, is deliberately left to the C⋆/Lie layer +(`StarAlgebra/Lie.lean`) — see the module docstring there for the split +`ω((a-ω(a))(b-ω(b))) = Cov_ω(a,b) + ½ω([a,b])`. + +## ii. Key definitions and results + +- `LinearMap.covarianceForm` +- `IsJordanOrderUnit.variance_eq_covarianceForm_self` +- `IsJordanOrderUnit.covarianceForm_isPosSemidef` +- `IsJordanOrderUnit.covariance_cauchy_schwarz` +- `IsJordanOrderUnit.covMatrix_posSemidef` : `0 ≤ ∑ i, ∑ j, c i * c j * Cov_ω(aᵢ, aⱼ)` + +## iii. Table of contents + +- A. Covariance +- B. Positivity of the covariance matrix + +-/ + +@[expose] public section + +namespace IsJordanOrderUnit + +variable {E : Type*} [NonAssocCommRing E] [PartialOrder E] [IsOrderedAddMonoid E] + [Module ℝ E] [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] [IsCommJordan E] + [IsOrderUnit E] [IsJordanOrderUnit E] + +/-! ## A. Covariance -/ + +omit [IsOrderedAddMonoid E] [IsCommJordan E] [IsOrderUnit E] [IsJordanOrderUnit E] in +/-- The Jordan variance is the diagonal of the canonical generic covariance form. -/ +theorem variance_eq_covarianceForm_self (ω : 𝓢[ℝ, E]) (a : E) : + variance ω a = LinearMap.covarianceForm ω.toLinearMap a a := rfl + +omit [IsOrderedAddMonoid E] [IsCommJordan E] [IsOrderUnit E] [IsJordanOrderUnit E] in +/-- The state's value on the Jordan product of two centered observables is exactly their +covariance: the algebraic identity underlying `covMatrix_posSemidef` below. -/ +theorem moment_centered_mul (ω : 𝓢[ℝ, E]) (a b : E) : + ω (LinearMap.centered ω.toLinearMap a * LinearMap.centered ω.toLinearMap b) = + LinearMap.covarianceForm ω.toLinearMap a b := by + exact LinearMap.apply_centered_mul_centered ω.toLinearMap (map_one ω) + _root_.one_mul _root_.mul_one a b + +/-- The covariance form of a state is positive semidefinite. This is the coordinate-free form of +covariance-matrix positivity and uses only positivity of Jordan squares. -/ +theorem covarianceForm_isPosSemidef (ω : 𝓢[ℝ, E]) : + (LinearMap.covarianceForm ω.toLinearMap).IsPosSemidef where + isSymm := LinearMap.covarianceForm_isSymm ω.toLinearMap fun a b => mul_comm a b + isNonneg := ⟨fun a => by + rw [← moment_centered_mul] + exact ω.map_nonneg (sq_nonneg (LinearMap.centered ω.toLinearMap a))⟩ + +/-- Cauchy--Schwarz for covariance, derived from the generic theorem for positive semidefinite +bilinear forms rather than from a Cstar GNS representation. -/ +theorem covariance_cauchy_schwarz (ω : 𝓢[ℝ, E]) (a b : E) : + (LinearMap.covarianceForm ω.toLinearMap a b) ^ 2 ≤ variance ω a * variance ω b := by + have h := (LinearMap.covarianceForm ω.toLinearMap).apply_sq_le_of_symm + (covarianceForm_isPosSemidef ω).isNonneg.nonneg + (LinearMap.BilinForm.isSymm_iff.mp (covarianceForm_isPosSemidef ω).isSymm) a b + simpa only [← variance_eq_covarianceForm_self] using h + +/-! ## B. Positivity of the covariance matrix -/ + +/-- **Uncertainty theory, the Jordan-algebraic core**: the covariance matrix of a finite family of +observables is positive semidefinite. This is the coordinate form of +`covarianceForm_isPosSemidef`, obtained by evaluating the form on `∑ i, c i • a i`. -/ +theorem covMatrix_posSemidef {ι : Type*} [Fintype ι] (ω : 𝓢[ℝ, E]) (a : ι → E) (c : ι → ℝ) : + 0 ≤ ∑ i, ∑ j, c i * c j * LinearMap.covarianceForm ω.toLinearMap (a i) (a j) := by + have hnonneg := (covarianceForm_isPosSemidef ω).isNonneg.nonneg (∑ i, c i • a i) + simp only [map_sum, map_smul, LinearMap.coe_sum, Finset.sum_apply, + LinearMap.smul_apply, smul_eq_mul, Finset.mul_sum, LinearMap.covarianceForm_apply] + at hnonneg + refine hnonneg.trans_eq ?_ + apply Finset.sum_congr rfl + intro i _ + apply Finset.sum_congr rfl + intro j _ + rw [LinearMap.covarianceForm_isSymm ω.toLinearMap (fun x y => mul_comm x y) |>.eq] + rw [LinearMap.covarianceForm_apply] + ring + +end IsJordanOrderUnit diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/EXCEPTIONAL_ALBERT_ROADMAP.md b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/EXCEPTIONAL_ALBERT_ROADMAP.md new file mode 100644 index 0000000000..3e26e75f9e --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/EXCEPTIONAL_ALBERT_ROADMAP.md @@ -0,0 +1,67 @@ +# Exceptional Jordan / Albert implementation roadmap + +## Objective + +Formalize the genuine exceptional Euclidean Jordan algebra +`H₃(𝕆)` as a canonical PhyslibAlpha Jordan model, beginning with the generalized octonion +coordinate algebra and ending with its finite-dimensional trace/determinant and ordered-JB +realization. This is not a Cstar specialization: its purpose is precisely to cover the +exceptional non-special case. + +## Already owned + +- `Algebra/Alternative.lean`: associators, Teichmüller, alternation, flexibility, Moufang, and + McCrimmon left bumping. +- `Algebra/NuclearInvolution.lean`: nuclei, nuclear slipping, star/associator replacement, and + commutation of nuclear elements with associator values. +- `JordanOrderUnit/FiniteRank.lean`: rank/trace/determinant and density-observable interface. +- `JordanOrderUnit/StructureAlgebra.lean`: Jordan derivation and Lie-symmetry interface. + +## Mandatory dependency chain + +1. `Algebra/Octonion.lean` + - Generalized Cayley--Dickson `Octonion R a b c` over a commutative star-trivial base. + - Additive/module/ring/star structures, scalar embedding, conjugation, scalar norm, and + proved `IsAlternative` and `IsNuclearInvolution` instances. + - Specialize later to `R = ℝ`, `a = b = c = -1`; do not install a fake normed/JB instance. + +2. `Algebra/OctonionMatrix.lean` + - Matrix multiplication over octonions and the Hermitian subtype. + - Diagonal-real and off-diagonal-conjugacy API. No associative-matrix lemmas may be reused + without an explicit associativity hypothesis. + +3. `JordanOrderUnit/Exceptional/HermitianMatrixIdentity.lean` + - Matrix associator formulae for Hermitian `3 × 3` octonionic matrices. + - Use the nuclear-involution and left-bumping theorems to prove closure of the symmetrized + product and the Jordan identity. This is the central exceptional theorem. + +4. `JordanOrderUnit/Exceptional/Albert.lean` + - Define `AlbertAlgebra := HermitianOctonionMatrix (Fin 3)`. + - Provide `NonAssocCommRing`, real module/scalar compatibility, and `IsCommJordan` from the + central identity; expose the three real diagonal coordinates and three octonionic + off-diagonal coordinates (hence a real dimension-27 free-module basis after specializing + to `ℝ`). + - Define rank `3`, generic trace, and Moore determinant, then instantiate `TraceDeterminant`. + +5. `JordanOrderUnit/Exceptional/Euclidean.lean` + - Establish the positive cone, order unit, Euclidean Jordan norm, and the explicit + `IsJBOrderUnit` compatibility theorem. + - Only after this stage may Albert enter the JB spectral/CFC development. The finite- + dimensional JBW layer must be proved from the finite-dimensional order topology and normal + state separation; it is a consequence, not an assumed instance. + +## Non-negotiable proof gates + +- No `sorry`, `admit`, or new axioms. +- No import of Cobord's parallel `JordanAlgebra` class or `HermitianJordan` hierarchy. +- The Albert Jordan identity must be a theorem, not a typeclass field supplied as an assumption. +- The order-unit norm equality must be proved at the Euclidean realization stage; square + positivity alone is insufficient. +- Every stage passes `lake build PhyslibAlpha`, project linters, import-boundary checking, and + `git diff --check`. + +## Explicit non-goals until the chain is complete + +- Copying real/complex/quaternionic matrix wrappers that duplicate Cstar self-adjoint models. +- Claiming an Albert CFC, JB, or JBW instance before the respective norm/order theorem exists. +- Treating generalized octonions as associative. diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/EXTERNAL_JORDAN_ALGEBRA_AUDIT.md b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/EXTERNAL_JORDAN_ALGEBRA_AUDIT.md new file mode 100644 index 0000000000..bacc7dcd70 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/EXTERNAL_JORDAN_ALGEBRA_AUDIT.md @@ -0,0 +1,76 @@ +# Cobord/JordanAlgebra reuse audit + +Audited against `Cobord/JordanAlgebra` commit `8dd1d6719cb4c5e275ed7ae578bbec5574a64a39` +(2026-08-24), using its Lean 4.31 source. PhyslibAlpha uses Lean 4.33 and has a deliberately +different hierarchy, so it is not a dependency or a source tree to vendor wholesale. + +## Adopted now + +`Examples/SpinFactor.lean` ports the physics-relevant algebraic core of +`Jordan/SpinFactor.lean` into the canonical PhyslibAlpha interfaces: + +- the generic spin-factor carrier and product; +- its unit, additive/module structure, commutative nonassociative-ring witness, and Jordan + identity for a symmetric bilinear form; +- vector/scalar component API; +- the rank-two determinant and quadratic Cayley--Hamilton identity. + +It is intentionally only a `NonAssocCommRing`/`IsCommJordan` model. A real positive-definite +form has a Lorentz cone and a JB norm, but establishing that norm/order compatibility belongs to +the later analytic realization file. Installing a fictitious `JBAlgebra` or order-unit instance +here would violate the boundary repaired in B1. + +`StructureAlgebra.lean` ports the reusable symmetry layer at the same generality as the +canonical real Jordan core: + +- a bundled `JordanDerivation` carrier, proved to be a real vector space and Lie algebra under + commutator; +- the fact that every derivation fixes the unit; +- bundled inner derivations and their proved commutator law. + +This exposes infinitesimal reversible dynamics to concrete models (including the spin factor) +without creating a second multiplication-operator or Jordan-algebra hierarchy. + +`FiniteRank.lean` transfers the finite-rank trace/determinant interface without conflating it +with the general order-unit or JBW state spaces: + +- rank, generic trace, and homogeneous determinant data; +- density observables as the trace-one slice of Mathlib's canonical sum-of-squares cone; +- pure density observables, expectation functionals, and proved square-weighted mixing laws. + +`Algebra/Alternative.lean` is the foundational exceptional-model transfer: it supplies the +alternative associator calculus, Teichmüller identity, flexible and left Moufang laws, and +McCrimmon's left bumping formula. This is the correct common layer below octonions and the +Albert algebra; matrix-model code is intentionally not duplicated before that coordinate algebra +and its order/norm realization exist. + +The executable exceptional dependency order and proof gates are recorded in +`EXCEPTIONAL_ALBERT_ROADMAP.md`. + +## Already present here at a stronger or more general level + +| External material | PhyslibAlpha owner | Decision | +| --- | --- | --- | +| `JordanAlgebra.lean`: powers, multiplication operators, linearized identity | `JordanOrderUnit/Operator.lean`, `Quadratic/Fundamental.lean` | Do not duplicate. Our `mulLeft_triple_normalize`, polarizations, and quadratic API are the canonical real-Jordan formulation. | +| `JordanTriple.lean` | `Quadratic/Triple.lean` | Do not duplicate; ours identifies the triple operation with the canonical bilinear quadratic representation. | +| `StructureAlgebra.lean`: derivations and inner derivations | `StructureAlgebra.lean`, `Algebra/Derivation.lean`, `JB/Dynamics.lean`, `Quadratic/Fundamental.lean` | The bundled carrier/Lie layer is ported; raw predicate, generator, and inner-derivation theorems remain at their existing canonical owners. | +| `FormallyReal.lean`: square-sum consequences | `JB/Basic.lean`, `JB/Order.lean` | Do not duplicate. The JB layer derives formal reality and the stronger exact positive-cone theorem. | +| real/complex/quaternionic Hermitian models | `CStarAlgebra/Jordan.lean` and Hilbert/Cstar realization layers | Retain the canonical self-adjoint Cstar realization. Porting finite matrices would create a parallel specialization and add no abstract physics capability. | + +## Deliberately deferred concrete realizations + +The following are worthwhile *only after* their analytic/order data is stated at the right level: + +1. **Finite-dimensional Euclidean spin factors.** Add the Lorentz cone, Euclidean JB norm, + state space, and symmetries as a realization of the newly ported algebraic model. +2. **Exceptional Albert algebra.** Cobord's octonion/Hermitian-matrix development is a valuable + future finite-dimensional exceptional observable model. It depends on a substantial + alternative-algebra, nuclear-involution, and Moore-determinant stack. Port it as a separate + `Exceptional/Albert` realization after a compatibility audit; it must not leak octonionic + multiplication into abstract JB/CFC/JBW files. + +## Not imported + +No external source is imported and no external axioms are used. This preserves a single +Mathlib/toolchain graph, prevents duplicate Jordan classes, and keeps every transferred theorem +under PhyslibAlpha's proof and lint gates. diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Examples/SpinFactor.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Examples/SpinFactor.lean new file mode 100644 index 0000000000..f42e88a848 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Examples/SpinFactor.lean @@ -0,0 +1,145 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Operator +public import Mathlib.LinearAlgebra.QuadraticForm.Basic + +/-! +# Spin-factor Jordan algebras + +A spin factor is the Jordan algebra carried by `V × R` with product + +`(x, a) ∘ (y, b) = (a • y + b • x, B x y + a * b)`. + +This is the basic non-associative finite-dimensional observable model: over `ℝ`, a positive +definite form later supplies the Lorentz cone and its JB norm. The present file intentionally +stops at the algebraic layer. Positivity, completeness, and order-unit compatibility are +additional analytic data and must not be manufactured by this instance. + +The construction is adapted from Cobord's `Jordan/SpinFactor.lean`, but uses PhyslibAlpha's +canonical `NonAssocCommRing`/`IsCommJordan` interface rather than importing a parallel class. +-/ + +@[expose] public section + +namespace JordanAlgebra + +variable (R V : Type*) [CommRing R] [AddCommGroup V] [Module R V] + +/-- The spin factor determined by a bilinear form. The synonym keeps products belonging to +different forms from becoming definitionally interchangeable. -/ +abbrev SpinFactor (_B : LinearMap.BilinForm R V) : Type _ := V × R + +namespace SpinFactor + +variable {R V} +variable (B : LinearMap.BilinForm R V) + +instance : AddCommGroup (SpinFactor R V B) := inferInstanceAs (AddCommGroup (V × R)) +instance : Module R (SpinFactor R V B) := inferInstanceAs (Module R (V × R)) + +@[ext] theorem ext {z w : SpinFactor R V B} (hV : z.1 = w.1) (hR : z.2 = w.2) : z = w := + Prod.ext hV hR + +@[simp] theorem add_fst (z w : SpinFactor R V B) : (z + w).1 = z.1 + w.1 := rfl +@[simp] theorem add_snd (z w : SpinFactor R V B) : (z + w).2 = z.2 + w.2 := rfl +@[simp] theorem zero_fst : (0 : SpinFactor R V B).1 = 0 := rfl +@[simp] theorem zero_snd : (0 : SpinFactor R V B).2 = 0 := rfl +@[simp] theorem neg_fst (z : SpinFactor R V B) : (-z).1 = -z.1 := rfl +@[simp] theorem neg_snd (z : SpinFactor R V B) : (-z).2 = -z.2 := rfl +@[simp] theorem smul_fst (r : R) (z : SpinFactor R V B) : (r • z).1 = r • z.1 := rfl +@[simp] theorem smul_snd (r : R) (z : SpinFactor R V B) : (r • z).2 = r • z.2 := rfl + +/-- Constructor exposing the vector and scalar components. -/ +def mk (x : V) (a : R) : SpinFactor R V B := (x, a) + +@[simp] theorem mk_fst (x : V) (a : R) : (mk B x a).1 = x := rfl +@[simp] theorem mk_snd (x : V) (a : R) : (mk B x a).2 = a := rfl + +instance : Mul (SpinFactor R V B) where + mul z w := mk B (z.2 • w.1 + w.2 • z.1) (B z.1 w.1 + z.2 * w.2) + +@[simp] theorem mul_fst (z w : SpinFactor R V B) : + (z * w).1 = z.2 • w.1 + w.2 • z.1 := rfl + +@[simp] theorem mul_snd (z w : SpinFactor R V B) : + (z * w).2 = B z.1 w.1 + z.2 * w.2 := rfl + +instance : One (SpinFactor R V B) := ⟨mk B 0 1⟩ + +@[simp] theorem one_fst : (1 : SpinFactor R V B).1 = 0 := rfl +@[simp] theorem one_snd : (1 : SpinFactor R V B).2 = 1 := rfl + +instance : NonAssocRing (SpinFactor R V B) where + left_distrib z w v := by ext <;> simp [smul_add, mul_add] <;> [module; ring] + right_distrib z w v := by ext <;> simp [add_smul, map_add, add_mul] <;> [module; ring] + zero_mul z := by ext <;> simp + mul_zero z := by ext <;> simp + one_mul z := by ext <;> simp + mul_one z := by ext <;> simp + +theorem mul_comm (hB : B.IsSymm) (z w : SpinFactor R V B) : z * w = w * z := by + obtain ⟨x, a⟩ := z + obtain ⟨y, b⟩ := w + ext + · simp [add_comm] + · calc + B x y + a * b = B y x + a * b := congrArg (fun t => t + a * b) (hB.eq x y) + _ = B y x + b * a := by rw [_root_.mul_comm a b] + _ = _ := rfl + +instance : IsScalarTower R (SpinFactor R V B) (SpinFactor R V B) where + smul_assoc r z w := by + ext <;> simp [smul_add, smul_smul, smul_eq_mul] <;> ring + +instance : SMulCommClass R (SpinFactor R V B) (SpinFactor R V B) where + smul_comm r z w := by + ext <;> simp [smul_add, smul_smul, smul_eq_mul] <;> ring + +/-- A symmetric form gives the commutative Jordan algebra structure on the spin factor. -/ +@[instance_reducible] +noncomputable def nonAssocCommRing (hB : B.IsSymm) : NonAssocCommRing (SpinFactor R V B) where + __ := (inferInstance : NonAssocRing (SpinFactor R V B)) + mul_comm := mul_comm B hB + +/-- The Jordan identity for the spin-factor product. -/ +theorem isCommJordan (hB : B.IsSymm) : + let _ : NonAssocCommRing (SpinFactor R V B) := nonAssocCommRing B hB + IsCommJordan (SpinFactor R V B) := by + let : NonAssocCommRing (SpinFactor R V B) := nonAssocCommRing B hB + refine ⟨?_⟩ + intro z w + obtain ⟨x, a⟩ := z + obtain ⟨y, b⟩ := w + have hxy : B x y = B y x := by simpa using hB.eq x y + ext <;> simp [mul_fst, mul_snd, smul_eq_mul, hxy] <;> [module; ring] + +/-- The rank-two determinant/norm form of a spin factor. -/ +def determinant : QuadraticMap R (SpinFactor R V B) R := + QuadraticMap.sq.comp + { toFun := fun z => z.2 + map_add' := add_snd B + map_smul' := smul_snd B } - + B.toQuadraticMap.comp + { toFun := fun z => z.1 + map_add' := add_fst B + map_smul' := smul_fst B } + +@[simp] theorem determinant_apply (z : SpinFactor R V B) : + determinant B z = z.2 * z.2 - B z.1 z.1 := by + simp [determinant] + +/-- The quadratic Cayley--Hamilton identity characteristic of rank-two spin factors. -/ +theorem mul_self_sub_two_smul_snd_mul_add_determinant_smul_one + (z : SpinFactor R V B) : + z * z - (2 * z.2) • z + determinant B z • (1 : SpinFactor R V B) = 0 := by + obtain ⟨x, a⟩ := z + ext <;> simp [mul_fst, mul_snd, determinant_apply, smul_eq_mul] <;> [module; ring] + +end SpinFactor + +end JordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/FiniteRank.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/FiniteRank.lean new file mode 100644 index 0000000000..55adc6f8f6 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/FiniteRank.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.StructureAlgebra +public import Mathlib.Algebra.Ring.IsFormallyReal + +/-! +# Finite-rank Jordan trace and determinant data + +This is the algebraic finite-dimensional companion to the order-unit state space. It records the +generic trace and determinant of a formally real real Jordan algebra, and obtains density +observables by cutting the canonical sum-of-squares cone at trace one. It does not assert that +these are all order-unit states or normal JBW states: those are distinct analytic assertions. +-/ + +@[expose] public section + +namespace JordanAlgebra + +variable {E : Type*} [NonAssocCommRing E] [Module ℝ E] [SMulCommClass ℝ E E] + [IsScalarTower ℝ E E] [IsCommJordan E] [IsFormallyReal E] + +/-- Generic finite-rank trace and determinant data for a formally real real Jordan algebra. + +The intermediate coefficients of the generic minimal polynomial are deliberately not postulated: +they should be added together with an actual Cayley--Hamilton theorem, rather than as unused +structure fields. -/ +structure TraceDeterminant (E : Type*) [NonAssocCommRing E] [Module ℝ E] where + /-- Jordan rank, i.e. determinant degree and trace of the unit. -/ + rank : ℕ + /-- The generic trace. -/ + trace : E →ₗ[ℝ] ℝ + /-- The generic determinant. -/ + determinant : E → ℝ + determinant_smul : ∀ (r : ℝ) (x : E), determinant (r • x) = r ^ rank * determinant x + trace_one : trace 1 = rank + determinant_one : determinant 1 = 1 + +namespace TraceDeterminant + +/-- The finite-rank density-observable base: sums of Jordan squares with trace one. -/ +def states (τ : TraceDeterminant E) : Set E := + {ρ | IsSumSq ρ ∧ τ.trace ρ = 1} + +/-- A pure finite-rank density observable is an idempotent density observable. -/ +def pureStates (τ : TraceDeterminant E) : Set E := + {ρ | ρ ∈ τ.states ∧ ρ * ρ = ρ} + +/-- Expectation in a finite-rank density observable. -/ +def expectation (τ : TraceDeterminant E) (ρ : τ.states) : E →ₗ[ℝ] ℝ where + toFun a := τ.trace ((ρ : E) * a) + map_add' a b := by rw [mul_add, map_add] + map_smul' r a := by simp [mul_smul_comm] + +omit [IsScalarTower ℝ E E] [IsCommJordan E] [IsFormallyReal E] in +@[simp] theorem expectation_apply (τ : TraceDeterminant E) (ρ : τ.states) (a : E) : + τ.expectation ρ a = τ.trace ((ρ : E) * a) := rfl + +omit [IsCommJordan E] [IsFormallyReal E] in +/-- Square scalar weights preserve the sum-of-squares cone. -/ +theorem sq_smul_isSumSq {x : E} (hx : IsSumSq x) (r : ℝ) : IsSumSq ((r * r) • x) := by + induction hx with + | zero => simp + | sq_add a hs ih => + rw [smul_add] + have hsq : (r * r) • (a * a) = (r • a) * (r • a) := by + rw [smul_mul_assoc, mul_smul_comm, smul_smul] + rw [hsq] + exact IsSumSq.sq_add _ ih + +omit [IsCommJordan E] [IsFormallyReal E] in +/-- Square-weighted mixtures remain finite-rank density observables. -/ +theorem sq_smul_add_sq_smul_mem_states (τ : TraceDeterminant E) + {ρ σ : E} (hρ : ρ ∈ τ.states) (hσ : σ ∈ τ.states) + {r s : ℝ} (hrs : r * r + s * s = 1) : + (r * r) • ρ + (s * s) • σ ∈ τ.states := by + refine ⟨IsSumSq.add (sq_smul_isSumSq hρ.1 r) (sq_smul_isSumSq hσ.1 s), ?_⟩ + rw [map_add, map_smul, map_smul, hρ.2, hσ.2] + simpa using hrs + +omit [IsCommJordan E] [IsFormallyReal E] in +/-- Expectations respect square-weighted finite-rank mixtures. -/ +theorem expectation_sq_smul_add_sq_smul (τ : TraceDeterminant E) + {ρ σ : E} (hρ : ρ ∈ τ.states) (hσ : σ ∈ τ.states) + {r s : ℝ} (hrs : r * r + s * s = 1) (a : E) : + τ.expectation ⟨(r * r) • ρ + (s * s) • σ, + τ.sq_smul_add_sq_smul_mem_states hρ hσ hrs⟩ a = + (r * r) * τ.expectation ⟨ρ, hρ⟩ a + (s * s) * τ.expectation ⟨σ, hσ⟩ a := by + simp only [expectation_apply, add_mul, smul_mul_assoc, map_add, map_smul, smul_eq_mul] + +end TraceDeterminant + +end JordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/FreeJordanTwo.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/FreeJordanTwo.lean new file mode 100644 index 0000000000..fcd453557f --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/FreeJordanTwo.lean @@ -0,0 +1,236 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license and described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Mathlib.Algebra.FreeNonUnitalNonAssocAlgebra +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Hom + +/-! +# The free unital real Jordan algebra on two generators + +The construction follows Mathlib's free-Lie-algebra pattern: start with the free non-unital, +non-associative real algebra on a formal unit and two letters, then quotient by precisely the +relations for a unital commutative Jordan algebra. This is the abstract source of the canonical +map to `FreeSpecialJordanTwo`; it must not be confused with the latter special target. +-/ + +@[expose] public section + +namespace JordanAlgebra + +noncomputable section + +local notation "RawTwo" => FreeNonUnitalNonAssocAlgebra ℝ (Option (Fin 2)) + +/-- The congruence-generating relations for the free unital real Jordan algebra on two letters. -/ +inductive FreeJordanTwoRel : RawTwo → RawTwo → Prop + | comm (a b : RawTwo) : FreeJordanTwoRel (a * b) (b * a) + | jordan (a b : RawTwo) : + FreeJordanTwoRel (a * b * (a * a)) (a * (b * (a * a))) + | one_left (a : RawTwo) : + FreeJordanTwoRel (FreeNonUnitalNonAssocAlgebra.of ℝ none * a) a + | one_right (a : RawTwo) : + FreeJordanTwoRel (a * FreeNonUnitalNonAssocAlgebra.of ℝ none) a + | smul (r : ℝ) {a b : RawTwo} : FreeJordanTwoRel a b → FreeJordanTwoRel (r • a) (r • b) + | add_right (c : RawTwo) {a b : RawTwo} : + FreeJordanTwoRel a b → FreeJordanTwoRel (a + c) (b + c) + | mul_left (c : RawTwo) {a b : RawTwo} : + FreeJordanTwoRel a b → FreeJordanTwoRel (c * a) (c * b) + | mul_right (c : RawTwo) {a b : RawTwo} : + FreeJordanTwoRel a b → FreeJordanTwoRel (a * c) (b * c) + +namespace FreeJordanTwoRel + +theorem add_left (a : RawTwo) {b c : RawTwo} (h : FreeJordanTwoRel b c) : + FreeJordanTwoRel (a + b) (a + c) := by + rw [add_comm a b, add_comm a c] + exact h.add_right a + +theorem neg {a b : RawTwo} (h : FreeJordanTwoRel a b) : FreeJordanTwoRel (-a) (-b) := by + simpa only [neg_one_smul] using h.smul (-1) + +theorem sub_left (a : RawTwo) {b c : RawTwo} (h : FreeJordanTwoRel b c) : + FreeJordanTwoRel (a - b) (a - c) := by + simpa only [sub_eq_add_neg] using h.neg.add_left a + +theorem sub_right (c : RawTwo) {a b : RawTwo} (h : FreeJordanTwoRel a b) : + FreeJordanTwoRel (a - c) (b - c) := by + simpa only [sub_eq_add_neg] using h.add_right (-c) + +theorem nsmul (n : ℕ) {a b : RawTwo} (h : FreeJordanTwoRel a b) : + FreeJordanTwoRel (n • a) (n • b) := by + simpa only [← Nat.cast_smul_eq_nsmul ℝ] using h.smul (n : ℝ) + +theorem zsmul (n : ℤ) {a b : RawTwo} (h : FreeJordanTwoRel a b) : + FreeJordanTwoRel (n • a) (n • b) := by + simpa only [← Int.cast_smul_eq_zsmul ℝ] using h.smul (n : ℝ) + +end FreeJordanTwoRel + +/-- The free unital real Jordan algebra on two generators. -/ +def FreeJordanTwo : Type := Quot FreeJordanTwoRel + +namespace FreeJordanTwo + +instance : Zero FreeJordanTwo where zero := Quot.mk _ 0 + +instance : One FreeJordanTwo where one := Quot.mk _ (FreeNonUnitalNonAssocAlgebra.of ℝ none) + +instance : Add FreeJordanTwo where + add := Quot.map₂ (· + ·) (fun _ _ _ => FreeJordanTwoRel.add_left _) fun _ _ _ => + FreeJordanTwoRel.add_right _ + +instance : Neg FreeJordanTwo where neg := Quot.map Neg.neg fun _ _ => FreeJordanTwoRel.neg + +instance : Sub FreeJordanTwo where + sub := Quot.map₂ Sub.sub (fun _ _ _ => FreeJordanTwoRel.sub_left _) fun _ _ _ => + FreeJordanTwoRel.sub_right _ + +instance : Mul FreeJordanTwo where + mul := Quot.map₂ (· * ·) (fun _ _ _ => FreeJordanTwoRel.mul_left _) fun _ _ _ => + FreeJordanTwoRel.mul_right _ + +instance : SMul ℕ FreeJordanTwo where + smul n := Quot.map (n • ·) fun _ _ h => FreeJordanTwoRel.nsmul n h + +instance : SMul ℤ FreeJordanTwo where + smul n := Quot.map (n • ·) fun _ _ h => FreeJordanTwoRel.zsmul n h + +instance : SMul ℝ FreeJordanTwo where + smul r := Quot.map (r • ·) fun _ _ h => h.smul r + +instance : AddCommGroup FreeJordanTwo := + Function.Surjective.addCommGroup (Quot.mk _) Quot.mk_surjective rfl (fun _ _ => rfl) + (fun _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) fun _ _ => rfl + +instance : Module ℝ FreeJordanTwo := + Function.Surjective.module ℝ ⟨⟨Quot.mk _, rfl⟩, fun _ _ => rfl⟩ Quot.mk_surjective + (fun _ _ => rfl) + +instance : NonAssocCommRing FreeJordanTwo where + __ := (inferInstance : AddCommGroup FreeJordanTwo) + mul := (· * ·) + one := 1 + mul_comm x y := by + rcases x with ⟨x⟩ + rcases y with ⟨y⟩ + exact Quot.sound (FreeJordanTwoRel.comm x y) + one_mul x := by + rcases x with ⟨x⟩ + exact Quot.sound (FreeJordanTwoRel.one_left x) + mul_one x := by + rcases x with ⟨x⟩ + exact Quot.sound (FreeJordanTwoRel.one_right x) + left_distrib x y z := by + rcases x with ⟨x⟩ + rcases y with ⟨y⟩ + rcases z with ⟨z⟩ + change Quot.mk _ (x * (y + z)) = Quot.mk _ (x * y + x * z) + exact congrArg (Quot.mk _) (mul_add x y z) + right_distrib x y z := by + rcases x with ⟨x⟩ + rcases y with ⟨y⟩ + rcases z with ⟨z⟩ + change Quot.mk _ ((x + y) * z) = Quot.mk _ (x * z + y * z) + exact congrArg (Quot.mk _) (add_mul x y z) + zero_mul x := by + rcases x with ⟨x⟩ + change Quot.mk _ (0 * x) = Quot.mk _ 0 + exact congrArg (Quot.mk _) (zero_mul x) + mul_zero x := by + rcases x with ⟨x⟩ + change Quot.mk _ (x * 0) = Quot.mk _ 0 + exact congrArg (Quot.mk _) (mul_zero x) + +instance : IsCommJordan FreeJordanTwo where + lmul_comm_rmul_rmul x y := by + rcases x with ⟨x⟩ + rcases y with ⟨y⟩ + change Quot.mk _ (x * y * (x * x)) = Quot.mk _ (x * (y * (x * x))) + exact Quot.sound (FreeJordanTwoRel.jordan x y) + +/-- The first free abstract Jordan generator. -/ +def x : FreeJordanTwo := Quot.mk _ (FreeNonUnitalNonAssocAlgebra.of ℝ (some 0)) + +/-- The second free abstract Jordan generator. -/ +def y : FreeJordanTwo := Quot.mk _ (FreeNonUnitalNonAssocAlgebra.of ℝ (some 1)) + +variable {E : Type*} [NonAssocCommRing E] [Module ℝ E] + [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] [IsCommJordan E] + +/-- Raw evaluation of formal unit-and-two-letter expressions in a unital real Jordan algebra. -/ +def liftAux (f : Fin 2 → E) : RawTwo →ₙₐ[ℝ] E := + FreeNonUnitalNonAssocAlgebra.lift ℝ (fun o => Option.elim o 1 f) + +omit [IsCommJordan E] in +theorem liftAux_map_smul (f : Fin 2 → E) (r : ℝ) (a : RawTwo) : + liftAux f (r • a) = r • liftAux f a := + map_smul _ r a + +omit [IsCommJordan E] in +theorem liftAux_map_add (f : Fin 2 → E) (a b : RawTwo) : + liftAux f (a + b) = liftAux f a + liftAux f b := + map_add _ a b + +omit [IsCommJordan E] in +theorem liftAux_map_mul (f : Fin 2 → E) (a b : RawTwo) : + liftAux f (a * b) = liftAux f a * liftAux f b := + map_mul _ a b + +omit [IsCommJordan E] in +theorem liftAux_of_none (f : Fin 2 → E) : + liftAux f (FreeNonUnitalNonAssocAlgebra.of ℝ none) = 1 := by + simp [liftAux] + +theorem liftAux_spec (f : Fin 2 → E) (a b : RawTwo) (h : FreeJordanTwoRel a b) : + liftAux f a = liftAux f b := by + induction h with + | comm a b => simp only [liftAux_map_mul, mul_comm] + | jordan a b => + simp only [liftAux_map_mul, IsCommJordan.lmul_comm_rmul_rmul] + | one_left a => + rw [liftAux_map_mul] + rw [liftAux_of_none, one_mul] + | one_right a => + rw [liftAux_map_mul] + rw [liftAux_of_none, mul_one] + | smul r h ih => simp only [liftAux_map_smul, ih] + | add_right c h ih => simp only [liftAux_map_add, ih] + | mul_left c h ih => simp only [liftAux_map_mul, ih] + | mul_right c h ih => simp only [liftAux_map_mul, ih] + +/-- The canonical unital Jordan homomorphism evaluating the two free generators at `f`. -/ +def lift (f : Fin 2 → E) : JordanHom FreeJordanTwo E where + toLinearMap := + { toFun := fun q => Quot.liftOn q (liftAux f) (liftAux_spec f) + map_add' := by + rintro ⟨a⟩ ⟨b⟩ + exact liftAux_map_add f a b + map_smul' := by + rintro r ⟨a⟩ + exact liftAux_map_smul f r a } + map_one' := by + change liftAux f (FreeNonUnitalNonAssocAlgebra.of ℝ none) = 1 + simp [liftAux] + map_mul' := by + rintro ⟨a⟩ ⟨b⟩ + exact liftAux_map_mul f a b + +@[simp] +theorem lift_x (f : Fin 2 → E) : lift f x = f 0 := by + change liftAux f (FreeNonUnitalNonAssocAlgebra.of ℝ (some 0)) = f 0 + simp [liftAux] + +@[simp] +theorem lift_y (f : Fin 2 → E) : lift f y = f 1 := by + change liftAux f (FreeNonUnitalNonAssocAlgebra.of ℝ (some 1)) = f 1 + simp [liftAux] + +end FreeJordanTwo + +end + +end JordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/FreeSpecialTwo.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/FreeSpecialTwo.lean new file mode 100644 index 0000000000..cd571eb2a2 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/FreeSpecialTwo.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license and described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Mathlib.Algebra.FreeAlgebra +public import Mathlib.Algebra.Symmetrized +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.FreeJordanTwo +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Power.Generated + +/-! +# The free special Jordan algebra on two generators + +Let `A₂ = FreeAlgebra ℝ (Fin 2)`. Mathlib's `SymAlg A₂` is its normalized Jordanization, +with product `x ∘ y = (xy + yx)/2`. The free special Jordan algebra on two generators is the +Jordan fragment of that symmetrization generated by the two canonical free-associative letters. + +This is only the concrete special side of Shirshov--Cohn. It deliberately does not claim that +the abstract free Jordan algebra maps injectively here (Shirshov), nor that every quotient remains +special (Cohn); those are the two distinct hard theorems to be formalized above this object. +-/ + +@[expose] public section + +namespace JordanAlgebra + +/-- The free associative real algebra on two noncommuting letters. -/ +abbrev FreeAssocTwo := FreeAlgebra ℝ (Fin 2) + +/-- The normalized symmetrized product on the real free associative algebra uses division by two. +This is available because the free algebra has characteristic zero. -/ +noncomputable instance : Invertible (2 : FreeAssocTwo) := + let u : FreeAssocTwoˣ := + Units.map (algebraMap ℝ FreeAssocTwo) (Units.mk0 (2 : ℝ) (by norm_num)) + IsUnit.invertible ⟨u, by + change algebraMap ℝ FreeAssocTwo (2 : ℝ) = (2 : FreeAssocTwo) + exact map_natCast (algebraMap ℝ FreeAssocTwo) 2⟩ + +/-- Mathlib supplies the symmetrized non-associative ring and commutativity separately; package +them into the ordinary carrier class used by the generated-subalgebra API. -/ +noncomputable instance : NonAssocCommRing (SymAlg FreeAssocTwo) := + { SymAlg.nonAssocSemiring, SymAlg.addCommGroup with + mul_comm := SymAlg.mul_comm } + +noncomputable instance (priority := 2000) : SMul (SymAlg FreeAssocTwo) (SymAlg FreeAssocTwo) where + smul := (· * ·) + +noncomputable instance : + IsScalarTower ℝ (SymAlg FreeAssocTwo) (SymAlg FreeAssocTwo) where + smul_assoc r x y := by + rw [smul_eq_mul, smul_eq_mul] + apply SymAlg.unsym_injective + rw [SymAlg.unsym_mul, SymAlg.unsym_smul, SymAlg.unsym_smul, SymAlg.unsym_mul, + Algebra.smul_mul_assoc, Algebra.mul_smul_comm, ← smul_add, mul_smul_comm] + +noncomputable instance : + SMulCommClass ℝ (SymAlg FreeAssocTwo) (SymAlg FreeAssocTwo) where + smul_comm r x y := by + rw [smul_eq_mul, smul_eq_mul] + apply SymAlg.unsym_injective + rw [SymAlg.unsym_smul, SymAlg.unsym_mul, SymAlg.unsym_mul, SymAlg.unsym_smul, + Algebra.mul_smul_comm, Algebra.smul_mul_assoc, ← smul_add, Algebra.mul_smul_comm] + + +/-- The first canonical generator in the Jordanization of `FreeAssocTwo`. -/ +def freeSpecialX : SymAlg FreeAssocTwo := SymAlg.sym (FreeAlgebra.ι ℝ 0) + +/-- The second canonical generator in the Jordanization of `FreeAssocTwo`. -/ +def freeSpecialY : SymAlg FreeAssocTwo := SymAlg.sym (FreeAlgebra.ι ℝ 1) + +/-- The carrier submodule of the free special Jordan algebra on two generators. -/ +noncomputable abbrev freeSpecialJordanTwo : Submodule ℝ (SymAlg FreeAssocTwo) := + generatedByTwo freeSpecialX freeSpecialY + +/-- The free special Jordan algebra on two generators as its own unital real Jordan algebra. -/ +noncomputable abbrev FreeSpecialJordanTwo : Type _ := GeneratedByTwo freeSpecialX freeSpecialY + +/-- The first free special generator belongs to its generated Jordan fragment. -/ +theorem freeSpecialX_mem : freeSpecialX ∈ freeSpecialJordanTwo := + left_mem_generatedByTwo freeSpecialX freeSpecialY + +/-- The second free special generator belongs to its generated Jordan fragment. -/ +theorem freeSpecialY_mem : freeSpecialY ∈ freeSpecialJordanTwo := + right_mem_generatedByTwo freeSpecialX freeSpecialY + +/-- The two canonical letters as elements of the free special Jordan algebra. -/ +noncomputable def freeSpecialGenerators : Fin 2 → FreeSpecialJordanTwo := + Fin.cases ⟨freeSpecialX, freeSpecialX_mem⟩ fun _ => ⟨freeSpecialY, freeSpecialY_mem⟩ + +/-- The canonical homomorphism from the abstract free Jordan algebra to its special model. +Shirshov's theorem is precisely the still-unproved assertion that this map is injective. -/ +noncomputable def freeJordanToSpecial : JordanHom FreeJordanTwo FreeSpecialJordanTwo := + FreeJordanTwo.lift freeSpecialGenerators + +@[simp] +theorem freeJordanToSpecial_x : freeJordanToSpecial FreeJordanTwo.x = freeSpecialGenerators 0 := + FreeJordanTwo.lift_x freeSpecialGenerators + +@[simp] +theorem freeJordanToSpecial_y : freeJordanToSpecial FreeJordanTwo.y = freeSpecialGenerators 1 := + FreeJordanTwo.lift_y freeSpecialGenerators + +end JordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Hom.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Hom.lean new file mode 100644 index 0000000000..dbd828a818 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Hom.lean @@ -0,0 +1,100 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license and described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Mathlib.Algebra.Jordan.Basic +public import Mathlib.Data.Real.Basic +public import Mathlib.Algebra.Module.LinearMap.Basic + +/-! +# Unital real Jordan homomorphisms + +`JordanHom` is the minimal bundled map between unital real Jordan algebras: it is real-linear, +unital, and preserves the Jordan product. It has no order, norm, completeness, Cstar, or +specialness requirement. In particular it is the correct language for the inclusion of a +generated Jordan fragment and for the eventual local associative-envelope theorem. +-/ + +@[expose] public section + +namespace JordanAlgebra + +variable {E F G : Type*} [NonAssocCommRing E] [Module ℝ E] + [NonAssocCommRing F] [Module ℝ F] [NonAssocCommRing G] [Module ℝ G] + +/-- A unital real-linear map preserving the Jordan product. -/ +structure JordanHom (E F : Type*) [NonAssocCommRing E] [Module ℝ E] + [NonAssocCommRing F] [Module ℝ F] extends E →ₗ[ℝ] F where + map_one' : toLinearMap 1 = 1 + map_mul' : ∀ x y, toLinearMap (x * y) = toLinearMap x * toLinearMap y + +namespace JordanHom + +instance : CoeFun (JordanHom E F) fun _ => E → F := ⟨fun f => f.toLinearMap⟩ + +@[ext] +theorem ext {f g : JordanHom E F} (h : ∀ x, f x = g x) : f = g := by + rcases f with ⟨f, hf₁, hf₂⟩ + rcases g with ⟨g, hg₁, hg₂⟩ + dsimp at h + have hfg : f = g := LinearMap.ext h + subst g + rfl + +@[simp] +theorem map_zero (f : JordanHom E F) : f 0 = 0 := f.toLinearMap.map_zero + +@[simp] +theorem map_add (f : JordanHom E F) (x y : E) : f (x + y) = f x + f y := + f.toLinearMap.map_add x y + +theorem map_smul (f : JordanHom E F) (r : ℝ) (x : E) : f (r • x) = r • f x := + f.toLinearMap.map_smul r x + +@[simp] +theorem map_one (f : JordanHom E F) : f 1 = 1 := f.map_one' + +@[simp] +theorem map_mul (f : JordanHom E F) (x y : E) : f (x * y) = f x * f y := + f.map_mul' x y + +/-- The identity Jordan homomorphism. -/ +def id : JordanHom E E where + toLinearMap := LinearMap.id + map_one' := rfl + map_mul' _ _ := rfl + +/-- Composition of unital real Jordan homomorphisms. -/ +def comp (g : JordanHom F G) (f : JordanHom E F) : JordanHom E G where + toLinearMap := g.toLinearMap.comp f.toLinearMap + map_one' := by simp + map_mul' x y := by simp + +@[simp] +theorem id_apply (x : E) : id x = x := rfl + +@[simp] +theorem comp_apply (g : JordanHom F G) (f : JordanHom E F) (x : E) : + g.comp f x = g (f x) := rfl + +@[simp] +theorem id_comp (f : JordanHom E F) : (id : JordanHom F F).comp f = f := by + ext x + rfl + +@[simp] +theorem comp_id (f : JordanHom E F) : f.comp (id : JordanHom E E) = f := by + ext x + rfl + +theorem comp_assoc (h : JordanHom G E) (g : JordanHom F G) (f : JordanHom E F) : + (h.comp g).comp f = h.comp (g.comp f) := by + ext x + rfl + +end JordanHom + +end JordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/Basic.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/Basic.lean new file mode 100644 index 0000000000..8f9a34d061 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/Basic.lean @@ -0,0 +1,273 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Observable +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Norm +public import Mathlib.Analysis.Normed.Module.Basic +public import Mathlib.Algebra.Ring.IsFormallyReal + +/-! + +# Normed Jordan algebras and JB-algebras + +## i. Overview + +`JBAlgebra` is the analytic Banach refinement of a normed Jordan algebra. It deliberately has no +chosen order: square positivity does not stop a larger proper cone from changing the order-unit +norm. `IsJBOrderUnit` is the separate ordered refinement, asserting that a chosen order-unit cone +does induce the given norm. The classical norm package is exactly what a +"JB-algebra" (Jordan–Banach algebra satisfying the extra JB axiom) means in the literature +(Alfsen–Shultz, *State Spaces of Operator Algebras*; Hanche-Olsen–Størmer, *Jordan Operator +Algebras*, Def. 3.1.1 combined with the equivalent-axiom discussion around Prop. 3.3.6). Several +equivalent axiom sets are documented there; we fix the classical three-axiom one, since it is the +one that transfers most directly from the C⋆-algebra norm identity in the canonical realization +(`CStarAlgebra/Jordan.lean`): + +- `‖a ∘ b‖ ≤ ‖a‖ ‖b‖` — the product is submultiplicative; +- `‖a ∘ a‖ = ‖a‖ ^ 2` — squares realize the norm exactly (the "B*-condition" for Jordan algebras); +- `‖a ∘ a‖ ≤ ‖a ∘ a + b ∘ b‖` — monotonicity on sums of squares. + +This alone does not identify an independently supplied cone with the JB cone. Accordingly, +`IsJBOrderUnit.norm_eq_orderUnitNorm` is an explicit ordered compatibility field, not a theorem +claimed from square positivity. + +The data-carrying class `NormedJordanAlgebra` packages the additive, multiplicative, scalar, and +metric structures coherently. This avoids the instance diamonds caused by separately requesting +`NonAssocCommRing`, `NormedAddCommGroup`, `Module`, and `NormedSpace`. `JBAlgebra` is then the +complete analytic refinement: a JB-algebra is genuinely Banach, while incomplete normed Jordan +algebras retain an honest separate name. + +## ii. Key definitions and results + +- `NormedJordanAlgebra E` +- `JBAlgebra E` +- `JBAlgebra.norm_mul_self_le_norm_mul_self_add_mul_self` + +## iii. Table of contents + +- A. The class +- B. Basic consequences + +-/ + +@[expose] public section + +/-! ## A. Coherent normed Jordan data -/ + +/-- A coherent real normed unital Jordan algebra. All data-bearing parent structures are bundled +once so downstream analysis cannot select incompatible additions, scalar actions, or norms. -/ +class NormedJordanAlgebra (E : Type*) extends Norm E, MetricSpace E, NonAssocCommRing E, + Module ℝ E where + /-- The metric is induced by the additive norm. -/ + dist_eq : ∀ x y : E, dist x y = ‖-x + y‖ + /-- Real scalar multiplication is norm-bounded. -/ + norm_smul_le : ∀ (r : ℝ) (x : E), ‖r • x‖ ≤ ‖r‖ * ‖x‖ + /-- Real scalars commute with right Jordan multiplication. -/ + smul_comm : ∀ (r : ℝ) (x y : E), r • (x * y) = x * (r • y) + /-- Real scalar multiplication is a tower over Jordan multiplication. -/ + smul_assoc : ∀ (r : ℝ) (x y : E), (r • x) * y = r • (x * y) + /-- The commutative Jordan identity. -/ + jordan_identity : ∀ x y : E, x * y * (x * x) = x * (y * (x * x)) + /-- The Jordan product is norm-submultiplicative. -/ + norm_mul_le : ∀ x y : E, ‖x * y‖ ≤ ‖x‖ * ‖y‖ + +attribute [instance 10] NormedJordanAlgebra.toNonAssocCommRing + +/-- The coherent additive metric structure underlying a normed Jordan algebra. -/ +instance {E : Type*} [s : NormedJordanAlgebra E] : NormedAddCommGroup E := { s with } + +/-- The coherent real normed-space structure underlying a normed Jordan algebra. -/ +instance {E : Type*} [s : NormedJordanAlgebra E] : NormedSpace ℝ E := + { s.toModule with norm_smul_le := s.norm_smul_le } + +/-- Scalar actions commute with Jordan multiplication. -/ +instance {E : Type*} [s : NormedJordanAlgebra E] : SMulCommClass ℝ E E := ⟨s.smul_comm⟩ + +/-- Scalar actions form a tower over Jordan multiplication. -/ +instance {E : Type*} [s : NormedJordanAlgebra E] : IsScalarTower ℝ E E := ⟨s.smul_assoc⟩ + +/-- A normed Jordan algebra satisfies Mathlib's commutative Jordan predicate. -/ +instance {E : Type*} [s : NormedJordanAlgebra E] : IsCommJordan E := ⟨s.jordan_identity⟩ + +/-! ## B. The complete analytic refinement -/ + +/-- A JB-algebra: a complete real normed Jordan algebra whose norm realizes squares exactly and is +monotone under addition of squares. No order is chosen at this analytic level. -/ +class JBAlgebra (E : Type*) [NormedJordanAlgebra E] : Prop extends CompleteSpace E where + /-- Squares realize the norm exactly: the JB (Jordan–Banach) axiom. -/ + norm_mul_self : ∀ a : E, ‖a * a‖ = ‖a‖ ^ 2 + /-- Order-norm compatibility: a square's norm cannot exceed the norm of its sum with another + square. -/ + norm_mul_self_le_add : ∀ a b : E, ‖a * a‖ ≤ ‖a * a + b * b‖ + +/-- An ordered realization of a JB-algebra. `IsJordanOrderUnit` only makes squares positive; +this separate refinement says that the selected order-unit cone induces the given JB norm. -/ +class IsJBOrderUnit (E : Type*) [NormedJordanAlgebra E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [JBAlgebra E] : Prop + extends IsJordanOrderUnit E where + norm_eq_orderUnitNorm : ∀ x : E, ‖x‖ = IsArchimedeanOrderUnit.orderUnitNorm x + +namespace JBAlgebra + +variable {E : Type*} [NormedJordanAlgebra E] [JBAlgebra E] + +/-! ## C. Basic consequences -/ + +/-- Re-exported under the class-generic name matching the module docstring's displayed axiom. -/ +theorem norm_mul_self_le_norm_mul_self_add_mul_self (a b : E) : ‖a * a‖ ≤ ‖a * a + b * b‖ := + norm_mul_self_le_add a b + +/-- The Jordan square of a norm-`1` element has norm `1`. -/ +theorem norm_mul_self_of_norm_eq_one {a : E} (ha : ‖a‖ = 1) : ‖a * a‖ = 1 := by + rw [norm_mul_self, ha, one_pow] + +/-- A Jordan square in a JB-algebra is zero only when its root is zero. -/ +theorem eq_zero_of_mul_self_eq_zero {a : E} (ha : a * a = 0) : a = 0 := by + apply norm_eq_zero.mp + apply sq_eq_zero_iff.mp + rw [← norm_mul_self a, ha, norm_zero] + +/-- The zero-square criterion as an equivalence, convenient when transporting formal reality to +subalgebras and quotients. -/ +theorem mul_self_eq_zero_iff {a : E} : a * a = 0 ↔ a = 0 := + ⟨eq_zero_of_mul_self_eq_zero, fun h => by simp [h]⟩ + +section Ordered + +variable [PartialOrder E] [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] + [PosSMulMono ℝ E] [IsJBOrderUnit E] + +/-- In an ordered JB realization, the analytic norm is exactly the order-unit norm. -/ +theorem norm_eq_orderUnitNorm (x : E) : ‖x‖ = IsArchimedeanOrderUnit.orderUnitNorm x := + IsJBOrderUnit.norm_eq_orderUnitNorm x + +/-- A nonnegative scalar bounds the analytic JB norm exactly when its order-unit multiple bounds +the observable on both sides. This is the public norm/order interface for an ordered JB algebra. -/ +theorem norm_le_iff_order_bounds {x : E} {r : ℝ} (hr : 0 ≤ r) : + ‖x‖ ≤ r ↔ -(r • (1 : E)) ≤ x ∧ x ≤ r • (1 : E) := by + constructor + · intro h + rw [norm_eq_orderUnitNorm] at h + exact (IsArchimedeanOrderUnit.mem_orderUnitBounds_iff.mpr h).2 + · rintro ⟨hlow, hupp⟩ + rw [norm_eq_orderUnitNorm] + exact IsArchimedeanOrderUnit.mem_orderUnitBounds_iff.mp ⟨hr, hlow, hupp⟩ + +/-- The unit interval is contained in the analytic closed unit ball of an ordered JB algebra. -/ +theorem norm_le_one_of_zero_le_of_le_one {x : E} (hx : 0 ≤ x) (hxu : x ≤ 1) : ‖x‖ ≤ 1 := by + apply (norm_le_iff_order_bounds (x := x) (r := 1) zero_le_one).mpr + constructor + · calc + -((1 : ℝ) • (1 : E)) ≤ 0 := by simp [IsOrderUnit.one_nonneg] + _ ≤ x := hx + · simpa using hxu + +/-- The positive cone is closed for the supplied JB norm. This transports the order-unit +closedness argument to the analytic norm through `norm_eq_orderUnitNorm`, and is the limit step +needed by intrinsic square-root approximations. -/ +theorem isClosed_nonneg : IsClosed {x : E | 0 ≤ x} := by + apply IsSeqClosed.isClosed + intro x p hx hp + apply neg_nonpos.mp + apply IsArchimedeanOrderUnit.le_zero_of_forall_pos_smul_one_le + intro ε hε + obtain ⟨N, hN⟩ := Metric.tendsto_atTop.mp hp ε hε + have hdist := hN N le_rfl + have hnorm : IsArchimedeanOrderUnit.orderUnitNorm (p - x N) < ε := by + rw [dist_eq_norm] at hdist + change ‖x N - p‖ < ε at hdist + calc + IsArchimedeanOrderUnit.orderUnitNorm (p - x N) = ‖p - x N‖ := + (norm_eq_orderUnitNorm (p - x N)).symm + _ = ‖x N - p‖ := by rw [← norm_neg, neg_sub] + _ < ε := hdist + have hdiff : -(ε • (1 : E)) ≤ p - x N := by + have hmono : IsArchimedeanOrderUnit.orderUnitNorm (p - x N) • (1 : E) ≤ ε • (1 : E) := by + calc + IsArchimedeanOrderUnit.orderUnitNorm (p - x N) • (1 : E) = + ε • (1 : E) - (ε - IsArchimedeanOrderUnit.orderUnitNorm (p - x N)) • (1 : E) := by + rw [← sub_smul, sub_sub_cancel] + _ ≤ ε • (1 : E) := sub_le_self _ + (smul_nonneg (sub_nonneg.mpr hnorm.le) IsOrderUnit.one_nonneg) + exact (neg_le_neg hmono).trans + (IsArchimedeanOrderUnit.neg_orderUnitNorm_smul_one_le (p - x N)) + have hnegp : -p ≤ ε • (1 : E) - x N := by + have hshift := add_le_add_right (neg_le_neg hdiff) (-x N) + convert hshift using 1 <;> abel + calc + -p ≤ ε • (1 : E) - x N := hnegp + _ ≤ ε • (1 : E) := sub_le_self _ (hx N) + +/-- Every finite sum of Jordan squares is positive. -/ +theorem isSumSq_nonneg {s : E} (hs : IsSumSq s) : 0 ≤ s := by + induction hs with + | zero => exact le_rfl + | sq_add a _ ih => exact add_nonneg (IsJordanOrderUnit.mul_self_nonneg a) ih + +/-- A JB-algebra has no square root of `-1`. This elementary ordered consequence is the +key algebraic obstruction separating the real JB one-generator algebra from arbitrary real +uniform Banach algebras (where the real spectrum may be empty). -/ +theorem no_mul_self_eq_neg_one [Nontrivial E] (a : E) : a * a ≠ -1 := by + intro h + have hnonneg : (0 : E) ≤ a * a := IsJordanOrderUnit.mul_self_nonneg a + have hone : (0 : E) < (1 : E) := + lt_of_le_of_ne IsOrderUnit.one_nonneg (Ne.symm one_ne_zero) + have hneg : (-1 : E) < 0 := neg_lt_zero.mpr hone + exact (not_le_of_gt hneg) (h ▸ hnonneg) + +/-- A sum of two Jordan squares can vanish only when both roots vanish. This is the +two-square form of formal reality and is useful when analysing quadratic real factors in the +one-generator resolvent. -/ +theorem add_mul_self_eq_zero_iff {a b : E} : + a * a + b * b = 0 ↔ a = 0 ∧ b = 0 := by + constructor + · intro h + have hsq := (add_eq_zero_iff_of_nonneg (IsJordanOrderUnit.mul_self_nonneg a) + (IsJordanOrderUnit.mul_self_nonneg b)).mp h + exact ⟨eq_zero_of_mul_self_eq_zero hsq.1, eq_zero_of_mul_self_eq_zero hsq.2⟩ + · rintro ⟨rfl, rfl⟩ + simp + +/-- The positive quadratic factor `a² + 1` cannot vanish in a nontrivial JB-algebra. -/ +theorem mul_self_add_one_ne_zero [Nontrivial E] (a : E) : a * a + 1 ≠ 0 := by + intro h + have h' : a * a + (1 : E) * 1 = 0 := by simpa using h + exact one_ne_zero ((add_mul_self_eq_zero_iff.mp h').2) + +/-- A JB-algebra is formally real: a finite sum of nonzero squares cannot vanish. Square +positivity makes every sum of squares positive, while the JB square-norm identity makes a zero +square have a zero root. This is the algebraic realness needed by the one-generator real Gelfand +theorem, and is stronger than merely having a uniform norm. -/ +noncomputable instance instIsFormallyReal : IsFormallyReal E := + IsFormallyReal.of_eq_zero_of_mul_self_of_eq_zero_of_add + (fun {a} ha => eq_zero_of_mul_self_eq_zero ha) + (by + intro s₁ s₂ hs₁ hs₂ hsum + exact (add_eq_zero_iff_of_nonneg (isSumSq_nonneg hs₁) (isSumSq_nonneg hs₂)).mp hsum |>.1) + +/-- In an ordered JB realization, the ambient JB norm and the order-unit norm copy are linearly +isometric. This is deliberately a bundled transport rather than a second global norm instance +on `E`: downstream constructions can choose the order-unit topology explicitly without creating +an instance diamond. -/ +noncomputable def toWithOrderUnitNormLinearIsometryEquiv : + E ≃ₗᵢ[ℝ] WithOrderUnitNorm E where + __ := WithOrderUnitNorm.linearEquiv + norm_map' x := by + change IsArchimedeanOrderUnit.orderUnitNorm x = ‖x‖ + exact (norm_eq_orderUnitNorm x).symm + +/-- The order-unit-norm copy of an ordered JB algebra is complete, transported explicitly from +the Banach completeness contained in `JBAlgebra`. -/ +theorem completeWithOrderUnitNorm : CompleteSpace (WithOrderUnitNorm E) := by + exact (completeSpace_congr + (e := (toWithOrderUnitNormLinearIsometryEquiv (E := E)).symm.toLinearEquiv.toEquiv) + (toWithOrderUnitNormLinearIsometryEquiv (E := E)).symm.isometry.isUniformEmbedding).mpr + JBAlgebra.toCompleteSpace + +end Ordered + +end JBAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/Dynamics.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/Dynamics.lean new file mode 100644 index 0000000000..47c33771eb --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/Dynamics.lean @@ -0,0 +1,111 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.Basic +public import PhyslibAlpha.AlgebraicFramework.Dynamics.GeneratorIsDerivation + +/-! + +# The generator of JB automorphisms is a Jordan derivation + +## i. Overview + +`NormedJordanAlgebra` packages a coherent norm, additive group, real module, and Jordan product. +Its submultiplicativity axiom is exactly the bounded-bilinear hypothesis needed by the generic +generator theorem. Consequently the result is abstract in an arbitrary JB-algebra; no Cstar +realization-specific adapter is involved. + +## ii. Key definitions and results + +- `NormedJordanAlgebra.isBoundedBilinearMap_mul` +- `NormedJordanAlgebra.mulLeftCLM`, `NormedJordanAlgebra.quadRepCLM` +- `NormedJordanAlgebra.isDerivation_of_isAutomorphismFamily` + +## iii. Table of contents + +- A. The Jordan product is bounded bilinear +- B. Continuous multiplication and quadratic operators +- C. The derivation corollary + +-/ + +@[expose] public section + +namespace NormedJordanAlgebra + +variable {E : Type*} [NormedJordanAlgebra E] + +/-! ## A. The Jordan product is bounded bilinear -/ + +/-- The Jordan product of a normed Jordan algebra is bounded bilinear, with bound constant `1`. -/ +theorem isBoundedBilinearMap_mul : + IsBoundedBilinearMap ℝ (fun p : E × E => p.1 * p.2) where + add_left := add_mul + smul_left c x y := smul_mul_assoc c x y + add_right := mul_add + smul_right c x y := mul_smul_comm c x y + bound := ⟨1, one_pos, fun x y => by simpa using NormedJordanAlgebra.norm_mul_le x y⟩ + +/-- Left Jordan multiplication by a fixed element is continuous. -/ +theorem continuous_mul_left (a : E) : Continuous fun x : E => a * x := + isBoundedBilinearMap_mul.continuous.comp (continuous_const.prodMk continuous_id) + +/-- Right Jordan multiplication by a fixed element is continuous. -/ +theorem continuous_mul_right (a : E) : Continuous fun x : E => x * a := + isBoundedBilinearMap_mul.continuous.comp (continuous_id.prodMk continuous_const) + +/-! ## B. Continuous multiplication and quadratic operators -/ + +open JordanAlgebra +open scoped JordanAlgebra + +/-- Left Jordan multiplication as a bounded linear operator, with operator bound `‖a‖`. -/ +noncomputable def mulLeftCLM (a : E) : E →L[ℝ] E := + LinearMap.mkContinuous (L a) ‖a‖ fun b => NormedJordanAlgebra.norm_mul_le a b + +@[simp] +theorem mulLeftCLM_apply (a b : E) : mulLeftCLM a b = a * b := rfl + +/-- A uniform norm bound for the quadratic representation: +`‖U_a b‖ ≤ 3 ‖a‖² ‖b‖`. The sharp constant is not needed for continuity. -/ +theorem norm_quadRep_le (a b : E) : ‖U a b‖ ≤ 3 * ‖a‖ ^ 2 * ‖b‖ := by + rw [quadRep_apply, jpow_two] + have hleft : ‖(2 : ℝ) • (a * (a * b))‖ ≤ 2 * (‖a‖ * (‖a‖ * ‖b‖)) := by + rw [norm_smul, Real.norm_of_nonneg (by norm_num)] + exact mul_le_mul_of_nonneg_left + (le_trans (NormedJordanAlgebra.norm_mul_le a (a * b)) + (mul_le_mul_of_nonneg_left (NormedJordanAlgebra.norm_mul_le a b) (norm_nonneg a))) + (by norm_num) + have hright : ‖(a * a) * b‖ ≤ (‖a‖ * ‖a‖) * ‖b‖ := by + exact le_trans (NormedJordanAlgebra.norm_mul_le (a * a) b) + (mul_le_mul_of_nonneg_right (NormedJordanAlgebra.norm_mul_le a a) (norm_nonneg b)) + calc + ‖(2 : ℝ) • (a * (a * b)) - (a * a) * b‖ + ≤ ‖(2 : ℝ) • (a * (a * b))‖ + ‖(a * a) * b‖ := norm_sub_le _ _ + _ ≤ 2 * (‖a‖ * (‖a‖ * ‖b‖)) + (‖a‖ * ‖a‖) * ‖b‖ := by + exact add_le_add hleft hright + _ = 3 * ‖a‖ ^ 2 * ‖b‖ := by ring + +/-- The quadratic representation as a bounded linear operator. -/ +noncomputable def quadRepCLM (a : E) : E →L[ℝ] E := + LinearMap.mkContinuous (U a) (3 * ‖a‖ ^ 2) (norm_quadRep_le a) + +@[simp] +theorem quadRepCLM_apply (a b : E) : quadRepCLM a b = U a b := rfl + +/-! ## C. The derivation corollary -/ + +/-- The generator of a differentiable one-parameter family of Jordan automorphisms of an +arbitrary normed Jordan algebra is a Jordan derivation. This is +`IsGenerator.isDerivation_of_isAutomorphismFamily` applied with `isBoundedBilinearMap_mul` +supplying its one analytic hypothesis. -/ +theorem isDerivation_of_isAutomorphismFamily {α : ℝ → E → E} + (hα0 : ∀ a, α 0 a = a) (hmul : ∀ t a b, α t (a * b) = α t a * α t b) + {D : E →ₗ[ℝ] E} (hD : IsGenerator α D) : IsDerivation D := + IsGenerator.isDerivation_of_isAutomorphismFamily isBoundedBilinearMap_mul hα0 hmul hD + +end NormedJordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GENERATED_SUBALGEBRA_ROADMAP.md b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GENERATED_SUBALGEBRA_ROADMAP.md new file mode 100644 index 0000000000..d923f73fcf --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GENERATED_SUBALGEBRA_ROADMAP.md @@ -0,0 +1,39 @@ +# Single-generator JB analysis + +The authoritative architecture and global milestones are in +[`../JB_ROADMAP.md`](../JB_ROADMAP.md). This note records only the local state of the +single-generator analytic construction. + +## Implemented + +```text +Jordan powers + -> power-associativity + -> algebraic generatedByOne a + -> CommRing / Algebra ℝ structure + -> closedGeneratedByOne a + -> NormedRing / NormedAlgebra ℝ / CompleteSpace + -> jordanSpectrum a + -> compactness of jordanSpectrum a + -> uniform square norm and exact powers-of-two norm growth +``` + +The closure and all analytic structure are abstract in a coherent `NormedJordanAlgebra`; ambient +completeness is requested only for the complete-space instance. The spectrum is canonically the +ordinary real-algebra spectrum of the bundled generator inside its closed generated algebra. + +## Remaining + +1. Establish the JB-specific spectral facts not true for an arbitrary real Banach algebra, + beginning with nonemptiness and the correct spectral-radius/norm relation. The square norm and + powers-of-two norm identities are now available in `Uniform.lean`. +2. Implement one of the two sound routes isolated in `CFC_AUDIT.md`: a real uniform-algebra + representation theorem, or a named complexification proved to be a commutative Cstar algebra. +3. Construct a bundled unital isometric homomorphism + `C(jordanSpectrum a, ℝ) -> ClosedGeneratedByOne a`. +4. Prove that it sends the coordinate function to the generator and is onto. +5. Derive continuous functions of `a`, then `abs`, positive/negative parts, and positive square + roots. + +There is deliberately no placeholder CFC declaration. In particular, no arbitrary set may be +passed in as “the spectrum,” and no theorem in this layer may be supplied by a new axiom. diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/CFC_AUDIT.md b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/CFC_AUDIT.md new file mode 100644 index 0000000000..d965376c05 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/CFC_AUDIT.md @@ -0,0 +1,453 @@ +Audit: abstract one-generator continuous functional calculus + +This is a code audit of the Mathlib version pinned by this repository, performed +on 2026-09-11. It concerns an abstract real JB-algebra E and +NormedJordanAlgebra.ClosedGeneratedByOne a, not a chosen Cstar realization. + +Present local infrastructure + +Closed.lean already performs the essential algebraic reduction needed for a +one-generator Jordan continuous functional calculus: + +variable {E : Type*} [NormedJordanAlgebra E] (a : E) +NormedJordanAlgebra.ClosedGeneratedByOne a : Type _ +-- instances: CommRing, Algebra ℝ, NormedRing, NormedAlgebra ℝ +-- under [CompleteSpace E]: +instance : CompleteSpace (NormedJordanAlgebra.ClosedGeneratedByOne a) + +Although the ambient Jordan algebra is nonassociative, the closed algebra +generated by a single element is an ordinary commutative associative real +Banach algebra. This is the correct place to construct the CFC. + +The canonical spectrum is already defined intrinsically: + +NormedJordanAlgebra.jordanSpectrum a : Set ℝ := + spectrum ℝ (NormedJordanAlgebra.closedGenerator a) +NormedJordanAlgebra.isCompact_jordanSpectrum + [CompleteSpace E] (a : E) : + IsCompact (NormedJordanAlgebra.jordanSpectrum a) + +Thus neither an arbitrary compact set nor an ambient Cstar representation is +needed to state the result. + +The desired theorem is intrinsically + +C(jordanSpectrum a, ℝ) ≃ ClosedGeneratedByOne a + +as an isometric real algebra isomorphism sending the coordinate function to +closedGenerator a. + +What Mathlib already provides + +Mathlib.Analysis.Normed.Algebra.Spectrum contains substantial spectrum +infrastructure for complete normed algebras, not only Cstar algebras. In +particular it provides the ordinary spectrum and resolvent, compactness and +closedness results, the estimate + +spectrum ℝ x ⊆ closedBall 0 ‖x‖ + +and the abstract spectralRadius, with + +spectralRadius ≤ ‖x‖. + +The important limitation is that the stronger Gelfand formula is separated +into Mathlib.Analysis.Normed.Algebra.GelfandFormula and is currently a theorem +for complex Banach algebras. Mathlib itself documents this distinction: +Spectrum.lean contains the generic Banach-algebra theory, whereas theorems +specific to complex Banach algebras, including Gelfand’s formula, live in +GelfandFormula.lean. (Lean Community) + +Mathlib also has infrastructure for relating scalar-field spectra through + +SpectrumRestricts +QuasispectrumRestricts + +including the important ℂ → ℝ case. This is useful when a complex spectrum +is already known to be real, but it does not by itself prove that an abstract +real JB element has the required real spectral properties. (Lean Community) + +The approximation side of the desired construction is already particularly +strong. Mathlib.Topology.ContinuousMap.StoneWeierstrass proves directly that, +for compact s : Set ℝ, + +theorem polynomialFunctions.topologicalClosure (s : Set ℝ) [CompactSpace ↑s] : + (polynomialFunctions s).topologicalClosure = ⊤ + +so real polynomial functions are dense in C(s, ℝ). It also contains +continuous-algebra-hom extensionality from the coordinate function. (Lean Community) + +Mathlib.Topology.ContinuousMap.Polynomial already supplies the canonical +continuous polynomial functions on a compact subset of ℝ, including +Polynomial.toContinuousMapOnAlgHom. (Lean Community) + +Therefore the approximation/completion half of the Jordan CFC does not need to +be developed from scratch. + +Why generic CFC and Cstar Gelfand duality are not the right construction + +Mathlib’s generic CFC interface in +Mathlib.Analysis.CStarAlgebra.ContinuousFunctionalCalculus.Unital is a +specification mechanism: + +class ContinuousFunctionalCalculus + (R A : Type*) (p : outParam (A → Prop)) : Prop where + exists_cfc_of_predicate : + ∀ a, p a → + ∃ φ : C(spectrum R a, R) →⋆ₐ[R] A, + Continuous φ ∧ Function.Injective φ ∧ + φ ((ContinuousMap.id R).restrict (spectrum R a)) = a ∧ + (∀ f, spectrum R (φ f) = Set.range f) ∧ + ∀ f, p (φ f) +class IsometricContinuousFunctionalCalculus ... + extends ContinuousFunctionalCalculus R A p where + isometric (a : A) (ha : p a) : Isometry (cfcHom ha) + +This interface assumes the CFC exists and provides a selected cfcHom; it is +not a theorem deriving a CFC from + +CommRing + CompleteSpace + NormedAlgebra. + +It also uses star-algebra language which is not the natural primitive structure +of an abstract real JB algebra. + +Likewise, Mathlib’s gelfandStarTransform is a theorem for commutative complex +Cstar algebras. The Cstar spectral theory additionally has spectral permanence +and the equality of norm and spectral radius for self-adjoint elements, but +those results depend on Cstar structure. (Lean Community) + +Using this machinery directly would therefore introduce a substantially +stronger representation hypothesis than is needed. + +In particular, a general abstract JB algebra must not be forced through a +chosen operator/Cstar realization merely to define its one-element functional +calculus. + +Resolved spectral input + +The formerly missing ingredient was smaller and more precise than a general real Gelfand +duality theorem. It is now proved intrinsically. + +For + +Aₐ := NormedJordanAlgebra.ClosedGeneratedByOne a + +the delivered real JB spectral-radius theorem is: + +theorem NormedJordanAlgebra.jordanSpectrum_nonempty (a : E) : + (jordanSpectrum a).Nonempty + +and, more importantly, + +theorem JBAlgebra.ClosedGeneratedByOne.jordanSpectralRadius_eq_norm (x : Aₐ) : + spectralRadius ℝ x = ‖x‖₊ + +where the right-hand side expresses + +max {|λ| : λ ∈ spectrum ℝ x}. + +Equivalently, after choosing the convenient Mathlib representation of +spectralRadius, the theorem should state that the real spectral radius of +x equals ‖x‖. + +Mathematically: + +‖x‖ = max_{λ ∈ σℝ(x)} |λ|. + +This is the genuine JB-specific spectral input. + +One must not try to derive this merely from the algebraic facts + +Aₐ is commutative, +Aₐ is complete, +‖x²‖ = ‖x‖². + +Those conditions alone do not force the spectrum over ℝ to be nonempty. For +example, ℂ regarded as a real Banach algebra satisfies + +‖z²‖ = ‖z‖² + +but the real spectrum of i is empty. + +The order/formal-reality content of the JB axioms is therefore essential. The +proved result is specifically a JB real spectral theorem, not a theorem about +arbitrary real uniform Banach algebras. + +Shortest construction of the CFC + +Once the JB spectral theorem is available, the remaining construction is +comparatively direct. + +Let + +Aₐ = ClosedGeneratedByOne a +σ = jordanSpectrum a. + +1. Polynomial evaluation + +There is the canonical real algebra homomorphism + +Polynomial ℝ →ₐ[ℝ] Aₐ +p ↦ p(a). + +There is also the existing Mathlib map + +Polynomial ℝ →ₐ[ℝ] C(σ, ℝ) +p ↦ p|σ. + +The crucial lemma is + +theorem norm_aeval_closedGenerator + (p : Polynomial ℝ) : + ‖Polynomial.aeval (closedGenerator a) p‖ = + ‖p.toContinuousMapOn (jordanSpectrum a)‖ + +i.e. + +‖p(a)‖ = sup_{λ ∈ σ(a)} |p(λ)|. + +This is obtained from: + +JB norm = real spectral radius ++ +polynomial spectral mapping. + +Indeed, + +‖p(a)‖ + = rℝ(p(a)) + = max {|μ| : μ ∈ σℝ(p(a))} + = max {|p(λ)| : λ ∈ σℝ(a)} + = ‖p|σ(a)‖∞. + +Exact real polynomial spectral mapping is now proved locally as +`NormedJordanAlgebra.jordanSpectrum_aeval`. Its corresponding total spectral-supremum +norm forms are `nnnorm_aeval_closedGenerator` and `norm_aeval_closedGenerator`. The +remaining step is to identify that supremum with Mathlib's norm of +`p.toContinuousMapOn σ`, then extend the isometric polynomial map by density. + +2. Extend by density + +Mathlib already proves that polynomial functions are dense: + +polynomialFunctions.topologicalClosure (jordanSpectrum a) = ⊤ + +because jordanSpectrum a is compact. (Lean Community) + +The polynomial evaluation map is an isometry by the previous step, so it +extends uniquely from polynomial functions to + +C(jordanSpectrum a, ℝ). + +This gives + +noncomputable def jordanCfcHom + (a : E) : + C(jordanSpectrum a, ℝ) →ₐ[ℝ] ClosedGeneratedByOne a + +with + +theorem jordanCfcHom_isometry (a : E) : + Isometry (jordanCfcHom a) + +and + +theorem jordanCfcHom_id (a : E) : + jordanCfcHom a + ((ContinuousMap.id ℝ).restrict (jordanSpectrum a)) = + closedGenerator a + +3. Prove surjectivity from generatedness + +An isometry has closed range. + +The range of jordanCfcHom a contains the coordinate function and therefore +contains every polynomial in closedGenerator a. + +But ClosedGeneratedByOne a is, by definition, the closure of precisely this +polynomial algebra. + +Hence the closed range of jordanCfcHom a is all of +ClosedGeneratedByOne a: + +theorem jordanCfcHom_range_eq_top (a : E) : + (jordanCfcHom a).range = ⊤ + +Thus the final result is an isometric algebra equivalence + +C(jordanSpectrum a, ℝ) + ≃ₐ[ℝ] +ClosedGeneratedByOne a. + +No character space is needed. + +Target API + +The first public API should remain Jordan-native: + +namespace NormedJordanAlgebra +noncomputable def jordanCfcHom + {E : Type*} [NormedJordanAlgebra E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [JBAlgebra E] + (a : E) : + C(jordanSpectrum a, ℝ) →ₐ[ℝ] ClosedGeneratedByOne a +theorem jordanCfcHom_isometry + {E : Type*} [NormedJordanAlgebra E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [JBAlgebra E] + (a : E) : + Isometry (jordanCfcHom a) +theorem jordanCfcHom_id + {E : Type*} [NormedJordanAlgebra E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [JBAlgebra E] + (a : E) : + jordanCfcHom a + ((ContinuousMap.id ℝ).restrict (jordanSpectrum a)) = + closedGenerator a +theorem jordanCfcHom_range_eq_top + {E : Type*} [NormedJordanAlgebra E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [JBAlgebra E] + (a : E) : + (jordanCfcHom a).range = ⊤ +end NormedJordanAlgebra + +Keeping the codomain bundled is important: this states exactly that continuous +functions of a are the closed algebra generated by a. + +The ambient-valued operation can then be a thin wrapper: + +noncomputable def jordanCfc + (f : C(jordanSpectrum a, ℝ)) : E := + (jordanCfcHom a f : ClosedGeneratedByOne a) + +Immediate consequences include + +jordanCfc_id +jordanCfc_add +jordanCfc_mul +jordanCfc_const + +and + +theorem norm_jordanCfc + (f : C(jordanSpectrum a, ℝ)) : + ‖jordanCfc a f‖ = ‖f‖ + +from jordanCfcHom_isometry. + +Recommended dependency chain + +The implementation should therefore be organized around the following chain: + +JB axioms + ↓ +one-generator associative closed real Banach algebra + ↓ +real spectrum of JB elements is nonempty + ↓ +‖x‖ = real spectral radius of x + ↓ +real polynomial spectral mapping + ↓ +‖p(a)‖ = ‖p|σ(a)‖∞ + ↓ +polynomial evaluation is isometric + ↓ +Mathlib Stone-Weierstrass + ↓ +C(σ(a), ℝ) →ₐ[ℝ] ClosedGeneratedByOne a + ↓ +closed range + generatedness + ↓ +surjectivity +v +The genuinely new mathematics is concentrated near the top: + +JB real spectrality +#### B1. Repair the ordered-JB boundary, then expose the norm/order theorem + +**Foundational correction.** The present `JBAlgebra` fields do *not* imply norm/order +compatibility: they only say that Jordan squares are positive, and leave open the possibility of a +strictly larger proper cone. Enlarging the cone preserves square positivity and the two analytic +JB norm axioms, while changing `orderUnitNorm`. Therefore the following statement cannot soundly +be proved from the current class fields: +#### B1. Repair the ordered-JB boundary, then expose the norm/order theorem + +**Foundational correction.** The present `JBAlgebra` fields do *not* imply norm/order +compatibility: they only say that Jordan squares are positive, and leave open the possibility of a +strictly larger proper cone. Enlarging the cone preserves square positivity and the two analytic +JB norm axioms, while changing `orderUnitNorm`. Therefore the following statement cannot soundly +be proved from the current class fields: ++ +JB norm = real spectral radius. + +The lower half is largely existing Mathlib infrastructure. + +Suggested file structure + +Do not introduce a file named RealGelfand.lean: that suggests a much more +general theorem than is actually required. + +A cleaner decomposition is + +JB/GeneratedByOne/Spectrum.lean +JB/GeneratedByOne/ContinuousFunctionalCalculus.lean + +Spectrum.lean should establish the JB-specific results, approximately: + +jordanSpectrum_nonempty +jordanSpectralRadius_eq_norm +jordanSpectrum_aeval +norm_aeval_closedGenerator + +The CFC file should then contain mostly completion and packaging: + +jordanCfcHom +jordanCfcHom_isometry +jordanCfcHom_id +jordanCfcHom_range_eq_top +jordanCfc +norm_jordanCfc + +If the polynomial spectral-mapping result turns out to be naturally generic +for suitable real Banach algebras, it can be contributed separately to +Mathlib rather than made JB-specific. + +Recommendation + +Keep the existing intrinsic jordanSpectrum and +ClosedGeneratedByOne construction. + +Do not: + +* add a placeholder jordanCfcHom; +* postulate a ContinuousFunctionalCalculus instance; +* add a fake StarRing; +* choose a Cstar/operator representation; +* formalize full real Gelfand duality merely for this purpose. + +Status: B5 is complete in `ContinuousFunctionalCalculus.lean`. Polynomial evaluation is +descended to `polynomialFunctions σ`, extended by Stone--Weierstrass density to the bundled +isometric real algebra homomorphism `jordanCfcHom`, and its range is proved closed and equal to +the closed generated algebra by the algebraic Jordan-power span argument. The public +ambient-valued wrapper is `jordanCfc`, with its coordinate, additive, multiplicative, constant, +and norm laws. `jordanCfcEquiv` additionally packages the proved injectivity and surjectivity +as the canonical real algebra equivalence onto `ClosedGeneratedByOne a`. + +Status: the resulting intrinsic calculus now also supplies the canonical positive square root, +absolute value, and positive/negative parts. Spectrum positivity for a nonnegative observable +is proved through strict-positive invertibility in its closed generated algebra; no Cstar +realization is used. The CFC proves the square-root and absolute-value square identities, +nonnegativity, positive/negative decomposition, and Jordan orthogonality of the two parts. +Uniqueness of an arbitrary positive square root remains a separate multielement JB theorem. + +The order API is now general rather than restricted to the named functions: +`jordanCfc_nonneg` sends each pointwise nonnegative continuous function to a positive JB element, +and `jordanCfc_monotone` sends pointwise inequalities to ambient order inequalities. Both are +proved by an intrinsic continuous square-root factorization followed by exact-cone reconstruction. +Conversely, `jordanCfc_nonneg_iff` and `jordanCfc_le_iff` reflect the ambient JB order to the +pointwise order. Their proof uses the local exact-cone theorem inside `ClosedGeneratedByOne a` +and the proved CFC algebra equivalence, so no representation is introduced. + +Consequently, `jordanSqrt_eq_of_mem_closedGeneratedByOne` gives positive-square-root uniqueness +for roots which lie in the input observable's closed generated algebra. This is intentionally +not advertised as unrestricted JB root uniqueness: moving an arbitrary positive root into that +one-observable algebra is precisely the remaining multielement quadratic-Jordan problem. diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/Closed.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/Closed.lean new file mode 100644 index 0000000000..00228c04fc --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/Closed.lean @@ -0,0 +1,226 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Power.Ring +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.Dynamics + +/-! + +# The closed subalgebra generated by a single element: `C_J(a)` + +## i. Overview + +Step 2 of `JB/GENERATED_SUBALGEBRA_ROADMAP.md`: `C_J(a) := \overline{J[a]}`, the norm-closure of +the subalgebra generated by `1` and `a` (`Power/GeneratedByOne.lean`). Continuity of the Jordan +product (`JB/Dynamics.lean`'s `isBoundedBilinearMap_mul`, itself just `norm_mul_le'` repackaged) +is exactly what lets the closure of a subalgebra remain a subalgebra: this is the standard +topological +argument "a continuous binary operation closed on a set is closed on the set's closure", via +`image_closure_subset_closure_image` and `closure_prod_eq`, not anything Jordan-specific. + +Because `NormedJordanAlgebra` bundles coherent algebraic and normed data and `JBAlgebra` includes +completeness, this construction is abstract in an arbitrary JB-algebra. `C_J(a)` is a closed subset +of a complete space and is therefore complete. + +## ii. Key definitions and results + +- `NormedJordanAlgebra.closedGeneratedByOne` +- `NormedJordanAlgebra.mul_mem_closedGeneratedByOne` +- `NormedJordanAlgebra.isClosed_closedGeneratedByOne` +- `NormedJordanAlgebra.isComplete_closedGeneratedByOne` +- `NormedJordanAlgebra.assoc_of_mem_closedGeneratedByOne` +- `NormedJordanAlgebra.ClosedGeneratedByOne` + +## iii. Table of contents + +- A. The closure +- B. Closure under the Jordan product +- C. Completeness +- D. The bundled commutative normed algebra + +-/ + +@[expose] public section + +namespace NormedJordanAlgebra + +variable {E : Type*} [NormedJordanAlgebra E] + +open scoped JordanAlgebra + +/-! ## A. The closure -/ + +/-- `C_J(a) := \overline{J[a]}`, the norm-closure of the subalgebra generated by `1` and `a`. -/ +noncomputable def closedGeneratedByOne (a : E) : Submodule ℝ E := + (JordanAlgebra.generatedByOne a).topologicalClosure + +theorem generatedByOne_le_closedGeneratedByOne (a : E) : + JordanAlgebra.generatedByOne a ≤ closedGeneratedByOne a := + Submodule.le_topologicalClosure _ + +theorem one_mem_closedGeneratedByOne (a : E) : + (1 : E) ∈ closedGeneratedByOne a := + generatedByOne_le_closedGeneratedByOne a (JordanAlgebra.one_mem_generatedByOne a) + +theorem self_mem_closedGeneratedByOne (a : E) : a ∈ closedGeneratedByOne a := + generatedByOne_le_closedGeneratedByOne a (JordanAlgebra.self_mem_generatedByOne a) + +/-! ## B. Closure under the Jordan product -/ + +/-- **The topological half of the reduction.** `C_J(a)` is closed under the Jordan product: a +continuous binary operation (`isBoundedBilinearMap_mul.continuous`) that is closed on `J[a]` +(`IsJordanOrderUnit.mul_mem_generatedByOne`) remains closed on `J[a]`'s closure. -/ +theorem mul_mem_closedGeneratedByOne {a x y : E} + (hx : x ∈ closedGeneratedByOne a) (hy : y ∈ closedGeneratedByOne a) : + x * y ∈ closedGeneratedByOne a := by + let S : Set E := JordanAlgebra.generatedByOne a + have hclosed : IsClosed (closure S) := isClosed_closure + have hleft : ∀ u ∈ S, u * y ∈ closure S := by + intro u hu + apply (closure_minimal ?_ (hclosed.preimage (NormedJordanAlgebra.continuous_mul_left u))) hy + intro v hv + exact subset_closure (JordanAlgebra.mul_mem_generatedByOne a hu hv) + have hfinal : x * y ∈ closure S := by + apply (closure_minimal hleft (hclosed.preimage (NormedJordanAlgebra.continuous_mul_right y))) hx + show x * y ∈ (closedGeneratedByOne a : Set E) + rw [closedGeneratedByOne, Submodule.topologicalClosure_coe] + exact hfinal + +/-- Associativity extends from `J[a]` to its closure. The proof extends the polynomial identity +successively in the third, second, and first variables, using continuity of multiplication. -/ +theorem assoc_of_mem_closedGeneratedByOne (a : E) {x y z : E} + (hx : x ∈ closedGeneratedByOne a) (hy : y ∈ closedGeneratedByOne a) + (hz : z ∈ closedGeneratedByOne a) : (x * y) * z = x * (y * z) := by + let S : Set E := JordanAlgebra.generatedByOne a + have hx' : x ∈ closure S := by + change x ∈ closure (JordanAlgebra.generatedByOne a : Set E) at hx + simpa only [S] using hx + have hy' : y ∈ closure S := by + change y ∈ closure (JordanAlgebra.generatedByOne a : Set E) at hy + simpa only [S] using hy + have hz' : z ∈ closure S := by + change z ∈ closure (JordanAlgebra.generatedByOne a : Set E) at hz + simpa only [S] using hz + have hbase {u v w : E} (hu : u ∈ S) (hv : v ∈ S) (hw : w ∈ S) : + (u * v) * w = u * (v * w) := by + let u' : JordanAlgebra.GeneratedByOne a := ⟨u, hu⟩ + let v' : JordanAlgebra.GeneratedByOne a := ⟨v, hv⟩ + let w' : JordanAlgebra.GeneratedByOne a := ⟨w, hw⟩ + exact congrArg Subtype.val (JordanAlgebra.GeneratedByOne.mul_assoc a u' v' w') + have hclose_z {u v : E} (hu : u ∈ S) (hv : v ∈ S) : + ∀ z ∈ closure S, (u * v) * z = u * (v * z) := by + exact Set.EqOn.closure (fun _ hw => hbase hu hv hw) + (continuous_mul_left (u * v)) + ((continuous_mul_left u).comp (continuous_mul_left v)) + have hclose_y {u z : E} (hu : u ∈ S) (hz : z ∈ closure S) : + ∀ y ∈ closure S, (u * y) * z = u * (y * z) := by + exact Set.EqOn.closure (fun _ hv => hclose_z hu hv z hz) + ((continuous_mul_right z).comp (continuous_mul_left u)) + ((continuous_mul_left u).comp (continuous_mul_right z)) + exact Set.EqOn.closure (fun _ hu => hclose_y hu hz' y hy') + ((continuous_mul_right z).comp (continuous_mul_right y)) + (continuous_mul_right (y * z)) hx' + +/-! ## C. Completeness -/ + +/-- `C_J(a)` is closed, being a topological closure. -/ +theorem isClosed_closedGeneratedByOne (a : E) : + IsClosed (closedGeneratedByOne a : Set E) := + Submodule.isClosed_topologicalClosure _ + +variable [CompleteSpace E] in +/-- `C_J(a)` is complete whenever its ambient normed Jordan algebra is complete. -/ +theorem isComplete_closedGeneratedByOne (a : E) : + IsComplete (closedGeneratedByOne a : Set E) := + (isClosed_closedGeneratedByOne a).isComplete + +/-! ## D. The bundled commutative normed algebra -/ + +/-- The norm-closed Jordan subalgebra generated by `1` and `a`, regarded as its own type. Although +the ambient multiplication need not be associative, its restriction to this subtype is. -/ +abbrev ClosedGeneratedByOne (a : E) : Type _ := closedGeneratedByOne a + +namespace ClosedGeneratedByOne + +variable (a : E) + +noncomputable instance : Mul (ClosedGeneratedByOne a) where + mul x y := ⟨(x : E) * (y : E), mul_mem_closedGeneratedByOne x.2 y.2⟩ + +@[simp] +theorem val_mul (x y : ClosedGeneratedByOne a) : + ((x * y : ClosedGeneratedByOne a) : E) = (x : E) * (y : E) := rfl + +noncomputable instance : One (ClosedGeneratedByOne a) := ⟨⟨1, one_mem_closedGeneratedByOne a⟩⟩ + +@[simp] +theorem val_one : ((1 : ClosedGeneratedByOne a) : E) = 1 := rfl + +/-- The closed one-generator algebra is a commutative associative ring. -/ +noncomputable instance instCommRing : CommRing (ClosedGeneratedByOne a) where + __ := (inferInstance : AddCommGroup (ClosedGeneratedByOne a)) + mul := (· * ·) + mul_assoc x y z := Subtype.ext (assoc_of_mem_closedGeneratedByOne a x.2 y.2 z.2) + one := 1 + one_mul x := Subtype.ext (_root_.one_mul (x : E)) + mul_one x := Subtype.ext (_root_.mul_one (x : E)) + left_distrib x y z := Subtype.ext (mul_add (x : E) (y : E) (z : E)) + right_distrib x y z := Subtype.ext (add_mul (x : E) (y : E) (z : E)) + mul_comm x y := Subtype.ext (_root_.mul_comm (x : E) (y : E)) + zero_mul x := Subtype.ext (by simp) + mul_zero x := Subtype.ext (by simp) + +/-- The closed one-generator algebra is an algebra over the real scalars inherited from `E`. -/ +noncomputable instance instAlgebra : Algebra ℝ (ClosedGeneratedByOne a) where + algebraMap := + { toFun := fun c => ⟨c • (1 : E), (closedGeneratedByOne a).smul_mem c + (one_mem_closedGeneratedByOne a)⟩ + map_one' := Subtype.ext (one_smul ℝ 1) + map_mul' := fun c d => Subtype.ext (by + show (c * d) • (1 : E) = (c • (1 : E)) * (d • (1 : E)) + rw [mul_smul_comm, smul_mul_assoc, _root_.one_mul, smul_smul, _root_.mul_comm c d]) + map_zero' := Subtype.ext (by simp) + map_add' := fun c d => Subtype.ext (by simp [add_smul]) } + commutes' c x := Subtype.ext (_root_.mul_comm (c • (1 : E)) (x : E)) + smul c x := ⟨c • (x : E), (closedGeneratedByOne a).smul_mem c x.2⟩ + smul_def' c x := Subtype.ext (by + show c • (x : E) = (c • (1 : E)) * (x : E) + rw [smul_mul_assoc, _root_.one_mul]) + +/-- The inherited norm is submultiplicative on the closed generated algebra. -/ +noncomputable instance instNormedRing : NormedRing (ClosedGeneratedByOne a) where + __ : NormedAddCommGroup (ClosedGeneratedByOne a) := inferInstance + __ : Ring (ClosedGeneratedByOne a) := inferInstance + norm_mul_le x y := NormedJordanAlgebra.norm_mul_le (x : E) (y : E) + +/-- The real algebra structure is compatible with the inherited norm. -/ +noncomputable instance instNormedAlgebra : NormedAlgebra ℝ (ClosedGeneratedByOne a) where + __ := instAlgebra a + norm_smul_le r x := by simpa using norm_smul_le r (x : E) + +/-- If `E` is complete, its closed generated subalgebra is complete. -/ +noncomputable instance instCompleteSpace [CompleteSpace E] : + CompleteSpace (ClosedGeneratedByOne a) := + (isClosed_closedGeneratedByOne a).completeSpace_coe + +/-- Ordinary ring powers inside any closed one-generator algebra coerce to the ambient Jordan +power of the underlying element. This holds for `x` in the closed algebra generated by *any* +element `a`, not only for the canonical generator itself: both sides are computed by the same +recursive multiplication, so the identity does not depend on which enveloping closed algebra `x` +happens to be regarded as living in. This ambient-independence is exactly what lets a single +polynomial identity be transported between two different closed one-generator algebras sharing a +common element, which is the mechanism used for square-root uniqueness. -/ +theorem pow_val (x : ClosedGeneratedByOne a) (n : ℕ) : + ((x ^ n : ClosedGeneratedByOne a) : E) = (x : E) ^[n] := by + induction n with + | zero => simp [JordanAlgebra.jpow_zero] + | succ n ih => + rw [pow_succ, val_mul, ih, JordanAlgebra.jpow_succ, _root_.mul_comm] + +end ClosedGeneratedByOne + +end NormedJordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/ContinuousFunctionalCalculus.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/ContinuousFunctionalCalculus.lean new file mode 100644 index 0000000000..ed4d401009 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/ContinuousFunctionalCalculus.lean @@ -0,0 +1,877 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.GeneratedByOne.Spectrum +public import Mathlib.Topology.ContinuousMap.StoneWeierstrass +public import Mathlib.Topology.ContinuousMap.Compact +public import Mathlib.Analysis.Normed.Operator.Extend + +/-! +# Intrinsic continuous functional calculus for one JB observable + +This file starts from the genuinely Jordan-theoretic spectral theorem in +`GeneratedByOne.Spectrum`. In particular, its norm comparison is not imported from a Cstar +realization: polynomial evaluation in the commutative associative algebra generated by `a` is +isometric for the sup norm on the intrinsic real spectrum. + +The remaining construction extends this isometry from polynomial functions to all continuous +functions by Stone--Weierstrass and completeness. +-/ + +@[expose] public section + +namespace NormedJordanAlgebra + +variable {E : Type*} [NormedJordanAlgebra E] [JBAlgebra E] + +open scoped JordanAlgebra + +/-- The intrinsic spectrum of a complete Jordan observable is a compact type. Bundling this +standard consequence of spectral compactness lets the continuous-function algebra carry its +ordinary sup norm without any auxiliary choice of a compact set. -/ +noncomputable instance jordanSpectrum.compactSpace (a : E) : CompactSpace (jordanSpectrum a) := + isCompact_iff_compactSpace.mp (isCompact_jordanSpectrum a) + +/-- Polynomial evaluation at the closed generator has exactly the sup norm of the corresponding +polynomial function on the intrinsic Jordan spectrum. This is the isometric polynomial core of +the intrinsic continuous functional calculus. -/ +theorem enorm_aeval_closedGenerator_eq_enorm_toContinuousMapOn [Nontrivial E] + [PartialOrder E] [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] + [IsJBOrderUnit E] (a : E) (p : Polynomial ℝ) : + ‖Polynomial.aeval (closedGenerator a) p‖ₑ = + ‖p.toContinuousMapOn (jordanSpectrum a)‖ₑ := by + rw [enorm_eq_nnnorm, norm_aeval_closedGenerator a p, + ContinuousMap.enorm_eq_iSup_enorm, iSup_subtype] + rfl + +/-- The polynomial functions on the intrinsic spectrum are dense in its real continuous-function +algebra. This is the approximation input for the JB continuous functional calculus. -/ +theorem jordanSpectrum_polynomialFunctions_dense (a : E) : + Dense (polynomialFunctions (jordanSpectrum a) : Set C(jordanSpectrum a, ℝ)) := by + rw [dense_iff_closure_eq] + have h := congrArg (fun A : Subalgebra ℝ C(jordanSpectrum a, ℝ) => + (A : Set C(jordanSpectrum a, ℝ))) + (polynomialFunctions.topologicalClosure (jordanSpectrum a)) + change closure ↑(polynomialFunctions (jordanSpectrum a)) = + ((⊤ : Subalgebra ℝ C(jordanSpectrum a, ℝ)) : Set C(jordanSpectrum a, ℝ)) + simpa only [Subalgebra.topologicalClosure_coe] using h + +/-! ## The descended polynomial map -/ + +omit [JBAlgebra E] in +/-- Every polynomial function on the intrinsic spectrum has a polynomial representative. -/ +theorem exists_polynomialRepresentative (a : E) + (f : polynomialFunctions (jordanSpectrum a)) : + ∃ p : Polynomial ℝ, + Polynomial.toContinuousMapOnAlgHom (jordanSpectrum a) p = f := by + have hf : (f : C(jordanSpectrum a, ℝ)) ∈ + (polynomialFunctions (jordanSpectrum a) : Set C(jordanSpectrum a, ℝ)) := f.property + rw [polynomialFunctions_coe] at hf + exact hf + +/-- A chosen polynomial representative. The choice is only an implementation device: +`aeval_closedGenerator_eq_of_toContinuousMapOn_eq` proves evaluation is independent of it. -/ +noncomputable def polynomialRepresentative (a : E) + (f : polynomialFunctions (jordanSpectrum a)) : Polynomial ℝ := + Classical.choose (exists_polynomialRepresentative a f) + +omit [JBAlgebra E] in +theorem toContinuousMapOn_polynomialRepresentative (a : E) + (f : polynomialFunctions (jordanSpectrum a)) : + Polynomial.toContinuousMapOnAlgHom (jordanSpectrum a) (polynomialRepresentative a f) = f := + Classical.choose_spec (exists_polynomialRepresentative a f) + +/-- Equality of polynomial functions on the intrinsic spectrum implies equality of their values +at the closed generator. This is exactly the quotient step needed to descend polynomial +evaluation to `polynomialFunctions (jordanSpectrum a)`. -/ +theorem aeval_closedGenerator_eq_of_toContinuousMapOn_eq [Nontrivial E] + [PartialOrder E] [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] + [IsJBOrderUnit E] (a : E) {p q : Polynomial ℝ} + (h : Polynomial.toContinuousMapOnAlgHom (jordanSpectrum a) p = + Polynomial.toContinuousMapOnAlgHom (jordanSpectrum a) q) : + Polynomial.aeval (closedGenerator a) p = Polynomial.aeval (closedGenerator a) q := by + rw [← sub_eq_zero] + apply enorm_eq_zero.mp + rw [← map_sub, enorm_aeval_closedGenerator_eq_enorm_toContinuousMapOn a] + have hzero : Polynomial.toContinuousMapOnAlgHom (jordanSpectrum a) (p - q) = 0 := by + rw [map_sub, h, sub_self] + change ‖Polynomial.toContinuousMapOnAlgHom (jordanSpectrum a) (p - q)‖ₑ = 0 + rw [hzero] + rw [enorm_eq_nnnorm] + simp + +/-- Polynomial evaluation descended to the subspace of polynomial functions on the intrinsic +spectrum. The preceding quotient theorem makes this independent of the chosen representative. -/ +noncomputable def polynomialCfcLinearMap [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : + polynomialFunctions (jordanSpectrum a) →ₗ[ℝ] ClosedGeneratedByOne a where + toFun f := Polynomial.aeval (closedGenerator a) (polynomialRepresentative a f) + map_add' f g := by + rw [← map_add] + apply aeval_closedGenerator_eq_of_toContinuousMapOn_eq a + rw [map_add, toContinuousMapOn_polynomialRepresentative, + toContinuousMapOn_polynomialRepresentative, + toContinuousMapOn_polynomialRepresentative] + rfl + map_smul' r f := by + rw [← map_smul] + apply aeval_closedGenerator_eq_of_toContinuousMapOn_eq a + rw [map_smul, toContinuousMapOn_polynomialRepresentative, + toContinuousMapOn_polynomialRepresentative] + rfl + +/-- The descended polynomial map preserves the exact sup norm. -/ +theorem enorm_polynomialCfcLinearMap [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) + (f : polynomialFunctions (jordanSpectrum a)) : + ‖polynomialCfcLinearMap a f‖ₑ = ‖f‖ₑ := by + change ‖Polynomial.aeval (closedGenerator a) (polynomialRepresentative a f)‖ₑ = ‖f‖ₑ + rw [enorm_aeval_closedGenerator_eq_enorm_toContinuousMapOn a] + change ‖Polynomial.toContinuousMapOnAlgHom (jordanSpectrum a) + (polynomialRepresentative a f)‖ₑ = ‖f‖ₑ + rw [toContinuousMapOn_polynomialRepresentative] + rfl + +/-- The polynomial calculus is a real linear isometry from polynomial functions with their +sup norm into the closed algebra generated by the observable. -/ +noncomputable def polynomialCfcLinearIsometry [Nontrivial E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (a : E) : polynomialFunctions (jordanSpectrum a) →ₗᵢ[ℝ] ClosedGeneratedByOne a where + toLinearMap := polynomialCfcLinearMap a + norm_map' f := by + have h : ‖polynomialCfcLinearMap a f‖ₑ = ‖f‖ₑ := + enorm_polynomialCfcLinearMap a f + exact congrArg (fun x : NNReal => (x : ℝ)) <| + ENNReal.coe_injective (by simpa only [enorm_eq_nnnorm] using h) + +/-- The descended polynomial calculus respects multiplication. -/ +theorem polynomialCfcLinearMap_mul [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) + (f g : polynomialFunctions (jordanSpectrum a)) : + polynomialCfcLinearMap a (f * g) = polynomialCfcLinearMap a f * polynomialCfcLinearMap a g := by + change Polynomial.aeval (closedGenerator a) (polynomialRepresentative a (f * g)) = + Polynomial.aeval (closedGenerator a) (polynomialRepresentative a f) * + Polynomial.aeval (closedGenerator a) (polynomialRepresentative a g) + rw [← Polynomial.aeval_mul] + apply aeval_closedGenerator_eq_of_toContinuousMapOn_eq a + rw [map_mul, toContinuousMapOn_polynomialRepresentative, + toContinuousMapOn_polynomialRepresentative, + toContinuousMapOn_polynomialRepresentative] + rfl + +/-! ## Completion from polynomial functions -/ + +/-- The canonical continuous linear extension of intrinsic polynomial evaluation. It is defined +solely by completion along the dense polynomial functions on `jordanSpectrum a`. -/ +noncomputable def jordanCfcLinear [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : + C(jordanSpectrum a, ℝ) →L[ℝ] ClosedGeneratedByOne a := + (polynomialCfcLinearIsometry a).toContinuousLinearMap.extend + (polynomialFunctions (jordanSpectrum a)).toSubmodule.subtypeL + +private theorem denseRange_polynomialFunctions_subtype (a : E) : + DenseRange ((polynomialFunctions (jordanSpectrum a)).toSubmodule.subtypeL : + polynomialFunctions (jordanSpectrum a) →L[ℝ] C(jordanSpectrum a, ℝ)) := by + rw [show ((polynomialFunctions (jordanSpectrum a)).toSubmodule.subtypeL : + polynomialFunctions (jordanSpectrum a) → C(jordanSpectrum a, ℝ)) = Subtype.val by rfl, + denseRange_subtype_val] + exact jordanSpectrum_polynomialFunctions_dense a + +/-- The continuous extension agrees with the descended polynomial calculus on every polynomial +function. -/ +theorem jordanCfcLinear_eq_polynomialCfcLinearMap [Nontrivial E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (a : E) (f : polynomialFunctions (jordanSpectrum a)) : + jordanCfcLinear a f = polynomialCfcLinearMap a f := by + exact ContinuousLinearMap.extend_eq _ (denseRange_polynomialFunctions_subtype a) + isUniformEmbedding_subtype_val.isUniformInducing f + +/-- The coordinate function, regarded as a polynomial function on the intrinsic spectrum. -/ +noncomputable def jordanSpectrumCoordinatePolynomialFunction (a : E) : + polynomialFunctions (jordanSpectrum a) := + ⟨Polynomial.toContinuousMapOnAlgHom (jordanSpectrum a) Polynomial.X, by + change Polynomial.toContinuousMapOnAlgHom (jordanSpectrum a) Polynomial.X ∈ + (⊤ : Subalgebra ℝ (Polynomial ℝ)).map + (Polynomial.toContinuousMapOnAlgHom (jordanSpectrum a)) + exact ⟨Polynomial.X, by simp, rfl⟩⟩ + +/-- The intrinsic continuous calculus sends the spectrum coordinate to the closed generator. -/ +theorem jordanCfcLinear_coordinate [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : + jordanCfcLinear a (jordanSpectrumCoordinatePolynomialFunction a) = closedGenerator a := by + rw [jordanCfcLinear_eq_polynomialCfcLinearMap] + change Polynomial.aeval (closedGenerator a) + (polynomialRepresentative a (jordanSpectrumCoordinatePolynomialFunction a)) = closedGenerator a + have h := aeval_closedGenerator_eq_of_toContinuousMapOn_eq a + (p := polynomialRepresentative a (jordanSpectrumCoordinatePolynomialFunction a)) + (q := Polynomial.X) (by + rw [toContinuousMapOn_polynomialRepresentative] + rfl) + simpa using h + +/-- The continuous extension remains an isometry on all real continuous functions. -/ +theorem norm_jordanCfcLinear [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) + (f : C(jordanSpectrum a, ℝ)) : ‖jordanCfcLinear a f‖ = ‖f‖ := by + refine (denseRange_polynomialFunctions_subtype a).induction ?_ ?_ f + · rintro _ ⟨g, rfl⟩ + change ‖jordanCfcLinear a g‖ = ‖g‖ + rw [jordanCfcLinear_eq_polynomialCfcLinearMap] + exact (polynomialCfcLinearIsometry a).norm_map g + · exact isClosed_eq ((jordanCfcLinear a).continuous.norm) continuous_norm + +/-- The continuous intrinsic JB calculus as a linear isometry. -/ +noncomputable def jordanCfcLinearIsometry [Nontrivial E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (a : E) : C(jordanSpectrum a, ℝ) →ₗᵢ[ℝ] ClosedGeneratedByOne a where + toLinearMap := jordanCfcLinear a + norm_map' := norm_jordanCfcLinear a + +/-- The continuous intrinsic calculus is multiplicative. Both variables are reduced to +polynomial functions by density; equality is then closed by continuity of multiplication. -/ +theorem jordanCfcLinear_mul [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) + (f g : C(jordanSpectrum a, ℝ)) : + jordanCfcLinear a (f * g) = jordanCfcLinear a f * jordanCfcLinear a g := by + refine (denseRange_polynomialFunctions_subtype a).induction ?_ ?_ f + · rintro _ ⟨p, rfl⟩ + refine (denseRange_polynomialFunctions_subtype a).induction ?_ ?_ g + · rintro _ ⟨q, rfl⟩ + let p' : polynomialFunctions (jordanSpectrum a) := ⟨p, p.property⟩ + let q' : polynomialFunctions (jordanSpectrum a) := ⟨q, q.property⟩ + change jordanCfcLinear a (↑(p' * q') : C(jordanSpectrum a, ℝ)) = + jordanCfcLinear a p' * jordanCfcLinear a q' + rw [jordanCfcLinear_eq_polynomialCfcLinearMap, + jordanCfcLinear_eq_polynomialCfcLinearMap, + jordanCfcLinear_eq_polynomialCfcLinearMap] + exact polynomialCfcLinearMap_mul a p' q' + · exact isClosed_eq + ((jordanCfcLinear a).continuous.comp (continuous_const.mul continuous_id)) + ((continuous_const.mul (jordanCfcLinear a).continuous)) + · exact isClosed_eq + ((jordanCfcLinear a).continuous.comp (continuous_id.mul continuous_const)) + ((jordanCfcLinear a).continuous.mul continuous_const) + +/-- The continuous intrinsic calculus preserves the constant one function. -/ +theorem jordanCfcLinear_one [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : + jordanCfcLinear a (1 : C(jordanSpectrum a, ℝ)) = 1 := by + let f : polynomialFunctions (jordanSpectrum a) := 1 + change jordanCfcLinear a f = 1 + rw [jordanCfcLinear_eq_polynomialCfcLinearMap] + change Polynomial.aeval (closedGenerator a) (polynomialRepresentative a f) = 1 + have h := aeval_closedGenerator_eq_of_toContinuousMapOn_eq a + (p := polynomialRepresentative a f) (q := 1) (by + rw [toContinuousMapOn_polynomialRepresentative] + change (1 : C(jordanSpectrum a, ℝ)) = + Polynomial.toContinuousMapOnAlgHom (jordanSpectrum a) 1 + ext x + simp) + simpa using h + +/-- The intrinsic continuous functional calculus as a unital real algebra homomorphism. -/ +noncomputable def jordanCfcHom [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : + C(jordanSpectrum a, ℝ) →ₐ[ℝ] ClosedGeneratedByOne a where + toFun := jordanCfcLinear a + map_zero' := (jordanCfcLinear a).map_zero + map_add' := (jordanCfcLinear a).map_add + map_one' := jordanCfcLinear_one a + map_mul' := jordanCfcLinear_mul a + commutes' r := by + rw [Algebra.algebraMap_eq_smul_one, Algebra.algebraMap_eq_smul_one, + map_smul, jordanCfcLinear_one] + +/-- The intrinsic CFC algebra homomorphism is an isometry. -/ +theorem jordanCfcHom_isometry [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : + Isometry (jordanCfcHom a) := + (jordanCfcLinearIsometry a).isometry + +/-- The intrinsic CFC sends the canonical coordinate on the spectrum to the observable. -/ +theorem jordanCfcHom_id [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : + jordanCfcHom a (ContinuousMap.restrict (jordanSpectrum a) (.id ℝ)) = closedGenerator a := by + change jordanCfcLinear a (ContinuousMap.restrict (jordanSpectrum a) (.id ℝ)) = closedGenerator a + rw [← Polynomial.toContinuousMapOn_X_eq_restrict_id] + exact jordanCfcLinear_coordinate a + +/-- Apply the intrinsic continuous functional calculus to a real continuous function on the +canonical Jordan spectrum. -/ +noncomputable def jordanCfc [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) + (f : C(jordanSpectrum a, ℝ)) : E := (jordanCfcHom a f : ClosedGeneratedByOne a) + +/-- The intrinsic JB functional calculus has exactly the sup norm. -/ +theorem norm_jordanCfc [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) + (f : C(jordanSpectrum a, ℝ)) : ‖jordanCfc a f‖ = ‖f‖ := + norm_jordanCfcLinear a f + +/-- The range of the intrinsic CFC is closed, because its source is complete and the calculus is +an isometry. -/ +theorem isClosed_range_jordanCfcHom [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : + IsClosed (Set.range (jordanCfcHom a)) := + (jordanCfcHom_isometry a).antilipschitz.isClosed_range + (jordanCfcHom_isometry a).uniformContinuous + +/-- The algebraic one-generator submodule included into its norm closure. -/ +noncomputable def generatedByOneInClosed (a : E) : + JordanAlgebra.generatedByOne a →ₗ[ℝ] ClosedGeneratedByOne a := + (JordanAlgebra.generatedByOne a).inclusion (generatedByOne_le_closedGeneratedByOne a) + +omit [JBAlgebra E] in +/-- The algebraic one-generator submodule is dense in its closed generated algebra. -/ +theorem denseRange_generatedByOneInClosed (a : E) : + DenseRange (generatedByOneInClosed a) := by + change DenseRange (Set.inclusion (generatedByOne_le_closedGeneratedByOne a)) + apply (denseRange_inclusion_iff (generatedByOne_le_closedGeneratedByOne a)).2 + intro x hx + exact hx + +omit [JBAlgebra E] in +/-- The inclusion of an algebraic Jordan power is the corresponding ordinary power in the +associative closed one-generator algebra. -/ +theorem generatedByOneInClosed_jpow (a : E) (n : ℕ) : + generatedByOneInClosed a ⟨a ^[n], JordanAlgebra.jpow_mem_generatedByOne a n⟩ = + (closedGenerator a) ^ n := by + apply Subtype.ext + induction n with + | zero => simp [generatedByOneInClosed] + | succ n ih => + simpa [generatedByOneInClosed, ClosedGeneratedByOne.val_mul, pow_succ, + JordanAlgebra.jpow_succ, mul_comm] using congrArg (fun x : E => a * x) ih + +/-- Every algebraic Jordan power of the observable lies in the range of the intrinsic CFC. -/ +theorem generatedByOneInClosed_jpow_mem_range_jordanCfcHom [Nontrivial E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (a : E) (n : ℕ) : + generatedByOneInClosed a ⟨a ^[n], JordanAlgebra.jpow_mem_generatedByOne a n⟩ ∈ + Set.range (jordanCfcHom a) := by + refine ⟨(ContinuousMap.restrict (jordanSpectrum a) (.id ℝ)) ^ n, ?_⟩ + rw [map_pow, jordanCfcHom_id, ← generatedByOneInClosed_jpow] + +/-- The whole algebraic one-generator submodule lies in the CFC range. -/ +theorem generatedByOneInClosed_mem_range_jordanCfcHom [Nontrivial E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (a : E) (x : JordanAlgebra.generatedByOne a) : + generatedByOneInClosed a x ∈ Set.range (jordanCfcHom a) := by + have hspan : ∀ y ∈ JordanAlgebra.generatedByOne a, + ∃ f : C(jordanSpectrum a, ℝ), ((jordanCfcHom a f : ClosedGeneratedByOne a) : E) = y := by + intro y hy + induction hy using Submodule.span_induction with + | mem y hy => + obtain ⟨n, rfl⟩ := hy + obtain ⟨f, hf⟩ := generatedByOneInClosed_jpow_mem_range_jordanCfcHom a n + exact ⟨f, congrArg (fun z : ClosedGeneratedByOne a => (z : E)) hf⟩ + | zero => exact ⟨0, by simp⟩ + | add y z hy hz ihy ihz => + obtain ⟨fy, hfy⟩ := ihy + obtain ⟨fz, hfz⟩ := ihz + exact ⟨fy + fz, by simpa [map_add] using congrArg₂ (· + ·) hfy hfz⟩ + | smul r y hy ihy => + obtain ⟨f, hf⟩ := ihy + exact ⟨r • f, by simpa [map_smul] using congrArg (fun z : E => r • z) hf⟩ + obtain ⟨f, hf⟩ := hspan x x.property + refine ⟨f, Subtype.ext ?_⟩ + exact hf + +/-- The intrinsic continuous functional calculus is onto the closed one-generator JB algebra. -/ +theorem jordanCfcLinear_range_eq_top [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : + LinearMap.range (jordanCfcHom a).toLinearMap = ⊤ := by + apply top_unique + intro x hx + have hdense : closure (Set.range (generatedByOneInClosed a)) = Set.univ := + dense_iff_closure_eq.mp (denseRange_generatedByOneInClosed a) + have hxclosure : x ∈ closure (Set.range (generatedByOneInClosed a)) := by + rw [hdense] + trivial + have hsubset : Set.range (generatedByOneInClosed a) ⊆ Set.range (jordanCfcHom a) := by + rintro y ⟨z, rfl⟩ + exact generatedByOneInClosed_mem_range_jordanCfcHom a z + exact closure_minimal hsubset (isClosed_range_jordanCfcHom a) hxclosure + +/-- The range of the intrinsic CFC algebra homomorphism is the entire closed one-generator +JB algebra. -/ +theorem jordanCfcHom_range_eq_top [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : + (jordanCfcHom a).range = ⊤ := by + apply top_unique + intro x hx + obtain ⟨f, hf⟩ := LinearMap.range_eq_top.mp (jordanCfcLinear_range_eq_top a) x + exact ⟨f, hf⟩ + +/-- The intrinsic continuous functional calculus identifies the continuous real functions on the +Jordan spectrum with the closed associative algebra generated by the observable. The algebraic +equivalence is separate from `jordanCfcHom_isometry`, which records its essential isometric +property. -/ +noncomputable def jordanCfcEquiv [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : + C(jordanSpectrum a, ℝ) ≃ₐ[ℝ] ClosedGeneratedByOne a := + AlgEquiv.ofBijective (jordanCfcHom a) ⟨(jordanCfcHom_isometry a).injective, by + intro x + have hx : x ∈ (jordanCfcHom a).range := by + rw [jordanCfcHom_range_eq_top] + trivial + exact hx⟩ + +/-- The algebra equivalence supplied by the intrinsic CFC preserves the sup norm exactly. -/ +theorem norm_jordanCfcEquiv_apply [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) + (f : C(jordanSpectrum a, ℝ)) : ‖jordanCfcEquiv a f‖ = ‖f‖ := + norm_jordanCfcLinear a f + +/-- The pointwise CFC coordinate law. -/ +theorem jordanCfc_id [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : + jordanCfc a (ContinuousMap.restrict (jordanSpectrum a) (.id ℝ)) = a := by + exact congrArg (fun x : ClosedGeneratedByOne a => (x : E)) (jordanCfcHom_id a) + +/-- The pointwise CFC is additive. -/ +theorem jordanCfc_add [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) + (f g : C(jordanSpectrum a, ℝ)) : + jordanCfc a (f + g) = jordanCfc a f + jordanCfc a g := + congrArg (fun x : ClosedGeneratedByOne a => (x : E)) (map_add (jordanCfcHom a) f g) + +/-- The pointwise CFC preserves subtraction. -/ +theorem jordanCfc_sub [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) + (f g : C(jordanSpectrum a, ℝ)) : + jordanCfc a (f - g) = jordanCfc a f - jordanCfc a g := + congrArg (fun x : ClosedGeneratedByOne a => (x : E)) (map_sub (jordanCfcHom a) f g) + +/-- The pointwise CFC preserves zero. -/ +theorem jordanCfc_zero [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : + jordanCfc a (0 : C(jordanSpectrum a, ℝ)) = 0 := + congrArg (fun x : ClosedGeneratedByOne a => (x : E)) (map_zero (jordanCfcHom a)) + +/-- The pointwise CFC is multiplicative. -/ +theorem jordanCfc_mul [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) + (f g : C(jordanSpectrum a, ℝ)) : + jordanCfc a (f * g) = jordanCfc a f * jordanCfc a g := + congrArg (fun x : ClosedGeneratedByOne a => (x : E)) (map_mul (jordanCfcHom a) f g) + +/-- The pointwise CFC sends constant functions to the corresponding scalar multiples of one. -/ +theorem jordanCfc_const [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) (r : ℝ) : + jordanCfc a (ContinuousMap.const (jordanSpectrum a) r) = r • (1 : E) := by + change + ((jordanCfcHom a (ContinuousMap.const (jordanSpectrum a) r) : ClosedGeneratedByOne a) : E) = + r • (1 : E) + have hconst : ContinuousMap.const (jordanSpectrum a) r = r • (1 : C(jordanSpectrum a, ℝ)) := by + ext x + simp + have h : jordanCfcHom a (ContinuousMap.const (jordanSpectrum a) r) = + r • (1 : ClosedGeneratedByOne a) := by + rw [hconst] + simpa only [Algebra.algebraMap_eq_smul_one] using (jordanCfcHom a).commutes r + exact congrArg (fun x : ClosedGeneratedByOne a => (x : E)) h + +/-! ## Positive square roots -/ + +/-- The continuous square-root function on the intrinsic spectrum of a positive observable. -/ +noncomputable def jordanSpectrumSqrt (a : E) : C(jordanSpectrum a, ℝ) := + ⟨fun x => Real.sqrt x, Real.continuous_sqrt.comp continuous_subtype_val⟩ + +/-- The canonical intrinsic positive square root of a nonnegative JB observable, obtained by +applying its own continuous functional calculus to the real square-root function. -/ +noncomputable def jordanSqrt [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) (_ha : 0 ≤ a) : E := + jordanCfc a (jordanSpectrumSqrt a) + +/-- The continuous square-root function squares to the spectral coordinate for a positive +observable. -/ +theorem jordanSpectrumSqrt_mul_self_eq_id [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + {a : E} (ha : 0 ≤ a) : jordanSpectrumSqrt a * jordanSpectrumSqrt a = + ContinuousMap.restrict (jordanSpectrum a) (.id ℝ) := by + ext x + change Real.sqrt (x : ℝ) * Real.sqrt x = x + exact Real.mul_self_sqrt (nonneg_of_mem_jordanSpectrum ha x.property) + +/-- The canonical positive square root squares to its input. -/ +theorem jordanSqrt_mul_self [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) (ha : 0 ≤ a) : + jordanSqrt a ha * jordanSqrt a ha = a := by + unfold jordanSqrt + rw [← jordanCfc_mul, jordanSpectrumSqrt_mul_self_eq_id ha, jordanCfc_id] + +/-- The canonical square root is nonnegative. The fourth-root function is a square root of the +square-root function, so exact cone reconstruction proves positivity without a representation. -/ +theorem jordanSqrt_nonneg [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) (ha : 0 ≤ a) : + 0 ≤ jordanSqrt a ha := by + let fourthRoot : C(jordanSpectrum a, ℝ) := + ⟨fun x => Real.sqrt (Real.sqrt x), + Real.continuous_sqrt.comp (Real.continuous_sqrt.comp continuous_subtype_val)⟩ + have hfourth : jordanSqrt a ha = jordanCfc a fourthRoot * jordanCfc a fourthRoot := by + rw [← jordanCfc_mul] + change jordanCfc a (jordanSpectrumSqrt a) = jordanCfc a (fourthRoot * fourthRoot) + congr 1 + ext x + change Real.sqrt x = Real.sqrt (Real.sqrt x) * Real.sqrt (Real.sqrt x) + exact (Real.mul_self_sqrt (Real.sqrt_nonneg x)).symm + rw [hfourth] + exact IsJordanOrderUnit.mul_self_nonneg _ + +/-! ## Absolute value and positive/negative parts -/ + +/-- A CFC value is positive whenever its defining function is a pointwise square. -/ +theorem jordanCfc_nonneg_of_eq_mul_self [Nontrivial E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (a : E) {f g : C(jordanSpectrum a, ℝ)} (hfg : f = g * g) : 0 ≤ jordanCfc a f := by + rw [hfg, jordanCfc_mul] + exact IsJordanOrderUnit.mul_self_nonneg _ + +/-- The intrinsic continuous calculus is positive: every pointwise nonnegative continuous +function on the canonical Jordan spectrum has a nonnegative value in the JB algebra. The proof +uses the continuous pointwise square root and exact-cone reconstruction, without a chosen +associative realization. -/ +theorem jordanCfc_nonneg [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) + (f : C(jordanSpectrum a, ℝ)) (hf : ∀ x, 0 ≤ f x) : 0 ≤ jordanCfc a f := by + let root : C(jordanSpectrum a, ℝ) := + ⟨fun x => Real.sqrt (f x), Real.continuous_sqrt.comp f.continuous⟩ + apply jordanCfc_nonneg_of_eq_mul_self a (g := root) + ext x + change f x = Real.sqrt (f x) * Real.sqrt (f x) + exact (Real.mul_self_sqrt (hf x)).symm + +/-- The intrinsic continuous calculus is monotone for the pointwise order on continuous +functions. -/ +theorem jordanCfc_monotone [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) + {f g : C(jordanSpectrum a, ℝ)} (hfg : f ≤ g) : jordanCfc a f ≤ jordanCfc a g := by + rw [← sub_nonneg, ← jordanCfc_sub] + exact jordanCfc_nonneg a (g - f) fun x => sub_nonneg.mpr (hfg x) + +/-- The intrinsic CFC reflects positivity as well as preserving it. A positive CFC value is a +square already in its closed generated algebra; transporting that local square witness back +through the CFC equivalence shows that the defining continuous function is pointwise a square. -/ +theorem jordanCfc_nonneg_iff [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) + (f : C(jordanSpectrum a, ℝ)) : 0 ≤ jordanCfc a f ↔ ∀ x, 0 ≤ f x := by + constructor + · intro hf + change 0 ≤ (jordanCfcHom a f : ClosedGeneratedByOne a) at hf + obtain ⟨s, hs⟩ := JBAlgebra.ClosedGeneratedByOne.exists_mul_self_of_nonneg a + (jordanCfcHom a f) hf + let g : C(jordanSpectrum a, ℝ) := (jordanCfcEquiv a).symm s + have hgs : jordanCfcHom a g = s := (jordanCfcEquiv a).apply_symm_apply s + have hfg : f = g * g := (jordanCfcHom_isometry a).injective (by + rw [map_mul, hgs, hs]) + intro x + rw [hfg] + exact mul_self_nonneg _ + · exact jordanCfc_nonneg a f + +/-- The intrinsic CFC is an order embedding from pointwise-ordered continuous functions onto the +closed generated JB algebra. -/ +theorem jordanCfc_le_iff [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) + (f g : C(jordanSpectrum a, ℝ)) : jordanCfc a f ≤ jordanCfc a g ↔ f ≤ g := by + constructor + · intro hfg x + have hnonneg : 0 ≤ jordanCfc a (g - f) := by + rw [jordanCfc_sub] + exact sub_nonneg.mpr hfg + exact sub_nonneg.mp ((jordanCfc_nonneg_iff a (g - f)).mp hnonneg x) + · exact jordanCfc_monotone a + +/-- The canonical CFC square root is the unique nonnegative square root lying in the closed +one-generator algebra of its input. The remaining unrestricted uniqueness theorem is genuinely +multielement: it must show that an arbitrary positive root belongs to this algebra, or replace +that conclusion through quadratic Jordan theory. -/ +theorem jordanSqrt_eq_of_mem_closedGeneratedByOne [Nontrivial E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (a : E) (ha : 0 ≤ a) (b : ClosedGeneratedByOne a) (hb0 : 0 ≤ b) + (hb : b * b = closedGenerator a) : jordanSqrt a ha = (b : E) := by + let f : C(jordanSpectrum a, ℝ) := (jordanCfcEquiv a).symm b + have hfb : jordanCfcHom a f = b := (jordanCfcEquiv a).apply_symm_apply b + have hf0 : ∀ x, 0 ≤ f x := (jordanCfc_nonneg_iff a f).mp (by + change 0 ≤ ((jordanCfcHom a f : ClosedGeneratedByOne a) : E) + rw [hfb] + exact hb0) + have hfsq : f * f = ContinuousMap.restrict (jordanSpectrum a) (.id ℝ) := + (jordanCfcHom_isometry a).injective (by + rw [map_mul, hfb, hb, jordanCfcHom_id]) + have hfsqrt : f = jordanSpectrumSqrt a := by + ext x + have hsq := DFunLike.congr_fun hfsq x + change f x = Real.sqrt (x : ℝ) + change f x * f x = (x : ℝ) at hsq + nlinarith [hf0 x, Real.sqrt_nonneg (x : ℝ), + Real.mul_self_sqrt (nonneg_of_mem_jordanSpectrum ha x.property)] + unfold jordanSqrt + change ((jordanCfcHom a (jordanSpectrumSqrt a) : ClosedGeneratedByOne a) : E) = (b : E) + rw [← hfb, ← hfsqrt] + +/-- The absolute-value function on the intrinsic spectrum. -/ +noncomputable def jordanSpectrumAbs (a : E) : C(jordanSpectrum a, ℝ) := + ⟨fun x => |x|, continuous_abs.comp continuous_subtype_val⟩ + +/-- The intrinsic absolute value of a JB observable. -/ +noncomputable def jordanAbs [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : E := + jordanCfc a (jordanSpectrumAbs a) + +/-- Absolute value squares to the square of the observable. -/ +theorem jordanAbs_mul_self [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : + jordanAbs a * jordanAbs a = a * a := by + unfold jordanAbs + rw [← jordanCfc_mul] + have habs : jordanSpectrumAbs a * jordanSpectrumAbs a = + (ContinuousMap.restrict (jordanSpectrum a) (.id ℝ)) * + ContinuousMap.restrict (jordanSpectrum a) (.id ℝ) := by + ext x + change |(x : ℝ)| * |(x : ℝ)| = (x : ℝ) * (x : ℝ) + simp + rw [habs, jordanCfc_mul, jordanCfc_id] + +/-- Absolute value is nonnegative, witnessed by the CFC square-root of the absolute-value +function. -/ +theorem jordanAbs_nonneg [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : 0 ≤ jordanAbs a := by + let rootAbs : C(jordanSpectrum a, ℝ) := + ⟨fun x => Real.sqrt |(x : ℝ)|, Real.continuous_sqrt.comp + (continuous_abs.comp continuous_subtype_val)⟩ + apply jordanCfc_nonneg_of_eq_mul_self a (g := rootAbs) + ext x + change |(x : ℝ)| = Real.sqrt |(x : ℝ)| * Real.sqrt |(x : ℝ)| + exact (Real.mul_self_sqrt (abs_nonneg (x : ℝ))).symm + +/-- The intrinsic absolute value vanishes exactly at the zero observable. The nontrivial +direction uses the JB zero-square criterion through `|a|² = a²`. -/ +theorem jordanAbs_eq_zero_iff [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : + jordanAbs a = 0 ↔ a = 0 := by + constructor + · intro h + apply JBAlgebra.eq_zero_of_mul_self_eq_zero + rw [← jordanAbs_mul_self, h, zero_mul] + · rintro rfl + apply JBAlgebra.eq_zero_of_mul_self_eq_zero + rw [jordanAbs_mul_self, zero_mul] + +/-- Absolute value fixes every positive observable. Positivity first confines the intrinsic +spectrum to the nonnegative real line, so the pointwise absolute-value function is the identity. -/ +theorem jordanAbs_eq_self_of_nonneg [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) (ha : 0 ≤ a) : + jordanAbs a = a := by + unfold jordanAbs + have habs : jordanSpectrumAbs a = ContinuousMap.restrict (jordanSpectrum a) (.id ℝ) := by + ext x + change |(x : ℝ)| = (x : ℝ) + exact abs_of_nonneg (nonneg_of_mem_jordanSpectrum ha x.property) + rw [habs, jordanCfc_id] + +/-- Positivity is exactly the fixed-point condition for intrinsic absolute value. -/ +theorem jordanAbs_eq_self_iff_nonneg [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : + jordanAbs a = a ↔ 0 ≤ a := by + constructor + · intro h + rw [← h] + exact jordanAbs_nonneg a + · exact jordanAbs_eq_self_of_nonneg a + +/-- The positive-part function on the intrinsic spectrum. -/ +noncomputable def jordanSpectrumPosPart (a : E) : C(jordanSpectrum a, ℝ) := + ⟨fun x => max (x : ℝ) 0, continuous_subtype_val.max continuous_const⟩ + +/-- The negative-part function on the intrinsic spectrum. -/ +noncomputable def jordanSpectrumNegPart (a : E) : C(jordanSpectrum a, ℝ) := + ⟨fun x => max (-(x : ℝ)) 0, continuous_subtype_val.neg.max continuous_const⟩ + +/-- The positive part of an intrinsic JB observable. -/ +noncomputable def jordanPosPart [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : E := + jordanCfc a (jordanSpectrumPosPart a) + +/-- The negative part of an intrinsic JB observable. -/ +noncomputable def jordanNegPart [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : E := + jordanCfc a (jordanSpectrumNegPart a) + +/-- Positive parts are nonnegative. -/ +theorem jordanPosPart_nonneg [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : + 0 ≤ jordanPosPart a := by + let rootPos : C(jordanSpectrum a, ℝ) := + ⟨fun x => Real.sqrt (max (x : ℝ) 0), Real.continuous_sqrt.comp + (continuous_subtype_val.max continuous_const)⟩ + apply jordanCfc_nonneg_of_eq_mul_self a (g := rootPos) + ext x + change max (x : ℝ) 0 = Real.sqrt (max (x : ℝ) 0) * Real.sqrt (max (x : ℝ) 0) + exact (Real.mul_self_sqrt (le_max_right _ _)).symm + +/-- Negative parts are nonnegative. -/ +theorem jordanNegPart_nonneg [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : + 0 ≤ jordanNegPart a := by + let rootNeg : C(jordanSpectrum a, ℝ) := + ⟨fun x => Real.sqrt (max (-(x : ℝ)) 0), Real.continuous_sqrt.comp + (continuous_subtype_val.neg.max continuous_const)⟩ + apply jordanCfc_nonneg_of_eq_mul_self a (g := rootNeg) + ext x + change max (-(x : ℝ)) 0 = Real.sqrt (max (-(x : ℝ)) 0) * + Real.sqrt (max (-(x : ℝ)) 0) + exact (Real.mul_self_sqrt (le_max_right _ _)).symm + +/-- The positive part fixes a positive observable. -/ +theorem jordanPosPart_eq_self_of_nonneg [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) (ha : 0 ≤ a) : + jordanPosPart a = a := by + unfold jordanPosPart + rw [show jordanSpectrumPosPart a = ContinuousMap.restrict (jordanSpectrum a) (.id ℝ) by + ext x + change max (x : ℝ) 0 = (x : ℝ) + exact max_eq_left (nonneg_of_mem_jordanSpectrum ha x.property), jordanCfc_id] + +/-- The negative part of a positive observable vanishes. -/ +theorem jordanNegPart_eq_zero_of_nonneg [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) (ha : 0 ≤ a) : + jordanNegPart a = 0 := by + unfold jordanNegPart + rw [show jordanSpectrumNegPart a = 0 by + ext x + change max (-(x : ℝ)) 0 = 0 + exact max_eq_right (neg_nonpos.mpr (nonneg_of_mem_jordanSpectrum ha x.property)), + jordanCfc_zero] + +/-- The positive and negative parts reconstruct the observable. -/ +theorem jordanPosPart_sub_jordanNegPart [Nontrivial E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (a : E) : jordanPosPart a - jordanNegPart a = a := by + unfold jordanPosPart jordanNegPart + rw [← jordanCfc_sub] + have hparts : jordanSpectrumPosPart a - jordanSpectrumNegPart a = + ContinuousMap.restrict (jordanSpectrum a) (.id ℝ) := by + ext x + change max (x : ℝ) 0 - max (-(x : ℝ)) 0 = (x : ℝ) + by_cases hx : 0 ≤ (x : ℝ) + · rw [max_eq_left hx, max_eq_right (neg_nonpos.mpr hx)] + ring + · have hx' : (x : ℝ) ≤ 0 := le_of_not_ge hx + rw [max_eq_right hx', max_eq_left (neg_nonneg.mpr hx')] + ring + rw [hparts, jordanCfc_id] + +/-- Positivity is exactly the vanishing of the intrinsic negative part. -/ +theorem jordanNegPart_eq_zero_iff_nonneg [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : + jordanNegPart a = 0 ↔ 0 ≤ a := by + constructor + · intro h + have hparts := jordanPosPart_sub_jordanNegPart a + have hpos : jordanPosPart a = a := by simpa [h] using hparts + rw [← hpos] + exact jordanPosPart_nonneg a + · exact jordanNegPart_eq_zero_of_nonneg a + +/-- Nonpositivity is exactly the vanishing of the intrinsic positive part. The reverse direction +uses the exact CFC order equivalence to turn `a ≤ 0` into the pointwise spectral inequality +`x ≤ 0`. -/ +theorem jordanPosPart_eq_zero_iff_nonpos [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : + jordanPosPart a = 0 ↔ a ≤ 0 := by + constructor + · intro h + have hparts := jordanPosPart_sub_jordanNegPart a + have ha : a = -jordanNegPart a := by simpa [h] using hparts.symm + rw [ha] + exact neg_nonpos.mpr (jordanNegPart_nonneg a) + · intro ha + have hCfc : jordanCfc a (ContinuousMap.restrict (jordanSpectrum a) (.id ℝ)) ≤ + jordanCfc a 0 := by + rw [jordanCfc_id, jordanCfc_zero] + exact ha + have hpoint := (jordanCfc_le_iff a _ _).mp hCfc + unfold jordanPosPart + rw [show jordanSpectrumPosPart a = 0 by + ext x + change max (x : ℝ) 0 = 0 + exact max_eq_right (hpoint x), jordanCfc_zero] + +/-- Absolute value is the sum of the positive and negative parts. Together with +`jordanPosPart_sub_jordanNegPart`, this is the intrinsic one-observable Jordan decomposition. -/ +theorem jordanAbs_eq_jordanPosPart_add_jordanNegPart [Nontrivial E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (a : E) : jordanAbs a = jordanPosPart a + jordanNegPart a := by + unfold jordanAbs jordanPosPart jordanNegPart + rw [← jordanCfc_add] + congr 1 + ext x + change |(x : ℝ)| = max (x : ℝ) 0 + max (-(x : ℝ)) 0 + by_cases hx : 0 ≤ (x : ℝ) + · rw [abs_of_nonneg hx, max_eq_left hx, max_eq_right (neg_nonpos.mpr hx)] + ring + · have hx' : (x : ℝ) ≤ 0 := le_of_not_ge hx + rw [abs_of_nonpos hx', max_eq_right hx', max_eq_left (neg_nonneg.mpr hx')] + ring + +/-- The positive part is bounded by the intrinsic absolute value. -/ +theorem jordanPosPart_le_jordanAbs [Nontrivial E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (a : E) : jordanPosPart a ≤ jordanAbs a := by + rw [jordanAbs_eq_jordanPosPart_add_jordanNegPart] + exact le_add_of_nonneg_right (jordanNegPart_nonneg a) + +/-- The negative part is bounded by the intrinsic absolute value. -/ +theorem jordanNegPart_le_jordanAbs [Nontrivial E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (a : E) : jordanNegPart a ≤ jordanAbs a := by + rw [jordanAbs_eq_jordanPosPart_add_jordanNegPart] + exact le_add_of_nonneg_left (jordanPosPart_nonneg a) + +/-- An observable is bounded above by its intrinsic absolute value. -/ +theorem le_jordanAbs [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : + a ≤ jordanAbs a := by + calc + a = jordanPosPart a - jordanNegPart a := (jordanPosPart_sub_jordanNegPart a).symm + _ = jordanPosPart a + -jordanNegPart a := sub_eq_add_neg _ _ + _ ≤ jordanPosPart a + jordanNegPart a := + add_le_add_right (neg_le_self (jordanNegPart_nonneg a)) _ + _ = jordanAbs a := (jordanAbs_eq_jordanPosPart_add_jordanNegPart a).symm + +/-- The negative of an observable is bounded above by its intrinsic absolute value. -/ +theorem neg_le_jordanAbs [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : + -a ≤ jordanAbs a := by + calc + -a = -(jordanPosPart a - jordanNegPart a) := by + rw [jordanPosPart_sub_jordanNegPart] + _ = jordanNegPart a - jordanPosPart a := neg_sub _ _ + _ = jordanNegPart a + -jordanPosPart a := sub_eq_add_neg _ _ + _ ≤ jordanNegPart a + jordanPosPart a := + add_le_add_right (neg_le_self (jordanPosPart_nonneg a)) _ + _ = jordanAbs a := by + rw [add_comm, (jordanAbs_eq_jordanPosPart_add_jordanNegPart a).symm] + +/-- Positive and negative parts are Jordan-orthogonal. -/ +theorem jordanPosPart_jordanOrthogonal_jordanNegPart [Nontrivial E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (a : E) : JordanAlgebra.JordanOrthogonal (jordanPosPart a) (jordanNegPart a) := by + unfold JordanAlgebra.JordanOrthogonal jordanPosPart jordanNegPart + rw [← jordanCfc_mul] + have horth : jordanSpectrumPosPart a * jordanSpectrumNegPart a = 0 := by + ext x + change max (x : ℝ) 0 * max (-(x : ℝ)) 0 = 0 + by_cases hx : 0 ≤ (x : ℝ) + · rw [max_eq_right (neg_nonpos.mpr hx), mul_zero] + · have hx' : (x : ℝ) ≤ 0 := le_of_not_ge hx + rw [max_eq_right hx', zero_mul] + rw [horth, jordanCfc_zero] + +end NormedJordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/Effect.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/Effect.lean new file mode 100644 index 0000000000..bb508da0bc --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/Effect.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.GeneratedByOne.ContinuousFunctionalCalculus +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Effect.Basic + +/-! +# Continuous functional-calculus effects + +A continuous `[0,1]`-valued function of one intrinsic JB observable is an effect. This is the +continuous precursor to the bounded Borel calculus of a spectral resolution: it packages the +order consequences of the intrinsic CFC without making the CFC core depend on effects. +-/ + +@[expose] public section + +namespace NormedJordanAlgebra + +variable {E : Type*} [NormedJordanAlgebra E] [JBAlgebra E] + +/-- Apply the intrinsic continuous functional calculus to a continuous effect-valued function. +The lower and upper bounds are transported by `jordanCfc_nonneg` and `jordanCfc_monotone`; no +concrete realization is used. -/ +noncomputable def jordanCfcEffect [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) + (f : C(jordanSpectrum a, ℝ)) (hf0 : ∀ x, 0 ≤ f x) (hf1 : ∀ x, f x ≤ 1) : Effect E := + ⟨jordanCfc a f, jordanCfc_nonneg a f hf0, by + have h := jordanCfc_monotone a (f := f) + (g := ContinuousMap.const (jordanSpectrum a) 1) fun x => by simpa using hf1 x + calc + jordanCfc a f ≤ jordanCfc a (ContinuousMap.const (jordanSpectrum a) 1) := h + _ = 1 := by simpa using (jordanCfc_const a 1)⟩ + +/-- Coercing the CFC effect forgets only its proved bounds. -/ +@[simp] +theorem coe_jordanCfcEffect [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) + (f : C(jordanSpectrum a, ℝ)) (hf0 : ∀ x, 0 ≤ f x) (hf1 : ∀ x, f x ≤ 1) : + (jordanCfcEffect a f hf0 hf1 : E) = jordanCfc a f := + rfl + +end NormedJordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/Inherited.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/Inherited.lean new file mode 100644 index 0000000000..bdcfe8b77c --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/Inherited.lean @@ -0,0 +1,138 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.GeneratedByOne.Closed + +/-! +# The inherited JB structure on a closed one-generator algebra + +The closed algebra generated by one element is not merely a complete commutative normed algebra. +It inherits the ambient order, order unit, square positivity, and JB square-norm law. This is the +proper abstract input for the real Gelfand theorem needed by the Jordan continuous functional +calculus: it retains the order information that distinguishes a formally real JB algebra from an +arbitrary real uniform Banach algebra. +-/ + +@[expose] public section + +namespace JBAlgebra + +variable {E : Type*} [NormedJordanAlgebra E] [JBAlgebra E] + +open NormedJordanAlgebra + +namespace ClosedGeneratedByOne + +variable (a : E) + +/-- The closed one-generator algebra inherits its ambient normed Jordan structure. Associativity +is already supplied by `Closed.lean`; the remaining fields are restrictions of the ambient data. -/ +noncomputable instance instNormedJordanAlgebra : NormedJordanAlgebra (ClosedGeneratedByOne a) where + __ := NormedJordanAlgebra.ClosedGeneratedByOne.instCommRing a + __ := (inferInstance : Norm (ClosedGeneratedByOne a)) + __ := (inferInstance : MetricSpace (ClosedGeneratedByOne a)) + __ := (inferInstance : Module ℝ (ClosedGeneratedByOne a)) + dist_eq x y := by + change dist (x : E) (y : E) = ‖-(x : E) + (y : E)‖ + exact NormedJordanAlgebra.dist_eq (x : E) (y : E) + norm_smul_le r x := by + change ‖r • (x : E)‖ ≤ ‖r‖ * ‖(x : E)‖ + exact NormedJordanAlgebra.norm_smul_le r (x : E) + smul_comm r x y := by + apply Subtype.ext + exact NormedJordanAlgebra.smul_comm r (x : E) (y : E) + smul_assoc r x y := by + apply Subtype.ext + exact NormedJordanAlgebra.smul_assoc r (x : E) (y : E) + jordan_identity x y := by + exact mul_assoc x y (x * x) + norm_mul_le x y := by + change ‖(x : E) * (y : E)‖ ≤ ‖(x : E)‖ * ‖(y : E)‖ + exact NormedJordanAlgebra.norm_mul_le (x : E) (y : E) + +/-- A nontrivial ambient algebra gives a nontrivial closed generated algebra, since it contains the +same unit. -/ +noncomputable instance instNontrivial [Nontrivial E] : Nontrivial (ClosedGeneratedByOne a) where + exists_pair_ne := by + refine ⟨(0 : ClosedGeneratedByOne a), (1 : ClosedGeneratedByOne a), ?_⟩ + intro h + have : (0 : E) = 1 := congrArg (fun x : ClosedGeneratedByOne a => (x : E)) h + exact zero_ne_one this + +/-- The inherited unit has norm one, as required by the Banach-algebra spectrum estimates. -/ +noncomputable instance instNormOneClass [Nontrivial E] : NormOneClass (ClosedGeneratedByOne a) where + norm_one := by + have hsq : ‖(1 : E)‖ = ‖(1 : E)‖ ^ 2 := by + rw [← JBAlgebra.norm_mul_self, one_mul] + have hpos : 0 < ‖(1 : E)‖ := norm_pos_iff.mpr one_ne_zero + have hfac : ‖(1 : E)‖ * (‖(1 : E)‖ - 1) = 0 := by + nlinarith [hsq] + rcases mul_eq_zero.mp hfac with hzero | hone + · exact False.elim (ne_of_gt hpos hzero) + · exact sub_eq_zero.mp hone + +/-- The closed one-generator algebra is again a JB-algebra. The complete-space instance is the +closed-subspace instance established in `Closed.lean`; the two norm laws are inherited verbatim. -/ +noncomputable instance instJBAlgebra : JBAlgebra (ClosedGeneratedByOne a) where + norm_mul_self x := by + change ‖(x : E) * (x : E)‖ = ‖(x : E)‖ ^ 2 + exact JBAlgebra.norm_mul_self (x : E) + norm_mul_self_le_add x y := by + change ‖(x : E) * (x : E)‖ ≤ ‖(x : E) * (x : E) + (y : E) * (y : E)‖ + exact JBAlgebra.norm_mul_self_le_add (x : E) (y : E) + +section Ordered + +variable [PartialOrder E] [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] + [PosSMulMono ℝ E] [IsJBOrderUnit E] + +/-- Positive real scalars preserve the inherited order. -/ +noncomputable instance instPosSMulMono : PosSMulMono ℝ (ClosedGeneratedByOne a) where + smul_le_smul_of_nonneg_left {r} hr {x y} hxy := by + change r • (x : E) ≤ r • (y : E) + exact smul_le_smul_of_nonneg_left hxy hr + +/-- The ambient order unit remains an order unit after restricting to the closed generated +subalgebra: each ambient bound is itself a scalar multiple of the same unit and hence lies in the +subalgebra. -/ +noncomputable instance instIsOrderUnit : IsOrderUnit (ClosedGeneratedByOne a) where + one_nonneg := by + change (0 : E) ≤ 1 + exact IsOrderUnit.one_nonneg + exists_nsmul_one_le x := by + obtain ⟨n, hn⟩ := IsOrderUnit.exists_nsmul_one_le (x : E) + refine ⟨n, ?_⟩ + change (x : E) ≤ n • (1 : E) + exact hn + +/-- Archimedeanness restricts along the closed generated subalgebra. -/ +noncomputable instance instIsArchimedeanOrderUnit : + IsArchimedeanOrderUnit (ClosedGeneratedByOne a) where + le_zero_of_forall_pos_smul_one_le x hx := by + change (x : E) ≤ 0 + apply IsArchimedeanOrderUnit.le_zero_of_forall_pos_smul_one_le (x : E) + intro ε hε + exact hx ε hε + +/-- Square positivity restricts to the closed generated subalgebra. -/ +noncomputable instance instIsJordanOrderUnit : IsJordanOrderUnit (ClosedGeneratedByOne a) where + mul_self_nonneg x := by + change (0 : E) ≤ (x : E) * (x : E) + exact IsJordanOrderUnit.mul_self_nonneg (x : E) + +/-- Exact norm/order compatibility is inherited by the closed one-generator algebra. -/ +noncomputable instance instIsJBOrderUnit : IsJBOrderUnit (ClosedGeneratedByOne a) where + norm_eq_orderUnitNorm x := by + change ‖(x : E)‖ = IsArchimedeanOrderUnit.orderUnitNorm x + rw [IsJBOrderUnit.norm_eq_orderUnitNorm (x : E)] + congr 1 + +end Ordered + +end ClosedGeneratedByOne + +end JBAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/PositiveInvertibility.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/PositiveInvertibility.lean new file mode 100644 index 0000000000..a929a94106 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/PositiveInvertibility.lean @@ -0,0 +1,518 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.GeneratedByOne.Uniform +public import Mathlib.Combinatorics.Enumerative.Catalan.Basic +public import Mathlib.RingTheory.PowerSeries.Binomial + +/-! +# Positive invertibility in a closed one-generator JB algebra + +This is the analytic entry point for the intrinsic JB spectral theorem. Everything in this file +lives in the commutative associative algebra `ClosedGeneratedByOne a`; no Cstar realization or +functional-calculus API is used. + +The first lemma packages the geometric-series inverse in the form needed by order arguments. The +next development will prove that a strict order lower bound supplies its norm hypothesis, and then +add the endpoint-valid binomial square-root series needed for the converse positive-unit result. +-/ + +@[expose] public section + +namespace JBAlgebra + +variable {E : Type*} [NormedJordanAlgebra E] [JBAlgebra E] + +open NormedJordanAlgebra +open scoped Topology + +namespace ClosedGeneratedByOne + +variable (a : E) + +/-- The intrinsic half-binomial candidate for `sqrt (1 - z)` in the closed associative algebra +generated by one JB observable. Its endpoint convergence is established by +`summable_norm_half_binomial`. -/ +noncomputable def halfBinomialSqrt (z : ClosedGeneratedByOne a) : ClosedGeneratedByOne a := + ∑' n : ℕ, Ring.choose (1 / 2 : ℝ) n • (-z) ^ n + +/-- The formal coefficient identity for the binomial square-root series. Evaluation at `-z` +will give the algebraic identity `sqrt (1 - z)^2 = 1 - z`; the remaining analytic work is to +justify that endpoint evaluation in the complete generated-one algebra. -/ +theorem binomial_half_series_sq : + (PowerSeries.binomialSeries ℝ (1 / 2 : ℝ)) ^ 2 = 1 + PowerSeries.X := by + rw [pow_two, ← PowerSeries.binomialSeries_add] + norm_num + simpa using (PowerSeries.binomialSeries_nat (R := ℝ) (A := ℝ) 1) + +/-- The scalar telescoping identity behind endpoint summability of the half-binomial series. -/ +theorem catalan_weight_telescopes (n : ℕ) : + (catalan n : ℝ) / 4 ^ n = + 2 * ((Nat.centralBinom n : ℝ) / 4 ^ n - + (Nat.centralBinom (n + 1) : ℝ) / 4 ^ (n + 1)) := by + have hc : ((n + 1 : ℕ) : ℝ) * catalan n = Nat.centralBinom n := by + exact_mod_cast succ_mul_catalan_eq_centralBinom n + have hs : ((n + 1 : ℕ) : ℝ) * Nat.centralBinom (n + 1) = + 2 * (2 * n + 1 : ℕ) * Nat.centralBinom n := by + exact_mod_cast Nat.succ_mul_centralBinom_succ n + push_cast at hc hs + have hn : (n : ℝ) + 1 ≠ 0 := by positivity + have hs' : (Nat.centralBinom (n + 1) : ℝ) = + 2 * (2 * (n : ℝ) + 1) * catalan n := by + apply (mul_left_cancel₀ hn) + calc + ((n : ℝ) + 1) * Nat.centralBinom (n + 1) = + 2 * (2 * (n : ℝ) + 1) * Nat.centralBinom n := hs + _ = ((n : ℝ) + 1) * (2 * (2 * (n : ℝ) + 1) * catalan n) := by + rw [← hc] + ring + rw [pow_succ] + field_simp + rw [hs', ← hc] + ring + +/-- The finite Catalan partial sums telescope, giving the uniform endpoint bound. -/ +theorem sum_range_catalan_weight (N : ℕ) : + ∑ n ∈ Finset.range N, (catalan n : ℝ) / 4 ^ n = + 2 * (1 - (Nat.centralBinom N : ℝ) / 4 ^ N) := by + calc + ∑ n ∈ Finset.range N, (catalan n : ℝ) / 4 ^ n = + ∑ n ∈ Finset.range N, 2 * ((Nat.centralBinom n : ℝ) / 4 ^ n - + (Nat.centralBinom (n + 1) : ℝ) / 4 ^ (n + 1)) := by + apply Finset.sum_congr rfl + intro n _ + exact catalan_weight_telescopes n + _ = 2 * ∑ n ∈ Finset.range N, ((Nat.centralBinom n : ℝ) / 4 ^ n - + (Nat.centralBinom (n + 1) : ℝ) / 4 ^ (n + 1)) := by rw [Finset.mul_sum] + _ = 2 * (1 - (Nat.centralBinom N : ℝ) / 4 ^ N) := by + induction N with + | zero => norm_num + | succ N ih => + rw [Finset.sum_range_succ, mul_add, ih] + ring + +/-- The Catalan weights at `1/4` are summable. -/ +theorem summable_catalan_weight : Summable (fun n : ℕ ↦ (catalan n : ℝ) / 4 ^ n) := by + apply summable_of_sum_range_le (c := 2) + · intro n + positivity + · intro N + rw [sum_range_catalan_weight] + have hnonneg : 0 ≤ (Nat.centralBinom N : ℝ) / 4 ^ N := by positivity + linarith + +/-- Generalized binomial coefficients satisfy their usual one-step recurrence over the reals. -/ +theorem choose_succ_recurrence (a : ℝ) (n : ℕ) : + Ring.choose a (n + 1) = Ring.choose a n * (a - n) / (n + 1) := by + rw [Ring.choose_eq_smul, Ring.choose_eq_smul] + simp only [smul_eq_mul, descPochhammer_succ_right, Polynomial.smeval_mul, + Polynomial.smeval_sub, Polynomial.smeval_X, Polynomial.smeval_natCast, + Nat.factorial_succ, Nat.cast_mul, Nat.cast_add, Nat.cast_one] + field_simp + ring + +/-- The Catalan successor recurrence in the real form matched to generalized binomial ratios. -/ +theorem catalan_succ_recurrence (n : ℕ) : + (catalan (n + 1) : ℝ) = + 2 * (2 * (n : ℝ) + 1) * catalan n / (n + 2) := by + have hc : ((n + 1 : ℕ) : ℝ) * catalan n = Nat.centralBinom n := by + exact_mod_cast succ_mul_catalan_eq_centralBinom n + have hs : ((n + 1 : ℕ) : ℝ) * Nat.centralBinom (n + 1) = + 2 * (2 * n + 1 : ℕ) * Nat.centralBinom n := by + exact_mod_cast Nat.succ_mul_centralBinom_succ n + have hc' : ((n + 2 : ℕ) : ℝ) * catalan (n + 1) = Nat.centralBinom (n + 1) := by + simpa [Nat.add_assoc] using + (show (((n + 1) + 1 : ℕ) : ℝ) * catalan (n + 1) = Nat.centralBinom (n + 1) from + (by exact_mod_cast succ_mul_catalan_eq_centralBinom (n + 1))) + push_cast at hc hs hc' + have hn : (n : ℝ) + 1 ≠ 0 := by positivity + have hcentral : (Nat.centralBinom (n + 1) : ℝ) = + 2 * (2 * (n : ℝ) + 1) * catalan n := by + apply (mul_left_cancel₀ hn) + calc + ((n : ℝ) + 1) * Nat.centralBinom (n + 1) = + 2 * (2 * (n : ℝ) + 1) * Nat.centralBinom n := hs + _ = ((n : ℝ) + 1) * (2 * (2 * (n : ℝ) + 1) * catalan n) := by + rw [← hc] + ring + rw [hcentral] at hc' + field_simp + nlinarith + +/-- The exact signed half-binomial/Catalan identity. Taking absolute values will provide the +scalar majorant for the endpoint binomial square-root series. -/ +theorem choose_half_succ_eq_catalan (n : ℕ) : + Ring.choose (1 / 2 : ℝ) (n + 1) = + (-1 : ℝ) ^ n * (catalan n : ℝ) / (2 * 4 ^ n) := by + induction n with + | zero => norm_num [Ring.choose_one_right, catalan_zero] + | succ n ih => + rw [show n + 1 + 1 = (n + 1) + 1 by omega, + choose_succ_recurrence, ih, catalan_succ_recurrence, pow_succ] + push_cast + field_simp + ring + +/-- The absolute half-binomial coefficients are the Catalan endpoint weights. -/ +theorem abs_choose_half_succ_eq_catalan (n : ℕ) : + |Ring.choose (1 / 2 : ℝ) (n + 1)| = (catalan n : ℝ) / (2 * 4 ^ n) := by + have hcat : 0 ≤ (catalan n : ℝ) := by positivity + rw [choose_half_succ_eq_catalan, abs_div, abs_mul, abs_pow] + norm_num [abs_of_nonneg hcat] + +/-- The half-binomial coefficients are absolutely summable at the endpoint. -/ +theorem summable_abs_choose_half : Summable (fun n : ℕ ↦ |Ring.choose (1 / 2 : ℝ) n|) := by + apply (summable_nat_add_iff 1).mp + have h := (summable_catalan_weight.mul_left (1 / 2 : ℝ)) + refine h.congr ?_ + intro n + rw [abs_choose_half_succ_eq_catalan] + ring + +/-- The endpoint half-binomial series is absolutely summable in every closed one-generator JB +algebra on the closed unit ball. -/ +theorem summable_norm_half_binomial [Nontrivial E] (z : ClosedGeneratedByOne a) (hz : ‖z‖ ≤ 1) : + Summable (fun n : ℕ ↦ ‖Ring.choose (1 / 2 : ℝ) n • (-z) ^ n‖) := by + apply summable_abs_choose_half.of_nonneg_of_le (fun n ↦ norm_nonneg _) + intro n + have hzneg : ‖-z‖ ≤ 1 := by simpa using hz + calc + ‖Ring.choose (1 / 2 : ℝ) n • (-z) ^ n‖ = + |Ring.choose (1 / 2 : ℝ) n| * ‖(-z) ^ n‖ := by rw [norm_smul, Real.norm_eq_abs] + _ ≤ |Ring.choose (1 / 2 : ℝ) n| * ‖-z‖ ^ n := + mul_le_mul_of_nonneg_left (norm_pow_le _ _) (abs_nonneg _) + _ ≤ |Ring.choose (1 / 2 : ℝ) n| * 1 := + mul_le_mul_of_nonneg_left (pow_le_one₀ (norm_nonneg _) hzneg) (abs_nonneg _) + _ = |Ring.choose (1 / 2 : ℝ) n| := mul_one _ + +/-- The defining series for `halfBinomialSqrt` is summable on the closed unit ball. -/ +theorem halfBinomialSqrt_summable [Nontrivial E] (z : ClosedGeneratedByOne a) (hz : ‖z‖ ≤ 1) : + Summable (fun n : ℕ ↦ Ring.choose (1 / 2 : ℝ) n • (-z) ^ n) := + (summable_norm_half_binomial a z hz).of_norm + +omit [JBAlgebra E] in +/-- The `n`th Cauchy-product coefficient of the evaluated half-binomial series. This is the +formal binomial identity transported to the associative algebra generated by the single Jordan +element `a`. -/ +theorem halfBinomialSqrt_antidiagonal (z : ClosedGeneratedByOne a) (n : ℕ) : + ∑ kl ∈ Finset.antidiagonal n, + (Ring.choose (1 / 2 : ℝ) kl.1 • (-z) ^ kl.1) * + (Ring.choose (1 / 2 : ℝ) kl.2 • (-z) ^ kl.2) = + ((if n = 0 then (1 : ℝ) else 0) + if n = 1 then 1 else 0) • (-z) ^ n := by + have hcoeff := congrArg (fun p : PowerSeries ℝ ↦ p.coeff n) binomial_half_series_sq + have hscalar : + ∑ kl ∈ Finset.antidiagonal n, + Ring.choose (1 / 2 : ℝ) kl.1 * Ring.choose (1 / 2 : ℝ) kl.2 = + (if n = 0 then (1 : ℝ) else 0) + if n = 1 then 1 else 0 := by + simpa only [pow_two, PowerSeries.coeff_mul, PowerSeries.binomialSeries_coeff, + smul_eq_mul, mul_one, map_add, PowerSeries.coeff_one, PowerSeries.coeff_X] using hcoeff + calc + ∑ kl ∈ Finset.antidiagonal n, + (Ring.choose (1 / 2 : ℝ) kl.1 • (-z) ^ kl.1) * + (Ring.choose (1 / 2 : ℝ) kl.2 • (-z) ^ kl.2) = + ∑ kl ∈ Finset.antidiagonal n, + (Ring.choose (1 / 2 : ℝ) kl.1 * Ring.choose (1 / 2 : ℝ) kl.2) • + ((-z) ^ kl.1 * (-z) ^ kl.2) := by + apply Finset.sum_congr rfl + intro kl _ + rw [smul_mul_assoc, mul_smul_comm, ← smul_smul] + _ = ∑ kl ∈ Finset.antidiagonal n, + (Ring.choose (1 / 2 : ℝ) kl.1 * Ring.choose (1 / 2 : ℝ) kl.2) • (-z) ^ n := by + apply Finset.sum_congr rfl + intro kl hkl + rw [Finset.mem_antidiagonal] at hkl + rw [← hkl, pow_add] + _ = (∑ kl ∈ Finset.antidiagonal n, + Ring.choose (1 / 2 : ℝ) kl.1 * Ring.choose (1 / 2 : ℝ) kl.2) • (-z) ^ n := by + rw [Finset.sum_smul] + _ = _ := by rw [hscalar] + +/-- The endpoint-valid intrinsic binomial square-root identity. Absolute convergence, proved +from the Catalan majorant above, licenses the Cauchy product; the formal coefficient calculation +then collapses that product to `1 - z`. -/ +theorem halfBinomialSqrt_mul_self [Nontrivial E] (z : ClosedGeneratedByOne a) (hz : ‖z‖ ≤ 1) : + halfBinomialSqrt a z * halfBinomialSqrt a z = 1 - z := by + unfold halfBinomialSqrt + rw [tsum_mul_tsum_eq_tsum_sum_antidiagonal_of_summable_norm + (summable_norm_half_binomial a z hz) (summable_norm_half_binomial a z hz)] + simp_rw [halfBinomialSqrt_antidiagonal a z] + rw [tsum_eq_sum (s := ({0, 1} : Finset ℕ))] + · norm_num [sub_eq_add_neg] + · intro n hn + simp only [Finset.mem_insert, Finset.mem_singleton] at hn + have hn0 : n ≠ 0 := fun h ↦ hn (Or.inl h) + have hn1 : n ≠ 1 := fun h ↦ hn (Or.inr h) + simp [hn0, hn1] + +/-- Local exact-cone direction: every nonnegative element of the closed associative algebra +generated by one JB element is a square. This is the intrinsic endpoint square-root argument; +no representation or pre-existing functional calculus is involved. -/ +theorem exists_mul_self_of_nonneg [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (y : ClosedGeneratedByOne a) (hy : 0 ≤ y) : ∃ s : ClosedGeneratedByOne a, s * s = y := by + let M : ℝ := ‖y‖ + 1 + have hM : 0 < M := by + dsimp [M] + positivity + have hMne : M ≠ 0 := ne_of_gt hM + have hy_norm : ‖y‖ < M := by + dsimp [M] + linarith [norm_nonneg y] + have hy_upper : y ≤ M • (1 : ClosedGeneratedByOne a) := + (JBAlgebra.norm_le_iff_order_bounds (x := y) (r := M) hM.le).mp hy_norm.le |>.2 + let z : ClosedGeneratedByOne a := 1 - M⁻¹ • y + have hscaled : M⁻¹ • y ≤ (1 : ClosedGeneratedByOne a) := by + have := smul_le_smul_of_nonneg_left hy_upper (inv_pos.mpr hM).le + simpa [smul_smul, hMne] using this + have hz_nonneg : 0 ≤ z := sub_nonneg.mpr hscaled + have hz_upper : z ≤ (1 : ClosedGeneratedByOne a) := by + dsimp [z] + exact sub_le_self _ (smul_nonneg (inv_pos.mpr hM).le hy) + have hz_lower : -(1 : ClosedGeneratedByOne a) ≤ z := by + calc + -(1 : ClosedGeneratedByOne a) ≤ 0 := neg_nonpos.mpr IsOrderUnit.one_nonneg + _ ≤ z := hz_nonneg + have hz_norm : ‖z‖ ≤ 1 := + (JBAlgebra.norm_le_iff_order_bounds (x := z) (r := 1) zero_le_one).mpr + ⟨by simpa using hz_lower, by simpa using hz_upper⟩ + let r : ClosedGeneratedByOne a := halfBinomialSqrt a z + refine ⟨Real.sqrt M • r, ?_⟩ + calc + (Real.sqrt M • r) * (Real.sqrt M • r) = (Real.sqrt M * Real.sqrt M) • (r * r) := by + rw [smul_mul_assoc, mul_smul_comm, ← smul_smul] + _ = M • (r * r) := by rw [Real.mul_self_sqrt hM.le] + _ = M • (1 - z) := by rw [show r * r = 1 - z by exact halfBinomialSqrt_mul_self a z hz_norm] + _ = y := by + simp [z, smul_smul, hMne] + +/-- The local exact-cone theorem for a closed one-generator ordered JB algebra. -/ +theorem nonneg_iff_exists_mul_self [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (y : ClosedGeneratedByOne a) : 0 ≤ y ↔ ∃ s : ClosedGeneratedByOne a, s * s = y := by + constructor + · exact exists_mul_self_of_nonneg a y + · rintro ⟨s, rfl⟩ + exact IsJordanOrderUnit.mul_self_nonneg s + +/-- A nonnegative unit lies in the order interior. The proof first reconstructs squares from +the local exact cone, and then transfers the order bound for its positive inverse through the +commutative one-generator algebra. -/ +theorem exists_pos_smul_one_le_of_isUnit_of_nonneg [Nontrivial E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + {y : ClosedGeneratedByOne a} (hy : IsUnit y) (hy_nonneg : 0 ≤ y) : + ∃ ε : ℝ, 0 < ε ∧ ε • (1 : ClosedGeneratedByOne a) ≤ y := by + obtain ⟨s, hs⟩ := exists_mul_self_of_nonneg a y hy_nonneg + have hs_unit : IsUnit s := by + apply isUnit_mul_self_iff.mp + simpa [hs] using hy + let v : ClosedGeneratedByOne a := ↑(hs_unit.unit⁻¹) + let t : ClosedGeneratedByOne a := v * v + have ht_nonneg : 0 ≤ t := IsJordanOrderUnit.mul_self_nonneg v + have ht_mul : t * y = 1 := by + rw [← hs] + calc + (v * v) * (s * s) = (v * s) * (v * s) := by ring + _ = 1 := by rw [show v * s = 1 by exact IsUnit.val_inv_mul hs_unit]; simp + let M : ℝ := ‖t‖ + 1 + have hM : 0 < M := by + dsimp [M] + positivity + have hMne : M ≠ 0 := ne_of_gt hM + have ht_upper : t ≤ M • (1 : ClosedGeneratedByOne a) := + (JBAlgebra.norm_le_iff_order_bounds (x := t) (r := M) hM.le).mp (by + dsimp [M] + linarith [norm_nonneg t]) |>.2 + obtain ⟨q, hq⟩ := exists_mul_self_of_nonneg a (M • (1 : ClosedGeneratedByOne a) - t) + (sub_nonneg.mpr ht_upper) + have hmy_nonneg : 0 ≤ M • y - 1 := by + calc + M • y - 1 = (M • (1 : ClosedGeneratedByOne a) - t) * y := by + rw [sub_mul, smul_mul_assoc, ht_mul] + simp + _ = (q * s) * (q * s) := by rw [← hq, ← hs]; ring + _ ≥ 0 := IsJordanOrderUnit.mul_self_nonneg (q * s) + refine ⟨M⁻¹, inv_pos.mpr hM, ?_⟩ + have hmy : (1 : ClosedGeneratedByOne a) ≤ M • y := sub_nonneg.mp hmy_nonneg + have := smul_le_smul_of_nonneg_left hmy (inv_pos.mpr hM).le + simpa [smul_smul, hMne] using this + +/-- At the two norm endpoints of a one-generator JB observable, at least one order-positive +element is on the boundary of the cone. This is the cone-boundary core of real spectrality. -/ +theorem not_isUnit_norm_smul_one_sub_and_add [Nontrivial E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (x : ClosedGeneratedByOne a) : + ¬ (IsUnit (‖x‖ • (1 : ClosedGeneratedByOne a) - x) ∧ + IsUnit (‖x‖ • (1 : ClosedGeneratedByOne a) + x)) := by + intro hunit + have hbounds := + (JBAlgebra.norm_le_iff_order_bounds (x := x) (r := ‖x‖) (norm_nonneg x)).mp le_rfl + have hplus_nonneg : 0 ≤ ‖x‖ • (1 : ClosedGeneratedByOne a) - x := + sub_nonneg.mpr hbounds.2 + have hminus_nonneg : 0 ≤ ‖x‖ • (1 : ClosedGeneratedByOne a) + x := by + have hneg : -x ≤ ‖x‖ • (1 : ClosedGeneratedByOne a) := by + simpa using neg_le_neg hbounds.1 + simpa [sub_eq_add_neg] using sub_nonneg.mpr hneg + obtain ⟨εp, hεp, hp⟩ := + exists_pos_smul_one_le_of_isUnit_of_nonneg a hunit.1 hplus_nonneg + obtain ⟨εm, hεm, hm⟩ := + exists_pos_smul_one_le_of_isUnit_of_nonneg a hunit.2 hminus_nonneg + have hr : 0 < ‖x‖ := by + by_contra hnr + have hr0 : ‖x‖ = 0 := le_antisymm (le_of_not_gt hnr) (norm_nonneg x) + have hx0 : x = 0 := norm_eq_zero.mp hr0 + exact (not_isUnit_zero : ¬ IsUnit (0 : ClosedGeneratedByOne a)) + (by simpa [hr0, hx0] using hunit.1) + let δ : ℝ := min (‖x‖ / 2) (min εp εm) + have hδ : 0 < δ := lt_min (by linarith) (lt_min hεp hεm) + have hδhalf : δ ≤ ‖x‖ / 2 := min_le_left _ _ + have hδp : δ ≤ εp := le_trans (min_le_right _ _) (min_le_left _ _) + have hδm : δ ≤ εm := le_trans (min_le_right _ _) (min_le_right _ _) + have hnonneg : 0 ≤ ‖x‖ - δ := by linarith + have hupperp : x ≤ (‖x‖ - εp) • (1 : ClosedGeneratedByOne a) := by + calc + x = ‖x‖ • (1 : ClosedGeneratedByOne a) - + (‖x‖ • (1 : ClosedGeneratedByOne a) - x) := by abel + _ ≤ ‖x‖ • (1 : ClosedGeneratedByOne a) - εp • (1 : ClosedGeneratedByOne a) := + sub_le_sub_left hp _ + _ = (‖x‖ - εp) • (1 : ClosedGeneratedByOne a) := by rw [sub_smul] + have hupper : x ≤ (‖x‖ - δ) • (1 : ClosedGeneratedByOne a) := + hupperp.trans <| smul_le_smul_of_nonneg_right (sub_le_sub_left hδp _) IsOrderUnit.one_nonneg + have hlowerm : -((‖x‖ - εm) • (1 : ClosedGeneratedByOne a)) ≤ x := by + calc + -((‖x‖ - εm) • (1 : ClosedGeneratedByOne a)) = + εm • (1 : ClosedGeneratedByOne a) - ‖x‖ • (1 : ClosedGeneratedByOne a) := by module + _ ≤ x := (sub_le_iff_le_add).mpr (by simpa [add_comm] using hm) + have hscalar : -(‖x‖ - δ) ≤ -(‖x‖ - εm) := + neg_le_neg (sub_le_sub_left hδm _) + have hlower : -((‖x‖ - δ) • (1 : ClosedGeneratedByOne a)) ≤ x := by + calc + -((‖x‖ - δ) • (1 : ClosedGeneratedByOne a)) = + (-(‖x‖ - δ)) • (1 : ClosedGeneratedByOne a) := by rw [neg_smul] + _ ≤ (-(‖x‖ - εm)) • (1 : ClosedGeneratedByOne a) := + smul_le_smul_of_nonneg_right hscalar IsOrderUnit.one_nonneg + _ = -((‖x‖ - εm) • (1 : ClosedGeneratedByOne a)) := by rw [neg_smul] + _ ≤ x := hlowerm + have hnorm : ‖x‖ ≤ ‖x‖ - δ := + (JBAlgebra.norm_le_iff_order_bounds (x := x) (r := ‖x‖ - δ) hnonneg).mpr + ⟨by simpa using hlower, hupper⟩ + linarith + +omit [JBAlgebra E] in +/-- The completion step for the endpoint binomial construction: if partial square roots converge +and their squares converge to the target, the limit is an actual square root. -/ +theorem exists_mul_self_of_tendsto_square {y : ClosedGeneratedByOne a} + (s : ℕ → ClosedGeneratedByOne a) {r : ClosedGeneratedByOne a} + (hs : Filter.Tendsto s Filter.atTop (𝓝 r)) + (hys : Filter.Tendsto (fun n ↦ s n * s n) Filter.atTop (𝓝 y)) : + ∃ r : ClosedGeneratedByOne a, r * r = y := by + refine ⟨r, ?_⟩ + exact tendsto_nhds_unique (hs.mul hs) hys + +/-- An element in the closed one-generator algebra is invertible whenever its distance from the +unit is strictly below one. This is the geometric-series step in the strict-positive-implies-unit +direction of the intrinsic JB spectral argument. -/ +theorem isUnit_of_norm_one_sub_lt (y : ClosedGeneratedByOne a) (hy : ‖1 - y‖ < 1) : IsUnit y := by + have hunit : IsUnit (1 - (1 - y)) := isUnit_one_sub_of_norm_lt_one hy + simpa using hunit + +/-- A strict order lower bound makes an element of a closed one-generator ordered JB algebra a +unit. The proof is intrinsic: rescale into the open unit ball using the B1 norm/order theorem, +then use the geometric series for `1 - z`. -/ +theorem isUnit_of_strictly_positive [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + {y : ClosedGeneratedByOne a} {ε : ℝ} (hε : 0 < ε) (hy : ε • (1 : ClosedGeneratedByOne a) ≤ y) : + IsUnit y := by + let M : ℝ := ‖y‖ + ε + 1 + have hM : 0 < M := by + dsimp [M] + positivity + have hMne : M ≠ 0 := ne_of_gt hM + have hyMnorm : ‖y‖ < M := by + dsimp [M] + linarith [norm_nonneg y, hε] + have hyM : y ≤ M • (1 : ClosedGeneratedByOne a) := + (JBAlgebra.norm_le_iff_order_bounds (x := y) (r := M) hM.le).mp hyMnorm.le |>.2 + have hinvM : 0 ≤ M⁻¹ := (inv_pos.mpr hM).le + have hscaled_lower := smul_le_smul_of_nonneg_left hy hinvM + have hscaled_lower' : (ε / M) • (1 : ClosedGeneratedByOne a) ≤ M⁻¹ • y := by + simpa [div_eq_mul_inv, smul_smul, mul_comm, mul_left_comm] using hscaled_lower + have hscaled_upper := smul_le_smul_of_nonneg_left hyM hinvM + have hscaled_upper' : M⁻¹ • y ≤ (1 : ClosedGeneratedByOne a) := by + simpa [smul_smul, hMne] using hscaled_upper + let z : ClosedGeneratedByOne a := 1 - M⁻¹ • y + have hz_nonneg : 0 ≤ z := sub_nonneg.mpr hscaled_upper' + have hz_upper : z ≤ (1 - ε / M) • (1 : ClosedGeneratedByOne a) := by + simpa [z, sub_smul] using sub_le_sub_left hscaled_lower' 1 + have hεM : ε / M < 1 := by + apply (div_lt_one₀ hM).mpr + dsimp [M] + linarith [norm_nonneg (y : E), hε] + have hc_nonneg : 0 ≤ 1 - ε / M := (sub_pos.mpr hεM).le + have hz_lower : -((1 - ε / M) • (1 : ClosedGeneratedByOne a)) ≤ z := by + calc + -((1 - ε / M) • (1 : ClosedGeneratedByOne a)) ≤ 0 := + neg_nonpos.mpr (smul_nonneg hc_nonneg IsOrderUnit.one_nonneg) + _ ≤ z := hz_nonneg + have hz_norm : ‖z‖ < 1 := + lt_of_le_of_lt + ((JBAlgebra.norm_le_iff_order_bounds (x := z) (r := 1 - ε / M) hc_nonneg).mpr + ⟨hz_lower, hz_upper⟩) (sub_lt_self 1 (div_pos hε hM)) + have hunit : IsUnit (1 - z) := isUnit_one_sub_of_norm_lt_one hz_norm + have hscaled_unit : IsUnit (M • (1 - z)) := by + simpa using IsUnit.smul (Units.mk0 M hMne) hunit + have hy_eq : M • (1 - z) = y := by + simp [z, smul_smul, hMne] + exact hy_eq ▸ hscaled_unit + +/-- The order interior of the local positive cone is exactly its positive unit locus. This is +the form of B2 used by the cone-boundary proof of the real JB spectral theorem. -/ +theorem isUnit_iff_mem_interior_positiveCone [Nontrivial E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + {y : ClosedGeneratedByOne a} (hy : 0 ≤ y) : + IsUnit y ↔ ∃ ε : ℝ, 0 < ε ∧ ε • (1 : ClosedGeneratedByOne a) ≤ y := by + constructor + · exact fun hu ↦ exists_pos_smul_one_le_of_isUnit_of_nonneg a hu hy + · rintro ⟨ε, hε, hεy⟩ + exact isUnit_of_strictly_positive a hε hεy + +/-- A completed square with nonzero scalar remainder is a unit. This is the local real-quadratic +lemma needed for reverse polynomial spectral mapping: irreducible real quadratic factors evaluate +to strictly positive units in the generated-one algebra. -/ +theorem isUnit_mul_self_sub_smul_one_add_sq_smul_one [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (x : ClosedGeneratedByOne a) (c d : ℝ) (hd : d ≠ 0) : + IsUnit ((x - c • (1 : ClosedGeneratedByOne a)) * (x - c • (1 : ClosedGeneratedByOne a)) + + d ^ 2 • (1 : ClosedGeneratedByOne a)) := by + apply isUnit_of_strictly_positive a (sq_pos_of_ne_zero hd) + exact le_add_of_nonneg_left (IsJordanOrderUnit.mul_self_nonneg _) + +/-- Polynomial-evaluation form of the completed-square unit lemma. -/ +theorem isUnit_aeval_completed_square [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (x : ClosedGeneratedByOne a) (c d : ℝ) (hd : d ≠ 0) : + IsUnit (Polynomial.aeval x ((Polynomial.X - Polynomial.C c) ^ 2 + Polynomial.C (d ^ 2))) := by + simpa [map_add, map_pow, map_sub, Polynomial.aeval_X, Polynomial.aeval_C, + Algebra.algebraMap_eq_smul_one, pow_two, ← smul_smul] using + isUnit_mul_self_sub_smul_one_add_sq_smul_one a x c d hd + +/-- If a unit is presented as a Jordan square, it has a positive inverse witness. This is the +algebraic half of the positive-unit direction; the endpoint square-root construction will supply +the square witness for an arbitrary positive element. -/ +theorem exists_nonneg_inverse_of_mul_self_isUnit [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + {s : ClosedGeneratedByOne a} (hs : IsUnit (s * s)) : + ∃ t : ClosedGeneratedByOne a, 0 ≤ t ∧ t * (s * s) = 1 := by + have hus : IsUnit s := isUnit_mul_self_iff.mp hs + let v : ClosedGeneratedByOne a := ↑(hus.unit⁻¹) + refine ⟨v * v, IsJordanOrderUnit.mul_self_nonneg v, ?_⟩ + calc + (v * v) * (s * s) = (v * s) * (v * s) := by ring + _ = 1 := by rw [show v * s = 1 by exact IsUnit.val_inv_mul hus]; simp + +end ClosedGeneratedByOne + +end JBAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/Spectrum.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/Spectrum.lean new file mode 100644 index 0000000000..cb5417551e --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/Spectrum.lean @@ -0,0 +1,403 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.GeneratedByOne.Closed +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.GeneratedByOne.Inherited +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.GeneratedByOne.PositiveInvertibility +public import Mathlib.Analysis.Normed.Algebra.Spectrum +public import Mathlib.Analysis.Polynomial.Factorization + +/-! + +# The canonical spectrum of one Jordan element + +## i. Overview + +The closed subalgebra generated by one element is an ordinary commutative associative normed real +algebra. Its usual algebraic spectrum therefore gives a canonical spectrum for that Jordan +element—there is no arbitrary set parameter and no dependence on a chosen Cstar realization. + +This is the sound domain for the eventual continuous functional calculus. The map from continuous +functions is intentionally not postulated here: its construction requires the JB spectral theorem. + +## ii. Key definitions and results + +- `NormedJordanAlgebra.closedGenerator` +- `NormedJordanAlgebra.jordanSpectrum` +- `NormedJordanAlgebra.isCompact_jordanSpectrum` + +## iii. Table of contents + +- A. The generator in its closed algebra +- B. The canonical spectrum + +-/ + +@[expose] public section + +namespace NormedJordanAlgebra + +variable {E : Type*} [NormedJordanAlgebra E] + +/-! ## A. The generator in its closed algebra -/ + +/-- The element `a`, bundled as an element of its own closed generated subalgebra. -/ +noncomputable def closedGenerator (a : E) : ClosedGeneratedByOne a := + ⟨a, self_mem_closedGeneratedByOne a⟩ + +@[simp] +theorem closedGenerator_val (a : E) : ((closedGenerator a : ClosedGeneratedByOne a) : E) = a := + rfl + +/-! ## B. The canonical spectrum -/ + +/-- The canonical real spectrum of a Jordan element: its ordinary spectrum inside the closed +commutative associative algebra generated by that element. -/ +noncomputable def jordanSpectrum (a : E) : Set ℝ := + spectrum ℝ (closedGenerator a) + +/-- The canonical spectrum of the zero observable is the singleton `{0}`. -/ +theorem jordanSpectrum_zero [Nontrivial E] : jordanSpectrum (0 : E) = ({0} : Set ℝ) := by + let : Nontrivial (ClosedGeneratedByOne (0 : E)) := + { exists_pair_ne := by + refine ⟨(0 : ClosedGeneratedByOne (0 : E)), (1 : ClosedGeneratedByOne (0 : E)), ?_⟩ + intro h + exact zero_ne_one (congrArg (fun x : ClosedGeneratedByOne (0 : E) => (x : E)) h) } + change spectrum ℝ (0 : ClosedGeneratedByOne (0 : E)) = ({0} : Set ℝ) + exact spectrum.zero_eq (𝕜 := ℝ) (A := ClosedGeneratedByOne (0 : E)) + +/-- Scalar multiples of the order unit have the expected singleton canonical spectrum. -/ +theorem jordanSpectrum_smul_one [Nontrivial E] (r : ℝ) : + jordanSpectrum (r • (1 : E)) = ({r} : Set ℝ) := by + let : Nontrivial (ClosedGeneratedByOne (r • (1 : E))) := + { exists_pair_ne := by + refine ⟨(0 : ClosedGeneratedByOne (r • (1 : E))), + (1 : ClosedGeneratedByOne (r • (1 : E))), ?_⟩ + intro h + exact zero_ne_one (congrArg + (fun x : ClosedGeneratedByOne (r • (1 : E)) => (x : E)) h) } + change spectrum ℝ (r • (1 : ClosedGeneratedByOne (r • (1 : E)))) = ({r} : Set ℝ) + rw [← Algebra.algebraMap_eq_smul_one] + exact spectrum.scalar_eq r + +/-- Polynomial spectral mapping is exact on scalar-unit observables. -/ +theorem jordanSpectrum_polynomial_smul_one [Nontrivial E] (r : ℝ) (p : Polynomial ℝ) : + (fun x => p.eval x) '' jordanSpectrum (r • (1 : E)) = ({p.eval r} : Set ℝ) := by + rw [jordanSpectrum_smul_one r, Set.image_singleton] + +/-- The canonical Jordan spectrum is compact. -/ +theorem isCompact_jordanSpectrum [CompleteSpace E] (a : E) : IsCompact (jordanSpectrum a) := + spectrum.isCompact (closedGenerator a) + +/-- The algebraic half of polynomial spectral mapping for the canonical Jordan spectrum. This +direction is available over the real field without a JB spectral theorem; the reverse inclusion +and the resulting norm identity require the nonempty real JB spectrum argument recorded in the +CFC audit. -/ +theorem jordanSpectrum_aeval_subset (a : E) (p : Polynomial ℝ) : + (fun x => p.eval x) '' jordanSpectrum a ⊆ + spectrum ℝ (Polynomial.aeval (closedGenerator a) p) := by + exact spectrum.subset_polynomial_aeval (closedGenerator a) p + +/-- The algebraic transport step for reverse real polynomial spectral mapping. If, after +subtracting a scalar value, all factors except one linear factor evaluate to units, then a +spectral value of the polynomial evaluation is already a spectral value of the generator. -/ +theorem mem_spectrum_of_aeval_factor (a : E) (x : ClosedGeneratedByOne a) + (p q r : Polynomial ℝ) (l μ : ℝ) + (hfactor : p - Polynomial.C μ = q * (Polynomial.X - Polynomial.C l) * r) + (hq : IsUnit (Polynomial.aeval x q)) (hr : IsUnit (Polynomial.aeval x r)) + (hμ : μ ∈ spectrum ℝ (Polynomial.aeval x p)) : l ∈ spectrum ℝ x := by + rw [spectrum.mem_iff] + intro hlin + have hlinear : IsUnit (Polynomial.aeval x (Polynomial.X - Polynomial.C l)) := by + have : IsUnit (-(Polynomial.aeval x (Polynomial.X - Polynomial.C l))) := by + simpa [map_sub, Polynomial.aeval_X, Polynomial.aeval_C, + Algebra.algebraMap_eq_smul_one, sub_eq_add_neg, add_comm] using hlin + exact (IsUnit.neg_iff _).mp this + have hprod : IsUnit (Polynomial.aeval x (p - Polynomial.C μ)) := by + rw [hfactor, Polynomial.aeval_mul, Polynomial.aeval_mul] + exact IsUnit.mul (IsUnit.mul hq hlinear) hr + have hsub : IsUnit (Polynomial.aeval x p - (algebraMap ℝ (ClosedGeneratedByOne a)) μ) := by + simpa [map_sub, Polynomial.aeval_C] using hprod + have hres : IsUnit ((algebraMap ℝ (ClosedGeneratedByOne a)) μ - Polynomial.aeval x p) := by + simpa [sub_eq_add_neg, add_comm] using hsub.neg + exact (spectrum.mem_iff.mp hμ) hres + +/-- Every monic irreducible real quadratic evaluates to a unit in the closed one-generator +ordered JB algebra. Its no-real-root property forces the remainder in its completed-square form +to be strictly positive, so B2 applies directly. -/ +theorem isUnit_aeval_of_irreducible_monic_degree_two [JBAlgebra E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (a : E) (x : ClosedGeneratedByOne a) (q : Polynomial ℝ) + (hq : Polynomial.IsMonicOfDegree q 2) (hirr : Irreducible q) : + IsUnit (Polynomial.aeval x q) := by + obtain ⟨b, c, hqform⟩ := Polynomial.isMonicOfDegree_two_iff'.mp hq + let e : ℝ := c - b ^ 2 / 4 + have he : 0 < e := by + by_contra hne + have hle : e ≤ 0 := le_of_not_gt hne + have hrad : 0 ≤ b ^ 2 / 4 - c := by dsimp [e] at hle; linarith + have hroot : q.IsRoot (b / 2 + Real.sqrt (b ^ 2 / 4 - c)) := by + change Polynomial.eval (b / 2 + Real.sqrt (b ^ 2 / 4 - c)) q = 0 + rw [hqform] + simp only [Polynomial.eval_add, Polynomial.eval_sub, Polynomial.eval_pow, + Polynomial.eval_C, Polynomial.eval_X, Polynomial.eval_mul] + nlinarith [Real.sq_sqrt hrad] + exact (hirr.not_isRoot_of_natDegree_ne_one (by simp [hq.natDegree_eq]) hroot) + let d : ℝ := Real.sqrt e + have hd : d ≠ 0 := ne_of_gt (by dsimp [d]; exact Real.sqrt_pos.2 he) + have hlinear : Polynomial.C (b / 2) * 2 = Polynomial.C b := by + change Polynomial.C (b / 2) * Polynomial.C 2 = Polynomial.C b + rw [← Polynomial.C_mul] + congr 1 + field_simp + have hconstant : Polynomial.C (b / 2) ^ 2 = Polynomial.C (b ^ 2 / 4) := by + rw [← Polynomial.C_pow] + congr 1 + field_simp + ring + have hqcompleted : q = (Polynomial.X - Polynomial.C (b / 2)) ^ 2 + Polynomial.C (d ^ 2) := by + rw [hqform] + dsimp [d] + rw [Real.sq_sqrt he.le] + dsimp [e] + rw [Polynomial.C_sub, ← hlinear, ← hconstant] + ring + rw [hqcompleted] + exact JBAlgebra.ClosedGeneratedByOne.isUnit_aeval_completed_square a x (b / 2) d hd + +/-- A nonunit evaluation of a monic linear polynomial directly exposes its real spectral root. -/ +theorem exists_mem_spectrum_of_not_isUnit_aeval_monic_degree_one (a : E) + (x : ClosedGeneratedByOne a) (q : Polynomial ℝ) + (hq : Polynomial.IsMonicOfDegree q 1) (hnu : ¬ IsUnit (Polynomial.aeval x q)) : + ∃ l : ℝ, l ∈ spectrum ℝ x ∧ q.eval l = 0 := by + obtain ⟨c, hqform⟩ := Polynomial.isMonicOfDegree_one_iff.mp hq + refine ⟨-c, ?_, ?_⟩ + · rw [spectrum.mem_iff] + intro hunit + apply hnu + have hneg : IsUnit (-(Polynomial.aeval x (Polynomial.X + Polynomial.C c))) := by + simpa [Polynomial.aeval_X, Polynomial.aeval_C, Algebra.algebraMap_eq_smul_one, + sub_eq_add_neg, add_comm] using hunit + simpa [hqform] using (IsUnit.neg_iff _).mp hneg + · rw [hqform] + simp + +/-- A nonunit value of a monic real polynomial has a real spectral root. The proof is strong +induction on degree: a monic irreducible factor has degree one or two; B4's quadratic theorem +rules out the second case, while the first supplies the spectral root. -/ +theorem exists_mem_spectrum_of_not_isUnit_aeval_monic [JBAlgebra E] + [PartialOrder E] [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] + [IsJBOrderUnit E] (a : E) (x : ClosedGeneratedByOne a) (f : Polynomial ℝ) + (hf : f.Monic) (hnu : ¬ IsUnit (Polynomial.aeval x f)) : + ∃ l : ℝ, l ∈ spectrum ℝ x ∧ f.eval l = 0 := by + let P : ℕ → Prop := fun n ↦ ∀ g : Polynomial ℝ, g.natDegree = n → g.Monic → + ¬ IsUnit (Polynomial.aeval x g) → ∃ l : ℝ, l ∈ spectrum ℝ x ∧ g.eval l = 0 + have hP : ∀ n, P n := by + intro n + induction n using Nat.strong_induction_on with + | h n ih => + intro g hgn hg hgnu + have hfnunit : ¬ IsUnit g := by + intro hfu + exact hgnu (hfu.map (Polynomial.aeval x)) + obtain ⟨q, hqmonic, hqirr, r, hfr⟩ := Polynomial.exists_monic_irreducible_factor g hfnunit + have hfrmonic : r.Monic := hqmonic.of_mul_monic_left (hfr ▸ hg) + have hqpos : 0 < q.natDegree := hqirr.natDegree_pos + have hqle : q.natDegree ≤ 2 := hqirr.natDegree_le_two + have hqcases : q.natDegree = 1 ∨ q.natDegree = 2 := by omega + have hrlt : r.natDegree < n := by + calc + r.natDegree < q.natDegree + r.natDegree := Nat.lt_add_of_pos_left hqpos + _ = g.natDegree := by rw [hfr, hqmonic.natDegree_mul' hfrmonic.ne_zero] + _ = n := hgn + have hprod : ¬ (IsUnit (Polynomial.aeval x q) ∧ IsUnit (Polynomial.aeval x r)) := by + rintro ⟨hqu, hru⟩ + apply hgnu + rw [hfr, Polynomial.aeval_mul] + exact hqu.mul hru + rcases hqcases with hqone | hqtwo + · have hqdeg : Polynomial.IsMonicOfDegree q 1 := ⟨hqone, hqmonic⟩ + by_cases hqu : IsUnit (Polynomial.aeval x q) + · have hrunu : ¬ IsUnit (Polynomial.aeval x r) := fun hru ↦ hprod ⟨hqu, hru⟩ + obtain ⟨l, hlspec, hrl⟩ := ih r.natDegree hrlt r rfl hfrmonic hrunu + refine ⟨l, hlspec, ?_⟩ + rw [hfr, Polynomial.eval_mul, hrl, mul_zero] + · obtain ⟨l, hlspec, hql⟩ := + exists_mem_spectrum_of_not_isUnit_aeval_monic_degree_one a x q hqdeg hqu + refine ⟨l, hlspec, ?_⟩ + rw [hfr, Polynomial.eval_mul, hql, zero_mul] + · have hqdeg : Polynomial.IsMonicOfDegree q 2 := ⟨hqtwo, hqmonic⟩ + have hqu : IsUnit (Polynomial.aeval x q) := + isUnit_aeval_of_irreducible_monic_degree_two a x q hqdeg hqirr + have hrunu : ¬ IsUnit (Polynomial.aeval x r) := fun hru ↦ hprod ⟨hqu, hru⟩ + obtain ⟨l, hlspec, hrl⟩ := ih r.natDegree hrlt r rfl hfrmonic hrunu + refine ⟨l, hlspec, ?_⟩ + rw [hfr, Polynomial.eval_mul, hrl, mul_zero] + exact hP f.natDegree f rfl hf hnu + +end NormedJordanAlgebra + +namespace JBAlgebra + +variable {E : Type*} [NormedJordanAlgebra E] [JBAlgebra E] + +open NormedJordanAlgebra + +namespace ClosedGeneratedByOne + +variable (a : E) + +/-- The intrinsic real JB spectral endpoint theorem. The two order-norm endpoints cannot both +be units by the local exact-cone/interior argument, so one of their scalars is in the ordinary +real spectrum of the commutative algebra generated by `a`. -/ +theorem norm_or_neg_norm_mem_spectrum [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (x : ClosedGeneratedByOne a) : + ‖x‖ ∈ spectrum ℝ x ∨ -‖x‖ ∈ spectrum ℝ x := by + by_cases hp : IsUnit (‖x‖ • (1 : ClosedGeneratedByOne a) - x) + · right + rw [spectrum.mem_iff] + intro hm + apply not_isUnit_norm_smul_one_sub_and_add a x + refine ⟨hp, ?_⟩ + have hm' : IsUnit (-(‖x‖ • (1 : ClosedGeneratedByOne a) + x)) := by + simpa [Algebra.algebraMap_eq_smul_one, smul_add, sub_eq_add_neg, add_comm, add_left_comm, + add_assoc] using hm + exact (IsUnit.neg_iff _).mp hm' + · left + rw [spectrum.mem_iff] + simpa [Algebra.algebraMap_eq_smul_one] using hp + +/-- In a closed one-generator ordered JB algebra, the real spectral radius is exactly the JB +norm. The generic upper bound is met by one of the two real norm endpoints. -/ +theorem jordanSpectralRadius_eq_norm [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (x : ClosedGeneratedByOne a) : spectralRadius ℝ x = (‖x‖₊ : ENNReal) := by + apply le_antisymm + · exact spectralRadius_le_norm a x + · rcases norm_or_neg_norm_mem_spectrum a x with hx | hx + · calc + (‖x‖₊ : ENNReal) = ‖(‖x‖ : ℝ)‖₊ := by rw [nnnorm_norm] + _ ≤ spectralRadius ℝ x := le_iSup₂ (α := ENNReal) (‖x‖ : ℝ) hx + · calc + (‖x‖₊ : ENNReal) = ‖(-‖x‖ : ℝ)‖₊ := by simp only [nnnorm_neg, nnnorm_norm] + _ ≤ spectralRadius ℝ x := le_iSup₂ (α := ENNReal) (-‖x‖ : ℝ) hx + +end ClosedGeneratedByOne + +end JBAlgebra + +namespace NormedJordanAlgebra + +variable {E : Type*} [NormedJordanAlgebra E] [JBAlgebra E] + +/-- The canonical real spectrum of every ordered JB observable is nonempty. -/ +theorem jordanSpectrum_nonempty [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) : + (jordanSpectrum a).Nonempty := by + rcases JBAlgebra.ClosedGeneratedByOne.norm_or_neg_norm_mem_spectrum a (closedGenerator a) + with h | h + · exact ⟨‖closedGenerator a‖, h⟩ + · exact ⟨-‖closedGenerator a‖, h⟩ + +/-- The canonical real spectrum of a positive JB observable is nonnegative. A negative scalar +is excluded intrinsically because subtracting it is a strictly positive element of the closed +one-generator algebra, hence a unit. -/ +theorem nonneg_of_mem_jordanSpectrum [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] {a : E} (ha : 0 ≤ a) + {r : ℝ} (hr : r ∈ jordanSpectrum a) : 0 ≤ r := by + by_contra hrnonneg + have hrneg : r < 0 := lt_of_not_ge hrnonneg + have hgenerator : 0 ≤ closedGenerator a := ha + have hbound : (-r) • (1 : ClosedGeneratedByOne a) ≤ closedGenerator a - + r • (1 : ClosedGeneratedByOne a) := by + rw [sub_eq_add_neg, ← neg_smul] + exact le_add_of_nonneg_left hgenerator + have hunit : IsUnit (closedGenerator a - r • (1 : ClosedGeneratedByOne a)) := + JBAlgebra.ClosedGeneratedByOne.isUnit_of_strictly_positive a (neg_pos.mpr hrneg) hbound + change r ∈ spectrum ℝ (closedGenerator a) at hr + rw [spectrum.mem_iff] at hr + apply hr + simpa [Algebra.algebraMap_eq_smul_one, sub_eq_add_neg, add_comm] using hunit.neg + +/-- The reverse real polynomial spectral-mapping direction in the generated-one JB algebra. -/ +theorem exists_mem_spectrum_of_mem_spectrum_aeval [Nontrivial E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (a : E) (x : ClosedGeneratedByOne a) (p : Polynomial ℝ) (μ : ℝ) + (hμ : μ ∈ spectrum ℝ (Polynomial.aeval x p)) : + ∃ l : ℝ, l ∈ spectrum ℝ x ∧ p.eval l = μ := by + let f : Polynomial ℝ := p - Polynomial.C μ + have hfnu : ¬ IsUnit (Polynomial.aeval x f) := by + intro hfu + apply (spectrum.mem_iff.mp hμ) + have hsub : IsUnit (Polynomial.aeval x p - (algebraMap ℝ (ClosedGeneratedByOne a)) μ) := by + simpa [f, map_sub, Polynomial.aeval_C] using hfu + simpa [sub_eq_add_neg, add_comm] using hsub.neg + by_cases hfzero : f = 0 + · obtain hx | hx := JBAlgebra.ClosedGeneratedByOne.norm_or_neg_norm_mem_spectrum a x + · refine ⟨‖x‖, hx, ?_⟩ + have hzeroeval : f.eval ‖x‖ = 0 := by simpa using congrArg (Polynomial.eval ‖x‖) hfzero + exact sub_eq_zero.mp (by simpa [f, Polynomial.eval_sub, Polynomial.eval_C] using hzeroeval) + · refine ⟨-‖x‖, hx, ?_⟩ + have hzeroeval : f.eval (-‖x‖ : ℝ) = 0 := + by simpa using congrArg (Polynomial.eval (-‖x‖ : ℝ)) hfzero + exact sub_eq_zero.mp (by simpa [f, Polynomial.eval_sub, Polynomial.eval_C] using hzeroeval) + · let g : Polynomial ℝ := f * Polynomial.C f.leadingCoeff⁻¹ + have hgmonic : g.Monic := Polynomial.monic_mul_leadingCoeff_inv hfzero + have hgnu : ¬ IsUnit (Polynomial.aeval x g) := by + intro hgu + apply hfnu + have hprod : IsUnit (Polynomial.aeval x f * + (algebraMap ℝ (ClosedGeneratedByOne a)) f.leadingCoeff⁻¹) := by + simpa [g, Polynomial.aeval_mul, Polynomial.aeval_C] using hgu + exact (IsUnit.mul_iff.mp hprod).1 + obtain ⟨l, hlspec, hgl⟩ := + exists_mem_spectrum_of_not_isUnit_aeval_monic a x g hgmonic hgnu + have hinv : f.leadingCoeff⁻¹ ≠ 0 := inv_ne_zero (Polynomial.leadingCoeff_ne_zero.mpr hfzero) + have hfl : f.eval l = 0 := by + have hprod : f.eval l * f.leadingCoeff⁻¹ = 0 := by + simpa [g, Polynomial.eval_mul, Polynomial.eval_C] using hgl + exact (mul_eq_zero.mp hprod).resolve_right hinv + refine ⟨l, hlspec, ?_⟩ + exact sub_eq_zero.mp (by simpa [f, Polynomial.eval_sub, Polynomial.eval_C] using hfl) + +/-- Exact real polynomial spectral mapping for the canonical spectrum of a JB observable. -/ +theorem jordanSpectrum_aeval [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (a : E) (p : Polynomial ℝ) : + (fun t ↦ p.eval t) '' jordanSpectrum a = + spectrum ℝ (Polynomial.aeval (closedGenerator a) p) := by + apply Set.Subset.antisymm + · exact jordanSpectrum_aeval_subset a p + · intro μ hμ + obtain ⟨l, hl, hpl⟩ := + exists_mem_spectrum_of_mem_spectrum_aeval a (closedGenerator a) p μ hμ + exact ⟨l, hl, hpl⟩ + +/-- The JB norm of polynomial evaluation is the real spectral supremum of the corresponding +restricted polynomial. This is the order-theoretic isometry statement prior to bundling the +continuous polynomial function in B5. -/ +theorem nnnorm_aeval_closedGenerator [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (a : E) (p : Polynomial ℝ) : + (‖Polynomial.aeval (closedGenerator a) p‖₊ : ENNReal) = + ⨆ l ∈ jordanSpectrum a, (‖p.eval l‖₊ : ENNReal) := by + rw [← JBAlgebra.ClosedGeneratedByOne.jordanSpectralRadius_eq_norm a + (Polynomial.aeval (closedGenerator a) p)] + unfold spectralRadius + rw [← jordanSpectrum_aeval a p, iSup_image] + +/-- Norm form of the polynomial-evaluation isometry, expressed in `ℝ≥0∞` so that the spectral +supremum is total. -/ +theorem norm_aeval_closedGenerator [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (a : E) (p : Polynomial ℝ) : + (‖Polynomial.aeval (closedGenerator a) p‖₊ : ENNReal) = + ⨆ l ∈ jordanSpectrum a, (‖p.eval l‖₊ : ENNReal) := by + exact nnnorm_aeval_closedGenerator a p + +end NormedJordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/SquareRootUniqueness.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/SquareRootUniqueness.lean new file mode 100644 index 0000000000..31c396843b --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/SquareRootUniqueness.lean @@ -0,0 +1,301 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.GeneratedByOne.ContinuousFunctionalCalculus + +/-! + +# Uniqueness of the positive square root + +## i. Overview + +`jordanSqrt_eq_of_mem_closedGeneratedByOne` (`ContinuousFunctionalCalculus.lean`) only proves +uniqueness of the canonical positive square root among roots already known to lie in +`ClosedGeneratedByOne a`. This file removes that restriction: it proves that **every** nonnegative +`b` with `b * b = a` equals `jordanSqrt a ha`, for `b` an arbitrary element of the ambient JB +algebra. + +The genuinely multielement obstruction is that `b` is a priori unrelated to `ClosedGeneratedByOne +a`; it is not smuggled in by treating `a` and `b` as if they already lay in one common associative +algebra. The argument instead uses a single algebraic identity that is *ambient-independent*: +evaluating a real polynomial `p` at an element by repeated Jordan multiplication produces an +answer depending only on that element's value in `E`, never on which enveloping closed +one-generator algebra it is regarded as living in (`aevalCoe_eq_jordanPolyEval`). Consequently, for +every real polynomial `p`, + +```text +jordanPolyEval b (p.comp (X ^ 2)) = jordanPolyEval (b * b) p = jordanPolyEval a p, +``` + +purely algebraically, with no reference to any spectral or order theory. The two sides are then +independently approximated: on the left, using only `b`'s own polynomial functional calculus and +`b ≥ 0`, `p.comp (X ^ 2)` evaluated at `b` approximates `b` itself; on the right, using only `a`'s +own calculus and `a ≥ 0`, `p` evaluated at `a` approximates `jordanSqrt a ha`. Because the exact +algebraic identity forces the two approximating quantities to coincide term by term, the two limits +coincide, giving `b = jordanSqrt a ha`. + +## ii. Key definitions and results + +- `NormedJordanAlgebra.jordanPolyEval` +- `NormedJordanAlgebra.aevalCoe_eq_jordanPolyEval` +- `NormedJordanAlgebra.jordanPolyEval_comp_sq` +- `NormedJordanAlgebra.jordanSqrt_eq_of_nonneg_of_mul_self` +- `NormedJordanAlgebra.eq_of_nonneg_of_mul_self_eq_mul_self` + +## iii. Table of contents + +- A. The ambient-independent polynomial evaluation +- B. Approximation of the polynomial calculus +- C. Uniform polynomial approximation of the square root +- D. Unrestricted uniqueness of the positive square root + +-/ + +@[expose] public section + +namespace NormedJordanAlgebra + +open scoped JordanAlgebra + +/-! ## A. The ambient-independent polynomial evaluation -/ + +variable {E : Type*} [NormedJordanAlgebra E] + +/-- Evaluate a real polynomial at a Jordan element by repeated Jordan multiplication. Unlike +`Polynomial.aeval (closedGenerator x) p`, this definition makes no reference to any particular +closed one-generator algebra: it is visibly a function of `x` and `p` alone. -/ +def jordanPolyEval (x : E) (p : Polynomial ℝ) : E := + ∑ i ∈ Finset.range (p.natDegree + 1), p.coeff i • x ^[i] + +/-- Polynomial evaluation inside *any* closed one-generator algebra containing `x` coerces to +`jordanPolyEval (x : E) p`. This is the ambient-independence lemma: the two sides of +`Polynomial.aeval x p = Polynomial.aeval y p` for `x`, `y` living in different closed +one-generator algebras but sharing the same ambient value are forced to agree, because both equal +the same `jordanPolyEval`. -/ +theorem aevalCoe_eq_jordanPolyEval {u : E} (x : ClosedGeneratedByOne u) (p : Polynomial ℝ) : + (Polynomial.aeval x p : E) = jordanPolyEval (x : E) p := by + rw [Polynomial.aeval_eq_sum_range] + unfold jordanPolyEval + rw [AddSubmonoidClass.coe_finsetSum] + refine Finset.sum_congr rfl fun i _ => ?_ + rw [SetLike.val_smul, ClosedGeneratedByOne.pow_val] + +/-- `jordanPolyEval` is additive in the polynomial argument. -/ +theorem jordanPolyEval_add (x : E) (p q : Polynomial ℝ) : + jordanPolyEval x (p + q) = jordanPolyEval x p + jordanPolyEval x q := by + have h : ∀ (u : E) (r : Polynomial ℝ), + jordanPolyEval u r = (Polynomial.aeval (closedGenerator u) r : E) := fun u r => + (aevalCoe_eq_jordanPolyEval (closedGenerator u) r).symm + rw [h x p, h x q, h x (p + q), map_add] + rfl + +/-- The key algebraic identity behind square-root uniqueness: substituting `X ^ 2` before +evaluating at `v` agrees with evaluating directly at `v * v`. This is a purely algebraic identity, +with no order or norm hypothesis on `v`. -/ +theorem jordanPolyEval_comp_sq (v : E) (p : Polynomial ℝ) : + jordanPolyEval v (p.comp (Polynomial.X ^ 2)) = jordanPolyEval (v * v) p := by + have h1 : jordanPolyEval v (p.comp (Polynomial.X ^ 2)) = + (Polynomial.aeval (closedGenerator v) (p.comp (Polynomial.X ^ 2)) : E) := + (aevalCoe_eq_jordanPolyEval (closedGenerator v) _).symm + rw [h1, Polynomial.aeval_comp] + set w : ClosedGeneratedByOne v := + Polynomial.aeval (closedGenerator v) ((Polynomial.X : Polynomial ℝ) ^ 2) + with hw + have hwval : (w : E) = v * v := by + rw [hw, Polynomial.aeval_X_pow, ClosedGeneratedByOne.pow_val, closedGenerator_val, + JordanAlgebra.jpow_two] + rw [aevalCoe_eq_jordanPolyEval w p, hwval] + +/-! ## B. Approximation of the polynomial calculus -/ + +variable [JBAlgebra E] + +/-- `jordanCfc` applied to a polynomial function is exactly `jordanPolyEval` at the same +polynomial. This connects the ambient-independent algebraic evaluation of §A to the intrinsic +continuous functional calculus. -/ +theorem jordanCfc_toContinuousMapOnAlgHom [Nontrivial E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] (a : E) (p : Polynomial ℝ) : + jordanCfc a (Polynomial.toContinuousMapOnAlgHom (jordanSpectrum a) p) = jordanPolyEval a p := by + have hmem : Polynomial.toContinuousMapOnAlgHom (jordanSpectrum a) p ∈ + (polynomialFunctions (jordanSpectrum a) : Set C(jordanSpectrum a, ℝ)) := by + rw [polynomialFunctions_coe] + exact ⟨p, rfl⟩ + let f : polynomialFunctions (jordanSpectrum a) := + ⟨Polynomial.toContinuousMapOnAlgHom (jordanSpectrum a) p, hmem⟩ + have hf : jordanCfc a (f : C(jordanSpectrum a, ℝ)) = jordanCfcLinear a f := rfl + have heq : Polynomial.toContinuousMapOnAlgHom (jordanSpectrum a) + (polynomialRepresentative a f) = Polynomial.toContinuousMapOnAlgHom (jordanSpectrum a) p := + toContinuousMapOn_polynomialRepresentative a f + have haeval : Polynomial.aeval (closedGenerator a) (polynomialRepresentative a f) = + Polynomial.aeval (closedGenerator a) p := + aeval_closedGenerator_eq_of_toContinuousMapOn_eq a heq + show jordanCfc a (f : C(jordanSpectrum a, ℝ)) = jordanPolyEval a p + rw [hf, jordanCfcLinear_eq_polynomialCfcLinearMap] + show (Polynomial.aeval (closedGenerator a) (polynomialRepresentative a f) : E) = + jordanPolyEval a p + rw [haeval, aevalCoe_eq_jordanPolyEval, closedGenerator_val] + +/-- Norm bound transporting a uniform polynomial approximation of a continuous target function +into a norm bound between `jordanPolyEval` and the intrinsic calculus. -/ +theorem norm_jordanPolyEval_sub_jordanCfc_le [Nontrivial E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (a : E) (p : Polynomial ℝ) (F : C(jordanSpectrum a, ℝ)) {δ : ℝ} (hδ : 0 ≤ δ) + (hbound : ∀ x : jordanSpectrum a, |p.eval (x : ℝ) - F x| ≤ δ) : + ‖jordanPolyEval a p - jordanCfc a F‖ ≤ δ := by + rw [← jordanCfc_toContinuousMapOnAlgHom a p, ← jordanCfc_sub] + rw [show ‖jordanCfc a (Polynomial.toContinuousMapOnAlgHom (jordanSpectrum a) p - F)‖ = + ‖Polynomial.toContinuousMapOnAlgHom (jordanSpectrum a) p - F‖ from norm_jordanCfc a _] + rw [ContinuousMap.norm_le _ hδ] + intro x + have hval : (Polynomial.toContinuousMapOnAlgHom (jordanSpectrum a) p - F) x = + p.eval (x : ℝ) - F x := by + simp [Polynomial.toContinuousMapOnAlgHom_apply, Polynomial.toContinuousMapOn_apply, + Polynomial.toContinuousMap_apply] + rw [hval, Real.norm_eq_abs] + exact hbound x + +/-! ## C. Uniform polynomial approximation of the square root -/ + +/-- Every polynomial function on a compact real interval `[0, M]` extends to a global real +polynomial. This is the interval specialization of the general fact used for `jordanSpectrum`. -/ +private theorem exists_polynomialRepresentative_of_mem {s : Set ℝ} {g : C(s, ℝ)} + (hg : g ∈ (polynomialFunctions s : Set C(s, ℝ))) : + ∃ p : Polynomial ℝ, Polynomial.toContinuousMapOnAlgHom s p = g := by + rwa [polynomialFunctions_coe] at hg + +/-- Classical uniform polynomial approximation of the real square root on a compact interval +`[0, M]`. This is ordinary Stone--Weierstrass applied on a fixed real interval, entirely +independent of any Jordan spectrum. -/ +private theorem exists_polynomial_approx_sqrt (M : ℝ) (ε : ℝ) (hε : 0 < ε) : + ∃ p : Polynomial ℝ, ∀ s ∈ Set.Icc (0 : ℝ) M, |p.eval s - Real.sqrt s| < ε := by + have hcs : CompactSpace (Set.Icc (0 : ℝ) M) := isCompact_iff_compactSpace.mp isCompact_Icc + set K : Set ℝ := Set.Icc (0 : ℝ) M with hK + let f : C(K, ℝ) := ⟨fun x => Real.sqrt (x : ℝ), Real.continuous_sqrt.comp continuous_subtype_val⟩ + have hdense : Dense (polynomialFunctions K : Set C(K, ℝ)) := by + rw [dense_iff_closure_eq] + have h := congrArg (fun A : Subalgebra ℝ C(K, ℝ) => (A : Set C(K, ℝ))) + (polynomialFunctions.topologicalClosure K) + change closure ↑(polynomialFunctions K) = ((⊤ : Subalgebra ℝ C(K, ℝ)) : Set C(K, ℝ)) + simpa only [Subalgebra.topologicalClosure_coe] using h + obtain ⟨g, hgmem, hgdist⟩ := Metric.mem_closure_iff.mp (hdense f) ε hε + obtain ⟨p, hp⟩ := exists_polynomialRepresentative_of_mem hgmem + refine ⟨p, fun s hs => ?_⟩ + have hlt : ‖f - g‖ < ε := by rwa [dist_eq_norm] at hgdist + have hpt : ‖(f - g) (⟨s, hs⟩ : K)‖ < ε := lt_of_le_of_lt (ContinuousMap.norm_coe_le_norm _ _) hlt + have heval : g (⟨s, hs⟩ : K) = p.eval s := by + rw [← hp] + simp [Polynomial.toContinuousMapOnAlgHom_apply, Polynomial.toContinuousMapOn_apply, + Polynomial.toContinuousMap_apply] + have hval : (f - g) (⟨s, hs⟩ : K) = Real.sqrt s - p.eval s := by + change f (⟨s, hs⟩ : K) - g (⟨s, hs⟩ : K) = Real.sqrt s - p.eval s + rw [heval] + rfl + rw [hval, Real.norm_eq_abs, abs_sub_comm] at hpt + exact hpt + +/-! ## D. Unrestricted uniqueness of the positive square root -/ + +/-- **Uniqueness of the positive square root, among arbitrary nonnegative elements of the +ambient JB algebra.** This removes the restriction in +`jordanSqrt_eq_of_mem_closedGeneratedByOne`, which only handled roots already known to lie in +`ClosedGeneratedByOne a`. The proof is genuinely multielement: it relates `a` and `b` only through +the ambient-independent algebraic identity `jordanPolyEval_comp_sq`, then closes an `ε`-argument +using each element's own, separately constructed, polynomial functional calculus. -/ +theorem jordanSqrt_eq_of_nonneg_of_mul_self [Nontrivial E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + (a : E) (ha : 0 ≤ a) (b : E) (hb0 : 0 ≤ b) (hb : b * b = a) : + b = jordanSqrt a ha := by + rw [← sub_eq_zero, ← norm_eq_zero (E := E)] + by_contra hne + set δ₀ : ℝ := ‖b - jordanSqrt a ha‖ with hδ₀ + have hδpos : 0 < δ₀ := lt_of_le_of_ne (norm_nonneg _) (Ne.symm hne) + set ε : ℝ := δ₀ / 3 with hεdef + have hεpos : 0 < ε := by positivity + set M : ℝ := ‖a‖ with hM + have hMnonneg : 0 ≤ M := norm_nonneg a + have hbsq : ‖b‖ * ‖b‖ = M := by + rw [hM, ← hb, JBAlgebra.norm_mul_self b, sq] + obtain ⟨p, hp⟩ := exists_polynomial_approx_sqrt M ε hεpos + set q : Polynomial ℝ := p.comp (Polynomial.X ^ 2) with hq + -- The two sides are algebraically identical. + have halg : jordanPolyEval b q = jordanPolyEval a p := by + rw [hq, jordanPolyEval_comp_sq, hb] + -- The `b`-side approximates `b` itself, using only `b`'s own spectrum. + have hbspec : ∀ x : jordanSpectrum b, 0 ≤ (x : ℝ) := fun x => nonneg_of_mem_jordanSpectrum hb0 x.2 + have hbnorm : ∀ x : jordanSpectrum b, |x.1| ≤ ‖b‖ := by + intro x + have hxmem : x.1 ∈ spectrum ℝ (closedGenerator b) := x.2 + have := spectrum.norm_le_norm_of_mem (𝕜 := ℝ) hxmem + simpa using this + have hbbound : ∀ x : jordanSpectrum b, + |q.eval (x : ℝ) - (ContinuousMap.restrict (jordanSpectrum b) (.id ℝ)) x| ≤ ε := by + intro x + have hx0 : (0 : ℝ) ≤ (x : ℝ) := hbspec x + have hxb : (x : ℝ) ≤ ‖b‖ := (abs_le.mp (hbnorm x)).2 + have hqx : q.eval (x : ℝ) = p.eval ((x : ℝ) ^ 2) := by + simp [hq, Polynomial.eval_comp] + have hxsq : (x : ℝ) ^ 2 ∈ Set.Icc (0 : ℝ) M := by + refine ⟨by positivity, ?_⟩ + rw [← hbsq, sq] + exact mul_le_mul hxb hxb hx0 (norm_nonneg b) + have hlt := hp ((x : ℝ) ^ 2) hxsq + have hsqrt : Real.sqrt ((x : ℝ) ^ 2) = (x : ℝ) := Real.sqrt_sq hx0 + have hidval : (ContinuousMap.restrict (jordanSpectrum b) (.id ℝ)) x = (x : ℝ) := rfl + rw [hqx, hidval] + rw [hsqrt] at hlt + exact le_of_lt hlt + have hbapprox : ‖jordanPolyEval b q - + jordanCfc b (ContinuousMap.restrict (jordanSpectrum b) (.id ℝ))‖ ≤ ε := + norm_jordanPolyEval_sub_jordanCfc_le b q _ hεpos.le hbbound + rw [jordanCfc_id] at hbapprox + -- The `a`-side approximates `jordanSqrt a ha`, using only `a`'s own spectrum. + have haspec : ∀ x : jordanSpectrum a, 0 ≤ (x : ℝ) := fun x => nonneg_of_mem_jordanSpectrum ha x.2 + have hanorm : ∀ x : jordanSpectrum a, |x.1| ≤ M := by + intro x + have hxmem : x.1 ∈ spectrum ℝ (closedGenerator a) := x.2 + have := spectrum.norm_le_norm_of_mem (𝕜 := ℝ) hxmem + simpa [hM] using this + have habound : ∀ x : jordanSpectrum a, + |p.eval (x : ℝ) - jordanSpectrumSqrt a x| ≤ ε := by + intro x + have hx0 : (0 : ℝ) ≤ (x : ℝ) := haspec x + have hxM : (x : ℝ) ≤ M := (abs_le.mp (hanorm x)).2 + have hxIcc : (x : ℝ) ∈ Set.Icc (0 : ℝ) M := ⟨hx0, hxM⟩ + have hlt := hp (x : ℝ) hxIcc + have hidval : jordanSpectrumSqrt a x = Real.sqrt (x : ℝ) := rfl + rw [hidval] + exact le_of_lt hlt + have haapprox : ‖jordanPolyEval a p - jordanCfc a (jordanSpectrumSqrt a)‖ ≤ ε := + norm_jordanPolyEval_sub_jordanCfc_le a p _ hεpos.le habound + have hsqrtdef : jordanCfc a (jordanSpectrumSqrt a) = jordanSqrt a ha := rfl + rw [hsqrtdef] at haapprox + -- Combine: `b` and `jordanSqrt a ha` are each within `ε` of the same quantity. + rw [← halg] at haapprox + have htri : ‖b - jordanSqrt a ha‖ ≤ + ‖b - jordanPolyEval b q‖ + ‖jordanPolyEval b q - jordanSqrt a ha‖ := by + have hsplit : b - jordanSqrt a ha = + (b - jordanPolyEval b q) + (jordanPolyEval b q - jordanSqrt a ha) := by + abel + rw [hsplit] + exact norm_add_le _ _ + have hb' : ‖b - jordanPolyEval b q‖ ≤ ε := by + rwa [norm_sub_rev] at hbapprox + have h2 : ‖jordanPolyEval b q - jordanSqrt a ha‖ ≤ ε := haapprox + have hfinal : δ₀ ≤ ε + ε := hδ₀ ▸ le_trans htri (add_le_add hb' h2) + rw [hεdef] at hfinal + linarith + +/-- Uniqueness of the positive square root, restated as equality of two arbitrary nonnegative +roots of the same element. -/ +theorem eq_of_nonneg_of_mul_self_eq_mul_self [Nontrivial E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + {a b c : E} (hb0 : 0 ≤ b) (hc0 : 0 ≤ c) (hb : b * b = a) (hc : c * c = a) : b = c := by + have ha : 0 ≤ a := hb ▸ IsJordanOrderUnit.mul_self_nonneg b + rw [jordanSqrt_eq_of_nonneg_of_mul_self a ha b hb0 hb, + jordanSqrt_eq_of_nonneg_of_mul_self a ha c hc0 hc] + +end NormedJordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/Uniform.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/Uniform.lean new file mode 100644 index 0000000000..4b0c14f321 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/Uniform.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.GeneratedByOne.Inherited +public import Mathlib.Analysis.Normed.Algebra.Spectrum + +/-! + +# Uniform norm on the closed algebra generated by one JB element + +The closed algebra generated by one element is more than a commutative real Banach algebra. The +JB square axiom restricts to it, so its norm is uniform: `‖x²‖ = ‖x‖²`. Iteration along powers of +two is the analytic input needed to identify norm and spectral radius once real-spectrum +nonemptiness is established. + +This layer deliberately stops before asserting spectrum nonemptiness. That statement is false +for general real Banach algebras and must be proved from the JB-specific uniform/order structure. + +-/ + +@[expose] public section + +namespace JBAlgebra + +variable {E : Type*} [NormedJordanAlgebra E] [JBAlgebra E] + +open NormedJordanAlgebra +open scoped ENNReal NNReal + +namespace ClosedGeneratedByOne + +variable (a : E) + +/-! ## Uniform square norm -/ + +/-- The JB square axiom restricts to the closed algebra generated by one element. -/ +lemma norm_mul_self (x : ClosedGeneratedByOne a) : ‖x * x‖ = ‖x‖ ^ 2 := by + exact JBAlgebra.norm_mul_self x + +/-- The generic Banach-algebra spectral-radius bound, specialized to the closed JB generator. The +reverse inequality is the genuinely JB-specific spectral theorem and is intentionally not folded +into this generic estimate. -/ +lemma spectralRadius_le_norm [Nontrivial E] (x : ClosedGeneratedByOne a) : + spectralRadius ℝ x ≤ (‖x‖₊ : ℝ≥0∞) := by + exact spectrum.spectralRadius_le_nnnorm x + +/-- Along powers of two, the closed one-generator algebra has a uniform norm. -/ +lemma norm_pow_two_pow (x : ClosedGeneratedByOne a) (n : ℕ) : + ‖x ^ (2 ^ n)‖ = ‖x‖ ^ (2 ^ n) := by + induction n with + | zero => simp + | succ n ih => + calc + ‖x ^ (2 ^ (n + 1))‖ = ‖(x ^ (2 ^ n)) * (x ^ (2 ^ n))‖ := by + rw [pow_succ, pow_mul, pow_two] + _ = ‖x ^ (2 ^ n)‖ ^ 2 := norm_mul_self a _ + _ = (‖x‖ ^ (2 ^ n)) ^ 2 := by rw [ih] + _ = ‖x‖ ^ (2 ^ (n + 1)) := by + rw [← pow_mul, pow_succ] + +end ClosedGeneratedByOne + +end JBAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/Order.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/Order.lean new file mode 100644 index 0000000000..14f63d620e --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/Order.lean @@ -0,0 +1,48 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.GeneratedByOne.PositiveInvertibility + +/-! + +# Exact order in JB-algebras + +The ordered-JB boundary initially assumes only that Jordan squares are positive. The converse is +not an axiom: it is a consequence of the intrinsic one-observable analytic theory. Every +observable belongs to its closed associative one-generator algebra, where the endpoint binomial +argument proves that positive elements are squares; coercing that witness back gives the global +JB cone theorem. + +This is the first order-reconstruction result used by the later positive-root, projection, and +JBW spectral developments. No Cstar realization is involved. + +-/ + +@[expose] public section + +namespace JBAlgebra + +variable {E : Type*} [NormedJordanAlgebra E] [JBAlgebra E] [Nontrivial E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + +/-- In an ordered JB-algebra, the positive cone is exactly the set of Jordan squares. The +nontrivial direction is proved in the closed associative algebra generated by the positive +observable, then transported through its subtype coercion. -/ +theorem nonneg_iff_exists_mul_self (a : E) : + 0 ≤ a ↔ ∃ b : E, b * b = a := by + constructor + · intro ha + let x : NormedJordanAlgebra.ClosedGeneratedByOne a := + ⟨a, NormedJordanAlgebra.self_mem_closedGeneratedByOne a⟩ + have hx : 0 ≤ x := ha + obtain ⟨b, hb⟩ := ClosedGeneratedByOne.exists_mul_self_of_nonneg a x hx + refine ⟨(b : E), ?_⟩ + exact congrArg Subtype.val hb + · rintro ⟨b, rfl⟩ + exact IsJordanOrderUnit.mul_self_nonneg b + +end JBAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JBW/Basic.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JBW/Basic.lean new file mode 100644 index 0000000000..841b650c07 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JBW/Basic.lean @@ -0,0 +1,111 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.Basic +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Channel.Normal +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.MonotoneComplete +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.NormalEquivalence + +/-! + +# JBW-algebras + +This file fixes the boundary between continuous JB theory and monotone-complete JBW theory. We +use the order-theoretic characterization: a JBW-algebra is a monotone-complete JB-algebra whose +normal states separate points. Normality itself remains the canonical +`UnitalPositiveLinearMap.IsNormal`; it is not copied into this layer. + +Projection-valued spectral measures and Borel functional calculus belong downstream of this +interface. The continuous single-generator spectrum remains in the JB layer. + +-/ + +@[expose] public section + +/-- A JBW-algebra, presented as a monotone-complete JB-algebra with enough normal states. +The ordinary JB, order-unit, and scalar-order data stay in their existing canonical classes. -/ +class JBWAlgebra (E : Type*) [NormedJordanAlgebra E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [JBAlgebra E] + [IsJBOrderUnit E] : Prop + extends MonotoneCompleteOrder E where + /-- Normal states separate a nonzero observable from zero. -/ + exists_normal_state_ne_zero : ∀ {x : E}, x ≠ 0 → + ∃ ω : 𝓢[ℝ, E], ω.IsNormal ∧ ω x ≠ 0 + +namespace JBWAlgebra + +variable {E : Type*} [NormedJordanAlgebra E] [PartialOrder E] [IsOrderedAddMonoid E] + [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [JBAlgebra E] [IsJBOrderUnit E] [JBWAlgebra E] + +/-- Equality of observables is detected by all normal states. -/ +theorem eq_of_forall_normal_state_eq {x y : E} + (h : ∀ ω : 𝓢[ℝ, E], ω.IsNormal → ω x = ω y) : x = y := by + by_contra hxy + obtain ⟨ω, hωnormal, hωne⟩ := exists_normal_state_ne_zero (sub_ne_zero.mpr hxy) + apply hωne + rw [map_sub, h ω hωnormal, sub_self] + +/-- A normal state preserves the canonical supremum of every nonempty bounded directed family. +This is the directed-set form of JBW monotone convergence; the sequence statements below are its +special case after passing to the range of a monotone sequence. -/ +theorem isLUB_directedSup_normal_state_image (ω : 𝓢[ℝ, E]) (hω : ω.IsNormal) + (D : Set E) (hD : D.Nonempty) (hdir : DirectedOn (· ≤ ·) D) (hbounded : BddAbove D) : + IsLUB (ω '' D) (ω (MonotoneCompleteOrder.directedSup D hD hdir hbounded)) := by + exact hω D (MonotoneCompleteOrder.directedSup D hD hdir hbounded) hD hdir + (MonotoneCompleteOrder.isLUB_directedSup D hD hdir hbounded) + +/-- Monotone completeness and normality give the expected monotone-convergence statement for a +normal state: a bounded increasing sequence has a supremum in the JBW-algebra, and evaluating it +is the least upper bound of the scalar sequence. This is stated with `IsLUB`, rather than an +unconditional `iSup`, because `ℝ` is conditionally complete. -/ +theorem exists_isLUB_range_and_normal_state_image (ω : 𝓢[ℝ, E]) (hω : ω.IsNormal) + (x : ℕ → E) (hx : Monotone x) (hbounded : BddAbove (Set.range x)) : + ∃ a : E, IsLUB (Set.range x) a ∧ + IsLUB (Set.range fun n => ω (x n)) (ω a) := by + obtain ⟨a, ha⟩ := MonotoneCompleteOrder.exists_isLUB_range x hx hbounded + refine ⟨a, ha, ?_⟩ + have himage := hω (Set.range x) a ⟨x 0, Set.mem_range_self 0⟩ + hx.directed_le.directedOn_range ha + have heq : ω '' Set.range x = Set.range fun n => ω (x n) := by + ext r + constructor + · rintro ⟨_, ⟨n, rfl⟩, rfl⟩ + exact ⟨n, rfl⟩ + · rintro ⟨n, rfl⟩ + exact ⟨x n, ⟨n, rfl⟩, rfl⟩ + change IsLUB (ω '' Set.range x) (ω a) at himage + rwa [heq] at himage + +/-- The same monotone-convergence statement using the canonical chosen sequence supremum from +`MonotoneCompleteOrder`. -/ +theorem isLUB_rangeSup_normal_state_image (ω : 𝓢[ℝ, E]) (hω : ω.IsNormal) + (x : ℕ → E) (hx : Monotone x) (hbounded : BddAbove (Set.range x)) : + IsLUB (Set.range fun n => ω (x n)) + (ω (MonotoneCompleteOrder.rangeSup x hx hbounded)) := by + have himage := isLUB_directedSup_normal_state_image ω hω (Set.range x) + ⟨x 0, Set.mem_range_self 0⟩ hx.directed_le.directedOn_range hbounded + have heq : ω '' Set.range x = Set.range fun n => ω (x n) := by + ext r + constructor + · rintro ⟨_, ⟨n, rfl⟩, rfl⟩ + exact ⟨n, rfl⟩ + · rintro ⟨n, rfl⟩ + exact ⟨x n, ⟨n, rfl⟩, rfl⟩ + simpa only [MonotoneCompleteOrder.rangeSup, heq] using himage + +/-- A nonzero positive observable is detected by a normal finite weight. This is the canonical +state-to-weight direction: normal-state separation supplies the state, and the established +state/weight conversion transports its normality to the positive cone. -/ +theorem exists_normal_finite_weight_ne_zero {x : E} (hx : 0 ≤ x) (hxne : x ≠ 0) : + ∃ w : Weight E, w.IsNormal ∧ w.IsFinite ∧ w ⟨x, hx⟩ ≠ 0 := by + obtain ⟨ω, hωnormal, hωx⟩ := exists_normal_state_ne_zero hxne + refine ⟨ω.toWeight, hωnormal.toWeight_isNormal, (ω.toWeight_isState).finite, ?_⟩ + rw [UnitalPositiveLinearMap.toWeight_apply] + exact ne_of_gt <| ENNReal.ofReal_pos.mpr + (lt_of_le_of_ne (ω.map_nonneg hx) hωx.symm) + +end JBWAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JBW/ProjectionResolution.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JBW/ProjectionResolution.lean new file mode 100644 index 0000000000..78c68d7207 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JBW/ProjectionResolution.lean @@ -0,0 +1,261 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JBW.Basic +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.ProjectionResolution +public import PhyslibAlpha.AlgebraicFramework.Measurement.ProbabilityLaw +public import PhyslibAlpha.AlgebraicFramework.Measurement.MeasurableOutcome +public import PhyslibAlpha.AlgebraicFramework.Measurement.BoundedScalarization + +/-! + +# Projection resolutions in JBW-algebras + +`MeasurableProjectionResolution` is defined at the weaker Jordan order-unit level and reuses the +entire effect-valued-measure API. This JBW file adds the two genuinely JBW ingredients: normal +states produce ordinary probability laws, and the separating normal-state family detects equality +of projection resolutions. + +It is deliberately only the bounded spectral-measure boundary. An unbounded Hilbert-space +spectral integral carries an additional square-moment domain and remains a represented/affiliated +construction above this intrinsic JBW layer. + +-/ + +@[expose] public section + +open MeasureTheory + +namespace MeasurableProjectionResolution + +variable {Ω E : Type*} [MeasurableSpace Ω] [NormedJordanAlgebra E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [JBAlgebra E] + [IsJBOrderUnit E] [JBWAlgebra E] + +/-- The identity order isomorphism into the explicit order-unit-norm copy, bundled as a normal +channel. It changes topology only through the codomain type synonym; algebraic and order data +remain literally the same. -/ +noncomputable def toWithOrderUnitNormChannel : E →ₚ₁[ℝ] WithOrderUnitNorm E := + UnitalPositiveLinearMap.ofLinearMap (WithOrderUnitNorm.linearEquiv (E := E)).toLinearMap + (fun _ hx => hx) rfl + +omit [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [JBAlgebra E] [IsJBOrderUnit E] [JBWAlgebra E] in +/-- The norm-copy channel is normal because it is the identity on the underlying ordered set. -/ +theorem toWithOrderUnitNormChannel_isNormal : + (toWithOrderUnitNormChannel (E := E)).IsNormal := by + intro D x hD hdir hLUB + constructor + · rintro _ ⟨y, hy, rfl⟩ + change y ≤ x + exact hLUB.1 hy + · intro y hy + change x ≤ (show E from y) + apply hLUB.2 + intro z hz + have hzy := hy ⟨z, hz, rfl⟩ + change z ≤ (show E from y) at hzy + exact hzy + +/-- The inverse identity order isomorphism from the norm copy back to the ambient ordered space, +again packaged as a channel rather than by changing any global instances. -/ +noncomputable def fromWithOrderUnitNormChannel : + WithOrderUnitNorm E →ₚ₁[ℝ] E := + UnitalPositiveLinearMap.ofLinearMap (WithOrderUnitNorm.linearEquiv (E := E)).symm.toLinearMap + (fun _ hx => hx) rfl + +omit [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [JBAlgebra E] [IsJBOrderUnit E] [JBWAlgebra E] in +/-- The inverse norm-copy channel is normal for the same order-theoretic reason. -/ +theorem fromWithOrderUnitNormChannel_isNormal : + (fromWithOrderUnitNormChannel (E := E)).IsNormal := by + intro D x hD hdir hLUB + constructor + · rintro _ ⟨y, hy, rfl⟩ + change (show E from y) ≤ (show E from x) + exact hLUB.1 hy + · intro y hy + change (show E from x) ≤ y + apply hLUB.2 + intro z hz + have hzy := hy ⟨z, hz, rfl⟩ + change (show E from z) ≤ y at hzy + exact hzy + +/-- The scalar identity channel into its explicit order-unit-norm copy. This is stated directly: +the generic JB-copy channel is deliberately not invoked here, since `ℝ` need not carry the +ambient `NormedJordanAlgebra` structure used by the JB layer. -/ +noncomputable def realToWithOrderUnitNormChannel : + ℝ →ₚ₁[ℝ] WithOrderUnitNorm ℝ := + UnitalPositiveLinearMap.ofLinearMap (WithOrderUnitNorm.linearEquiv (E := ℝ)).toLinearMap + (fun _ hx => hx) rfl + +/-- The scalar norm-copy channel is normal because it is the identity on the ordered carrier. -/ +theorem realToWithOrderUnitNormChannel_isNormal : + realToWithOrderUnitNormChannel.IsNormal := by + intro D x hD hdir hLUB + constructor + · rintro _ ⟨y, hy, rfl⟩ + change y ≤ x + exact hLUB.1 hy + · intro y hy + change x ≤ (show ℝ from y) + apply hLUB.2 + intro z hz + have hzy := hy ⟨z, hz, rfl⟩ + change z ≤ (show ℝ from y) at hzy + exact hzy + +/-- A normal state, regarded between explicit order-unit-norm copies. This is the coherent +channel used to scalarize the copied bounded Borel calculus. -/ +noncomputable def normalStateToWithOrderUnitNormChannel (ω : 𝓢[ℝ, E]) : + WithOrderUnitNorm E →ₚ₁[ℝ] WithOrderUnitNorm ℝ := + realToWithOrderUnitNormChannel.comp + (ω.comp (fromWithOrderUnitNormChannel (E := E))) + +omit [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [JBAlgebra E] [IsJBOrderUnit E] [JBWAlgebra E] in +/-- Normality of a state is preserved by the two explicit order-unit-copy transports. -/ +theorem normalStateToWithOrderUnitNormChannel_isNormal (ω : 𝓢[ℝ, E]) (hω : ω.IsNormal) : + (normalStateToWithOrderUnitNormChannel ω).IsNormal := by + exact (fromWithOrderUnitNormChannel_isNormal (E := E)).comp + (hω.comp realToWithOrderUnitNormChannel_isNormal) + +/-- Bounded Borel integration of a projection resolution in the explicit order-unit-norm copy. +The input measure is transported through the normal identity channel, and completeness is supplied +by `JBAlgebra.completeWithOrderUnitNorm`; the ambient JB norm on `E` is never replaced. -/ +noncomputable def boundedBorelWithOrderUnitNorm (P : MeasurableProjectionResolution Ω E) + (f : Ω → ℝ) (hf : Measurable f) {M : ℝ} (hM : ∀ x, |f x| ≤ M) : WithOrderUnitNorm E := by + let _ : NormedAddCommGroup (WithOrderUnitNorm E) := + IsArchimedeanOrderUnit.orderUnitNormedAddCommGroup + let e : WithOrderUnitNorm E ≃ₗᵢ[ℝ] E := + { __ := (WithOrderUnitNorm.linearEquiv (E := E)).symm + norm_map' := fun x => by + change ‖(show E from x)‖ = ‖x‖ + rw [show ‖x‖ = IsArchimedeanOrderUnit.orderUnitNorm (show E from x) by rfl] + exact JBAlgebra.norm_eq_orderUnitNorm (show E from x) } + let _ : CompleteSpace (WithOrderUnitNorm E) := + (completeSpace_congr (e := e.toLinearEquiv.toEquiv) e.isometry.isUniformEmbedding).mpr + JBAlgebra.toCompleteSpace + exact EffectValuedMeasure.integral hf hM + (P.toEffectValuedMeasure.map (toWithOrderUnitNormChannel (E := E)) + (toWithOrderUnitNormChannel_isNormal (E := E))) + +omit [JBWAlgebra E] in +/-- On an indicator, the copied bounded Borel calculus recovers the corresponding event +projection, transported through the norm-copy channel. -/ +theorem boundedBorelWithOrderUnitNorm_indicator (P : MeasurableProjectionResolution Ω E) + {s : Set Ω} (hs : MeasurableSet s) : + P.boundedBorelWithOrderUnitNorm (s.indicator fun _ : Ω => (1 : ℝ)) + (measurable_const.indicator hs) (M := 1) (by intro x; by_cases hx : x ∈ s <;> simp [hx]) = + toWithOrderUnitNormChannel (E := E) (P s hs : E) := by + let : NormedAddCommGroup (WithOrderUnitNorm E) := + IsArchimedeanOrderUnit.orderUnitNormedAddCommGroup + let e : WithOrderUnitNorm E ≃ₗᵢ[ℝ] E := + { __ := (WithOrderUnitNorm.linearEquiv (E := E)).symm + norm_map' := fun x => by + change ‖(show E from x)‖ = ‖x‖ + rw [show ‖x‖ = IsArchimedeanOrderUnit.orderUnitNorm (show E from x) by rfl] + exact JBAlgebra.norm_eq_orderUnitNorm (show E from x) } + let : CompleteSpace (WithOrderUnitNorm E) := + (completeSpace_congr (e := e.toLinearEquiv.toEquiv) e.isometry.isUniformEmbedding).mpr + JBAlgebra.toCompleteSpace + let c : Bool → ℝ := fun b => if b then 1 else 0 + let pieces : Bool → Set Ω := fun b => if b then s else sᶜ + have hpieces : EffectValuedMeasure.IsPartition pieces := + { measurable := by intro b; cases b <;> simp [pieces, hs] + disjoint := by + intro b b' hne + cases b <;> cases b' + · exact (hne rfl).elim + · exact disjoint_compl_left + · exact disjoint_compl_right + · exact (hne rfl).elim + cover := by + apply Set.Subset.antisymm + · exact Set.subset_univ _ + · intro x _ + by_cases hx : x ∈ s + · exact Set.mem_iUnion.2 ⟨true, by simp [pieces, hx]⟩ + · exact Set.mem_iUnion.2 ⟨false, by simp [pieces, hx]⟩ } + have hvalue : ∀ x, EffectValuedMeasure.simpleValue c pieces x = + s.indicator (fun _ : Ω => (1 : ℝ)) x := by + intro x + by_cases hx : x ∈ s + · rw [EffectValuedMeasure.simpleValue_apply_of_mem hpieces (i := true)] + · simp [c, hx] + · simp [pieces, hx] + · rw [EffectValuedMeasure.simpleValue_apply_of_mem hpieces (i := false)] + · simp [c, hx] + · simp [pieces, hx] + rw [boundedBorelWithOrderUnitNorm, EffectValuedMeasure.integral_eq_simpleIntegral + (measurable_const.indicator hs) (by intro x; by_cases hx : x ∈ s <;> simp [hx]) + hpieces hvalue] + unfold EffectValuedMeasure.simpleIntegral + simp [c, pieces] + +/-- Scalarization of the copied bounded Borel calculus, still in the explicit order-unit-norm +copy of `ℝ`. The final conversion to ordinary scalars is the separately proved isometry +`WithOrderUnitNorm.realLinearIsometryEquiv`. -/ +noncomputable def scalarBoundedBorelWithOrderUnitNorm (P : MeasurableProjectionResolution Ω E) + (ω : 𝓢[ℝ, E]) (hω : ω.IsNormal) (f : Ω → ℝ) (hf : Measurable f) + {M : ℝ} (hM : ∀ x, |f x| ≤ M) : WithOrderUnitNorm ℝ := + EffectValuedMeasure.scalarCopyIntegral f hf hM + ((P.toEffectValuedMeasure.map (toWithOrderUnitNormChannel (E := E)) + (toWithOrderUnitNormChannel_isNormal (E := E))).map + (normalStateToWithOrderUnitNormChannel ω) + (normalStateToWithOrderUnitNormChannel_isNormal ω hω)) + +/-- The ordinary real scalar bounded Borel calculus of a normal JBW state. The integral is first +taken in `WithOrderUnitNorm ℝ`; only then is it transported through the canonical real-line +isometry. Thus this endpoint cannot silently inherit or replace the JB norm on `E`. -/ +noncomputable def scalarBoundedBorel (P : MeasurableProjectionResolution Ω E) + (ω : 𝓢[ℝ, E]) (hω : ω.IsNormal) (f : Ω → ℝ) (hf : Measurable f) + {M : ℝ} (hM : ∀ x, |f x| ≤ M) : ℝ := + WithOrderUnitNorm.realLinearIsometryEquiv + (P.scalarBoundedBorelWithOrderUnitNorm ω hω f hf hM) + +/-- A normal JBW state turns a projection resolution into its ordinary scalar probability law. +This is the existing effect-valued-measure scalarization, applied to the inherited measure rather +than reconstructed in the JBW layer. -/ +noncomputable def probabilityLaw (P : MeasurableProjectionResolution Ω E) + (ω : 𝓢[ℝ, E]) (hω : ω.IsNormal) : ProbabilityMeasure Ω := + P.toEffectValuedMeasure.probabilityLaw ω hω + +omit [JBAlgebra E] [IsJBOrderUnit E] [JBWAlgebra E] in +/-- Evaluation of the normal-state probability law on a measurable event is the state evaluated +at the corresponding spectral projection. -/ +theorem probabilityLaw_apply (P : MeasurableProjectionResolution Ω E) + (ω : 𝓢[ℝ, E]) (hω : ω.IsNormal) (s : Set Ω) (hs : MeasurableSet s) : + (P.probabilityLaw ω hω : Measure Ω) s = ENNReal.ofReal (ω (P s hs : E)) := + EffectValuedMeasure.probabilityLaw_apply P.toEffectValuedMeasure ω hω s hs + +/-- A JBW projection resolution is determined by the ordinary probability laws it induces in all +normal states. This is the operational form of normal-state separation: it lets clients compare +spectral resolutions through measurable probabilities rather than their ambient observables. -/ +theorem eq_of_forall_normal_probabilityLaw_eq {P Q : MeasurableProjectionResolution Ω E} + (h : ∀ ω : 𝓢[ℝ, E], ∀ hω : ω.IsNormal, + P.probabilityLaw ω hω = Q.probabilityLaw ω hω) : P = Q := by + apply MeasurableProjectionResolution.ext + intro s hs + apply JBWAlgebra.eq_of_forall_normal_state_eq + intro ω hω + have hmeasure : (P.probabilityLaw ω hω : Measure Ω) s = + (Q.probabilityLaw ω hω : Measure Ω) s := by + rw [h ω hω] + rw [P.probabilityLaw_apply ω hω s hs, Q.probabilityLaw_apply ω hω s hs] at hmeasure + exact (ENNReal.ofReal_eq_ofReal_iff + (ω.map_nonneg (P s hs).2.1) (ω.map_nonneg (Q s hs).2.1)).mp hmeasure + +/-- Normal states separate measurable projection resolutions pointwise. -/ +theorem eq_of_forall_normal_state_eq {P Q : MeasurableProjectionResolution Ω E} + (h : ∀ ω : 𝓢[ℝ, E], ω.IsNormal → ∀ s hs, + ω (P s hs : E) = ω (Q s hs : E)) : P = Q := by + apply MeasurableProjectionResolution.ext + intro s hs + apply JBWAlgebra.eq_of_forall_normal_state_eq + intro ω hω + exact h ω hω s hs + +end MeasurableProjectionResolution diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB_ROADMAP.md b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB_ROADMAP.md new file mode 100644 index 0000000000..b383d644e4 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB_ROADMAP.md @@ -0,0 +1,1040 @@ +# Jordan/order-unit/JB development map + +This is the architectural contract for the Jordan development. It records what is already in +place, the dependency direction that future work must preserve, and the remaining mathematical +milestones. Historical migration steps are deliberately omitted: the source tree, not a list of +old bridge files, is the authority for the current design. + +## 1. Governing principle + +Every definition lives at the weakest natural level, exactly once. Stronger settings inherit it +through instances or specialize it by applying the same definition. A file may translate between +genuinely independent representations, but it must not repair duplicate definitions by proving +that they coincide. + +```text +bilinear algebra -------- statistics, generators + | +unital Jordan algebra --- powers, L, U, projections, generated algebra + | +Jordan order-unit ------- square positivity, states, covariance, effects + | +normed Jordan algebra --- bounded multiplication, continuous L and U + | +JB algebra -------------- completeness, closed one-generator algebra, spectrum, CFC + | +JBW algebra ------------- directed suprema, normal states, Borel theory + +Cstar algebra -- selfAdjoint realization --> special JB/JBW examples +``` + +The Cstar branch points into the hierarchy. The abstract hierarchy never imports a concrete +Cstar realization. + +## 2. Stable ownership rules + +### 2.1 Generic algebra and statistics + +`AlgebraicFramework/Algebra/Statistics.lean` owns the canonical second-moment and covariance +bilinear forms. Symmetry, positive-semidefiniteness, Cauchy--Schwarz, scalar covariance, variance, +and finite covariance matrices are derived from that object at the assumptions each result uses. + +`StarAlgebra/Statistics.lean` is only an ergonomic specialization to self-adjoint observables. +The Robertson--Schrodinger commutator term remains Cstar-specific because it uses the associative +and Lie products; the symmetric covariance term does not. + +Weights do not acquire a copied statistics API. A finite nonzero weight is normalized to a state, +after which the state API applies unchanged. The equivalence between finite normalized weights +and states is a genuine representation equivalence and is named accordingly. + +### 2.2 Pure Jordan algebra + +The `JordanAlgebra` namespace owns all statements requiring no order or norm: + +- fixed-bracketing powers `jpow`; +- multiplication operators `L` and quadratic representations `U`; +- the Jordan identity and power-associativity; +- operator compatibility; +- algebraic projections and orthogonality; +- the associative commutative algebra generated by one element. + +The standard hypotheses are `NonAssocCommRing`, a compatible real module structure, and +`IsCommJordan`. Pure algebra declarations must not carry an order-unit assumption for convenience. + +### 2.3 Jordan order-unit algebra + +`IsJordanOrderUnit` couples the Jordan product to the order by one minimal axiom: squares are +nonnegative. It intentionally does not claim that every positive element is a square. + +This layer owns: + +- positivity of state evaluations on squares; +- positive-semidefiniteness of covariance; +- conversion of algebraic projections to effects; +- the forward implication from Jordan orthogonality to an effect partial sum; +- other results that genuinely combine multiplication and order. + +The reverse projection/sharp-effect correspondence and positivity of arbitrary quadratic +representations require spectral JB theory and are not smuggled into this weak class. + +### 2.4 Normed Jordan and JB algebra + +`NormedJordanAlgebra` is the coherent data-carrying structure. It bundles one addition, scalar +action, multiplication, norm, and metric, plus the Jordan and norm-submultiplicativity laws. This +prevents instance diamonds. + +`JBAlgebra` is the complete analytic refinement: it has the Banach and JB norm laws but no chosen +order. `IsJBOrderUnit` is the separate ordered refinement, extending weak square-positivity by +the exact equality between the supplied norm and `orderUnitNorm`. Normed results such as bounded multiplication, +continuous `L_a`, continuous `U_a`, and derivation generators are stated for +`NormedJordanAlgebra` whenever order and completeness are unused. Closed-generated-subalgebra +results add `CompleteSpace` only where closure arguments need it. + +### 2.5 JBW algebra + +Monotone completeness is an order property and lives in `OrderUnit/MonotoneComplete.lean`. +`JBWAlgebra` combines a JB algebra with monotone completeness and a separating family of normal +states. Normality remains `UnitalPositiveLinearMap.IsNormal`/`Weight.IsNormal`; the JBW layer does +not redefine it. + +Projection-valued spectral measures and Borel functional calculus belong here. Continuous +single-observable functional calculus belongs one level lower, in JB. + +### 2.6 Cstar realization + +`StarAlgebra/Jordan.lean` defines the one normalized Jordan product on `selfAdjoint A`. +`CStarAlgebra/Jordan.lean` and its focused companion files provide the ordered, normed, complete, +specialness, positivity, compatibility, and statistics realizations. + +Concrete identities such as `U_a(b) = aba` and coercion of Jordan powers to associative powers +live with that realization. They are specializations, not competing abstract definitions. + +### 2.7 Exceptional-model acceptance condition + +The abstract Jordan/JB/JBW development is required to remain meaningful for the exceptional +Albert algebra `H₃(𝕆)`. Cstar self-adjoint algebras are important special realizations, but they +are not a completeness argument for the abstract theory and may not be used to prove an abstract +theorem merely because they validate its matrix intuition. + +This has a direct API consequence. `U_a` is public operational structure — the intrinsic +counterpart of `b ↦ aba`, hence compression/filtering and the Heisenberg-picture Lüders map — and +the public theorems downstream of its positivity request only the intrinsic quadratic-positivity +fact. Shirshov--Cohn or another proof of that fact is an implementation dependency, never a +dependency exposed by measurement, conditioning, CFC, or JBW clients. In particular, no +abstract theorem may require `JBAlgebra.IsSpecial`. + +`EXCEPTIONAL_ALBERT_ROADMAP.md` is the concrete realization plan and its proof gates. It is a +separate vertical track: it validates the general interfaces with a genuinely non-special model; +it does not move octonionic coordinates, alternative multiplication, or finite-dimensional +matrix calculations into the abstract Jordan files. + +## 3. Implemented foundation + +The following parts of the architecture are now present and must be preserved: + +- canonical generic covariance as a bilinear form, including positivity, Cauchy--Schwarz, and + covariance-matrix consequences; +- Cstar uncertainty consuming that canonical covariance API; +- pure Jordan powers, multiplication operators, quadratic representations, compatibility, + projections, and generated-by-one algebra in the `JordanAlgebra` namespace; +- a proof of power-associativity and `jpow_add` without order or Cstar assumptions; +- exact formulas for `U` on powers and the quadratic fundamental formula on every + one-generated associative sector; +- pointwise and bundled commutation of `U_a` with the multiplication operators `L_a` and + `L_(a²)`, directly from the Jordan identity; +- inner-variable additivity and scalar linearity of `U_a`, outer-variable quadratic homogeneity, + sign invariance, and bundled two-sided identity laws for `U_1`; +- the symmetric bilinear polarization `quadRepPolar a b` of the quadratic representation, with + its exact cross-effect formula `U_(a+b) = U_a + quadRepPolar a b + U_b`; this is the shared + operator-level interface for the still-missing multivariable fundamental-formula proof; +- the computable Jordan triple product `{a, b, c}`, symmetric and bilinear in its outer variables + and linear in its middle variable, with `quadRepPolar a c b = 2 {a, b, c}` and diagonal + `{a, b, a} = U_a b`; the remaining fundamental-formula proof is therefore correctly posed as + the standard Jordan-triple commutator identity rather than as duplicated `U` expansions; +- a closed operator normal form `mulLeft_quadRep_normalize` for `L_(U_a b)` in terms of `L_a`, + `L_b`, `L_(a*a)`, `L_(a*b)` compositions, and the bilinear reduction `quadRep_quadRep_eq` + expressing `U_(U_a b)` via `U` and `quadRepBilin` of `U a b`'s two elementary constituents; + together these confirm that pure operator-normalization (as opposed to the Jordan-triple + fundamental identity) cannot self-terminate the multivariable fundamental-formula proof; +- the Peirce polynomial and algebraic idempotence of quadratic compression by a projection; +- the Peirce-`1` eigenspace of a projection and its exact identification with the range of its + quadratic compression; +- explicit algebraic Peirce-`0`, Peirce-`1/2`, and Peirce-`1` components of every element, with + their eigenvalue laws, joint directness, and decomposition formula; +- projection conditioning of states, with quadratic positivity exposed at the JB-theoretic level + where it belongs; +- a shared `IsQuadraticallyPositive` operational boundary, its bundled positive map + `quadRepPositiveLinearMap`, and the generic projection-conditioning specialization that consumes + exactly that boundary; `Quadratic/Operational.lean` is the separate meeting point with the + purely algebraic fundamental formula, where intrinsic square-composition and full sequential- + filtering laws are bundled without making the basic positivity interface import that proof; +- Cstar-realization positivity of quadratic representations and a concrete projection-conditioning + constructor that supplies that positivity automatically; +- the intrinsic effect-to-operation slice: CFC supplies `effectSqrt`, quadratic positivity supplies + `luedersMap e := U_(effectSqrt e)`, `luedersMap e 1 = e`, and nonzero-probability effects induce + normalized Lüders states; for a Jordan projection `p`, square-root uniqueness proves + `effectSqrt p = p`, so the Lüders operation is exactly the established quadratic compression + `U_p`, and the resulting Lüders conditional state is exactly projection conditioning; the map + is bundled as an `Operation` whose outcome effect is precisely `e`; +- ordered projections as effects and the algebraic-orthogonality-to-effect-sum implication; +- finite-weight normalization and the state/finite-weight equivalences; +- the canonical direction of normality under that equivalence: a normal state induces a normal + finite normalized weight, with directed suprema transported through the positive cone; +- coherent `NormedJordanAlgebra` and complete `JBAlgebra` classes; +- abstract continuous multiplication, bounded `L_a` and `U_a`, and generator-is-derivation; +- a closed, complete, commutative associative real algebra generated by one element; +- its inherited abstract JB structure (ambient order unit, Archimedean order, square positivity, + normed Jordan data, completeness, and JB norm laws), retaining the formal-reality information + required by the real Gelfand step; +- a canonical real spectrum defined in that closed generated algebra, with compactness; +- a sound, realization-specific real CFC into self-adjoint Cstar observables, obtained by + packaging Mathlib's isometric `cfcHom` as a Jordan-valued linear map; its coordinate and norm + laws, Jordan multiplicativity, positivity, and monotonicity are available without claiming an + abstract JB CFC; +- restriction of the JB square-norm law to the closed generated algebra, including exact norm + growth along powers of two; +- the generic spectral-radius upper bound for closed one-generator JB elements, with the reverse + inequality reserved for the genuine JB spectral theorem; +- specialness represented by an isometric Jordan embedding with closed range; +- an initial JBW boundary based on generic monotone completeness and normal-state separation; +- monotone convergence for normal states on bounded increasing sequences in a JBW-algebra, + formulated with scalar `IsLUB` to respect conditional completeness of `ℝ`; +- normal finite weights detect nonzero positive JBW observables, via the canonical normal + state-to-weight transport (with no unsound converse normality claim); +- directed-supremum normality is owned once by `PositiveLinearMap.IsNormal`; the channel and + subunital-operation APIs are abbreviations of that predicate, so future normal Lüders + operations require no parallel continuity notion; operations compose sequentially and the + normal-operation predicate is closed under that composition; `Operation.condition` is the one + normalized post-measurement-state constructor reused by instruments and Lüders operations, and + it proves normality from a normal operation and normal input state; operations now have their + expected identity and associative sequential composition laws; +- realization files named by what they construct, with no Jordan `*Bridge.lean` layer; +- removal of the unsound arbitrary-spectrum functional-calculus placeholder. + +## 4. Remaining mathematical program + +The remaining work is not another hierarchy migration. It is the analytic and spectral content +needed to make the abstract JB layer fully useful. + +### 4.0 Execution priority and proof ownership + +The critical path is now **Stage B, then Stage C, then Stage E**. Continuous one-observable +calculus is foundational for the order reconstruction and the later JBW/Borel layer, so it takes +priority over extending the multivariable quadratic API. + +The primary model owns the mathematical design and the proofs of the JB norm/order theorem, +strict-positive invertibility, real spectrality, polynomial spectral mapping, and the CFC +extension. Do not delegate those proofs to a lower-capability model. A lower-capability model +may be used only after a theorem statement and proof spine are fixed, for bounded mechanical work +such as resolving elaboration errors, locating an already named lemma, or minimizing imports. + +Work in vertical slices. A slice must end in a proved theorem used by the next slice; adding +wrappers, special scalar cases, or documentation alone does not count as progress on the critical +path. + +### Stage A: quadratic order theory + +1. Promote the proved one-generated fundamental formula for `U` to arbitrary elements. The + missing ingredient is the classical multivariable-polarization/Macdonald argument: evaluated + at an element, the target is a degree-7 multihomogeneous identity, while Mathlib currently + provides only the cubic Jordan commutation law and degree-4 polarized commutator identities. + The symmetric bilinear cross-effect `quadRepPolar` and its computable Jordan-triple form are + now the reusable first layer. The first finite certificate step is also proved: + `mulLeft_triple_normalize` reduces `L_(a*(b*c))` to products of multiplication operators on + single and double products, directly from the cyclic commutator identity. Its cubic and + fourth-power specializations now prove the first nontrivial quadratic identity + `quadRep_mul_self_eq_comp : U_(a²) = U_a²`. The standard bilinear operator + `quadRepBilin a b` is now exposed as the integral half-polarization: its diagonal is `U_a`, + while the existing cross-effect is exactly `2 • quadRepBilin a b`. Its three-summand expansion + and bundled quadratic homogeneity are installed, and + `quadRep_add_mul_self_eq_comp` records the exact operator source equation obtained by applying + the square theorem to `a + b`. Its positive and signed expansions now cancel to the proved + standard mixed coefficient identity `quadRepBilin_comp_self_polarization`; this is the first + genuine two-generator quadratic relation. The cubic analogue is now also polarized: substituting + `a + b` and `a - b` into the cubic commutation law `quadRep_mulLeft` and taking the same + even/odd combination isolates the two pure mixed-bidegree `(2,1)`/`(1,2)` pieces, proved as + `quadRepBilin_mulLeft_polarization` and its `a ↔ b` companion + `quadRepBilin_mulLeft_polarization'` in `Quadratic/Fundamental.lean`: + `U_a(b*x) + 2 quadRepBilin(a,b)(a*x) = b*(U_a x) + 2 a*(quadRepBilin(a,b) x)`. This is the + standard triple commutator identity the previous session's writeup called for next. It is a + genuine three-generator trilinear relation (degree `(2,1,1)` in `(a,b,x)`), proved by the same + finite even/odd polarization technique as the quadratic case, via the reusable + `linear_combination (norm := module)` combinator rather than manual coefficient bookkeeping. + **Correction (checked in a later session):** both polarization passes the previous writeup + called for are in fact already on hand — `quadRepBilin_comp_self_polarization` (line above, the + degree-4 polarization of `quadRep_mul_self_eq_comp`) predates + `quadRepBilin_mulLeft_polarization` and was not a further step still owed. The assembly of these + two was attempted directly and is **not yet closed**, for a precise reason: expanding + `U (U a b) x` via `quadRep_apply` produces only multiplications *by the compound element* + `U a b` itself, and neither available identity supplies a normalization rule for + `(U a b) * y` in terms of separate `a`-/`b`-multiplications — `quadRepBilin_comp_self_polarization` + is a closed operator equation with no argument slot to substitute `U a b` into, and + `quadRepBilin_mulLeft_polarization` only normalizes a *single* extra factor of `b`, not the + `(2,1)`-bidegree compound `U a b`. The classical proofs (Jacobson, McCrimmon) close this gap only + via the Jordan-triple-system fundamental identity + `{a,b,{a,d,c}} = {{a,b,a},d,c} - {a,{b,a,d},c} + {a,d,{a,b,c}}` (using `jordanTriple` from + `Quadratic/Triple.lean`) or Macdonald's transfer theorem for special algebras; the triple + identity is a strictly new three-slot linearization, not obtainable by re-polarizing an + identity already on hand, and Mathlib's `two_nsmul_lie_lmul_lmul_add_add_eq_zero` (already used + here via `cyclic_mulLeft_commutator`) is only the *two*-variable linearization of the Jordan + axiom, not this triple-system identity. See `Quadratic/Fundamental.lean`'s final section and + §7 below for the two concrete candidate next attempts (formalizing the triple identity itself + by multi-point polarization, or pushing `mulLeft_triple_normalize`'s associative normal form + further to absorb the whole computation) — do not reattempt two-point `a ± b` polarization a + third time; that specific technique is now exhausted for this goal. +2. Prove positivity of `U_a` in a JB algebra from JB theory; do not add it as an unrelated axiom + merely to make later files compile. +3. Use the algebraically direct Peirce decomposition to establish the remaining JB order-theoretic + facts, especially compatibility and positivity of the corresponding compressions. +4. Derive JB positivity of `U_p` and use it to strengthen the existing conditional state + construction into effect/state compression maps without an explicit positivity argument. + The public operational interface and the effect-level Lüders construction are now in place; + the remaining foundational task is to discharge `IsQuadraticallyPositive` intrinsically from + the JB theorem, rather than only in concrete Cstar realizations. + +#### A2. Shirshov--Cohn route to intrinsic quadratic positivity + +The remaining `U_a ≥ 0` theorem is not an analytic consequence of the current weak ordered-JB +fields. Its algebraic core is the two-generated-special theorem. The already-complete generic +closure API (`generatedBySet`, `GeneratedByTwo`, and its canonical `JordanHom` inclusion) is the +endpoint for this construction: do not add another family of closure wrappers or a parallel +generated-subalgebra hierarchy. + +The implementation is a chain of genuinely distinct theorems, in this order: + +1. **Special model — complete.** `FreeSpecialTwo.lean` defines + `FreeAssocTwo := FreeAlgebra ℝ (Fin 2)`, its normalized symmetrization + `SymAlg FreeAssocTwo`, and `FreeSpecialJordanTwo`, the Jordan fragment generated by the two + canonical letters. This reuses Mathlib's `SymAlg`; it does not reimplement the associative + Jordanization. +2. **Free abstract model — presentation and evaluation complete.** + `FreeJordanTwo.lean` now presents the free unital real Jordan algebra as the quotient of the + free non-unital non-associative real algebra on a formal unit and two letters, by + commutativity, the Jordan identity, and the two unit relations. It proves the resulting + `NonAssocCommRing`, real module, and `IsCommJordan` structures, and constructs the canonical + evaluation `JordanHom` into every unital real Jordan algebra. The remaining part of this + item is the *uniqueness* theorem for that evaluation; it will use the raw-expression induction + rather than create another generated-closure API. `JordanHom` remains the single morphism + notion for this work. +3. **Word normal form and Shirshov.** Equip the free associative algebra with reversal, prove the + requisite fixed-word normal form, and show that the canonical homomorphism from the free + abstract two-generator Jordan algebra to `FreeSpecialJordanTwo` is injective. This is the + Shirshov theorem; it is not replaceable by a calculation in a chosen Cstar algebra. +4. **Ideals and Cohn intersection.** Develop Jordan ideals and quotient maps at the same + `JordanHom` level. For an ideal `I` of the free special algebra prove the Cohn statement + `I ∩ FreeSpecialJordanTwo = K`, for the induced Jordan ideal `K`. This step is essential: + specialness is not generally inherited by arbitrary quotients. +5. **Two-generated quotients.** Present `GeneratedByTwo a b` as a quotient of the free abstract + object, identify its kernel through the Cohn intersection theorem, and produce the resulting + special representation. The public endpoint is + + ```text + exists_special_representation_generatedByTwo + ``` + + with no Cstar hypothesis and no exceptional-algebra exclusion. +6. **Return to JB order.** Use that representation only for the local two-generator positivity + argument needed for `U_a`; state the resulting positivity as the existing intrinsic + `IsQuadraticallyPositive` interface. Conditioning, Lüders operations, CFC, and JBW clients + consume that interface and must not expose the Shirshov--Cohn machinery. + +The word-normal-form/Shirshov and Cohn-intersection pieces are the hard proof work. The model, +universal maps, quotient presentation, and API packaging are supporting infrastructure; they are +not substitutes for either theorem. + +### Stage B: continuous functional calculus + +The spectral theorem is to be proved intrinsically from the JB order and norm. The proof should +not pass through a chosen Cstar realization, an abstract real Gelfand-duality package, or a public +complexification. The concrete implementation order is as follows. + +#### B1. Repair the ordered-JB boundary, then expose the norm/order theorem + +**Foundational correction.** The present `JBAlgebra` fields do *not* imply norm/order +compatibility: they only say that Jordan squares are positive, and leave open the possibility of a +strictly larger proper cone. Enlarging the cone preserves square positivity and the two analytic +JB norm axioms, while changing `orderUnitNorm`. Therefore the following statement cannot soundly +be proved from the current class fields: + +```text +JBAlgebra.norm_eq_orderUnitNorm +JBAlgebra.norm_le_iff_order_bounds +``` + +Do **not** put that field on the pure analytic `JBAlgebra` class: its norm laws and completeness +make sense before any order is chosen. Instead repair the hierarchy in `JB/Basic.lean` as two +separate boundaries: + +```text +JBAlgebra E + -- complete normed unital Jordan algebra with the two JB norm axioms; + -- no PartialOrder, order unit, or cone data. + +IsJBOrderUnit E + -- extends IsJordanOrderUnit E; + -- couples an already chosen order to the existing JB norm. +``` + +After importing `OrderUnit/Norm.lean`, put the compatibility field on the second class: + +```text +IsJBOrderUnit.norm_eq_orderUnitNorm : + ∀ x : E, ‖x‖ = IsArchimedeanOrderUnit.orderUnitNorm x +``` + +This is not an auxiliary axiom or a CFC placeholder; it is the missing compatibility clause in +the definition of an **ordered** JB algebra. The exact-cone theorem remains a theorem to be +proved later, not a class field. The CFC and JBW layers request both `JBAlgebra E` and +`IsJBOrderUnit E`; purely analytic dynamics requests only `JBAlgebra E`; elementary ordered +results request only `IsJordanOrderUnit E`. + +Then immediately derive the two public theorems above from the field and +`orderUnitNorm_mem_orderUnitBounds` / `mem_orderUnitBounds_iff`. + +The second theorem should have the usable form, for `0 ≤ r`, + +```text +‖x‖ ≤ r ↔ -(r • 1) ≤ x ∧ x ≤ r • 1. +``` + +Do not create a second normed copy of the JB algebra or change the data-bearing +`NormedJordanAlgebra` instance. This B1 slice is entirely abstract: + +1. transport compatibility to `ClosedGeneratedByOne a` by coercion to the ambient JB algebra; +2. keep `NormedJordanAlgebra` free of every order-unit assumption; +3. add no default instance that could silently choose an incompatible order; +4. do not import, inspect, or use a Cstar realization in the proof of any B1--B5 theorem. + +Concrete realizations are a separate downstream maintenance concern. They may instantiate the +final abstract boundary later, but they are neither evidence for nor ingredients of the Jordan +proof. + +#### B2. Build the local analytic square-root machinery before CFC — complete + +This slice is now implemented in +`JB/GeneratedByOne/PositiveInvertibility.lean`, entirely inside the existing commutative +associative Banach algebra `ClosedGeneratedByOne a`. The endpoint binomial construction is +proved using the Catalan coefficient majorant and the absolutely-convergent Cauchy product; it +does not use Cstar, complexification, or a pre-existing functional calculus. It supplies the +local exact cone, both directions between positive units and the order interior, and the +cone-boundary lemma consumed by B3. + +1. Formalize the absolutely summable binomial series for `sqrt (1 - z)` on `‖z‖ ≤ 1` and prove + its square is `1 - z`. The endpoint `‖z‖ = 1` matters: the square-root coefficients are + absolutely summable, so this step must not be weakened to the open unit ball. +2. For `0 ≤ y`, choose `M > ‖y‖` and put `z = 1 - M⁻¹ • y`. The order-norm theorem gives + `0 ≤ z ≤ 1`, hence `‖z‖ ≤ 1`; rescaling the binomial-series result produces a square root of + every positive `y` in its one-generated associative sector. +3. Record the local exact-cone result: in a closed one-generated JB algebra, nonnegative elements + are exactly squares. This result is local analytic machinery for the spectral theorem; the + later Stage C theorem exports and packages it for arbitrary ambient elements. +4. If positive `y` is a unit, write `y = s^2`. Then `s` is a unit and + `y⁻¹ = (s⁻¹)^2 ≥ 0`. + The square-witness part is implemented in + `JB/GeneratedByOne/PositiveInvertibility.lean`: a unit `s²` has an explicit positive inverse + witness. What remains is the endpoint binomial argument that supplies `s` from an arbitrary + positive `y`. +5. Use positivity of `y⁻¹`, its order-unit upper bound, and the local exact-cone theorem to prove + `ε • 1 ≤ y` for some `ε > 0`: if `y⁻¹ ≤ M • 1`, write + `M • 1 - y⁻¹ = t^2`, multiply by `y = s^2` inside the associative sector, and obtain + `1 ≤ M • y`. +6. Conversely, if `ε • 1 ≤ y`, choose `M > ‖y‖` and write + `y = M • (1 - z)` with `‖z‖ < 1`; the geometric series makes `1 - z`, hence `y`, a unit. + This strict-positive-to-unit direction is implemented in + `JB/GeneratedByOne/PositiveInvertibility.lean`, using the B1 bound theorem and no concrete + realization. Its explicit inverse-series formula may be exposed later if a downstream theorem + needs it. +7. Package the two directions needed later: + +```text +JBAlgebra.isUnit_of_pos_smul_one_le +JBAlgebra.exists_pos_smul_one_le_of_isUnit_of_nonneg +JBAlgebra.isUnit_iff_mem_interior_positiveCone +``` + +Only the one-generated associative sector is needed. Do not wait for the unrestricted +fundamental formula or general positivity of `U_a`. + +#### B3. Prove the real JB spectral theorem by the cone-boundary argument — complete + +In `JB/GeneratedByOne/Spectrum.lean`, for `x : ClosedGeneratedByOne a`, let `r = ‖x‖`. The order +norm theorem gives + +```text +0 ≤ r • 1 - x, +0 ≤ r • 1 + x. +``` + +This has now been proved in `JB/GeneratedByOne/Spectrum.lean`. At least one of these two positive elements is not a unit. Otherwise B2 makes both interior +points of the positive cone, so both order bounds can be improved by a common positive epsilon; +`norm_le_iff_order_bounds` then yields `‖x‖ < r`, a contradiction. Consequently either `r` or +`-r` belongs to the real spectrum of `x`. This single endpoint theorem immediately supplies +both required results: + +```text +JBAlgebra.ClosedGeneratedByOne.norm_or_neg_norm_mem_spectrum +NormedJordanAlgebra.jordanSpectrum_nonempty +JBAlgebra.ClosedGeneratedByOne.jordanSpectralRadius_eq_norm +``` + +Combining endpoint membership with the existing generic bound +`spectrum.spectralRadius_le_nnnorm` gives the proved +`JBAlgebra.ClosedGeneratedByOne.jordanSpectralRadius_eq_norm`; no spectral compactness or generic +resolvent fact is reproved. The canonical consequence is the proved +`NormedJordanAlgebra.jordanSpectrum_nonempty`. + +#### B4. Establish real polynomial spectral mapping locally + +Prove the reverse inclusion missing from `jordanSpectrum_aeval_subset`. Factor +`p(X) - μ` over `ℝ` into linear and irreducible quadratic factors. Linear factors are handled by +the spectrum definition. Every irreducible quadratic can be completed to + +```text +(X - c)^2 + d^2, with d ≠ 0, +``` + +and B2 shows its evaluation is a strictly positive unit. Therefore a nonunit product must have a +nonunit linear factor. Record: + +```text +NormedJordanAlgebra.jordanSpectrum_aeval +NormedJordanAlgebra.norm_aeval_closedGenerator +``` + +The norm identity then follows from B3 applied to `p(a)` and exact spectral mapping. + +#### B5. Extend polynomial evaluation by density + +`JB/GeneratedByOne/ContinuousFunctionalCalculus.lean` is now complete. Its construction is +entirely intrinsic: + +1. `NormedJordanAlgebra.jordanSpectrum.compactSpace` makes the intrinsic spectrum a compact + type, so `C(jordanSpectrum a, ℝ)` has its canonical sup norm; +2. `enorm_aeval_closedGenerator_eq_enorm_toContinuousMapOn` identifies the B4 spectral norm of + polynomial evaluation with that sup norm, with no Cstar import; +3. `jordanSpectrum_polynomialFunctions_dense` invokes real Stone--Weierstrass for this exact + spectrum; +4. evaluation descends from raw polynomials through equality on the spectrum to the isometric + `polynomialCfcLinearIsometry`; +5. `jordanCfcLinear` is its unique continuous extension, and density proves it remains an + isometry and multiplicative; +6. `jordanCfcHom` bundles the resulting unital real algebra homomorphism, and + `jordanCfcEquiv` packages its proved bijectivity as the canonical algebra equivalence; +7. its range is closed by isometry, contains every algebraic Jordan power by the coordinate law, + and is all of `ClosedGeneratedByOne a` because that algebra is their norm closure. +8. `jordanCfc_nonneg` and `jordanCfc_monotone` transport the pointwise order on continuous + functions to the ambient JB order by taking a continuous pointwise square root and applying + exact-cone reconstruction. This is the order interface used by later effect and Borel work. + The converse `jordanCfc_nonneg_iff`, and hence `jordanCfc_le_iff`, are also proved: local + exact-cone reconstruction supplies a square witness in `ClosedGeneratedByOne a`, and the CFC + equivalence carries it back to a pointwise square. Thus the one-observable CFC is an exact + order identification, not only an order-preserving map. + +The public declarations are exactly the ones listed in `JB/GeneratedByOne/CFC_AUDIT.md`: + +```text +jordanCfcHom +jordanCfcHom_isometry +jordanCfcHom_id +jordanCfcHom_range_eq_top +jordanCfc +norm_jordanCfc +jordanCfc_nonneg +jordanCfc_monotone +jordanCfc_nonneg_iff +jordanCfc_le_iff +jordanSpectrumSqrt +jordanSqrt +jordanSqrt_mul_self +jordanSqrt_nonneg +jordanAbs +jordanPosPart +jordanNegPart +``` + +Only after these are proved may the API expose `abs`, `sqrt`, `posPart`, and `negPart`. + +No public API may accept an arbitrary set called a spectrum, and no unbundled function may stand +in for the calculus. + +### Stage C: exact order reconstruction + +Using continuous functional calculus: + +1. **Complete:** `jordanSqrt` is the canonical CFC square root of a nonnegative + observable. `nonneg_of_mem_jordanSpectrum` first proves that positivity of the observable + forces its intrinsic real spectrum to lie in `[0,∞)` by strict-positive invertibility; + `jordanSqrt_mul_self` and `jordanSqrt_nonneg` then prove existence of the positive root. + `jordanSqrt_eq_of_mem_closedGeneratedByOne` proves uniqueness for every nonnegative root in + `ClosedGeneratedByOne a`, using the exact CFC order equivalence and pointwise real-root + uniqueness. Unrestricted uniqueness — among *arbitrary* nonnegative roots, not only ones + already known to lie in `ClosedGeneratedByOne a` — is now also proved, in + `JB/GeneratedByOne/SquareRootUniqueness.lean`, as `jordanSqrt_eq_of_nonneg_of_mul_self` and its + restatement `eq_of_nonneg_of_mul_self_eq_mul_self`. The argument is genuinely multielement: it + never treats `a` and an arbitrary root `b` as if they lay in one common associative algebra. + Instead it introduces an ambient-independent polynomial evaluation `jordanPolyEval x p` + (repeated Jordan multiplication of `x` by itself, weighted by `p`'s coefficients), proves that + evaluating inside *any* closed one-generator algebra containing `x` coerces to this same + ambient-independent value (`aevalCoe_eq_jordanPolyEval`), and uses that to get the purely + algebraic identity `jordanPolyEval b (p.comp (X^2)) = jordanPolyEval a p` whenever `b * b = a`. + Because this identity holds on the nose (not merely in a limit), approximating each side + independently — `b`'s side by its own polynomial functional calculus using `b ≥ 0`, `a`'s side + by its own calculus using `a ≥ 0` and the classical Weierstrass approximation of `√·` on + `[0, ‖a‖]` — forces `b` and `jordanSqrt a ha` to coincide by an `ε`-argument + (`norm_jordanPolyEval_sub_jordanCfc_le`). No projection-valued spectral theorem, joint + functional calculus, or Stage D/E machinery is used; +2. **Complete:** `JBAlgebra.nonneg_iff_exists_mul_self` proves `0 ≤ a` iff + `a = b * b` for some `b`, intrinsically by passing to `ClosedGeneratedByOne a` and coercing + its local witness back to the ambient JB algebra. The remaining work is selection and + uniqueness of the nonnegative witness, not another cone theorem; +3. **Complete:** `jordanPosPart` and `jordanNegPart` are defined directly by the intrinsic CFC + functions `max x 0` and `max (-x) 0`. They are nonnegative, + `jordanPosPart a - jordanNegPart a = a`, and are Jordan-orthogonal. `jordanAbs` is likewise + intrinsic, nonnegative, and squares to `a * a`. The decomposition is now also packaged as + `jordanAbs_eq_jordanPosPart_add_jordanNegPart`, with each part bounded above by `jordanAbs` + and the fundamental bounds `-jordanAbs a ≤ a ≤ jordanAbs a`. Its definiteness is explicit as + `jordanAbs_eq_zero_iff`, using the JB zero-square criterion rather than a representation. + Positivity restricts the intrinsic spectrum as expected: `jordanAbs_eq_self_of_nonneg`, + `jordanPosPart_eq_self_of_nonneg`, and `jordanNegPart_eq_zero_of_nonneg` expose the resulting + cone simplifications. The converses are now packaged as + `jordanAbs_eq_self_iff_nonneg` and `jordanNegPart_eq_zero_iff_nonneg`, so this local CFC + calculus recognizes positivity exactly. Dually, + `jordanPosPart_eq_zero_iff_nonpos` recognizes nonpositivity through the exact CFC order + equivalence; +4. **Complete:** derive order preservation of special embeddings from the exact cone theorem. + `JBAlgebra.IsSpecialWitness.map_nonneg` transports a source square witness through the unital + Jordan embedding, and `.monotone` derives monotonicity from that theorem. Positivity is thus + not duplicated as an extra specialness field; +5. prove Jordan projections are exactly the extreme effects; +6. derive positivity and sharper norm bounds for `U_a`. + +These are theorems of JB theory, not fields of `IsJordanOrderUnit`. + +**Status of items 5–6 (checked, not yet started):** both remain genuinely blocked on Stage A +item 1, not merely unattempted busywork. The standard proof of JB positivity of `U_a` (item 6) +needs either the general multivariable fundamental formula (`U_a = 2 L_a^2 - L_{a^2}` together +with an operator-monotonicity argument, or the polarized cubic/quartic identities) or a genuine +spectral-projection argument; Stage A item 1 records that the fundamental formula is proved only +on one-generated associative sectors so far, with the general multivariable case explicitly still +open ("Continue by polarizing the cubic analogue..."). Root uniqueness (item 1, now complete) +deliberately avoided this dependency by using an ambient-independent single-variable polynomial +identity instead of the fundamental formula; that trick does not extend to `U_a` positivity, whose +statement is inherently about a bilinear/quadratic map and does not reduce to a one-generator +approximation argument. Item 5 (projections are exactly the extreme effects) additionally needs a +notion of extreme point for the effect order-interval, which does not yet exist anywhere in +`OrderUnit/Effect/`; introducing it is a small independent slice, but the hard direction of the +theorem (an extreme effect is a projection) still appears to need `U_a` positivity or an equivalent +spectral fact. Both items should be resumed only after Stage A item 1 lands, not attempted by a +shortcut that would special-case them. + +### Stage D: multivariable commutative fragments + +1. **Closure carrier complete:** `Power/Generated.lean` defines `generatedBySet s` as the least + unital real submodule closed under Jordan multiplication and containing `s`; it proves the + universal property, product closure, and the exact singleton identification + `generatedBySet {a} = generatedByOne a`. `generatedByTwo a b` is the resulting genuine + two-observable carrier; its subtype `GeneratedBySet s` inherits the ambient unital real + commutative Jordan algebra structure, and `GeneratedByTwo a b` names the corresponding type. + It intentionally has no associative-ring instance: supplying one is precisely the unresolved + two-generator specialness/Shirshov--Cohn theorem, not a closure convenience. +2. Relate operator compatibility to associativity of the generated subalgebra under the correct + hypotheses. +3. Construct joint continuous functional calculus for finite compatible families. +4. Derive joint laws and covariance transformations from the generic statistics API. + +### Stage E: JBW spectral and measure theory + +1. **Complete:** `MonotoneCompleteOrder.directedSup` is the single chosen directed supremum; + `JBWAlgebra.isLUB_directedSup_normal_state_image` proves normal-state preservation at that + generality. The increasing-sequence `rangeSup` statement is derived from it rather than + maintaining a parallel proof. +2. Before claiming a reverse normality transport, align the domains of the two predicates: an + arbitrary directed set with a supremum need not have a common lower bound and cannot generally + be shifted into the positive cone. Use either a bounded-below state-normality predicate or a + strengthened weight predicate, then prove the representation theorem at that matched level. +3. **Complete:** `JordanOrderUnit/ProjectionResolution.lean` defines the generic + `MeasurableProjectionResolution α E` as an extension of the existing + `EffectValuedMeasure α E`, rather than a duplicated PVM carrier. Its events are intrinsic + Jordan projections, multiplication computes measurable intersection, and its inherited + countable-additivity is the order-theoretic `IsLUB` of partial sums. The JBW specialization + supplies normal-state probability laws and normal-state separation extensionality. +4. Construct projection-valued spectral measures for observables and prove that normal states + scalarize them to ordinary finite measures. State extensionality through this separating + normal-state family. +5. **Partially complete:** `MeasurableProjectionResolution.boundedBorel` reuses the existing + complete order-unit `EffectValuedMeasure.integral`, rather than creating a second Borel + integral. It has positivity, real linearity, and the fundamental + `boundedBorel_indicator` law recovering each event projection. Bound independence is exposed + as `boundedBorel_indep_of_bound`, and `boundedBorelEffect` packages every measurable + `[0,1]`-valued function as an `Effect E`; these are shared resolution laws, not a JBW-only + duplicate. What remains is the genuinely JBW-specific part: construct the resolution of an + observable, prove multiplicativity on its one-observable commutative sector, and prove + monotone convergence there. +6. **Partially complete:** normal-state scalarization already gives `ProbabilityMeasure` laws for + a projection resolution, and equality of those laws for every normal state is now the proved + operational extensionality criterion + `MeasurableProjectionResolution.eq_of_forall_normal_probabilityLaw_eq`. `EffectValuedMeasure.map_simpleIntegral` and + `scalarize_simpleIntegral` prove finite naturality, and the new generic + `EffectValuedMeasure.map_integral` proves bounded-integral naturality for every normal channel + between complete order-unit spaces. The remaining scalar statement is not another analytic + limit proof: it must transport that theorem through explicit order-unit-norm copies of both + source and scalar target. The necessary scalar topology boundary is now explicit: + `WithOrderUnitNorm.realLinearIsometryEquiv` identifies the order-unit-norm copy of `ℝ` with + ordinary `ℝ` and transports completeness there. The remaining proof must formulate the + scalar mesh limit through that copy (rather than attempting to register a second global norm + instance on `ℝ`) and then apply this isometry; it must not silently mix the two norm instances. + More generally, `JBAlgebra.toWithOrderUnitNormLinearIsometryEquiv` now identifies every + ordered JB algebra's ambient JB norm with its `WithOrderUnitNorm` copy, and + `JBAlgebra.completeWithOrderUnitNorm` transports Banach completeness to that copy. The + remaining measure-theoretic step is therefore explicitly a transport of an + `EffectValuedMeasure`/projection resolution to the copy, never a local replacement of `E`'s + metric instance. `MeasurableProjectionResolution.toWithOrderUnitNormChannel` now provides + that identity order isomorphism as a proved normal channel, and + `boundedBorelWithOrderUnitNorm` integrates its pushed-forward effect-valued measure in the + completed copy. The next scalar theorem must compose this copied calculus with + `WithOrderUnitNorm.realLinearIsometryEquiv`, not reintroduce an integral on raw `ℝ` by a second + limit construction. **Complete:** `EffectValuedMeasure.scalarCopyIntegral` now supplies + completeness for the exact locally fixed order-unit topology used by the generic bounded + integral, closing the instance boundary which previously prevented the scalar copy from being + integrated. `MeasurableProjectionResolution.scalarBoundedBorelWithOrderUnitNorm` integrates + the twice-pushed-forward resolution there, and `scalarBoundedBorel` applies the real-line + isometry only afterwards. This is the single scalar limit path. + +The Hilbert-space `WOTSpectralMeasure` and maximal unbounded spectral integral are a concrete +special-JBW realization of this bounded projection-resolution layer. They retain the additional +square-moment-domain data needed for affiliated unbounded operators. Do not move that domain +theory into bare JBW algebras, and do not use the complex Cayley transform as an abstract-JBW +primitive. + +## 5. File discipline + +- Abstract algebra/order/JB files may not import `CStarAlgebra` or `WStarAlgebra`. +- Realization files may import abstractions and instantiate them. +- A theorem is moved downward whenever its proof does not use the stronger layer. +- Parallel notation is acceptable only as a zero-proof abbreviation of the canonical definition. +- A representation-equivalence file is acceptable when both sides are independently meaningful; + it is named `Equivalence` or by the construction, never generically `Bridge`. +- Placeholder declarations using `sorry`, `admit`, or new axioms are forbidden. +- Public imports are added only after a module builds independently. + +## 6. Verification gates + +Every slice is complete only when: + +1. each touched module compiles without warnings; +2. the full `PhyslibAlpha.lean` import surface builds; +3. `rg '\b(sorry|admit|axiom)\b'` is clean in executable Lean code in the migrated layer; +4. `git diff --check` passes; +5. repository import and style linters pass; +6. no new dependency points from an abstract layer to a concrete realization; +7. declarations expose the weakest hypotheses actually used. + +## 7. Next implementation slice + +**B1, B2, and B3 are complete.** The intrinsic path is now executable end-to-end through the +real JB spectral-radius theorem: + +1. `PositiveInvertibility.lean` proves endpoint summability of the half-binomial series by the + Catalan telescoping majorant, its absolute Cauchy-product identity, and + `halfBinomialSqrt_mul_self` on the closed unit ball. +2. It derives local exact positivity-as-squares, positive-unit iff order-interior, and the + norm-endpoint cone-boundary lemma, all in `ClosedGeneratedByOne a` and with no Cstar import. +3. `Spectrum.lean` turns that boundary result into + `norm_or_neg_norm_mem_spectrum`, `jordanSpectralRadius_eq_norm`, and + `jordanSpectrum_nonempty`. + +The real polynomial spectral-mapping slice of **B4 is complete**: +`NormedJordanAlgebra.jordanSpectrum_aeval` combines the existing forward inclusion with an +intrinsic real factorization induction. It factors `p(X) - μ` into linear factors and +irreducible quadratics; each quadratic is completed to `(X-c)^2+d^2` with `d ≠ 0` and shown to +evaluate to a strictly positive unit using B2. A nonunit product therefore has a nonunit linear +factor, which is the desired real spectral preimage. No Cstar, complexification, or generic-CFC +route is used. + +The B4 norm slice is also complete: `nnnorm_aeval_closedGenerator` and +`norm_aeval_closedGenerator` combine exact mapping with B3 to identify the norm with the real +spectral supremum of the restricted polynomial. **B5 is complete as well**: the bundled +isometric homomorphism `jordanCfcHom`, its surjectivity, and the resulting algebra equivalence +`jordanCfcEquiv` now identify `C(jordanSpectrum a, ℝ)` intrinsically with +`ClosedGeneratedByOne a`. + +**Stage C.2 is now complete.** Unrestricted uniqueness of the positive square root +(`jordanSqrt_eq_of_nonneg_of_mul_self`, `eq_of_nonneg_of_mul_self_eq_mul_self`) is proved in the new +file `JB/GeneratedByOne/SquareRootUniqueness.lean`, via the ambient-independent polynomial +evaluation `jordanPolyEval` described above. The global exact-cone theorem, canonical positive-root +existence theorem, positive/negative-part decomposition, order preservation of special embeddings, +and now root uniqueness are all complete. + +The remaining Stage C items (5: projections are exactly the extreme effects; 6: JB positivity and +sharper norm bounds for `U_a`) were investigated but are genuinely blocked: both need either the +general multivariable fundamental formula or an equivalent spectral-projection fact, neither of +which exists yet. Stage A item 1 (promoting the fundamental formula for `U` from one-generated +associative sectors to arbitrary elements via multivariable polarization) is the correct +prerequisite and remains the next vertical slice on the critical path. + +**Correction to the previous writeup, checked this session:** the "still-missing piece" that the +previous writeup described as the next polarization pass — polarizing the degree-4 identity +`quadRep_mul_self_eq_comp` at `a ± b` — is **not** actually missing: it was already proved, one +session *earlier* than the cubic-law polarization, as `quadRep_add_square_polarized` / +`quadRep_sub_square_polarized` / `quadRepBilin_comp_self_polarization` (all already present in +`Quadratic/Fundamental.lean`, immediately above the triple-commutator section). So both halves the +previous writeup called for are in fact already on hand: + +- the degree-4 mixed identity `quadRepBilin_comp_self_polarization`: + `4 • (quadRepBilin a b).comp (quadRepBilin a b) = 4 • U (a*b) + 2 • quadRepBilin (a*a) (b*b) - + (U a).comp (U b) - (U b).comp (U a)`; +- the degree-(2,1,1) trilinear identity `quadRepBilin_mulLeft_polarization` / + `quadRepBilin_mulLeft_polarization'`. + +This session attempted the assembly of these two directly (matching what the previous writeup +already flagged as attempted-and-not-closed) and confirms the same negative finding, now with a +precise diagnosis of *why* it cannot close by further two-point (`a ± b`) polarization alone. +Expanding `U (U a b) x` via `quadRep_apply` produces `2 • (U a b) * ((U a b) * x) - (U a b)^[2] * x`, +i.e. every term is multiplication *by* the compound element `U a b = 2•a*(a*b) - a^[2]*b` itself, +not by `a` or `b` separately. Neither available identity supplies a normalization rule for +`(compound element) * y` in terms of separate `a`- and `b`-multiplications: `quadRepBilin_comp_self_polarization` +is a closed operator equation with no free "argument" slot to substitute `U a b` into, and +`quadRepBilin_mulLeft_polarization` only normalizes `U a (b * x)`/`b * (U a x)` — linear in a +*single* factor of `b`, whereas `U a b` itself is already bilinear `(2,1)` in `(a,b)`, so +substituting it as the outer variable of another application of the same lemma produces a +`(4,2)`/`(2,3)`-mixed term with no matching identity to reduce it further. This is the same +obstruction the classical algebraic proofs (Jacobson, McCrimmon) resolve only via the **Jordan +triple system fundamental identity** — the linearized triple-product law +`{a,b,{a,d,c}} = {{a,b,a},d,c} - {a,{b,a,d},c} + {a,d,{a,b,c}}` (writing `{·,·,·}` for +`jordanTriple`, already defined in `Quadratic/Triple.lean` with `{a,b,a} = U a b`) — or via +Macdonald's transfer theorem for special (associative-embeddable) Jordan algebras. Proving the +triple-system fundamental identity from the bare Jordan axiom is *not* a further two-point +polarization of an identity already on hand; it is a new, independently hard linearization (it is, +essentially, exactly as hard as the fundamental formula it is meant to prove — the identity and the +formula are inter-derivable), and Mathlib's own linearized commutator lemma +`two_nsmul_lie_lmul_lmul_add_add_eq_zero` (already used via `cyclic_mulLeft_commutator` in this +file) is the *two*-variable linearization of the Jordan axiom, not the triple-system identity: it +does not by itself supply the extra degree of freedom needed. No further short assembly of the +currently-available lemmas was found this session; forcing one was not attempted, per the "no fake +progress" rule, since every combination tried reduces to needing a normalization rule for +`(U a b) * y` that does not yet exist and cannot be manufactured from the two-point polarization +trick already used twice in this file. + +**Correction (checked again, this session): route 2 has now actually been attempted (see below) +and is confirmed not to close by itself; only route 1 remains open.** + +The concrete next attempt, for whichever session resumes this, should therefore *not* retry +two-point (`a ± b`) polarization a third time. It should instead attempt route 1 below (route 2 is +now confirmed exhausted, see the writeup after the numbered list): + +1. Directly formalize the Jordan-triple fundamental identity above as its own theorem, by the same + substitution-and-cancel method but linearizing in **three** independent triple-product slots at + once (substitute `a → a + b`, `d → d + e`, or similar, into an already-diagonal instance such as + `jordanTriple_diag` composed with `quadRep_mulLeft`/`quadRep_mul_self_eq_comp`, and take the + multi-point finite difference needed to isolate the fully mixed term). This is a strictly larger + calculation than either polarization already done in this file (more independent substitution + points, hence more simultaneous equations to combine), but uses no new machinery beyond `module` + and `linear_combination (norm := module)`, which have handled every polarization step so far. +2. Alternatively, formalize Macdonald's transfer principle for the one-relation case actually + needed here: since `mulLeft_triple_normalize` already reduces any `L (a * (b * c))` to a + polynomial in single/double-product multiplication operators, investigate whether the *same* + normalization, applied systematically to every multiplication appearing in the expansion of + `U (U a b) x`, terminates in a expression built only from `L_a`, `L_b`, `L_{a*a}`, `L_{b*b}`, + `L_{a*b}` (and their compositions) — i.e. whether the one-generated-by-two-elements associative + normal form already implicit in `mulLeft_triple_normalize` is strong enough to finish the + computation by pure linear algebra of operator compositions, without ever invoking the Jordan + triple identity as a separate black box. This has not been tried and may be more tractable than + (1), since it reuses `mulLeft_triple_normalize` directly instead of introducing new algebra. + +Either route is real, substantial work (on the order of the effort already spent on the cubic-law +polarization, or more), not a short patch. + +**Route 2 attempted (this session): makes genuine progress at its first level, then provably +stalls at the second, with the obstruction now precisely characterized rather than assumed.** +Pushing `mulLeft_triple_normalize` further does yield a real, previously-unestablished theorem: +`mulLeft_quadRep_normalize` in `Quadratic/Fundamental.lean` normalizes `L (U a b)` completely, with +no remaining atom of the same bidegree as `U a b` itself: + +```text +L (U a b) = 2 • (L a).comp (L (a * b)) + (L b).comp (L (a * a)) + - 2 • ((L a).comp (L a)).comp (L b) - 2 • ((L b).comp (L a)).comp (L a) + + 2 • ((L a).comp (L b)).comp (L a) +``` + +obtained by applying `mulLeft_triple_normalize` once to `a * (a * b)` and once to `b * (a * a)` +(identifying `jpow a 2 * b` with `b * (a * a)` by commutativity), then taking the exact +`2 • (first) - (second)` combination matching `quadRep_apply`'s own expansion of `U a b`. This is +real headway: `L (U a b)` was not previously known in closed form. + +However, this does **not** propagate to a second level. `quadRep_quadRep_eq`, also now proved, +gives the exact reduction + +```text +U (U a b) = 4 • U (a * (a * b)) - 4 • quadRepBilin (a * (a * b)) (jpow a 2 * b) + U (jpow a 2 * b) +``` + +by bare bilinearity of `quadRepBilin` in `quadRep_apply`'s expansion `U a b = 2 • (a * (a * b)) - +jpow a 2 * b` (no Jordan identity needed for this step — it is proved `omit [IsCommJordan E]`). +The diagnosis this makes precise: `a * (a * b)` and `jpow a 2 * b` are themselves elements of +exactly the same bidegree `(2, 1)` in `(a, b)` as `U a b` itself. So this identity trades the +single degree-`(4, 2)`-operator problem `U (U a b)` for **three** subproblems of the identical +difficulty (`U (a * (a * b))`, `U (jpow a 2 * b)`, and their cross-effect +`quadRepBilin (a * (a * b)) (jpow a 2 * b)`), not for anything simpler — there is no smaller base +case to induct into. Repeating `mulLeft_quadRep_normalize`-style operator normalization on these +new targets does not terminate the way it did for `L (U a b)`, because the compound arguments +`a * (a * b)` and `jpow a 2 * b` are exactly as far from being "generators" as `U a b` was; the +normalization only ever shifts the same bidegree around among bilinear cross-effects, it never +reduces it. Route 2 is therefore confirmed exhausted as a *self-contained* strategy: it cannot +close the fundamental formula without eventually invoking the same extra degree of freedom that +the Jordan-triple fundamental identity supplies. Route 1 (formalizing that identity) remains the +correct next step, now with the added benefit that `mulLeft_quadRep_normalize` and +`quadRep_quadRep_eq` are themselves reusable lemmas (e.g. as sanity checks or partial computation +shortcuts) for whichever session attempts it. + +**Update (this session): the "linear substitution" half of route 1 is now rigorously excluded, not +just empirically untried.** Before attempting a Lean proof of the triple identity +`{a, b, {a, d, c}} = {{a, b, a}, d, c} - {a, {b, a, d}, c} + {a, d, {a, b, c}}` by hand, this session +first checked, by an independent offline linear-algebra computation (not a Lean tactic search), +exactly how much of it the *linear* span of `cyclic_mulLeft_commutator` instances can reach. The +computation: represent the free **commutative, non-associative** ℚ-algebra on formal generators +`a, b, c, d` by canonical binary-tree monomials (commutative at every node, no associativity +imposed); implement `jordanTriple` and `U` literally by their defining formulas as bilinear/ +quadratic operations on these formal polynomials; expand both sides of the target identity to get +a target difference vector (33 nonzero monomials — confirmed nonzero, so the identity is a genuine +consequence of the Jordan axiom, not a formal identity of the raw definitions); then generate every +instance of `cyclic_mulLeft_commutator (p, q, r, x)` obtainable by substituting, into its four +argument slots, either one of `a, b, c, d` (with repetition) or a single degree-2 product of two of +them, subject to the four slots jointly consuming exactly the multiset `{a, a, b, c, d}` (the only +degree split compatible with a degree-5 target from a multilinear degree-4 identity is +`(2, 1, 1, 1)`, so this enumeration is exhaustive for *any* single-compound-slot substitution, and +by multilinearity of `cyclic_mulLeft_commutator` in each of its four slots, every linear combination +of instances at summed arguments — such as the `a ± b` polarization trick used throughout +`Fundamental.lean` — already reduces to a linear combination of these same atomic/single-compound +instances, so the enumeration also covers every identity in this file provable by that trick, +including `mulLeft_triple_normalize`, `quadRepBilin_mulLeft_polarization`, and their kin evaluated +at a compound point). Result: 132 relation instances span a 25-dimensional subspace of the +60-dimensional degree-`(2,1,1,1)` monomial space, and adjoining the target difference raises the +rank to 26 — i.e. the target is **provably outside the span**. This means no amount of further +`linear_combination`-style assembly of sums/differences of `cyclic_mulLeft_commutator` instances +(equivalently, of any identity in this file derived from it purely by the `a ± b`-substitution +technique) can close the triple identity, no matter how many substitution points are tried; the +earlier "both routes exhausted by attempt" finding for the closely related `U (U a b)` target is +therefore now reinforced by an actual rank computation for the triple-identity target specifically, +not merely inferred from the two problems' inter-derivability. Closing the triple identity +necessarily requires a genuinely **non-linear** composition step — squaring/multiplying two +already-derived identities together (as `quadRepBilin_comp_self_polarization` did via +`quadRep_add_mul_self_eq_comp`, or as route 2's `mulLeft_quadRep_normalize` / +`quadRep_quadRep_eq` did via operator composition) rather than a further linear substitution — and +route 2's own composition attempt already stalls at exactly this kind of step for the parity target. +The concrete recommendation for whoever resumes: do not spend further effort on `a ± b`-style linear +polarization variants of the triple identity (this is now excluded by direct computation, not +assumption); the remaining open avenues are (a) a genuine two-step nonlinear composition specific to +the triple-product form (not yet attempted, since route 2's composition attempt was carried out only +in the `U`/operator formulation, not the `jordanTriple` formulation, and the two need not stall at +the identical point), or (b) Macdonald's transfer principle for special Jordan algebras, which is a +structural/representational argument rather than a polynomial-identity manipulation and would need +its own development (e.g. via the one-generated-by-two-elements associative sector already partly +explored in `mulLeft_quadRep_normalize`'s proof). No new Lean declarations were added this session +in `Quadratic/Triple.lean` or `Quadratic/Fundamental.lean`, since no proof attempt succeeded and +`§5` forbids landing a `sorry`; the verification script and its exact method are recorded here so +the negative result does not need to be rediscovered. + +Once Stage A item 1 lands, Stage C items 5–6 become tractable, and only after that does the +intrinsic JBW spectral resolution of an observable (Stage E items 4–5) become fully load-bearing: +`ProjectionResolution.lean` and `scalarBoundedBorel` already supply the shared bounded Borel +calculus engine, but constructing the resolution *of an observable* genuinely needs `U_a` +positivity to build its spectral projections order-theoretically. Do not attempt Stage E ahead of +Stage A item 1 by substituting a concrete (Cstar/Hilbert-space) spectral measure for the missing +abstract step; that would violate the file-discipline rule that abstract JB/JBW files must not +import a concrete realization. + +**Update (this session): route 2 attempted and confirmed exhausted; route 1 is now the only open +path.** Two new theorems are proved in `Quadratic/Fundamental.lean`: + +- `mulLeft_quadRep_normalize`: a genuine, previously-missing closed form for `L (U a b)` purely in + terms of compositions of `L a`, `L b`, `L (a * a)`, `L (a * b)` — obtained by pushing + `mulLeft_triple_normalize` a further step, exactly the "route 2" candidate this roadmap flagged + as untried. +- `quadRep_quadRep_eq`: the exact bilinear reduction + `U (U a b) = 4 • U (a * (a * b)) - 4 • quadRepBilin (a * (a * b)) (jpow a 2 * b) + U (jpow a 2 * b)`, + proved from bare `quadRepBilin` bilinearity with no Jordan-identity input. + +Together these show route 2 cannot self-terminate: `L (U a b)` normalizes cleanly (first level), +but the resulting `U (U a b)` reduction lands on three new subproblems (`U (a * (a * b))`, +`U (jpow a 2 * b)`, and their `quadRepBilin` cross-effect) of the *same* `(2, 1)`-bidegree +difficulty as the original `U a b`, not a smaller one — there is no base case to induct on this +way. **Stage A item 1's correct next step is therefore unambiguously route 1**: formalize the +Jordan-triple fundamental identity +`{a, b, {a, d, c}} = {{a, b, a}, d, c} - {a, {b, a, d}, c} + {a, d, {a, b, c}}` in +`Quadratic/Triple.lean` by genuine multi-point linearization, as described above. `Quadratic/ +Fundamental.lean`'s existing lemmas (`mulLeft_triple_normalize`, `mulLeft_quadRep_normalize`, +`quadRep_quadRep_eq`, `quadRepBilin_comp_self_polarization`, +`quadRepBilin_mulLeft_polarization`/`'`) are all available as reusable building blocks or sanity +checks for that attempt, but none of them, individually or combined, supply the missing degree of +freedom by themselves. + +**Route 1 landed (2026-09-13).** Rather than proving the triple identity directly by linearization +(shown separately, by an independent offline rank computation, to be unreachable by *linear* +substitution alone — see the addendum above), the identity was obtained instead via the standard +Jordan-triple-system operator toolkit, which supplies exactly the missing nonlinear degree of +freedom. New declarations, all in `Quadratic/Fundamental.lean` (the inner-derivation primitive +itself, `innerDerivation`/`innerDerivation_apply`/`innerDerivation_swap`/`innerDerivation_self`, +lives in `Operator.lean`, at the weakest level — bare `NonAssocCommRing` — since it is independently +useful infrastructure beyond this one theorem): + +- `innerDerivation_add_left`/`_smul_left`/`_add_right`/`_smul_right`/`_sub_left`/`_sub_right`: + bilinearity of `D_{a,b} := [L_a, L_b]` in both defining arguments. +- **`innerDerivation_mul`** (the key nonlinear fact): `D_{a,b}` is a genuine derivation of the + Jordan product, `D_{a,b}(x*y) = (D_{a,b}x)*y + x*(D_{a,b}y)`. Proved from exactly two atomic + instances of `cyclic_mulLeft_commutator` (`cyclic_mulLeft_commutator a x y b` and + `cyclic_mulLeft_commutator b x y a`), composed rather than linearly polarized — this is precisely + the nonlinear composition step the rank computation showed no linear substitution could reach. +- `innerDerivation_mulLeft_comm`: the derivation law restated as an operator commutator, + `[D_{a,b}, L_x] = L_{D_{a,b}x}`. +- `innerDerivation_comm`: the double commutator + `[D_{a,b}, D_{c,d}] = D_{D_{a,b}c,d} + D_{c,D_{a,b}d}`, pure associative operator algebra from the + above. +- `innerDerivation_mul_left`: `D_{a*b,q} = D_{a,b*q} + D_{b,a*q}`, from one further atomic instance + of `cyclic_mulLeft_commutator`. +- `tripleOperator`/notation `V`, `triple_eq_V_apply`: `V_{a,b} := L_{a*b} + D_{a,b}` computes the + Jordan triple product in its middle slot, `V_{a,b}x = {a,b,x}`. +- **`tripleOperator_comm`** (the target): `[V_{a,b}, V_{c,d}] = V_{\{a,b,c\},d} - V_{c,\{b,a,d\}}`, + the operator form of the Jordan-triple-system fundamental identity, proved entirely from the + building blocks above plus `cyclic_mulLeft_commutator`. Applying both sides to any element gives + the classical identity `{a,b,{c,d,e}} = \{\{a,b,c\},d,e\} - \{c,\{b,a,d\},e\} + \{c,d,\{a,b,e\}\}`; + setting `c := a` gives the originally-targeted three-variable identity. + +All new declarations build clean, no `sorry`/`admit`/`axiom`; full `lake build PhyslibAlpha`, 9008 + +## 2026 correction: the general quadratic fundamental formula is complete + +The historical passages above which describe Stage A item 1, Stage C items 5--6, or the +Jordan-triple fundamental identity as blocked are superseded by the current executable source. +`Quadratic/Fundamental.lean` now proves, at bare real commutative-Jordan generality, + +```text +quadRep_fundamental_apply : U (U x y) z = U x (U y (U x z)) +quadRep_fundamental : U (U x y) = U x ∘ U y ∘ U x. +``` + +The proof goes through `tripleOperator_comm`, `V_quadRep_eq_quadRep_triple`, and a direct +three-variable triple-product calculation; it is neither a one-generated restriction nor a +special/Cstar transfer. Consequently, the next critical theorem is **positivity of `U a` for a +JB order-unit algebra**, followed by its norm bounds and the extreme-effect/projection theorem. +Those results must use this now-proved formula (or an equally intrinsic spectral argument), and +must not retain any claim that the formula itself is missing. + +### Correction on quadratic positivity + +The fundamental formula is necessary algebraic infrastructure but is not, by itself, a proof that +`U a` preserves the JB positive cone. The standard JB route is the **Shirshov--Cohn theorem**: +the unital JB subalgebra generated by the two elements `a` and `b` is special, where the desired +claim becomes `U a b = a b a ≥ 0` for `b ≥ 0`. Formalizing this two-generator specialness theorem +(or an equivalent intrinsic JB positivity theorem) is therefore the actual missing prerequisite +for Stage C.5--C.6. It must be developed at the JB level and cannot be replaced by the existing +one-generator CFC or by merely restating `U`-positivity as a class field. +jobs, 0 errors, only pre-existing unrelated warnings in `HilbertSpace/Unbounded/...`. + +**Superseded — Stage A item 1 is now complete**, per the "2026 correction" section above: +`quadRep_fundamental`/`quadRep_fundamental_apply` prove `U (U x y) = U x ∘ U y ∘ U x` at full +generality (`tripleOperator_quadRep_step` and `V_quadRep_eq_quadRep_triple` are the two intermediate +lemmas that close the gap from `tripleOperator_comm` to this target). Full `lake build PhyslibAlpha`, +9015 jobs, 0 errors, no `sorry`/`admit`/`axiom`. **The concrete resume point is now Stage C.5–6 / +Stage A item 2**, per the "Correction on quadratic positivity" section immediately above: JB +positivity of `U_a` needs the Shirshov–Cohn two-generator specialness theorem (or an equivalent +intrinsic JB positivity argument), not merely the fundamental formula proved here. diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Lueders.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Lueders.lean new file mode 100644 index 0000000000..b82bc71a35 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Lueders.lean @@ -0,0 +1,131 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Quadratic.Order +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Conditioning +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.JB.GeneratedByOne.SquareRootUniqueness +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Operation + +/-! + +# Lüders operations in an ordered JB algebra + +An effect `e` has an intrinsic positive square root supplied by one-observable JB functional +calculus. The quadratic representation of that root is the Jordan Lüders operation + +`x ↦ U_(sqrt e) x`. + +Quadratic positivity is kept as an explicit ordered-Jordan capability. Its eventual intrinsic +JB proof will make these definitions available to every genuine ordered JB algebra; concrete +models already discharge it independently. + +-/ + +@[expose] public section + +namespace NormedJordanAlgebra + +open JordanAlgebra +open scoped JordanAlgebra + +variable {E : Type*} [NormedJordanAlgebra E] [JBAlgebra E] [Nontrivial E] [PartialOrder E] + [IsOrderedAddMonoid E] [IsArchimedeanOrderUnit E] [PosSMulMono ℝ E] [IsJBOrderUnit E] + [IsQuadraticallyPositive E] + +/-- The intrinsic positive square root selected by the JB continuous functional calculus for an +effect. -/ +noncomputable def effectSqrt (e : Effect E) : E := + jordanSqrt (e : E) e.2.1 + +/-- The Lüders operation of an effect: the positive quadratic operation induced by its square +root. In a special Jordan algebra it is precisely `x ↦ sqrt(e) x sqrt(e)`. -/ +noncomputable def luedersMap (e : Effect E) : E →ₚ[ℝ] E := + quadRepPositiveLinearMap (effectSqrt e) + +@[simp] +theorem luedersMap_apply (e : Effect E) (x : E) : luedersMap e x = U (effectSqrt e) x := + rfl + +/-- A Lüders operation sends the order unit to its effect. Thus its probability in a state is +exactly the probability assigned to that effect. -/ +theorem luedersMap_one (e : Effect E) : luedersMap e (1 : E) = e := by + rw [luedersMap_apply, quadRep_apply_one, jpow_two] + exact jordanSqrt_mul_self (e : E) e.2.1 + +/-- The Lüders map is an operation: it is positive and its outcome probability never exceeds +certainty. Its outcome effect is the original effect, so this is the intrinsic Jordan analogue +of a single-Kraus measurement operation. -/ +noncomputable def luedersOperation (e : Effect E) : Operation E := + ⟨luedersMap e, by simpa only [luedersMap_one] using e.2.2⟩ + +@[simp] +theorem luedersOperation_apply (e : Effect E) (x : E) : luedersOperation e x = luedersMap e x := + rfl + +/-- The effect recorded by the Lüders operation is exactly the effect it implements. -/ +theorem luedersOperation_outcomeEffect (e : Effect E) : + (Operation.outcomeEffect (luedersOperation e) : E) = e := by + rw [Operation.coe_outcomeEffect, luedersOperation_apply, luedersMap_one] + +omit [IsQuadraticallyPositive E] in +/-- The CFC square root of a sharp Jordan event is the event itself. This is the point where +the general effect operation recovers projection compression. -/ +theorem effectSqrt_toEffect_of_projection {p : E} (hp : IsJordanProjection p) : + effectSqrt hp.toEffect = p := by + change jordanSqrt p hp.nonneg = p + exact (jordanSqrt_eq_of_nonneg_of_mul_self p hp.nonneg p hp.nonneg hp).symm + +/-- Lüders filtering by a sharp event is exactly quadratic compression by that projection. -/ +theorem luedersMap_toEffect_of_projection {p : E} (hp : IsJordanProjection p) : + luedersMap hp.toEffect = quadRepPositiveLinearMap p := by + rw [luedersMap, effectSqrt_toEffect_of_projection hp] + +/-- The normalized post-measurement state associated with an effect of nonzero probability. -/ +noncomputable def luedersCondition (ω : 𝓢[ℝ, E]) (e : Effect E) (hmass : 0 < ω e) : + 𝓢[ℝ, E] := + (luedersOperation e).condition ω (by + simpa only [luedersOperation_apply, luedersMap_one] using hmass) + +/-- Formula for the normalized state after the Lüders operation. -/ +@[simp] +theorem luedersCondition_apply (ω : 𝓢[ℝ, E]) (e : Effect E) (hmass : 0 < ω e) (x : E) : + luedersCondition ω e hmass x = (ω e)⁻¹ * ω (U (effectSqrt e) x) := by + rw [luedersCondition, Operation.condition_apply] + change (ω (luedersOperation e 1))⁻¹ * ω (luedersOperation e x) = + (ω e)⁻¹ * ω (U (effectSqrt e) x) + rw [luedersOperation_apply, luedersMap_one, luedersOperation_apply, luedersMap_apply] + +/-- The normalized Lüders state evaluates the unit to one. -/ +theorem luedersCondition_one (ω : 𝓢[ℝ, E]) (e : Effect E) (hmass : 0 < ω e) : + luedersCondition ω e hmass 1 = 1 := + (luedersCondition ω e hmass).map_one + +/-- In a JBW application, once the Lüders operation is known to preserve directed suprema, +conditioning a normal state by a nonzero-probability effect remains normal. Normality of the +quadratic operation itself is the remaining intrinsic JBW quadratic-order theorem. -/ +theorem luedersCondition_isNormal (ω : 𝓢[ℝ, E]) (e : Effect E) (hmass : 0 < ω e) + (hOp : (luedersOperation e).IsNormal) (hω : ω.IsNormal) : + (luedersCondition ω e hmass).IsNormal := + Operation.condition_isNormal (luedersOperation e) ω (by + simpa only [luedersOperation_apply, luedersMap_one] using hmass) hOp hω + +/-- For a sharp event, the general Lüders conditional state is exactly the quadratic projection +conditional state. Thus effect conditioning extends projection conditioning rather than creating +a second measurement semantics. -/ +theorem luedersCondition_toEffect_of_projection {p : E} (hp : IsJordanProjection p) + (ω : 𝓢[ℝ, E]) (hmass : 0 < ω p) : + luedersCondition ω hp.toEffect hmass = hp.conditionOfQuadraticPositive ω hmass := by + apply UnitalPositiveLinearMap.ext + intro x + have hmass' : 0 < ω (hp.toEffect : E) := by simpa using hmass + change luedersCondition ω hp.toEffect hmass' x = + hp.conditionOfQuadraticPositive ω hmass x + rw [luedersCondition_apply, IsJordanProjection.conditionOfQuadraticPositive_apply, + effectSqrt_toEffect_of_projection hp] + simp only [hp.coe_toEffect] + +end NormedJordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Observable.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Observable.lean new file mode 100644 index 0000000000..0765998763 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Observable.lean @@ -0,0 +1,233 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Operator +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.Basic +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Effect.Basic +public import PhyslibAlpha.AlgebraicFramework.Algebra.Statistics + +/-! + +# Moments, variance, and Jordan projections + +## i. Overview + +This file connects the bare Jordan-power API of `Operator.lean` to the existing state/effect +physics API from `OrderUnit`: + +- `moment n ω a := ω (a ^[n])` is the `n`-th moment of the observable `a` in the state `ω`. +- `variance ω a` is the generic `LinearMap.variance` of the state's underlying functional. In a + Jordan algebra it is `Var_ω(a) = ω(a²) - ω(a)²`. +- A **Jordan projection** is `p` with `p ∘ p = p`; two Jordan projections are **orthogonal** when + `p ∘ q = 0`. These are the Jordan-algebraic analogues of `Effect.IsSharp`/`Effect.Orthogonal` + (`OrderUnit/Effect/Basic.lean`) — in the canonical C⋆-algebra realization the two notions of + projection and orthogonality agree exactly with the star-algebra ones + (`CStarAlgebra/SharpEffect.lean`), which is what `CStarAlgebra/Jordan.lean` verifies. + +## ii. Key definitions and results + +- `IsJordanOrderUnit.moment`, `IsJordanOrderUnit.variance` +- `IsJordanOrderUnit.IsJordanProjection` +- `IsJordanOrderUnit.JordanOrthogonal` +- `JordanAlgebra.IsJordanProjection.toEffect` : a projection as an effect +- `JordanAlgebra.IsJordanProjection.quadRep_self`/`.quadRep_jordanOrthogonal` : `U_p` as + Jordan-algebraic compression onto the event `p` + +## iii. Table of contents + +- A. Moments and variance +- B. Jordan projections and orthogonality +- C. Compression: `U_p` for an idempotent `p` + +-/ + +@[expose] public section + +namespace IsJordanOrderUnit + +open JordanAlgebra +open scoped JordanAlgebra + +variable {E : Type*} [NonAssocCommRing E] [PartialOrder E] [IsOrderedAddMonoid E] + [Module ℝ E] [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] [IsCommJordan E] + [IsOrderUnit E] [IsJordanOrderUnit E] + +/-! ## A. Moments and variance -/ + +/-- The `n`-th moment of the observable `a` in the state `ω`: `moment_n(ω, a) = ω(a^n)`. -/ +def moment (n : ℕ) (ω : 𝓢[ℝ, E]) (a : E) : ℝ := ω (a ^[n]) + +omit [IsOrderedAddMonoid E] [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] + [IsCommJordan E] [IsOrderUnit E] [IsJordanOrderUnit E] in +@[simp] theorem moment_zero (ω : 𝓢[ℝ, E]) (a : E) : moment 0 ω a = 1 := by + simp [moment] + +omit [IsOrderedAddMonoid E] [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] + [IsCommJordan E] [IsOrderUnit E] [IsJordanOrderUnit E] in +@[simp] theorem moment_one (ω : 𝓢[ℝ, E]) (a : E) : moment 1 ω a = ω a := by + simp [moment] + +/-- The variance of the observable `a` in the state `ω`, inherited from the generic covariance +form of its underlying linear functional. -/ +def variance (ω : 𝓢[ℝ, E]) (a : E) : ℝ := LinearMap.variance ω.toLinearMap a + +omit [IsOrderedAddMonoid E] [IsCommJordan E] [IsOrderUnit E] [IsJordanOrderUnit E] in +/-- The variance is expressed directly, unfolding `moment 2` to the Jordan square. -/ +theorem variance_eq (ω : 𝓢[ℝ, E]) (a : E) : variance ω a = ω (a * a) - (ω a) ^ 2 := by + simp [variance, LinearMap.variance, pow_two] + +/-- The second moment of any observable is nonnegative: it is the state's value on the +(possible-outcome) Jordan square. -/ +theorem moment_two_nonneg (ω : 𝓢[ℝ, E]) (a : E) : 0 ≤ moment 2 ω a := + ω.map_nonneg (jpow_two a ▸ sq_nonneg a) + +end IsJordanOrderUnit + +namespace JordanAlgebra + +variable {E : Type*} [NonAssocCommRing E] + +open scoped JordanAlgebra + +/-! ## B. Jordan projections and orthogonality -/ + +/-- A Jordan projection: an element idempotent for the Jordan product, `p ∘ p = p`. The +Jordan-algebraic analogue of a self-adjoint projection, and (in the canonical C⋆-algebra +realization, `CStarAlgebra/Jordan.lean`) exactly an ordinary projection `p² = p = p⋆`. -/ +def IsJordanProjection (p : E) : Prop := p * p = p + +/-- Two elements are Jordan-orthogonal when their Jordan product vanishes, `p ∘ q = 0`: the +Jordan-algebraic analogue of `Effect.Orthogonal`. -/ +def JordanOrthogonal (p q : E) : Prop := p * q = 0 + +theorem isJordanProjection_zero : IsJordanProjection (0 : E) := by + simp [IsJordanProjection] + +theorem isJordanProjection_one : IsJordanProjection (1 : E) := _root_.mul_one 1 + +theorem jordanOrthogonal_comm {p q : E} (h : JordanOrthogonal p q) : JordanOrthogonal q p := by + unfold JordanOrthogonal at * + rwa [mul_comm] + +theorem jordanOrthogonal_zero_left (p : E) : JordanOrthogonal 0 p := by + simp [JordanOrthogonal] + +theorem jordanOrthogonal_zero_right (p : E) : JordanOrthogonal p 0 := + jordanOrthogonal_comm (jordanOrthogonal_zero_left p) + +/-- A Jordan projection is automatically a possible outcome (`0 ≤ p`), since it equals its own +Jordan square. -/ +theorem IsJordanProjection.nonneg [PartialOrder E] [IsOrderedAddMonoid E] [Module ℝ E] + [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] [IsCommJordan E] + [IsOrderUnit E] [IsJordanOrderUnit E] {p : E} (hp : IsJordanProjection p) : 0 ≤ p := + hp ▸ IsJordanOrderUnit.sq_nonneg p + +/-- The sum of two orthogonal Jordan projections is again a Jordan projection: the abstract, +operator-free analogue of "two orthogonal projections add to a projection", the algebraic content +behind an event-logic (sharp-effect) sum. -/ +theorem IsJordanProjection.add_of_jordanOrthogonal {p q : E} (hp : IsJordanProjection p) + (hq : IsJordanProjection q) (horth : JordanOrthogonal p q) : + IsJordanProjection (p + q) := by + unfold IsJordanProjection at * + unfold JordanOrthogonal at horth + rw [add_mul, mul_add, mul_add, hp, hq, horth, mul_comm q p, horth] + abel + +/-- The complement `1 - p` of a Jordan projection is again a Jordan projection: the Jordan-algebra +analogue of `Effect.complement`. -/ +theorem IsJordanProjection.complement {p : E} (hp : IsJordanProjection p) : + IsJordanProjection (1 - p) := by + unfold IsJordanProjection at * + rw [sub_mul, mul_sub, mul_sub, _root_.one_mul, _root_.one_mul, _root_.mul_one, hp] + abel + +/-- A Jordan projection is orthogonal to its own complement: `p ∘ (1 - p) = 0`. -/ +theorem IsJordanProjection.jordanOrthogonal_complement {p : E} (hp : IsJordanProjection p) : + JordanOrthogonal p (1 - p) := by + unfold IsJordanProjection at hp + unfold JordanOrthogonal + rw [mul_sub, _root_.mul_one, hp] + abel + +/-! ## C. Projections as effects -/ + +section Ordered + +variable [PartialOrder E] [IsOrderedAddMonoid E] [Module ℝ E] [SMulCommClass ℝ E E] + [IsScalarTower ℝ E E] [IsCommJordan E] [IsOrderUnit E] [IsJordanOrderUnit E] + +/-- A Jordan projection is bounded above by the order unit. Its complement is another projection, +hence a nonnegative square, and `0 ≤ 1 - p` is exactly `p ≤ 1`. -/ +theorem IsJordanProjection.le_one {p : E} (hp : IsJordanProjection p) : p ≤ 1 := + sub_nonneg.mp hp.complement.nonneg + +/-- A Jordan projection, bundled as an effect. -/ +def IsJordanProjection.toEffect {p : E} (hp : IsJordanProjection p) : Effect E := + ⟨p, hp.nonneg, hp.le_one⟩ + +@[simp] +theorem IsJordanProjection.coe_toEffect {p : E} (hp : IsJordanProjection p) : + (hp.toEffect : E) = p := rfl + +/-- Bundling a projection's algebraic complement agrees with taking its effect complement. -/ +theorem IsJordanProjection.toEffect_complement {p : E} (hp : IsJordanProjection p) : + hp.complement.toEffect = Effect.complement hp.toEffect := rfl + +/-- Jordan-orthogonal projections have a defined partial sum in the effect algebra. This is the +forward direction that follows from square positivity alone; the converse needs the stronger JB +order theory. -/ +theorem IsJordanProjection.effectOrthogonal_of_jordanOrthogonal {p q : E} + (hp : IsJordanProjection p) (hq : IsJordanProjection q) (hpq : JordanOrthogonal p q) : + Effect.Orthogonal hp.toEffect hq.toEffect := + (hp.add_of_jordanOrthogonal hq hpq).le_one + +/-- The effect-algebra partial sum of Jordan-orthogonal projections is their algebraic projection +sum. -/ +theorem IsJordanProjection.addOfOrthogonal_toEffect {p q : E} + (hp : IsJordanProjection p) (hq : IsJordanProjection q) (hpq : JordanOrthogonal p q) : + Effect.addOfOrthogonal hp.toEffect hq.toEffect + (hp.effectOrthogonal_of_jordanOrthogonal hq hpq) = + (hp.add_of_jordanOrthogonal hq hpq).toEffect := by + rfl + +end Ordered + +/-! ## D. Compression: `U_p` for an idempotent `p` -/ + +section Compression + +variable [Module ℝ E] [SMulCommClass ℝ E E] + +/-- **Compression onto an event.** For a Jordan projection `p`, `U_p(p) = p`: compressing `p` +itself onto the event `p` changes nothing. The Jordan-algebraic seed of "the outcome that already +happened is unaffected by conditioning on it having happened". -/ +theorem IsJordanProjection.quadRep_self {p : E} (hp : IsJordanProjection p) : U p p = p := by + have h1 : p * (p * p) = p := by rw [hp, hp] + have h2 : p ^[2] * p = p := by rw [jpow_two, hp, hp] + rw [quadRep_apply, h1, h2] + module + +/-- **Compression kills the orthogonal complement.** For a Jordan projection `p` and any `q` +Jordan-orthogonal to it, `U_p(q) = 0`: conditioning on `p` annihilates anything already excluded by +`p`. This is the abstract Jordan-algebraic seed of measurement-update/filtering — no operators, +Hilbert space, or associative product needed. -/ +theorem IsJordanProjection.quadRep_jordanOrthogonal {p q : E} (hp : IsJordanProjection p) + (horth : JordanOrthogonal p q) : U p q = 0 := by + unfold JordanOrthogonal at horth + have h1 : p * (p * q) = 0 := by rw [horth, mul_zero] + have h2 : p ^[2] * q = 0 := by rw [jpow_two, hp, horth] + rw [quadRep_apply, h1, h2] + module + +/-- **Compression of the unit recovers the event itself.** For a Jordan projection `p`, +`U_p(1) = p`: this is `quadRep_apply_one` specialized using `p² = p`. -/ +theorem IsJordanProjection.quadRep_one {p : E} (hp : IsJordanProjection p) : U p (1 : E) = p := by + rw [quadRep_apply_one, jpow_two, hp] + +end Compression + +end JordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Operator.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Operator.lean new file mode 100644 index 0000000000..2c21c8c522 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Operator.lean @@ -0,0 +1,452 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Basic + +/-! + +# Powers, multiplication operators, and the quadratic representation + +## i. Overview + +Three pieces of observable API sit directly on top of the bare Jordan product: + +- **Powers** `a ^[n]`, defined by the obvious recursion `a^[0] = 1`, `a^[n+1] = a ∘ a^[n]`. This + is a fixed bracketing (always multiply by `a` on the left), so it needs no power-associativity + theorem to be well defined — it is simply iterated application of `L_a`. +- **The multiplication operator** `L a`, `L a b = a ∘ b`, linear in `b` because the Jordan product + is real-bilinear. +- **The quadratic representation** `U a := 2 L_a² - L_{a²}`. In the special (associative) case this + is exactly `U_a(b) = a b a`, the two-sided operator-conjugation map — + `CStarAlgebra/Jordan.lean` proves this + identity for the canonical C⋆-algebra realization. Abstractly, `U_a` is the Jordan-algebraic + substitute for "conjugate by `a`", available even though the raw associative product `aba` does + not typecheck at this level of generality. + +## ii. Key definitions and results + +- `IsJordanOrderUnit.jpow`, notation `a ^[n]` +- `IsJordanOrderUnit.mulLeft`, notation `L` +- `IsJordanOrderUnit.quadRep`, notation `U` +- `IsJordanOrderUnit.quadRep_apply` + +## iii. Table of contents + +- A. Powers +- B. The multiplication operator `L_a` +- C. The quadratic representation `U_a` + +-/ + +@[expose] public section + +namespace JordanAlgebra + +variable {E : Type*} [NonAssocCommRing E] + +/-! ## A. Powers -/ + +/-- The `n`-th Jordan power of `a`, defined by the fixed left-bracketing recursion +`a^[0] = 1`, `a^[n+1] = a ∘ a^[n]`. -/ +def jpow (a : E) : ℕ → E + | 0 => 1 + | n + 1 => a * jpow a n + +@[inherit_doc] scoped notation:max a " ^[" n "]" => jpow a n + +@[simp] theorem jpow_zero (a : E) : a ^[0] = 1 := rfl + +theorem jpow_succ (a : E) (n : ℕ) : a ^[n + 1] = a * a ^[n] := rfl + +@[simp] theorem jpow_one (a : E) : a ^[1] = a := by + rw [jpow_succ, jpow_zero, mul_one] + +/-- The second Jordan power is the Jordan square, `a ∘ a`. -/ +theorem jpow_two (a : E) : a ^[2] = a * a := by + rw [jpow_succ, jpow_one] + +/-! ## B. The multiplication operator `L_a` -/ + +section Linear + +variable [Module ℝ E] [SMulCommClass ℝ E E] + +/-- The Jordan multiplication operator `L a : E →ₗ[ℝ] E`, `L a b = a ∘ b`. Linear in `b` since the +Jordan product distributes over `+` (`NonUnitalNonAssocCommRing`) and commutes with real scalars +(`SMulCommClass ℝ E E`). -/ +def mulLeft (a : E) : E →ₗ[ℝ] E where + toFun b := a * b + map_add' := mul_add a + map_smul' c b := by simp [mul_smul_comm] + +@[inherit_doc] scoped notation "L" => mulLeft + +@[simp] theorem mulLeft_apply (a b : E) : L a b = a * b := rfl + +theorem mulLeft_one (a : E) : L a 1 = a := _root_.mul_one a + +theorem mulLeft_one_apply (a : E) : L 1 a = a := _root_.one_mul a + +/-! ## C. The quadratic representation `U_a` -/ + +/-- The quadratic representation `U a := 2 • L_a ∘ L_a - L_{a ^[2]}`, the Jordan-algebraic +substitute for two-sided conjugation `b ↦ a b a`. See `CStarAlgebra/Jordan.lean` for the theorem +that this is +*literally* `aba` in the canonical C⋆-algebra realization. -/ +def quadRep (a : E) : E →ₗ[ℝ] E := + (2 : ℝ) • ((mulLeft a).comp (mulLeft a)) - mulLeft (a ^[2]) + +@[inherit_doc] scoped notation "U" => quadRep + +theorem quadRep_apply (a b : E) : U a b = (2 : ℝ) • (a * (a * b)) - a ^[2] * b := by + simp [quadRep, jpow_two] + +@[simp] theorem quadRep_zero_apply (b : E) : U (0 : E) b = 0 := by + rw [quadRep_apply] + simp [jpow_two] + +@[simp] theorem quadRep_add_right (a b c : E) : U a (b + c) = U a b + U a c := by + exact (U a).map_add b c + +theorem quadRep_smul_right (r : ℝ) (a b : E) : U a (r • b) = r • U a b := by + exact (U a).map_smul r b + +/-- The bilinear polarization of the quadratic representation. It is the cross-effect of +`a ↦ U a`: in a special Jordan algebra it is the symmetrized two-sided action +`x ↦ axb + bxa`. Defining it at the operator level, rather than repeatedly expanding +`U (a + b)`, is the natural interface for multivariable identities. -/ +def quadRepPolar (a b : E) : E →ₗ[ℝ] E := + (2 : ℝ) • (((L a).comp (L b)) + ((L b).comp (L a)) - L (a * b)) + +/-- The standard bilinear quadratic operator. `quadRepPolar` is its literal cross-effect +and therefore equals twice this operator. Keeping this undivided normalization is essential for +the finite polarization identities used in the algebraic proof of the fundamental formula. -/ +def quadRepBilin (a b : E) : E →ₗ[ℝ] E := + ((L a).comp (L b)) + ((L b).comp (L a)) - L (a * b) + +/-- Pointwise form of the standard bilinear quadratic operator. -/ +theorem quadRepBilin_apply (a b x : E) : + quadRepBilin a b x = a * (b * x) + b * (a * x) - (a * b) * x := by + simp only [quadRepBilin, LinearMap.sub_apply, LinearMap.add_apply, LinearMap.comp_apply, + mulLeft_apply] + +/-- The standard bilinear quadratic operator is symmetric. -/ +theorem quadRepBilin_comm (a b : E) : quadRepBilin a b = quadRepBilin b a := by + ext x + rw [quadRepBilin_apply, quadRepBilin_apply, mul_comm b a] + abel + +/-- Additivity in the first variable of the standard quadratic polarization. -/ +theorem quadRepBilin_add_left (a b c : E) : + quadRepBilin (a + b) c = quadRepBilin a c + quadRepBilin b c := by + ext x + rw [quadRepBilin_apply] + change (a + b) * (c * x) + c * ((a + b) * x) - ((a + b) * c) * x = + quadRepBilin a c x + quadRepBilin b c x + rw [quadRepBilin_apply, quadRepBilin_apply] + simp only [add_mul, mul_add] + module + +/-- Real linearity in the first variable of the standard quadratic polarization. -/ +theorem quadRepBilin_smul_left (r : ℝ) (a b : E) : + quadRepBilin (r • a) b = r • quadRepBilin a b := by + ext x + rw [quadRepBilin_apply] + change (r • a) * (b * x) + b * ((r • a) * x) - ((r • a) * b) * x = + r • quadRepBilin a b x + rw [quadRepBilin_apply] + have hsmul_mul (z y : E) : (r • z) * y = r • (z * y) := by + calc + (r • z) * y = y * (r • z) := mul_comm _ _ + _ = r • (y * z) := mul_smul_comm r y z + _ = r • (z * y) := by rw [mul_comm y z] + rw [hsmul_mul a (b * x), hsmul_mul a x, mul_smul_comm, + hsmul_mul a b, hsmul_mul (a * b) x] + simp only [smul_add, smul_sub] + +/-- Additivity in the second variable of the standard quadratic polarization. -/ +theorem quadRepBilin_add_right (a b c : E) : + quadRepBilin a (b + c) = quadRepBilin a b + quadRepBilin a c := by + rw [quadRepBilin_comm, quadRepBilin_comm a b, quadRepBilin_comm a c, + quadRepBilin_add_left] + +/-- Real linearity in the second variable of the standard quadratic polarization. -/ +theorem quadRepBilin_smul_right (r : ℝ) (a b : E) : + quadRepBilin a (r • b) = r • quadRepBilin a b := by + calc + quadRepBilin a (r • b) = quadRepBilin (r • b) a := quadRepBilin_comm _ _ + _ = r • quadRepBilin b a := quadRepBilin_smul_left r b a + _ = r • quadRepBilin a b := by rw [quadRepBilin_comm] + +/-- Signed second-variable specialization of the bilinear quadratic operator. -/ +theorem quadRepBilin_neg_right (a b : E) : + quadRepBilin a (-b) = -quadRepBilin a b := by + simpa using quadRepBilin_smul_right (-1 : ℝ) a b + +/-- Signed first-variable specialization of the bilinear quadratic operator. -/ +theorem quadRepBilin_neg_left (a b : E) : + quadRepBilin (-a) b = -quadRepBilin a b := by + calc + quadRepBilin (-a) b = quadRepBilin b (-a) := quadRepBilin_comm _ _ + _ = -quadRepBilin b a := quadRepBilin_neg_right _ _ + _ = -quadRepBilin a b := by rw [quadRepBilin_comm] + +/-- Difference expansion in the second variable of the bilinear quadratic operator. -/ +theorem quadRepBilin_sub_right (a b c : E) : + quadRepBilin a (b - c) = quadRepBilin a b - quadRepBilin a c := by + rw [sub_eq_add_neg, quadRepBilin_add_right, quadRepBilin_neg_right] + abel + +/-- The cross-effect normalization is twice the standard bilinear quadratic operator. -/ +theorem quadRepPolar_eq_two_smul_quadRepBilin (a b : E) : + quadRepPolar a b = (2 : ℝ) • quadRepBilin a b := by + rw [quadRepPolar, quadRepBilin] + +/-- The diagonal of the standard bilinear quadratic operator is the quadratic representation. -/ +theorem quadRepBilin_self (a : E) : quadRepBilin a a = U a := by + ext x + simp only [quadRepBilin, LinearMap.sub_apply, LinearMap.add_apply, LinearMap.comp_apply, + mulLeft_apply] + rw [quadRep_apply] + simp only [jpow_two] + module + +/-- Pointwise form of the polarized quadratic representation. -/ +theorem quadRepPolar_apply (a b x : E) : + quadRepPolar a b x = + (2 : ℝ) • (a * (b * x) + b * (a * x) - (a * b) * x) := by + simp only [quadRepPolar, LinearMap.smul_apply, LinearMap.sub_apply, LinearMap.add_apply, + LinearMap.comp_apply, mulLeft_apply] + +/-- Polarization is symmetric in its two outer variables. -/ +theorem quadRepPolar_comm (a b : E) : quadRepPolar a b = quadRepPolar b a := by + ext x + rw [quadRepPolar_apply, quadRepPolar_apply, mul_comm b a] + abel + +/-- The polarization is additive in its first outer variable. -/ +theorem quadRepPolar_add_left (a b c : E) : + quadRepPolar (a + b) c = quadRepPolar a c + quadRepPolar b c := by + ext x + rw [quadRepPolar_apply] + change (2 : ℝ) • ((a + b) * (c * x) + c * ((a + b) * x) - ((a + b) * c) * x) = + quadRepPolar a c x + quadRepPolar b c x + rw [quadRepPolar_apply, quadRepPolar_apply] + simp only [add_mul, mul_add] + module + +/-- The polarization is real-linear in its first outer variable. -/ +theorem quadRepPolar_smul_left (r : ℝ) (a b : E) : + quadRepPolar (r • a) b = r • quadRepPolar a b := by + ext x + rw [quadRepPolar_apply] + change (2 : ℝ) • ((r • a) * (b * x) + b * ((r • a) * x) - ((r • a) * b) * x) = + r • quadRepPolar a b x + rw [quadRepPolar_apply] + have hsmul_mul (z y : E) : (r • z) * y = r • (z * y) := by + calc + (r • z) * y = y * (r • z) := mul_comm _ _ + _ = r • (y * z) := mul_smul_comm r y z + _ = r • (z * y) := by rw [mul_comm y z] + rw [hsmul_mul a (b * x), hsmul_mul a x, mul_smul_comm, + hsmul_mul a b, hsmul_mul (a * b) x] + simp only [smul_add, smul_sub] + module + +/-- The polarization is additive in its second outer variable. -/ +theorem quadRepPolar_add_right (a b c : E) : + quadRepPolar a (b + c) = quadRepPolar a b + quadRepPolar a c := by + rw [quadRepPolar_comm, quadRepPolar_comm a b, quadRepPolar_comm a c, + quadRepPolar_add_left] + +/-- The polarization is real-linear in its second outer variable. -/ +theorem quadRepPolar_smul_right (r : ℝ) (a b : E) : + quadRepPolar a (r • b) = r • quadRepPolar a b := by + calc + quadRepPolar a (r • b) = quadRepPolar (r • b) a := quadRepPolar_comm _ _ + _ = r • quadRepPolar b a := quadRepPolar_smul_left r b a + _ = r • quadRepPolar a b := by rw [quadRepPolar_comm b a] + +/-- The diagonal of the polarization is twice the original quadratic representation. -/ +theorem quadRepPolar_self (a : E) : quadRepPolar a a = (2 : ℝ) • U a := by + ext x + rw [quadRepPolar_apply] + change (2 : ℝ) • (a * (a * x) + a * (a * x) - (a * a) * x) = + (2 : ℝ) • U a x + rw [quadRep_apply] + simp only [jpow_two] + module + +/-- The quadratic representation splits into its two diagonal pieces and its polarized +cross-effect. -/ +theorem quadRep_add_apply (a b x : E) : + U (a + b) x = U a x + quadRepPolar a b x + U b x := by + rw [quadRepPolar_apply] + repeat' rw [quadRep_apply] + simp only [jpow_two, add_mul, mul_add] + rw [mul_comm b a] + module + +/-- Exact additive polarization of the quadratic representation in standard normalization. -/ +theorem quadRep_add_eq (a b : E) : + U (a + b) = U a + (2 : ℝ) • quadRepBilin a b + U b := by + ext x + rw [quadRep_add_apply, quadRepPolar_eq_two_smul_quadRepBilin] + simp only [LinearMap.add_apply, LinearMap.smul_apply] + +/-- Signed additive polarization, obtained from the same quadratic cross-effect. Together with +`quadRep_add_eq`, this gives the two exact evaluations used to isolate a quadratic coefficient. -/ +theorem quadRep_sub_eq (a b : E) : + U (a - b) = U a - (2 : ℝ) • quadRepBilin a b + U b := by + have hneg : U (-b) = U b := by + ext x + rw [quadRep_apply, quadRep_apply] + simp only [jpow_two, neg_mul, mul_neg] + module + rw [sub_eq_add_neg, quadRep_add_eq, quadRepBilin_neg_right, hneg] + module + +/-- The quadratic representation of a three-term sum, expressed through the canonical symmetric +bilinear cross-effect. This is the coefficient-expansion interface for polarizing identities in +quadratic representations; it keeps all mixed terms in the single `quadRepBilin` API. -/ +theorem quadRep_add_add_eq (a b c : E) : + U (a + b + c) = + U a + U b + U c + + (2 : ℝ) • quadRepBilin a b + + (2 : ℝ) • quadRepBilin a c + + (2 : ℝ) • quadRepBilin b c := by + rw [quadRep_add_eq, quadRep_add_eq, quadRepBilin_add_left] + module + +omit [SMulCommClass ℝ E E] in +/-- Exact square expansion for the positive polarization evaluation. -/ +theorem add_mul_self (a b : E) : + (a + b) * (a + b) = a * a + (2 : ℝ) • (a * b) + b * b := by + simp only [add_mul, mul_add] + rw [mul_comm b a] + module + +omit [SMulCommClass ℝ E E] in +/-- Exact square expansion for the signed polarization evaluation. -/ +theorem sub_mul_self (a b : E) : + (a - b) * (a - b) = a * a - (2 : ℝ) • (a * b) + b * b := by + simp only [sub_mul, mul_sub] + rw [mul_comm b a] + module + +/-- Quadratic representations are homogeneous of degree two in their outer argument. -/ +theorem quadRep_smul_apply (r : ℝ) (a b : E) : + U (r • a) b = r ^ 2 • U a b := by + rw [quadRep_apply, quadRep_apply] + simp [jpow_two, mul_smul_comm, smul_smul, smul_sub, pow_two, mul_comm, mul_assoc] + +/-- Quadratic homogeneity of the representation, as an equality of operators. -/ +theorem quadRep_smul_eq (r : ℝ) (a : E) : + U (r • a) = r ^ 2 • U a := by + ext b + rw [quadRep_smul_apply] + simp only [LinearMap.smul_apply] + +theorem quadRep_neg_apply (a b : E) : U (-a) b = U a b := by + simpa using (quadRep_smul_apply (-1 : ℝ) a b) + +/-- Sign invariance of the quadratic representation, as an equality of operators. -/ +theorem quadRep_neg (a : E) : U (-a) = U a := by + ext b + exact quadRep_neg_apply a b + +/-- The quadratic representation of the order unit is the identity: `U_1 = id`. The Jordan +identity element acts as "conjugate by the identity", i.e. does nothing. -/ +@[simp] theorem quadRep_one_apply (b : E) : U (1 : E) b = b := by + have h1 : (1 : E) * ((1 : E) * b) = b := by + rw [_root_.one_mul, _root_.one_mul] + have h2 : (1 : E) ^[2] * b = b := by + rw [jpow_two, _root_.one_mul, _root_.one_mul] + rw [quadRep_apply, h1, h2] + module + +@[simp] theorem quadRep_one_comp (a : E) : (U (1 : E)).comp (U a) = U a := by + ext b + simp + +@[simp] theorem quadRep_comp_one (a : E) : (U a).comp (U (1 : E)) = U a := by + ext b + simp + +/-- The quadratic representation of `a`, evaluated at the order unit, recovers the Jordan square: +`U_a(1) = a²`. Conjugating the identity by `a` gives back `a²`, matching the associative picture +`a \cdot 1 \cdot a = a^2`. -/ +@[simp] theorem quadRep_apply_one (a : E) : U a (1 : E) = a ^[2] := by + have h1 : a * (a * (1 : E)) = a * a := by rw [_root_.mul_one] + have h2 : a ^[2] * (1 : E) = a ^[2] := _root_.mul_one _ + rw [quadRep_apply, h1, h2, ← jpow_two] + module + +/-! ## D. The Jordan commutation law -/ + +/-- Quadratic representation by `a` commutes with multiplication by `a`. + +This is the operator form of the Jordan identity used at its weakest level: the only nontrivial +interchange is `a² ∘ (a ∘ x) = a ∘ (a² ∘ x)`. It is the basic invariant-subalgebra fact behind +the one-generator and Peirce developments. -/ +theorem quadRep_mulLeft [IsCommJordan E] (a x : E) : U a (a * x) = a * U a x := by + rw [quadRep_apply, quadRep_apply] + have hJordan : a ^[2] * (a * x) = a * (a ^[2] * x) := by + rw [jpow_two] + exact IsJordan.lmul_lmul_comm_lmul a x + rw [hJordan] + rw [mul_sub, mul_smul_comm] + +/-- Quadratic representation by `a` also commutes with multiplication by the square `a²`. +Together with `quadRep_mulLeft`, this says that `U_a` preserves the associative algebra generated +by `a` at the operator level, without appealing to an ambient associative realization. -/ +theorem quadRep_mulLeft_sq [IsCommJordan E] (a x : E) : + U a (a ^[2] * x) = a ^[2] * U a x := by + rw [quadRep_apply, quadRep_apply, mul_sub, mul_smul_comm] + have hJordan (y : E) : a ^[2] * (a * y) = a * (a ^[2] * y) := by + rw [jpow_two] + exact IsJordan.lmul_lmul_comm_lmul a y + rw [← hJordan x, ← hJordan (a * x)] + +/-- Bundled form of `quadRep_mulLeft`: the quadratic representation commutes with `L_a`. -/ +theorem commute_quadRep_mulLeft [IsCommJordan E] (a : E) : Commute (U a) (L a) := by + ext x + exact quadRep_mulLeft a x + +/-- Bundled form of `quadRep_mulLeft_sq`: the quadratic representation commutes with `L_(a²)`. -/ +theorem commute_quadRep_mulLeft_sq [IsCommJordan E] (a : E) : Commute (U a) (L (a ^[2])) := by + ext x + exact quadRep_mulLeft_sq a x + +/-! ## E. The inner derivation `D_{a,b}` -/ + +/-- The inner derivation associated to a pair `(a, b)`: `D_{a,b} := L_a ∘ L_b - L_b ∘ L_a`. This +is well defined with no Jordan hypothesis (it only needs the bare bilinear product), but it +becomes a genuine derivation of the Jordan product exactly when the Jordan identity holds +(`innerDerivation_mul` in `Quadratic/Fundamental.lean`). It is kept here, at the weakest level +alongside `L` and `U`, because it is reusable infrastructure beyond the fundamental-formula proof +(automorphisms, generators, Peirce theory, symmetry actions, dynamics), not a throwaway auxiliary +of a single theorem. -/ +def innerDerivation (a b : E) : E →ₗ[ℝ] E := (L a).comp (L b) - (L b).comp (L a) + +/-- Pointwise form of the inner derivation. -/ +theorem innerDerivation_apply (a b x : E) : innerDerivation a b x = a * (b * x) - b * (a * x) := by + simp only [innerDerivation, LinearMap.sub_apply, LinearMap.comp_apply, mulLeft_apply] + +/-- The inner derivation is antisymmetric in its two defining arguments. -/ +theorem innerDerivation_swap (a b : E) : innerDerivation a b = -innerDerivation b a := by + ext x + simp only [innerDerivation_apply, LinearMap.neg_apply] + abel + +@[simp] theorem innerDerivation_self (a : E) : innerDerivation a a = 0 := by + ext x + simp [innerDerivation_apply] + +end Linear + +end JordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Power/Associative.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Power/Associative.lean new file mode 100644 index 0000000000..9ba9fc4bd7 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Power/Associative.lean @@ -0,0 +1,202 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Operator + +/-! + +# Strong power-associativity of a single Jordan element + +## i. Overview + +Power-associativity is the classical fact (Albert 1947; see Jacobson, *Structure and +Representations of Jordan Algebras*, or McCrimmon, *A Taste of Jordan Algebras*, Ch. II) that the +subalgebra generated by a single element `a` of a Jordan algebra is *associative*: not merely that +the fixed-bracketing powers `a^[n]` from `Operator.lean` are unambiguous (they always were, being +defined by a single recursion), but that +$$ a^{[m]} \circ a^{[n]} = a^{[m+n]} \quad \text{for every } m, n, $$ +and more generally that arbitrary polynomials in `a` associate under `∘`. This is what makes +`J[a] := \operatorname{span}\{1, a, a^2, \dots\}` (`GeneratedByOne.lean`) into a genuine +commutative *associative* ring, letting the whole downstream single-observable spectral theory +(`JB/GeneratedByOne/*`) reduce to mathlib's ordinary associative machinery instead of needing a +bespoke non-associative functional calculus. + +**The operator recursion.** Polarizing the Jordan identity gives an expression for +`L_{(a² * y)}` in terms of `L_a`, `L_{a²}`, `L_y`, and `L_{a*y}`. Applied to `y = a^[n]`, this +shows recursively that every `L_{a^[n]}` is a polynomial in the commuting operators `L_a` and +`L_{a²}`. In particular, `L_a` commutes with every multiplication operator of one of its powers. + +Strong power-associativity then follows by a routine induction: assuming +`a^{[m]} ∘ a^{[n]} = a^{[m+n]}`, +$$ a^{[m]} \circ a^{[n+1]} = a^{[m]} \circ (a \circ a^{[n]}) = a \circ (a^{[m]} \circ a^{[n]}) + = a \circ a^{[m+n]} = a^{[m+n+1]}, $$ +where the middle step is exactly `commute_mulLeft_pow m` evaluated at `a^{[n]}`. + +## ii. Key definitions and results + +- `JordanAlgebra.linearized_mul_sq`: the polarized Jordan identity used by the recursion +- `JordanAlgebra.commute_mulLeft_pow`: `L_a` commutes with every `L_(a^[n])` +- `JordanAlgebra.pow_add`: `a^[m] * a^[n] = a^[m+n]` + +## iii. Table of contents + +- A. Operator commutation for powers +- B. Strong power-associativity + +-/ + +@[expose] public section + +namespace JordanAlgebra + +variable {E : Type*} [NonAssocCommRing E] [Module ℝ E] [SMulCommClass ℝ E E] + [IsCommJordan E] + +open scoped JordanAlgebra + +/-! ## A. Operator commutation for powers -/ + +/-- `L_a` and `L_{a²}` commute: mathlib's `IsCommJordan.lmul_comm_rmul_rmul` restated as operator +commutation (`a * b * (a * a) = a * (b * (a * a))`, i.e. `L_{a∘a}(L_a b) = L_a(L_{a∘a} b)` for +every `b`, using commutativity to reorder `a * b * (a * a) = (a * a) * (a * b)`). No `sorry`: this +is exactly the `n = 2` case of `commute_mulLeft_pow` below, and the only case mathlib's bare +(unlinearized) Jordan axiom gives for free. -/ +theorem commute_mulLeft_sq (a : E) : Commute (L a) (L (a ^[2])) := by + rw [jpow_two] + ext b + simp only [Module.End.mul_apply, mulLeft_apply] + have h := IsCommJordan.lmul_comm_rmul_rmul a b + rw [mul_comm (a * b) (a * a), mul_comm b (a * a)] at h + exact h.symm + +omit [IsCommJordan E] in +/-- A pointwise restatement of `Commute (L a) (L x)`: `a` and `x` "cross-associate" against any +third element `y`. -/ +theorem commute_mulLeft_apply {a x : E} (h : Commute (L a) (L x)) (y : E) : + a * (x * y) = x * (a * y) := by + have hpt := LinearMap.congr_fun h.eq y + simpa only [Module.End.mul_apply, mulLeft_apply] using hpt + +omit [SMulCommClass ℝ E E] in +/-- A polarized form of the Jordan identity. This is Basic Identity (2.1.2) in McCrimmon's +*A Taste of Jordan Algebras*. It is the algebraic engine behind the recursion for multiplication +operators of powers. -/ +theorem linearized_mul_sq (a y z : E) : + (a * a * y) * z = + -(2 : ℝ) • (a * (y * (a * z))) + (a * a) * (y * z) + + (2 : ℝ) • ((a * y) * (a * z)) := by + have hp := IsCommJordan.lmul_comm_rmul_rmul (a + z) y + have hm := IsCommJordan.lmul_comm_rmul_rmul (a - z) y + have hz := IsCommJordan.lmul_comm_rmul_rmul z y + simp only [add_mul, mul_add, sub_mul, mul_sub] at hp hm + have h := congrArg₂ (fun u v : E => u - v) hp hm + abel_nf at h + rw [mul_comm z a, mul_comm (z * y) (a * a), mul_comm z (y * (a * a)), + mul_comm y (a * a)] at h + rw [hz] at h + abel_nf at h + have hclean : + (2 : ℤ) • (z * (y * (z * z))) + + ((2 : ℤ) • (a * a * (z * y)) + (4 : ℤ) • (a * y * (a * z))) = + (2 : ℤ) • (z * (y * (z * z))) + + ((2 : ℤ) • (a * a * y * z) + (4 : ℤ) • (a * (y * (a * z)))) := by + calc + _ = (2 : ℤ) • (a * a * (z * y)) + + ((4 : ℤ) • (a * y * (a * z)) + (2 : ℤ) • (z * (y * (z * z)))) := by abel + _ = _ := h + _ = _ := by abel + have hc := add_left_cancel hclean + have h' : (2 : ℤ) • (a * a * y * z) = + (2 : ℤ) • (-(2 : ℝ) • (a * (y * (a * z))) + + (a * a) * (y * z) + (2 : ℝ) • ((a * y) * (a * z))) := by + calc + _ = (2 : ℤ) • (a * a * (z * y)) + (4 : ℤ) • (a * y * (a * z)) - + (4 : ℤ) • (a * (y * (a * z))) := by rw [hc]; module + _ = _ := by rw [mul_comm z y]; module + calc + _ = (1 / 2 : ℝ) • ((2 : ℤ) • (a * a * y * z)) := by module + _ = (1 / 2 : ℝ) • ((2 : ℤ) • (-(2 : ℝ) • (a * (y * (a * z))) + + (a * a) * (y * z) + (2 : ℝ) • ((a * y) * (a * z)))) := + congrArg (fun w : E => (1 / 2 : ℝ) • w) h' + _ = _ := by module + +/-- Multiplying a Jordan power by the square raises its degree by two. -/ +theorem square_mul_jpow (a : E) (n : ℕ) : (a * a) * a ^[n] = a ^[n + 2] := by + induction n with + | zero => simp [jpow_two] + | succ n ih => + rw [jpow_succ, ← jpow_two] + rw [← commute_mulLeft_apply (commute_mulLeft_sq a) (a ^[n])] + rw [jpow_two, ih, ← jpow_succ] + +/-- The multiplication operator of `a^[n+2]`, expressed recursively in the commuting generators +`L_a` and `L_(a²)`. -/ +theorem mulLeft_jpow_add_two (a : E) (n : ℕ) : + L (a ^[n + 2]) = + -(2 : ℝ) • ((L a) * ((L (a ^[n])) * (L a))) + + ((L (a * a)) * (L (a ^[n])) + + (2 : ℝ) • ((L (a ^[n + 1])) * (L a))) := by + ext z + simp only [LinearMap.add_apply, LinearMap.smul_apply, Module.End.mul_apply, mulLeft_apply] + rw [← square_mul_jpow a n] + simpa only [← jpow_succ, add_assoc] using linearized_mul_sq a (a ^[n]) z + +/-- Both fundamental commuting operators `L_a` and `L_(a²)` commute with multiplication by every +power of `a`. -/ +theorem fundamental_mulLeft_commute_pow (a : E) (n : ℕ) : + Commute (L a) (L (a ^[n])) ∧ Commute (L (a * a)) (L (a ^[n])) := by + induction n using Nat.twoStepInduction with + | zero => + constructor <;> ext z <;> + simp only [jpow_zero, Module.End.mul_apply, mulLeft_apply, one_mul] + | one => + constructor + · simpa only [jpow_one] using Commute.refl (L a) + · simpa only [jpow_one, jpow_two] using (commute_mulLeft_sq a).symm + | more n hn hn1 => + rw [mulLeft_jpow_add_two] + let X := L a + let Y := L (a * a) + let N := L (a ^[n]) + let M := L (a ^[n + 1]) + have hXY : Commute X Y := by simpa [X, Y, jpow_two] using commute_mulLeft_sq a + have hXN : Commute X N := by simpa [X, N] using hn.1 + have hYN : Commute Y N := by simpa [Y, N] using hn.2 + have hXM : Commute X M := by simpa [X, M] using hn1.1 + have hYM : Commute Y M := by simpa [Y, M] using hn1.2 + constructor + · simpa [X, Y, N, M] using + (Commute.smul_right + ((Commute.refl X).mul_right (hXN.mul_right (Commute.refl X))) (-2 : ℝ)).add_right + ((hXY.mul_right hXN).add_right + ((hXM.mul_right (Commute.refl X)).smul_right (2 : ℝ))) + · simpa [X, Y, N, M] using + ((((hXY.symm.mul_right (hYN.mul_right hXY.symm))).smul_right (-2 : ℝ)).add_right + (((Commute.refl Y).mul_right hYN).add_right + ((hYM.mul_right hXY.symm).smul_right (2 : ℝ)))) + +/-- `a` commutes, as a Jordan multiplication operator, with the multiplication operator of every +one of its powers. -/ +theorem commute_mulLeft_pow (a : E) (n : ℕ) : Commute (L a) (L (a ^[n])) := + (fundamental_mulLeft_commute_pow a n).1 + +/-! ## B. Strong power-associativity -/ + +/-- Powers of a single Jordan element associate: `a^{[m]} \circ a^{[n]} = a^{[m+n]}`. This is +exactly what is needed to make +`J[a] = \operatorname{span}\{a^{[n]}\}` (`GeneratedByOne.lean`) an honest associative ring. -/ +theorem pow_add (a : E) (m n : ℕ) : a ^[m] * a ^[n] = a ^[m + n] := by + induction n with + | zero => simp + | succ n ih => + have hpt := commute_mulLeft_apply (commute_mulLeft_pow a m) (a ^[n]) + calc a ^[m] * a ^[n + 1] = a ^[m] * (a * a ^[n]) := by rw [jpow_succ] + _ = a * (a ^[m] * a ^[n]) := hpt.symm + _ = a * a ^[m + n] := by rw [ih] + _ = a ^[m + n + 1] := (jpow_succ a (m + n)).symm + +end JordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Power/Generated.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Power/Generated.lean new file mode 100644 index 0000000000..b2aef6ad98 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Power/Generated.lean @@ -0,0 +1,214 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Hom +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Power.GeneratedByOne + +/-! +# Jordan submodules generated by arbitrary observables + +The existing `generatedByOne a` is the computable power-span presentation of the one-observable +Jordan algebra. This file provides the complementary universal construction: the smallest +unital real submodule closed under the Jordan product and containing an arbitrary set of +observables. Its singleton case is proved equal to the existing power span. + +This is deliberately only a closure carrier. It makes no false associativity claim for two +generators: proving that the two-generated algebra is special is the later Shirshov--Cohn step +needed for intrinsic quadratic positivity. +-/ + +@[expose] public section + +namespace JordanAlgebra + +variable {E : Type*} [NonAssocCommRing E] [Module ℝ E] + +open scoped JordanAlgebra + +/-- A real submodule is Jordan-closed when it contains the unit and is closed under the Jordan +product. This is the closure notion used for arbitrary generated Jordan fragments. -/ +def IsJordanSubmodule (J : Submodule ℝ E) : Prop := + (1 : E) ∈ J ∧ ∀ ⦃x y : E⦄, x ∈ J → y ∈ J → x * y ∈ J + +/-- The smallest unital Jordan submodule containing the set `s`. -/ +def generatedBySet (s : Set E) : Submodule ℝ E := + sInf {J : Submodule ℝ E | s ⊆ J ∧ IsJordanSubmodule J} + +/-- The generating set is contained in its generated Jordan submodule. -/ +theorem subset_generatedBySet (s : Set E) : s ⊆ generatedBySet s := by + intro x hx + change x ∈ sInf {J : Submodule ℝ E | s ⊆ J ∧ IsJordanSubmodule J} + rw [Submodule.mem_sInf] + intro J hJ + exact hJ.1 hx + +/-- The generated Jordan submodule contains the order unit. -/ +theorem one_mem_generatedBySet (s : Set E) : (1 : E) ∈ generatedBySet s := by + change (1 : E) ∈ sInf {J : Submodule ℝ E | s ⊆ J ∧ IsJordanSubmodule J} + rw [Submodule.mem_sInf] + intro J hJ + exact hJ.2.1 + +/-- The generated Jordan submodule is closed under the Jordan product. -/ +theorem mul_mem_generatedBySet (s : Set E) {x y : E} (hx : x ∈ generatedBySet s) + (hy : y ∈ generatedBySet s) : x * y ∈ generatedBySet s := by + change x ∈ sInf {J : Submodule ℝ E | s ⊆ J ∧ IsJordanSubmodule J} at hx + change y ∈ sInf {J : Submodule ℝ E | s ⊆ J ∧ IsJordanSubmodule J} at hy + change x * y ∈ sInf {J : Submodule ℝ E | s ⊆ J ∧ IsJordanSubmodule J} + rw [Submodule.mem_sInf] at hx hy ⊢ + intro J hJ + exact hJ.2.2 (hx J hJ) (hy J hJ) + +/-- The universal generated submodule is itself unital and Jordan-closed. -/ +theorem isJordanSubmodule_generatedBySet (s : Set E) : IsJordanSubmodule (generatedBySet s) := + ⟨one_mem_generatedBySet s, fun _ _ hx hy => mul_mem_generatedBySet s hx hy⟩ + +/-- Universal property of arbitrary Jordan generation: every unital Jordan submodule containing +the generators contains `generatedBySet s`. -/ +theorem generatedBySet_le {s : Set E} {J : Submodule ℝ E} (hs : s ⊆ J) + (hJ : IsJordanSubmodule J) : generatedBySet s ≤ J := by + rw [generatedBySet] + exact sInf_le ⟨hs, hJ⟩ + +/-- Enlarging the generating set can only enlarge its generated Jordan fragment. -/ +theorem generatedBySet_mono {s t : Set E} (hst : s ⊆ t) : + generatedBySet s ≤ generatedBySet t := + generatedBySet_le (fun _ hx => subset_generatedBySet t (hst hx)) + (isJordanSubmodule_generatedBySet t) + +/-- The arbitrary generated Jordan fragment as its own carrier type. -/ +abbrev GeneratedBySet (s : Set E) : Type _ := generatedBySet s + +namespace GeneratedBySet + +variable (s : Set E) + +instance : Mul (GeneratedBySet s) where + mul x y := ⟨(x : E) * (y : E), mul_mem_generatedBySet s x.2 y.2⟩ + +@[simp] +theorem val_mul (x y : GeneratedBySet s) : ((x * y : GeneratedBySet s) : E) = (x : E) * (y : E) := + rfl + +instance : One (GeneratedBySet s) := ⟨⟨1, one_mem_generatedBySet s⟩⟩ + +@[simp] +theorem val_one : ((1 : GeneratedBySet s) : E) = 1 := rfl + +/-- The canonical inclusion of a generated Jordan fragment into its ambient algebra. -/ +def inclusion : GeneratedBySet s →ₗ[ℝ] E := (generatedBySet s).subtype + +@[simp] +theorem inclusion_apply (x : GeneratedBySet s) : inclusion s x = (x : E) := rfl + +theorem inclusion_injective : Function.Injective (inclusion s) := Subtype.val_injective + +/-- Every generated Jordan fragment inherits the ambient unital commutative nonassociative ring. +Associativity is intentionally absent: it is exceptional extra structure, not part of closure. -/ +instance instNonAssocCommRing : NonAssocCommRing (GeneratedBySet s) where + __ := (inferInstance : AddCommGroup (GeneratedBySet s)) + mul := (· * ·) + one := 1 + mul_comm x y := Subtype.ext (_root_.mul_comm (x : E) (y : E)) + one_mul x := Subtype.ext (_root_.one_mul (x : E)) + mul_one x := Subtype.ext (_root_.mul_one (x : E)) + left_distrib x y z := Subtype.ext (mul_add (x : E) (y : E) (z : E)) + right_distrib x y z := Subtype.ext (add_mul (x : E) (y : E) (z : E)) + zero_mul x := Subtype.ext (by simp) + mul_zero x := Subtype.ext (by simp) + +/-- The canonical inclusion, bundled as a unital real Jordan homomorphism. -/ +def inclusionJordanHom : JordanHom (GeneratedBySet s) E where + toLinearMap := inclusion s + map_one' := rfl + map_mul' _ _ := rfl + +end GeneratedBySet + +variable [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] [IsCommJordan E] + +namespace GeneratedBySet + +variable (s : Set E) + +instance : SMulCommClass ℝ (GeneratedBySet s) (GeneratedBySet s) where + smul_comm r x y := by + apply Subtype.ext + simp only [smul_eq_mul, val_mul, Submodule.coe_smul] + exact (mul_smul_comm r (x : E) (y : E)).symm + +instance : IsScalarTower ℝ (GeneratedBySet s) (GeneratedBySet s) where + smul_assoc r x y := Subtype.ext (smul_mul_assoc r (x : E) (y : E)) + +/-- The Jordan identity restricts to every generated Jordan fragment. -/ +instance : IsCommJordan (GeneratedBySet s) where + lmul_comm_rmul_rmul x y := + Subtype.ext (IsCommJordan.lmul_comm_rmul_rmul (x : E) (y : E)) + +omit [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] [IsCommJordan E] in +/-- The canonical inclusion preserves the order unit. -/ +@[simp] +theorem inclusion_one : inclusion s (1 : GeneratedBySet s) = 1 := rfl + +omit [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] [IsCommJordan E] in +/-- The canonical inclusion preserves the Jordan product. -/ +@[simp] +theorem inclusion_mul (x y : GeneratedBySet s) : + inclusion s (x * y) = inclusion s x * inclusion s y := rfl + +end GeneratedBySet + +/-- The existing power-span model is exactly the universal Jordan submodule generated by one +observable. Thus single-observable CFC and later two-generator work share one closure notion, +rather than maintaining competing generated-algebra semantics. -/ +theorem generatedBySet_singleton_eq_generatedByOne (a : E) : + generatedBySet ({a} : Set E) = generatedByOne a := by + apply le_antisymm + · apply generatedBySet_le + · intro x hx + rw [Set.mem_singleton_iff] at hx + rw [hx] + exact self_mem_generatedByOne a + · constructor + · exact one_mem_generatedByOne a + · intro x y hx hy + exact mul_mem_generatedByOne a hx hy + · apply Submodule.span_le.mpr + rintro x ⟨n, rfl⟩ + induction n with + | zero => simpa using one_mem_generatedBySet ({a} : Set E) + | succ n ih => + rw [jpow_succ] + apply mul_mem_generatedBySet ({a} : Set E) + · exact subset_generatedBySet ({a} : Set E) (by simp) + · exact ih + +/-- The two-observable generated Jordan fragment, the carrier for the future formal +Shirshov--Cohn/specialness theorem. No associative structure is asserted here. -/ +abbrev generatedByTwo (a b : E) : Submodule ℝ E := generatedBySet ({a, b} : Set E) + +/-- The two-observable generated Jordan fragment as an actual unital Jordan algebra. -/ +abbrev GeneratedByTwo (a b : E) : Type _ := GeneratedBySet ({a, b} : Set E) + +omit [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] [IsCommJordan E] in +theorem left_mem_generatedByTwo (a b : E) : a ∈ generatedByTwo a b := + subset_generatedBySet ({a, b} : Set E) (by simp) + +omit [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] [IsCommJordan E] in +theorem right_mem_generatedByTwo (a b : E) : b ∈ generatedByTwo a b := + subset_generatedBySet ({a, b} : Set E) (by simp) + +omit [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] [IsCommJordan E] in +/-- The two-observable generated fragment is independent of the order in which its generators +are named. -/ +theorem generatedByTwo_comm (a b : E) : generatedByTwo a b = generatedByTwo b a := by + have hset : ({a, b} : Set E) = {b, a} := by + ext x + simp [or_comm] + rw [generatedByTwo, hset] + +end JordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Power/GeneratedByOne.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Power/GeneratedByOne.lean new file mode 100644 index 0000000000..652ee645ba --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Power/GeneratedByOne.lean @@ -0,0 +1,88 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Power.Associative + +/-! + +# The subalgebra generated by a single element + +## i. Overview + +`J[a] := \operatorname{span}_ℝ\{1, a, a^2, a^3, \dots\}`: the smallest ℝ-subspace of a Jordan +order-unit algebra containing `1` and closed under `∘`-multiplication by `a`. Every element of +`J[a]` is (by definition of `span`) a finite real-linear combination of powers `a^{[n]}`. + +This file only builds the *module*-level object and its membership API; the payoff — that `J[a]` +carries a genuine commutative *associative* ring structure, reducing single-observable spectral +theory to mathlib's ordinary associative machinery (`Power/Associative.lean`'s module docstring +spells out the architecture) — is `Ring.lean`. + +## ii. Key definitions and results + +- `IsJordanOrderUnit.generatedByOne` +- `IsJordanOrderUnit.jpow_mem_generatedByOne`, `IsJordanOrderUnit.one_mem_generatedByOne`, + `IsJordanOrderUnit.self_mem_generatedByOne` +- `IsJordanOrderUnit.mul_mem_generatedByOne` : `J[a]` is closed under `∘` + +## iii. Table of contents + +- A. The generated submodule +- B. Closure under the Jordan product + +-/ + +@[expose] public section + +namespace JordanAlgebra + +variable {E : Type*} [NonAssocCommRing E] [Module ℝ E] [SMulCommClass ℝ E E] + [IsScalarTower ℝ E E] [IsCommJordan E] + +open scoped JordanAlgebra + +/-! ## A. The generated submodule -/ + +/-- The subalgebra generated by `1` and `a`, as an ℝ-submodule: the span of all Jordan powers of +`a` (which already includes `a^{[0]} = 1`). -/ +def generatedByOne (a : E) : Submodule ℝ E := Submodule.span ℝ (Set.range (jpow a)) + +omit [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] [IsCommJordan E] in +theorem jpow_mem_generatedByOne (a : E) (n : ℕ) : a ^[n] ∈ generatedByOne a := + Submodule.subset_span ⟨n, rfl⟩ + +omit [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] [IsCommJordan E] in +theorem one_mem_generatedByOne (a : E) : (1 : E) ∈ generatedByOne a := by + have h := jpow_mem_generatedByOne a 0 + rwa [jpow_zero] at h + +omit [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] [IsCommJordan E] in +theorem self_mem_generatedByOne (a : E) : a ∈ generatedByOne a := by + have h := jpow_mem_generatedByOne a 1 + rwa [jpow_one] at h + +/-! ## B. Closure under the Jordan product -/ + +/-- `J[a]` is closed under the Jordan product: multiplying two finite real-linear combinations of +powers of `a` gives another one, by bilinearity of `∘` together with the power-associativity +identity `pow_add` (`Power/Associative.lean`). This is the module-level shadow of the deeper fact +(`Ring.lean`) that `∘` restricted to `J[a]` is not just closed but genuinely associative. -/ +theorem mul_mem_generatedByOne (a : E) {x y : E} (hx : x ∈ generatedByOne a) + (hy : y ∈ generatedByOne a) : x * y ∈ generatedByOne a := by + induction hx, hy using Submodule.span_induction₂ with + | mem_mem x y hx hy => + obtain ⟨m, rfl⟩ := hx + obtain ⟨n, rfl⟩ := hy + exact pow_add a m n ▸ jpow_mem_generatedByOne a (m + n) + | zero_left => simp + | zero_right => simp + | add_left _ _ _ _ _ _ ihx ihy => simpa [add_mul] using (generatedByOne a).add_mem ihx ihy + | add_right _ _ _ _ _ _ ihy ihz => simpa [mul_add] using (generatedByOne a).add_mem ihy ihz + | smul_left r _ _ _ _ ih => simpa [smul_mul_assoc] using (generatedByOne a).smul_mem r ih + | smul_right r _ _ _ _ ih => simpa [mul_smul_comm] using (generatedByOne a).smul_mem r ih + +end JordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Power/Quadratic.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Power/Quadratic.lean new file mode 100644 index 0000000000..541f3f459c --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Power/Quadratic.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Power.Associative + +/-! + +# Quadratic representations on one-generated Jordan algebras + +Power-associativity makes the action of `U` on powers completely explicit. These formulas are +pure Jordan algebra: they require neither an order nor a norm. They form the computational base +for the deeper quadratic identities and, later, positivity of `U` in a JB-algebra. + +The general fundamental formula `U_(U_a b) = U_a U_b U_a` is intentionally not postulated here; +it will be added only with a proof from the Jordan identity. + +-/ + +@[expose] public section + +namespace JordanAlgebra + +variable {E : Type*} [NonAssocCommRing E] [Module ℝ E] [SMulCommClass ℝ E E] + [IsCommJordan E] + +open scoped JordanAlgebra + +/-! ## Quadratic action on powers -/ + +/-- The quadratic representation is ordinary degree doubling on the associative algebra +generated by one element: +`U_(a^[m]) (a^[n]) = a^[2*m+n]`. + +The exponent is written `2*m+n` to make the two copies of the outer power contributed by +`U` visible. -/ +theorem quadRep_jpow_jpow (a : E) (m n : ℕ) : + U (a ^[m]) (a ^[n]) = a ^[2 * m + n] := by + rw [quadRep_apply] + have h₁ : a ^[m] * (a ^[m] * a ^[n]) = a ^[m + (m + n)] := by + rw [pow_add, pow_add] + have h₂ : (a ^[m]) ^[2] * a ^[n] = a ^[m + m + n] := by + rw [jpow_two, pow_add, pow_add] + rw [h₁, h₂] + have hdegree₁ : m + (m + n) = 2 * m + n := by omega + have hdegree₂ : m + m + n = 2 * m + n := by omega + rw [hdegree₁, hdegree₂] + module + +/-- A single outer factor raises the degree of a power by two. -/ +theorem quadRep_jpow (a : E) (n : ℕ) : U a (a ^[n]) = a ^[n + 2] := by + simpa [jpow_one, Nat.add_comm] using quadRep_jpow_jpow a 1 n + +/-- The quadratic representation of a power at the order unit is its even power. -/ +theorem quadRep_jpow_one (a : E) (m : ℕ) : U (a ^[m]) (1 : E) = a ^[2 * m] := by + simpa using quadRep_jpow_jpow a m 0 + +/-- Quadratic representations compose additively on powers of a common element. -/ +theorem quadRep_jpow_comp_jpow (a : E) (m n k : ℕ) : + U (a ^[m]) (U (a ^[n]) (a ^[k])) = a ^[2 * m + 2 * n + k] := by + rw [quadRep_jpow_jpow a n k, quadRep_jpow_jpow a m (2 * n + k)] + congr 1 + omega + +end JordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Power/Ring.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Power/Ring.lean new file mode 100644 index 0000000000..362fc8aea0 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Power/Ring.lean @@ -0,0 +1,171 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Power.GeneratedByOne + +/-! + +# `J[a]` is a commutative associative unital algebra + +## i. Overview + +This is the payoff of `Power/Associative.lean` and `Power/GeneratedByOne.lean`: the subalgebra +`J[a] = generatedByOne a`, equipped with the Jordan product `∘` restricted to it +(`mul_mem_generatedByOne` shows this restriction lands back in `J[a]`), is a genuine commutative +**associative** unital `ℝ`-algebra. Associativity is not assumed — it is *proved*, by expanding +any three elements of `J[a]` into finite linear combinations of powers of `a` and reducing to +`pow_add`'s monomial identity `a^{[m]} \circ a^{[n]} = a^{[m+n]}` (itself associative on the nose, +since `ℕ`-addition is). This is exactly the classical reduction the module docstring of +`Power/Associative.lean` describes: +$$ C(\sigma(a), \mathbb R) \xrightarrow{\text{CFC}} J[a] \xrightarrow{\iota} E, $$ +and this file is what makes the left-hand associative algebra `J[a]` an honest object mathlib's +ordinary `CommRing`/`Algebra ℝ` machinery applies to, rather than needing any bespoke +non-associative functional calculus. + +`J[a]` is packaged as a `Submodule ℝ E` (from `GeneratedByOne.lean`) rather than a fresh type: the +`Subtype`/coercion API this gives for free (`Submodule.subtype`, `AddSubmonoid`, ...) is exactly +what is needed, and it keeps the inclusion `ι : J[a] → E` (the second arrow above) definitionally +trivial rather than something to construct. + +The power-associativity theorem in `Power/Associative.lean` is proved from the polarized Jordan +identity, so the associative ring structure produced here is unconditional. + +## ii. Key definitions and results + +- `JordanAlgebra.GeneratedByOne` : the subtype packaging of `generatedByOne a` +- `JordanAlgebra.GeneratedByOne.instCommRing` : the associative commutative ring structure +- `JordanAlgebra.GeneratedByOne.instAlgebra` : the `ℝ`-algebra structure + +## iii. Table of contents + +- A. The carrier type and its multiplication +- B. The commutative ring structure +- C. The `ℝ`-algebra structure and inclusion + +-/ + +@[expose] public section + +namespace JordanAlgebra + +variable {E : Type*} [NonAssocCommRing E] [Module ℝ E] [SMulCommClass ℝ E E] + [IsScalarTower ℝ E E] [IsCommJordan E] (a : E) + +open scoped JordanAlgebra + +/-! ## A. The carrier type and its multiplication -/ + +/-- The subalgebra generated by `1` and `a`, as its own type (the subtype of `generatedByOne a`). +This is what carries the associative `CommRing`/`Algebra ℝ` instances below; the ambient `E` itself +is generally *not* associative, so those instances cannot live on `E`. -/ +abbrev GeneratedByOne (a : E) : Type _ := generatedByOne a + +namespace GeneratedByOne + +instance : Mul (GeneratedByOne a) where + mul x y := ⟨(x : E) * (y : E), mul_mem_generatedByOne a x.2 y.2⟩ + +@[simp] theorem val_mul (x y : GeneratedByOne a) : ((x * y : GeneratedByOne a) : E) = (x:E)*(y:E) := + rfl + +instance : One (GeneratedByOne a) := ⟨⟨1, one_mem_generatedByOne a⟩⟩ + +omit [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] [IsCommJordan E] in +@[simp] theorem val_one : ((1 : GeneratedByOne a) : E) = 1 := rfl + +/-! ## B. The commutative ring structure -/ + +theorem mul_assoc (x y z : GeneratedByOne a) : x * y * z = x * (y * z) := by + obtain ⟨x, hx⟩ := x + obtain ⟨y, hy⟩ := y + obtain ⟨z, hz⟩ := z + apply Subtype.ext + show (x*y)*z = x*(y*z) + induction hx using Submodule.span_induction with + | mem x hx => + obtain ⟨i, rfl⟩ := hx + induction hy using Submodule.span_induction with + | mem y hy => + obtain ⟨j, rfl⟩ := hy + induction hz using Submodule.span_induction with + | mem z hz => + obtain ⟨k, rfl⟩ := hz + rw [pow_add, pow_add, pow_add, pow_add, Nat.add_assoc] + | zero => simp + | add _ _ _ _ h1 h2 => simp [mul_add, h1, h2] + | smul c _ _ h => simp [mul_smul_comm, h] + | zero => simp + | add _ _ _ _ h1 h2 => simp [mul_add, add_mul, h1, h2] + | smul c _ _ h => simp [mul_smul_comm, smul_mul_assoc, h] + | zero => simp + | add _ _ _ _ h1 h2 => simp [add_mul, h1, h2] + | smul c _ _ h => simp [smul_mul_assoc, h] + +theorem mul_comm (x y : GeneratedByOne a) : x * y = y * x := + Subtype.ext (_root_.mul_comm (x:E) (y:E)) + +theorem one_mul (x : GeneratedByOne a) : (1 : GeneratedByOne a) * x = x := + Subtype.ext (_root_.one_mul (x:E)) + +theorem mul_one (x : GeneratedByOne a) : x * (1 : GeneratedByOne a) = x := + Subtype.ext (_root_.mul_one (x:E)) + +theorem left_distrib (x y z : GeneratedByOne a) : x * (y + z) = x * y + x * z := + Subtype.ext (mul_add (x:E) (y:E) (z:E)) + +theorem right_distrib (x y z : GeneratedByOne a) : (x + y) * z = x * z + y * z := + Subtype.ext (add_mul (x:E) (y:E) (z:E)) + +/-- `J[a]`, the subalgebra generated by `1` and `a`, is a genuine commutative **associative** +ring: the reduction promised in the module docstrings of `Power/Associative.lean` and this file. -/ +instance instCommRing : CommRing (GeneratedByOne a) where + __ := (inferInstance : AddCommGroup (GeneratedByOne a)) + mul := (· * ·) + mul_assoc := mul_assoc a + one := 1 + one_mul := one_mul a + mul_one := mul_one a + left_distrib := left_distrib a + right_distrib := right_distrib a + mul_comm := mul_comm a + zero_mul x := Subtype.ext (by simp) + mul_zero x := Subtype.ext (by simp) + +/-! ## C. The `ℝ`-algebra structure and inclusion -/ + +/-- The inclusion `J[a] ↪ E`, the second arrow of +`C(σ(a), ℝ) → J[a] → E`. Just the submodule coercion, definitionally trivial. -/ +def inclusion : GeneratedByOne a → E := Subtype.val + +omit [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] [IsCommJordan E] in +@[simp] theorem inclusion_apply (x : GeneratedByOne a) : inclusion a x = (x : E) := rfl + +omit [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] [IsCommJordan E] in +theorem inclusion_injective : Function.Injective (inclusion a) := Subtype.val_injective + +/-- `J[a]` is an `ℝ`-algebra: scalars act via the ambient `Module ℝ E` structure (already +compatible with `∘` on `E`, hence with the restricted product on `J[a]`), and the algebra map is +just `c ↦ c • 1`. -/ +noncomputable instance instAlgebra : Algebra ℝ (GeneratedByOne a) where + algebraMap := + { toFun := fun c => ⟨c • (1 : E), (generatedByOne a).smul_mem c (one_mem_generatedByOne a)⟩ + map_one' := Subtype.ext (one_smul ℝ 1) + map_mul' := fun c d => Subtype.ext (by + show (c * d) • (1:E) = (c • (1:E)) * (d • (1:E)) + rw [mul_smul_comm, smul_mul_assoc, _root_.one_mul, smul_smul, + _root_.mul_comm c d]) + map_zero' := Subtype.ext (by simp) + map_add' := fun c d => Subtype.ext (by simp [add_smul]) } + commutes' c x := mul_comm a _ x + smul c x := ⟨c • (x:E), (generatedByOne a).smul_mem c x.2⟩ + smul_def' c x := Subtype.ext (by + show c • (x:E) = (c • (1:E)) * (x:E) + rw [smul_mul_assoc, _root_.one_mul]) + +end GeneratedByOne + +end JordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/ProjectionResolution.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/ProjectionResolution.lean new file mode 100644 index 0000000000..cdd711f95e --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/ProjectionResolution.lean @@ -0,0 +1,297 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Effect.BoundedIntegral +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Observable + +/-! + +# Intrinsic measurable projection resolutions + +`EffectValuedMeasure` already owns the order-theoretic measure API: effects, normalization, +countable additivity as an `IsLUB` of partial sums, scalarization, and integration are not +repeated here. A measurable projection resolution is the strictly stronger, Jordan-algebraic +object obtained by requiring each event effect to be an idempotent and intersections to be +represented by the Jordan product. + +This definition is intentionally below JBW. It needs neither monotone completeness as a class +field nor Hilbert-space operators: the `IsLUB` formulation is already the weakest valid +countable-additivity statement. JBW theory later supplies existence for an observable and uses +normal states to scalarize and separate these resolutions. + +-/ + +@[expose] public section + +section Core + +variable {Ω E : Type*} [MeasurableSpace Ω] [NonAssocCommRing E] [PartialOrder E] + [IsOrderedAddMonoid E] [Module ℝ E] [PosSMulMono ℝ E] [SMulCommClass ℝ E E] + [IsScalarTower ℝ E E] [IsOrderUnit E] + +/-- A measurable projection resolution is an effect-valued measure whose event effects are +Jordan projections and whose product realizes intersection. Its countable-additivity and +normalization fields are inherited from `EffectValuedMeasure`, so this is a refinement rather +than a parallel measure representation. -/ +structure MeasurableProjectionResolution (Ω : Type*) [MeasurableSpace Ω] (E : Type*) + [NonAssocCommRing E] [PartialOrder E] [IsOrderedAddMonoid E] [Module ℝ E] + [PosSMulMono ℝ E] [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] [IsOrderUnit E] where + /-- The underlying countably additive effect-valued measure. -/ + toEffectValuedMeasure : EffectValuedMeasure Ω E + /-- Every measurable event is a Jordan projection. -/ + isJordanProjection' : ∀ s hs, + JordanAlgebra.IsJordanProjection (toEffectValuedMeasure s hs : E) + /-- Intersection of measurable events is multiplication of their projections. -/ + map_inter' : ∀ s t hs ht, + (toEffectValuedMeasure s hs : E) * (toEffectValuedMeasure t ht : E) = + (toEffectValuedMeasure (s ∩ t) (hs.inter ht) : E) + +namespace MeasurableProjectionResolution + +instance : CoeOut (MeasurableProjectionResolution Ω E) (EffectValuedMeasure Ω E) := + ⟨MeasurableProjectionResolution.toEffectValuedMeasure⟩ + +instance : CoeFun (MeasurableProjectionResolution Ω E) fun _ => + ∀ s : Set Ω, MeasurableSet s → Effect E := + ⟨fun P => P.toEffectValuedMeasure⟩ + +/-- Projection resolutions are determined by their event projections. This is purely structural +and belongs below JBW: normal-state separation is only one later way to establish its premise. -/ +@[ext] +theorem ext {P Q : MeasurableProjectionResolution Ω E} + (h : ∀ s hs, (P s hs : E) = (Q s hs : E)) : P = Q := by + cases P with + | mk P hP hPinter => + cases Q with + | mk Q hQ hQinter => + dsimp at h ⊢ + have hPQ : P = Q := EffectValuedMeasure.ext fun s hs => + Subtype.ext (h s hs) + subst Q + rfl + +/-- The impossible event is the zero effect. -/ +theorem map_empty (P : MeasurableProjectionResolution Ω E) : + P ∅ MeasurableSet.empty = 0 := + P.toEffectValuedMeasure.map_empty + +/-- The whole outcome space is the unit effect. -/ +theorem map_univ (P : MeasurableProjectionResolution Ω E) : + P Set.univ MeasurableSet.univ = 1 := + P.toEffectValuedMeasure.map_univ + +/-- Each event of a measurable projection resolution is an intrinsic Jordan projection. -/ +theorem isJordanProjection (P : MeasurableProjectionResolution Ω E) + (s : Set Ω) (hs : MeasurableSet s) : + JordanAlgebra.IsJordanProjection (P s hs : E) := + P.isJordanProjection' s hs + +/-- The projection product computes measurable intersection. -/ +theorem map_inter (P : MeasurableProjectionResolution Ω E) + (s t : Set Ω) (hs : MeasurableSet s) (ht : MeasurableSet t) : + (P s hs : E) * (P t ht : E) = P (s ∩ t) (hs.inter ht) := + P.map_inter' s t hs ht + +/-- Disjoint measurable events have Jordan-orthogonal projections. -/ +theorem jordanOrthogonal_of_disjoint (P : MeasurableProjectionResolution Ω E) + {s t : Set Ω} (hs : MeasurableSet s) (ht : MeasurableSet t) (hdisj : Disjoint s t) : + JordanAlgebra.JordanOrthogonal (P s hs : E) (P t ht : E) := by + rw [JordanAlgebra.JordanOrthogonal, P.map_inter s t hs ht] + have hinter : s ∩ t = ∅ := hdisj.inter_eq + simp only [hinter] + change ((P ∅ MeasurableSet.empty : Effect E) : E) = 0 + rw [P.map_empty] + rfl + +/-- The inherited countable-additivity law, stated in the ambient ordered Jordan algebra. -/ +theorem countably_additive (P : MeasurableProjectionResolution Ω E) (s : ℕ → Set Ω) + (hsm : ∀ n, MeasurableSet (s n)) (hs : ∀ m n, m ≠ n → Disjoint (s m) (s n)) : + IsLUB (Set.range fun N : ℕ => ∑ n ∈ Finset.range N, (P (s n) (hsm n) : E)) + (P (⋃ n, s n) (MeasurableSet.iUnion hsm) : E) := + P.toEffectValuedMeasure.countably_additive s hsm hs + +end MeasurableProjectionResolution + +end Core + +/-! ## Bounded Borel calculus + +The resolution does not duplicate the order-unit integral. Under the analytic hypotheses under +which that integral is available, this section gives it its spectral-calculus name. -/ + +namespace MeasurableProjectionResolution + +section BoundedBorel + +variable {Ω E : Type*} [MeasurableSpace Ω] [NonAssocCommRing E] [PartialOrder E] + [IsOrderedAddMonoid E] [Module ℝ E] [PosSMulMono ℝ E] [SMulCommClass ℝ E E] + [IsScalarTower ℝ E E] [IsArchimedeanOrderUnit E] + +/-- The order-unit norm supplies the topology required by the completed bounded integral. -/ +noncomputable local instance : NormedAddCommGroup E := + IsArchimedeanOrderUnit.orderUnitNormedAddCommGroup + +variable [CompleteSpace E] + +/-- The bounded Borel calculus of a measurable projection resolution. This is the existing +effect-valued integral applied to the underlying measure, not a parallel construction. -/ +noncomputable def boundedBorel (P : MeasurableProjectionResolution Ω E) (f : Ω → ℝ) + (hf : Measurable f) {M : ℝ} (hM : ∀ x, |f x| ≤ M) : E := + EffectValuedMeasure.integral hf hM P.toEffectValuedMeasure + +/-- A nonnegative bounded Borel function has a positive value under the resolution calculus. -/ +theorem nonneg_boundedBorel (P : MeasurableProjectionResolution Ω E) (f : Ω → ℝ) + (hf : Measurable f) {M : ℝ} (hM : ∀ x, |f x| ≤ M) (hf0 : ∀ x, 0 ≤ f x) : + 0 ≤ P.boundedBorel f hf hM := + EffectValuedMeasure.nonneg_integral hf hM hf0 P.toEffectValuedMeasure + +/-- The bounded Borel value is independent of the particular valid uniform bound used to +construct the completed order-unit integral. -/ +theorem boundedBorel_indep_of_bound (P : MeasurableProjectionResolution Ω E) (f : Ω → ℝ) + (hf : Measurable f) {M M' : ℝ} (hM : ∀ x, |f x| ≤ M) (hM' : ∀ x, |f x| ≤ M') : + P.boundedBorel f hf hM = P.boundedBorel f hf hM' := + EffectValuedMeasure.integral_indep_of_bound hf hM hM' P.toEffectValuedMeasure + +/-- The bounded Borel calculus is additive. -/ +theorem boundedBorel_add (P : MeasurableProjectionResolution Ω E) {f g : Ω → ℝ} + (hf : Measurable f) {M : ℝ} (hM : ∀ x, |f x| ≤ M) + (hg : Measurable g) {M' : ℝ} (hM' : ∀ x, |g x| ≤ M') + (hfg : Measurable (f + g)) (hMfg : ∀ x, |(f + g) x| ≤ M + M') : + P.boundedBorel (f + g) hfg hMfg = + P.boundedBorel f hf hM + P.boundedBorel g hg hM' := + EffectValuedMeasure.integral_add hf hM hg hM' P.toEffectValuedMeasure + +/-- The bounded Borel calculus is real-homogeneous. -/ +theorem boundedBorel_smul (P : MeasurableProjectionResolution Ω E) (c : ℝ) {f : Ω → ℝ} + (hf : Measurable f) {M : ℝ} (hM : ∀ x, |f x| ≤ M) + (hcf : Measurable (c • f)) (hMcf : ∀ x, |(c • f) x| ≤ |c| * M) : + P.boundedBorel (c • f) hcf hMcf = c • P.boundedBorel f hf hM := + EffectValuedMeasure.integral_smul hf hM c P.toEffectValuedMeasure + +/-- The characteristic function of a measurable event integrates to precisely its projection. +This is the bridge from the bounded Borel calculus back to the projection resolution itself. -/ +theorem boundedBorel_indicator (P : MeasurableProjectionResolution Ω E) {s : Set Ω} + (hs : MeasurableSet s) : + P.boundedBorel (s.indicator fun _ : Ω => (1 : ℝ)) (measurable_const.indicator hs) + (M := 1) (by intro x; by_cases hx : x ∈ s <;> simp [hx]) = (P s hs : E) := by + classical + let c : Bool → ℝ := fun b => if b then 1 else 0 + let pieces : Bool → Set Ω := fun b => if b then s else sᶜ + have hpieces : EffectValuedMeasure.IsPartition pieces := + { measurable := by intro b; cases b <;> simp [pieces, hs] + disjoint := by + intro b b' hne + cases b <;> cases b' + · exact (hne rfl).elim + · exact disjoint_compl_left + · exact disjoint_compl_right + · exact (hne rfl).elim + cover := by + apply Set.Subset.antisymm + · exact Set.subset_univ _ + · intro x _ + by_cases hx : x ∈ s + · exact Set.mem_iUnion.2 ⟨true, by simp [pieces, hx]⟩ + · exact Set.mem_iUnion.2 ⟨false, by simp [pieces, hx]⟩ } + have hvalue : ∀ x, EffectValuedMeasure.simpleValue c pieces x = + s.indicator (fun _ : Ω => (1 : ℝ)) x := by + intro x + by_cases hx : x ∈ s + · rw [EffectValuedMeasure.simpleValue_apply_of_mem hpieces (i := true)] + · simp [c, hx] + · simp [pieces, hx] + · rw [EffectValuedMeasure.simpleValue_apply_of_mem hpieces (i := false)] + · simp [c, hx] + · simp [pieces, hx] + rw [boundedBorel, EffectValuedMeasure.integral_eq_simpleIntegral + (measurable_const.indicator hs) (by intro x; by_cases hx : x ∈ s <;> simp [hx]) + hpieces hvalue] + unfold EffectValuedMeasure.simpleIntegral + simp [c, pieces] + +/-- The constant-one bounded Borel function integrates to the order unit. This is the +normalization of the inherited effect-valued measure, recovered from the indicator law for the +whole outcome space. -/ +theorem boundedBorel_one (P : MeasurableProjectionResolution Ω E) : + P.boundedBorel (fun _ : Ω => (1 : ℝ)) measurable_const (M := 1) (by intro _; simp) = 1 := by + simpa using P.boundedBorel_indicator (s := Set.univ) MeasurableSet.univ + +/-- A measurable `[0,1]`-valued bounded function has an effect-valued bounded Borel calculus. +This packages positivity and normalization once at the shared projection-resolution layer; every +JBW projection resolution inherits it. -/ +noncomputable def boundedBorelEffect (P : MeasurableProjectionResolution Ω E) (f : Ω → ℝ) + (hf : Measurable f) (hf0 : ∀ x, 0 ≤ f x) (hf1 : ∀ x, f x ≤ 1) : Effect E := + let g : Ω → ℝ := fun x => 1 - f x + have hfbound : ∀ x, |f x| ≤ 1 := fun x => by + rw [abs_of_nonneg (hf0 x)] + exact hf1 x + have hgbound : ∀ x, |g x| ≤ 1 := fun x => by + rw [abs_of_nonneg (sub_nonneg.mpr (hf1 x))] + exact sub_le_self 1 (hf0 x) + have hg : Measurable g := measurable_const.sub hf + have hg0 : ∀ x, 0 ≤ g x := fun x => sub_nonneg.mpr (hf1 x) + have hsummeas : Measurable (f + g) := hf.add hg + have hsumbound : ∀ x, |(f + g) x| ≤ 1 + 1 := fun x => by + change |f x + (1 - f x)| ≤ 1 + 1 + norm_num + have hsum := P.boundedBorel_add hf hfbound hg hgbound hsummeas hsumbound + ⟨P.boundedBorel f hf hfbound, P.nonneg_boundedBorel f hf hfbound hf0, by + have htotal : P.boundedBorel f hf hfbound + P.boundedBorel g hg hgbound = 1 := by + calc + P.boundedBorel f hf hfbound + P.boundedBorel g hg hgbound = + P.boundedBorel (f + g) hsummeas hsumbound := hsum.symm + _ = 1 := by + let c : Unit → ℝ := fun _ => 1 + let pieces : Unit → Set Ω := fun _ => Set.univ + have hpieces : EffectValuedMeasure.IsPartition pieces := + { measurable := fun _ => MeasurableSet.univ + disjoint := by + intro i j hij + exact (hij (Subsingleton.elim i j)).elim + cover := by + apply Set.Subset.antisymm + · exact Set.iUnion_subset fun _ => Set.subset_univ _ + · intro x _ + exact Set.mem_iUnion.2 ⟨Unit.unit, by simp [pieces]⟩ } + have hvalue : ∀ x, EffectValuedMeasure.simpleValue c pieces x = (f + g) x := by + intro x + simp [EffectValuedMeasure.simpleValue, c, pieces, g] + rw [boundedBorel, EffectValuedMeasure.integral_eq_simpleIntegral + hsummeas hsumbound hpieces hvalue] + unfold EffectValuedMeasure.simpleIntegral + simp [c, pieces] + rw [← htotal] + exact le_add_of_nonneg_right (P.nonneg_boundedBorel g hg hgbound hg0)⟩ + +/-- Coercing the bounded Borel effect forgets only its established interval bounds. -/ +@[simp] +theorem coe_boundedBorelEffect (P : MeasurableProjectionResolution Ω E) (f : Ω → ℝ) + (hf : Measurable f) (hf0 : ∀ x, 0 ≤ f x) (hf1 : ∀ x, f x ≤ 1) : + (P.boundedBorelEffect f hf hf0 hf1 : E) = + P.boundedBorel f hf (M := 1) + (fun x => by rw [abs_of_nonneg (hf0 x)]; exact hf1 x) := + rfl + +/-- The bounded Borel calculus determines a projection resolution. It suffices to compare every +bounded measurable function because indicators recover exactly the event projections. -/ +theorem ext_of_forall_boundedBorel_eq {P Q : MeasurableProjectionResolution Ω E} + (h : ∀ (f : Ω → ℝ) (hf : Measurable f) {M : ℝ} (hM : ∀ x, |f x| ≤ M), + P.boundedBorel f hf hM = Q.boundedBorel f hf hM) : P = Q := by + apply ext + intro s hs + let f : Ω → ℝ := s.indicator fun _ => (1 : ℝ) + have hf : Measurable f := measurable_const.indicator hs + have hbound : ∀ x, |f x| ≤ 1 := by + intro x + by_cases hx : x ∈ s <;> simp [f, hx] + have hvalue := h f hf hbound + rw [P.boundedBorel_indicator hs, Q.boundedBorel_indicator hs] at hvalue + exact hvalue + +end BoundedBorel + +end MeasurableProjectionResolution diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Quadratic/Fundamental.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Quadratic/Fundamental.lean new file mode 100644 index 0000000000..c77861f140 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Quadratic/Fundamental.lean @@ -0,0 +1,1081 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Quadratic.Triple +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Power.Quadratic + +/-! + +# The fundamental formula for quadratic Jordan representations + +The target of this module is the purely algebraic identity + +`U (U a b) = U a * U b * U a`. + +It is the central composition law for quadratic representations. This module is kept separate +from the elementary definition of `U` and from ordered/JB positivity, because its proof uses the +Jordan identity but no order or norm. + +-/ + +@[expose] public section + +namespace JordanAlgebra + +variable {E : Type*} [NonAssocCommRing E] [Module ℝ E] [SMulCommClass ℝ E E] + [IsCommJordan E] + +open scoped JordanAlgebra + +/-! ## Fundamental composition identity -/ + +omit [SMulCommClass ℝ E E] in +/-- The fully polarised Jordan identity, evaluated at a third element. Mathlib states this as +an equality of additive endomorphisms annihilated by `2`; over a real Jordan algebra the scalar +action is torsion-free, so the actual cyclic commutator vanishes. Keeping this pointwise form is +useful when expanding identities for `U`, while avoiding a second, parallel multiplication +operator API. -/ +theorem cyclic_mulLeft_commutator (a b c x : E) : + (a * ((b * c) * x) - (b * c) * (a * x)) + + (b * ((c * a) * x) - (c * a) * (b * x)) + + (c * ((a * b) * x) - (a * b) * (c * x)) = 0 := by + have h := two_nsmul_lie_lmul_lmul_add_add_eq_zero a b c + have hx := DFunLike.congr_fun h x + have hx' : (2 : ℕ) • + ((a * ((b * c) * x) - (b * c) * (a * x)) + + (b * ((c * a) * x) - (c * a) * (b * x)) + + (c * ((a * b) * x) - (a * b) * (c * x))) = 0 := by + exact hx + have htwo : (2 : ℝ) • + ((a * ((b * c) * x) - (b * c) * (a * x)) + + (b * ((c * a) * x) - (c * a) * (b * x)) + + (c * ((a * b) * x) - (a * b) * (c * x))) = 0 := by + simpa [two_smul] using hx' + calc + _ = (1 / 2 : ℝ) • ((2 : ℝ) • + ((a * ((b * c) * x) - (b * c) * (a * x)) + + (b * ((c * a) * x) - (c * a) * (b * x)) + + (c * ((a * b) * x) - (a * b) * (c * x)))) := by module + _ = 0 := by rw [htwo]; module + +omit [SMulCommClass ℝ E E] in +/-- The cyclic commutator identity, with its three commutators collected. This is the fully +polarized degree-four Jordan relation in the form used by the operator normalization argument. -/ +theorem cyclic_mulLeft_assoc_sum (a b c x : E) : + a * ((b * c) * x) + b * ((c * a) * x) + c * ((a * b) * x) = + (b * c) * (a * x) + (c * a) * (b * x) + (a * b) * (c * x) := by + have h := cyclic_mulLeft_commutator a b c x + apply sub_eq_zero.mp + calc + _ = (a * ((b * c) * x) - (b * c) * (a * x)) + + (b * ((c * a) * x) - (c * a) * (b * x)) + + (c * ((a * b) * x) - (a * b) * (c * x)) := by abel + _ = 0 := h + +/-- The multiplication operator of a triple product can be normalized to a polynomial in +multiplication operators of single and double products. This is equation (2.2) in the +self-contained algebraic proof of the quadratic fundamental formula: it is obtained by applying +the cyclic relation, then exploiting the symmetry of its right-hand side under interchange of +the first and evaluation variables. -/ +theorem mulLeft_triple_normalize (a b c : E) : + L (a * (b * c)) = + ((L a).comp (L (b * c)) + (L b).comp (L (a * c)) + (L c).comp (L (a * b))) - + (((L b).comp (L a)).comp (L c) + ((L c).comp (L a)).comp (L b)) := by + ext x + simp only [LinearMap.sub_apply, LinearMap.add_apply, LinearMap.comp_apply, mulLeft_apply] + have habc := cyclic_mulLeft_assoc_sum a b c x + have hxbc := cyclic_mulLeft_assoc_sum x b c a + have hright : + (b * c) * (a * x) + (c * a) * (b * x) + (a * b) * (c * x) = + (b * c) * (x * a) + (c * x) * (b * a) + (x * b) * (c * a) := by + rw [mul_comm x a, mul_comm b a, mul_comm x b] + rw [mul_comm (c * a) (b * x), mul_comm (a * b) (c * x)] + abel + have hswap : + a * ((b * c) * x) + b * ((c * a) * x) + c * ((a * b) * x) = + x * ((b * c) * a) + b * ((c * x) * a) + c * ((x * b) * a) := by + calc + _ = (b * c) * (a * x) + (c * a) * (b * x) + (a * b) * (c * x) := habc + _ = (b * c) * (x * a) + (c * x) * (b * a) + (x * b) * (c * a) := hright + _ = _ := hxbc.symm + rw [mul_comm (a * (b * c)) x, mul_comm a (b * c), mul_comm a c, + mul_comm a (c * x), mul_comm a (b * x), mul_comm b x] + calc + x * (b * c * a) = + (x * (b * c * a) + b * (c * x * a) + c * (x * b * a)) - + (b * (c * x * a) + c * (x * b * a)) := by abel + _ = _ := by rw [← hswap] + +/-- First specialization of `mulLeft_triple_normalize`: the multiplication operator of the third +Jordan power is a polynomial in `L_a` and `L_(a²)`. -/ +theorem mulLeft_cube_normalize (a : E) : + L (a * (a * a)) = + (3 : ℝ) • ((L a).comp (L (a * a))) - + (2 : ℝ) • (((L a).comp (L a)).comp (L a)) := by + rw [mulLeft_triple_normalize] + module + +/-- Second normalization step, evaluated at `x`: multiplication by `(a²)²` is reduced to the +commuting operators `L_a` and `L_(a²)`. -/ +theorem mul_self_mul_self_mulLeft_normalize (a x : E) : + ((a * a) * (a * a)) * x = + (a * a) * ((a * a) * x) + + (4 : ℝ) • (a * (a * ((a * a) * x))) - + (4 : ℝ) • (a * (a * (a * (a * x)))) := by + have hpow : (a * a) * (a * a) = a * (a * (a * a)) := by + calc + (a * a) * (a * a) = a ^[2] * a ^[2] := by rw [jpow_two] + _ = a ^[4] := pow_add a 2 2 + _ = a * a ^[3] := (jpow_succ a 3).symm + _ = a * (a * (a * a)) := by rw [jpow_succ a 2, jpow_two] + have hnorm := DFunLike.congr_fun (mulLeft_triple_normalize a a (a * a)) x + rw [← hpow] at hnorm + rw [mulLeft_cube_normalize] at hnorm + simp only [LinearMap.sub_apply, LinearMap.add_apply, LinearMap.comp_apply, + LinearMap.smul_apply, mulLeft_apply, mul_smul_comm, mul_sub] at hnorm + have hcomm (y : E) : a * ((a * a) * y) = (a * a) * (a * y) := + by simpa only [jpow_two] using commute_mulLeft_apply (commute_mulLeft_sq a) y + have hYX2 : (a * a) * (a * (a * x)) = a * (a * ((a * a) * x)) := by + calc + (a * a) * (a * (a * x)) = a * ((a * a) * (a * x)) := (hcomm (a * x)).symm + _ = a * (a * ((a * a) * x)) := by rw [hcomm x] + rw [hYX2] at hnorm + calc + _ = (3 : ℝ) • (a * (a * ((a * a) * x))) - (2 : ℝ) • (a * (a * (a * (a * x)))) + + ((3 : ℝ) • (a * (a * ((a * a) * x))) - (2 : ℝ) • (a * (a * (a * (a * x))))) + + (a * a) * ((a * a) * x) - + (a * (a * ((a * a) * x)) + a * (a * ((a * a) * x))) := hnorm + _ = _ := by module + +/-- The quadratic representation of a Jordan square is the square of its quadratic +representation. This is the first nontrivial quadratic fundamental identity; its proof uses only +the finite operator normalization certificate and the Jordan commutation law. -/ +theorem quadRep_mul_self_eq_comp (a : E) : + U (a * a) = (U a).comp (U a) := by + ext x + simp only [LinearMap.comp_apply] + rw [quadRep_apply, quadRep_apply, quadRep_apply] + simp only [jpow_two, mul_smul_comm, mul_sub] + rw [mul_self_mul_self_mulLeft_normalize] + have hcomm (y : E) : a * ((a * a) * y) = (a * a) * (a * y) := + by simpa only [jpow_two] using commute_mulLeft_apply (commute_mulLeft_sq a) y + have hYX2 : (a * a) * (a * (a * x)) = a * (a * ((a * a) * x)) := by + calc + (a * a) * (a * (a * x)) = a * ((a * a) * (a * x)) := (hcomm (a * x)).symm + _ = a * (a * ((a * a) * x)) := by rw [hcomm x] + rw [hYX2] + module + +/-- The square identity evaluated on a sum. This keeps the polarizing source equation in a +canonical bilinear form: the remaining coefficient extraction is purely a finite calculation in +the noncommutative ring of linear endomorphisms. -/ +theorem quadRep_add_mul_self_eq_comp (a b : E) : + U ((a + b) * (a + b)) = + (U a + (2 : ℝ) • quadRepBilin a b + U b).comp + (U a + (2 : ℝ) • quadRepBilin a b + U b) := by + rw [quadRep_mul_self_eq_comp, quadRep_add_eq] + +/-- The positive polarization of the square identity, fully expanded in the canonical bilinear +quadratic operator. Pairing this equation with its signed counterpart isolates the standard +mixed quadratic coefficient. -/ +theorem quadRep_add_square_polarized (a b : E) : + (U a).comp (U a) + (4 : ℝ) • U (a * b) + (U b).comp (U b) + + (4 : ℝ) • quadRepBilin (a * a) (a * b) + + (2 : ℝ) • quadRepBilin (a * a) (b * b) + + (4 : ℝ) • quadRepBilin (a * b) (b * b) = + (U a).comp (U a) + (4 : ℝ) • (quadRepBilin a b).comp (quadRepBilin a b) + + (U b).comp (U b) + (U a).comp (U b) + (U b).comp (U a) + + (2 : ℝ) • ((U a).comp (quadRepBilin a b) + + (quadRepBilin a b).comp (U a) + (U b).comp (quadRepBilin a b) + + (quadRepBilin a b).comp (U b)) := by + have h := quadRep_add_mul_self_eq_comp a b + rw [add_mul_self, quadRep_add_add_eq, quadRep_mul_self_eq_comp, + quadRep_smul_eq, quadRep_mul_self_eq_comp, quadRepBilin_smul_right, + quadRepBilin_smul_left] at h + simp only [LinearMap.add_comp, LinearMap.comp_add, LinearMap.smul_comp, + LinearMap.comp_smul] at h + norm_num at h + convert h using 1 <;> module + +/-- The signed companion to `quadRep_add_square_polarized`. Adding the two equations cancels +the cubic terms and leaves precisely the mixed quadratic coefficient. -/ +theorem quadRep_sub_square_polarized (a b : E) : + (U a).comp (U a) + (4 : ℝ) • U (a * b) + (U b).comp (U b) - + (4 : ℝ) • quadRepBilin (a * a) (a * b) + + (2 : ℝ) • quadRepBilin (a * a) (b * b) - + (4 : ℝ) • quadRepBilin (a * b) (b * b) = + (U a).comp (U a) + (4 : ℝ) • (quadRepBilin a b).comp (quadRepBilin a b) + + (U b).comp (U b) + (U a).comp (U b) + (U b).comp (U a) - + (2 : ℝ) • ((U a).comp (quadRepBilin a b) + + (quadRepBilin a b).comp (U a) + (U b).comp (quadRepBilin a b) + + (quadRepBilin a b).comp (U b)) := by + have h := quadRep_add_square_polarized a (-b) + simp only [mul_neg, neg_mul, quadRep_neg, quadRepBilin_neg_right, + quadRepBilin_neg_left, LinearMap.neg_comp, LinearMap.comp_neg, neg_neg, smul_neg] at h + convert h using 1 <;> module + +/-- The standard mixed quadratic polarization identity. This is the exact coefficient obtained +by adding the positive and signed square identities: all cubic terms cancel, leaving a relation +between the square of the bilinear quadratic operator, `U_(a*b)`, and the square cross-effect. +It is the finite algebraic entry point for the unrestricted quadratic fundamental formula. -/ +theorem quadRepBilin_comp_self_polarization (a b : E) : + (4 : ℝ) • (quadRepBilin a b).comp (quadRepBilin a b) = + (4 : ℝ) • U (a * b) + (2 : ℝ) • quadRepBilin (a * a) (b * b) - + (U a).comp (U b) - (U b).comp (U a) := by + let S := (U a).comp (quadRepBilin a b) + (quadRepBilin a b).comp (U a) + + (U b).comp (quadRepBilin a b) + (quadRepBilin a b).comp (U b) + calc + _ = (1 / 2 : ℝ) • + ((U a).comp (U a) + (4 : ℝ) • (quadRepBilin a b).comp (quadRepBilin a b) + + (U b).comp (U b) + (U a).comp (U b) + (U b).comp (U a) + (2 : ℝ) • S + + ((U a).comp (U a) + (4 : ℝ) • (quadRepBilin a b).comp (quadRepBilin a b) + + (U b).comp (U b) + (U a).comp (U b) + (U b).comp (U a) - (2 : ℝ) • S)) - + (U a).comp (U a) - (U b).comp (U b) - (U a).comp (U b) - (U b).comp (U a) := by + dsimp [S] + module + _ = (1 / 2 : ℝ) • + ((U a).comp (U a) + (4 : ℝ) • U (a * b) + (U b).comp (U b) + + (4 : ℝ) • quadRepBilin (a * a) (a * b) + + (2 : ℝ) • quadRepBilin (a * a) (b * b) + + (4 : ℝ) • quadRepBilin (a * b) (b * b) + + ((U a).comp (U a) + (4 : ℝ) • U (a * b) + (U b).comp (U b) - + (4 : ℝ) • quadRepBilin (a * a) (a * b) + + (2 : ℝ) • quadRepBilin (a * a) (b * b) - + (4 : ℝ) • quadRepBilin (a * b) (b * b))) - + (U a).comp (U a) - (U b).comp (U b) - (U a).comp (U b) - (U b).comp (U a) := by + dsimp [S] + rw [← quadRep_add_square_polarized a b, ← quadRep_sub_square_polarized a b] + _ = _ := by module + +/-! ## Polarizing the cubic commutation law: the triple commutator identity -/ + +omit [IsCommJordan E] in +/-- Pointwise expansion of `U (a + b)` at an arbitrary argument, the elementary consequence of +`quadRep_add_eq` used repeatedly below to unfold both sides of the polarized cubic law. -/ +theorem quadRep_add_apply' (a b y : E) : + U (a + b) y = U a y + (2 : ℝ) • quadRepBilin a b y + U b y := by + rw [quadRep_add_eq] + simp only [LinearMap.add_apply, LinearMap.smul_apply] + +omit [IsCommJordan E] in +/-- Pointwise expansion of `U (a - b)` at an arbitrary argument. -/ +theorem quadRep_sub_apply' (a b y : E) : + U (a - b) y = U a y - (2 : ℝ) • quadRepBilin a b y + U b y := by + rw [quadRep_sub_eq] + simp only [LinearMap.add_apply, LinearMap.sub_apply, LinearMap.smul_apply] + +/-- The `(2,1)`-bidegree polarization of the cubic commutation law `quadRep_mulLeft`. This is the +standard triple commutator identity obtained by substituting `a + b` and `a - b` into +`quadRep_mulLeft` and isolating the pure mixed-bidegree term via the two resulting equations, the +same finite-certificate technique used for the quadratic case in +`quadRepBilin_comp_self_polarization`. It is the next concrete step in the multivariable +polarization program (Stage A item 1 of `JB_ROADMAP.md`): a genuine three-generator trilinear +relation between `U_a`, the bilinear cross-effect `quadRepBilin a b`, and plain multiplication. -/ +theorem quadRepBilin_mulLeft_polarization (a b x : E) : + U a (b * x) + (2 : ℝ) • quadRepBilin a b (a * x) = + b * U a x + (2 : ℝ) • (a * quadRepBilin a b x) := by + have hplus := quadRep_mulLeft (a + b) x + have hminus := quadRep_mulLeft (a - b) x + simp only [add_mul, sub_mul, quadRep_add_apply', quadRep_sub_apply', map_add, map_sub, + mul_add, mul_sub, mul_smul_comm] at hplus hminus + have ha := quadRep_mulLeft a x + have hb := quadRep_mulLeft b x + rw [ha, hb] at hplus hminus + linear_combination (norm := module) (1 / 2 : ℝ) • hplus - (1 / 2 : ℝ) • hminus + +/-- The symmetric companion of `quadRepBilin_mulLeft_polarization`, obtained by exchanging the +roles of `a` and `b` (using symmetry of `quadRepBilin`). Together the pair is the full standard +triple commutator identity: it records the same trilinear relation for both mixed bidegree +components `(2,1)` and `(1,2)` that appear when the cubic law `quadRep_mulLeft` is evaluated at +`a + b`. -/ +theorem quadRepBilin_mulLeft_polarization' (a b x : E) : + U b (a * x) + (2 : ℝ) • quadRepBilin a b (b * x) = + a * U b x + (2 : ℝ) • (b * quadRepBilin a b x) := by + have h := quadRepBilin_mulLeft_polarization b a x + rwa [quadRepBilin_comm] at h + +/-! ## Normalizing the multiplication operator of a quadratic image -/ + +/-- The multiplication operator of the compound element `U a b` normalizes to a polynomial in +`L_a`, `L_b`, `L_(a*a)`, and `L_(a*b)`, with no remaining atom of the same bidegree as `U a b` +itself. This is the concrete outcome of pushing `mulLeft_triple_normalize` further (Stage A item +1 of `JB_ROADMAP.md`, the second candidate route): apply it once to `a * (a * b)` and once to +`b * (a * a)` (using commutativity to identify `(a * a) * b` with `b * (a * a)`), then take the +exact integer combination `2 • (first) - (second)` matching `quadRep_apply`'s expansion of +`U a b = 2 • (a * (a * b)) - jpow a 2 * b`. Unlike the compound element `U a b` itself, this +operator formula uses only single- and double-product multiplication operators, so it is a genuine +new normalization certificate, not a restatement of anything already on hand. -/ +theorem mulLeft_quadRep_normalize (a b : E) : + L (U a b) = + (2 : ℝ) • ((L a).comp (L (a * b))) + (L b).comp (L (a * a)) - + (2 : ℝ) • (((L a).comp (L a)).comp (L b)) - + (2 : ℝ) • (((L b).comp (L a)).comp (L a)) + + (2 : ℝ) • (((L a).comp (L b)).comp (L a)) := by + ext x + simp only [LinearMap.add_apply, LinearMap.sub_apply, LinearMap.smul_apply, + LinearMap.comp_apply, mulLeft_apply] + rw [quadRep_apply] + have hsmul_mul (y : E) : (2 : ℝ) • (a * (a * b)) * y = (2 : ℝ) • ((a * (a * b)) * y) := by + calc + (2 : ℝ) • (a * (a * b)) * y = y * ((2 : ℝ) • (a * (a * b))) := mul_comm _ _ + _ = (2 : ℝ) • (y * (a * (a * b))) := mul_smul_comm _ _ _ + _ = (2 : ℝ) • ((a * (a * b)) * y) := by rw [mul_comm y (a * (a * b))] + rw [sub_mul, hsmul_mul, jpow_two] + have h1 := DFunLike.congr_fun (mulLeft_triple_normalize a a b) x + have h2 := DFunLike.congr_fun (mulLeft_triple_normalize b a a) x + simp only [LinearMap.sub_apply, LinearMap.add_apply, LinearMap.comp_apply, + mulLeft_apply] at h1 h2 + rw [mul_comm (a * a) b] + rw [mul_comm b a] at h2 + linear_combination (norm := module) (2 : ℝ) • h1 - h2 + +omit [IsCommJordan E] in +/-- The quadratic representation of the compound element `U a b` reduces, by bare bilinearity of +`quadRepBilin` (no Jordan identity needed for this step), to the quadratic representations of the +two elementary constituents of `quadRep_apply`'s expansion +`U a b = 2 • (a * (a * b)) - jpow a 2 * b` and their cross-effect. This is the precise sense in +which pushing the operator-normalization route (`mulLeft_quadRep_normalize`) a second level does +*not* terminate the fundamental-formula computation: `a * (a * b)` and `jpow a 2 * b` are +themselves elements of the same bidegree `(2,1)` in `(a, b)` as `U a b`, so `U (a * (a * b))` and +`U (jpow a 2 * b)` are exactly as hard as the original +target `U (U a b)` — this identity trades one degree-`(4,2)` problem for three of the same +difficulty, not for something simpler — this lemma documents precisely why that route does not +close by itself beyond its first level. (`quadRep_fundamental` below is in fact proved by a +different route entirely: the inner-derivation/triple-operator toolkit, `tripleOperator_comm`.) -/ +theorem quadRep_quadRep_eq (a b : E) : + U (U a b) = + (4 : ℝ) • U (a * (a * b)) - (4 : ℝ) • quadRepBilin (a * (a * b)) (jpow a 2 * b) + + U (jpow a 2 * b) := by + rw [← quadRepBilin_self (U a b), quadRep_apply] + set p := a * (a * b) + set q := jpow a 2 * b + have hXX : quadRepBilin ((2 : ℝ) • p - q) ((2 : ℝ) • p - q) = + quadRepBilin ((2 : ℝ) • p) ((2 : ℝ) • p) - quadRepBilin ((2 : ℝ) • p) q - + (quadRepBilin q ((2 : ℝ) • p) - quadRepBilin q q) := by + rw [quadRepBilin_sub_right, quadRepBilin_comm ((2 : ℝ) • p - q) ((2 : ℝ) • p), + quadRepBilin_comm ((2 : ℝ) • p - q) q, quadRepBilin_sub_right, quadRepBilin_sub_right] + rw [hXX] + simp only [quadRepBilin_smul_left, quadRepBilin_smul_right, quadRepBilin_self, + quadRepBilin_comm q p, quadRep_smul_eq] + norm_num + module + +/-! ## The inner derivation and the Jordan-triple-system fundamental identity + +This section formalizes the standard Jordan-triple-system operator toolkit +(`D_{a,b} := [L_a, L_b]`, `V_{a,b} := L_{a*b} + D_{a,b}`) and uses it to prove the linearized +triple-product fundamental identity that direct polarization of `cyclic_mulLeft_commutator` cannot +reach on its own (see `JB_ROADMAP.md` §7): a rank computation shows every *linear* substitution +combination of `cyclic_mulLeft_commutator` spans too small a space; the missing ingredient is the +*nonlinear* operator fact that `innerDerivation a b` is a genuine derivation of the Jordan +product, from which the whole triple identity follows by mechanical (associative) operator +algebra. -/ + +omit [IsCommJordan E] in +/-- Additivity of the inner derivation in its first defining argument. -/ +theorem innerDerivation_add_left (a b c : E) : + innerDerivation (a + b) c = innerDerivation a c + innerDerivation b c := by + ext x + simp only [innerDerivation_apply, LinearMap.add_apply] + simp only [add_mul, mul_add] + module + +omit [IsCommJordan E] in +/-- Real linearity of the inner derivation in its first defining argument. -/ +theorem innerDerivation_smul_left (r : ℝ) (a b : E) : + innerDerivation (r • a) b = r • innerDerivation a b := by + ext x + simp only [innerDerivation_apply, LinearMap.smul_apply] + have hsmul_mul (z y : E) : (r • z) * y = r • (z * y) := by + calc + (r • z) * y = y * (r • z) := mul_comm _ _ + _ = r • (y * z) := mul_smul_comm r y z + _ = r • (z * y) := by rw [mul_comm y z] + rw [hsmul_mul a (b * x), hsmul_mul a x, mul_smul_comm] + simp only [smul_sub] + +omit [IsCommJordan E] in +/-- Additivity of the inner derivation in its second defining argument. -/ +theorem innerDerivation_add_right (a b c : E) : + innerDerivation a (b + c) = innerDerivation a b + innerDerivation a c := by + rw [innerDerivation_swap, innerDerivation_add_left, innerDerivation_swap a b, + innerDerivation_swap a c] + ext x + simp only [LinearMap.neg_apply, LinearMap.add_apply] + abel + +omit [IsCommJordan E] in +/-- Real linearity of the inner derivation in its second defining argument. -/ +theorem innerDerivation_smul_right (r : ℝ) (a b : E) : + innerDerivation a (r • b) = r • innerDerivation a b := by + rw [innerDerivation_swap, innerDerivation_smul_left, innerDerivation_swap a b, smul_neg] + +omit [IsCommJordan E] in +/-- Difference expansion of the inner derivation in its first defining argument. -/ +theorem innerDerivation_sub_left (a b c : E) : + innerDerivation (a - b) c = innerDerivation a c - innerDerivation b c := by + ext x + simp only [innerDerivation_apply, LinearMap.sub_apply] + simp only [sub_mul, mul_sub] + module + + +omit [Module ℝ E] [SMulCommClass ℝ E E] [IsCommJordan E] in +/-- The diagonal fact for the triple product at `(a, a, x)`: telescoping cancellation collapses +it to the plain associative square multiplication `a² x`. This is the base case used in the +final specialization of the fundamental identity. -/ +theorem jordanTriple_diag_left (a x : E) : jordanTriple a a x = a ^[2] * x := by + rw [jordanTriple, jpow_two] + rw [mul_comm a (a * x), mul_comm x (a * a)] + abel + +/-- **The key nonlinear fact.** The inner derivation `D_{a,b}` is a genuine derivation of the +Jordan product. Unlike every identity in this file so far, this is *not* reachable by linear +(`a ± b`-style) substitution into `cyclic_mulLeft_commutator`: it is exactly the two atomic +substitution instances `cyclic_mulLeft_commutator a x y b` and `cyclic_mulLeft_commutator b x y a`, +combined and then normalized by commutativity — the same base relation used everywhere else in +this file, but composed at two independent points rather than linearly polarized at one. This was +verified offline before being formalized: representing the free commutative (non-associative) +algebra on four generators and checking that the derivation defect +`D_{a,b}(xy) - (D_{a,b}x)y - x(D_{a,b}y)` equals exactly +`cyclic(a,x,y,b) - cyclic(b,x,y,a)` (both sides expanded to raw monomials), confirmed the two +atomic instances suffice with unit coefficients. -/ +theorem innerDerivation_mul (a b x y : E) : + innerDerivation a b (x * y) = (innerDerivation a b x) * y + x * (innerDerivation a b y) := by + have h1 := cyclic_mulLeft_commutator a x y b + have h2 := cyclic_mulLeft_commutator b x y a + simp only [innerDerivation_apply, sub_mul, mul_sub] + simp only [mul_comm] at h1 h2 ⊢ + linear_combination (norm := module) h1 - h2 + +/-- The derivation property restated as an operator commutator: `[D_{a,b}, L_x] = L_{D_{a,b} x}`. +This is `innerDerivation_mul` read as a statement about composed multiplication operators; it is +the operator-level form used to build the double commutator `innerDerivation_comm` below. -/ +theorem innerDerivation_mulLeft_comm (a b x : E) : + (innerDerivation a b).comp (L x) - (L x).comp (innerDerivation a b) = + L (innerDerivation a b x) := by + ext z + simp only [LinearMap.sub_apply, LinearMap.comp_apply, mulLeft_apply] + rw [innerDerivation_mul] + abel + +/-- The double commutator of two inner derivations: +`[D_{a,b}, D_{c,d}] = D_{D_{a,b}c, d} + D_{c, D_{a,b}d}`. This is pure associative operator +algebra built from `innerDerivation_mulLeft_comm` (applied once at `c` and once at `d`) plus the +elementary telescoping cancellation exhibited by expanding both composite arguments — no further +appeal to `cyclic_mulLeft_commutator` is needed beyond what is already packaged in +`innerDerivation_mul`. -/ +theorem innerDerivation_comm (a b c d : E) : + (innerDerivation a b).comp (innerDerivation c d) - + (innerDerivation c d).comp (innerDerivation a b) = + innerDerivation (innerDerivation a b c) d + innerDerivation c (innerDerivation a b d) := by + ext z + simp only [LinearMap.sub_apply, LinearMap.comp_apply, LinearMap.add_apply] + rw [innerDerivation_apply c d z, map_sub (innerDerivation a b), + innerDerivation_apply c d (innerDerivation a b z)] + rw [innerDerivation_mul a b c (d * z), innerDerivation_mul a b d (c * z), + innerDerivation_mul a b d z, innerDerivation_mul a b c z] + rw [innerDerivation_apply (innerDerivation a b c) d z, + innerDerivation_apply c (innerDerivation a b d) z] + simp only [mul_add] + module + +/-- The Jordan triple operator `V_{a,b} := L_{a*b} + D_{a,b}`. Its action on any `x` is exactly +the Jordan triple product `{a,b,x}` (`triple_eq_V_apply`), so it packages `jordanTriple`'s middle +slot as a bundled linear operator, mirroring how `quadRepBilin a c` already packages `{a,·,c}`. -/ +def tripleOperator (a b : E) : E →ₗ[ℝ] E := L (a * b) + innerDerivation a b + +@[inherit_doc] scoped notation "V" => tripleOperator + +omit [IsCommJordan E] in +/-- The Jordan triple operator `V_{a,b}` computes the Jordan triple product in its middle slot. -/ +theorem triple_eq_V_apply (a b x : E) : V a b x = jordanTriple a b x := by + simp only [tripleOperator, LinearMap.add_apply, innerDerivation_apply, mulLeft_apply, + jordanTriple] + rw [mul_comm x (b * a), mul_comm b a, mul_comm (a * x) b] + abel + +omit [IsCommJordan E] in +/-- Difference expansion of the inner derivation in its second defining argument. -/ +theorem innerDerivation_sub_right (a b c : E) : + innerDerivation a (b - c) = innerDerivation a b - innerDerivation a c := by + ext x + simp only [innerDerivation_apply, LinearMap.sub_apply] + simp only [sub_mul, mul_sub] + module + +/-- **A second nonlinear derivation fact**: a "product rule" for the inner derivation's own first +(outer) argument, distinct from `innerDerivation_mul` (which is a product rule for `D`'s +*evaluation* argument). Obtained from a *single* atomic instance of `cyclic_mulLeft_commutator` +(no composition of two instances is needed here, unlike `innerDerivation_mul`), by rearranging +`cyclic_mulLeft_commutator a b q e = 0` into +`D (a*b) q e = D a (b*q) e + D b (a*q) e` and simplifying the resulting third bracket via +`innerDerivation_swap`. This is a genuine new building block toward the still-open Jordan-triple +fundamental identity: see `JB_ROADMAP.md` §7 for the precise remaining gap and the concrete leads +it opens (recursively applying this rule to reduce `D (a*b) (c*d)`, or the independently verified +15-term raw cyclic-instance certificate). -/ +theorem innerDerivation_mul_left (a b q e : E) : + innerDerivation (a * b) q e = innerDerivation a (b * q) e + innerDerivation b (a * q) e := by + have h := cyclic_mulLeft_commutator a b q e + rw [mul_comm q a] at h + simp only [innerDerivation_apply] + linear_combination (norm := module) -h + +/-- The commutator law for Jordan triple operators: +`[V_{a,b}, V_{c,d}] = V_{{a,b,c},d} - V_{c,{b,a,d}}`. + +This is the operator form of the Jordan-triple-system fundamental identity. -/ +theorem tripleOperator_comm (a b c d : E) : + (V a b).comp (V c d) - (V c d).comp (V a b) = + V (jordanTriple a b c) d - V c (jordanTriple b a d) := by + ext e + + simp only [ + tripleOperator, + LinearMap.sub_apply, + LinearMap.comp_apply, + LinearMap.add_apply, + mulLeft_apply, + map_add + ] + + /- + Expand the two inner derivations acting on products. + -/ + have e1 : + innerDerivation a b ((c * d) * e) = + (innerDerivation a b c) * d * e + + c * (innerDerivation a b d) * e + + (c * d) * (innerDerivation a b e) := by + rw [innerDerivation_mul a b (c * d) e] + rw [innerDerivation_mul a b c d] + rw [add_mul] + + have e2 : + innerDerivation c d ((a * b) * e) = + (innerDerivation c d a) * b * e + + a * (innerDerivation c d b) * e + + (a * b) * (innerDerivation c d e) := by + rw [innerDerivation_mul c d (a * b) e] + rw [innerDerivation_mul c d a b] + rw [add_mul] + + /- + Commutator of inner derivations. + -/ + have e3 : + innerDerivation a b (innerDerivation c d e) - + innerDerivation c d (innerDerivation a b e) = + innerDerivation (innerDerivation a b c) d e + + innerDerivation c (innerDerivation a b d) e := by + have h := DFunLike.congr_fun (innerDerivation_comm a b c d) e + simpa only [ + LinearMap.sub_apply, + LinearMap.comp_apply, + LinearMap.add_apply + ] using h + + /- + Jordan cyclic identity for the product pair. + -/ + have e4 : + innerDerivation (a * b) (c * d) e = + innerDerivation ((a * b) * c) d e - + innerDerivation c ((a * b) * d) e := by + have h := innerDerivation_mul_left (a * b) c d e + rw [h] + module + + /- + Express the triple products in L_{ab} + D_{a,b} form. + -/ + have hJ1 : + jordanTriple a b c = + (a * b) * c + innerDerivation a b c := by + rw [← triple_eq_V_apply] + rfl + + have hJ2 : + jordanTriple b a d = + (a * b) * d - innerDerivation a b d := by + rw [← triple_eq_V_apply] + simp only [ + tripleOperator, + LinearMap.add_apply, + mulLeft_apply + ] + rw [ + mul_comm b a, + innerDerivation_swap b a, + LinearMap.neg_apply + ] + module + + rw [hJ1, hJ2] + + simp only [ + add_mul, + sub_mul, + mul_sub, + innerDerivation_add_left, + LinearMap.add_apply + ] + + /- + Convert the raw left-multiplication commutator into an inner derivation. + -/ + have e4' : + a * b * (c * d * e) - c * d * (a * b * e) = + innerDerivation (a * b * c) d e - + innerDerivation c (a * b * d) e := by + rw [← innerDerivation_apply, e4] + + /- + Remaining product/derivation relation. + -/ + have hQ : + c * (a * b * d) * e - a * b * c * d * e - + (innerDerivation c d a * b * e + + a * (innerDerivation c d b) * e) = 0 := by + have step1 : + c * (a * b * d) * e = + c * (d * (a * b)) * e := by + rw [mul_comm (a * b) d] + + have step2 : + a * b * c * d * e = + d * (c * (a * b)) * e := by + rw [ + mul_comm d (c * (a * b)), + mul_comm c (a * b) + ] + + have step3 : + innerDerivation c d a * b * e + + a * (innerDerivation c d b) * e = + c * (d * (a * b)) * e - + d * (c * (a * b)) * e := by + have h6 : + (innerDerivation c d a * b + + a * innerDerivation c d b) * e = + innerDerivation c d (a * b) * e := by + rw [innerDerivation_mul c d a b] + + rw [add_mul] at h6 + rwa [ + innerDerivation_apply c d (a * b), + sub_mul + ] at h6 + + rw [step1, step2, step3] + module + + /- + Expand the product derivations first. + -/ + rw [e1, e2] + + simp only [ + innerDerivation_sub_right, + LinearMap.sub_apply + ] + + have e3' : + innerDerivation a b (innerDerivation c d e) = + innerDerivation c d (innerDerivation a b e) + + innerDerivation (innerDerivation a b c) d e + + innerDerivation c (innerDerivation a b d) e := by + have h := + (sub_eq_iff_eq_add).mp e3 + calc + innerDerivation a b (innerDerivation c d e) = + (innerDerivation (innerDerivation a b c) d e + + innerDerivation c (innerDerivation a b d) e) + + innerDerivation c d (innerDerivation a b e) := h + _ = + innerDerivation c d (innerDerivation a b e) + + innerDerivation (innerDerivation a b c) d e + + innerDerivation c (innerDerivation a b d) e := by + abel + + have e4'' : + a * b * (c * d * e) = + c * d * (a * b * e) + + innerDerivation (a * b * c) d e - + innerDerivation c (a * b * d) e := by + have h := + (sub_eq_iff_eq_add).mp e4' + calc + a * b * (c * d * e) = + (innerDerivation (a * b * c) d e - + innerDerivation c (a * b * d) e) + + c * d * (a * b * e) := h + _ = + c * d * (a * b * e) + + innerDerivation (a * b * c) d e - + innerDerivation c (a * b * d) e := by + abel + + have hQ' : + c * (a * b * d) * e = + a * b * c * d * e + + innerDerivation c d a * b * e + + a * innerDerivation c d b * e := by + have h : + c * (a * b * d) * e - a * b * c * d * e = + innerDerivation c d a * b * e + + a * innerDerivation c d b * e := by + have h0 := hQ + -- hQ is `(X - Y) - Z = 0`, hence `X - Y = Z`. + exact sub_eq_zero.mp h0 + + have h' := (sub_eq_iff_eq_add).mp h + calc + c * (a * b * d) * e = + (innerDerivation c d a * b * e + + a * innerDerivation c d b * e) + + a * b * c * d * e := h' + _ = + a * b * c * d * e + + innerDerivation c d a * b * e + + a * innerDerivation c d b * e := by + abel + + rw [e3', e4'', hQ'] + + abel + +/-- A first genuine consequence of `tripleOperator_comm` toward the Stage A item 1 target +`U (U a b) = U a * U b * U a`: specializing `(a, b, c, d) := (x, y, x, z)` and evaluating at `x` +collapses every diagonal slot (`{x, ·, x}`) to a `U_x` evaluation, via `jordanTriple_diag` and +`jordanTriple_outer_comm`. Not yet the fundamental formula itself: `V_quadRep_eq_quadRep_triple` +below reaches it by combining this identity with its `y ↔ z` companion. -/ +theorem tripleOperator_quadRep_step (x y z : E) : + V x y (U x z) = + (2 : ℝ) • V x z (U x y) - U x (jordanTriple y x z) := by + have h := DFunLike.congr_fun (tripleOperator_comm x y x z) x + simp only [LinearMap.sub_apply, LinearMap.comp_apply] at h + have hVxzx : V x z x = U x z := (triple_eq_V_apply x z x).trans (jordanTriple_diag x z) + have hVxyx : V x y x = U x y := (triple_eq_V_apply x y x).trans (jordanTriple_diag x y) + have hdiagxyx : jordanTriple x y x = U x y := jordanTriple_diag x y + rw [hVxzx, hVxyx, hdiagxyx] at h + have hswap : V (U x y) z x = V x z (U x y) := by + rw [triple_eq_V_apply, triple_eq_V_apply, jordanTriple_outer_comm] + have hdiag2 : V x (jordanTriple y x z) x = U x (jordanTriple y x z) := + (triple_eq_V_apply x (jordanTriple y x z) x).trans + (jordanTriple_diag x (jordanTriple y x z)) + rw [hswap, hdiag2] at h + linear_combination (norm := module) h + +/-- Combining `tripleOperator_quadRep_step` with its own `y ↔ z` companion (and +`jordanTriple_outer_comm`, which identifies `jordanTriple z x y` with `jordanTriple y x z`) +eliminates the `V x z (U x y)` cross-term entirely. -/ +theorem V_quadRep_eq_quadRep_triple (x y z : E) : + V x y (U x z) = U x (jordanTriple y x z) := by + have h1 := tripleOperator_quadRep_step x y z + have h2 := tripleOperator_quadRep_step x z y + have hswap : + jordanTriple z x y = jordanTriple y x z := by + rw [jordanTriple_outer_comm] + rw [hswap] at h2 + linear_combination (norm := module) + (-1 / 3 : ℝ) • h1 + (-2 / 3 : ℝ) • h2 + +/-- Pointwise form of the fundamental formula for the quadratic representation: +`U_{U_x y} z = U_x U_y U_x z`. -/ +theorem quadRep_fundamental_apply (x y z : E) : + U (U x y) z = U x (U y (U x z)) := by + + /- + Step 1. + + Specialize the triple-operator commutator at + (a,b,c,d,e) = (z,x,y,x,y). + + This gives an identity from which we solve for `U y (U x z)`. + -/ + have hinner0 := + DFunLike.congr_fun (tripleOperator_comm z x y x) y + + simp only [ + LinearMap.sub_apply, + LinearMap.comp_apply + ] at hinner0 + + have hxzx : + jordanTriple x z x = U x z := + jordanTriple_diag x z + + have hright : + V (jordanTriple y x z) x y = + V y x (jordanTriple y x z) := by + rw [ + triple_eq_V_apply, + triple_eq_V_apply, + jordanTriple_outer_comm + ] + + have hdiag : + V y (U x z) y = U y (U x z) := + (triple_eq_V_apply y (U x z) y).trans + (jordanTriple_diag y (U x z)) + + have houter : + jordanTriple z x y = jordanTriple y x z := by + exact jordanTriple_outer_comm z x y + + have hyxy : + V y x y = U y x := + (triple_eq_V_apply y x y).trans + (jordanTriple_diag y x) + + have hzxy : + V z x y = jordanTriple y x z := by + rw [ + triple_eq_V_apply, + jordanTriple_outer_comm + ] + + rw [ + houter, + hxzx, + hright, + hdiag, + hyxy, + hzxy + ] at hinner0 + + /- + Now: + + hinner0 : + V z x (U y x) - V y x {y,x,z} + = + V y x {y,x,z} - U y (U x z). + + Solve additively for `U y (U x z)`. + -/ + have hinner : + U y (U x z) = + V y x (jordanTriple y x z) + + V y x (jordanTriple y x z) - + V z x (U y x) := by + calc + U y (U x z) = + V y x (jordanTriple y x z) - + (V y x (jordanTriple y x z) - + U y (U x z)) := by + abel + _ = + V y x (jordanTriple y x z) - + (V z x (U y x) - + V y x (jordanTriple y x z)) := by + rw [← hinner0] + _ = + V y x (jordanTriple y x z) + + V y x (jordanTriple y x z) - + V z x (U y x) := by + abel + + /- + Apply `U x` to the preceding identity. + -/ + have hinnerUx0 := + congrArg (fun w => U x w) hinner + + have hinnerUx : + U x (U y (U x z)) = + U x (V y x (jordanTriple y x z)) + + U x (V y x (jordanTriple y x z)) - + U x (V z x (U y x)) := by + simpa only [ + map_add, + map_sub + ] using hinnerUx0 + + /- + Step 2. + + Specialize the triple-operator commutator at + (a,b,c,d,e) = (x,y,x,z,U_x y). + -/ + have hmain := + DFunLike.congr_fun + (tripleOperator_comm x y x z) + (U x y) + + simp only [ + LinearMap.sub_apply, + LinearMap.comp_apply + ] at hmain + + have hdiagxy : + jordanTriple x y x = U x y := + jordanTriple_diag x y + + rw [hdiagxy] at hmain + + /- + Diagonal term: + V_{U_x y,z}(U_x y) = U_{U_x y} z. + -/ + have hUU : + V (U x y) z (U x y) = + U (U x y) z := + (triple_eq_V_apply (U x y) z (U x y)).trans + (jordanTriple_diag (U x y) z) + + /- + V_{x,z}(U_x y) = U_x {y,x,z}. + -/ + have h1 : + V x z (U x y) = + U x (jordanTriple y x z) := by + have h := + V_quadRep_eq_quadRep_triple x z y + rwa [jordanTriple_outer_comm z x y] at h + + /- + V_{x,y}(U_x {y,x,z}) + = + U_x V_{y,x}({y,x,z}). + -/ + have h2 : + V x y (U x (jordanTriple y x z)) = + U x (V y x (jordanTriple y x z)) := by + have h := + V_quadRep_eq_quadRep_triple + x y (jordanTriple y x z) + simpa only [triple_eq_V_apply] using h + + /- + V_{x,y}(U_x y) = U_x(U_y x). + -/ + have h3 : + V x y (U x y) = + U x (U y x) := by + have h := + V_quadRep_eq_quadRep_triple x y y + have hyxy' : + jordanTriple y x y = U y x := + jordanTriple_diag y x + rwa [hyxy'] at h + + /- + V_{x,z}(U_x(U_y x)) + = + U_x V_{z,x}(U_y x). + -/ + have h4 : + V x z (U x (U y x)) = + U x (V z x (U y x)) := by + have h := + V_quadRep_eq_quadRep_triple + x z (U y x) + simpa only [triple_eq_V_apply] using h + + /- + V_{x,{y,x,z}}(U_x y) + = + U_x V_{{y,x,z},x}(y). + -/ + have h5 : + V x (jordanTriple y x z) (U x y) = + U x (V (jordanTriple y x z) x y) := by + have h := + V_quadRep_eq_quadRep_triple + x (jordanTriple y x z) y + simpa only [triple_eq_V_apply] using h + + /- + Outer symmetry: + V_{{y,x,z},x}(y) + = + V_{y,x}({y,x,z}). + -/ + have h6 : + V (jordanTriple y x z) x y = + V y x (jordanTriple y x z) := by + rw [ + triple_eq_V_apply, + triple_eq_V_apply, + jordanTriple_outer_comm + ] + + rw [ + h1, + h2, + h3, + h4, + hUU, + h5, + h6 + ] at hmain + + /- + After the rewrites, hmain has the additive form + + P - Q = R - P, + + where + + P = U_x(V_{y,x}{y,x,z}), + Q = U_x(V_{z,x}(U_y x)), + R = U_{U_x y} z. + + Solve for R using only additive-group normalization. + -/ + have hmain' : + U (U x y) z = + U x (V y x (jordanTriple y x z)) + + U x (V y x (jordanTriple y x z)) - + U x (V z x (U y x)) := by + calc + U (U x y) z = + (U (U x y) z - + U x (V y x (jordanTriple y x z))) + + U x (V y x (jordanTriple y x z)) := by + abel + _ = + (U x (V y x (jordanTriple y x z)) - + U x (V z x (U y x))) + + U x (V y x (jordanTriple y x z)) := by + rw [← hmain] + _ = + U x (V y x (jordanTriple y x z)) + + U x (V y x (jordanTriple y x z)) - + U x (V z x (U y x)) := by + abel + + exact hmain'.trans hinnerUx.symm + + +/-- The fundamental formula for the quadratic representation: +`U_{U_x y} = U_x ∘ U_y ∘ U_x`. -/ +theorem quadRep_fundamental (x y : E) : + U (U x y) = (U x).comp ((U y).comp (U x)) := by + ext z + exact quadRep_fundamental_apply x y z + +/-- The fundamental formula holds on the associative algebra generated by one element. This +is the fully proved common-generator sector of the general identity: both sides send `a^[k]` to +`a^[4*m + 2*n + k]`. + +The unrestricted formula additionally needs a three-variable polarization argument, since its +middle element need not lie in the one-generated algebra. -/ +theorem quadRep_fundamental_jpow (a : E) (m n k : ℕ) : + U (U ((a ^[m]) : E) ((a ^[n]) : E)) ((a ^[k]) : E) = + U ((a ^[m]) : E) (U ((a ^[n]) : E) (U ((a ^[m]) : E) ((a ^[k]) : E))) := by + rw [quadRep_jpow_jpow a m n] + rw [quadRep_jpow_jpow a (2 * m + n) k] + rw [quadRep_jpow_jpow a m k] + rw [quadRep_jpow_jpow a n (2 * m + k)] + rw [quadRep_jpow_jpow a m (2 * n + (2 * m + k))] + congr 1 + omega + +end JordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Quadratic/Operational.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Quadratic/Operational.lean new file mode 100644 index 0000000000..321c1b03bb --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Quadratic/Operational.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Quadratic.Order +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Quadratic.Fundamental + +/-! +# Sequential quadratic operations + +This module is the meeting point of ordered quadratic operations and the purely algebraic +fundamental formula. `Quadratic/Order.lean` deliberately remains independent of the latter: +positivity itself needs only the linear quadratic representation. Once both facts are available, +the fundamental formula becomes an equality of bundled positive operations, suitable for +measurement and JBW clients. +-/ + +@[expose] public section + +namespace JordanAlgebra + +open scoped JordanAlgebra + +variable {E : Type*} [NonAssocCommRing E] [PartialOrder E] [IsOrderedAddMonoid E] + [Module ℝ E] [SMulCommClass ℝ E E] [IsQuadraticallyPositive E] [IsCommJordan E] + +/-- Squaring the filtering observable composes its positive quadratic operation with itself. +This is the bundled operational form of `U_(a²) = U_a ∘ U_a`. -/ +theorem quadRepPositiveLinearMap_mul_self (a : E) : + quadRepPositiveLinearMap (a * a) = + (quadRepPositiveLinearMap a).comp (quadRepPositiveLinearMap a) := by + apply PositiveLinearMap.ext + intro x + change U (a * a) x = U a (U a x) + exact DFunLike.congr_fun (quadRep_mul_self_eq_comp a) x + +/-- The quadratic fundamental formula as an equality of positive operations. Thus a filter +whose observable is `U_a b` is precisely the sequential filter `U_a`, then `U_b`, then `U_a`. +The statement is intrinsic Jordan algebra; positivity is used only to bundle the maps. -/ +theorem quadRepPositiveLinearMap_fundamental (a b : E) : + quadRepPositiveLinearMap (U a b) = + (quadRepPositiveLinearMap a).comp + ((quadRepPositiveLinearMap b).comp (quadRepPositiveLinearMap a)) := by + apply PositiveLinearMap.ext + intro x + change U (U a b) x = U a (U b (U a x)) + exact quadRep_fundamental_apply a b x + +end JordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Quadratic/Order.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Quadratic/Order.lean new file mode 100644 index 0000000000..9142a42c80 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Quadratic/Order.lean @@ -0,0 +1,78 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Operator +public import Mathlib.Algebra.Order.Module.PositiveLinearMap + +/-! + +# Positive quadratic representations + +The quadratic representation `U a` is the intrinsic Jordan version of the +self-adjoint one-Kraus operation `b ↦ aba`. Its preservation of the positive cone is the +precise operational fact used by compression and conditioning. It is intentionally a separate +capability: square positivity alone does not prove it for an arbitrary supplied cone, and the +intrinsic JB theorem which discharges this capability belongs to the later spectral development. + +Concrete realizations and, eventually, genuine JB theory provide this class. Physics-facing +results should require it directly rather than importing a proof through a special associative +realization. + +-/ + +@[expose] public section + +namespace JordanAlgebra + +open scoped JordanAlgebra + +variable {E : Type*} [NonAssocCommRing E] [PartialOrder E] [IsOrderedAddMonoid E] + [Module ℝ E] [SMulCommClass ℝ E E] + +/-- Quadratic representations preserve the given positive cone. This is an operational ordered +Jordan capability, not a consequence claimed from the weak square-positive order-unit interface. +The intended intrinsic provider is the JB quadratic-positivity theorem; special realizations can +also provide it directly from `U_a(b) = aba`. -/ +class IsQuadraticallyPositive (E : Type*) [NonAssocCommRing E] [PartialOrder E] + [IsOrderedAddMonoid E] [Module ℝ E] [SMulCommClass ℝ E E] : Prop where + quadRep_nonneg : ∀ (a : E) {b : E}, 0 ≤ b → 0 ≤ U a b + +variable [IsQuadraticallyPositive E] + +/-- Quadratic representations map nonnegative observables to nonnegative observables. -/ +theorem quadRep_nonneg (a : E) {b : E} (hb : 0 ≤ b) : 0 ≤ U a b := + IsQuadraticallyPositive.quadRep_nonneg a hb + +/-- The quadratic representation as a bundled positive linear operation. -/ +def quadRepPositiveLinearMap (a : E) : E →ₚ[ℝ] E := + PositiveLinearMap.mk₀ (U a) fun _ hb => quadRep_nonneg a hb + +@[simp] +theorem coe_quadRepPositiveLinearMap (a : E) : + (quadRepPositiveLinearMap a : E →ₗ[ℝ] E) = U a := + rfl + +@[simp] +theorem quadRepPositiveLinearMap_apply (a b : E) : quadRepPositiveLinearMap a b = U a b := + rfl + +/-- The unit has the identity quadratic operation. -/ +@[simp] +theorem quadRepPositiveLinearMap_one : + quadRepPositiveLinearMap (1 : E) = PositiveLinearMap.id ℝ E := by + apply PositiveLinearMap.ext + intro x + exact quadRep_one_apply x + +/-- Positivity of `U a` implies monotonicity. -/ +theorem quadRep_monotone (a : E) : Monotone (U a) := by + intro b c hbc + rw [← sub_nonneg] at hbc ⊢ + rw [← map_sub] + exact quadRep_nonneg a hbc + +end JordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Quadratic/Projection.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Quadratic/Projection.lean new file mode 100644 index 0000000000..b236845735 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Quadratic/Projection.lean @@ -0,0 +1,307 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Observable +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Quadratic.Fundamental + +/-! +# Quadratic compression by Jordan projections + +For an idempotent `p` in a real Jordan algebra, its quadratic representation `U p` is itself an +idempotent linear map. This is the algebraic core of the Peirce-`1` compression. The results +here deliberately make no positivity, norm, or order assertion: those require genuinely JB-level +input. + +The elementary values `U_p(p) = p`, `U_p(1) = p`, and `U_p(q) = 0` for `p ∘ q = 0` are provided +by `Observable.lean`; this module builds the nontrivial operator-idempotence consequence without +duplicating them. +-/ + +@[expose] public section + +namespace JordanAlgebra + +variable {E : Type*} [NonAssocCommRing E] [Module ℝ E] + +open scoped JordanAlgebra + +/-! ## The Peirce polynomial -/ + +/-- If `p` is idempotent, multiplication by `p` obeys the Peirce polynomial +`2 L_p^3 - 3 L_p^2 + L_p = 0`. This is a specialization of the polarized Jordan identity and +is the exact algebraic fact needed to make `U_p` an idempotent compression. -/ +theorem IsJordanProjection.peirce_polynomial [IsCommJordan E] {p : E} + (hp : IsJordanProjection p) (x : E) : + (2 : ℝ) • (p * (p * (p * x))) - (3 : ℝ) • (p * (p * x)) + p * x = 0 := by + have h := linearized_mul_sq p p x + rw [hp, hp] at h + let A : E := p * (p * (p * x)) + let B : E := p * (p * x) + let C : E := p * x + have h' : C = -(2 : ℝ) • A + B + (2 : ℝ) • B := by + simpa only [A, B, C] using h + change (2 : ℝ) • A - (3 : ℝ) • B + C = 0 + rw [h'] + module + +/-! ## The Peirce-`1` compression -/ + +/-- The Peirce-`1` eigenspace of a Jordan projection: the fixed submodule of multiplication by +`p`. This is purely algebraic; no order or norm structure is involved. -/ +def IsJordanProjection.peirceOne [SMulCommClass ℝ E E] (p : E) : Submodule ℝ E := + LinearMap.ker (L p - LinearMap.id) + +/-- Membership in the Peirce-`1` space is exactly the eigenvalue-one equation. -/ +theorem IsJordanProjection.mem_peirceOne_iff [SMulCommClass ℝ E E] (p x : E) : + x ∈ IsJordanProjection.peirceOne p ↔ p * x = x := by + change (L p - (LinearMap.id : E →ₗ[ℝ] E)) x = 0 ↔ _ + simp only [LinearMap.sub_apply, LinearMap.id_apply, mulLeft_apply, sub_eq_zero] + +/-- The Peirce-`0` eigenspace of a projection. -/ +def IsJordanProjection.peirceZero [SMulCommClass ℝ E E] (p : E) : Submodule ℝ E := + LinearMap.ker (L p) + +/-- Membership in the Peirce-`0` space is exactly annihilation by `p`. -/ +theorem IsJordanProjection.mem_peirceZero_iff [SMulCommClass ℝ E E] (p x : E) : + x ∈ IsJordanProjection.peirceZero p ↔ p * x = 0 := by + change L p x = 0 ↔ _ + rfl + +/-- The Peirce-`1/2` eigenspace of a projection. The equation is written without division so it +works directly with the real linear-map structure. -/ +def IsJordanProjection.peirceHalf [SMulCommClass ℝ E E] (p : E) : Submodule ℝ E := + LinearMap.ker ((2 : ℝ) • L p - LinearMap.id) + +/-- Membership in the Peirce-`1/2` space is exactly `2 (p ∘ x) = x`. -/ +theorem IsJordanProjection.mem_peirceHalf_iff [SMulCommClass ℝ E E] (p x : E) : + x ∈ IsJordanProjection.peirceHalf p ↔ (2 : ℝ) • (p * x) = x := by + change ((2 : ℝ) • L p - (LinearMap.id : E →ₗ[ℝ] E)) x = 0 ↔ _ + simp only [LinearMap.sub_apply, LinearMap.smul_apply, LinearMap.id_apply, mulLeft_apply, + sub_eq_zero] + +/-- The Peirce-`0` and Peirce-`1/2` spaces intersect only at zero. -/ +theorem IsJordanProjection.disjoint_peirceZero_peirceHalf [SMulCommClass ℝ E E] (p : E) : + Disjoint (IsJordanProjection.peirceZero p) (IsJordanProjection.peirceHalf p) := by + refine Submodule.disjoint_def.mpr fun x hx₀ hxhalf => ?_ + have h₀ := (IsJordanProjection.mem_peirceZero_iff p x).mp hx₀ + have hhalf := (IsJordanProjection.mem_peirceHalf_iff p x).mp hxhalf + rw [h₀] at hhalf + simpa using hhalf.symm + +/-- The Peirce-`0` and Peirce-`1` spaces intersect only at zero. -/ +theorem IsJordanProjection.disjoint_peirceZero_peirceOne [SMulCommClass ℝ E E] (p : E) : + Disjoint (IsJordanProjection.peirceZero p) (IsJordanProjection.peirceOne p) := by + refine Submodule.disjoint_def.mpr fun x hx₀ hx₁ => ?_ + have h₀ := (IsJordanProjection.mem_peirceZero_iff p x).mp hx₀ + have h₁ := (IsJordanProjection.mem_peirceOne_iff p x).mp hx₁ + rw [h₀] at h₁ + simpa using h₁.symm + +/-- The Peirce-`1/2` and Peirce-`1` spaces intersect only at zero. -/ +theorem IsJordanProjection.disjoint_peirceHalf_peirceOne [SMulCommClass ℝ E E] (p : E) : + Disjoint (IsJordanProjection.peirceHalf p) (IsJordanProjection.peirceOne p) := by + refine Submodule.disjoint_def.mpr fun x hxhalf hx₁ => ?_ + have hhalf := (IsJordanProjection.mem_peirceHalf_iff p x).mp hxhalf + have h₁ := (IsJordanProjection.mem_peirceOne_iff p x).mp hx₁ + rw [h₁] at hhalf + have h : (2 : ℝ) • x - x = 0 := sub_eq_zero.mpr hhalf + calc + x = (2 : ℝ) • x - x := by module + _ = 0 := h + +/-- The three Peirce eigenspaces are jointly direct: a vanishing sum of a `0`, `1/2`, and `1` +eigenvector has all three summands equal to zero. -/ +theorem IsJordanProjection.eq_zero_of_peirce_sum_eq_zero [SMulCommClass ℝ E E] (p : E) + {x₀ xhalf x₁ : E} (hx₀ : x₀ ∈ IsJordanProjection.peirceZero p) + (hxhalf : xhalf ∈ IsJordanProjection.peirceHalf p) + (hx₁ : x₁ ∈ IsJordanProjection.peirceOne p) (hsum : x₀ + xhalf + x₁ = 0) : + x₀ = 0 ∧ xhalf = 0 ∧ x₁ = 0 := by + have h₀ := (IsJordanProjection.mem_peirceZero_iff p x₀).mp hx₀ + have hhalf := (IsJordanProjection.mem_peirceHalf_iff p xhalf).mp hxhalf + have h₁ := (IsJordanProjection.mem_peirceOne_iff p x₁).mp hx₁ + have hpSum : p * xhalf + x₁ = 0 := by + have h := congrArg (fun z : E => p * z) hsum + simpa only [mul_add, h₀, h₁, zero_add, mul_zero] using h + have hppSum : p * (p * xhalf) + x₁ = 0 := by + have h := congrArg (fun z : E => p * z) hpSum + simpa only [mul_add, h₁, zero_add, mul_zero] using h + have hhalfP : (2 : ℝ) • (p * (p * xhalf)) = p * xhalf := by + have h := congrArg (fun z : E => p * z) hhalf + simpa only [mul_smul_comm] using h + have hAB : p * xhalf = p * (p * xhalf) := by + apply sub_eq_zero.mp + calc + p * xhalf - p * (p * xhalf) = + (p * xhalf + x₁) - (p * (p * xhalf) + x₁) := by module + _ = 0 := by rw [hpSum, hppSum]; module + rw [← hAB] at hhalfP + have hpxhalf : p * xhalf = 0 := by + calc + p * xhalf = (2 : ℝ) • (p * xhalf) - p * xhalf := by module + _ = 0 := sub_eq_zero.mpr hhalfP + have hxhalf : xhalf = 0 := by + calc + xhalf = (2 : ℝ) • (p * xhalf) := hhalf.symm + _ = 0 := by rw [hpxhalf, smul_zero] + have hx₁ : x₁ = 0 := by simpa only [hpxhalf, zero_add] using hpSum + have hx₀ : x₀ = 0 := by simpa only [hxhalf, hx₁, add_zero] using hsum + exact ⟨hx₀, hxhalf, hx₁⟩ + +/-- The algebraic Peirce-`0` component of `x` relative to `p`. -/ +def IsJordanProjection.peirceZeroPart (p x : E) : E := + x - (3 : ℝ) • (p * x) + (2 : ℝ) • (p * (p * x)) + +/-- The algebraic Peirce-`1/2` component of `x` relative to `p`. -/ +def IsJordanProjection.peirceHalfPart (p x : E) : E := + (4 : ℝ) • (p * x - p * (p * x)) + +/-- The Peirce-`0` component is annihilated by `p`. -/ +theorem IsJordanProjection.mul_peirceZeroPart [SMulCommClass ℝ E E] [IsCommJordan E] {p : E} + (hp : IsJordanProjection p) (x : E) : p * IsJordanProjection.peirceZeroPart p x = 0 := by + simp only [IsJordanProjection.peirceZeroPart, mul_add, mul_sub, mul_smul_comm] + let A₁ : E := p * x + let A₂ : E := p * A₁ + let A₃ : E := p * A₂ + have hP := hp.peirce_polynomial x + change A₁ - (3 : ℝ) • A₂ + (2 : ℝ) • A₃ = 0 + calc + A₁ - (3 : ℝ) • A₂ + (2 : ℝ) • A₃ = + (2 : ℝ) • A₃ - (3 : ℝ) • A₂ + A₁ := by module + _ = 0 := by simpa only [A₁, A₂, A₃] using hP + +/-- The algebraic zero component belongs to the Peirce-`0` subspace. -/ +theorem IsJordanProjection.peirceZeroPart_mem [SMulCommClass ℝ E E] [IsCommJordan E] {p : E} + (hp : IsJordanProjection p) (x : E) : + IsJordanProjection.peirceZeroPart p x ∈ IsJordanProjection.peirceZero p := + (IsJordanProjection.mem_peirceZero_iff p _).mpr (hp.mul_peirceZeroPart x) + +/-- The Peirce-`1/2` component has eigenvalue `1/2` for multiplication by `p`. -/ +theorem IsJordanProjection.two_smul_mul_peirceHalfPart [SMulCommClass ℝ E E] [IsCommJordan E] + {p : E} (hp : IsJordanProjection p) (x : E) : + (2 : ℝ) • (p * IsJordanProjection.peirceHalfPart p x) = + IsJordanProjection.peirceHalfPart p x := by + rw [IsJordanProjection.peirceHalfPart, mul_smul_comm] + let A₁ : E := p * x + let A₂ : E := p * A₁ + let A₃ : E := p * A₂ + let P : E := (2 : ℝ) • A₃ - (3 : ℝ) • A₂ + A₁ + have hP : P = 0 := by + simpa only [P, A₁, A₂, A₃] using hp.peirce_polynomial x + simp only [mul_sub] + change (2 : ℝ) • ((4 : ℝ) • (A₂ - A₃)) = (4 : ℝ) • (A₁ - A₂) + apply sub_eq_zero.mp + calc + (2 : ℝ) • ((4 : ℝ) • (A₂ - A₃)) - (4 : ℝ) • (A₁ - A₂) = -(4 : ℝ) • P := by + dsimp only [P] + module + _ = 0 := by rw [hP]; module + +/-- The algebraic half component belongs to the Peirce-`1/2` subspace. -/ +theorem IsJordanProjection.peirceHalfPart_mem [SMulCommClass ℝ E E] [IsCommJordan E] {p : E} + (hp : IsJordanProjection p) (x : E) : + IsJordanProjection.peirceHalfPart p x ∈ IsJordanProjection.peirceHalf p := + (IsJordanProjection.mem_peirceHalf_iff p _).mpr (hp.two_smul_mul_peirceHalfPart x) + +/-- Every element has a canonical algebraic Peirce decomposition. The three summands have +eigenvalues `0`, `1/2`, and `1` respectively; the `1` summand is `U_p x`. -/ +theorem IsJordanProjection.peirce_decomposition [SMulCommClass ℝ E E] {p : E} + (hp : IsJordanProjection p) (x : E) : + IsJordanProjection.peirceZeroPart p x + IsJordanProjection.peirceHalfPart p x + U p x = x := by + rw [IsJordanProjection.peirceZeroPart, IsJordanProjection.peirceHalfPart, quadRep_apply, + jpow_two, hp] + module + +/-- Quadratic compression by a projection lands in the Peirce-`1` eigenspace. -/ +theorem IsJordanProjection.mul_quadRep [SMulCommClass ℝ E E] [IsCommJordan E] {p : E} + (hp : IsJordanProjection p) (x : E) : p * U p x = U p x := by + rw [quadRep_apply, jpow_two, hp] + let A₁ : E := p * x + let A₂ : E := p * A₁ + let A₃ : E := p * A₂ + let P : E := (2 : ℝ) • A₃ - (3 : ℝ) • A₂ + A₁ + have hP : P = 0 := by + simpa only [P, A₁, A₂, A₃] using hp.peirce_polynomial x + simp only [mul_sub, mul_smul_comm] + change (2 : ℝ) • A₃ - A₂ = (2 : ℝ) • A₂ - A₁ + apply sub_eq_zero.mp + calc + (2 : ℝ) • A₃ - A₂ - ((2 : ℝ) • A₂ - A₁) = P := by + dsimp only [P] + module + _ = 0 := hP + +/-- The `U_p` summand in `peirce_decomposition` belongs to the Peirce-`1` subspace. -/ +theorem IsJordanProjection.quadRep_mem_peirceOne [SMulCommClass ℝ E E] [IsCommJordan E] {p : E} + (hp : IsJordanProjection p) (x : E) : U p x ∈ IsJordanProjection.peirceOne p := + (IsJordanProjection.mem_peirceOne_iff p _).mpr (hp.mul_quadRep x) + +/-- Quadratic compression fixes every Peirce-`1` element. -/ +theorem IsJordanProjection.quadRep_eq_self_of_mul_eq_self [SMulCommClass ℝ E E] + {p x : E} (hp : IsJordanProjection p) (hx : p * x = x) : U p x = x := by + rw [quadRep_apply, jpow_two, hp, hx, hx] + module + +/-- For a projection, quadratic compression is exactly the algebraic projection onto the +Peirce-`1` eigenspace. -/ +theorem IsJordanProjection.quadRep_range_eq_peirceOne [SMulCommClass ℝ E E] [IsCommJordan E] + {p : E} (hp : IsJordanProjection p) : + LinearMap.range (U p) = IsJordanProjection.peirceOne p := by + ext x + constructor + · rintro ⟨y, rfl⟩ + exact (IsJordanProjection.mem_peirceOne_iff p _).mpr (hp.mul_quadRep y) + · intro hx + exact ⟨x, hp.quadRep_eq_self_of_mul_eq_self ((IsJordanProjection.mem_peirceOne_iff p x).mp hx)⟩ + +/-- Quadratic compression by an idempotent is idempotent: `U_p ∘ U_p = U_p`. +Consequently, `U_p` is a purely algebraic projection onto its range. -/ +theorem IsJordanProjection.quadRep_comp_self [SMulCommClass ℝ E E] [IsCommJordan E] {p : E} + (hp : IsJordanProjection p) (x : E) : + U p (U p x) = U p x := by + rw [quadRep_apply, quadRep_apply, jpow_two, hp] + let A₁ : E := p * x + let A₂ : E := p * A₁ + let A₃ : E := p * A₂ + let A₄ : E := p * A₃ + let P : E := (2 : ℝ) • A₃ - (3 : ℝ) • A₂ + A₁ + let Q : E := (2 : ℝ) • A₄ - (3 : ℝ) • A₃ + A₂ + have hP : P = 0 := by + simpa only [P, A₁, A₂, A₃] using hp.peirce_polynomial x + have hQ : Q = 0 := by + simpa only [Q, A₂, A₃, A₄] using hp.peirce_polynomial A₁ + simp only [mul_sub, mul_smul_comm] + change (2 : ℝ) • ((2 : ℝ) • A₄ - A₃) - ((2 : ℝ) • A₃ - A₂) = + (2 : ℝ) • A₂ - A₁ + apply sub_eq_zero.mp + calc + (2 : ℝ) • ((2 : ℝ) • A₄ - A₃) - ((2 : ℝ) • A₃ - A₂) - + ((2 : ℝ) • A₂ - A₁) = (2 : ℝ) • Q + P := by + dsimp only [P, Q] + module + _ = 0 := by rw [hQ, hP]; module + +/-- Every element in the range of `U_p` is fixed by `U_p`. -/ +theorem IsJordanProjection.quadRep_eq_self_of_mem_range [SMulCommClass ℝ E E] [IsCommJordan E] + {p x : E} + (hp : IsJordanProjection p) (y : E) (hy : x = U p y) : U p x = x := by + rw [hy, hp.quadRep_comp_self] + +/-- The residual after quadratic compression lies in the kernel of that compression. -/ +theorem IsJordanProjection.quadRep_sub_quadRep [SMulCommClass ℝ E E] [IsCommJordan E] + {p x : E} (hp : IsJordanProjection p) : + U p (x - U p x) = 0 := by + rw [map_sub, hp.quadRep_comp_self, sub_self] + +/-- Every element splits algebraically into its quadratic-image part and residual. For an +idempotent `p`, `quadRep_sub_quadRep` says that the latter is in the kernel of `U_p`. This is a +linear decomposition only; no claim of positivity or a full Peirce eigenspace decomposition is +made here. -/ +theorem quadRep_add_sub_quadRep [SMulCommClass ℝ E E] (p x : E) : + U p x + (x - U p x) = x := by + abel + +end JordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Quadratic/Triple.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Quadratic/Triple.lean new file mode 100644 index 0000000000..1eb08df440 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/Quadratic/Triple.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Operator + +/-! + +# The Jordan triple product + +The symmetric polarization of the quadratic representation has a more structural form: the +Jordan triple product + +`{a, b, c} = a * (b * c) + c * (b * a) - (a * c) * b`. + +It is symmetric and bilinear in the outer variables and linear in the middle variable. Its +diagonal is precisely the quadratic representation, `{a, b, a} = U_a b`. Thus it is the right +language for the multivariable (Macdonald) proof of the quadratic fundamental formula. + +-/ + +@[expose] public section + +namespace JordanAlgebra + +variable {E : Type*} [NonAssocCommRing E] [Module ℝ E] [SMulCommClass ℝ E E] + +open scoped JordanAlgebra + +/-- The Jordan triple product, written directly to retain a computable algebraic definition. -/ +def jordanTriple (a b c : E) : E := a * (b * c) + c * (b * a) - (a * c) * b + +/-- The triple product is precisely the action of the canonical bilinear quadratic operator on +its middle variable. Thus no second bundled triple-operator API is needed: `quadRepBilin a c` +is already the operator `b ↦ {a,b,c}`. -/ +theorem jordanTriple_eq_quadRepBilin_apply (a b c : E) : + jordanTriple a b c = quadRepBilin a c b := by + rw [jordanTriple, quadRepBilin_apply] + rw [mul_comm b c, mul_comm b a] + +/-- The existing quadratic polarization is exactly twice the Jordan triple product. -/ +theorem quadRepPolar_eq_two_smul_jordanTriple (a b c : E) : + quadRepPolar a c b = (2 : ℝ) • jordanTriple a b c := by + rw [quadRepPolar_apply, jordanTriple, mul_comm c b, mul_comm a b] + +omit [Module ℝ E] [SMulCommClass ℝ E E] in +/-- The Jordan triple product is symmetric in its outer variables. -/ +theorem jordanTriple_outer_comm (a b c : E) : jordanTriple a b c = jordanTriple c b a := by + rw [jordanTriple, jordanTriple, mul_comm a c] + abel + +/-- The diagonal of the triple product is the quadratic representation. -/ +theorem jordanTriple_diag (a b : E) : jordanTriple a b a = U a b := by + rw [jordanTriple, quadRep_apply, mul_comm b a] + simp only [jpow_two] + module + +omit [Module ℝ E] [SMulCommClass ℝ E E] in +/-- Additivity in the first outer variable. -/ +theorem jordanTriple_add_left (a b c d : E) : + jordanTriple (a + b) c d = jordanTriple a c d + jordanTriple b c d := by + rw [jordanTriple, jordanTriple, jordanTriple] + simp only [add_mul, mul_add] + module + +/-- Real linearity in the first outer variable. -/ +theorem jordanTriple_smul_left (r : ℝ) (a b c : E) : + jordanTriple (r • a) b c = r • jordanTriple a b c := by + rw [jordanTriple, jordanTriple] + have hsmul_mul (z y : E) : (r • z) * y = r • (z * y) := by + calc + (r • z) * y = y * (r • z) := mul_comm _ _ + _ = r • (y * z) := mul_smul_comm r y z + _ = r • (z * y) := by rw [mul_comm y z] + rw [hsmul_mul a (b * c), mul_comm b (r • a), hsmul_mul a b, mul_smul_comm, + hsmul_mul a c, hsmul_mul (a * c) b, mul_comm a b] + simp only [smul_add, smul_sub] + +omit [Module ℝ E] [SMulCommClass ℝ E E] in +/-- Additivity in the third outer variable. -/ +theorem jordanTriple_add_right (a b c d : E) : + jordanTriple a b (c + d) = jordanTriple a b c + jordanTriple a b d := by + rw [jordanTriple_outer_comm, jordanTriple_outer_comm a b c, + jordanTriple_outer_comm a b d, jordanTriple_add_left] + +/-- Real linearity in the third outer variable. -/ +theorem jordanTriple_smul_right (r : ℝ) (a b c : E) : + jordanTriple a b (r • c) = r • jordanTriple a b c := by + calc + jordanTriple a b (r • c) = jordanTriple (r • c) b a := jordanTriple_outer_comm _ _ _ + _ = r • jordanTriple c b a := jordanTriple_smul_left r c b a + _ = r • jordanTriple a b c := by rw [jordanTriple_outer_comm] + +omit [Module ℝ E] [SMulCommClass ℝ E E] in +/-- Additivity in the middle variable. -/ +theorem jordanTriple_add_middle (a b c d : E) : + jordanTriple a (b + c) d = jordanTriple a b d + jordanTriple a c d := by + rw [jordanTriple, jordanTriple, jordanTriple] + simp only [mul_add, add_mul] + module + +/-- Real linearity in the middle variable. -/ +theorem jordanTriple_smul_middle (r : ℝ) (a b c : E) : + jordanTriple a (r • b) c = r • jordanTriple a b c := by + rw [jordanTriple, jordanTriple] + have hsmul_mul (z y : E) : (r • z) * y = r • (z * y) := by + calc + (r • z) * y = y * (r • z) := mul_comm _ _ + _ = r • (y * z) := mul_smul_comm r y z + _ = r • (z * y) := by rw [mul_comm y z] + rw [hsmul_mul b c, mul_smul_comm, hsmul_mul b a, mul_smul_comm, mul_smul_comm] + simp only [smul_add, smul_sub] + +end JordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/StructureAlgebra.lean b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/StructureAlgebra.lean new file mode 100644 index 0000000000..0b2920f00d --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/StructureAlgebra.lean @@ -0,0 +1,203 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.JordanOrderUnit.Quadratic.Fundamental +public import PhyslibAlpha.AlgebraicFramework.Algebra.Derivation +public import Mathlib.Algebra.Lie.Basic + +/-! +# Jordan derivations and infinitesimal symmetries + +This is the bundled companion to the generic predicate `IsDerivation`. A Jordan derivation is +an infinitesimal reversible symmetry of an observable algebra; the module gives such generators +a stable carrier, while `inner` packages commutators of multiplication operators. It is wholly +algebraic and sits below order units, JB norms, Cstar realizations, and JBW normality. + +The design is adapted from Cobord's `Jordan/StructureAlgebra.lean`, but reuses PhyslibAlpha's +canonical `IsDerivation`, `innerDerivation`, and proved triple-commutator identities rather than +introducing a parallel Jordan class or multiplication-operator API. +-/ + +@[expose] public section + +namespace JordanAlgebra + +variable {E : Type*} [NonAssocCommRing E] [Module ℝ E] [SMulCommClass ℝ E E] + [IsScalarTower ℝ E E] + +/-- A bundled real Jordan derivation. -/ +structure JordanDerivation (E : Type*) [NonAssocCommRing E] [Module ℝ E] where + /-- The underlying real-linear infinitesimal generator. -/ + toLinearMap : E →ₗ[ℝ] E + leibniz' : IsDerivation toLinearMap + +namespace JordanDerivation + +variable {D D₁ D₂ : JordanDerivation E} + +instance : CoeFun (JordanDerivation E) (fun _ => E → E) := ⟨fun D => D.toLinearMap⟩ +instance : Coe (JordanDerivation E) (E →ₗ[ℝ] E) := ⟨fun D => D.toLinearMap⟩ + +omit [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] in +@[ext] theorem ext (h : ∀ x, D₁ x = D₂ x) : D₁ = D₂ := by + cases D₁ + cases D₂ + simp only at h + congr + ext x + exact h x + +omit [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] in +@[simp] theorem leibniz (D : JordanDerivation E) (x y : E) : + D (x * y) = D x * y + x * D y := D.leibniz' x y + +/-- All derivations as a submodule of linear endomorphisms. -/ +def submodule : Submodule ℝ (E →ₗ[ℝ] E) where + carrier := {D | IsDerivation D} + zero_mem' := IsDerivation.zero + add_mem' hD hE := IsDerivation.add hD hE + smul_mem' c _ hD := IsDerivation.smul c hD + +/-- The zero infinitesimal symmetry. -/ +instance : Zero (JordanDerivation E) := ⟨⟨0, IsDerivation.zero⟩⟩ + +/-- Addition of infinitesimal symmetries. -/ +instance : Add (JordanDerivation E) := + ⟨fun D₁ D₂ => ⟨D₁.toLinearMap + D₂.toLinearMap, IsDerivation.add D₁.leibniz' D₂.leibniz'⟩⟩ + +/-- Negation of infinitesimal symmetries. -/ +instance : Neg (JordanDerivation E) := + ⟨fun D => ⟨-D.toLinearMap, IsDerivation.neg D.leibniz'⟩⟩ + +omit [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] in +@[simp] theorem zero_apply (x : E) : (0 : JordanDerivation E) x = 0 := rfl + +omit [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] in +@[simp] theorem add_apply (D₁ D₂ : JordanDerivation E) (x : E) : (D₁ + D₂) x = D₁ x + D₂ x := rfl + +omit [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] in +@[simp] theorem neg_apply (D : JordanDerivation E) (x : E) : (-D) x = -D x := rfl + +/-- Scalar multiples of infinitesimal symmetries. -/ +instance : SMul ℝ (JordanDerivation E) := + ⟨fun c D => ⟨c • D.toLinearMap, IsDerivation.smul c D.leibniz'⟩⟩ + +@[simp] theorem smul_apply (c : ℝ) (D : JordanDerivation E) (x : E) : (c • D) x = c • D x := rfl + +omit [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] in +/-- Every infinitesimal symmetry fixes the unit to first order. -/ +theorem map_one_eq_zero (D : JordanDerivation E) : D 1 = 0 := by + have h : D 1 = D 1 + D 1 := by simpa using D.leibniz 1 1 + apply add_right_cancel (b := D 1) + simpa using h.symm + +/-- Jordan derivations form an additive commutative group. -/ +instance : AddCommGroup (JordanDerivation E) where + add_assoc D₁ D₂ D₃ := by ext x; simp only [add_apply]; abel + zero_add D := by ext x; simp + add_zero D := by ext x; simp + add_comm D₁ D₂ := by ext x; simp only [add_apply]; abel + neg_add_cancel D := by ext x; simp + sub_eq_add_neg D₁ D₂ := by ext x; rfl + nsmul := nsmulRec + zsmul := zsmulRec + +/-- Jordan derivations form a real vector space. -/ +instance : Module ℝ (JordanDerivation E) where + one_smul D := by ext x; simp + mul_smul c d D := by + ext x + change (c * d) • D.toLinearMap x = c • d • D.toLinearMap x + exact mul_smul c d (D.toLinearMap x) + smul_zero c := by ext x; simp only [smul_apply, zero_apply, smul_zero] + smul_add c D₁ D₂ := by + ext x + change c • (D₁.toLinearMap x + D₂.toLinearMap x) = + c • D₁.toLinearMap x + c • D₂.toLinearMap x + exact smul_add c (D₁.toLinearMap x) (D₂.toLinearMap x) + add_smul c d D := by + ext x + change (c + d) • D.toLinearMap x = c • D.toLinearMap x + d • D.toLinearMap x + exact add_smul c d (D.toLinearMap x) + zero_smul D := by ext x; simp only [smul_apply, zero_smul, zero_apply] + +/-- The commutator of two derivations is again a derivation. -/ +def comm (D₁ D₂ : JordanDerivation E) : JordanDerivation E where + toLinearMap := D₁.toLinearMap.comp D₂.toLinearMap - D₂.toLinearMap.comp D₁.toLinearMap + leibniz' := by + intro x y + simp only [LinearMap.sub_apply, LinearMap.comp_apply] + rw [D₂.leibniz x y, D₁.leibniz x y] + simp only [map_add] + rw [D₁.leibniz, D₁.leibniz, D₂.leibniz, D₂.leibniz] + simp only [sub_mul, mul_sub] + module + +omit [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] in +@[simp] theorem comm_apply (D₁ D₂ : JordanDerivation E) (x : E) : + comm D₁ D₂ x = D₁ (D₂ x) - D₂ (D₁ x) := rfl + +/-- Derivations carry their canonical commutator bracket. -/ +instance : Bracket (JordanDerivation E) (JordanDerivation E) := ⟨comm⟩ + +omit [SMulCommClass ℝ E E] [IsScalarTower ℝ E E] in +@[simp] theorem lie_apply (D₁ D₂ : JordanDerivation E) (x : E) : + ⁅D₁, D₂⁆ x = D₁ (D₂ x) - D₂ (D₁ x) := rfl + +/-- Infinitesimal Jordan symmetries form a Lie ring under commutator. -/ +instance : LieRing (JordanDerivation E) where + add_lie D₁ D₂ D₃ := by + ext x + simp only [lie_apply, add_apply, map_add] + abel + lie_add D₁ D₂ D₃ := by + ext x + simp only [lie_apply, add_apply, map_add] + abel + lie_self D := by + ext x + simp only [lie_apply, zero_apply] + abel + leibniz_lie D₁ D₂ D₃ := by + ext x + simp only [lie_apply, add_apply, map_sub] + abel + +/-- The commutator Lie ring of derivations is a real Lie algebra. -/ +instance : LieAlgebra ℝ (JordanDerivation E) where + lie_smul c D₁ D₂ := by + ext x + simp only [lie_apply, smul_apply, map_smul, smul_sub] + +end JordanDerivation + +section Inner + +variable [IsCommJordan E] + +/-- The canonical inner Jordan derivation, generated by two observables. -/ +def inner (a b : E) : JordanDerivation E where + toLinearMap := innerDerivation a b + leibniz' := fun x y => innerDerivation_mul a b x y + +omit [IsScalarTower ℝ E E] in +@[simp] theorem inner_apply (a b x : E) : inner a b x = a * (b * x) - b * (a * x) := rfl + +omit [IsScalarTower ℝ E E] in +/-- The inner-derivation commutator law in bundled infinitesimal-symmetry form. -/ +theorem inner_comm (a b c d : E) : + JordanDerivation.comm (inner a b) (inner c d) = + inner (inner a b c) d + inner c (inner a b d) := by + ext x + change (innerDerivation a b).comp (innerDerivation c d) x - + (innerDerivation c d).comp (innerDerivation a b) x = + (innerDerivation (innerDerivation a b c) d + innerDerivation c (innerDerivation a b d)) x + exact DFunLike.congr_fun (innerDerivation_comm a b c d) x + +end Inner + +end JordanAlgebra diff --git a/PhyslibAlpha/AlgebraicFramework/Measurement/Basic.lean b/PhyslibAlpha/AlgebraicFramework/Measurement/Basic.lean new file mode 100644 index 0000000000..5f0ed43ac3 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/Measurement/Basic.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Effect.Basic +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.Basic +public import Mathlib.Analysis.Convex.StdSimplex + +/-! + +# Finite-outcome measurements + +A finite-outcome measurement is a finite family of effects whose total is the order unit. The +outcome *type* `ι` need not itself be finite — only finitely many outcomes need actually occur, +recorded by an explicit `Finset ι` of outcomes — so a measurement can, for instance, be labeled by +all of `ℕ` or `ℝ` while only ever registering finitely many of those labels. Evaluating a +measurement in a state gives a probability distribution on its (finite) outcome set, directly in +`ℝ`: a state is already a genuine linear functional, so its values on the (bounded) effects of a +measurement are already finite nonnegative reals summing to `1`, with no detour through `Weight`'s +`[0, ∞]`-valued arithmetic needed. + +This sits outside `OrderUnit/`: it is a derived notion built *from* `Effect` and `State`, not part +of the order-unit algebra itself, the same way `Traciality.lean` sits outside `OrderUnit/` despite +being built from `Weight`. `FiniteOutcome.lean` gives the equivalent, order-unit-level presentation +of the same data: a measurement is exactly a channel out of the classical `ι`-outcome system. + +## Main definitions + +- `Measurement E ι` +- `Measurement.outcomeDistribution` + +-/ + +@[expose] public section + +open scoped BigOperators + +variable {E ι : Type*} [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] + [Module ℝ E] [PosSMulMono ℝ E] [One E] [IsOrderUnit E] + +/-- A measurement with outcomes in `ι`: an effect for each outcome in the finite set `outcomes`, +totaling `1`. `ι` itself need not be finite. -/ +structure Measurement (E : Type*) [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] + [Module ℝ E] [PosSMulMono ℝ E] [One E] [IsOrderUnit E] (ι : Type*) where + /-- The finitely many outcomes this measurement can actually produce. -/ + outcomes : Finset ι + /-- The effect associated to each possible outcome. -/ + effects : ι → Effect E + /-- The effects exhaust the certain event. -/ + sum_eq_one : ∑ i ∈ outcomes, (effects i : E) = 1 + +namespace Measurement + +/-- Measurements are equivalently a finite set of outcomes together with an effect for each, +summing to `1` over that set. -/ +def outcomesEffectsEquiv : + Measurement E ι ≃ {p : Finset ι × (ι → Effect E) // ∑ i ∈ p.1, (p.2 i : E) = 1} where + toFun m := ⟨(m.outcomes, m.effects), m.sum_eq_one⟩ + invFun p := ⟨p.1.1, p.1.2, p.2⟩ + left_inv _ := rfl + right_inv _ := rfl + +/-- The probability distribution a measurement induces in a state, on its (finite) outcome set: +nonnegative since a state is positive, summing to `1` since the effects exhaust the certain event +and a state is linear and unital. -/ +noncomputable def outcomeDistribution (m : Measurement E ι) (s : 𝓢[ℝ, E]) : + stdSimplex ℝ m.outcomes := + ⟨fun i => s (m.effects i : E), fun i => s.map_nonneg (m.effects i).2.1, by + classical + rw [Finset.sum_coe_sort m.outcomes (fun i => s (m.effects i : E)), ← _root_.map_sum, + m.sum_eq_one, _root_.map_one]⟩ + +@[simp] +lemma outcomeDistribution_apply (m : Measurement E ι) (s : 𝓢[ℝ, E]) (i : m.outcomes) : + m.outcomeDistribution s i = s (m.effects i : E) := + rfl + +/-- A measurement as its map from states to the probability simplex on its outcomes. -/ +noncomputable abbrev outcomeMap (m : Measurement E ι) : 𝓢[ℝ, E] → stdSimplex ℝ m.outcomes := + m.outcomeDistribution + +end Measurement diff --git a/PhyslibAlpha/AlgebraicFramework/Measurement/BoundedScalarization.lean b/PhyslibAlpha/AlgebraicFramework/Measurement/BoundedScalarization.lean new file mode 100644 index 0000000000..5f646e15d6 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/Measurement/BoundedScalarization.lean @@ -0,0 +1,70 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.Measurement.MeasurableOutcome +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Effect.BoundedIntegral + +/-! + +# Naturality of bounded effect-valued integration + +A normal channel carries an effect-valued measure to an effect-valued measure. This file proves +that the already-defined bounded integral commutes with that operation. The proof is intentionally +at the order-unit/channel level: scalarization by a normal state is a later specialization, not a +second limit argument. + +-/ + +@[expose] public section + +namespace EffectValuedMeasure + +section BoundedNaturality + +variable {Ω E F : Type*} [MeasurableSpace Ω] + [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] [Module ℝ E] + [PosSMulMono ℝ E] [One E] [IsArchimedeanOrderUnit E] + [AddCommGroup F] [PartialOrder F] [IsOrderedAddMonoid F] [Module ℝ F] + [PosSMulMono ℝ F] [One F] [IsArchimedeanOrderUnit F] + +open Filter Topology IsArchimedeanOrderUnit + +@[nolint docBlame] +noncomputable local instance instNormedAddCommGroupE : NormedAddCommGroup E := + IsArchimedeanOrderUnit.orderUnitNormedAddCommGroup + +@[nolint docBlame] +noncomputable local instance instNormedAddCommGroupF : NormedAddCommGroup F := + IsArchimedeanOrderUnit.orderUnitNormedAddCommGroup + +variable [CompleteSpace E] [CompleteSpace F] + +/-- A normal channel commutes with the bounded effect-valued integral. The only analytic input is +order-unit contractivity of a unital positive map; normality is used solely to make `μ.map φ hφ` +an effect-valued measure. -/ +theorem map_integral {f : Ω → ℝ} {M : ℝ} (hf : Measurable f) (hM : ∀ x, |f x| ≤ M) + (μ : EffectValuedMeasure Ω E) (φ : E →ₚ₁[ℝ] F) (hφ : φ.IsNormal) : + φ (integral hf hM μ) = integral hf hM (μ.map φ hφ) := by + let φc : E →L[ℝ] F := φ.toLinearMap.mkContinuous 1 (by + intro x + change orderUnitNorm (φ x) ≤ 1 * orderUnitNorm x + simpa using φ.orderUnitNorm_map_le x) + have hmap : Tendsto + (fun n : ℕ => φ (simpleIntegral μ (meshWeight M n) (meshPiece f M n) + (isPartition_meshPiece hf hM n))) atTop (𝓝 (φ (integral hf hM μ))) := by + have h := (φc.continuous.tendsto (integral hf hM μ)).comp (integral_tendsto hf hM μ) + change Tendsto (fun n : ℕ => φc (simpleIntegral μ (meshWeight M n) (meshPiece f M n) + (isPartition_meshPiece hf hM n))) atTop (𝓝 (φc (integral hf hM μ))) + exact h.congr fun _ => rfl + have htarget := integral_tendsto hf hM (μ.map φ hφ) + apply tendsto_nhds_unique ?_ htarget + exact hmap.congr fun n => map_simpleIntegral μ φ hφ (meshWeight M n) (meshPiece f M n) + (isPartition_meshPiece hf hM n) + +end BoundedNaturality + +end EffectValuedMeasure diff --git a/PhyslibAlpha/AlgebraicFramework/Measurement/ClassicalSystem.lean b/PhyslibAlpha/AlgebraicFramework/Measurement/ClassicalSystem.lean new file mode 100644 index 0000000000..95c8fd2df3 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/Measurement/ClassicalSystem.lean @@ -0,0 +1,61 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Basic +public import Mathlib.Data.Fintype.Defs +public import Mathlib.Data.Finset.Lattice.Fold +public import Mathlib.Algebra.Order.Floor.Semiring +public import Mathlib.Algebra.Module.Pi +public import Mathlib.Algebra.Order.Pi + +/-! + +# The classical system with finitely many outcomes + +For a finite outcome type `ι`, `ι → ℝ` is the order-unit space of a classical system that can show +one of the outcomes in `ι`: the order is pointwise, and the order unit `1` is the function +constantly `1`, i.e. the "certain event". This is the domain a finite-outcome measurement is a +channel *from*, in the sense of `Measurement` (`FiniteOutcome.lean`): an outcome `i` corresponds to +the indicator function `Pi.single i 1`, and a positive unital map out of `ι → ℝ` is exactly a +choice of effect for each outcome, summing to the certain event. + +Everything but `IsOrderUnit`/`IsArchimedeanOrderUnit` is already provided by the generic `Pi` +instances for an ordered `ℝ`-vector space; what is special to a *finite* index type is that `1` is +already the biggest thing around, since a finite set of reals is bounded. + +## Main definitions + +- `Pi.instIsOrderUnit`, `Pi.instIsArchimedeanOrderUnit` : instances for `ι → ℝ` with `ι` finite. + +-/ + +@[expose] public section + +variable {ι : Type*} [Fintype ι] + +namespace Pi + +instance instIsOrderUnit : IsOrderUnit (ι → ℝ) where + one_nonneg := fun _ => zero_le_one + exists_nsmul_one_le x := by + classical + refine ⟨Finset.univ.sup fun i => ⌈x i⌉₊, fun i => ?_⟩ + have h : x i ≤ (Finset.univ.sup fun i => ⌈x i⌉₊ : ℕ) := + (Nat.le_ceil (x i)).trans + (Nat.cast_le.mpr (Finset.le_sup (f := fun i => ⌈x i⌉₊) (Finset.mem_univ i))) + simpa using h + +instance instIsArchimedeanOrderUnit : IsArchimedeanOrderUnit (ι → ℝ) where + le_zero_of_forall_pos_smul_one_le x h i := by + show x i ≤ (0 : ℝ) + by_contra hlt + push Not at hlt + have hx := h (x i / 2) (by linarith) i + simp only [Pi.smul_apply, Pi.one_apply, smul_eq_mul, mul_one] at hx + linarith + +end Pi diff --git a/PhyslibAlpha/AlgebraicFramework/Measurement/Compatibility.lean b/PhyslibAlpha/AlgebraicFramework/Measurement/Compatibility.lean new file mode 100644 index 0000000000..e99f4cfed8 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/Measurement/Compatibility.lean @@ -0,0 +1,65 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.Measurement.Postprocessing + +/-! + +# Compatible measurements + +Two measurements are compatible when a single joint measurement, on the classical *product* of +their outcome types, marginalizes — via postprocessing along the two coordinate projections — to +both. Compatibility of measurements is exactly this classical-output specialization of channel +compatibility (a joint channel into a composite system, marginalized by the two partial-trace +channels); the classical product `ι × κ → ℝ` needs no composite-system theory to build, since +`ι × κ` is already an ordinary product type. + +## Main definitions + +- `Measurement.IsCompatible` +- `Measurement.isCompatible_self`, `Measurement.isCompatible_comm` + +-/ + +@[expose] public section + +variable {E ι κ : Type*} [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] + [Module ℝ E] [PosSMulMono ℝ E] [One E] [IsOrderUnit E] + [Fintype ι] [DecidableEq ι] [Fintype κ] [DecidableEq κ] + +namespace Measurement + +/-- Two measurements are compatible when there is a joint measurement on the classical product of +their outcome types marginalizing, via the coordinate projections, to both. -/ +def IsCompatible (M₁ : (ι → ℝ) →ₚ₁[ℝ] E) (M₂ : (κ → ℝ) →ₚ₁[ℝ] E) : Prop := + ∃ J : (ι × κ → ℝ) →ₚ₁[ℝ] E, + postprocess J (classicalPullback Prod.fst) = M₁ ∧ + postprocess J (classicalPullback Prod.snd) = M₂ + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsOrderUnit E] [Fintype ι] [DecidableEq ι] in +/-- Every measurement is compatible with itself: the joint measurement pulled back along the +diagonal `i ↦ (i, i)` marginalizes to the original measurement along either coordinate. -/ +lemma isCompatible_self (M : (ι → ℝ) →ₚ₁[ℝ] E) : IsCompatible M M := by + refine ⟨postprocess M (classicalPullback fun i => (i, i)), ?_, ?_⟩ + · rw [postprocess_postprocess, classicalPullback_comp, + show Prod.fst ∘ (fun i : ι => (i, i)) = id from rfl, classicalPullback_id, postprocess_id] + · rw [postprocess_postprocess, classicalPullback_comp, + show Prod.snd ∘ (fun i : ι => (i, i)) = id from rfl, classicalPullback_id, postprocess_id] + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsOrderUnit E] + [Fintype ι] [DecidableEq ι] [Fintype κ] [DecidableEq κ] in +/-- Compatibility is symmetric: swap the two coordinates of the joint measurement. -/ +lemma isCompatible_comm {M₁ : (ι → ℝ) →ₚ₁[ℝ] E} {M₂ : (κ → ℝ) →ₚ₁[ℝ] E} (h : IsCompatible M₁ M₂) : + IsCompatible M₂ M₁ := by + obtain ⟨J, h1, h2⟩ := h + refine ⟨postprocess J (classicalPullback (Prod.swap : ι × κ → κ × ι)), ?_, ?_⟩ + · rw [postprocess_postprocess, classicalPullback_comp, + show Prod.fst ∘ (Prod.swap : ι × κ → κ × ι) = Prod.snd from rfl, h2] + · rw [postprocess_postprocess, classicalPullback_comp, + show Prod.snd ∘ (Prod.swap : ι × κ → κ × ι) = Prod.fst from rfl, h1] + +end Measurement diff --git a/PhyslibAlpha/AlgebraicFramework/Measurement/FiniteOutcome.lean b/PhyslibAlpha/AlgebraicFramework/Measurement/FiniteOutcome.lean new file mode 100644 index 0000000000..7c7c6fa6b0 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/Measurement/FiniteOutcome.lean @@ -0,0 +1,138 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.Measurement.Basic +public import PhyslibAlpha.AlgebraicFramework.Measurement.ClassicalSystem +public import Mathlib.LinearAlgebra.Finsupp.LinearCombination + +/-! + +# Finite-outcome measurements, as channels + +A finite-outcome measurement is already presented in `Measurement/Basic.lean` as a finite family +of effects summing to `1`. This file gives the *other* presentation, promised as future work in +`OrderUnit/Channel/Basic.lean`: a finite-outcome measurement with outcome type `ι` (`ι` itself +finite, every label actually occurring) is the same thing as a channel out of the classical +`ι`-outcome system `ι → ℝ` (`ClassicalSystem.lean`) — a positive unital linear map +`(ι → ℝ) →ₚ₁[ℝ] E` — and `channelEquiv` is the equivalence witnessing this. + +The correspondence is the standard basis expansion for `ι → ℝ`: the point mass `Pi.single i 1` at +outcome `i` plays the role of the classical indicator function `𝟙_{i}`, `toChannel` sends a family +of effects to the (unique, by linearity) channel matching it on every point mass, and +`outcomeEffect` reads the family back off a channel by evaluating it at each point mass. + +## Main definitions + +- `Measurement.toChannel`, `Measurement.outcomeEffect` +- `Measurement.channelEquiv` : channels out of the classical `ι`-outcome system correspond to + finite families of effects on `ι` summing to `1`. +- `Measurement.ofChannel` : the induced `Measurement E ι`, with every outcome occurring. + +-/ + +@[expose] public section + +variable {E ι : Type*} [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] + [Module ℝ E] [PosSMulMono ℝ E] [One E] [IsOrderUnit E] [Fintype ι] [DecidableEq ι] + +namespace Measurement + +/-- The channel matching a given family of effects on every point mass: the (unique, by +linearity) positive unital extension of `i ↦ e i` from the point masses to all of `ι → ℝ`. -/ +noncomputable def toChannel (e : ι → Effect E) (he : ∑ i, (e i : E) = 1) : + (ι → ℝ) →ₚ₁[ℝ] E := + UnitalPositiveLinearMap.ofLinearMap (Fintype.linearCombination ℝ (fun i => (e i : E))) + (fun f hf => Finset.sum_nonneg fun i _ => smul_nonneg (hf i) (e i).2.1) + (by + show ∑ i, (1 : ι → ℝ) i • (e i : E) = 1 + simpa using he) + +omit [IsOrderUnit E] [DecidableEq ι] in +@[simp] +lemma toChannel_apply (e : ι → Effect E) (he : ∑ i, (e i : E) = 1) (f : ι → ℝ) : + toChannel e he f = ∑ i, f i • (e i : E) := + Fintype.linearCombination_apply ℝ (fun i => (e i : E)) f + +omit [IsOrderUnit E] in +/-- The channel matching a family of effects agrees with that family on each point mass. -/ +lemma toChannel_single (e : ι → Effect E) (he : ∑ i, (e i : E) = 1) (i : ι) : + toChannel e he (Pi.single i (1 : ℝ)) = (e i : E) := by + rw [toChannel_apply, + Finset.sum_eq_single i + (fun j _ hji => by rw [Pi.single_apply, if_neg hji, zero_smul]) + (fun h => absurd (Finset.mem_univ i) h)] + simp + +/-- The effect a channel out of the classical `ι`-outcome system assigns to outcome `i`: its value +at the point mass `Pi.single i 1`. `0 ≤` it since the point mass is a possible (classical) outcome, +and `≤ 1` since the point mass is bounded by the certain event and the channel is monotone. -/ +def outcomeEffect (M : (ι → ℝ) →ₚ₁[ℝ] E) (i : ι) : Effect E := + ⟨M (Pi.single i (1 : ℝ)), M.map_nonneg (Pi.single_nonneg.mpr zero_le_one), + (M.monotone' fun j => by rw [Pi.single_apply]; split_ifs <;> norm_num).trans_eq (map_one M)⟩ + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsOrderUnit E] [Fintype ι] in +@[simp] +lemma coe_outcomeEffect (M : (ι → ℝ) →ₚ₁[ℝ] E) (i : ι) : + (outcomeEffect M i : E) = M (Pi.single i (1 : ℝ)) := + rfl + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsOrderUnit E] in +/-- The effects a channel assigns to the outcomes of the classical system it comes from sum to the +certain event: the point masses sum to the order unit, and the channel is linear and unital. -/ +lemma outcomeEffect_sum (M : (ι → ℝ) →ₚ₁[ℝ] E) : ∑ i, (outcomeEffect M i : E) = 1 := by + simp only [coe_outcomeEffect] + calc ∑ i, M (Pi.single i (1 : ℝ)) = ∑ i, (1 : ι → ℝ) i • M (Pi.single i (1 : ℝ)) := by + simp + _ = M (∑ i, (1 : ι → ℝ) i • Pi.single i (1 : ℝ)) := by + rw [_root_.map_sum] + simp + _ = M 1 := by rw [← pi_eq_sum_univ'] + _ = 1 := map_one M + +/-- Channels out of the classical `ι`-outcome system correspond exactly to finite families of +effects on `ι`, all of whose labels occur, summing to `1`: `toChannel` and `outcomeEffect` are +mutually inverse, by the standard basis expansion of `ι → ℝ` along the point masses. -/ +noncomputable def channelEquiv : + ((ι → ℝ) →ₚ₁[ℝ] E) ≃ {e : ι → Effect E // ∑ i, (e i : E) = 1} where + toFun M := ⟨outcomeEffect M, outcomeEffect_sum M⟩ + invFun p := toChannel p.1 p.2 + left_inv M := by + apply UnitalPositiveLinearMap.toLinearMap_injective + apply LinearMap.pi_ext + intro i x + show toChannel (outcomeEffect M) (outcomeEffect_sum M) (Pi.single i x) = M (Pi.single i x) + have hx : Pi.single i x = x • Pi.single i (1 : ℝ) := by + funext j + simp only [Pi.smul_apply, smul_eq_mul, Pi.single_apply] + split_ifs <;> ring + rw [hx, map_smul, toChannel_apply] + rw [Finset.sum_eq_single i + (fun j _ hji => by rw [Pi.single_apply, if_neg hji, zero_smul]) + (fun h => absurd (Finset.mem_univ i) h)] + simp [coe_outcomeEffect] + right_inv p := by + refine Subtype.ext (funext fun i => Subtype.ext ?_) + simp + +/-- Reading a channel's outcome effects off as a `Measurement E ι`, with every label of `ι` +actually occurring as an outcome. -/ +noncomputable def ofChannel (M : (ι → ℝ) →ₚ₁[ℝ] E) : Measurement E ι where + outcomes := Finset.univ + effects := outcomeEffect M + sum_eq_one := outcomeEffect_sum M + +/-- The Born rule closes the loop between the two presentations: the outcome probability a state +assigns to `i`, computed from the channel `M` via `ofChannel`, is just that state pulled back +through `M` and evaluated at the point mass for `i` — the classical state `ω ∘ M` on the point +mass, exactly as if `i` had been measured directly on the classical system. -/ +lemma ofChannel_outcomeDistribution_apply (M : (ι → ℝ) →ₚ₁[ℝ] E) (ω : 𝓢[ℝ, E]) + (i : (ofChannel M).outcomes) : + (ofChannel M).outcomeDistribution ω i = ω (M (Pi.single (i : ι) (1 : ℝ))) := by + rw [Measurement.outcomeDistribution_apply] + rfl + +end Measurement diff --git a/PhyslibAlpha/AlgebraicFramework/Measurement/Instrument.lean b/PhyslibAlpha/AlgebraicFramework/Measurement/Instrument.lean new file mode 100644 index 0000000000..efef643185 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/Measurement/Instrument.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.Measurement.Basic +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Operation + +/-! + +# Instruments + +A finite-outcome instrument retains more than a measurement: not just the outcome probabilities, +but the transformed, post-measurement system too. It is a finite family of operations (one per +outcome, `Instrument.op`) whose images of the certain event sum to exactly `1` — the instrument as +a whole loses no probability, even though each individual operation may. + +Forgetting the post-measurement state and keeping only the outcome probabilities recovers a +`Measurement` (`Instrument.measurement`); pairing a prior state with an outcome, when that outcome +has nonzero probability, gives the conditional (post-measurement, renormalized) state +(`Instrument.conditionalState`). + +## Main definitions + +- `Instrument E ι` +- `Instrument.measurement` +- `Instrument.conditionalState` + +-/ + +@[expose] public section + +variable {E ι : Type*} [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] + [Module ℝ E] [PosSMulMono ℝ E] [One E] [IsOrderUnit E] + +/-- A finite-outcome instrument: an operation for each outcome in the finite set `outcomes`, +whose images of the certain event exhaust it — the instrument loses no probability overall, even +though a single operation may. As with `Measurement`, `ι` itself need not be finite. -/ +structure Instrument (E : Type*) [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] + [Module ℝ E] [PosSMulMono ℝ E] [One E] [IsOrderUnit E] (ι : Type*) where + /-- The finitely many outcomes this instrument can actually produce. -/ + outcomes : Finset ι + /-- The operation associated to each possible outcome. -/ + op : ι → Operation E + /-- The outcome probabilities exhaust the certain event. -/ + sum_op_one_eq_one : ∑ i ∈ outcomes, (op i : E → E) 1 = 1 + +namespace Instrument + +/-- The measurement an instrument induces: only the outcome probabilities remain, given by each +operation's image of the certain event. -/ +def measurement (𝓘 : Instrument E ι) : Measurement E ι where + outcomes := 𝓘.outcomes + effects i := Operation.outcomeEffect (𝓘.op i) + sum_eq_one := 𝓘.sum_op_one_eq_one + +@[simp] +lemma coe_measurement_effects (𝓘 : Instrument E ι) (i : ι) : + ((𝓘.measurement.effects i : Effect E) : E) = (𝓘.op i : E → E) 1 := + rfl + +/-- The post-measurement (conditional) state after outcome `i`, given a prior state `ω` for which +that outcome has nonzero probability: apply the operation, then renormalize by the outcome's +probability, so the certain event is again sent to `1`. -/ +noncomputable def conditionalState (𝓘 : Instrument E ι) (i : ι) (ω : 𝓢[ℝ, E]) + (hpos : 0 < ω ((𝓘.op i : E → E) 1)) : 𝓢[ℝ, E] := + (𝓘.op i).condition ω hpos + +@[simp] +lemma conditionalState_apply (𝓘 : Instrument E ι) (i : ι) (ω : 𝓢[ℝ, E]) + (hpos : 0 < ω ((𝓘.op i : E → E) 1)) (a : E) : + 𝓘.conditionalState i ω hpos a = + (ω ((𝓘.op i : E → E) 1))⁻¹ * ω ((𝓘.op i : E → E) a) := + Operation.condition_apply _ _ _ _ + +/-- A normal instrument operation sends a normal input state to a normal conditional state, +whenever its outcome has nonzero probability. -/ +theorem conditionalState_isNormal (𝓘 : Instrument E ι) (i : ι) (ω : 𝓢[ℝ, E]) + (hpos : 0 < ω ((𝓘.op i : E → E) 1)) (hOp : (𝓘.op i).IsNormal) (hω : ω.IsNormal) : + (𝓘.conditionalState i ω hpos).IsNormal := + Operation.condition_isNormal (𝓘.op i) ω hpos hOp hω + +end Instrument diff --git a/PhyslibAlpha/AlgebraicFramework/Measurement/MeasurableOutcome.lean b/PhyslibAlpha/AlgebraicFramework/Measurement/MeasurableOutcome.lean new file mode 100644 index 0000000000..203cab47ce --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/Measurement/MeasurableOutcome.lean @@ -0,0 +1,122 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Channel.Normal +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Effect.Integral +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.Basic + +/-! + +# Measurable-outcome measurements, pushed forward along a normal channel + +An `EffectValuedMeasure Ω C` is already exactly a measurable-outcome measurement with classical +output `C`: the general definition promised in `OrderUnit/Channel/Basic.lean` — a channel out of +bounded measurable functions `B_b(Ω, ℝ)` — restricts on indicator functions to precisely this data, +`countably_additive'` being the trace of the channel's order-continuity on indicators alone. This +file gives the other half: pushing such a measure forward along a further, genuinely normal +channel `C →ₚ₁[ℝ] E` keeps it an effect-valued measure — countable additivity survives because the +channel is linear (so it commutes with finite partial sums) and normal (so it commutes with their +supremum). + +## Main definitions + +- `EffectValuedMeasure.map` +- `EffectValuedMeasure.scalarize` + +-/ + +@[expose] public section + +variable {Ω C E : Type*} [MeasurableSpace Ω] + [AddCommGroup C] [PartialOrder C] [IsOrderedAddMonoid C] [Module ℝ C] [PosSMulMono ℝ C] [One C] + [IsOrderUnit C] + [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] [Module ℝ E] [PosSMulMono ℝ E] [One E] + [IsOrderUnit E] + +namespace EffectValuedMeasure + +omit [Module ℝ C] [PosSMulMono ℝ C] [One C] [IsOrderUnit C] in +/-- Nonnegative partial sums are monotone in how many terms are included: adding more +nonnegative terms never decreases the sum. -/ +private lemma monotone_partialSums {f : ℕ → C} (hf : ∀ n, 0 ≤ f n) : + Monotone (fun N => ∑ n ∈ Finset.range N, f n) := fun _ _ hNM => + Finset.sum_le_sum_of_subset_of_nonneg (Finset.range_subset_range.mpr hNM) fun i _ _ => hf i + +/-- Pushing an effect-valued measure forward along a normal channel: composing each assigned +effect with the channel. -/ +noncomputable def map (μ : EffectValuedMeasure Ω C) (φ : C →ₚ₁[ℝ] E) (hφ : φ.IsNormal) : + EffectValuedMeasure Ω E where + toFun s hs := ⟨φ (μ s hs : C), φ.map_nonneg (μ s hs).2.1, + (φ.monotone' (μ s hs).2.2).trans_eq (map_one φ)⟩ + map_empty' := by + refine Subtype.ext ?_ + show φ (μ ∅ MeasurableSet.empty : C) = 0 + rw [μ.map_empty]; exact map_zero φ + map_univ' := by + refine Subtype.ext ?_ + show φ (μ Set.univ MeasurableSet.univ : C) = 1 + rw [μ.map_univ]; exact map_one φ + countably_additive' s hsm hs' := by + set D : Set C := Set.range fun N => ∑ n ∈ Finset.range N, (μ (s n) (hsm n) : C) with hD + have hmono : Monotone (fun N => ∑ n ∈ Finset.range N, (μ (s n) (hsm n) : C)) := + monotone_partialSums fun n => (μ (s n) (hsm n)).2.1 + have hdirected : DirectedOn (· ≤ ·) D := hmono.directed_le.directedOn_range + have hnonempty : D.Nonempty := ⟨_, ⟨0, rfl⟩⟩ + have hlub : IsLUB D (μ (⋃ n, s n) (MeasurableSet.iUnion hsm) : C) := + μ.countably_additive s hsm hs' + have hpush := hφ D _ hnonempty hdirected hlub + change IsLUB (φ '' D) (φ (μ (⋃ n, s n) (MeasurableSet.iUnion hsm) : C)) at hpush + have himage : φ '' D = + Set.range fun N => ∑ n ∈ Finset.range N, φ (μ (s n) (hsm n) : C) := by + rw [hD, ← Set.range_comp] + congr 1 + funext N + exact map_sum φ (fun n => (μ (s n) (hsm n) : C)) (Finset.range N) + rwa [himage] at hpush + +omit [PosSMulMono ℝ C] [PosSMulMono ℝ E] in +@[simp] +lemma coe_map_apply (μ : EffectValuedMeasure Ω C) (φ : C →ₚ₁[ℝ] E) (hφ : φ.IsNormal) + (s : Set Ω) (hs : MeasurableSet s) : + ((μ.map φ hφ) s hs : E) = φ (μ s hs : C) := rfl + +/-- Scalarizing an effect-valued measure by a normal state gives its ordinary real-valued +probability law, represented as an effect-valued measure in the classical order-unit space +`ℝ`. For each measurable event this is precisely the abstract Born rule `ω(μ(s))`. -/ +noncomputable def scalarize (μ : EffectValuedMeasure Ω C) (ω : 𝓢[ℝ, C]) (hω : ω.IsNormal) : + EffectValuedMeasure Ω ℝ := μ.map ω hω + +omit [PosSMulMono ℝ C] in +@[simp] +lemma coe_scalarize_apply (μ : EffectValuedMeasure Ω C) (ω : 𝓢[ℝ, C]) (hω : ω.IsNormal) + (s : Set Ω) (hs : MeasurableSet s) : + ((μ.scalarize ω hω) s hs : ℝ) = ω (μ s hs : C) := rfl + +omit [PosSMulMono ℝ C] [PosSMulMono ℝ E] in +/-- Pushing an effect-valued measure through a normal channel commutes with its finite simple +integral. This is the finite, algebraic naturality law underlying scalarization of the bounded +projection calculus; no second integration construction is introduced. -/ +theorem map_simpleIntegral (μ : EffectValuedMeasure Ω C) (φ : C →ₚ₁[ℝ] E) (hφ : φ.IsNormal) + {ι : Type*} [Fintype ι] (c : ι → ℝ) (s : ι → Set Ω) + (hs : IsPartition s) : + φ (simpleIntegral μ c s hs) = simpleIntegral (μ.map φ hφ) c s hs := by + unfold simpleIntegral + rw [map_sum] + apply Finset.sum_congr rfl + intro i _ + rw [map_smul, coe_map_apply] + +omit [PosSMulMono ℝ C] [PosSMulMono ℝ E] in +/-- Scalarizing a simple effect-valued integral by a normal state is the corresponding ordinary +real simple integral. -/ +theorem scalarize_simpleIntegral (μ : EffectValuedMeasure Ω C) (ω : 𝓢[ℝ, C]) + (hω : ω.IsNormal) {ι : Type*} [Fintype ι] (c : ι → ℝ) (s : ι → Set Ω) + (hs : IsPartition s) : + ω (simpleIntegral μ c s hs) = simpleIntegral (μ.scalarize ω hω) c s hs := + map_simpleIntegral μ ω hω c s hs + +end EffectValuedMeasure diff --git a/PhyslibAlpha/AlgebraicFramework/Measurement/Postprocessing.lean b/PhyslibAlpha/AlgebraicFramework/Measurement/Postprocessing.lean new file mode 100644 index 0000000000..cb86f9a05f --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/Measurement/Postprocessing.lean @@ -0,0 +1,133 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.Measurement.FiniteOutcome + +/-! + +# Postprocessing a finite-outcome measurement + +A classical channel that relabels, coarse-grains, or adds noise to the outcomes of a measurement +— from raw outcomes `ι` to coarse outcomes `κ` — is, in the same Heisenberg convention as every +other channel here, a positive unital linear map `K : (κ → ℝ) →ₚ₁[ℝ] (ι → ℝ)`: it pulls functions +of the coarse outcome back to functions of the raw one. Given a measurement `M : (ι → ℝ) →ₚ₁[ℝ] E`, +its postprocessing through `K` is `M.comp K`, already meaningful with no new definition needed — +this is the entire point of presenting measurements as channels (`FiniteOutcome.lean`): +postprocessing is composition. + +`stochasticMatrixEquiv` identifies such classical channels concretely: `ι → ℝ` is itself a +classical order-unit space (`ClassicalSystem.lean`), so `channelEquiv` applies to it verbatim, and +uncurrying its family of effects turns a classical channel into exactly what one would expect — +a row-stochastic matrix, a probability distribution over `κ` for every raw outcome in `ι`. + +A deterministic relabeling `f : κ → ι` of outcomes — no randomness, just reading off `f k` — gives +the simplest classical channel of all, `classicalPullback f`; `Compatibility.lean` builds the +coordinate projections of a product outcome type out of it. + +## Main definitions + +- `Measurement.postprocess`, `Measurement.postprocess_postprocess` +- `Measurement.stochasticMatrixEquiv` +- `Measurement.classicalPullback` + +-/ + +@[expose] public section + +variable {E ι κ : Type*} [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] + [Module ℝ E] [PosSMulMono ℝ E] [One E] [IsOrderUnit E] + [Fintype ι] [DecidableEq ι] [Fintype κ] [DecidableEq κ] + +namespace Measurement + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsOrderUnit E] [Fintype ι] [DecidableEq ι] + [Fintype κ] [DecidableEq κ] in +/-- Postprocessing a measurement through a classical channel `κ → ι` is just composition: reading +measurements as channels makes postprocessing free, with no separate notion to build. -/ +def postprocess (M : (ι → ℝ) →ₚ₁[ℝ] E) (K : (κ → ℝ) →ₚ₁[ℝ] (ι → ℝ)) : (κ → ℝ) →ₚ₁[ℝ] E := + M.comp K + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsOrderUnit E] [Fintype ι] [DecidableEq ι] + [Fintype κ] [DecidableEq κ] in +@[simp] +lemma postprocess_apply (M : (ι → ℝ) →ₚ₁[ℝ] E) (K : (κ → ℝ) →ₚ₁[ℝ] (ι → ℝ)) (f : κ → ℝ) : + postprocess M K f = M (K f) := + rfl + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsOrderUnit E] [Fintype ι] [DecidableEq ι] in +/-- Postprocessing through the identity channel changes nothing. -/ +@[simp] +lemma postprocess_id (M : (ι → ℝ) →ₚ₁[ℝ] E) : + postprocess M (.id ℝ (ι → ℝ)) = M := + UnitalPositiveLinearMap.comp_id M + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsOrderUnit E] [Fintype ι] [DecidableEq ι] + [Fintype κ] [DecidableEq κ] in +/-- Postprocessing twice, through `K` then `L`, is postprocessing once through their composite: +postprocessing is a genuine (contravariant) action of classical channels on measurements. -/ +lemma postprocess_postprocess {μ : Type*} + (M : (ι → ℝ) →ₚ₁[ℝ] E) (K : (κ → ℝ) →ₚ₁[ℝ] (ι → ℝ)) (L : (μ → ℝ) →ₚ₁[ℝ] (κ → ℝ)) : + postprocess (postprocess M K) L = postprocess M (K.comp L) := + UnitalPositiveLinearMap.ext fun _ => rfl + +/-- Uncurrying a `κ`-indexed family of effects in the classical system `ι → ℝ` summing to `1` +into a row-stochastic matrix: `packEquiv` just swaps which index is bundled into the effect and +which is left free, so both directions are `rfl` once unfolded. -/ +def packEquiv : + {e : κ → Effect (ι → ℝ) // ∑ k, (e k : ι → ℝ) = 1} ≃ + {P : ι → κ → ℝ // ∀ i, (∀ k, 0 ≤ P i k) ∧ ∑ k, P i k = 1} where + toFun p := ⟨fun i k => (p.1 k : ι → ℝ) i, + fun i => ⟨fun k => (p.1 k).2.1 i, by simpa using congrFun p.2 i⟩⟩ + invFun P := ⟨fun k => ⟨fun i => P.1 i k, fun i => (P.2 i).1 k, + fun i => (Finset.single_le_sum (fun k _ => (P.2 i).1 k) (Finset.mem_univ k)).trans_eq + (P.2 i).2⟩, + by + funext i + simp only [Finset.sum_apply, Pi.one_apply] + exact (P.2 i).2⟩ + left_inv p := by apply Subtype.ext; funext k; exact Subtype.ext rfl + right_inv P := by apply Subtype.ext; funext i k; rfl + +/-- A classical channel from raw outcomes `ι` to coarse outcomes `κ` is exactly a row-stochastic +matrix: for every raw outcome `i`, a probability distribution `k ↦ P i k` over `κ`. This +specializes `channelEquiv` to the classical system `ι → ℝ` in place of a general `E`, then +uncurries the resulting family of effects into a matrix via `packEquiv`. -/ +noncomputable def stochasticMatrixEquiv : + ((κ → ℝ) →ₚ₁[ℝ] (ι → ℝ)) ≃ {P : ι → κ → ℝ // ∀ i, (∀ k, 0 ≤ P i k) ∧ ∑ k, P i k = 1} := + (channelEquiv (ι := κ) (E := ι → ℝ)).trans packEquiv + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsOrderUnit E] [Fintype ι] [DecidableEq ι] + [Fintype κ] [DecidableEq κ] in +/-- The deterministic classical channel reading off outcome `f k`: pulling a function of the +coarse outcome `ι` back along `f : κ → ι` to a function of the raw outcome `κ`. The corresponding +stochastic matrix is the one-hot family `P i k = if f k = i then 1 else 0`. -/ +def classicalPullback (f : κ → ι) : (ι → ℝ) →ₚ₁[ℝ] (κ → ℝ) := + UnitalPositiveLinearMap.ofLinearMap (LinearMap.funLeft ℝ ℝ f) (fun _ hg k => hg (f k)) rfl + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsOrderUnit E] [Fintype ι] [DecidableEq ι] + [Fintype κ] [DecidableEq κ] in +@[simp] +lemma classicalPullback_id : + classicalPullback (id : ι → ι) = UnitalPositiveLinearMap.id ℝ (ι → ℝ) := + UnitalPositiveLinearMap.ext fun _ => rfl + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsOrderUnit E] [Fintype ι] [DecidableEq ι] + [Fintype κ] [DecidableEq κ] in +/-- Pulling back along `f` then along `g` is pulling back along `f ∘ g` once: `classicalPullback` +is a contravariant functor from outcome types and relabelings to classical channels. -/ +lemma classicalPullback_comp {μ : Type*} (f : κ → ι) (g : μ → κ) : + (classicalPullback g).comp (classicalPullback f) = classicalPullback (f ∘ g) := + UnitalPositiveLinearMap.ext fun _ => rfl + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsOrderUnit E] [Fintype ι] [DecidableEq ι] + [Fintype κ] [DecidableEq κ] in +@[simp] +lemma classicalPullback_apply (f : κ → ι) (g : ι → ℝ) (k : κ) : + classicalPullback f g k = g (f k) := + rfl + +end Measurement diff --git a/PhyslibAlpha/AlgebraicFramework/Measurement/ProbabilityLaw.lean b/PhyslibAlpha/AlgebraicFramework/Measurement/ProbabilityLaw.lean new file mode 100644 index 0000000000..604ab2b093 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/Measurement/ProbabilityLaw.lean @@ -0,0 +1,94 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.Measurement.MeasurableOutcome +public import Mathlib.MeasureTheory.Measure.ProbabilityMeasure +public import Mathlib.Topology.Algebra.InfiniteSum.ENNReal +public import Mathlib.Topology.Order.MonotoneConvergence + +/-! + +# Probability laws of effect-valued measurements + +A real-valued effect measure is exactly a probability measure: its values lie in `[0, 1]`, and +its order-theoretic countable additivity becomes `ENNReal` countable additivity after applying +`ENNReal.ofReal`. Consequently, scalarizing a POVM by a normal state produces an ordinary +probability law. + +## Main definitions + +- `EffectValuedMeasure.toMeasure` +- `EffectValuedMeasure.toProbabilityMeasure` +- `EffectValuedMeasure.probabilityLaw` + +-/ + +@[expose] public section + +open MeasureTheory + +variable {Ω C : Type*} [MeasurableSpace Ω] + +namespace EffectValuedMeasure + +/-- The ordinary measure represented by a real-valued effect-valued measure. -/ +noncomputable def toMeasure (ν : EffectValuedMeasure Ω ℝ) : Measure Ω := + Measure.ofMeasurable + (fun s hs => ENNReal.ofReal (ν s hs : ℝ)) + (by simp) + (by + intro s hsm hs + let a : ℕ → ℝ := fun n => (ν (s n) (hsm n) : ℝ) + let p : ℕ → ℝ := fun N => ∑ n ∈ Finset.range N, a n + have ha : ∀ n, 0 ≤ a n := fun n => (ν (s n) (hsm n)).2.1 + have hpmono : Monotone p := fun _ _ hNM => + Finset.sum_le_sum_of_subset_of_nonneg (Finset.range_subset_range.mpr hNM) + (fun i _ _ => ha i) + have hlub : IsLUB (Set.range p) (ν (⋃ n, s n) (MeasurableSet.iUnion hsm) : ℝ) := by + simpa [p, a] using ν.countably_additive s hsm hs + have hreal : Filter.Tendsto p Filter.atTop + (nhds (ν (⋃ n, s n) (MeasurableSet.iUnion hsm) : ℝ)) := + tendsto_atTop_isLUB hpmono hlub + have henn : Filter.Tendsto (fun N => ENNReal.ofReal (p N)) Filter.atTop + (nhds (ENNReal.ofReal (ν (⋃ n, s n) (MeasurableSet.iUnion hsm) : ℝ))) := + ENNReal.tendsto_ofReal hreal + have hpartial : (fun N => ENNReal.ofReal (p N)) = + fun N => ∑ n ∈ Finset.range N, ENNReal.ofReal (a n) := by + funext N + exact ENNReal.ofReal_sum_of_nonneg fun i _ => ha i + rw [hpartial] at henn + exact tendsto_nhds_unique henn (ENNReal.tendsto_nat_tsum fun n => ENNReal.ofReal (a n))) + +@[simp] +lemma toMeasure_apply (ν : EffectValuedMeasure Ω ℝ) (s : Set Ω) (hs : MeasurableSet s) : + ν.toMeasure s = ENNReal.ofReal (ν s hs : ℝ) := + Measure.ofMeasurable_apply _ hs + +/-- Every real-valued effect-valued measure has total mass one. -/ +instance (ν : EffectValuedMeasure Ω ℝ) : IsProbabilityMeasure ν.toMeasure where + measure_univ := by simp [toMeasure_apply] + +/-- A real-valued effect-valued measure bundled as an ordinary probability measure. -/ +noncomputable def toProbabilityMeasure (ν : EffectValuedMeasure Ω ℝ) : ProbabilityMeasure Ω := + ⟨ν.toMeasure, inferInstance⟩ + +variable [AddCommGroup C] [PartialOrder C] [IsOrderedAddMonoid C] [Module ℝ C] + [PosSMulMono ℝ C] [One C] [IsOrderUnit C] + +/-- The probability distribution obtained by measuring `μ` in the normal state `ω`. -/ +noncomputable def probabilityLaw (μ : EffectValuedMeasure Ω C) (ω : 𝓢[ℝ, C]) (hω : ω.IsNormal) : + ProbabilityMeasure Ω := (μ.scalarize ω hω).toProbabilityMeasure + +omit [PosSMulMono ℝ C] in +@[simp] +lemma probabilityLaw_apply (μ : EffectValuedMeasure Ω C) (ω : 𝓢[ℝ, C]) (hω : ω.IsNormal) + (s : Set Ω) (hs : MeasurableSet s) : + (μ.probabilityLaw ω hω : Measure Ω) s = ENNReal.ofReal (ω (μ s hs : C)) := by + change (μ.scalarize ω hω).toMeasure s = ENNReal.ofReal (ω (μ s hs : C)) + rw [toMeasure_apply _ s hs, coe_scalarize_apply] + +end EffectValuedMeasure diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/Basic.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Basic.lean new file mode 100644 index 0000000000..10d04080b8 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Basic.lean @@ -0,0 +1,176 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Mathlib.Algebra.Order.Module.Defs +public import Mathlib.Algebra.Order.Nonneg.Basic +public import Mathlib.Data.NNReal.Defs +public import Mathlib.Geometry.Convex.Cone.Pointed + +/-! + +# Order units and the positive cone + +## i. Overview + +`E` is where measurement outcomes and expectation values live, and `≤` is the natural order on +them: `0 ≤ x` means `x` could be a probability, or the expectation value of a +positive observable — since no measurement ever returns something negative. + +`1 : E` is the certain outcome, i.e. the identity operator. `IsOrderUnit` says it's the biggest +thing around: every outcome is bounded by finitely many copies of `1`, which is what lets us later +squeeze an effect between `0` and `1` or normalize a state. `IsArchimedeanOrderUnit` adds one more +thing: nothing is infinitesimally smaller than `1` without actually being `≤ 0`. That's what lets +`≤` become an actual distance between states later, not just a comparison. + +`PosCone E` is just the possible outcomes on their own. Adding two of them, or scaling one down by +a probability, keeps you among possible outcomes, and does so as a `ℝ≥0`-module. + +## ii. Key definitions and results + +- `IsOrderUnit E` +- `IsArchimedeanOrderUnit E` +- `IsOrderUnitElement u` +- `IsArchimedeanOrderUnitElement u` +- `PosCone E` +- `IsOrderUnit.exists_eq_sub_nonneg` + +## iii. Table of contents + +- A. Order units +- B. The positive cone + +-/ + +@[expose] public section + +open scoped NNReal + +/-! + +## A. Order units +-/ + +/-- An element `u` is an order unit when it is nonnegative and every element is bounded above by +a natural multiple of `u`. In an ordered additive group, applying the same condition to `-x` +supplies the corresponding lower bound. -/ +def IsOrderUnitElement {E : Type*} [AddCommMonoid E] [PartialOrder E] (u : E) : Prop := + 0 ≤ u ∧ ∀ x : E, ∃ n : ℕ, x ≤ n • u + +/-- An element `u` is an Archimedean order unit when it is an order unit and an element lying +below every positive real multiple of `u` is nonpositive. -/ +def IsArchimedeanOrderUnitElement {E : Type*} [AddCommGroup E] [PartialOrder E] [Module ℝ E] + (u : E) : Prop := + IsOrderUnitElement u ∧ ∀ x : E, (∀ ε : ℝ, 0 < ε → x ≤ ε • u) → x ≤ 0 + +/-- The identity is the biggest outcome around: everything else is bounded by finitely many +copies of it. -/ +class IsOrderUnit (E : Type*) [AddCommMonoid E] [PartialOrder E] [One E] : Prop where + /-- The identity is itself a possible outcome. -/ + one_nonneg : 0 ≤ (1 : E) + /-- Every outcome is bounded by some finite multiple of the identity. -/ + exists_nsmul_one_le : ∀ x : E, ∃ n : ℕ, x ≤ n • (1 : E) + +/-- Same as `IsOrderUnit`, plus: nothing is infinitesimally smaller than `1` without actually +being `≤ 0`. -/ +class IsArchimedeanOrderUnit (E : Type*) [AddCommGroup E] [PartialOrder E] [Module ℝ E] [One E] : + Prop extends IsOrderUnit E where + /-- If `x` is smaller than every positive multiple of `1`, however small, `x` is already + `≤ 0`. -/ + le_zero_of_forall_pos_smul_one_le : ∀ x : E, + (∀ ε : ℝ, 0 < ε → x ≤ ε • (1 : E)) → x ≤ 0 + +/-- The real numbers, ordered in the usual way and with order unit `1`, form the basic +Archimedean order-unit space. -/ +instance instIsArchimedeanOrderUnitReal : IsArchimedeanOrderUnit ℝ where + one_nonneg := zero_le_one + exists_nsmul_one_le x := by + obtain ⟨n, hn⟩ := exists_nat_ge x + exact ⟨n, by simpa using hn⟩ + le_zero_of_forall_pos_smul_one_le x hx := by + by_contra h + have hxpos : 0 < x := lt_of_not_ge h + have := hx (x / 2) (by positivity) + simp only [smul_eq_mul, mul_one] at this + linarith + +/-- The distinguished unit is an order-unit element whenever `E` carries `IsOrderUnit`. -/ +lemma isOrderUnitElement_one {E : Type*} [AddCommMonoid E] [PartialOrder E] [One E] + [IsOrderUnit E] : IsOrderUnitElement (1 : E) := + ⟨IsOrderUnit.one_nonneg, IsOrderUnit.exists_nsmul_one_le⟩ + +/-- The distinguished unit is an Archimedean order-unit element whenever `E` carries +`IsArchimedeanOrderUnit`. -/ +lemma isArchimedeanOrderUnitElement_one {E : Type*} [AddCommGroup E] [PartialOrder E] + [Module ℝ E] [One E] [IsArchimedeanOrderUnit E] : + IsArchimedeanOrderUnitElement (1 : E) := + ⟨isOrderUnitElement_one, IsArchimedeanOrderUnit.le_zero_of_forall_pos_smul_one_le⟩ + +namespace IsOrderUnitElement + +variable {E : Type*} [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] + +/-- Every vector is a difference of two nonnegative vectors when a specified order unit exists. -/ +lemma exists_eq_sub_nonneg {u : E} (hu : IsOrderUnitElement u) (x : E) : + ∃ xp xn : E, 0 ≤ xp ∧ 0 ≤ xn ∧ x = xp - xn := by + obtain ⟨n, hn⟩ := hu.2 (-x) + refine ⟨n • u + x, n • u, ?_, nsmul_nonneg hu.1 n, ?_⟩ + · simpa [sub_eq_add_neg] using sub_nonneg.mpr hn + · abel + +end IsOrderUnitElement + +namespace IsOrderUnit + +variable {E : Type*} [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] [One E] + [IsOrderUnit E] + +/-- Every element of an order-unit space is a difference of two nonnegative elements. In cone +language, the positive cone is reproducing. -/ +lemma exists_eq_sub_nonneg (x : E) : + ∃ xp xn : E, 0 ≤ xp ∧ 0 ≤ xn ∧ x = xp - xn := + isOrderUnitElement_one.exists_eq_sub_nonneg x + +end IsOrderUnit + +/-! + +## B. The positive cone +-/ + +/-- The possible measurement outcomes on their own. -/ +abbrev PosCone (E : Type*) [AddCommMonoid E] [PartialOrder E] := {x : E // 0 ≤ x} + +namespace PosCone + +variable {E : Type*} + +/-- Two possible outcomes add up to a possible outcome. -/ +instance [AddCommMonoid E] [PartialOrder E] [IsOrderedAddMonoid E] : + AddCommMonoid (PosCone E) := + inferInstanceAs (AddCommMonoid {x : E // 0 ≤ x}) + +variable [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] [Module ℝ E] [PosSMulMono ℝ E] + +/-- Scaling a possible outcome by a nonnegative number keeps it a possible outcome and does so +compatibly with addition to make `PosCone E` a `ℝ≥0`-module. -/ +instance instModule : Module ℝ≥0 (PosCone E) where + smul c x := ⟨(c : ℝ) • (x : E), smul_nonneg c.2 x.2⟩ + one_smul _ := Subtype.ext (one_smul ℝ _) + mul_smul c d _ := Subtype.ext (mul_smul (c : ℝ) (d : ℝ) _) + smul_zero _ := Subtype.ext (smul_zero _) + smul_add c _ _ := Subtype.ext (smul_add (c : ℝ) _ _) + add_smul c d _ := Subtype.ext (by push_cast; exact add_smul (c : ℝ) (d : ℝ) _) + zero_smul _ := Subtype.ext (by push_cast; exact zero_smul ℝ _) + +@[simp, norm_cast] +lemma coe_smul (c : ℝ≥0) (x : PosCone E) : ((c • x : PosCone E) : E) = (c : ℝ) • (x : E) := rfl + +@[simp] +lemma mk_smul (c : ℝ≥0) {x : E} (hx : 0 ≤ x) : + c • (⟨x, hx⟩ : PosCone E) = ⟨(c : ℝ) • x, smul_nonneg c.2 hx⟩ := rfl + +end PosCone diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/Channel/Basic.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Channel/Basic.lean new file mode 100644 index 0000000000..a03ed0d7f5 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Channel/Basic.lean @@ -0,0 +1,206 @@ +/- +Copyright (c) 2026 David Gross. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Gross +-/ +module + +public import Mathlib.Algebra.Order.Module.PositiveLinearMap +public import Mathlib.Analysis.Complex.Basic + +/-! + +# Channels + +## i. Overview + +A channel from system `A` to system `B` is, in the Schrödinger picture, an affine map on states. +Dualizing gives a unital positive linear map on effects in the other direction (the Heisenberg +picture): `UnitalPositiveLinearMap` is exactly that dual, and `E₁ →ₚ₁[R] E₂` reads as "the +adjoint of a channel `A → B`" whenever `E₁`, `E₂` are the effect algebras of `A`, `B`. + +## ii. Key definitions and results + +- `UnitalPositiveLinearMap` is the type of positive linear maps that preserve `1`. +- `E₁ →ₚ₁[R] E₂` is notation for it. +- Endomorphisms `E →ₚ₁[R] E` form a monoid under composition. + +## iii. Table of contents + +- A. Unital positive linear maps +- B. Constructors +- C. Coercions and extensionality +- D. Identity and composition + +## Implementation details + +We follow the implementation of `PositiveLinearMap` closely. + +-/ + +@[expose] public section + +section UnitalPositiveLinearMap + +/-! ## A. Unital positive linear maps -/ + +/-- A positive linear map that preserves `1`. -/ +structure UnitalPositiveLinearMap (R E₁ E₂ : Type*) [Semiring R] + [AddCommMonoid E₁] [PartialOrder E₁] [AddCommMonoid E₂] [PartialOrder E₂] + [Module R E₁] [Module R E₂] [One E₁] [One E₂] extends E₁ →ₚ[R] E₂, OneHom E₁ E₂ + +-- The inherited `OneHom` projection has no separately attachable docstring. +attribute [nolint docBlame] UnitalPositiveLinearMap.toOneHom + +/-- Notation for unital positive linear maps. -/ +notation:25 E " →ₚ₁[" R:25 "] " F:0 => UnitalPositiveLinearMap R E F + +section UnitalPositiveLinearMapClass + +/-! ## B. Constructors -/ + +variable {F R E₁ E₂ : Type*} [Semiring R] + [AddCommMonoid E₁] [PartialOrder E₁] [AddCommMonoid E₂] [PartialOrder E₂] + [Module R E₁] [Module R E₂] [FunLike F E₁ E₂] [LinearMapClass F R E₁ E₂] + [OrderHomClass F E₁ E₂] [One E₁] [One E₂] [OneHomClass F E₁ E₂] + +/-- Bundle a positive, unital linear map satisfying the relevant typeclass assumptions. -/ +def UnitalPositiveLinearMap.ofClass (f : F) : E₁ →ₚ₁[R] E₂ := + { (f : E₁ →ₗ[R] E₂), (f : E₁ →o E₂), (f : OneHom E₁ E₂) with } + +end UnitalPositiveLinearMapClass + +namespace UnitalPositiveLinearMap + +variable {R E₁ E₂ : Type*} [Semiring R] + [AddCommGroup E₁] [PartialOrder E₁] [IsOrderedAddMonoid E₁] + [AddCommGroup E₂] [PartialOrder E₂] [IsOrderedAddMonoid E₂] + [Module R E₁] [Module R E₂] [One E₁] [One E₂] + +/-- Bundle a linear map after proving only positivity and preservation of `1`. -/ +def ofLinearMap (f : E₁ →ₗ[R] E₂) (hpos : ∀ x, 0 ≤ x → 0 ≤ f x) + (hone : f 1 = 1) : E₁ →ₚ₁[R] E₂ where + toPositiveLinearMap := PositiveLinearMap.mk₀ f hpos + map_one' := hone + +end UnitalPositiveLinearMap + +namespace UnitalPositiveLinearMap + +/-! ## C. Coercions and extensionality -/ + +variable {R E₁ E₂ E₃ E₄ : Type*} [Semiring R] + [AddCommMonoid E₁] [PartialOrder E₁] + [AddCommMonoid E₂] [PartialOrder E₂] + [AddCommMonoid E₃] [PartialOrder E₃] + [AddCommMonoid E₄] [PartialOrder E₄] + [Module R E₁] [Module R E₂] [Module R E₃] [Module R E₄] + [One E₁] [One E₂] [One E₃] [One E₄] + +instance : FunLike (E₁ →ₚ₁[R] E₂) E₁ E₂ where + coe f := f.toFun + coe_injective f g h := by + cases f + cases g + congr + apply DFunLike.coe_injective + exact h + +instance : LinearMapClass (E₁ →ₚ₁[R] E₂) R E₁ E₂ where + map_add f := map_add f.toLinearMap + map_smulₛₗ f := f.toLinearMap.map_smul' + +instance : OrderHomClass (E₁ →ₚ₁[R] E₂) E₁ E₂ where + map_rel f {_ _} hab := f.monotone' hab + +instance : OneHomClass (E₁ →ₚ₁[R] E₂) E₁ E₂ where + map_one f := f.map_one' + +example (f : E₁ →ₚ₁[R] E₂) : f 1 = 1 := by simp + +@[simp] +lemma coe_toPositiveLinearMap (f : E₁ →ₚ₁[R] E₂) : (f.toPositiveLinearMap : E₁ → E₂) = f := + rfl + +example (f : E₁ →ₚ₁[R] E₂) : f.toLinearMap 1 = 1 := by + simp + +initialize_simps_projections UnitalPositiveLinearMap (toFun → apply, as_prefix toLinearMap) + +@[ext] +lemma ext {f g : E₁ →ₚ₁[R] E₂} (h : ∀ x, f x = g x) : f = g := + DFunLike.ext f g h + +variable (R E₁) in +/-- The identity as a positive linear one-preserving map. -/ +@[simps! apply toLinearMap] protected def id : E₁ →ₚ₁[R] E₁ where + __ := LinearMap.id + __ := OrderHom.id + __ := OneHom.id E₁ + +@[simp] lemma toOrderHom_id : (UnitalPositiveLinearMap.id R E₁).toOrderHom = .id := rfl +@[simp] lemma toOneHom_id : (UnitalPositiveLinearMap.id R E₁).toOneHom = .id E₁ := rfl + +/-! ## D. Identity and composition -/ + +/-- Composition of positive linear one-preserving maps. -/ +@[simps! apply] +def comp (g : E₂ →ₚ₁[R] E₃) (f : E₁ →ₚ₁[R] E₂) : E₁ →ₚ₁[R] E₃ where + toLinearMap := g.toPositiveLinearMap.comp f.toPositiveLinearMap + monotone' := g.monotone'.comp f.monotone' + map_one' := by simp + +/-- Composition of unital positive linear maps is associative. -/ +lemma comp_assoc (h : E₃ →ₚ₁[R] E₄) (g : E₂ →ₚ₁[R] E₃) (f : E₁ →ₚ₁[R] E₂) : + (h.comp g).comp f = h.comp (g.comp f) := by + ext x + simp + +@[simp] lemma toPositiveLinearMap_comp (g : E₂ →ₚ₁[R] E₃) (f : E₁ →ₚ₁[R] E₂) : + (g.comp f).toPositiveLinearMap = g.toPositiveLinearMap.comp f.toPositiveLinearMap := + rfl + +@[simp] lemma toOrderHom_comp (g : E₂ →ₚ₁[R] E₃) (f : E₁ →ₚ₁[R] E₂) : + (g.comp f).toOrderHom = g.toOrderHom.comp f.toOrderHom := + rfl + +@[simp] lemma comp_id (f : E₁ →ₚ₁[R] E₂) : f.comp (.id R E₁) = f := rfl +@[simp] lemma id_comp (f : E₁ →ₚ₁[R] E₂) : (UnitalPositiveLinearMap.id R E₂).comp f = f := rfl + +/-- Unital positive endomorphisms form a monoid under composition. -/ +instance instMonoid : Monoid (E₁ →ₚ₁[R] E₁) where + one := .id R E₁ + mul := comp + one_mul := id_comp + mul_one := comp_id + mul_assoc := comp_assoc + +@[simp] lemma one_apply (x : E₁) : (1 : E₁ →ₚ₁[R] E₁) x = x := rfl + +@[simp] lemma mul_apply (f g : E₁ →ₚ₁[R] E₁) (x : E₁) : (f * g) x = f (g x) := rfl + +@[simp] +lemma map_smul_of_tower {S : Type*} [SMul S E₁] [SMul S E₂] + [LinearMap.CompatibleSMul E₁ E₂ S R] (f : E₁ →ₚ₁[R] E₂) (c : S) (x : E₁) : + f (c • x) = c • f x := LinearMapClass.map_smul_of_tower f _ _ + +@[aesop safe apply (rule_sets := [CStarAlgebra])] +protected lemma map_nonneg (f : E₁ →ₚ₁[R] E₂) {x : E₁} (hx : 0 ≤ x) : 0 ≤ f x := + map_nonneg f hx + +lemma toPositiveLinearMap_injective : + Function.Injective (toPositiveLinearMap : (E₁ →ₚ₁[R] E₂) → (E₁ →ₚ[R] E₂)) := + fun _ _ h ↦ by ext x; congrm($h x) + +/-- Unital positive linear maps are determined by their underlying linear maps. -/ +lemma toLinearMap_injective : + Function.Injective + (fun f : E₁ →ₚ₁[R] E₂ => f.toLinearMap) := by + intro f g h + ext x + exact congrArg (fun k : E₁ →ₗ[R] E₂ => k x) h + +@[simp] +lemma toPositiveLinearMap_inj {f g : E₁ →ₚ₁[R] E₂} : + f.toPositiveLinearMap = g.toPositiveLinearMap ↔ f = g := + toPositiveLinearMap_injective.eq_iff diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/Channel/MeasureAndPrepare.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Channel/MeasureAndPrepare.lean new file mode 100644 index 0000000000..9339c4a52d --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Channel/MeasureAndPrepare.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.Measurement.ClassicalSystem +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Channel.Basic + +/-! + +# Measure-and-prepare channels + +## i. Overview + +A channel `E₂ →ₚ₁[ℝ] E₁` (the Heisenberg picture of a Schrödinger channel `E₁ → E₂`) is +measure-and-prepare when it factors through a finite classical system: measure the input, then +prepare a (possibly different) output state for each outcome. Dually, this is exactly +`Φ = M.comp P` for a measurement `M : (ι → ℝ) →ₚ₁[ℝ] E₁` (`Measurement/ClassicalSystem.lean`) and +a "preparation" `P : E₂ →ₚ₁[ℝ] (ι → ℝ)` — itself a channel into the classical system, so a family +of states on `E₂` indexed by `ι`, bundled the same way `Measurement` bundles a family of effects. + +This is the abstract, order-unit-level version of an entanglement-breaking channel: the +factorization definition extends to any outcome type (not just finite ones) with no change, unlike +a hard-coded sum over a fixed outcome set. + +## ii. Key definitions + +- `UnitalPositiveLinearMap.IsMeasureAndPrepare` + +## iii. Table of contents + +- A. Factorization through a finite classical system + +-/ + +@[expose] public section + +variable {E₁ E₂ : Type*} + [AddCommGroup E₁] [PartialOrder E₁] [IsOrderedAddMonoid E₁] [Module ℝ E₁] [PosSMulMono ℝ E₁] + [One E₁] + [AddCommGroup E₂] [PartialOrder E₂] [IsOrderedAddMonoid E₂] [Module ℝ E₂] [PosSMulMono ℝ E₂] + [One E₂] + +namespace UnitalPositiveLinearMap + +/-! ## A. Factorization through a finite classical system -/ + +/-- A channel is measure-and-prepare when it factors through a finite classical system: measure, +then prepare a state for each outcome. This is the general-probabilistic-theory abstraction of an +entanglement-breaking channel. -/ +def IsMeasureAndPrepare (Φ : E₂ →ₚ₁[ℝ] E₁) : Prop := + ∃ (ι : Type) (_ : Fintype ι) (M : (ι → ℝ) →ₚ₁[ℝ] E₁) (P : E₂ →ₚ₁[ℝ] (ι → ℝ)), Φ = M.comp P + +end UnitalPositiveLinearMap diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/Channel/Normal.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Channel/Normal.lean new file mode 100644 index 0000000000..52c9347496 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Channel/Normal.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Channel.Basic + +/-! + +# Normal channels + +## i. Overview + +A channel is normal when it preserves suprema of directed sets: its value at a directed supremum +is the supremum of its values on the directed set. This is the extra continuity — beyond mere +positivity — needed to push a countably-additive effect-valued measure forward along a channel and +keep it countably additive (`Measurement/MeasurableOutcome.lean`); it plays the same role for +channels that `Weight.IsNormal` plays for weights. + +## ii. Key definitions and results + +- `UnitalPositiveLinearMap.IsNormal` +- `UnitalPositiveLinearMap.isNormal_id`, `UnitalPositiveLinearMap.IsNormal.comp` + +## iii. Table of contents + +- A. Normality +- B. Identity and composition + +-/ + +@[expose] public section + +variable {E₁ E₂ E₃ : Type*} + [AddCommGroup E₁] [PartialOrder E₁] [IsOrderedAddMonoid E₁] [Module ℝ E₁] [PosSMulMono ℝ E₁] + [One E₁] + [AddCommGroup E₂] [PartialOrder E₂] [IsOrderedAddMonoid E₂] [Module ℝ E₂] [PosSMulMono ℝ E₂] + [One E₂] + [AddCommGroup E₃] [PartialOrder E₃] [IsOrderedAddMonoid E₃] [Module ℝ E₃] [PosSMulMono ℝ E₃] + [One E₃] + +namespace PositiveLinearMap + +/-! ## A. Normal positive maps -/ + +/-- A positive linear map is normal when it preserves suprema of directed sets. Unital channels +and subunital operations are both special cases, so normality belongs here rather than being +duplicated for each operational wrapper. -/ +def IsNormal (φ : E₁ →ₚ[ℝ] E₂) : Prop := + ∀ (D : Set E₁) (x : E₁), D.Nonempty → DirectedOn (· ≤ ·) D → IsLUB D x → IsLUB (φ '' D) (φ x) + +omit [IsOrderedAddMonoid E₁] [PosSMulMono ℝ E₁] [One E₁] + [IsOrderedAddMonoid E₂] [PosSMulMono ℝ E₂] [One E₂] + [IsOrderedAddMonoid E₃] [PosSMulMono ℝ E₃] [One E₃] in +/-- Normality of positive linear maps is closed under composition. -/ +lemma IsNormal.comp {φ : E₁ →ₚ[ℝ] E₂} {ψ : E₂ →ₚ[ℝ] E₃} (hφ : φ.IsNormal) (hψ : ψ.IsNormal) : + (ψ.comp φ).IsNormal := fun D x hD hdirected hlub => by + have hφD : IsLUB (φ '' D) (φ x) := hφ D x hD hdirected hlub + have hdirectedφD : DirectedOn (· ≤ ·) (φ '' D) := + hdirected.mono_comp (fun _ _ hab => φ.monotone' hab) + have hφDnonempty : (φ '' D).Nonempty := hD.image φ + have himg := hψ (φ '' D) (φ x) hφDnonempty hdirectedφD hφD + rw [Set.image_image] at himg + exact himg + +end PositiveLinearMap + +namespace UnitalPositiveLinearMap + +/-! ## A. Normality -/ + +/-- A normal channel is simply a normal positive linear map which also preserves the order unit. +The abbreviation preserves the established channel-facing API while giving operations and +channels one canonical normality predicate. -/ +abbrev IsNormal (φ : E₁ →ₚ₁[ℝ] E₂) : Prop := φ.toPositiveLinearMap.IsNormal + +omit [IsOrderedAddMonoid E₁] [PosSMulMono ℝ E₁] in +/-- The identity channel is normal: the image of a directed set under it is itself. -/ +lemma isNormal_id : (UnitalPositiveLinearMap.id ℝ E₁).IsNormal := fun D x _ _ hlub => by + change IsLUB ((fun y : E₁ => y) '' D) x + simpa using hlub + +/-! ## B. Identity and composition -/ + +omit [IsOrderedAddMonoid E₁] [PosSMulMono ℝ E₁] [IsOrderedAddMonoid E₂] [PosSMulMono ℝ E₂] + [IsOrderedAddMonoid E₃] [PosSMulMono ℝ E₃] in +/-- Normality survives composition: normality is exactly the continuity needed to carry a +directed supremum through each stage of the composite. -/ +lemma IsNormal.comp {φ : E₁ →ₚ₁[ℝ] E₂} {ψ : E₂ →ₚ₁[ℝ] E₃} (hφ : φ.IsNormal) (hψ : ψ.IsNormal) : + (ψ.comp φ).IsNormal := + PositiveLinearMap.IsNormal.comp hφ hψ + +end UnitalPositiveLinearMap diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/Channel/Weight.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Channel/Weight.lean new file mode 100644 index 0000000000..073b96007c --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Channel/Weight.lean @@ -0,0 +1,118 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Weight.Basic +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Channel.Basic + +/-! + +# Weight pushforward along a channel + +## i. Overview + +A channel from system `A` to system `B` is, in the Schrödinger picture, an affine map on states. +Dualizing gives a unital positive linear map on effects in the other direction (the Heisenberg +picture): that map is already `UnitalPositiveLinearMap`, so a channel's adjoint needs no new +structure. What *is* new is pushing a weight forward along that adjoint, and the fact that a +state pushes forward to a state. + +Read `φ : E₂ →ₚ₁[ℝ] E₁` here as the adjoint of a channel `A → B` with effect algebras +`E₁ = E_A`, `E₂ = E_B`: it pulls an effect of `B` back to an effect of `A`. Precomposing a weight +on `A` with `φ` gives a weight on `B` — the Schrödinger-picture pushforward — and `Weight.comp_id`, +`Weight.comp_comp` show this assignment respects identities and composition, so pushforward is a +functor from unital positive linear maps to weights, contravariant in `φ`. + +## ii. Key definitions and results + +- `Weight.comp`, `Weight.IsFinite.comp`, `Weight.IsState.comp` + +## iii. Table of contents + +- A. Pushforward of weights +- B. Functoriality +- C. Preservation of finite weights and states + +-/ + +@[expose] public section + +open scoped ENNReal + +variable {E₁ E₂ E₃ : Type*} + [AddCommGroup E₁] [PartialOrder E₁] [IsOrderedAddMonoid E₁] [Module ℝ E₁] [PosSMulMono ℝ E₁] + [One E₁] + [AddCommGroup E₂] [PartialOrder E₂] [IsOrderedAddMonoid E₂] [Module ℝ E₂] [PosSMulMono ℝ E₂] + [One E₂] + [AddCommGroup E₃] [PartialOrder E₃] [IsOrderedAddMonoid E₃] [Module ℝ E₃] [PosSMulMono ℝ E₃] + [One E₃] + +namespace Weight + +/-! ## A. Pushforward of weights -/ + +/-- Precompose a weight on `E₁` with the adjoint `φ : E₂ →ₚ₁[ℝ] E₁` of a channel `E₁ → E₂`, +giving a weight on `E₂`: the Schrödinger-picture pushforward of `w` along the channel. -/ +noncomputable def comp (w : Weight E₁) (φ : E₂ →ₚ₁[ℝ] E₁) : Weight E₂ where + toFun y := w ⟨φ (y : E₂), φ.map_nonneg y.2⟩ + map_add' x y := by + have hxy : (⟨φ ((x + y : PosCone E₂) : E₂), φ.map_nonneg (x + y).2⟩ : PosCone E₁) = + ⟨φ (x : E₂), φ.map_nonneg x.2⟩ + ⟨φ (y : E₂), φ.map_nonneg y.2⟩ := by + apply Subtype.ext + show φ ((x : E₂) + (y : E₂)) = φ (x : E₂) + φ (y : E₂) + exact _root_.map_add φ _ _ + show w ⟨φ ((x + y : PosCone E₂) : E₂), _⟩ = _ + rw [hxy, w.map_add] + map_smul' c y := by + have hy : (⟨φ ((c • y : PosCone E₂) : E₂), φ.map_nonneg (c • y).2⟩ : PosCone E₁) = + c • (⟨φ (y : E₂), φ.map_nonneg y.2⟩ : PosCone E₁) := by + apply Subtype.ext + show φ ((c : ℝ) • (y : E₂)) = (c : ℝ) • φ (y : E₂) + exact _root_.map_smul φ (c : ℝ) (y : E₂) + show w ⟨φ ((c • y : PosCone E₂) : E₂), _⟩ = _ + rw [hy, w.map_smul] + rfl + +@[simp] +lemma comp_apply (w : Weight E₁) (φ : E₂ →ₚ₁[ℝ] E₁) (y : PosCone E₂) : + w.comp φ y = w ⟨φ (y : E₂), φ.map_nonneg y.2⟩ := rfl + +/-! ## B. Functoriality -/ + +@[simp] +lemma comp_id (w : Weight E₁) : w.comp (.id ℝ E₁) = w := by + ext y + simp + +lemma comp_comp (w : Weight E₁) (φ : E₂ →ₚ₁[ℝ] E₁) (ψ : E₃ →ₚ₁[ℝ] E₂) : + w.comp (φ.comp ψ) = (w.comp φ).comp ψ := by + ext y + simp + +/-! ## C. Preservation of finite weights and states -/ + +/-- Pushing a finite weight forward along a channel's adjoint stays finite: `φ` never sends the +cone anywhere `w` is infinite. -/ +lemma IsFinite.comp {w : Weight E₁} (hw : w.IsFinite) (φ : E₂ →ₚ₁[ℝ] E₁) : + (w.comp φ).IsFinite := + fun _ => hw _ + +variable [IsOrderUnit E₁] [IsOrderUnit E₂] + +/-- Pushing a state forward along a channel's adjoint gives a state: finiteness survives +(`IsFinite.comp`) and normalization survives because the adjoint is unital. -/ +lemma IsState.comp {w : Weight E₁} (hw : w.IsState) (φ : E₂ →ₚ₁[ℝ] E₁) : + (w.comp φ).IsState where + finite := hw.finite.comp φ + normalized := by + show w ⟨φ (1 : E₂), φ.map_nonneg IsOrderUnit.one_nonneg⟩ = 1 + have h1 : (⟨φ (1 : E₂), φ.map_nonneg IsOrderUnit.one_nonneg⟩ : PosCone E₁) = Weight.unit := by + apply Subtype.ext + show φ (1 : E₂) = 1 + exact map_one φ + rw [h1, hw.normalized] + +end Weight diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/Composite.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Composite.lean new file mode 100644 index 0000000000..c0dc10db1c --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Composite.lean @@ -0,0 +1,289 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Mathlib.Geometry.Convex.Cone.TensorProduct +public import Mathlib.Algebra.Order.Module.PositiveLinearMap +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Basic + +/-! +# Composite order-unit systems + +## i. Overview + +The underlying vector space of a composite of systems `E₁` and `E₂` is the algebraic tensor +product `E₁ ⊗[ℝ] E₂`. Its order is extra structure: in general, the orders on the factors do not +determine a unique positive cone on the tensor product. + +Mathlib supplies the two canonical extremal choices. The **minimal tensor cone** is generated by +positive elementary tensors. The **maximal tensor cone** consists of the tensors on which every +pair of positive linear functionals takes a nonnegative value. Every compatible tensor cone lies +between these two. + +`TensorCone E₁ E₂` bundles precisely such an intermediate choice. This makes it possible to state +results for an unspecified composite model, while `TensorCone.minimal` and `TensorCone.maximal` +recover the two extremal models. The construction uses Mathlib's `PointedCone` API throughout; +despite its name, a `PointedCone` here means a cone containing zero, bundled as an `ℝ≥0`-submodule. + +## ii. Key definitions and results + +- `minTensorCone E₁ E₂`: the cone generated by positive elementary tensors. +- `maxTensorCone E₁ E₂`: the dual-defined maximal tensor cone. +- `TensorCone E₁ E₂`: a choice of cone between `minTensorCone` and `maxTensorCone`. +- `TensorCone.tmul_mem`: every compatible tensor cone contains positive elementary tensors. +- `TensorCone.tmulRight`, `TensorCone.tmulLeft`: the canonical positive tensor embeddings. +- `exists_eq_sub_minTensorCone`: the minimal tensor cone is reproducing when both factors have + order units. + +## iii. Table of contents + +- A. The extremal tensor cones +- B. Compatible intermediate tensor cones +- C. Positive elementary tensors +- D. Canonical tensor embeddings +- E. The minimal tensor cone is reproducing + +-/ + +@[expose] public section + +open scoped NNReal TensorProduct + +variable (E₁ E₂ : Type*) + [AddCommGroup E₁] [PartialOrder E₁] [IsOrderedAddMonoid E₁] [Module ℝ E₁] [PosSMulMono ℝ E₁] + [AddCommGroup E₂] [PartialOrder E₂] [IsOrderedAddMonoid E₂] [Module ℝ E₂] [PosSMulMono ℝ E₂] + +/-! + +## A. The extremal tensor cones +-/ + +/-- The minimal tensor cone of two ordered real vector spaces: the cone generated by elementary +tensors `x ⊗ₜ y` with `0 ≤ x` and `0 ≤ y`. -/ +noncomputable def minTensorCone : PointedCone ℝ (E₁ ⊗[ℝ] E₂) := + PointedCone.minTensorProduct (PointedCone.positive ℝ E₁) (PointedCone.positive ℝ E₂) + +/-- The maximal tensor cone of two ordered real vector spaces: the tensors pairing nonnegatively +with every elementary tensor of positive linear functionals. -/ +noncomputable def maxTensorCone : PointedCone ℝ (E₁ ⊗[ℝ] E₂) := + PointedCone.maxTensorProduct (PointedCone.positive ℝ E₁) (PointedCone.positive ℝ E₂) + +/-- The minimal tensor cone is contained in the maximal tensor cone. -/ +lemma minTensorCone_le_maxTensorCone : minTensorCone E₁ E₂ ≤ maxTensorCone E₁ E₂ := + PointedCone.minTensorProduct_le_maxTensorProduct _ _ + +/-! + +## B. Compatible intermediate tensor cones +-/ + +/-- A compatible positive cone for a composite system: a tensor cone containing the minimal +tensor cone and contained in the maximal tensor cone. + +The two inequalities express the usual compatibility conditions. The lower bound makes every +positive elementary tensor positive in the composite. The upper bound says that every pair of +positive functionals on the factors remains positive on the composite. -/ +structure TensorCone where + /-- The chosen positive cone on the tensor-product vector space. -/ + toPointedCone : PointedCone ℝ (E₁ ⊗[ℝ] E₂) + /-- Every positive elementary tensor belongs to the chosen cone. -/ + min_le : minTensorCone E₁ E₂ ≤ toPointedCone + /-- Every element of the chosen cone is positive against product positive functionals. -/ + le_max : toPointedCone ≤ maxTensorCone E₁ E₂ + +namespace TensorCone + +instance : Coe (TensorCone E₁ E₂) (PointedCone ℝ (E₁ ⊗[ℝ] E₂)) := ⟨toPointedCone⟩ + +/-- A pair of positive functionals evaluates nonnegatively on every element of a compatible +composite cone. This is the defining operational content of the maximal tensor bound. -/ +lemma productFunctional_nonneg (C : TensorCone E₁ E₂) (φ : PositiveLinearMap ℝ E₁ ℝ) + (ψ : PositiveLinearMap ℝ E₂ ℝ) + {z : E₁ ⊗[ℝ] E₂} (hz : z ∈ C.toPointedCone) : + 0 ≤ TensorProduct.dualDistrib ℝ E₁ E₂ (φ.toLinearMap ⊗ₜ[ℝ] ψ.toLinearMap) z := by + have hzmax : z ∈ maxTensorCone E₁ E₂ := C.le_max hz + change z ∈ PointedCone.maxTensorProduct (PointedCone.positive ℝ E₁) + (PointedCone.positive ℝ E₂) at hzmax + rw [PointedCone.mem_maxTensorProduct] at hzmax + exact hzmax φ.toLinearMap (fun x hx => φ.map_nonneg hx) + ψ.toLinearMap (fun y hy => ψ.map_nonneg hy) + +variable {F₁ F₂ : Type*} + [AddCommGroup F₁] [PartialOrder F₁] [IsOrderedAddMonoid F₁] [Module ℝ F₁] + [PosSMulMono ℝ F₁] + [AddCommGroup F₂] [PartialOrder F₂] [IsOrderedAddMonoid F₂] [Module ℝ F₂] + [PosSMulMono ℝ F₂] + +/-- The image of the positive cone under a positive linear map remains in the positive cone. -/ +lemma positiveCone_map_le (φ : PositiveLinearMap ℝ E₁ F₁) : + (PointedCone.positive ℝ E₁).map φ.toLinearMap ≤ PointedCone.positive ℝ F₁ := by + rintro _ ⟨x, hx, rfl⟩ + exact φ.map_nonneg hx + +/-- Tensor products of positive maps preserve the minimal tensor cone. -/ +lemma minTensorCone_map_le (φ : PositiveLinearMap ℝ E₁ F₁) + (ψ : PositiveLinearMap ℝ E₂ F₂) : + (minTensorCone E₁ E₂).map (TensorProduct.map φ.toLinearMap ψ.toLinearMap) ≤ + minTensorCone F₁ F₂ := + (PointedCone.minTensorProduct_map_le φ.toLinearMap ψ.toLinearMap _ _).trans + (PointedCone.minTensorProduct_mono + (positiveCone_map_le (E₁ := E₁) (F₁ := F₁) φ) + (positiveCone_map_le (E₁ := E₂) (F₁ := F₂) ψ)) + +/-- Tensor products of positive maps preserve the maximal tensor cone. -/ +lemma maxTensorCone_map_le (φ : PositiveLinearMap ℝ E₁ F₁) + (ψ : PositiveLinearMap ℝ E₂ F₂) : + (maxTensorCone E₁ E₂).map (TensorProduct.map φ.toLinearMap ψ.toLinearMap) ≤ + maxTensorCone F₁ F₂ := + (PointedCone.maxTensorProduct_map_le φ.toLinearMap ψ.toLinearMap _ _).trans + (PointedCone.maxTensorProduct_mono + (positiveCone_map_le (E₁ := E₁) (F₁ := F₁) φ) + (positiveCone_map_le (E₁ := E₂) (F₁ := F₂) ψ)) + +/-- The elements of a compatible tensor cone form an `ℝ≥0`-module. This bridges Mathlib's +generic nonnegative-scalar subtype with `NNReal`, which this order-unit API uses throughout. -/ +instance instModuleNNReal (C : TensorCone E₁ E₂) : Module ℝ≥0 C.toPointedCone where + smul c x := ⟨(c : ℝ) • (x : E₁ ⊗[ℝ] E₂), C.toPointedCone.smul_mem c.2 x.2⟩ + one_smul _ := Subtype.ext (one_smul ℝ _) + mul_smul c d _ := Subtype.ext (mul_smul (c : ℝ) (d : ℝ) _) + smul_zero _ := Subtype.ext (smul_zero _) + smul_add c _ _ := Subtype.ext (smul_add (c : ℝ) _ _) + add_smul c d _ := Subtype.ext (by push_cast; exact add_smul (c : ℝ) (d : ℝ) _) + zero_smul _ := Subtype.ext (by push_cast; exact zero_smul ℝ _) + +@[ext] +lemma ext {C D : TensorCone E₁ E₂} (h : C.toPointedCone = D.toPointedCone) : C = D := by + cases C + cases D + simp_all + +/-- Compatible tensor cones are ordered by inclusion of their underlying cones. -/ +instance instPartialOrder : PartialOrder (TensorCone E₁ E₂) where + le C D := C.toPointedCone ≤ D.toPointedCone + le_refl _ := le_rfl + le_trans _ _ _ := le_trans + le_antisymm C D hCD hDC := TensorCone.ext (E₁ := E₁) (E₂ := E₂) (le_antisymm hCD hDC) + +/-- The minimal compatible tensor cone. -/ +noncomputable def minimal : TensorCone E₁ E₂ where + toPointedCone := minTensorCone E₁ E₂ + min_le := le_rfl + le_max := minTensorCone_le_maxTensorCone E₁ E₂ + +/-- The maximal compatible tensor cone. -/ +noncomputable def maximal : TensorCone E₁ E₂ where + toPointedCone := maxTensorCone E₁ E₂ + min_le := minTensorCone_le_maxTensorCone E₁ E₂ + le_max := le_rfl + +@[simp] +lemma minimal_toPointedCone : (minimal E₁ E₂).toPointedCone = minTensorCone E₁ E₂ := rfl + +@[simp] +lemma maximal_toPointedCone : (maximal E₁ E₂).toPointedCone = maxTensorCone E₁ E₂ := rfl + +@[simp] +lemma minimal_le (C : TensorCone E₁ E₂) : minimal E₁ E₂ ≤ C := C.min_le + +@[simp] +lemma le_maximal (C : TensorCone E₁ E₂) : C ≤ maximal E₁ E₂ := C.le_max + +/-! + +## C. Positive elementary tensors +-/ + +/-- A tensor of positive elements belongs to the minimal tensor cone. -/ +lemma tmul_mem_minimal {x : E₁} {y : E₂} (hx : 0 ≤ x) (hy : 0 ≤ y) : + x ⊗ₜ[ℝ] y ∈ minTensorCone E₁ E₂ := + PointedCone.tmul_mem_minTensorProduct + (by simpa only [PointedCone.mem_positive] using hx) + (by simpa only [PointedCone.mem_positive] using hy) + +/-- Every compatible tensor cone contains every tensor of positive elements. -/ +lemma tmul_mem (C : TensorCone E₁ E₂) {x : E₁} {y : E₂} (hx : 0 ≤ x) (hy : 0 ≤ y) : + x ⊗ₜ[ℝ] y ∈ C.toPointedCone := + C.min_le (tmul_mem_minimal E₁ E₂ hx hy) + +/-! + +## D. Canonical tensor embeddings +-/ + +variable {E₁ E₂} + +/-- For fixed `0 ≤ y₀`, tensoring on the right with `y₀` maps the positive cone of `E₁` +`ℝ≥0`-linearly into any compatible tensor cone. -/ +def tmulRight (C : TensorCone E₁ E₂) {y₀ : E₂} (hy₀ : 0 ≤ y₀) : + PosCone E₁ →ₗ[ℝ≥0] C.toPointedCone where + toFun x := ⟨(x : E₁) ⊗ₜ[ℝ] y₀, tmul_mem E₁ E₂ C x.2 hy₀⟩ + map_add' x y := by + apply Subtype.ext + exact TensorProduct.add_tmul _ _ _ + map_smul' c x := by + apply Subtype.ext + exact (TensorProduct.smul_tmul' (c : ℝ) (x : E₁) y₀).symm + +@[simp] +lemma tmulRight_apply (C : TensorCone E₁ E₂) {y₀ : E₂} (hy₀ : 0 ≤ y₀) (x : PosCone E₁) : + (C.tmulRight hy₀ x : E₁ ⊗[ℝ] E₂) = (x : E₁) ⊗ₜ[ℝ] y₀ := rfl + +/-- For fixed `0 ≤ x₀`, tensoring on the left with `x₀` maps the positive cone of `E₂` +`ℝ≥0`-linearly into any compatible tensor cone. -/ +def tmulLeft (C : TensorCone E₁ E₂) {x₀ : E₁} (hx₀ : 0 ≤ x₀) : + PosCone E₂ →ₗ[ℝ≥0] C.toPointedCone where + toFun y := ⟨x₀ ⊗ₜ[ℝ] (y : E₂), tmul_mem E₁ E₂ C hx₀ y.2⟩ + map_add' x y := by + apply Subtype.ext + exact TensorProduct.tmul_add _ _ _ + map_smul' c y := by + apply Subtype.ext + exact TensorProduct.tmul_smul _ _ _ + +@[simp] +lemma tmulLeft_apply (C : TensorCone E₁ E₂) {x₀ : E₁} (hx₀ : 0 ≤ x₀) (y : PosCone E₂) : + (C.tmulLeft hx₀ y : E₁ ⊗[ℝ] E₂) = x₀ ⊗ₜ[ℝ] (y : E₂) := rfl + +end TensorCone + +/-! + +## E. The minimal tensor cone is reproducing + +An order unit makes each factor's positive cone reproducing: every vector is a difference of two +positive vectors. Expanding both factors of an elementary tensor then shows that the minimal +tensor cone is reproducing as well. No multiplication, star operation, or C⋆-algebraic Jordan +decomposition is needed. +-/ + +variable {E₁ E₂} [One E₁] [IsOrderUnit E₁] [One E₂] [IsOrderUnit E₂] + +/-- Every element of the tensor product is a difference of two elements of the minimal tensor +cone when both factors have order units. -/ +lemma exists_eq_sub_minTensorCone (t : E₁ ⊗[ℝ] E₂) : + ∃ tp tn : minTensorCone E₁ E₂, + t = (tp : E₁ ⊗[ℝ] E₂) - (tn : E₁ ⊗[ℝ] E₂) := by + induction t using TensorProduct.induction_on with + | zero => exact ⟨0, 0, by simp⟩ + | tmul x y => + obtain ⟨xp, xn, hxp, hxn, hx⟩ := IsOrderUnit.exists_eq_sub_nonneg x + obtain ⟨yp, yn, hyp, hyn, hy⟩ := IsOrderUnit.exists_eq_sub_nonneg y + refine ⟨⟨xp ⊗ₜ[ℝ] yp + xn ⊗ₜ[ℝ] yn, + add_mem (TensorCone.tmul_mem_minimal E₁ E₂ hxp hyp) + (TensorCone.tmul_mem_minimal E₁ E₂ hxn hyn)⟩, + ⟨xp ⊗ₜ[ℝ] yn + xn ⊗ₜ[ℝ] yp, + add_mem (TensorCone.tmul_mem_minimal E₁ E₂ hxp hyn) + (TensorCone.tmul_mem_minimal E₁ E₂ hxn hyp)⟩, ?_⟩ + rw [hx, hy] + simp only [TensorProduct.sub_tmul, TensorProduct.tmul_sub] + abel + | add t₁ t₂ h₁ h₂ => + obtain ⟨ap, an, ha⟩ := h₁ + obtain ⟨bp, bn, hb⟩ := h₂ + refine ⟨ap + bp, an + bn, ?_⟩ + change t₁ + t₂ = ((ap : E₁ ⊗[ℝ] E₂) + bp) - ((an : E₁ ⊗[ℝ] E₂) + bn) + rw [ha, hb] + abel diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/Effect/Basic.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Effect/Basic.lean new file mode 100644 index 0000000000..fb45a21bd8 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Effect/Basic.lean @@ -0,0 +1,357 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Weight.Basic +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Channel.Basic +public import Mathlib.Analysis.Convex.Extreme +public import Mathlib.Topology.UnitInterval + +/-! + +# Effects + +## i. Overview + +An effect is a bounded element of `E`: `0 ≤ e ≤ 1`, a possible outcome of a yes/no measurement. + +Effects are also closed under mixing: a probabilistic combination of two effects is again an +effect (`Effect.convex`, `Effect.mix`) — the same fact as `Set.Icc` being convex. + +## ii. Key definitions and results + +- `Effect E` +- `Effect.complement` +- `Effect.Orthogonal`, `Effect.addOfOrthogonal` +- `Effect.mix` : a probabilistic mixture of two effects, again an effect. +- `Effect.IsSharp` : extremality in the effect interval. + +## iii. Table of contents + +- A. Effects and complements +- B. Partial addition +- C. Convex mixtures +- D. Sharp effects +- E. Pairing effects with weights +- F. Channels acting on effects + +-/ + +@[expose] public section + +variable {E : Type*} [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] [One E] + +/-- An effect: a bounded element of `E`. -/ +abbrev Effect (E : Type*) [AddCommGroup E] [PartialOrder E] [One E] := Set.Icc (0 : E) 1 + +namespace Effect + +/-! ## A. Effects and complements -/ + +/-- Regard an effect as an element of the positive cone, forgetting the upper bound. -/ +def toPosCone (e : Effect E) : PosCone E := ⟨e.1, e.2.1⟩ + +omit [IsOrderedAddMonoid E] in +@[simp] lemma coe_toPosCone (e : Effect E) : ((toPosCone e) : E) = e.1 := rfl + +/-- The complementary effect `1 - e`. -/ +def complement (e : Effect E) : Effect E := + ⟨1 - e.1, sub_nonneg.mpr e.2.2, sub_le_self 1 e.2.1⟩ + +@[simp] +lemma complement_complement (e : Effect E) : complement (complement e) = e := by + apply Subtype.ext + simp [complement] + +variable [IsOrderUnit E] + +instance : Zero (Effect E) := ⟨0, le_refl 0, IsOrderUnit.one_nonneg⟩ +instance : One (Effect E) := ⟨1, IsOrderUnit.one_nonneg, le_refl 1⟩ + +omit [IsOrderedAddMonoid E] in +@[simp] lemma coe_zero : ((0 : Effect E) : E) = 0 := rfl + +omit [IsOrderedAddMonoid E] in +@[simp] lemma coe_one : ((1 : Effect E) : E) = 1 := rfl + +@[simp] lemma complement_zero : complement (0 : Effect E) = 1 := by + apply Subtype.ext; simp [complement] + +@[simp] lemma complement_one : complement (1 : Effect E) = 0 := by + apply Subtype.ext; simp [complement] + +/-! ## B. Partial addition -/ + +/-- Two effects are orthogonal when their sum is still bounded by the order unit. This is the +domain of the partial addition operation of the effect algebra `[0, 1]`. -/ +def Orthogonal (e f : Effect E) : Prop := (e : E) + (f : E) ≤ 1 + +/-- The partial sum of two orthogonal effects. -/ +def addOfOrthogonal (e f : Effect E) (h : Orthogonal e f) : Effect E := + ⟨(e : E) + (f : E), add_nonneg e.2.1 f.2.1, h⟩ + +omit [IsOrderUnit E] in +@[simp] +lemma coe_addOfOrthogonal (e f : Effect E) (h : Orthogonal e f) : + (addOfOrthogonal e f h : E) = (e : E) + (f : E) := rfl + +omit [IsOrderedAddMonoid E] [IsOrderUnit E] in +lemma orthogonal_comm {e f : Effect E} : Orthogonal e f ↔ Orthogonal f e := by + simp only [Orthogonal, add_comm] + +omit [IsOrderedAddMonoid E] in +lemma orthogonal_zero_left (e : Effect E) : Orthogonal 0 e := by + simpa [Orthogonal] using e.2.2 + +omit [IsOrderedAddMonoid E] in +lemma orthogonal_zero_right (e : Effect E) : Orthogonal e 0 := + orthogonal_comm.mpr (orthogonal_zero_left e) + +omit [IsOrderUnit E] in +lemma orthogonal_complement (e : Effect E) : Orthogonal e (complement e) := by + simp [Orthogonal, complement] + +@[simp] +lemma addOfOrthogonal_zero_left (e : Effect E) : + addOfOrthogonal 0 e (orthogonal_zero_left e) = e := by + ext + simp + +@[simp] +lemma addOfOrthogonal_zero_right (e : Effect E) : + addOfOrthogonal e 0 (orthogonal_zero_right e) = e := by + ext + simp + +@[simp] +lemma addOfOrthogonal_complement (e : Effect E) : + addOfOrthogonal e (complement e) (orthogonal_complement e) = 1 := by + ext + simp [complement] + +omit [IsOrderUnit E] in +/-- Partial addition of effects is commutative whenever it is defined. -/ +lemma addOfOrthogonal_comm (e f : Effect E) (h : Orthogonal e f) : + addOfOrthogonal e f h = addOfOrthogonal f e (orthogonal_comm.mp h) := by + ext + exact add_comm _ _ + +omit [IsOrderUnit E] in +/-- If `(e ⊕ f) ⊕ g` is defined, then so is `f ⊕ g`. -/ +lemma orthogonal_right_of_addOfOrthogonal_left (e f g : Effect E) (hef : Orthogonal e f) + (hefg : Orthogonal (addOfOrthogonal e f hef) g) : Orthogonal f g := by + show (f : E) + (g : E) ≤ 1 + calc + (f : E) + (g : E) ≤ (e : E) + ((f : E) + (g : E)) := le_add_of_nonneg_left e.2.1 + _ = ((e : E) + (f : E)) + (g : E) := by abel + _ ≤ 1 := hefg + +omit [IsOrderUnit E] in +/-- If `(e ⊕ f) ⊕ g` is defined, then the reassociated sum `e ⊕ (f ⊕ g)` is defined. -/ +lemma orthogonal_addOfOrthogonal_right (e f g : Effect E) (hef : Orthogonal e f) + (hefg : Orthogonal (addOfOrthogonal e f hef) g) : + Orthogonal e + (addOfOrthogonal f g (orthogonal_right_of_addOfOrthogonal_left e f g hef hefg)) := by + simpa [Orthogonal, add_assoc] using hefg + +omit [IsOrderUnit E] in +/-- Associativity of the partial effect sum, including the proof that the reassociated sum is +defined. -/ +lemma addOfOrthogonal_assoc (e f g : Effect E) (hef : Orthogonal e f) + (hefg : Orthogonal (addOfOrthogonal e f hef) g) : + addOfOrthogonal (addOfOrthogonal e f hef) g hefg = + addOfOrthogonal e + (addOfOrthogonal f g (orthogonal_right_of_addOfOrthogonal_left e f g hef hefg)) + (orthogonal_addOfOrthogonal_right e f g hef hefg) := by + ext + simp only [coe_addOfOrthogonal] + exact add_assoc _ _ _ + +omit [IsOrderUnit E] in +/-- Cancellation for partial effect addition. -/ +lemma addOfOrthogonal_left_cancel {e f g : Effect E} {hef : Orthogonal e f} + {heg : Orthogonal e g} (h : addOfOrthogonal e f hef = addOfOrthogonal e g heg) : f = g := by + apply Subtype.ext + apply add_left_cancel (a := (e : E)) + exact congrArg Subtype.val h + +/-- An orthogonal partner summing with `e` to `1` is necessarily the complement of `e`. -/ +lemma eq_complement_of_addOfOrthogonal_eq_one {e f : Effect E} (horth : Orthogonal e f) + (hsum : addOfOrthogonal e f horth = 1) : f = complement e := by + apply Subtype.ext + have hval : (e : E) + (f : E) = 1 := congrArg Subtype.val hsum + change (f : E) = 1 - (e : E) + rw [← hval] + abel + +/-- The residual effect `f - e`, defined whenever `e ≤ f`. -/ +def subEffect (f e : Effect E) (h : e ≤ f) : Effect E := + ⟨(f : E) - (e : E), sub_nonneg.mpr h, sub_le_self (f : E) e.2.1 |>.trans f.2.2⟩ + +omit [IsOrderUnit E] in +@[simp] +lemma coe_subEffect (f e : Effect E) (h : e ≤ f) : + (subEffect f e h : E) = (f : E) - (e : E) := rfl + +omit [IsOrderUnit E] in +/-- An effect is orthogonal to the residual left after subtracting it from a larger effect. -/ +lemma orthogonal_subEffect (f e : Effect E) (h : e ≤ f) : Orthogonal e (subEffect f e h) := by + show (e : E) + ((f : E) - (e : E)) ≤ 1 + simpa [add_sub_cancel_left] using f.2.2 + +omit [IsOrderUnit E] in +/-- Adding an effect to its residual recovers the original larger effect. -/ +@[simp] +lemma addOfOrthogonal_subEffect (f e : Effect E) (h : e ≤ f) : + addOfOrthogonal e (subEffect f e h) (orthogonal_subEffect f e h) = f := by + ext + simp + +variable [Module ℝ E] [PosSMulMono ℝ E] + +/-! ## C. Convex mixtures -/ + +omit [IsOrderUnit E] in +/-- Effects are closed under probabilistic mixing: mixing two possible outcomes gives another +possible outcome. This is the same convexity that makes states convex (`States/Convex.lean`): +preparations (states) and measurement outcomes (effects) pair via the abstract Born rule +`(ω, e) ↦ ω(e) ∈ [0, 1]`, and both sides of that pairing are convex sets, so both have a notion of +extreme point — extreme states are pure states, extreme effects are sharp (`IsSharp`). -/ +lemma convex : Convex ℝ (Effect E : Set E) := convex_Icc 0 1 + +/-- The mixture of two effects, choosing the first with probability `t`. -/ +def mix (e₁ e₂ : Effect E) (t : unitInterval) : Effect E := + ⟨(t : ℝ) • (e₁ : E) + (1 - (t : ℝ)) • (e₂ : E), + convex e₁.2 e₂.2 t.2.1 (sub_nonneg.mpr t.2.2) (by ring)⟩ + +omit [IsOrderUnit E] in +@[simp] +lemma coe_mix (e₁ e₂ : Effect E) (t : unitInterval) : + (mix e₁ e₂ t : E) = (t : ℝ) • (e₁ : E) + (1 - (t : ℝ)) • (e₂ : E) := rfl + +omit [IsOrderUnit E] in +@[simp] lemma mix_zero (e₁ e₂ : Effect E) : mix e₁ e₂ 0 = e₂ := by apply Subtype.ext; simp + +omit [IsOrderUnit E] in +@[simp] lemma mix_one (e₁ e₂ : Effect E) : mix e₁ e₂ 1 = e₁ := by apply Subtype.ext; simp + +omit [One E] [IsOrderUnit E] [Module ℝ E] [PosSMulMono ℝ E] in +/-- A nonnegative vector that adds with another nonnegative vector to `0` is itself `0`: the +positive cone of an ordered vector space meets its negation only at `0`. Not specific to effects, +but stated here for lack of a better shared home; reused e.g. by `StarAlgebra/SharpEffect.lean`. -/ +lemma nonneg_add_eq_zero {a b : E} (ha : 0 ≤ a) (hb : 0 ≤ b) (hab : a + b = 0) : a = 0 := + le_antisymm (hab ▸ le_add_of_nonneg_right hb) ha + +/-! ## D. Sharp effects -/ + +/-- An effect is sharp when it is an extreme point of the effect interval `[0, 1]`: it cannot be +written as a nontrivial mixture of two distinct effects. Sharp effects generalize projections: in +a C⋆-algebra, `e` is sharp iff `e ^ 2 = e = star e`, i.e. `e` is a genuine projection +(`StarAlgebra/SharpEffect.lean`); a sharp measurable-outcome measurement is a PVM. -/ +def IsSharp (e : Effect E) : Prop := (e : E) ∈ Set.extremePoints ℝ (Set.Icc (0 : E) 1) + +/-- The impossible outcome is sharp: `0 = a • x₁ + b • x₂` with `x₁, x₂ ∈ [0, 1]` and `a, b > 0` +forces `x₁ = 0`, since `a • x₁` and `b • x₂` are nonnegative terms summing to `0`. -/ +lemma isSharp_zero : IsSharp (0 : Effect E) := by + refine ⟨⟨le_refl 0, IsOrderUnit.one_nonneg⟩, fun x₁ hx₁ _ hx₂ ⟨a, b, ha, hb, _, hz⟩ => ?_⟩ + have hax : a • x₁ = 0 := + nonneg_add_eq_zero (smul_nonneg ha.le hx₁.1) (smul_nonneg hb.le hx₂.1) (by simpa using hz) + have := congrArg (a⁻¹ • ·) hax + rwa [inv_smul_smul₀ ha.ne', smul_zero] at this + +omit [IsOrderUnit E] [PosSMulMono ℝ E] in +/-- Sharpness is preserved by taking the complement: `e ↦ 1 - e` is an affine involution of the +effect interval, so it carries the open segment through `x₁, x₂` to the open segment through +`1 - x₁, 1 - x₂`, transporting extremality of `e` to extremality of `complement e`. -/ +lemma isSharp_complement {e : Effect E} (h : IsSharp e) : IsSharp (complement e) := by + refine ⟨(complement e).2, fun x₁ hx₁ x₂ hx₂ ⟨a, b, ha, hb, hab, hz⟩ => ?_⟩ + have hone : a • (1 : E) + b • (1 : E) = 1 := by rw [← add_smul, hab, one_smul] + have key : a • (1 - x₁) + b • (1 - x₂) = (e : E) := by + have hsplit : a • (1 - x₁) + b • (1 - x₂) = + (a • (1 : E) + b • (1 : E)) - (a • x₁ + b • x₂) := by + simp only [smul_sub]; abel + rw [hsplit, hone, hz] + show (1 : E) - (1 - (e : E)) = (e : E) + abel + have x1eq := (mem_extremePoints_iff_left.mp h).2 (1 - x₁) + ⟨sub_nonneg.mpr hx₁.2, sub_le_self 1 hx₁.1⟩ (1 - x₂) + ⟨sub_nonneg.mpr hx₂.2, sub_le_self 1 hx₂.1⟩ ⟨a, b, ha, hb, hab, key⟩ + have hsum : x₁ + (e : E) = 1 := by rw [← x1eq]; abel + exact eq_sub_of_add_eq hsum + +omit [IsOrderUnit E] [PosSMulMono ℝ E] in +/-- Sharpness is preserved by taking the complement, in either direction: `isSharp_complement` +applied twice, using `complement_complement` to undo the second application. -/ +lemma isSharp_complement_iff {e : Effect E} : IsSharp (complement e) ↔ IsSharp e := + ⟨fun h => complement_complement e ▸ isSharp_complement h, isSharp_complement⟩ + +/-- The certain outcome is sharp: the complement of the (sharp) impossible outcome. -/ +lemma isSharp_one : IsSharp (1 : Effect E) := + complement_zero (E := E) ▸ isSharp_complement isSharp_zero + +end Effect + +namespace Weight + +/-! ## E. Pairing effects with weights -/ + +variable [Module ℝ E] [PosSMulMono ℝ E] [IsOrderUnit E] + + +/-- Pairing a weight with an effect is bounded by the weight of the order unit. -/ +lemma pairing_le_unit (w : Weight E) (e : Effect E) : w (Effect.toPosCone e) ≤ w unit := + w.mono e.2.2 + +/-- A weight finite at the order unit pairs finitely with every effect. -/ +lemma pairing_ne_top (w : Weight E) (hw : w unit ≠ ⊤) (e : Effect E) : + w (Effect.toPosCone e) ≠ ⊤ := + ne_top_of_le_ne_top hw (w.pairing_le_unit e) + +end Weight + +namespace UnitalPositiveLinearMap + +/-! ## F. Channels acting on effects -/ + +variable {E₁ E₂ : Type*} + [AddCommGroup E₁] [PartialOrder E₁] [IsOrderedAddMonoid E₁] [Module ℝ E₁] [One E₁] + [AddCommGroup E₂] [PartialOrder E₂] [IsOrderedAddMonoid E₂] [Module ℝ E₂] [One E₂] + [IsOrderUnit E₁] [IsOrderUnit E₂] + +/-- A channel sends an effect to an effect: positivity preserves the lower bound, while +monotonicity and unitality preserve the upper bound. -/ +def mapEffect (φ : E₁ →ₚ₁[ℝ] E₂) (e : Effect E₁) : Effect E₂ := + ⟨φ (e : E₁), φ.map_nonneg e.2.1, (φ.monotone' e.2.2).trans_eq (map_one φ)⟩ + +omit [IsOrderedAddMonoid E₁] [IsOrderedAddMonoid E₂] [IsOrderUnit E₁] [IsOrderUnit E₂] in +@[simp] +lemma coe_mapEffect (φ : E₁ →ₚ₁[ℝ] E₂) (e : Effect E₁) : + (φ.mapEffect e : E₂) = φ (e : E₁) := rfl + +omit [IsOrderUnit E₁] [IsOrderUnit E₂] in +@[simp] +lemma mapEffect_complement (φ : E₁ →ₚ₁[ℝ] E₂) (e : Effect E₁) : + φ.mapEffect (Effect.complement e) = Effect.complement (φ.mapEffect e) := by + ext + simp [mapEffect, Effect.complement] + +omit [IsOrderedAddMonoid E₁] [IsOrderedAddMonoid E₂] [IsOrderUnit E₁] [IsOrderUnit E₂] in +lemma mapEffect_orthogonal (φ : E₁ →ₚ₁[ℝ] E₂) {e f : Effect E₁} + (h : Effect.Orthogonal e f) : Effect.Orthogonal (φ.mapEffect e) (φ.mapEffect f) := by + show φ (e : E₁) + φ (f : E₁) ≤ 1 + rw [← map_add, ← map_one φ] + exact φ.monotone' h + +omit [IsOrderUnit E₁] [IsOrderUnit E₂] in +@[simp] +lemma mapEffect_addOfOrthogonal (φ : E₁ →ₚ₁[ℝ] E₂) (e f : Effect E₁) + (h : Effect.Orthogonal e f) : + φ.mapEffect (Effect.addOfOrthogonal e f h) = + Effect.addOfOrthogonal (φ.mapEffect e) (φ.mapEffect f) (φ.mapEffect_orthogonal h) := by + ext + simp + +end UnitalPositiveLinearMap diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/Effect/BoundedIntegral.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Effect/BoundedIntegral.lean new file mode 100644 index 0000000000..04c2e385b2 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Effect/BoundedIntegral.lean @@ -0,0 +1,713 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Effect.Integral +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Norm +public import Mathlib.Algebra.Order.Floor.Ring +public import Mathlib.MeasureTheory.Function.Floor +public import Mathlib.MeasureTheory.Constructions.BorelSpace.Order +public import Mathlib.Analysis.SpecificLimits.Basic +public import Mathlib.Topology.MetricSpace.Cauchy +public import Mathlib.Topology.Order.Basic +public import Mathlib.Analysis.Normed.Group.Uniform + +/-! + +# Integrating bounded measurable functions against an effect-valued measure + +## i. Overview + +`Effect/Integral.lean` defines `EffectValuedMeasure.simpleIntegral`. This file extends it to +bounded measurable `f : Ω → ℝ`, assuming `E` is complete for its order-unit norm. + +## ii. Construction + +For a bound `M` with `|f x| ≤ M` and scale `n`, `meshPiece f M n` and `meshWeight M n` define a +finite simple approximation with uniform error at most `1/(n+1)`. The comparison lemma for two +simple approximations makes these integrals Cauchy and proves that every uniformly approximating +sequence has the same limit. The resulting integral is independent of the bound, agrees with +`simpleIntegral`, and is linear and positive. + +## iii. Key definitions and results + +- `EffectValuedMeasure.meshBound`, `MeshIndex`, `meshWeight`, `meshPiece` : the width-`1/(n+1)` + mesh simple function approximating a bounded measurable `f` with `|f x| ≤ M`, and its uniform + convergence to `f` (`abs_simpleValue_meshWeight_meshPiece_sub_le`). +- `EffectValuedMeasure.orderUnitNorm_simpleIntegral_sub_le` : the key comparison lemma — two simple + functions within `ε`, `ε'` of `f` give simple integrals within `ε + ε'` of each other. +- `EffectValuedMeasure.cauchySeq_meshSimpleIntegral`, `EffectValuedMeasure.integral` : the mesh + sequence is Cauchy, and (under `[CompleteSpace E]`, fixed via `letI`/`local instance` from + `IsArchimedeanOrderUnit.orderUnitNormedAddCommGroup`) `integral hf hM μ` is its limit. +- `EffectValuedMeasure.tendsto_of_uniformly_approximating` : independence from the approximating + sequence — any uniformly-approximating simple-function sequence has the same limit. +- `EffectValuedMeasure.integral_indep_of_bound`, `integral_eq_simpleIntegral` : independence from + the bound `M`, and agreement with `simpleIntegral` on functions that already are simple. +- `EffectValuedMeasure.integral_add`, `integral_smul`, `nonneg_integral` : linearity and + positivity. + +## iv. Table of contents + +- A. Mesh approximation +- B. Linear operations on simple values +- C. Comparison of simple integrals +- D. Construction by completeness + +-/ + +@[expose] public section + +namespace EffectValuedMeasure + +/-! ## A. The mesh approximation of a bounded measurable function -/ + +section Mesh + +variable {Ω : Type*} [MeasurableSpace Ω] + +/-- The number of width-`1/(n+1)` mesh cells it takes to reach out to `M` on either side of `0`: +`⌈(n+1)*M⌉₊`. Only depends on `M` and `n`, not on any particular function. -/ +noncomputable def meshBound (M : ℝ) (n : ℕ) : ℕ := ⌈(n + 1 : ℝ) * M⌉₊ + +/-- The mesh cell label set at scale `n` covering `[-M, M]`: integers from `-meshBound M n` to +`meshBound M n`. -/ +abbrev MeshIndex (M : ℝ) (n : ℕ) : Type := + ↥(Finset.Icc (-(meshBound M n : ℤ)) (meshBound M n : ℤ)) + +/-- The weight of mesh cell `k` at scale `n`: `k/(n+1)`, the left endpoint of the cell. -/ +noncomputable def meshWeight (M : ℝ) (n : ℕ) (k : MeshIndex M n) : ℝ := (k : ℤ) / ((n : ℝ) + 1) + +/-- The mesh cell `k` at scale `n`, pulled back along `f`: the points where `f` rounds down to +`k/(n+1)` at that scale, i.e. `⌊(n+1)*f(x)⌋ = k`. -/ +noncomputable def meshPiece (f : Ω → ℝ) (M : ℝ) (n : ℕ) (k : MeshIndex M n) : Set Ω := + (fun x => ⌊((n : ℝ) + 1) * f x⌋) ⁻¹' {(k : ℤ)} + +variable {f : Ω → ℝ} {M : ℝ} + +omit [MeasurableSpace Ω] in +@[simp] +lemma mem_meshPiece_iff (n : ℕ) (k : MeshIndex M n) (x : Ω) : + x ∈ meshPiece f M n k ↔ ⌊((n : ℝ) + 1) * f x⌋ = (k : ℤ) := Iff.rfl + +variable (hf : Measurable f) (hM : ∀ x, |f x| ≤ M) + +include hf in +lemma measurableSet_meshPiece (n : ℕ) (k : MeshIndex M n) : MeasurableSet (meshPiece f M n k) := + (Measurable.floor (measurable_const.mul hf)) (measurableSet_singleton _) + +include hM in +/-- The label the mesh assigns to the point `x`, together with the proof that it lies in range: +`⌊(n+1)*f(x)⌋` always lies in `[-meshBound M n, meshBound M n]` once `|f x| ≤ M`. -/ +noncomputable def meshIndexOf (n : ℕ) (x : Ω) : MeshIndex M n := + ⟨⌊((n : ℝ) + 1) * f x⌋, by + unfold meshBound + have hn1 : (0:ℝ) < (n:ℝ) + 1 := by positivity + have hle : f x ≤ M := (abs_le.mp (hM x)).2 + have hge : -M ≤ f x := (abs_le.mp (hM x)).1 + have hceil : ((n:ℝ)+1) * M ≤ (⌈((n:ℝ)+1) * M⌉₊ : ℝ) := Nat.le_ceil _ + have hub : ((n:ℝ)+1) * f x ≤ (⌈((n:ℝ)+1) * M⌉₊ : ℝ) := by + have := mul_le_mul_of_nonneg_left hle hn1.le + linarith + have hlb : -(⌈((n:ℝ)+1) * M⌉₊ : ℝ) ≤ ((n:ℝ)+1) * f x := by + have := mul_le_mul_of_nonneg_left hge hn1.le + linarith + rw [Finset.mem_Icc] + constructor + · have hmono := Int.floor_mono hlb + have heq : ⌊(-(⌈((n:ℝ)+1) * M⌉₊ : ℝ))⌋ = -(⌈((n:ℝ)+1) * M⌉₊ : ℤ) := by + rw [show (-(⌈((n:ℝ)+1) * M⌉₊ : ℝ)) = ((-(⌈((n:ℝ)+1) * M⌉₊ : ℤ) : ℤ) : ℝ) by push_cast; ring] + exact Int.floor_intCast _ + rwa [heq] at hmono + · have hmono := Int.floor_mono hub + rwa [Int.floor_natCast] at hmono⟩ + +omit [MeasurableSpace Ω] in +include hM in +@[simp] +lemma meshIndexOf_coe (n : ℕ) (x : Ω) : + ((meshIndexOf hM n x : MeshIndex M n) : ℤ) = ⌊((n : ℝ) + 1) * f x⌋ := rfl + +omit [MeasurableSpace Ω] in +include hM in +lemma mem_meshPiece_meshIndexOf (n : ℕ) (x : Ω) : x ∈ meshPiece f M n (meshIndexOf hM n x) := rfl + +include hf hM in +/-- The mesh pieces at scale `n` form a finite measurable partition of `Ω`. -/ +lemma isPartition_meshPiece (n : ℕ) : IsPartition (meshPiece f M n) where + measurable k := measurableSet_meshPiece hf n k + disjoint k l hkl := by + rw [Set.disjoint_left] + intro x hxk hxl + rw [mem_meshPiece_iff] at hxk hxl + exact hkl (Subtype.ext (hxk.symm.trans hxl)) + cover := by + ext x + simp only [Set.mem_iUnion, Set.mem_univ, iff_true] + exact ⟨meshIndexOf hM n x, mem_meshPiece_meshIndexOf hM n x⟩ + +include hf hM in +/-- The value of the mesh simple function at `x` is the label `f` is assigned, over `(n+1)`. -/ +lemma simpleValue_meshWeight_meshPiece (n : ℕ) (x : Ω) : + simpleValue (meshWeight M n) (meshPiece f M n) x = + (⌊((n : ℝ) + 1) * f x⌋ : ℝ) / ((n : ℝ) + 1) := by + rw [simpleValue_apply_of_mem (isPartition_meshPiece hf hM n) (mem_meshPiece_meshIndexOf hM n x)] + unfold meshWeight + rw [meshIndexOf_coe hM] + +include hf hM in +/-- **Uniform convergence of the mesh approximation.** At scale `n`, the mesh simple function +never differs from `f` by more than the mesh width `1/(n+1)`, at any point. -/ +lemma abs_simpleValue_meshWeight_meshPiece_sub_le (n : ℕ) (x : Ω) : + |simpleValue (meshWeight M n) (meshPiece f M n) x - f x| ≤ 1 / ((n : ℝ) + 1) := by + rw [simpleValue_meshWeight_meshPiece hf hM] + have hn1 : (0:ℝ) < (n:ℝ) + 1 := by positivity + have h1 : (⌊((n:ℝ)+1) * f x⌋ : ℝ) ≤ ((n:ℝ)+1) * f x := Int.floor_le _ + have h2 : ((n:ℝ)+1) * f x < (⌊((n:ℝ)+1) * f x⌋ : ℝ) + 1 := Int.lt_floor_add_one _ + have hle : (⌊((n:ℝ)+1) * f x⌋ : ℝ) / ((n:ℝ)+1) ≤ f x := by + rw [div_le_iff₀ hn1] + nlinarith [h1] + have hlt : f x < (⌊((n:ℝ)+1) * f x⌋ : ℝ) / ((n:ℝ)+1) + 1 / ((n:ℝ)+1) := by + rw [← add_div, lt_div_iff₀ hn1] + nlinarith [h2] + rw [abs_le] + constructor <;> linarith + +end Mesh + +section SimpleValueLinear + +/-! ## B. Linear operations on simple values -/ + +variable {Ω : Type*} {ι : Type*} [Fintype ι] + +/-- `simpleValue` is additive in the weights, pointwise. -/ +lemma simpleValue_add (a b : ι → ℝ) (s : ι → Set Ω) (x : Ω) : + simpleValue (a + b) s x = simpleValue a s x + simpleValue b s x := by + unfold simpleValue + rw [← Finset.sum_add_distrib] + refine Finset.sum_congr rfl fun i _ => ?_ + by_cases hi : x ∈ s i <;> simp [hi] + +/-- `simpleValue` is homogeneous in the weights, pointwise. -/ +lemma simpleValue_smul (r : ℝ) (c : ι → ℝ) (s : ι → Set Ω) (x : Ω) : + simpleValue (r • c) s x = r * simpleValue c s x := by + unfold simpleValue + rw [Finset.mul_sum] + refine Finset.sum_congr rfl fun i _ => ?_ + by_cases hi : x ∈ s i <;> simp [hi] + +end SimpleValueLinear + +/-! ## C. Comparing the simple integrals of two approximations + +The key ingredient for both the Cauchy property and the independence of the eventual integral +from the choice of approximating sequence: if two simple functions (over possibly different +partitions) both stay within `ε`, resp. `ε'`, of the same `f` everywhere, their integrals against +`μ` stay within `ε + ε'` of each other, in the order-unit norm. -/ + +section Comparison + +variable {Ω E : Type*} [MeasurableSpace Ω] [AddCommGroup E] [PartialOrder E] + [IsOrderedAddMonoid E] [Module ℝ E] [PosSMulMono ℝ E] [One E] [IsArchimedeanOrderUnit E] + +open IsArchimedeanOrderUnit + +/-- The pairwise intersections of two partitions again form a partition, indexed by the product of +their labels. -/ +lemma isPartition_inter {ι ι' : Type*} [Fintype ι] [Fintype ι'] {s : ι → Set Ω} {s' : ι' → Set Ω} + (hs : IsPartition s) (hs' : IsPartition s') : + IsPartition (fun p : ι × ι' => s p.1 ∩ s' p.2) where + measurable p := (hs.measurable p.1).inter (hs'.measurable p.2) + disjoint p q hpq := by + rcases p with ⟨i, j⟩ + rcases q with ⟨i', j'⟩ + by_cases hii' : i = i' + · subst hii' + have hjj' : j ≠ j' := fun h => hpq (by rw [h]) + exact Disjoint.mono Set.inter_subset_right Set.inter_subset_right (hs'.disjoint j j' hjj') + · exact Disjoint.mono Set.inter_subset_left Set.inter_subset_left (hs.disjoint i i' hii') + cover := by + ext x + simp only [Set.mem_iUnion, Set.mem_univ, iff_true] + have hxs : x ∈ ⋃ i, s i := by rw [hs.cover]; trivial + have hxs' : x ∈ ⋃ j, s' j := by rw [hs'.cover]; trivial + obtain ⟨i, hi⟩ := Set.mem_iUnion.mp hxs + obtain ⟨j, hj⟩ := Set.mem_iUnion.mp hxs' + exact ⟨(i, j), hi, hj⟩ + +lemma simpleValue_eq_simpleValue_inter_fst {ι ι' : Type*} [Fintype ι] [Fintype ι'] + {c : ι → ℝ} {s : ι → Set Ω} (hs : IsPartition s) {s' : ι' → Set Ω} (hs' : IsPartition s') + (x : Ω) : + simpleValue c s x = simpleValue (fun p : ι × ι' => c p.1) (fun p => s p.1 ∩ s' p.2) x := by + have hxs : x ∈ ⋃ i, s i := by rw [hs.cover]; trivial + have hxs' : x ∈ ⋃ j, s' j := by rw [hs'.cover]; trivial + obtain ⟨i, hi⟩ := Set.mem_iUnion.mp hxs + obtain ⟨j, hj⟩ := Set.mem_iUnion.mp hxs' + rw [simpleValue_apply_of_mem hs hi, + simpleValue_apply_of_mem (isPartition_inter hs hs') (i := (i, j)) + (show x ∈ s i ∩ s' j from ⟨hi, hj⟩)] + +lemma simpleValue_eq_simpleValue_inter_snd {ι ι' : Type*} [Fintype ι] [Fintype ι'] + {c' : ι' → ℝ} {s : ι → Set Ω} (hs : IsPartition s) {s' : ι' → Set Ω} (hs' : IsPartition s') + (x : Ω) : + simpleValue c' s' x = simpleValue (fun p : ι × ι' => c' p.2) (fun p => s p.1 ∩ s' p.2) x := by + have hxs : x ∈ ⋃ i, s i := by rw [hs.cover]; trivial + have hxs' : x ∈ ⋃ j, s' j := by rw [hs'.cover]; trivial + obtain ⟨i, hi⟩ := Set.mem_iUnion.mp hxs + obtain ⟨j, hj⟩ := Set.mem_iUnion.mp hxs' + rw [simpleValue_apply_of_mem hs' hj, + simpleValue_apply_of_mem (isPartition_inter hs hs') (i := (i, j)) + (show x ∈ s i ∩ s' j from ⟨hi, hj⟩)] + +/-- The pointwise sum of two simple functions, over possibly different partitions, is the simple +function of their common refinement with pointwise-summed weights. Used to build an admissible +approximating sequence for `f + g` out of ones for `f` and `g`. -/ +lemma simpleValue_add_inter {ι ι' : Type*} [Fintype ι] [Fintype ι'] {a : ι → ℝ} {s : ι → Set Ω} + (hs : IsPartition s) {b : ι' → ℝ} {s' : ι' → Set Ω} (hs' : IsPartition s') (x : Ω) : + simpleValue a s x + simpleValue b s' x = + simpleValue (fun p : ι × ι' => a p.1 + b p.2) (fun p => s p.1 ∩ s' p.2) x := by + rw [simpleValue_eq_simpleValue_inter_fst hs hs', simpleValue_eq_simpleValue_inter_snd hs hs', + ← simpleValue_add] + congr 1 + +omit [PosSMulMono ℝ E] in +lemma simpleIntegral_eq_simpleIntegral_inter_fst {ι ι' : Type*} [Fintype ι] [Fintype ι'] + [DecidableEq ι] [DecidableEq ι'] (μ : EffectValuedMeasure Ω E) {c : ι → ℝ} {s : ι → Set Ω} + (hs : IsPartition s) {s' : ι' → Set Ω} (hs' : IsPartition s') : + simpleIntegral μ c s hs = + simpleIntegral μ (fun p : ι × ι' => c p.1) (fun p => s p.1 ∩ s' p.2) + (isPartition_inter hs hs') := + simpleIntegral_eq_of_pointwise_eq μ c s hs _ _ (isPartition_inter hs hs') + (simpleValue_eq_simpleValue_inter_fst hs hs') + +omit [PosSMulMono ℝ E] in +lemma simpleIntegral_eq_simpleIntegral_inter_snd {ι ι' : Type*} [Fintype ι] [Fintype ι'] + [DecidableEq ι] [DecidableEq ι'] (μ : EffectValuedMeasure Ω E) {c' : ι' → ℝ} {s : ι → Set Ω} + (hs : IsPartition s) {s' : ι' → Set Ω} (hs' : IsPartition s') : + simpleIntegral μ c' s' hs' = + simpleIntegral μ (fun p : ι × ι' => c' p.2) (fun p => s p.1 ∩ s' p.2) + (isPartition_inter hs hs') := + simpleIntegral_eq_of_pointwise_eq μ c' s' hs' _ _ (isPartition_inter hs hs') + (simpleValue_eq_simpleValue_inter_snd hs hs') + +omit [PosSMulMono ℝ E] in +/-- The difference of two simple integrals, over possibly different partitions, is itself a simple +integral over their common refinement, with weights the pointwise difference of the two original +weights. This is what lets the difference be bounded termwise. -/ +lemma simpleIntegral_sub_simpleIntegral {ι ι' : Type*} [Fintype ι] [Fintype ι'] [DecidableEq ι] + [DecidableEq ι'] (μ : EffectValuedMeasure Ω E) {c : ι → ℝ} {s : ι → Set Ω} + (hs : IsPartition s) {c' : ι' → ℝ} {s' : ι' → Set Ω} (hs' : IsPartition s') : + simpleIntegral μ c s hs - simpleIntegral μ c' s' hs' = + simpleIntegral μ (fun p : ι × ι' => c p.1 - c' p.2) (fun p => s p.1 ∩ s' p.2) + (isPartition_inter hs hs') := by + have hd : (fun p : ι × ι' => c p.1 - c' p.2) + = (fun p : ι × ι' => c p.1) + (-1 : ℝ) • (fun p : ι × ι' => c' p.2) := by + funext p; simp [sub_eq_add_neg] + rw [hd, simpleIntegral_add, simpleIntegral_smul, + ← simpleIntegral_eq_simpleIntegral_inter_fst μ hs hs', + ← simpleIntegral_eq_simpleIntegral_inter_snd μ hs hs', neg_one_smul, sub_eq_add_neg] + +omit [PosSMulMono ℝ E] in +/-- The sum of two simple integrals, over possibly different partitions, is itself a simple +integral over their common refinement, with weights the pointwise sum of the two original +weights. Used to build an admissible approximating sequence for `f + g` out of ones for `f` and +`g`. -/ +lemma simpleIntegral_add_simpleIntegral {ι ι' : Type*} [Fintype ι] [Fintype ι'] [DecidableEq ι] + [DecidableEq ι'] (μ : EffectValuedMeasure Ω E) {c : ι → ℝ} {s : ι → Set Ω} + (hs : IsPartition s) {c' : ι' → ℝ} {s' : ι' → Set Ω} (hs' : IsPartition s') : + simpleIntegral μ c s hs + simpleIntegral μ c' s' hs' = + simpleIntegral μ (fun p : ι × ι' => c p.1 + c' p.2) (fun p => s p.1 ∩ s' p.2) + (isPartition_inter hs hs') := by + rw [simpleIntegral_eq_simpleIntegral_inter_fst μ hs hs', + simpleIntegral_eq_simpleIntegral_inter_snd μ hs hs', ← simpleIntegral_add] + congr 1 + +omit [PosSMulMono ℝ E] in +/-- The total measure of a partition is the certain outcome. -/ +lemma sum_apply_eq_one {ι : Type*} [Fintype ι] [DecidableEq ι] (μ : EffectValuedMeasure Ω E) + {s : ι → Set Ω} (hs : IsPartition s) : + ∑ i, (μ (s i) (hs.measurable i) : E) = 1 := by + have h := apply_iUnion_of_disjoint μ s hs.measurable hs.disjoint + rw [apply_congr μ hs.cover (ht := MeasurableSet.univ), map_univ] at h + exact h.symm + +/-- A simple integral whose weights are bounded by `δ`, on every piece the underlying measure sees +(i.e. every nonempty piece), has order-unit norm at most `δ`: every term is sandwiched between +`±δ` times a nonnegative effect, and those effects sum to the certain outcome. -/ +lemma orderUnitNorm_simpleIntegral_le {ι : Type*} [Fintype ι] [DecidableEq ι] + (μ : EffectValuedMeasure Ω E) {c : ι → ℝ} {s : ι → Set Ω} (hs : IsPartition s) {δ : ℝ} + (hδ : 0 ≤ δ) (hc : ∀ i, (s i).Nonempty → |c i| ≤ δ) : + orderUnitNorm (simpleIntegral μ c s hs) ≤ δ := by + have hzero : ∀ i, ¬ (s i).Nonempty → (μ (s i) (hs.measurable i) : E) = 0 := by + intro i hi + rw [Set.not_nonempty_iff_eq_empty] at hi + rw [apply_congr μ hi (ht := MeasurableSet.empty)] + simp + apply orderUnitNorm_le + refine ⟨hδ, ?_, ?_⟩ + · have hlow : ∀ i ∈ (Finset.univ : Finset ι), + (-δ) • (μ (s i) (hs.measurable i) : E) ≤ c i • (μ (s i) (hs.measurable i) : E) := by + intro i _ + by_cases hi : (s i).Nonempty + · exact smul_le_smul_of_nonneg_right (abs_le.mp (hc i hi)).1 (μ (s i) (hs.measurable i)).2.1 + · rw [hzero i hi]; simp + have keyL : ∑ i, ((-δ) • (μ (s i) (hs.measurable i) : E)) = -(δ • (1 : E)) := by + rw [← Finset.smul_sum, sum_apply_eq_one μ hs, neg_smul] + calc -(δ • (1 : E)) = ∑ i, ((-δ) • (μ (s i) (hs.measurable i) : E)) := keyL.symm + _ ≤ ∑ i, (c i • (μ (s i) (hs.measurable i) : E)) := Finset.sum_le_sum hlow + _ = simpleIntegral μ c s hs := rfl + · have hup : ∀ i ∈ (Finset.univ : Finset ι), + c i • (μ (s i) (hs.measurable i) : E) ≤ δ • (μ (s i) (hs.measurable i) : E) := by + intro i _ + by_cases hi : (s i).Nonempty + · exact smul_le_smul_of_nonneg_right (abs_le.mp (hc i hi)).2 (μ (s i) (hs.measurable i)).2.1 + · rw [hzero i hi]; simp + have keyU : ∑ i, (δ • (μ (s i) (hs.measurable i) : E)) = δ • (1 : E) := by + rw [← Finset.smul_sum, sum_apply_eq_one μ hs] + calc simpleIntegral μ c s hs = ∑ i, (c i • (μ (s i) (hs.measurable i) : E)) := rfl + _ ≤ ∑ i, (δ • (μ (s i) (hs.measurable i) : E)) := Finset.sum_le_sum hup + _ = δ • (1 : E) := keyU + +/-- A simple integral is nonnegative as soon as its weights are nonnegative on every piece the +underlying measure sees (i.e. every nonempty piece) — the same "only nonempty pieces matter" +relaxation of `simpleIntegral_nonneg` used above for the norm bound. -/ +lemma simpleIntegral_nonneg' {ι : Type*} [Fintype ι] (μ : EffectValuedMeasure Ω E) {c : ι → ℝ} + {s : ι → Set Ω} (hs : IsPartition s) (hc : ∀ i, (s i).Nonempty → 0 ≤ c i) : + 0 ≤ simpleIntegral μ c s hs := by + unfold simpleIntegral + apply Finset.sum_nonneg + intro i _ + by_cases hi : (s i).Nonempty + · exact smul_nonneg (hc i hi) (μ (s i) (hs.measurable i)).2.1 + · rw [Set.not_nonempty_iff_eq_empty] at hi + rw [apply_congr μ hi (ht := MeasurableSet.empty)] + simp + +/-- **The key comparison lemma.** Two simple functions that both stay within `ε`, resp. `ε'`, of +the same bounded function `f` everywhere give integrals against `μ` that are within `ε + ε'` of +each other, in the order-unit norm — regardless of which partitions were used to build them. -/ +theorem orderUnitNorm_simpleIntegral_sub_le {ι ι' : Type*} [Fintype ι] [Fintype ι'] + [DecidableEq ι] [DecidableEq ι'] (μ : EffectValuedMeasure Ω E) {f : Ω → ℝ} + {c : ι → ℝ} {s : ι → Set Ω} (hs : IsPartition s) {ε : ℝ} (hε : 0 ≤ ε) + (hc : ∀ x, |simpleValue c s x - f x| ≤ ε) + {c' : ι' → ℝ} {s' : ι' → Set Ω} (hs' : IsPartition s') {ε' : ℝ} (hε' : 0 ≤ ε') + (hc' : ∀ x, |simpleValue c' s' x - f x| ≤ ε') : + orderUnitNorm (simpleIntegral μ c s hs - simpleIntegral μ c' s' hs') ≤ ε + ε' := by + rw [simpleIntegral_sub_simpleIntegral μ hs hs'] + apply orderUnitNorm_simpleIntegral_le μ (isPartition_inter hs hs') (add_nonneg hε hε') + rintro ⟨i, j⟩ ⟨x, hx⟩ + have hxi : x ∈ s i := hx.1 + have hxj : x ∈ s' j := hx.2 + have hci : c i = simpleValue c s x := (simpleValue_apply_of_mem hs hxi).symm + have hcj : c' j = simpleValue c' s' x := (simpleValue_apply_of_mem hs' hxj).symm + have h1 : |simpleValue c s x - f x| ≤ ε := hc x + have h2 : |simpleValue c' s' x - f x| ≤ ε' := hc' x + rw [hci, hcj] + calc |simpleValue c s x - simpleValue c' s' x| + = |(simpleValue c s x - f x) - (simpleValue c' s' x - f x)| := by ring_nf + _ ≤ |simpleValue c s x - f x| + |simpleValue c' s' x - f x| := abs_sub _ _ + _ ≤ ε + ε' := add_le_add h1 h2 + +/-- Any real strictly above the order-unit norm of `y` is itself an order-unit bound of `y`: since +`orderUnitBounds y` is an up-set with infimum `orderUnitNorm y`, anything strictly past that +infimum is already in the set. The positivity argument below needs this to turn a norm estimate +into an actual order bound. -/ +lemma le_smul_one_of_orderUnitNorm_lt {y : E} {r : ℝ} (h : orderUnitNorm y < r) : + y ≤ r • (1 : E) := by + obtain ⟨r', hr', hr'lt⟩ := exists_lt_of_csInf_lt (orderUnitBounds_nonempty y) h + calc y ≤ r' • (1 : E) := hr'.2.2 + _ ≤ r • (1 : E) := smul_le_smul_of_nonneg_right hr'lt.le IsOrderUnit.one_nonneg + +end Comparison + +/-! ## D. The integral, via completeness + +`E`'s order-unit norm (`IsArchimedeanOrderUnit.orderUnitNorm`) makes it a normed group via +`IsArchimedeanOrderUnit.orderUnitNormedAddCommGroup`, deliberately not a registered instance at +this level of generality (see `OrderUnit/Norm.lean`); we fix it as a `local instance` for this +section (the term-mode `letI` the file's plan mentions is the tactic-mode spelling of the same +thing; at the section/command level `local instance` is what registers it for the elaborator), and +additionally assume `[CompleteSpace E]` under *that* instance — a genuine extra hypothesis, since +most order-unit spaces are not complete. -/ + +section Definition + +variable {Ω E : Type*} [MeasurableSpace Ω] [AddCommGroup E] [PartialOrder E] + [IsOrderedAddMonoid E] [Module ℝ E] [PosSMulMono ℝ E] [One E] [IsArchimedeanOrderUnit E] + +open IsArchimedeanOrderUnit Filter Topology + +/-- The order-unit norm supplies the ambient normed additive-group structure for this section. -/ +@[nolint docBlame] +noncomputable local instance instNormedAddCommGroup : NormedAddCommGroup E := + IsArchimedeanOrderUnit.orderUnitNormedAddCommGroup + +variable [CompleteSpace E] + +omit [CompleteSpace E] in +lemma dist_eq_orderUnitNorm (x y : E) : dist x y = orderUnitNorm (x - y) := by + rw [dist_eq_norm] + rfl + +omit [CompleteSpace E] in +/-- Scalar multiplication by a fixed real is continuous, established by hand from +`orderUnitNorm_smul_le` since no `NormedSpace ℝ E` instance is assumed at this generality. -/ +lemma tendsto_const_smul_of_tendsto {a : ℕ → E} {L : E} (c : ℝ) + (ha : Filter.Tendsto a atTop (𝓝 L)) : Filter.Tendsto (fun n => c • a n) atTop (𝓝 (c • L)) := by + rw [tendsto_iff_dist_tendsto_zero] at ha ⊢ + have hb : ∀ n, dist (c • a n) (c • L) ≤ |c| * dist (a n) L := by + intro n + rw [dist_eq_orderUnitNorm, dist_eq_orderUnitNorm, ← smul_sub] + exact orderUnitNorm_smul_le c (a n - L) + refine tendsto_of_tendsto_of_tendsto_of_le_of_le tendsto_const_nhds ?_ (fun _ => dist_nonneg) hb + simpa using ha.const_mul |c| + +variable {f : Ω → ℝ} (hf : Measurable f) {M : ℝ} (hM : ∀ x, |f x| ≤ M) + +omit [CompleteSpace E] in +include hf hM in +/-- **The mesh approximation is Cauchy.** Refining the mesh from scale `n` to scale `m`, both past +`N`, moves the simple integral by at most `2/(N+1)` in the order-unit norm — the sum of the two +meshes' uniform error bounds, via `orderUnitNorm_simpleIntegral_sub_le`. -/ +lemma cauchySeq_meshSimpleIntegral (μ : EffectValuedMeasure Ω E) : + CauchySeq (fun n : ℕ => simpleIntegral μ (meshWeight M n) (meshPiece f M n) + (isPartition_meshPiece hf hM n)) := by + apply cauchySeq_of_le_tendsto_0 (fun N : ℕ => 2 / ((N : ℝ) + 1)) + · intro n m N hNn hNm + rw [dist_eq_orderUnitNorm] + have hbound := orderUnitNorm_simpleIntegral_sub_le μ (f := f) + (isPartition_meshPiece hf hM n) (by positivity : (0:ℝ) ≤ 1 / ((n:ℝ)+1)) + (abs_simpleValue_meshWeight_meshPiece_sub_le hf hM n) + (isPartition_meshPiece hf hM m) (by positivity : (0:ℝ) ≤ 1 / ((m:ℝ)+1)) + (abs_simpleValue_meshWeight_meshPiece_sub_le hf hM m) + have hn : 1 / ((n : ℝ) + 1) ≤ 1 / ((N : ℝ) + 1) := by + apply one_div_le_one_div_of_le (by positivity) + exact_mod_cast Nat.succ_le_succ hNn + have hm : 1 / ((m : ℝ) + 1) ≤ 1 / ((N : ℝ) + 1) := by + apply one_div_le_one_div_of_le (by positivity) + exact_mod_cast Nat.succ_le_succ hNm + calc orderUnitNorm (simpleIntegral μ (meshWeight M n) (meshPiece f M n) + (isPartition_meshPiece hf hM n) + - simpleIntegral μ (meshWeight M m) (meshPiece f M m) (isPartition_meshPiece hf hM m)) + ≤ 1 / ((n:ℝ)+1) + 1 / ((m:ℝ)+1) := hbound + _ ≤ 1 / ((N:ℝ)+1) + 1 / ((N:ℝ)+1) := add_le_add hn hm + _ = 2 / ((N:ℝ)+1) := by ring + · simpa [div_eq_mul_inv] using + (tendsto_one_div_add_atTop_nhds_zero_nat (𝕜 := ℝ)).const_mul 2 + +include hf hM in +/-- **The integral of a bounded measurable function against `μ`.** The limit of the mesh +approximation's simple integrals, which exists by completeness of `E` since the sequence is +Cauchy. -/ +noncomputable def integral (μ : EffectValuedMeasure Ω E) : E := + (cauchySeq_tendsto_of_complete (cauchySeq_meshSimpleIntegral hf hM μ)).choose + +include hf hM in +/-- The mesh approximation's simple integrals converge to `integral hf hM μ`, by construction. -/ +lemma integral_tendsto (μ : EffectValuedMeasure Ω E) : + Tendsto (fun n : ℕ => simpleIntegral μ (meshWeight M n) (meshPiece f M n) + (isPartition_meshPiece hf hM n)) atTop (𝓝 (integral hf hM μ)) := + (cauchySeq_tendsto_of_complete (cauchySeq_meshSimpleIntegral hf hM μ)).choose_spec + +include hf hM in +/-- **Independence of the approximating sequence.** Any sequence of simple-function partitions +whose simple values converge to `f` uniformly (with an explicit `→ 0` error bound) has its simple +integrals against `μ` converge to `integral hf hM μ` — not just the canonical mesh sequence used to +define it. This is what makes `integral` a genuine integral of the function `f`, not of the +particular mesh construction: swap in any other admissible approximation and the same limit comes +out, by the same comparison argument (`orderUnitNorm_simpleIntegral_sub_le`) that drove the Cauchy +property above. -/ +theorem tendsto_of_uniformly_approximating (μ : EffectValuedMeasure Ω E) {ι : ℕ → Type*} + [∀ n, Fintype (ι n)] [∀ n, DecidableEq (ι n)] {c : ∀ n, ι n → ℝ} {s : ∀ n, ι n → Set Ω} + (hs : ∀ n, IsPartition (s n)) {ε : ℕ → ℝ} (hε0 : ∀ n, 0 ≤ ε n) + (hεtendsto : Tendsto ε atTop (𝓝 0)) (happrox : ∀ n x, |simpleValue (c n) (s n) x - f x| ≤ ε n) : + Tendsto (fun n => simpleIntegral μ (c n) (s n) (hs n)) atTop (𝓝 (integral hf hM μ)) := by + apply Filter.Tendsto.congr_dist (integral_tendsto hf hM μ) + have hb : ∀ n : ℕ, dist + (simpleIntegral μ (meshWeight M n) (meshPiece f M n) (isPartition_meshPiece hf hM n)) + (simpleIntegral μ (c n) (s n) (hs n)) ≤ 1 / ((n:ℝ)+1) + ε n := by + intro n + rw [dist_eq_orderUnitNorm] + exact orderUnitNorm_simpleIntegral_sub_le μ (f := f) (isPartition_meshPiece hf hM n) + (by positivity) (abs_simpleValue_meshWeight_meshPiece_sub_le hf hM n) (hs n) (hε0 n) + (happrox n) + refine tendsto_of_tendsto_of_tendsto_of_le_of_le tendsto_const_nhds ?_ (fun _ => dist_nonneg) hb + simpa using (tendsto_one_div_add_atTop_nhds_zero_nat (𝕜 := ℝ)).add hεtendsto + +include hf hM in +/-- **Independence from the choice of bound.** `integral` doesn't depend on which valid bound `M` +was used to build it: swapping in another bound `M'` only changes the *range* of mesh cells, not +their width, so the `M'`-mesh sequence is itself uniformly approximating for the `M`-built +`integral hf hM μ` too, and `tendsto_nhds_unique` identifies the two limits. -/ +theorem integral_indep_of_bound {M' : ℝ} (hM' : ∀ x, |f x| ≤ M') (μ : EffectValuedMeasure Ω E) : + integral hf hM μ = integral hf hM' μ := by + have happrox := tendsto_of_uniformly_approximating hf hM μ + (hs := fun n => isPartition_meshPiece hf hM' n) (ε := fun n => 1 / ((n:ℝ)+1)) + (fun n => by positivity) (tendsto_one_div_add_atTop_nhds_zero_nat (𝕜 := ℝ)) + (abs_simpleValue_meshWeight_meshPiece_sub_le hf hM') + exact tendsto_nhds_unique happrox (integral_tendsto hf hM' μ) + +include hf hM in +/-- **Consistency with the simple case.** When `f` already *is* a simple function against some +partition, `integral` agrees with `simpleIntegral` on it — the general construction extends the +special case rather than computing something else. The constant sequence `(c, s, hs)` is itself +(trivially) uniformly approximating, with error `0`, so `tendsto_of_uniformly_approximating` +applies directly. -/ +theorem integral_eq_simpleIntegral {ι : Type*} [Fintype ι] [DecidableEq ι] {c : ι → ℝ} + {s : ι → Set Ω} (hs : IsPartition s) (hcs : ∀ x, simpleValue c s x = f x) + (μ : EffectValuedMeasure Ω E) : integral hf hM μ = simpleIntegral μ c s hs := by + have happrox := tendsto_of_uniformly_approximating hf hM μ (ι := fun _ : ℕ => ι) + (c := fun _ => c) (s := fun _ => s) (fun _ => hs) (ε := fun _ => (0 : ℝ)) + (fun _ => le_refl 0) tendsto_const_nhds (fun _ x => by rw [hcs x]; simp) + exact tendsto_nhds_unique happrox tendsto_const_nhds + +include hf hM in +/-- **Positivity.** A nonnegative `f` integrates to a nonnegative value: every mesh approximation +of a nonnegative `f` has nonnegative weight on every piece it actually sees (a piece labelled `k` +that meets `f`'s graph forces `k ≥ 0`, since `f ≥ 0` there), so every term of the mesh sequence is +`≥ 0` (`simpleIntegral_nonneg'`); pass that bound to the limit using that +`-integral hf hM μ ≤ ε • 1` for every `ε > 0`, which is exactly what +`IsArchimedeanOrderUnit.le_zero_of_forall_pos_smul_one_le` needs to conclude `-integral ≤ 0`. -/ +theorem nonneg_integral (hf0 : ∀ x, 0 ≤ f x) (μ : EffectValuedMeasure Ω E) : + 0 ≤ integral hf hM μ := by + have hmesh_nonneg : ∀ n, 0 ≤ simpleIntegral μ (meshWeight M n) (meshPiece f M n) + (isPartition_meshPiece hf hM n) := by + intro n + apply simpleIntegral_nonneg' μ (isPartition_meshPiece hf hM n) + intro k ⟨x, hx⟩ + rw [mem_meshPiece_iff] at hx + have hxnn : (0:ℝ) ≤ ((n:ℝ)+1) * f x := mul_nonneg (by positivity) (hf0 x) + have : (0:ℤ) ≤ ⌊((n:ℝ)+1) * f x⌋ := by + have := Int.floor_mono hxnn + simpa using this + unfold meshWeight + rw [hx] at this + positivity + rw [← neg_nonpos] + apply IsArchimedeanOrderUnit.le_zero_of_forall_pos_smul_one_le + intro ε hε + obtain ⟨N, hN⟩ := Metric.tendsto_atTop.mp (integral_tendsto hf hM μ) ε hε + have hstep : -(integral hf hM μ) ≤ simpleIntegral μ (meshWeight M N) (meshPiece f M N) + (isPartition_meshPiece hf hM N) - integral hf hM μ := by + have h0 := hmesh_nonneg N + calc -(integral hf hM μ) = (0 : E) - integral hf hM μ := (zero_sub _).symm + _ ≤ simpleIntegral μ (meshWeight M N) (meshPiece f M N) (isPartition_meshPiece hf hM N) + - integral hf hM μ := sub_le_sub_right h0 _ + have hnorm : orderUnitNorm (simpleIntegral μ (meshWeight M N) (meshPiece f M N) + (isPartition_meshPiece hf hM N) - integral hf hM μ) < ε := by + have := hN N le_rfl + rwa [dist_eq_orderUnitNorm] at this + calc -(integral hf hM μ) ≤ simpleIntegral μ (meshWeight M N) (meshPiece f M N) + (isPartition_meshPiece hf hM N) - integral hf hM μ := hstep + _ ≤ ε • (1 : E) := le_smul_one_of_orderUnitNorm_lt hnorm + +include hf hM in +/-- **Additivity.** `integral (f + g) = integral f + integral g`, built by combining the two +canonical mesh sequences into one admissible sequence for `f + g` (pieces the pairwise +intersections, weights the pointwise sums — `simpleValue_add_inter` for the uniform bound, +`simpleIntegral_add_simpleIntegral` for the exact algebraic identity) and matching limits: the +combined sequence tends to `integral hfg hMfg μ` by `tendsto_of_uniformly_approximating`, and its +terms equal `mesh_f + mesh_g` exactly at every stage, so it also tends to +`integral f + integral g` (continuity of `+`, free in any normed group). -/ +theorem integral_add {g : Ω → ℝ} (hg : Measurable g) {M' : ℝ} (hM' : ∀ x, |g x| ≤ M') + {hfg : Measurable (f + g)} {hMfg : ∀ x, |(f + g) x| ≤ M + M'} (μ : EffectValuedMeasure Ω E) : + integral hfg hMfg μ = integral hf hM μ + integral hg hM' μ := by + set comb : ∀ n : ℕ, MeshIndex M n × MeshIndex M' n → ℝ := + fun n p => meshWeight M n p.1 + meshWeight M' n p.2 with hcomb_def + set combPiece : ∀ n : ℕ, MeshIndex M n × MeshIndex M' n → Set Ω := + fun n p => meshPiece f M n p.1 ∩ meshPiece g M' n p.2 with hcombPiece_def + have hcombPart : ∀ n, IsPartition (combPiece n) := fun n => + isPartition_inter (isPartition_meshPiece hf hM n) (isPartition_meshPiece hg hM' n) + have key1 : Filter.Tendsto (fun n => simpleIntegral μ (comb n) (combPiece n) (hcombPart n)) + atTop (𝓝 (integral hfg hMfg μ)) := by + apply tendsto_of_uniformly_approximating hfg hMfg μ hcombPart (ε := fun n => 2 / ((n:ℝ)+1)) + (fun n => by positivity) + · simpa [div_eq_mul_inv] using + (tendsto_one_div_add_atTop_nhds_zero_nat (𝕜 := ℝ)).const_mul 2 + · intro n x + have hval : simpleValue (meshWeight M n) (meshPiece f M n) x + + simpleValue (meshWeight M' n) (meshPiece g M' n) x + = simpleValue (comb n) (combPiece n) x := + simpleValue_add_inter (isPartition_meshPiece hf hM n) (isPartition_meshPiece hg hM' n) x + have h1 := abs_simpleValue_meshWeight_meshPiece_sub_le hf hM n x + have h2 := abs_simpleValue_meshWeight_meshPiece_sub_le hg hM' n x + rw [← hval] + have hregroup : simpleValue (meshWeight M n) (meshPiece f M n) x + + simpleValue (meshWeight M' n) (meshPiece g M' n) x - (f + g) x + = (simpleValue (meshWeight M n) (meshPiece f M n) x - f x) + + (simpleValue (meshWeight M' n) (meshPiece g M' n) x - g x) := by + simp only [Pi.add_apply]; ring + rw [hregroup] + calc |(simpleValue (meshWeight M n) (meshPiece f M n) x - f x) + + (simpleValue (meshWeight M' n) (meshPiece g M' n) x - g x)| + ≤ |simpleValue (meshWeight M n) (meshPiece f M n) x - f x| + + |simpleValue (meshWeight M' n) (meshPiece g M' n) x - g x| := abs_add_le _ _ + _ ≤ 1 / ((n:ℝ)+1) + 1 / ((n:ℝ)+1) := add_le_add h1 h2 + _ = 2 / ((n:ℝ)+1) := by ring + have key2 : Filter.Tendsto (fun n => simpleIntegral μ (comb n) (combPiece n) (hcombPart n)) + atTop (𝓝 (integral hf hM μ + integral hg hM' μ)) := by + have heq : ∀ n, simpleIntegral μ (comb n) (combPiece n) (hcombPart n) + = simpleIntegral μ (meshWeight M n) (meshPiece f M n) (isPartition_meshPiece hf hM n) + + simpleIntegral μ (meshWeight M' n) (meshPiece g M' n) + (isPartition_meshPiece hg hM' n) := + fun n => (simpleIntegral_add_simpleIntegral μ _ _).symm + simp_rw [heq] + exact (integral_tendsto hf hM μ).add (integral_tendsto hg hM' μ) + exact tendsto_nhds_unique key1 key2 + +include hf hM in +/-- **Homogeneity.** `integral (c • f) = c • integral f`, built from the canonical mesh sequence +for `f` with weights rescaled by `c` (same partition, so `simpleIntegral_smul` gives the exact +algebraic identity at every stage, no refinement needed); matching limits needs scalar +multiplication's continuity, established from `orderUnitNorm_smul_le` since no `NormedSpace ℝ E` +instance is assumed at this generality. -/ +theorem integral_smul (c : ℝ) {hcf : Measurable (c • f)} {hMcf : ∀ x, |(c • f) x| ≤ |c| * M} + (μ : EffectValuedMeasure Ω E) : integral hcf hMcf μ = c • integral hf hM μ := by + have key1 : Filter.Tendsto (fun n => c • simpleIntegral μ (meshWeight M n) (meshPiece f M n) + (isPartition_meshPiece hf hM n)) atTop (𝓝 (integral hcf hMcf μ)) := by + have heq : ∀ n, c • simpleIntegral μ (meshWeight M n) (meshPiece f M n) + (isPartition_meshPiece hf hM n) + = simpleIntegral μ (c • meshWeight M n) (meshPiece f M n) (isPartition_meshPiece hf hM n) := + fun n => (simpleIntegral_smul μ c _ _ _).symm + simp_rw [heq] + apply tendsto_of_uniformly_approximating hcf hMcf μ + (hs := fun n => isPartition_meshPiece hf hM n) (ε := fun n => |c| / ((n:ℝ)+1)) + (fun n => by positivity) + · simpa [div_eq_mul_inv] using + (tendsto_one_div_add_atTop_nhds_zero_nat (𝕜 := ℝ)).const_mul |c| + · intro n x + have h1 := abs_simpleValue_meshWeight_meshPiece_sub_le hf hM n x + rw [simpleValue_smul, show (c • f) x = c * f x by simp] + calc |c * simpleValue (meshWeight M n) (meshPiece f M n) x - c * f x| + = |c| * |simpleValue (meshWeight M n) (meshPiece f M n) x - f x| := by + rw [← mul_sub, abs_mul] + _ ≤ |c| * (1 / ((n:ℝ)+1)) := mul_le_mul_of_nonneg_left h1 (abs_nonneg c) + _ = |c| / ((n:ℝ)+1) := by ring + have key2 : Filter.Tendsto (fun n => c • simpleIntegral μ (meshWeight M n) (meshPiece f M n) + (isPartition_meshPiece hf hM n)) atTop (𝓝 (c • integral hf hM μ)) := + tendsto_const_smul_of_tendsto c (integral_tendsto hf hM μ) + exact tendsto_nhds_unique key1 key2 + +/-- The bounded integral in the explicit order-unit-norm copy of the real line. The generic +bounded-integral section intentionally fixes its order-unit norm as a local instance; this +wrapper supplies completeness for that *same* local topology via the real-line isometry, so users +of the copy never have to mix it with the ordinary scalar norm. -/ +noncomputable def scalarCopyIntegral {Ω : Type*} [MeasurableSpace Ω] + (f : Ω → ℝ) (hf : Measurable f) {M : ℝ} (hM : ∀ x, |f x| ≤ M) + (μ : EffectValuedMeasure Ω (WithOrderUnitNorm ℝ)) : WithOrderUnitNorm ℝ := by + let e : WithOrderUnitNorm ℝ ≃ₗᵢ[ℝ] ℝ := + { __ := (WithOrderUnitNorm.linearEquiv (E := ℝ)).symm + norm_map' := fun x => by + change |(show ℝ from x)| = IsArchimedeanOrderUnit.orderUnitNorm (show ℝ from x) + exact (IsArchimedeanOrderUnit.orderUnitNorm_real _).symm } + let hcomplete : CompleteSpace (WithOrderUnitNorm ℝ) := + (completeSpace_congr (e := e.toLinearEquiv.toEquiv) e.isometry.isUniformEmbedding).mpr + inferInstance + exact @integral Ω (WithOrderUnitNorm ℝ) _ _ _ _ _ _ _ _ hcomplete f hf M hM μ + +end Definition + +end EffectValuedMeasure diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/Effect/EffectValuedMeasure.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Effect/EffectValuedMeasure.lean new file mode 100644 index 0000000000..4a5302e144 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Effect/EffectValuedMeasure.lean @@ -0,0 +1,91 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Effect.Basic +public import Mathlib.MeasureTheory.MeasurableSpace.Defs +public import Mathlib.Algebra.BigOperators.Group.Finset.Defs + +/-! + +# Effect-valued measures + +## i. Overview + +An effect-valued measure assigns each measurable set an effect, with `∅ ↦ 0`, `univ ↦ 1`, and +countable additivity: the effects of a pairwise disjoint countable family have partial sums +(computed in `E`, since `Effect E` is not itself closed under addition) whose least upper bound +is the effect of their union. + +Once `E` is the self-adjoint part of an operator algebra, `Effect E` is a set of bounded +operators and this is exactly what the physics literature calls a POVM (positive +operator-valued measure). Nothing here is an operator, though: this layer only ever needed +`Effect E` to be bounded elements of an ordered vector space, which is why the name doesn't +mention operators. + +## ii. Key definitions and results + +- `EffectValuedMeasure Ω E` + +## iii. Table of contents + +- A. Effect-valued measures +- B. Basic API + +-/ + +@[expose] public section + +variable {Ω E : Type*} [MeasurableSpace Ω] [AddCommGroup E] [PartialOrder E] + [IsOrderedAddMonoid E] [One E] [IsOrderUnit E] + +/-! ## A. Effect-valued measures -/ + +/-- An effect-valued measure: `∅ ↦ 0`, `univ ↦ 1`, countably additive up to least upper bound. -/ +structure EffectValuedMeasure (Ω : Type*) [MeasurableSpace Ω] (E : Type*) [AddCommGroup E] + [PartialOrder E] [IsOrderedAddMonoid E] [One E] [IsOrderUnit E] where + /-- The underlying assignment of outcomes to effects. -/ + toFun : ∀ s : Set Ω, MeasurableSet s → Effect E + /-- The impossible outcome gets no weight. -/ + map_empty' : toFun ∅ MeasurableSet.empty = 0 + /-- The certain outcome gets full weight. -/ + map_univ' : toFun Set.univ MeasurableSet.univ = 1 + /-- The partial sums of a pairwise disjoint countable family have least upper bound the effect + of their union. -/ + countably_additive' : ∀ s : ℕ → Set Ω, ∀ hsm : ∀ n, MeasurableSet (s n), + ∀ _hs : ∀ m n, m ≠ n → Disjoint (s m) (s n), + IsLUB (Set.range fun N : ℕ => ∑ n ∈ Finset.range N, + ((toFun (s n) (hsm n) : Effect E) : E)) + ((toFun (⋃ n, s n) (MeasurableSet.iUnion hsm) : Effect E) : E) + +namespace EffectValuedMeasure + +/-! ## B. Basic API -/ + +instance : CoeFun (EffectValuedMeasure Ω E) fun _ => ∀ s : Set Ω, MeasurableSet s → Effect E where + coe m := m.toFun + +@[ext] +lemma ext {μ ν : EffectValuedMeasure Ω E} (h : ∀ s hs, μ s hs = ν s hs) : μ = ν := by + cases μ + cases ν + simp_all only [EffectValuedMeasure.mk.injEq] + funext s hs + exact h s hs + +@[simp] +lemma map_empty (μ : EffectValuedMeasure Ω E) : μ ∅ MeasurableSet.empty = 0 := μ.map_empty' + +@[simp] +lemma map_univ (μ : EffectValuedMeasure Ω E) : μ Set.univ MeasurableSet.univ = 1 := μ.map_univ' + +lemma countably_additive (μ : EffectValuedMeasure Ω E) (s : ℕ → Set Ω) + (hsm : ∀ n, MeasurableSet (s n)) (hs : ∀ m n, m ≠ n → Disjoint (s m) (s n)) : + IsLUB (Set.range fun N : ℕ => ∑ n ∈ Finset.range N, ((μ (s n) (hsm n) : Effect E) : E)) + ((μ (⋃ n, s n) (MeasurableSet.iUnion hsm) : Effect E) : E) := + μ.countably_additive' s hsm hs + +end EffectValuedMeasure diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/Effect/Integral.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Effect/Integral.lean new file mode 100644 index 0000000000..87d53fb04a --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Effect/Integral.lean @@ -0,0 +1,393 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Effect.EffectValuedMeasure + +/-! + +# Integrating a simple function against an effect-valued measure + +## i. Overview + +`EffectValuedMeasure Ω E` (`OrderUnit/Effect/EffectValuedMeasure.lean`'s POVM) already assigns an +effect to every measurable event. Physically, an *observable* with outcome space `(Ω, Σ)` is +recovered from its POVM `μ` by integration: `∫ f dμ ∈ E` for a bounded measurable `f : Ω → ℝ`, +generalizing the finite-outcome case (`Measurement.toChannel`, `Measurement/FiniteOutcome.lean`, +which is exactly `∫ · dμ` restricted to functions built from finitely many point masses on a +finite outcome space). + +The first, and hardest, step is integrating a *simple* function — one built from finitely many +measurable pieces `s : ι → Set Ω` (`Fintype ι`, pairwise disjoint, covering `Ω`) with real weights +`c : ι → ℝ`, i.e. the function `∑ i, c i • 𝟙_{s i}`. The naive definition `∑ i, c i • μ(s i)` +obviously depends on the chosen partition `(c, s)`, not just on the function it represents; the +crux fact making the construction sound is that it doesn't, *as long as `(c, s)` are read off +honestly*: two partitions representing the same function against the same `μ` give the same value. +That's `simpleIntegral_eq_of_pointwise_eq` below, proved by passing to the common refinement +`s i ∩ s' j` of the two partitions and using finite additivity of `μ` (itself derived here from the +countable additivity already built into `EffectValuedMeasure`, by padding a finite disjoint family +with `∅` and reading the eventual value off the least upper bound `countably_additive` promises, +since every value of `μ` is a nonnegative effect and the resulting partial sums are therefore +nondecreasing). + +This file stops at simple functions: extending to all bounded measurable functions by a +uniform-limit argument needs enough completeness of `E` to let the limit land somewhere, which +this generic order-unit layer does not yet provide (see `OrderUnit/Norm.lean`'s +`orderUnitNormedAddCommGroup`, which is a `def`, not a registered instance, precisely because no +canonical topology is fixed at this level of generality) — left as future work, see the docstring +remark at the end of this file. + +## ii. Key definitions and results + +- `EffectValuedMeasure.apply_union_of_disjoint` : binary additivity of `μ`, derived from the + countable additivity already in `EffectValuedMeasure`. +- `EffectValuedMeasure.apply_iUnion_of_disjoint` : finite additivity over a `Fintype`-indexed + pairwise disjoint family. +- `EffectValuedMeasure.IsPartition` : `s : ι → Set Ω` is a finite measurable partition of `Ω`. +- `EffectValuedMeasure.simpleValue` : the real-valued simple function `∑ i, c i • 𝟙_{s i}` + associated to a partition. +- `EffectValuedMeasure.simpleIntegral` : `∑ i, c i • μ(s i) ∈ E`. +- `EffectValuedMeasure.simpleIntegral_eq_of_pointwise_eq` : well-definedness — two partitions + giving the same `simpleValue` give the same `simpleIntegral`. +- `EffectValuedMeasure.simpleIntegral_add`, `simpleIntegral_smul` : linearity over a shared + partition (combined with well-definedness, this covers combining values from arbitrary + partitions, by first refining both to a shared one). +- `EffectValuedMeasure.simpleIntegral_nonneg` : positivity. + +## iii. Table of contents + +- A. Finite measurable partitions and simple functions +- B. Finite additivity +- C. The integral of a simple function +- D. Beyond simple functions + +-/ + +@[expose] public section + +namespace EffectValuedMeasure + +/-! ## A. Finite measurable partitions and the simple functions they carry + +Nothing here refers to `E` or to a POVM at all yet: a partition and the simple function it carries +are facts about `Ω` alone. -/ + +variable {Ω : Type*} [MeasurableSpace Ω] + +/-- `s` is a finite measurable partition of `Ω`: its pieces are measurable, pairwise disjoint, and +cover `Ω`. This is the "unbundled `he : ∑ i, e i = 1`" of `Measurement.toChannel` +(`FiniteOutcome.lean`) transported to the measure-theoretic setting: there, a finite family of +effects summing to the certain event; here, a finite family of sets whose indicators sum to the +constant function `1`. -/ +structure IsPartition {ι : Type*} [Fintype ι] (s : ι → Set Ω) : Prop where + /-- Every piece of the partition is measurable. -/ + measurable : ∀ i, MeasurableSet (s i) + /-- Distinct pieces of the partition are disjoint. -/ + disjoint : ∀ i j, i ≠ j → Disjoint (s i) (s j) + /-- The pieces cover all of `Ω`. -/ + cover : ⋃ i, s i = Set.univ + +/-- The real-valued simple function `∑ i, c i • 𝟙_{s i}` associated to a partition: `c i` weights +the piece `s i`. This is the classical-system counterpart of a POVM's effects: a genuine +`Ω → ℝ` function, well-defined at every point regardless of which partition is used to describe +it — the content of `simpleValue_eq_of_partition_eq`-style reasoning inside +`simpleIntegral_eq_of_pointwise_eq`. -/ +noncomputable def simpleValue {ι : Type*} [Fintype ι] (c : ι → ℝ) (s : ι → Set Ω) (x : Ω) : ℝ := + ∑ i, (s i).indicator (fun _ => c i) x + +/-- At a point lying in piece `i` of the partition, the simple function evaluates to `c i`: every +other term of the defining sum vanishes since the pieces are pairwise disjoint. -/ +lemma simpleValue_apply_of_mem {ι : Type*} [Fintype ι] {c : ι → ℝ} {s : ι → Set Ω} + (hs : IsPartition s) {x : Ω} {i : ι} (hx : x ∈ s i) : simpleValue c s x = c i := by + unfold simpleValue + rw [Finset.sum_eq_single i (fun j _ hji => Set.indicator_of_notMem + (fun hxj => absurd hx (Set.disjoint_left.mp (hs.disjoint j i hji) hxj)) _) + (fun h => absurd (Finset.mem_univ i) h)] + exact Set.indicator_of_mem hx _ + +end EffectValuedMeasure + +variable {Ω E : Type*} [MeasurableSpace Ω] [AddCommGroup E] [PartialOrder E] + [IsOrderedAddMonoid E] [Module ℝ E] [PosSMulMono ℝ E] [One E] [IsOrderUnit E] + +namespace EffectValuedMeasure + +/-! ## B. Finite additivity + +`EffectValuedMeasure` only bundles *countable* additivity (`countably_additive`). Finite +additivity is the special case of a family that is eventually `∅`, and the least upper bound of an +eventually-constant, nondecreasing sequence (nondecreasing since every value of `μ` is a +nonnegative effect) is just its eventual value — which is what lets us read finite sums off +`countably_additive` directly. -/ + +omit [Module ℝ E] [PosSMulMono ℝ E] in +/-- Applying `μ` only depends on the set, not on which proof of measurability is supplied — an +immediate consequence of `Set` equality and proof irrelevance, recorded here since it comes up +whenever a set is simplified (e.g. `if`-reduced) mid-computation. -/ +lemma apply_congr (μ : EffectValuedMeasure Ω E) {s t : Set Ω} (h : s = t) + {hs : MeasurableSet s} {ht : MeasurableSet t} : (μ s hs : E) = (μ t ht : E) := by + subst h; rfl + +omit [Module ℝ E] [PosSMulMono ℝ E] in +/-- Padding a finite disjoint family with `∅` and applying countable additivity: past the point +where every remaining piece is `∅`, the partial sums have stabilized, and since they are also +nondecreasing (every value of `μ` is a nonnegative effect), that stable value is already the least +upper bound `countably_additive` promises — so it computes `μ` of the union. -/ +lemma apply_iUnion_eq_sum_of_eventually_empty (μ : EffectValuedMeasure Ω E) (t : ℕ → Set Ω) + (htm : ∀ n, MeasurableSet (t n)) (htd : ∀ m n, m ≠ n → Disjoint (t m) (t n)) {N : ℕ} + (hN : ∀ n, N ≤ n → t n = ∅) : + (μ (⋃ n, t n) (MeasurableSet.iUnion htm) : E) = + ∑ n ∈ Finset.range N, (μ (t n) (htm n) : E) := by + set g : ℕ → E := fun n => (μ (t n) (htm n) : E) with hg_def + have hg0 : ∀ n, 0 ≤ g n := fun n => (μ (t n) (htm n)).2.1 + have hgN : ∀ n, N ≤ n → g n = 0 := fun n hn => by + show (μ (t n) (htm n) : E) = 0 + rw [apply_congr μ (hN n hn) (ht := MeasurableSet.empty)] + simp + have hPmono : Monotone (fun M => ∑ n ∈ Finset.range M, g n) := by + apply monotone_nat_of_le_succ + intro n + rw [Finset.sum_range_succ] + exact le_add_of_nonneg_right (hg0 n) + have hPstable : ∀ M, N ≤ M → (∑ n ∈ Finset.range M, g n) = ∑ n ∈ Finset.range N, g n := by + intro M hM + induction M, hM using Nat.le_induction with + | base => rfl + | succ M hM ih => rw [Finset.sum_range_succ, ih, hgN M hM, add_zero] + have hgreatest : IsGreatest (Set.range (fun M => ∑ n ∈ Finset.range M, g n)) + (∑ n ∈ Finset.range N, g n) := by + refine ⟨⟨N, rfl⟩, ?_⟩ + rintro _ ⟨M, rfl⟩ + rcases le_total M N with hMN | hMN + · exact hPmono hMN + · exact (hPstable M hMN).le + have hlub1 : IsLUB (Set.range (fun M => ∑ n ∈ Finset.range M, g n)) + (∑ n ∈ Finset.range N, g n) := hgreatest.isLUB + have hlub2 : IsLUB (Set.range (fun M => ∑ n ∈ Finset.range M, g n)) + (μ (⋃ n, t n) (MeasurableSet.iUnion htm) : E) := μ.countably_additive t htm htd + exact IsLUB.unique hlub2 hlub1 + +omit [Module ℝ E] [PosSMulMono ℝ E] in +/-- Binary additivity of `μ`, derived from countable additivity by padding a two-element family +with `∅`. -/ +lemma apply_union_of_disjoint (μ : EffectValuedMeasure Ω E) {A B : Set Ω} + (hA : MeasurableSet A) (hB : MeasurableSet B) (hAB : Disjoint A B) : + (μ (A ∪ B) (hA.union hB) : E) = (μ A hA : E) + (μ B hB : E) := by + classical + set t : ℕ → Set Ω := fun n => if n = 0 then A else if n = 1 then B else ∅ with ht_def + have htm : ∀ n, MeasurableSet (t n) := fun n => by + rw [ht_def] + show MeasurableSet (if n = 0 then A else if n = 1 then B else ∅) + split_ifs with h0 h1 + exacts [hA, hB, MeasurableSet.empty] + have htd : ∀ m n, m ≠ n → Disjoint (t m) (t n) := by + intro m n hmn + rw [ht_def] + show Disjoint (if m = 0 then A else if m = 1 then B else ∅) + (if n = 0 then A else if n = 1 then B else ∅) + split_ifs with hm0 hn0 hn0 hm1 hn1 hn1 + · exact absurd (hm0.trans hn0.symm) hmn + · exact hAB + · exact Set.disjoint_empty A + · exact hAB.symm + · exact absurd (hm1.trans hn1.symm) hmn + · exact Set.disjoint_empty B + · exact Set.empty_disjoint A + · exact Set.empty_disjoint B + · exact Set.disjoint_empty ∅ + have hUn : (⋃ n, t n) = A ∪ B := by + ext x + simp only [Set.mem_iUnion, ht_def] + constructor + · rintro ⟨n, hn⟩ + split_ifs at hn with h0 h1 + · exact Or.inl hn + · exact Or.inr hn + · exact absurd hn (Set.notMem_empty x) + · rintro (hx | hx) + · exact ⟨0, by simp [hx]⟩ + · exact ⟨1, by simp [hx]⟩ + have hN : ∀ n, 2 ≤ n → t n = ∅ := fun n hn => by + rw [ht_def] + show (if n = 0 then A else if n = 1 then B else ∅) = ∅ + have h0 : n ≠ 0 := by omega + have h1 : n ≠ 1 := by omega + simp [h0, h1] + have key := apply_iUnion_eq_sum_of_eventually_empty μ t htm htd (N := 2) hN + rw [apply_congr μ hUn (ht := hA.union hB)] at key + rw [key, Finset.sum_range_succ, Finset.sum_range_one] + refine congrArg₂ (· + ·) (apply_congr μ ?_) (apply_congr μ ?_) + · rw [ht_def]; simp + · rw [ht_def]; simp + +omit [Module ℝ E] [PosSMulMono ℝ E] in +/-- Finite additivity of `μ` over a pairwise disjoint family indexed by a `Finset`, with the +disjointness only required on the labels actually occurring in `s`. Proved by induction on the +`Finset`, peeling one element off at a time using binary additivity +(`apply_union_of_disjoint`). -/ +lemma apply_biUnion_of_disjoint {ι : Type*} [DecidableEq ι] (μ : EffectValuedMeasure Ω E) + (f : ι → Set Ω) (hfm : ∀ i, MeasurableSet (f i)) (s : Finset ι) + (hfd : ∀ i ∈ s, ∀ j ∈ s, i ≠ j → Disjoint (f i) (f j)) : + (μ (⋃ i ∈ s, f i) (s.measurableSet_biUnion fun i _ => hfm i) : E) = + ∑ i ∈ s, (μ (f i) (hfm i) : E) := by + induction s using Finset.induction with + | empty => + refine (apply_congr μ ?_ (ht := MeasurableSet.empty)).trans ?_ + · simp + · simp [μ.map_empty] + | insert a s ha ih => + have hfd' : ∀ i ∈ s, ∀ j ∈ s, i ≠ j → Disjoint (f i) (f j) := fun i hi j hj => + hfd i (Finset.mem_insert_of_mem hi) j (Finset.mem_insert_of_mem hj) + have hdisj : Disjoint (f a) (⋃ i ∈ s, f i) := by + rw [Set.disjoint_iUnion_right] + intro i + rw [Set.disjoint_iUnion_right] + intro hi + exact hfd a (Finset.mem_insert_self a s) i (Finset.mem_insert_of_mem hi) + (ne_of_mem_of_not_mem hi ha).symm + have hUn : (⋃ i ∈ insert a s, f i) = f a ∪ ⋃ i ∈ s, f i := by + ext x + simp only [Set.mem_iUnion, Finset.mem_insert, Set.mem_union] + constructor + · rintro ⟨i, hi | hi, hx⟩ + · exact Or.inl (hi ▸ hx) + · exact Or.inr ⟨i, hi, hx⟩ + · rintro (hx | ⟨i, hi, hx⟩) + · exact ⟨a, Or.inl rfl, hx⟩ + · exact ⟨i, Or.inr hi, hx⟩ + have step := + apply_union_of_disjoint μ (hfm a) (s.measurableSet_biUnion fun i _ => hfm i) hdisj + rw [apply_congr μ hUn + (ht := (hfm a).union (s.measurableSet_biUnion fun i _ => hfm i))] + rw [step, ih hfd', Finset.sum_insert ha] + +omit [Module ℝ E] [PosSMulMono ℝ E] in +/-- Finite additivity of `μ` over a `Fintype`-indexed pairwise disjoint family: the workhorse used +throughout the rest of this file. -/ +lemma apply_iUnion_of_disjoint {ι : Type*} [Fintype ι] [DecidableEq ι] + (μ : EffectValuedMeasure Ω E) (f : ι → Set Ω) (hfm : ∀ i, MeasurableSet (f i)) + (hfd : ∀ i j, i ≠ j → Disjoint (f i) (f j)) : + (μ (⋃ i, f i) (MeasurableSet.iUnion hfm) : E) = ∑ i, (μ (f i) (hfm i) : E) := by + have h := apply_biUnion_of_disjoint μ f hfm Finset.univ (fun i _ j _ hij => hfd i j hij) + rw [apply_congr μ (t := ⋃ i, f i) (by simp) (ht := MeasurableSet.iUnion hfm)] at h + simpa using h + +/-! ## C. The integral of a simple function -/ + +/-- The integral of the simple function `∑ i, c i • 𝟙_{s i}` against `μ`: `∑ i, c i • μ(s i)`. +Well-defined independently of the chosen partition by `simpleIntegral_eq_of_pointwise_eq`, and +this is exactly `Measurement.toChannel` (`FiniteOutcome.lean`) in the case where every piece of +the partition is a single point mass. -/ +noncomputable def simpleIntegral {ι : Type*} [Fintype ι] (μ : EffectValuedMeasure Ω E) + (c : ι → ℝ) (s : ι → Set Ω) (hs : IsPartition s) : E := + ∑ i, c i • (μ (s i) (hs.measurable i) : E) + +omit [Module ℝ E] [PosSMulMono ℝ E] in +/-- On a partition, the piece `s i` decomposes as the union of its intersections with every piece +of a second partition `s'`: `s'` covers `Ω`, so intersecting with `s i` covers `s i`. Used to +refine two partitions to their common refinement in `simpleIntegral_eq_of_pointwise_eq`. -/ +private lemma apply_eq_sum_inter {ι ι' : Type*} [Fintype ι] [Fintype ι'] [DecidableEq ι'] + (μ : EffectValuedMeasure Ω E) {s : ι → Set Ω} {s' : ι' → Set Ω} (hs : IsPartition s) + (hs' : IsPartition s') (i : ι) : + (μ (s i) (hs.measurable i) : E) = + ∑ j, (μ (s i ∩ s' j) ((hs.measurable i).inter (hs'.measurable j)) : E) := by + have hi_eq : s i = ⋃ j, s i ∩ s' j := by + rw [← Set.inter_iUnion, hs'.cover, Set.inter_univ] + rw [apply_congr μ hi_eq + (ht := MeasurableSet.iUnion fun j => (hs.measurable i).inter (hs'.measurable j))] + exact apply_iUnion_of_disjoint μ (fun j => s i ∩ s' j) + (fun j => (hs.measurable i).inter (hs'.measurable j)) + (fun j k hjk => Disjoint.mono Set.inter_subset_right Set.inter_subset_right + (hs'.disjoint j k hjk)) + +omit [Module ℝ E] [PosSMulMono ℝ E] in +/-- The symmetric counterpart of `apply_eq_sum_inter`, with the roles of the two partitions +swapped: the piece `s' j` decomposes as the union of its intersections with every piece of `s`. -/ +private lemma apply_eq_sum_inter' {ι ι' : Type*} [Fintype ι] [Fintype ι'] [DecidableEq ι] + (μ : EffectValuedMeasure Ω E) {s : ι → Set Ω} {s' : ι' → Set Ω} (hs : IsPartition s) + (hs' : IsPartition s') (j : ι') : + (μ (s' j) (hs'.measurable j) : E) = + ∑ i, (μ (s i ∩ s' j) ((hs.measurable i).inter (hs'.measurable j)) : E) := by + rw [apply_eq_sum_inter μ hs' hs j] + exact Finset.sum_congr rfl fun i _ => apply_congr μ (Set.inter_comm (s' j) (s i)) + +omit [PosSMulMono ℝ E] in +/-- **Well-definedness of the simple integral.** Two partitions computing the same simple function +pointwise give the same integral against `μ`: refine both to the common partition `s i ∩ s' j`, +where finite additivity turns each side into the same double sum, since a nonempty piece +`s i ∩ s' j` forces `c i = c' j` (both must equal the common function's value there, by +`simpleValue_apply_of_mem`) while an empty piece contributes `0` to both sides regardless. This is +the crux fact making `simpleIntegral` a genuine integral of a function, rather than of an arbitrary +partition-and-weights presentation. -/ +theorem simpleIntegral_eq_of_pointwise_eq {ι ι' : Type*} [Fintype ι] [Fintype ι'] [DecidableEq ι] + [DecidableEq ι'] (μ : EffectValuedMeasure Ω E) (c : ι → ℝ) (s : ι → Set Ω) (hs : IsPartition s) + (c' : ι' → ℝ) + (s' : ι' → Set Ω) (hs' : IsPartition s') + (hval : ∀ x, simpleValue c s x = simpleValue c' s' x) : + simpleIntegral μ c s hs = simpleIntegral μ c' s' hs' := by + have hterm : ∀ i j, c i • (μ (s i ∩ s' j) ((hs.measurable i).inter (hs'.measurable j)) : E) = + c' j • (μ (s i ∩ s' j) ((hs.measurable i).inter (hs'.measurable j)) : E) := by + intro i j + rcases Set.eq_empty_or_nonempty (s i ∩ s' j) with hempty | ⟨x, hx⟩ + · rw [apply_congr μ hempty (ht := MeasurableSet.empty)] + simp + · have hci : c i = simpleValue c s x := (simpleValue_apply_of_mem hs hx.1).symm + have hcj : c' j = simpleValue c' s' x := (simpleValue_apply_of_mem hs' hx.2).symm + rw [hci, hcj, hval x] + have hlhs : simpleIntegral μ c s hs = + ∑ i, ∑ j, c i • (μ (s i ∩ s' j) ((hs.measurable i).inter (hs'.measurable j)) : E) := by + unfold simpleIntegral + refine Finset.sum_congr rfl fun i _ => ?_ + rw [apply_eq_sum_inter μ hs hs' i, Finset.smul_sum] + have hrhs : simpleIntegral μ c' s' hs' = + ∑ i, ∑ j, c' j • (μ (s i ∩ s' j) ((hs.measurable i).inter (hs'.measurable j)) : E) := by + unfold simpleIntegral + have step : ∑ j, c' j • (μ (s' j) (hs'.measurable j) : E) = + ∑ j, ∑ i, c' j • (μ (s i ∩ s' j) ((hs.measurable i).inter (hs'.measurable j)) : E) := by + refine Finset.sum_congr rfl fun j _ => ?_ + rw [apply_eq_sum_inter' μ hs hs' j, Finset.smul_sum] + rw [step, Finset.sum_comm] + rw [hlhs, hrhs] + exact Finset.sum_congr rfl fun i _ => Finset.sum_congr rfl fun j _ => hterm i j + +variable {ι : Type*} [Fintype ι] + +omit [PosSMulMono ℝ E] in +/-- The simple integral is additive in the weights, over a fixed partition. -/ +lemma simpleIntegral_add (μ : EffectValuedMeasure Ω E) (c₁ c₂ : ι → ℝ) (s : ι → Set Ω) + (hs : IsPartition s) : + simpleIntegral μ (c₁ + c₂) s hs = simpleIntegral μ c₁ s hs + simpleIntegral μ c₂ s hs := by + unfold simpleIntegral + rw [← Finset.sum_add_distrib] + exact Finset.sum_congr rfl fun i _ => by rw [Pi.add_apply, add_smul] + +omit [PosSMulMono ℝ E] in +/-- The simple integral is homogeneous in the weights, over a fixed partition. -/ +lemma simpleIntegral_smul (μ : EffectValuedMeasure Ω E) (r : ℝ) (c : ι → ℝ) (s : ι → Set Ω) + (hs : IsPartition s) : + simpleIntegral μ (r • c) s hs = r • simpleIntegral μ c s hs := by + unfold simpleIntegral + rw [Finset.smul_sum] + exact Finset.sum_congr rfl fun i _ => by rw [Pi.smul_apply, smul_eq_mul, mul_smul] + +/-- The simple integral of a nonnegative simple function is nonnegative — matching `μ`'s own +positivity: every term `c i • μ(s i)` is a nonnegative scalar times a nonnegative effect. -/ +lemma simpleIntegral_nonneg (μ : EffectValuedMeasure Ω E) {c : ι → ℝ} (hc : ∀ i, 0 ≤ c i) + (s : ι → Set Ω) (hs : IsPartition s) : 0 ≤ simpleIntegral μ c s hs := + Finset.sum_nonneg fun i _ => smul_nonneg (hc i) (μ (s i) (hs.measurable i)).2.1 + +/-! +## D. Beyond simple functions + +Extending `simpleIntegral` to all bounded measurable functions — the standard uniform-limit +construction, approximating `f` by simple functions on a mesh of the right width and passing to the +limit under an explicit `[CompleteSpace E]` hypothesis against the order-unit norm +(`IsArchimedeanOrderUnit.orderUnitNorm`, `OrderUnit/Norm.lean`) — is built in +`OrderUnit/Effect/BoundedIntegral.lean`: `EffectValuedMeasure.integral`, independence of the +approximating sequence, linearity, and positivity, all proved in full. +-/ + +end EffectValuedMeasure diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/MonotoneComplete.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/MonotoneComplete.lean new file mode 100644 index 0000000000..e14f19b390 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/MonotoneComplete.lean @@ -0,0 +1,65 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Basic + +/-! + +# Monotone-complete ordered spaces + +Monotone completeness is order-theoretic: every nonempty upward-directed set which is bounded +above has a least upper bound. It therefore belongs below the Jordan and JBW layers. Those +layers consume this class; they do not redefine directed suprema. + +-/ + +@[expose] public section + +/-- An order is monotone complete when every nonempty upward-directed bounded set has a supremum. +No lattice operations are bundled: ordered vector spaces need not be lattices. -/ +class MonotoneCompleteOrder (E : Type*) [Preorder E] : Prop where + /-- Existence of the directed supremum. -/ + exists_isLUB (D : Set E) : D.Nonempty → DirectedOn (· ≤ ·) D → BddAbove D → + ∃ x : E, IsLUB D x + +namespace MonotoneCompleteOrder + +variable {E : Type*} [Preorder E] [MonotoneCompleteOrder E] + +/-- A chosen supremum for a nonempty upward-directed bounded set. The choice is deliberately +confined to this order-theoretic layer; algebraic and JBW layers use its `isLUB_directedSup` +specification rather than introducing competing supremum operations. -/ +noncomputable def directedSup (D : Set E) (hD : D.Nonempty) + (hdir : DirectedOn (· ≤ ·) D) (hbdd : BddAbove D) : E := + Classical.choose (exists_isLUB D hD hdir hbdd) + +theorem isLUB_directedSup (D : Set E) (hD : D.Nonempty) + (hdir : DirectedOn (· ≤ ·) D) (hbdd : BddAbove D) : + IsLUB D (directedSup D hD hdir hbdd) := + Classical.choose_spec (exists_isLUB D hD hdir hbdd) + +/-- A monotone sequence with a common upper bound has a least upper bound. -/ +theorem exists_isLUB_range (x : ℕ → E) (hx : Monotone x) (hbounded : BddAbove (Set.range x)) : + ∃ a : E, IsLUB (Set.range x) a := by + apply exists_isLUB + · exact ⟨x 0, Set.mem_range_self 0⟩ + · exact hx.directed_le.directedOn_range + · exact hbounded + +/-- The chosen supremum of a bounded increasing sequence. -/ +noncomputable def rangeSup (x : ℕ → E) (hx : Monotone x) + (hbounded : BddAbove (Set.range x)) : E := + directedSup (Set.range x) ⟨x 0, Set.mem_range_self 0⟩ + hx.directed_le.directedOn_range hbounded + +theorem isLUB_rangeSup (x : ℕ → E) (hx : Monotone x) + (hbounded : BddAbove (Set.range x)) : + IsLUB (Set.range x) (rangeSup x hx hbounded) := + isLUB_directedSup (Set.range x) ⟨x 0, Set.mem_range_self 0⟩ + hx.directed_le.directedOn_range hbounded + +end MonotoneCompleteOrder diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/Norm.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Norm.lean new file mode 100644 index 0000000000..6944a6bbd7 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Norm.lean @@ -0,0 +1,459 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Mathlib.Analysis.Normed.Module.Basic +public import Mathlib.Analysis.Normed.Operator.LinearIsometry +public import Mathlib.Topology.Sequences +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Basic +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Channel.Basic + +/-! + +# The order-unit norm + +## i. Overview + +`IsOrderUnit` only lets us compare outcomes to `1`; `IsArchimedeanOrderUnit` is what turns that +into an actual distance. `orderUnitNorm x` is the least `r` with `-r • 1 ≤ x ≤ r • 1` — how many +copies of the certain outcome it takes to sandwich `x` on both sides. This is a genuine norm, not +just a seminorm, exactly because nothing is infinitesimally close to `0` without being `0`. + +## ii. Key definitions and results + +- `IsArchimedeanOrderUnit.orderUnitNorm` +- `IsArchimedeanOrderUnit.orderUnitNormedAddCommGroup` +- `IsArchimedeanOrderUnit.isClosed_nonneg_orderUnitNorm` + +## iii. Table of contents + +- A. Order-unit bounds +- B. Norm laws +- C. Positive definiteness +- D. The induced normed group + +-/ + +@[expose] public section + +namespace IsArchimedeanOrderUnit + +variable {E : Type*} [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] [Module ℝ E] + [PosSMulMono ℝ E] [One E] [IsArchimedeanOrderUnit E] + +/-! ## A. Order-unit bounds -/ + +/-- The nonnegative real bounds of `x` by the order unit. -/ +def orderUnitBounds (x : E) : Set ℝ := + {r | 0 ≤ r ∧ -(r • (1 : E)) ≤ x ∧ x ≤ r • (1 : E)} + +/-- The order-unit norm of `x`: the least nonnegative real `r` such that +`-r • 1 ≤ x ≤ r • 1`. -/ +noncomputable def orderUnitNorm (x : E) : ℝ := sInf (orderUnitBounds x) + +/-- Every element has an order-unit bound. -/ +lemma orderUnitBounds_nonempty (x : E) : (orderUnitBounds x).Nonempty := by + obtain ⟨n, hn⟩ := IsOrderUnit.exists_nsmul_one_le x + obtain ⟨m, hm⟩ := IsOrderUnit.exists_nsmul_one_le (-x) + have hn' : x ≤ (n : ℝ) • (1 : E) := by + simpa only [Nat.cast_smul_eq_nsmul] using hn + have hm' : -x ≤ (m : ℝ) • (1 : E) := by + simpa only [Nat.cast_smul_eq_nsmul] using hm + let r : ℝ := max (n : ℝ) m + have hr_nonneg : 0 ≤ r := by + dsimp [r] + exact le_trans (Nat.cast_nonneg n) (le_max_left _ _) + refine ⟨r, hr_nonneg, ?_, ?_⟩ + · have hmr : (m : ℝ) ≤ r := by + dsimp [r] + exact le_max_right _ _ + have hnonneg : 0 ≤ (r - m) • (1 : E) := + smul_nonneg (sub_nonneg.mpr hmr) IsOrderUnit.one_nonneg + have hle : (m : ℝ) • (1 : E) ≤ r • (1 : E) := by + calc + (m : ℝ) • (1 : E) = r • (1 : E) - (r - m) • (1 : E) := by + rw [← sub_smul, sub_sub_cancel] + _ ≤ r • (1 : E) := sub_le_self _ hnonneg + simpa only [neg_smul, neg_neg] using (neg_le_neg hle).trans (neg_le_neg hm') + · have hnr : (n : ℝ) ≤ r := by + dsimp [r] + exact le_max_left _ _ + have hnonneg : 0 ≤ (r - n) • (1 : E) := + smul_nonneg (sub_nonneg.mpr hnr) IsOrderUnit.one_nonneg + calc + x ≤ (n : ℝ) • (1 : E) := hn' + _ = r • (1 : E) - (r - n) • (1 : E) := by + rw [← sub_smul, sub_sub_cancel] + _ ≤ r • (1 : E) := sub_le_self _ hnonneg + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsArchimedeanOrderUnit E] in +/-- The order-unit bounds are bounded below by zero. -/ +lemma orderUnitBounds_bddBelow (x : E) : BddBelow (orderUnitBounds x) := + ⟨0, fun _ hr ↦ hr.1⟩ + +/-- The order-unit norm is nonnegative. -/ +lemma orderUnitNorm_nonneg (x : E) : 0 ≤ orderUnitNorm x := + le_csInf (orderUnitBounds_nonempty x) fun _ hr ↦ hr.1 + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsArchimedeanOrderUnit E] in +/-- Any order-unit bound is an upper bound for the order-unit norm. -/ +lemma orderUnitNorm_le {x : E} {r : ℝ} (hr : r ∈ orderUnitBounds x) : orderUnitNorm x ≤ r := + csInf_le (orderUnitBounds_bddBelow x) hr + +/-! ## B. Norm laws -/ + +/-- The order-unit norm of zero is zero. -/ +@[simp] +lemma orderUnitNorm_zero : orderUnitNorm (0 : E) = 0 := by + apply le_antisymm + · exact orderUnitNorm_le ⟨le_rfl, by simp, by simp⟩ + · exact orderUnitNorm_nonneg 0 + +omit [PosSMulMono ℝ E] [IsArchimedeanOrderUnit E] in +/-- Negating an element preserves its order-unit bounds. -/ +lemma orderUnitBounds_neg (x : E) : orderUnitBounds (-x) = orderUnitBounds x := by + ext r + constructor + · rintro ⟨hr, hlow, hupp⟩ + exact ⟨hr, by simpa only [neg_neg] using neg_le_neg hupp, + by simpa only [neg_smul, neg_neg] using neg_le_neg hlow⟩ + · rintro ⟨hr, hlow, hupp⟩ + exact ⟨hr, by simpa only [neg_neg] using neg_le_neg hupp, + by simpa only [neg_smul, neg_neg] using neg_le_neg hlow⟩ + +omit [PosSMulMono ℝ E] [IsArchimedeanOrderUnit E] in +/-- Negating an element preserves its order-unit norm. -/ +lemma orderUnitNorm_neg (x : E) : orderUnitNorm (-x) = orderUnitNorm x := by + unfold orderUnitNorm + rw [orderUnitBounds_neg] + +omit [PosSMulMono ℝ E] [IsArchimedeanOrderUnit E] in +/-- The sum of two order-unit bounds is an order-unit bound of the sum. -/ +lemma add_mem_orderUnitBounds {x y : E} {r s : ℝ} (hr : r ∈ orderUnitBounds x) + (hs : s ∈ orderUnitBounds y) : r + s ∈ orderUnitBounds (x + y) := by + refine ⟨add_nonneg hr.1 hs.1, ?_, ?_⟩ + · rw [add_smul, neg_add] + exact add_le_add hr.2.1 hs.2.1 + · rw [add_smul] + exact add_le_add hr.2.2 hs.2.2 + +/-- Order-unit bounds approximate the order-unit norm arbitrarily closely from above. -/ +lemma exists_orderUnitBound_lt_orderUnitNorm_add (x : E) {ε : ℝ} (hε : 0 < ε) : + ∃ r ∈ orderUnitBounds x, r < orderUnitNorm x + ε := by + apply exists_lt_of_csInf_lt (orderUnitBounds_nonempty x) + change sInf (orderUnitBounds x) < sInf (orderUnitBounds x) + ε + exact lt_add_of_pos_right _ hε + +/-- The order-unit norm satisfies the triangle inequality. -/ +lemma orderUnitNorm_add_le (x y : E) : + orderUnitNorm (x + y) ≤ orderUnitNorm x + orderUnitNorm y := by + apply le_of_forall_pos_le_add + intro ε hε + obtain ⟨r, hr, hr_lt⟩ := exists_orderUnitBound_lt_orderUnitNorm_add x (half_pos hε) + obtain ⟨s, hs, hs_lt⟩ := exists_orderUnitBound_lt_orderUnitNorm_add y (half_pos hε) + calc + orderUnitNorm (x + y) ≤ r + s := orderUnitNorm_le (add_mem_orderUnitBounds hr hs) + _ ≤ (orderUnitNorm x + ε / 2) + (orderUnitNorm y + ε / 2) := + add_le_add hr_lt.le hs_lt.le + _ = orderUnitNorm x + orderUnitNorm y + ε := by + rw [show (orderUnitNorm x + ε / 2) + (orderUnitNorm y + ε / 2) = + (orderUnitNorm x + orderUnitNorm y) + (ε / 2 + ε / 2) by ac_rfl, add_halves] + +private lemma orderUnitNorm_smul_le_of_nonneg {c : ℝ} (hc : 0 ≤ c) (x : E) : + orderUnitNorm (c • x) ≤ c * orderUnitNorm x := by + apply le_of_forall_pos_le_add + intro ε hε + rcases hc.eq_or_lt with rfl | hc + · simpa using hε.le + · obtain ⟨r, hr, hrlt⟩ := exists_orderUnitBound_lt_orderUnitNorm_add x (div_pos hε hc) + have hmem : c * r ∈ orderUnitBounds (c • x) := by + refine ⟨mul_nonneg hc.le hr.1, ?_, ?_⟩ + · calc -((c * r) • (1 : E)) = c • (-(r • (1 : E))) := by module + _ ≤ c • x := smul_le_smul_of_nonneg_left hr.2.1 hc.le + · calc c • x ≤ c • (r • (1 : E)) := smul_le_smul_of_nonneg_left hr.2.2 hc.le + _ = (c * r) • (1 : E) := by module + calc + orderUnitNorm (c • x) ≤ c * r := orderUnitNorm_le hmem + _ ≤ c * (orderUnitNorm x + ε / c) := (mul_lt_mul_of_pos_left hrlt hc).le + _ = c * orderUnitNorm x + ε := by field_simp + +/-- The order-unit norm is bounded by the usual product under real scalar multiplication. -/ +lemma orderUnitNorm_smul_le (c : ℝ) (x : E) : + orderUnitNorm (c • x) ≤ |c| * orderUnitNorm x := by + rcases le_total 0 c with hc | hc + · rw [abs_of_nonneg hc] + exact orderUnitNorm_smul_le_of_nonneg hc x + · rw [abs_of_nonpos hc, show c • x = -((-c) • x) by rw [neg_smul, neg_neg], + orderUnitNorm_neg] + exact orderUnitNorm_smul_le_of_nonneg (neg_nonneg.mpr hc) x + +/-- The order-unit norm is absolutely homogeneous under real scalar multiplication. -/ +lemma orderUnitNorm_smul (c : ℝ) (x : E) : + orderUnitNorm (c • x) = |c| * orderUnitNorm x := by + apply le_antisymm (orderUnitNorm_smul_le c x) + rcases eq_or_ne c 0 with rfl | hc + · simp + · have hback := orderUnitNorm_smul_le c⁻¹ (c • x) + rw [inv_smul_smul₀ hc, abs_inv] at hback + calc + |c| * orderUnitNorm x ≤ |c| * (|c|⁻¹ * orderUnitNorm (c • x)) := + mul_le_mul_of_nonneg_left hback (abs_nonneg c) + _ = orderUnitNorm (c • x) := by field_simp + +private lemma smul_one_mono {r s : ℝ} (hrs : r ≤ s) : + r • (1 : E) ≤ s • (1 : E) := by + have hnonneg : 0 ≤ (s - r) • (1 : E) := + smul_nonneg (sub_nonneg.mpr hrs) IsOrderUnit.one_nonneg + calc + r • (1 : E) = s • (1 : E) - (s - r) • (1 : E) := by + rw [← sub_smul, sub_sub_cancel] + _ ≤ s • (1 : E) := sub_le_self _ hnonneg + +/-- The order-unit norm itself is an upper order-unit bound, rather than merely the infimum of +strictly larger bounds. This is exactly where Archimedeanity closes the positive cone. -/ +lemma le_orderUnitNorm_smul_one (x : E) : x ≤ orderUnitNorm x • (1 : E) := by + apply sub_nonpos.mp + apply IsArchimedeanOrderUnit.le_zero_of_forall_pos_smul_one_le + intro ε hε + obtain ⟨r, hr, hrlt⟩ := exists_orderUnitBound_lt_orderUnitNorm_add x hε + calc + x - orderUnitNorm x • (1 : E) ≤ r • (1 : E) - orderUnitNorm x • (1 : E) := + sub_le_sub_right hr.2.2 _ + _ = (r - orderUnitNorm x) • (1 : E) := by rw [sub_smul] + _ ≤ ε • (1 : E) := smul_one_mono (by linarith) + +/-- The order-unit norm itself is also a lower order-unit bound. -/ +lemma neg_orderUnitNorm_smul_one_le (x : E) : -(orderUnitNorm x • (1 : E)) ≤ x := by + have h := le_orderUnitNorm_smul_one (-x) + rw [orderUnitNorm_neg] at h + simpa only [neg_smul, neg_neg] using neg_le_neg h + +/-- The infimum defining the order-unit norm is attained. -/ +lemma orderUnitNorm_mem_orderUnitBounds (x : E) : orderUnitNorm x ∈ orderUnitBounds x := + ⟨orderUnitNorm_nonneg x, neg_orderUnitNorm_smul_one_le x, le_orderUnitNorm_smul_one x⟩ + +/-- A nonnegative scalar bounds `x` by the order unit exactly when it is at least the +order-unit norm. -/ +lemma mem_orderUnitBounds_iff {x : E} {r : ℝ} : + r ∈ orderUnitBounds x ↔ orderUnitNorm x ≤ r := by + constructor + · exact orderUnitNorm_le + · intro h + exact ⟨orderUnitNorm_nonneg x |>.trans h, + (neg_le_neg (smul_one_mono h)).trans (neg_orderUnitNorm_smul_one_le x), + (le_orderUnitNorm_smul_one x).trans (smul_one_mono h)⟩ + +/-! ## C. Positive definiteness -/ + +/-- If the order-unit norm of `x` vanishes, `x` lies below every positive multiple of the unit. -/ +lemma le_pos_smul_one_of_orderUnitNorm_eq_zero {x : E} (hx : orderUnitNorm x = 0) + {ε : ℝ} (hε : 0 < ε) : x ≤ ε • (1 : E) := by + have hlt : orderUnitNorm x < ε := hx ▸ hε + change sInf (orderUnitBounds x) < ε at hlt + obtain ⟨r, hr, hrε⟩ := exists_lt_of_csInf_lt (orderUnitBounds_nonempty x) hlt + have hnonneg : 0 ≤ (ε - r) • (1 : E) := + smul_nonneg (sub_nonneg.mpr hrε.le) IsOrderUnit.one_nonneg + have hbound : r • (1 : E) ≤ ε • (1 : E) := by + calc + r • (1 : E) = ε • (1 : E) - (ε - r) • (1 : E) := by + rw [← sub_smul, sub_sub_cancel] + _ ≤ ε • (1 : E) := sub_le_self _ hnonneg + exact hr.2.2.trans hbound + +/-- The order-unit norm is positive-definite precisely because the order unit is Archimedean: +this is what tells apart two outcomes with `orderUnitNorm (x - y) = 0` as actually the same +outcome, not two indistinguishable-but-different ones. -/ +lemma orderUnitNorm_eq_zero_iff {x : E} : orderUnitNorm x = 0 ↔ x = 0 := by + constructor + · intro hx + have hle_zero : x ≤ 0 := IsArchimedeanOrderUnit.le_zero_of_forall_pos_smul_one_le x + fun _ hε ↦ le_pos_smul_one_of_orderUnitNorm_eq_zero hx hε + have hneg : orderUnitNorm (-x) = 0 := by simpa only [orderUnitNorm_neg] using hx + have hnonneg : 0 ≤ x := neg_nonpos.mp <| + IsArchimedeanOrderUnit.le_zero_of_forall_pos_smul_one_le (-x) + fun _ hε ↦ le_pos_smul_one_of_orderUnitNorm_eq_zero hneg hε + exact le_antisymm hle_zero hnonneg + · rintro rfl + exact orderUnitNorm_zero + +/-! ## D. The induced normed group -/ + +/-- The order-unit norm packaged as an additive-group norm. -/ +noncomputable def orderUnitAddGroupNorm : AddGroupNorm E where + toFun := orderUnitNorm + map_zero' := orderUnitNorm_zero + add_le' := orderUnitNorm_add_le + neg' := orderUnitNorm_neg + eq_zero_of_map_eq_zero' _x hx := orderUnitNorm_eq_zero_iff.mp hx + +/-- The additive normed-group structure induced by the order-unit norm: `E` is now a genuine +metric space, with `orderUnitNorm (x - y)` the distance between two outcomes. -/ +@[instance_reducible] +noncomputable def orderUnitNormedAddCommGroup : NormedAddCommGroup E := + orderUnitAddGroupNorm.toNormedAddCommGroup + +/-- The real normed-space structure induced by the order-unit norm. This is a reducible +definition rather than an instance because `E` may already carry a different normed-space +structure whose norm must first be proved equal to the order-unit norm. -/ +@[instance_reducible] +noncomputable def orderUnitNormedSpace : + @NormedSpace ℝ E _ + (orderUnitNormedAddCommGroup (E := E)).toSeminormedAddCommGroup := by + letI := orderUnitNormedAddCommGroup (E := E) + refine ⟨?_⟩ + intro c x + change orderUnitNorm (c • x) ≤ |c| * orderUnitNorm x + exact orderUnitNorm_smul_le c x + +/-! ## E. Closedness of the positive cone -/ + +/-- The positive cone is closed in the topology induced by the order-unit norm. -/ +lemma isClosed_nonneg_orderUnitNorm : + let _ := orderUnitNormedAddCommGroup (E := E) + IsClosed {x : E | 0 ≤ x} := by + let _ := orderUnitNormedAddCommGroup (E := E) + apply IsSeqClosed.isClosed + intro x p hx hp + apply neg_nonpos.mp + apply IsArchimedeanOrderUnit.le_zero_of_forall_pos_smul_one_le + intro ε hε + obtain ⟨N, hN⟩ := Metric.tendsto_atTop.mp hp ε hε + have hdist := hN N le_rfl + have hnorm : orderUnitNorm (p - x N) < ε := by + rw [dist_eq_norm] at hdist + change orderUnitNorm (x N - p) < ε at hdist + calc + orderUnitNorm (p - x N) = orderUnitNorm (-(p - x N)) := + (orderUnitNorm_neg (p - x N)).symm + _ = orderUnitNorm (x N - p) := by rw [neg_sub] + _ < ε := hdist + have hdiff : -(ε • (1 : E)) ≤ p - x N := by + exact (neg_le_neg (smul_one_mono hnorm.le)).trans + (neg_orderUnitNorm_smul_one_le (p - x N)) + have hnegp : -p ≤ ε • (1 : E) - x N := by + have hshift := add_le_add_right (neg_le_neg hdiff) (-x N) + convert hshift using 1 <;> abel + calc + -p ≤ ε • (1 : E) - x N := hnegp + _ ≤ ε • (1 : E) := sub_le_self _ (hx N) + +end IsArchimedeanOrderUnit + +namespace IsArchimedeanOrderUnit + +/-- For the classical order unit `1 : ℝ`, the order-unit norm is the ordinary absolute value. +This is the scalar coherence fact needed when a construction based on the order-unit norm is +compared with ordinary real analysis. -/ +theorem orderUnitNorm_real (x : ℝ) : orderUnitNorm x = |x| := by + apply le_antisymm + · apply orderUnitNorm_le + refine ⟨abs_nonneg x, ?_, ?_⟩ + · simpa [smul_eq_mul] using neg_abs_le x + · simpa [smul_eq_mul] using le_abs_self x + · apply abs_le.mpr + constructor + · simpa [smul_eq_mul] using neg_orderUnitNorm_smul_one_le x + · simpa [smul_eq_mul] using le_orderUnitNorm_smul_one x + +end IsArchimedeanOrderUnit + +/-! ## F. A first-class copy carrying the order-unit norm -/ + +/-- A type synonym of `E` equipped canonically with its order-unit norm. The original type is +left untouched, so this construction remains usable even when `E` already carries a different +norm intended for another purpose. -/ +def WithOrderUnitNorm (E : Type*) := E + +namespace WithOrderUnitNorm + +variable {E : Type*} [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] [Module ℝ E] + [PosSMulMono ℝ E] [One E] [IsArchimedeanOrderUnit E] + +instance : AddCommGroup (WithOrderUnitNorm E) := inferInstanceAs (AddCommGroup E) +instance : Module ℝ (WithOrderUnitNorm E) := inferInstanceAs (Module ℝ E) +instance : PartialOrder (WithOrderUnitNorm E) := inferInstanceAs (PartialOrder E) +instance : IsOrderedAddMonoid (WithOrderUnitNorm E) := inferInstanceAs (IsOrderedAddMonoid E) +instance : PosSMulMono ℝ (WithOrderUnitNorm E) := inferInstanceAs (PosSMulMono ℝ E) +instance : One (WithOrderUnitNorm E) := inferInstanceAs (One E) +instance : IsOrderUnit (WithOrderUnitNorm E) := inferInstanceAs (IsOrderUnit E) +instance : IsArchimedeanOrderUnit (WithOrderUnitNorm E) := + inferInstanceAs (IsArchimedeanOrderUnit E) + +/-- The canonical normed additive group on the order-unit-norm copy. -/ +noncomputable instance : NormedAddCommGroup (WithOrderUnitNorm E) := + IsArchimedeanOrderUnit.orderUnitNormedAddCommGroup (E := E) + +/-- The canonical real normed-space structure on the order-unit-norm copy. -/ +noncomputable instance : NormedSpace ℝ (WithOrderUnitNorm E) := + IsArchimedeanOrderUnit.orderUnitNormedSpace (E := E) + +/-- The identity linear equivalence from `E` to its order-unit-norm copy. -/ +def linearEquiv : E ≃ₗ[ℝ] WithOrderUnitNorm E := LinearEquiv.refl ℝ E + +omit [PartialOrder E] [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [One E] + [IsArchimedeanOrderUnit E] in +@[simp] +lemma linearEquiv_apply (x : E) : linearEquiv x = x := rfl + +@[simp] +lemma norm_eq_orderUnitNorm (x : WithOrderUnitNorm E) : ‖x‖ = + IsArchimedeanOrderUnit.orderUnitNorm (show E from x) := rfl + +/-- The order-unit-norm copy of the classical scalar order-unit space is linearly isometric to +ordinary `ℝ`. This is the explicit topology bridge required when an order-unit-norm completion +is compared with a scalar-valued construction. -/ +noncomputable def realLinearIsometryEquiv : WithOrderUnitNorm ℝ ≃ₗᵢ[ℝ] ℝ where + __ := (linearEquiv (E := ℝ)).symm + norm_map' x := by + change |(show ℝ from x)| = + IsArchimedeanOrderUnit.orderUnitNorm (show ℝ from x) + exact (IsArchimedeanOrderUnit.orderUnitNorm_real _).symm + +@[simp] +lemma realLinearIsometryEquiv_apply (x : WithOrderUnitNorm ℝ) : + realLinearIsometryEquiv x = (show ℝ from x) := + rfl + +/-- The scalar order-unit-norm copy is complete, transported explicitly from the standard +complete normed real line through `realLinearIsometryEquiv`. -/ +noncomputable instance : CompleteSpace (WithOrderUnitNorm ℝ) := + (completeSpace_congr (e := realLinearIsometryEquiv.toLinearEquiv.toEquiv) + realLinearIsometryEquiv.isometry.isUniformEmbedding).mpr inferInstance + +end WithOrderUnitNorm + +/-! ## G. Contractivity of unital positive maps -/ + +namespace UnitalPositiveLinearMap + +variable {E F : Type*} + [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] [Module ℝ E] + [PosSMulMono ℝ E] [One E] [IsArchimedeanOrderUnit E] + [AddCommGroup F] [PartialOrder F] [IsOrderedAddMonoid F] [Module ℝ F] + [PosSMulMono ℝ F] [One F] [IsArchimedeanOrderUnit F] + +omit [IsOrderedAddMonoid F] [PosSMulMono ℝ F] [IsArchimedeanOrderUnit F] in +/-- A unital positive map is contractive for the order-unit norm. This belongs to the ordered +linear interface, independently of any Jordan multiplication or completeness hypothesis. -/ +lemma orderUnitNorm_map_le (φ : E →ₚ₁[ℝ] F) (x : E) : + IsArchimedeanOrderUnit.orderUnitNorm (φ x) ≤ IsArchimedeanOrderUnit.orderUnitNorm x := by + apply le_of_forall_pos_le_add + intro ε hε + obtain ⟨r, hr, hrlt⟩ := + IsArchimedeanOrderUnit.exists_orderUnitBound_lt_orderUnitNorm_add x hε + have hbound : r ∈ IsArchimedeanOrderUnit.orderUnitBounds (φ x) := by + refine ⟨hr.1, ?_, ?_⟩ + · have h := φ.monotone' hr.2.1 + calc + -(r • (1 : F)) = φ (-(r • (1 : E))) := by rw [map_neg, map_smul, map_one] + _ ≤ φ x := h + · have h := φ.monotone' hr.2.2 + calc + φ x ≤ φ (r • (1 : E)) := h + _ = r • (1 : F) := by rw [map_smul, map_one] + exact (IsArchimedeanOrderUnit.orderUnitNorm_le hbound).trans hrlt.le + +end UnitalPositiveLinearMap diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/Operation.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Operation.lean new file mode 100644 index 0000000000..e5f1508db6 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Operation.lean @@ -0,0 +1,172 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Effect.Basic +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Channel.Normal +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.Basic +public import Mathlib.Algebra.Order.Module.PositiveLinearMap + +/-! + +# Operations + +## i. Overview + +An operation on `E` is a positive linear endomorphism that is not required to be unital: unlike a +channel (`Channel/Basic.lean`), it can lose "probability mass" — the way a single, non-selective +outcome of a measurement transforms a state without necessarily preserving its normalization. +What keeps it physical rather than an arbitrary positive map is that it never *gains* mass either: +`op 1 ≤ 1`. A channel is exactly an operation with `op 1 = 1` (`Channel/Basic.lean`'s +`UnitalPositiveLinearMap`); a finite family of operations whose images of `1` sum to exactly `1` +is an instrument (`Measurement/Instrument.lean`). + +## ii. Key definitions and results + +- `Operation E` +- `Operation.id` +- `Operation.comp` +- `Operation.condition` +- `Operation.outcomeEffect` + +## iii. Table of contents + +- A. Operations +- B. Outcome effects + +-/ + +@[expose] public section + +variable {E : Type*} [AddCommGroup E] [PartialOrder E] [Module ℝ E] [One E] + +/-! ## A. Operations -/ + +/-- An operation on `E`: a positive linear endomorphism that never sends the certain event above +itself. -/ +def Operation (E : Type*) [AddCommGroup E] [PartialOrder E] [Module ℝ E] [One E] := + {op : E →ₚ[ℝ] E // op 1 ≤ 1} + +namespace Operation + +/-- Regard an operation as its underlying positive linear map. -/ +instance : CoeFun (Operation E) (fun _ => E → E) := ⟨fun op => op.1⟩ + +@[ext] +lemma ext {op₁ op₂ : Operation E} (h : ∀ x, op₁ x = op₂ x) : op₁ = op₂ := + Subtype.ext (PositiveLinearMap.ext h) + +/-- An operation never sends a possible outcome to something negative. -/ +lemma map_nonneg (op : Operation E) {x : E} (hx : 0 ≤ x) : 0 ≤ op x := + op.1.map_nonneg hx + +/-- An operation never sends the certain event above itself. -/ +lemma apply_one_le_one (op : Operation E) : op 1 ≤ 1 := + op.2 + +/-- Normality for operations is inherited from the single canonical normal-positive-map +predicate. It is intentionally not a second directed-supremum definition. -/ +abbrev IsNormal (op : Operation E) : Prop := op.1.IsNormal + +/-- The identity operation. -/ +def id : Operation E := ⟨PositiveLinearMap.id ℝ E, le_rfl⟩ + +@[simp] +lemma id_apply (x : E) : id (E := E) x = x := rfl + +/-- The identity operation is normal. -/ +lemma isNormal_id : (id (E := E)).IsNormal := fun D x _ _ hLUB => by + change IsLUB ((fun y : E => y) '' D) x + simpa using hLUB + +/-- Sequential composition of operations. Applying `φ` and then `ψ` is again subunital: +positivity makes `ψ` monotone, so `φ(1) ≤ 1` implies `ψ(φ(1)) ≤ ψ(1) ≤ 1`. -/ +def comp (ψ φ : Operation E) : Operation E := + ⟨ψ.1.comp φ.1, (ψ.1.monotone' φ.2).trans ψ.2⟩ + +@[simp] +lemma comp_apply (ψ φ : Operation E) (x : E) : ψ.comp φ x = ψ (φ x) := rfl + +@[simp] +lemma id_comp (φ : Operation E) : id.comp φ = φ := by + apply ext + intro x + rfl + +@[simp] +lemma comp_id (φ : Operation E) : φ.comp id = φ := by + apply ext + intro x + rfl + +lemma comp_assoc (χ ψ φ : Operation E) : (χ.comp ψ).comp φ = χ.comp (ψ.comp φ) := by + apply ext + intro x + rfl + +/-- Normal operations are closed under sequential composition, by the canonical positive-map +normality composition theorem. -/ +lemma IsNormal.comp {φ ψ : Operation E} (hφ : φ.IsNormal) (hψ : ψ.IsNormal) : + (ψ.comp φ).IsNormal := + PositiveLinearMap.IsNormal.comp hφ hψ + +variable [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsOrderUnit E] + +/-- Normalize the pullback of a state along an operation whose outcome has nonzero probability. +This is the common post-measurement state construction: instruments and Jordan Lüders operations +specialize it instead of maintaining parallel normalizations. -/ +noncomputable def condition (op : Operation E) (ω : 𝓢[ℝ, E]) + (hmass : 0 < ω (op 1)) : 𝓢[ℝ, E] := + UnitalPositiveLinearMap.ofLinearMap + ((ω (op 1))⁻¹ • (ω.toLinearMap.comp op.1.toLinearMap)) + (fun x hx => by + change 0 ≤ (ω (op 1))⁻¹ * ω (op x) + exact mul_nonneg (inv_nonneg.mpr hmass.le) (ω.map_nonneg (op.map_nonneg hx))) + (by + change (ω (op 1))⁻¹ * ω (op 1) = 1 + exact inv_mul_cancel₀ hmass.ne') + +omit [PosSMulMono ℝ E] [IsOrderUnit E] in +/-- Pointwise formula for the state conditioned by an operation. -/ +@[simp] +theorem condition_apply (op : Operation E) (ω : 𝓢[ℝ, E]) (hmass : 0 < ω (op 1)) (x : E) : + op.condition ω hmass x = (ω (op 1))⁻¹ * ω (op x) := + rfl + +omit [PosSMulMono ℝ E] [IsOrderUnit E] in +/-- A normalized operational conditional state preserves the order unit. -/ +theorem condition_one (op : Operation E) (ω : 𝓢[ℝ, E]) (hmass : 0 < ω (op 1)) : + op.condition ω hmass 1 = 1 := + (op.condition ω hmass).map_one + +omit [PosSMulMono ℝ E] [IsOrderUnit E] in +/-- Conditioning a normal state by a normal operation preserves normality. The unnormalized +functional is the composite of two normal positive maps; division by the strictly positive +outcome probability transports directed suprema through multiplication by a positive scalar. -/ +theorem condition_isNormal (op : Operation E) (ω : 𝓢[ℝ, E]) (hmass : 0 < ω (op 1)) + (hop : op.IsNormal) (hω : ω.IsNormal) : (op.condition ω hmass).IsNormal := by + intro D x hD hdir hLUB + have hcomp : (ω.toPositiveLinearMap.comp op.1).IsNormal := + PositiveLinearMap.IsNormal.comp hop hω + have hcompLUB := hcomp D x hD hdir hLUB + change IsLUB ((fun y : E => ω (op y)) '' D) (ω (op x)) at hcompLUB + have hscaled := hcompLUB.mul_left (inv_nonneg.mpr hmass.le) + change IsLUB ((fun y : E => (ω (op 1))⁻¹ * ω (op y)) '' D) + ((ω (op 1))⁻¹ * ω (op x)) + simpa only [Set.image_image] using hscaled + +/-! ## B. Outcome effects -/ + +/-- The image of the certain event under an operation, as an effect: the probability of the +operation actually "firing" in a given state. -/ +def outcomeEffect (op : Operation E) : Effect E := + ⟨op 1, op.map_nonneg IsOrderUnit.one_nonneg, op.apply_one_le_one⟩ + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] in +@[simp] +lemma coe_outcomeEffect (op : Operation E) : (outcomeEffect op : E) = op 1 := rfl + +end Operation diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/Basic.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/Basic.lean new file mode 100644 index 0000000000..338bb7314d --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/Basic.lean @@ -0,0 +1,152 @@ +/- +Copyright (c) 2026 David Gross. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Gross +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Channel.Basic +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Effect.Basic +public import Mathlib.Topology.UnitInterval + +/-! + +# States + +## i. Overview + +A state is a normalized positive linear functional: an element of `𝓟[𝕜, A]`, the positive linear +functionals on `A`, that sends the unit to `1`. `𝓢[𝕜, A]` is just `A →ₚ₁[𝕜] 𝕜` — the state space +is a special case of the channel type, with the target system the base field itself. + +## ii. Key definitions + +- `𝓟[𝕜, A]` is the type of positive linear functionals on an ordered `𝕜`-vector space. +- `𝓢[𝕜, A]` is the state space of an ordered `𝕜`-vector space with unit. +- `UnitalPositiveLinearMap.onEffect` is the probability assigned by a real state to an effect. + +## iii. Table of contents + +- A. Positive functionals and states +- B. Pulling states back along channels + +-/ + +@[expose] public section + +/-! ## A. Positive functionals and states -/ + +/-- Positive linear functionals on an ordered `𝕜`-vector space. -/ +notation " 𝓟[" 𝕜 ", " A "] " => A →ₚ[𝕜] 𝕜 + +/-- Positive linear functionals on an ordered complex vector space. -/ +notation " 𝓟[" A "] " => A →ₚ[ℂ] ℂ + +/-- State space of an ordered `𝕜`-vector space with unit. -/ +notation " 𝓢[" 𝕜 ", " A "] " => A →ₚ₁[𝕜] 𝕜 + +/-- State space of an ordered complex vector space with unit. -/ +notation " 𝓢[" A "] " => A →ₚ₁[ℂ] ℂ + +namespace UnitalPositiveLinearMap + +variable {E : Type*} [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] + [Module ℝ E] [One E] [IsOrderUnit E] + +/-- The probability a real state assigns to an effect, bundled in the unit interval. -/ +def onEffect (ω : 𝓢[ℝ, E]) (e : Effect E) : unitInterval := + ⟨ω (e : E), ω.map_nonneg e.2.1, + (ω.monotone' e.2.2).trans_eq (map_one ω)⟩ + +omit [IsOrderedAddMonoid E] [IsOrderUnit E] in +@[simp] +lemma coe_onEffect (ω : 𝓢[ℝ, E]) (e : Effect E) : + (ω.onEffect e : ℝ) = ω (e : E) := rfl + +omit [IsOrderUnit E] in +/-- A state sends complementary effects to complementary probabilities. -/ +lemma onEffect_complement (ω : 𝓢[ℝ, E]) (e : Effect E) : + ω.onEffect (Effect.complement e) = unitInterval.symm (ω.onEffect e) := by + apply Subtype.ext + simp [onEffect, Effect.complement, unitInterval.symm] + +omit [IsOrderUnit E] in +/-- A state is additive on every defined partial sum of effects. -/ +lemma onEffect_addOfOrthogonal (ω : 𝓢[ℝ, E]) (e f : Effect E) + (h : Effect.Orthogonal e f) : + (ω.onEffect (Effect.addOfOrthogonal e f h) : ℝ) = ω.onEffect e + ω.onEffect f := by + simp [onEffect] + +variable [PosSMulMono ℝ E] + +/-- States are determined by their probabilities on effects. Every positive observable can be +rescaled into the effect interval, and every observable is a difference of two positive ones. -/ +lemma ext_of_onEffect_eq {ω φ : 𝓢[ℝ, E]} (h : ∀ e : Effect E, ω.onEffect e = φ.onEffect e) : + ω = φ := by + apply UnitalPositiveLinearMap.ext + intro x + obtain ⟨xp, xn, hxp, hxn, rfl⟩ := IsOrderUnit.exists_eq_sub_nonneg x + suffices hpos : ∀ y : E, 0 ≤ y → ω y = φ y by + rw [map_sub, map_sub, hpos xp hxp, hpos xn hxn] + intro y hy + obtain ⟨n, hn⟩ := IsOrderUnit.exists_nsmul_one_le y + let r : ℝ := n + 1 + have hr : 0 < r := by positivity + have hyr : y ≤ r • (1 : E) := by + calc + y ≤ n • (1 : E) := hn + _ = (n : ℝ) • (1 : E) := (Nat.cast_smul_eq_nsmul ℝ n (1 : E)).symm + _ ≤ r • (1 : E) := + smul_le_smul_of_nonneg_right (by simp [r]) IsOrderUnit.one_nonneg + let e : Effect E := ⟨r⁻¹ • y, smul_nonneg (inv_nonneg.mpr hr.le) hy, by + have hs := smul_le_smul_of_nonneg_left hyr (inv_nonneg.mpr hr.le) + simpa [smul_smul, hr.ne'] using hs⟩ + have heq := congrArg Subtype.val (h e) + change ω (r⁻¹ • y) = φ (r⁻¹ • y) at heq + rw [map_smul, map_smul, smul_eq_mul, smul_eq_mul] at heq + exact mul_left_cancel₀ (inv_ne_zero hr.ne') heq + +/-- Two states are equal exactly when all of their effect probabilities agree. -/ +lemma eq_iff_onEffect_eq {ω φ : 𝓢[ℝ, E]} : + ω = φ ↔ ∀ e : Effect E, ω.onEffect e = φ.onEffect e := by + constructor + · rintro rfl + exact fun _ => rfl + · exact ext_of_onEffect_eq + +end UnitalPositiveLinearMap + +namespace UnitalPositiveLinearMap + +/-! ## B. Pulling states back along channels -/ + +variable {E₁ E₂ : Type*} + [AddCommGroup E₁] [PartialOrder E₁] [IsOrderedAddMonoid E₁] [Module ℝ E₁] [One E₁] + [AddCommGroup E₂] [PartialOrder E₂] [IsOrderedAddMonoid E₂] [Module ℝ E₂] [One E₂] + +/-- The Schrödinger-picture action of a Heisenberg channel on states: precomposition. -/ +def pullbackState (φ : E₁ →ₚ₁[ℝ] E₂) (ω : 𝓢[ℝ, E₂]) : 𝓢[ℝ, E₁] := ω.comp φ + +omit [IsOrderedAddMonoid E₁] [IsOrderedAddMonoid E₂] in +@[simp] +lemma pullbackState_apply (φ : E₁ →ₚ₁[ℝ] E₂) (ω : 𝓢[ℝ, E₂]) (x : E₁) : + φ.pullbackState ω x = ω (φ x) := rfl + +omit [IsOrderedAddMonoid E₁] in +@[simp] +lemma pullbackState_id (ω : 𝓢[ℝ, E₁]) : + (UnitalPositiveLinearMap.id ℝ E₁).pullbackState ω = ω := by + ext x + rfl + +variable {E₃ : Type*} + [AddCommGroup E₃] [PartialOrder E₃] [IsOrderedAddMonoid E₃] [Module ℝ E₃] [One E₃] + +omit [IsOrderedAddMonoid E₁] [IsOrderedAddMonoid E₂] [IsOrderedAddMonoid E₃] in +@[simp] +lemma pullbackState_comp (φ : E₁ →ₚ₁[ℝ] E₂) (ψ : E₂ →ₚ₁[ℝ] E₃) (ω : 𝓢[ℝ, E₃]) : + (ψ.comp φ).pullbackState ω = φ.pullbackState (ψ.pullbackState ω) := by + ext x + rfl + +end UnitalPositiveLinearMap diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/Convex.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/Convex.lean new file mode 100644 index 0000000000..3f2f618077 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/Convex.lean @@ -0,0 +1,146 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.Basic +public import Mathlib.Analysis.Convex.Extreme +public import Mathlib.Analysis.Convex.StdSimplex +public import Mathlib.Topology.UnitInterval + +/-! + +# Convex state spaces + +## i. Overview + +Mixtures of real- or complex-valued states on ordered vector spaces with a distinguished unit. +No multiplication, star operation, norm, topology, completeness, or C⋆ structure is required. + +## ii. Key definitions and results + +- `UnitalPositiveLinearMap.finiteMix`: a finite convex mixture of states. +- `UnitalPositiveLinearMap.mix`: a binary mixture. +- `UnitalPositiveLinearMap.stateSpace`: states embedded in the algebraic dual. +- `UnitalPositiveLinearMap.stateSpace_convex`: convexity of the state space. + +## iii. Table of contents + +- A. Finite mixtures +- B. Binary mixtures +- C. The state space in the algebraic dual + +-/ + +@[expose] public section + +open scoped ComplexOrder + +namespace UnitalPositiveLinearMap + +variable {𝕜 A : Type*} [RCLike 𝕜] [PosMulMono 𝕜] + [AddCommGroup A] [PartialOrder A] [IsOrderedAddMonoid A] [Module 𝕜 A] [One A] + +/-! ## A. Finite mixtures -/ + +/-- The state obtained from a finite family using probability weights `p`. -/ +noncomputable def finiteMix {ι : Type*} [Fintype ι] (ω : ι → 𝓢[𝕜, A]) + (p : stdSimplex ℝ ι) : 𝓢[𝕜, A] := + ofLinearMap (R := 𝕜) (E₁ := A) (E₂ := 𝕜) + (∑ i, (p i : 𝕜) • (ω i).toLinearMap) + (fun a ha => by + simp only [LinearMap.coe_sum, Finset.sum_apply, LinearMap.smul_apply, smul_eq_mul] + exact Finset.sum_nonneg fun i _ => + mul_nonneg (RCLike.ofReal_nonneg.mpr (stdSimplex.zero_le p i)) ((ω i).map_nonneg ha)) + (by + simp only [LinearMap.coe_sum, Finset.sum_apply, LinearMap.smul_apply, smul_eq_mul] + have hone (i : ι) : (ω i).toLinearMap (1 : A) = 1 := (ω i).map_one + simp_rw [hone, mul_one] + exact_mod_cast stdSimplex.sum_eq_one p) + +/-- Evaluation of a finite mixture is its pointwise weighted sum. -/ +@[simp] +lemma finiteMix_apply {ι : Type*} [Fintype ι] (ω : ι → 𝓢[𝕜, A]) + (p : stdSimplex ℝ ι) (a : A) : + finiteMix ω p a = ∑ i, (p i : 𝕜) * ω i a := by + change (∑ i, (p i : 𝕜) • (ω i).toLinearMap) a = _ + simp only [LinearMap.coe_sum, Finset.sum_apply, LinearMap.smul_apply, smul_eq_mul] + exact Finset.sum_congr rfl fun i _ => rfl + +/-- The two probability weights `t` and `1 - t`. -/ +def binaryWeights (t : unitInterval) : stdSimplex ℝ (Fin 2) := + ⟨![(t : ℝ), 1 - (t : ℝ)], + Fin.forall_fin_two.2 ⟨unitInterval.nonneg t, sub_nonneg.mpr (unitInterval.le_one t)⟩, + by simp⟩ + +@[simp] lemma binaryWeights_zero (t : unitInterval) : binaryWeights t 0 = (t : ℝ) := rfl + +@[simp] lemma binaryWeights_one (t : unitInterval) : + binaryWeights t 1 = 1 - (t : ℝ) := rfl + +/-! ## B. Binary mixtures -/ + +/-- Randomize between two states with probability `t` of choosing the first. -/ +noncomputable def mix (ω φ : 𝓢[𝕜, A]) (t : unitInterval) : 𝓢[𝕜, A] := + finiteMix ![ω, φ] (binaryWeights t) + +/-- Evaluation of a binary mixture is its pointwise convex combination. -/ +@[simp] +lemma mix_apply (ω φ : 𝓢[𝕜, A]) (t : unitInterval) (a : A) : + mix ω φ t a = (t : ℝ) • ω a + (1 - (t : ℝ)) • φ a := by + unfold mix + rw [finiteMix_apply, Fin.sum_univ_two] + simp [RCLike.real_smul_eq_coe_mul] + +/-- The underlying linear functional of a mixture is the pointwise convex combination. -/ +lemma mix_toLinearMap (ω φ : 𝓢[𝕜, A]) (t : unitInterval) : + (mix ω φ t).toLinearMap = + (t : ℝ) • ω.toLinearMap + (1 - (t : ℝ)) • φ.toLinearMap := by + ext a + change mix ω φ t a = (t : ℝ) • ω a + (1 - (t : ℝ)) • φ a + exact mix_apply ω φ t a + +/-- A state lies in the open segment between two states exactly when it is a genuine mixture of +them. -/ +lemma mem_openSegment_iff_exists_mix (ω φ ψ : 𝓢[𝕜, A]) : + ω.toLinearMap ∈ openSegment ℝ φ.toLinearMap ψ.toLinearMap ↔ + ∃ t : unitInterval, t ≠ 0 ∧ t ≠ 1 ∧ mix φ ψ t = ω := by + constructor + · rintro ⟨t, s, ht, hs, hts, heq⟩ + have ht₁ : t < 1 := by linarith + let u : unitInterval := ⟨t, by exact ⟨ht.le, ht₁.le⟩⟩ + refine ⟨u, ?_, ?_, ?_⟩ + · exact ne_of_gt (by exact_mod_cast ht) + · exact ne_of_lt (by exact_mod_cast ht₁) + · apply toLinearMap_injective + change (mix φ ψ u).toLinearMap = ω.toLinearMap + rw [mix_toLinearMap] + change t • φ.toLinearMap + (1 - t) • ψ.toLinearMap = ω.toLinearMap + rwa [show 1 - t = s by linarith] + · rintro ⟨t, ht₀, ht₁, rfl⟩ + refine ⟨(t : ℝ), 1 - (t : ℝ), ?_, ?_, by ring, ?_⟩ + · exact_mod_cast unitInterval.pos_iff_ne_zero.mpr ht₀ + · exact sub_pos.mpr (by exact_mod_cast unitInterval.lt_one_iff_ne_one.mpr ht₁) + · rw [mix_toLinearMap] + +/-! ## C. The state space in the algebraic dual -/ + +/-- General states embedded into the algebraic dual. -/ +def stateSpace : Set (A →ₗ[𝕜] 𝕜) := + Set.range fun ω : 𝓢[𝕜, A] => ω.toLinearMap + +/-- The general state space is convex in the algebraic dual. -/ +lemma stateSpace_convex : Convex ℝ (stateSpace (𝕜 := 𝕜) (A := A)) := by + rintro x ⟨ω, rfl⟩ y ⟨φ, rfl⟩ t s ht hs hts + have ht₁ : t ≤ 1 := by linarith + let u : unitInterval := ⟨t, by exact ⟨ht, ht₁⟩⟩ + refine ⟨mix ω φ u, ?_⟩ + change (mix ω φ u).toLinearMap = t • ω.toLinearMap + s • φ.toLinearMap + rw [mix_toLinearMap] + change t • ω.toLinearMap + (1 - t) • φ.toLinearMap = + t • ω.toLinearMap + s • φ.toLinearMap + rw [show s = 1 - t by linarith] + +end UnitalPositiveLinearMap diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/Discrimination.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/Discrimination.lean new file mode 100644 index 0000000000..3c625229bb --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/Discrimination.lean @@ -0,0 +1,311 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.Basic +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Effect.Basic + +/-! + +# State discrimination + +## i. Overview + +A system is prepared in state `ω₀` with prior probability `p₀`, or `ω₁` with prior `p₁`. Guess +which from a single yes/no test (an effect `e`): guess `0` if `e` clicks, `1` otherwise. The +optimal guess succeeds with probability + + `optimalSuccessProb ω₀ ω₁ p₀ p₁ = p₁ + sup_e (p₀ * ω₀ e - p₁ * ω₁ e)` + (`optimalSuccessProb_eq`) + +— the Helstrom bound, in the same spirit as the familiar `(1 + ‖p₀ρ₀ - p₁ρ₁‖₁) / 2` trace-distance +formula, here with the effect supremum playing the trace norm's role directly. + +## ii. Key definitions and results + +- `successProb`, `optimalSuccessProb` +- `weightedStateBaseNorm` +- `optimalSuccessProb_eq`, `optimalSuccessProb_eq_half_one_add_baseNorm` +- `weightedStateBaseNorm_pullback_le` + +## iii. Table of contents + +- A. Success probability of a fixed test +- B. Optimal success probability +- C. The abstract Helstrom formula +- D. The operational base norm +- E. Data processing + +-/ + +@[expose] public section + +variable {E : Type*} [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] [Module ℝ E] + [PosSMulMono ℝ E] [One E] [IsOrderUnit E] + +namespace UnitalPositiveLinearMap + +/-! ## A. Success probability of a fixed test -/ + +/-- The probability of correctly guessing between `ω₀` (prior `p₀`) and `ω₁` (prior `p₁`) using +the test `e`: guess `0` when `e` clicks, `1` when its complement does. -/ +def successProb (ω₀ ω₁ : 𝓢[ℝ, E]) (p₀ p₁ : ℝ) (e : Effect E) : ℝ := + p₀ * ω₀ (e : E) + p₁ * ω₁ ((Effect.complement e : E)) + +omit [PosSMulMono ℝ E] [IsOrderUnit E] in +/-- A test's success probability is the prior of guessing `1` outright, plus the advantage the +test itself adds. -/ +lemma successProb_eq_add_advantage (ω₀ ω₁ : 𝓢[ℝ, E]) (p₀ p₁ : ℝ) (e : Effect E) : + successProb ω₀ ω₁ p₀ p₁ e = p₁ + (p₀ * ω₀ (e : E) - p₁ * ω₁ (e : E)) := by + show p₀ * ω₀ (e : E) + p₁ * ω₁ (1 - (e : E)) = p₁ + (p₀ * ω₀ (e : E) - p₁ * ω₁ (e : E)) + rw [map_sub, map_one] + ring + +/-! ## B. Optimal success probability -/ + +/-- The best a single test can do: the supremum of `successProb` over every possible effect. -/ +noncomputable def optimalSuccessProb (ω₀ ω₁ : 𝓢[ℝ, E]) (p₀ p₁ : ℝ) : ℝ := + sSup (Set.range (successProb ω₀ ω₁ p₀ p₁)) + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsOrderUnit E] in +/-- No effect's advantage in telling `ω₀` from `ω₁` ever beats `p₀`: certainty, weighted by its +own prior. -/ +lemma advantage_le (ω₀ ω₁ : 𝓢[ℝ, E]) {p₀ p₁ : ℝ} (hp₀ : 0 ≤ p₀) (hp₁ : 0 ≤ p₁) (e : Effect E) : + p₀ * ω₀ (e : E) - p₁ * ω₁ (e : E) ≤ p₀ := by + have h1 : ω₀ (e : E) ≤ 1 := by simpa using ω₀.monotone' e.2.2 + have h2 : 0 ≤ ω₁ (e : E) := ω₁.map_nonneg e.2.1 + nlinarith + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsOrderUnit E] in +/-- The largest gap a single effect can open up between the two weighted states — the abstract +distinguishing power of `ω₀` against `ω₁`, bounded above by `advantage_le`. -/ +lemma bddAbove_advantage (ω₀ ω₁ : 𝓢[ℝ, E]) {p₀ p₁ : ℝ} (hp₀ : 0 ≤ p₀) (hp₁ : 0 ≤ p₁) : + BddAbove (Set.range fun e : Effect E => p₀ * ω₀ (e : E) - p₁ * ω₁ (e : E)) := + ⟨p₀, by rintro _ ⟨e, rfl⟩; exact advantage_le ω₀ ω₁ hp₀ hp₁ e⟩ + +/-! ## C. The abstract Helstrom formula -/ + +omit [PosSMulMono ℝ E] in +/-- The abstract Helstrom bound: the optimal one-shot success probability of distinguishing `ω₀` +(prior `p₀`) from `ω₁` (prior `p₁`) is `p₁` plus the largest advantage a single effect gives. -/ +theorem optimalSuccessProb_eq (ω₀ ω₁ : 𝓢[ℝ, E]) {p₀ p₁ : ℝ} (hp₀ : 0 ≤ p₀) (hp₁ : 0 ≤ p₁) : + optimalSuccessProb ω₀ ω₁ p₀ p₁ + = p₁ + sSup (Set.range fun e : Effect E => p₀ * ω₀ (e : E) - p₁ * ω₁ (e : E)) := by + unfold optimalSuccessProb + set g : Effect E → ℝ := fun e => p₀ * ω₀ (e : E) - p₁ * ω₁ (e : E) with hg + have hbdd : BddAbove (Set.range g) := bddAbove_advantage ω₀ ω₁ hp₀ hp₁ + have hne : (Set.range g).Nonempty := ⟨_, ⟨0, rfl⟩⟩ + have hbdd' : BddAbove (Set.range (successProb ω₀ ω₁ p₀ p₁)) := by + obtain ⟨b, hb⟩ := hbdd + refine ⟨p₁ + b, ?_⟩ + rintro _ ⟨e, rfl⟩ + rw [successProb_eq_add_advantage] + have hge : g e ≤ b := hb (Set.mem_range_self e) + linarith + have hne' : (Set.range (successProb ω₀ ω₁ p₀ p₁)).Nonempty := ⟨_, ⟨0, rfl⟩⟩ + apply le_antisymm + · apply csSup_le hne' + rintro _ ⟨e, rfl⟩ + rw [successProb_eq_add_advantage] + have hge : g e ≤ sSup (Set.range g) := le_csSup hbdd (Set.mem_range_self e) + linarith + · have hle : sSup (Set.range g) ≤ sSup (Set.range (successProb ω₀ ω₁ p₀ p₁)) - p₁ := by + apply csSup_le hne + rintro _ ⟨e, rfl⟩ + have h1 : successProb ω₀ ω₁ p₀ p₁ e ≤ sSup (Set.range (successProb ω₀ ω₁ p₀ p₁)) := + le_csSup hbdd' (Set.mem_range_self e) + rw [successProb_eq_add_advantage] at h1 + linarith + linarith + +/-! ## D. The operational base norm -/ + +/-- The base norm of the signed functional `p₀ ω₀ - p₁ ω₁`, presented operationally through +binary effects. The centering term is its value on the order unit. This normalization makes +the abstract Helstrom formula take the familiar form `(1 + ‖p₀ω₀ - p₁ω₁‖) / 2` when the priors +sum to one. -/ +noncomputable def weightedStateBaseNorm (ω₀ ω₁ : 𝓢[ℝ, E]) (p₀ p₁ : ℝ) : ℝ := + 2 * sSup (Set.range fun e : Effect E => p₀ * ω₀ (e : E) - p₁ * ω₁ (e : E)) - (p₀ - p₁) + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] in +/-- The operational base norm of a weighted state difference is at most the total weight. -/ +lemma weightedStateBaseNorm_le (ω₀ ω₁ : 𝓢[ℝ, E]) {p₀ p₁ : ℝ} + (hp₀ : 0 ≤ p₀) (hp₁ : 0 ≤ p₁) : + weightedStateBaseNorm ω₀ ω₁ p₀ p₁ ≤ p₀ + p₁ := by + have hs : sSup (Set.range fun e : Effect E => + p₀ * ω₀ (e : E) - p₁ * ω₁ (e : E)) ≤ p₀ := + csSup_le ⟨_, Set.mem_range_self (0 : Effect E)⟩ + (fun _ h => by obtain ⟨e, rfl⟩ := h; exact advantage_le ω₀ ω₁ hp₀ hp₁ e) + unfold weightedStateBaseNorm + linarith + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] in +/-- The operational base norm dominates the absolute total mass of the signed functional. -/ +lemma abs_sub_le_weightedStateBaseNorm (ω₀ ω₁ : 𝓢[ℝ, E]) {p₀ p₁ : ℝ} + (hp₀ : 0 ≤ p₀) (hp₁ : 0 ≤ p₁) : + |p₀ - p₁| ≤ weightedStateBaseNorm ω₀ ω₁ p₀ p₁ := by + let g : Effect E → ℝ := fun e => p₀ * ω₀ (e : E) - p₁ * ω₁ (e : E) + have hbdd : BddAbove (Set.range g) := bddAbove_advantage ω₀ ω₁ hp₀ hp₁ + have hzero : 0 ≤ sSup (Set.range g) := by + have : g 0 = 0 := by simp [g] + rw [← this] + exact le_csSup hbdd (Set.mem_range_self 0) + have hone : p₀ - p₁ ≤ sSup (Set.range g) := by + have : g 1 = p₀ - p₁ := by simp [g] + rw [← this] + exact le_csSup hbdd (Set.mem_range_self 1) + rw [abs_le] + unfold weightedStateBaseNorm + constructor <;> linarith + +omit [PosSMulMono ℝ E] in +/-- Abstract Helstrom formula in base-norm form for normalized prior probabilities. -/ +theorem optimalSuccessProb_eq_half_one_add_baseNorm (ω₀ ω₁ : 𝓢[ℝ, E]) + {p₀ p₁ : ℝ} (hp₀ : 0 ≤ p₀) (hp₁ : 0 ≤ p₁) (hsum : p₀ + p₁ = 1) : + optimalSuccessProb ω₀ ω₁ p₀ p₁ = + (1 + weightedStateBaseNorm ω₀ ω₁ p₀ p₁) / 2 := by + rw [optimalSuccessProb_eq ω₀ ω₁ hp₀ hp₁] + unfold weightedStateBaseNorm + linarith + +/-! ## E. Data processing -/ + +variable {F : Type*} [AddCommGroup F] [PartialOrder F] [IsOrderedAddMonoid F] [Module ℝ F] + [PosSMulMono ℝ F] [One F] [IsOrderUnit F] + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsOrderedAddMonoid F] [PosSMulMono ℝ F] + [IsOrderUnit F] in +/-- Pulling two states back along a channel cannot increase their maximal effect advantage. -/ +lemma sSup_advantage_pullback_le (φ : E →ₚ₁[ℝ] F) (ω₀ ω₁ : 𝓢[ℝ, F]) + {p₀ p₁ : ℝ} (hp₀ : 0 ≤ p₀) (hp₁ : 0 ≤ p₁) : + sSup (Set.range fun e : Effect E => + p₀ * (φ.pullbackState ω₀) (e : E) - p₁ * (φ.pullbackState ω₁) (e : E)) ≤ + sSup (Set.range fun e : Effect F => p₀ * ω₀ (e : F) - p₁ * ω₁ (e : F)) := by + let g : Effect F → ℝ := fun e => p₀ * ω₀ (e : F) - p₁ * ω₁ (e : F) + have hbdd : BddAbove (Set.range g) := bddAbove_advantage ω₀ ω₁ hp₀ hp₁ + apply csSup_le ⟨_, Set.mem_range_self (0 : Effect E)⟩ + rintro _ ⟨e, rfl⟩ + change g (φ.mapEffect e) ≤ sSup (Set.range g) + exact le_csSup hbdd (Set.mem_range_self (φ.mapEffect e)) + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsOrderedAddMonoid F] [PosSMulMono ℝ F] + [IsOrderUnit F] in +/-- Data processing for the operational base norm: a channel cannot make two weighted states +more distinguishable. -/ +theorem weightedStateBaseNorm_pullback_le (φ : E →ₚ₁[ℝ] F) (ω₀ ω₁ : 𝓢[ℝ, F]) + {p₀ p₁ : ℝ} (hp₀ : 0 ≤ p₀) (hp₁ : 0 ≤ p₁) : + weightedStateBaseNorm (φ.pullbackState ω₀) (φ.pullbackState ω₁) p₀ p₁ ≤ + weightedStateBaseNorm ω₀ ω₁ p₀ p₁ := by + unfold weightedStateBaseNorm + have h := sSup_advantage_pullback_le φ ω₀ ω₁ hp₀ hp₁ + linarith + +omit [PosSMulMono ℝ E] [PosSMulMono ℝ F] in +/-- Data processing for binary discrimination: applying a channel before measuring cannot +increase the optimal success probability. -/ +theorem optimalSuccessProb_pullback_le (φ : E →ₚ₁[ℝ] F) (ω₀ ω₁ : 𝓢[ℝ, F]) + {p₀ p₁ : ℝ} (hp₀ : 0 ≤ p₀) (hp₁ : 0 ≤ p₁) : + optimalSuccessProb (φ.pullbackState ω₀) (φ.pullbackState ω₁) p₀ p₁ ≤ + optimalSuccessProb ω₀ ω₁ p₀ p₁ := by + rw [optimalSuccessProb_eq _ _ hp₀ hp₁, optimalSuccessProb_eq _ _ hp₀ hp₁] + simpa [add_comm] using add_le_add_left (sSup_advantage_pullback_le φ ω₀ ω₁ hp₀ hp₁) p₁ + +/-! ## F. Operational distance of states -/ + +/-- The largest probability gap two states assign to the same effect. -/ +noncomputable def operationalDistance (ω φ : 𝓢[ℝ, E]) : ℝ := + sSup (Set.range fun e : Effect E => |ω (e : E) - φ (e : E)|) + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsOrderUnit E] in +/-- The probability gap of two states on one effect is at most one. -/ +lemma effectGap_le_one (ω φ : 𝓢[ℝ, E]) (e : Effect E) : + |ω (e : E) - φ (e : E)| ≤ 1 := by + have hω0 : 0 ≤ ω (e : E) := ω.map_nonneg e.2.1 + have hφ1 : φ (e : E) ≤ 1 := (φ.monotone' e.2.2).trans_eq (map_one φ) + have hφ0 : 0 ≤ φ (e : E) := φ.map_nonneg e.2.1 + have hω1 : ω (e : E) ≤ 1 := (ω.monotone' e.2.2).trans_eq (map_one ω) + rw [abs_le] + constructor <;> linarith + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsOrderUnit E] in +/-- Effect probability gaps are uniformly bounded by one. -/ +lemma bddAbove_effectGap (ω φ : 𝓢[ℝ, E]) : + BddAbove (Set.range fun e : Effect E => |ω (e : E) - φ (e : E)|) := by + exact ⟨1, by rintro _ ⟨e, rfl⟩; exact effectGap_le_one ω φ e⟩ + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] in +/-- Operational distance is nonnegative. -/ +lemma operationalDistance_nonneg (ω φ : 𝓢[ℝ, E]) : 0 ≤ operationalDistance ω φ := by + unfold operationalDistance + exact (abs_nonneg (ω (0 : E) - φ 0)).trans + (le_csSup (bddAbove_effectGap ω φ) (Set.mem_range_self (0 : Effect E))) + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] in +/-- Operational distance is at most one. -/ +lemma operationalDistance_le_one (ω φ : 𝓢[ℝ, E]) : operationalDistance ω φ ≤ 1 := by + unfold operationalDistance + exact csSup_le ⟨_, Set.mem_range_self (0 : Effect E)⟩ fun _ h => by + obtain ⟨e, rfl⟩ := h + exact effectGap_le_one ω φ e + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] in +@[simp] +lemma operationalDistance_self (ω : 𝓢[ℝ, E]) : operationalDistance ω ω = 0 := by + unfold operationalDistance + simp + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsOrderUnit E] in +/-- Operational distance is symmetric. -/ +lemma operationalDistance_comm (ω φ : 𝓢[ℝ, E]) : + operationalDistance ω φ = operationalDistance φ ω := by + unfold operationalDistance + congr 2 + funext e + exact abs_sub_comm _ _ + +@[simp] +lemma operationalDistance_eq_zero_iff (ω φ : 𝓢[ℝ, E]) : + operationalDistance ω φ = 0 ↔ ω = φ := by + constructor + · intro hzero + change sSup (Set.range fun e : Effect E => |ω (e : E) - φ (e : E)|) = 0 at hzero + apply ext_of_onEffect_eq + intro e + apply Subtype.ext + change ω (e : E) = φ (e : E) + have hle := le_csSup (bddAbove_effectGap ω φ) (Set.mem_range_self e) + rw [hzero] at hle + exact sub_eq_zero.mp (abs_eq_zero.mp (le_antisymm hle (abs_nonneg _))) + · rintro rfl + exact operationalDistance_self ω + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] in +/-- Operational distance satisfies the triangle inequality. -/ +lemma operationalDistance_triangle (ω φ ψ : 𝓢[ℝ, E]) : + operationalDistance ω ψ ≤ operationalDistance ω φ + operationalDistance φ ψ := by + unfold operationalDistance + apply csSup_le ⟨_, Set.mem_range_self (0 : Effect E)⟩ + rintro _ ⟨e, rfl⟩ + calc + |ω (e : E) - ψ (e : E)| ≤ + |ω (e : E) - φ (e : E)| + |φ (e : E) - ψ (e : E)| := abs_sub_le _ _ _ + _ ≤ sSup (Set.range fun e : Effect E => |ω (e : E) - φ (e : E)|) + + sSup (Set.range fun e : Effect E => |φ (e : E) - ψ (e : E)|) := add_le_add + (le_csSup (bddAbove_effectGap ω φ) (Set.mem_range_self e)) + (le_csSup (bddAbove_effectGap φ ψ) (Set.mem_range_self e)) + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsOrderedAddMonoid F] [PosSMulMono ℝ F] + [IsOrderUnit F] in +/-- Operational distance obeys data processing under every channel. -/ +theorem operationalDistance_pullback_le (φ : E →ₚ₁[ℝ] F) (ω ψ : 𝓢[ℝ, F]) : + operationalDistance (φ.pullbackState ω) (φ.pullbackState ψ) ≤ + operationalDistance ω ψ := by + unfold operationalDistance + apply csSup_le ⟨_, Set.mem_range_self (0 : Effect E)⟩ + rintro _ ⟨e, rfl⟩ + exact le_csSup (bddAbove_effectGap ω ψ) (Set.mem_range_self (φ.mapEffect e)) + +end UnitalPositiveLinearMap diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/Norm.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/Norm.lean new file mode 100644 index 0000000000..8b0a78ab7d --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/Norm.lean @@ -0,0 +1,65 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.Basic +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Norm + +/-! + +# States are bounded by the order-unit norm + +## i. Overview + +A state assigns real numbers to observables with no continuity assumed anywhere — `𝓢[ℝ, E]` is +built purely from positivity and unitality. It turns out to be bounded +regardless: `|ω x| ≤ ‖x‖`, the order-unit norm of `OrderUnit/Norm.lean`. Physically, a state can +never predict an expectation value bigger than the biggest an observable can actually read, and +this is exactly that fact, with the tightest possible constant. + +## ii. Key results + +- `UnitalPositiveLinearMap.apply_le_orderUnitNorm` +- `UnitalPositiveLinearMap.abs_apply_le_orderUnitNorm` + +## iii. Table of contents + +- A. The one-sided bound +- B. The absolute-value bound + +-/ + +@[expose] public section + +open IsArchimedeanOrderUnit + +variable {E : Type*} [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] [Module ℝ E] + [PosSMulMono ℝ E] [One E] [IsArchimedeanOrderUnit E] + +namespace UnitalPositiveLinearMap + +/-! ## A. The one-sided bound -/ + +/-- A state never overshoots the order-unit norm. -/ +lemma apply_le_orderUnitNorm (ω : 𝓢[ℝ, E]) (x : E) : ω x ≤ orderUnitNorm x := by + apply le_of_forall_pos_le_add + intro ε hε + obtain ⟨r, hr, hrε⟩ := exists_orderUnitBound_lt_orderUnitNorm_add x hε + have hpos : 0 ≤ ω (r • (1 : E) - x) := ω.map_nonneg (sub_nonneg.mpr hr.2.2) + simp only [map_sub, map_smul, smul_eq_mul, map_one, mul_one] at hpos + linarith + +/-! ## B. The absolute-value bound -/ + +/-- A state's values are squeezed within the order-unit norm on both sides: it can never predict +an expectation value bigger, in either direction, than an observable's own order-unit norm. -/ +lemma abs_apply_le_orderUnitNorm (ω : 𝓢[ℝ, E]) (x : E) : |ω x| ≤ orderUnitNorm x := by + have h1 : ω x ≤ orderUnitNorm x := apply_le_orderUnitNorm ω x + have h2 : ω (-x) ≤ orderUnitNorm (-x) := apply_le_orderUnitNorm ω (-x) + rw [_root_.map_neg, orderUnitNorm_neg] at h2 + exact abs_le.mpr ⟨by linarith, h1⟩ + +end UnitalPositiveLinearMap diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/NormalEquivalence.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/NormalEquivalence.lean new file mode 100644 index 0000000000..cc9421cccf --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/NormalEquivalence.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Channel.Normal +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.WeightEquivalence + +/-! + +# Normality under the state/weight equivalence + +A normal state yields a normal finite normalized weight through the canonical map +`UnitalPositiveLinearMap.toWeight`. The two predicates have intentionally different domains: +state normality is about directed suprema in the whole ordered space, whereas a weight is only +defined on the positive cone. The theorem below transports suprema across that inclusion rather +than defining a duplicate normal-state predicate. + +The converse is deliberately not asserted at this generality. An arbitrary directed set with a +supremum need not have one common lower bound, so it cannot in general be shifted wholesale into +the positive cone. A reverse theorem requires either a bounded-below version of state normality +or a strengthened weight predicate that controls those translated directed families. + +-/ + +@[expose] public section + +open scoped ENNReal + +variable {E : Type*} [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] + [Module ℝ E] [PosSMulMono ℝ E] [One E] [IsOrderUnit E] + +namespace UnitalPositiveLinearMap + +omit [IsOrderUnit E] in +/-- A normal state induces a normal weight. No new normality predicate is introduced: the proof +transports a nonempty directed positive set to `E`, applies the canonical state predicate, and +then transports the nonnegative scalar supremum through `ENNReal.ofReal`. -/ +theorem IsNormal.toWeight_isNormal {s : 𝓢[ℝ, E]} (hs : s.IsNormal) : s.toWeight.IsNormal := by + intro D x hD hdir hLUB + have hLUBcoe : IsLUB ((fun z : PosCone E => (z : E)) '' D) (x : E) := by + constructor + · rintro z ⟨z, hz, rfl⟩ + exact hLUB.1 hz + · intro y hy + obtain ⟨d, hd⟩ := hD + have hy_nonneg : (0 : E) ≤ y := by + exact (d.2.trans (hy ⟨d, hd, rfl⟩)) + let y' : PosCone E := ⟨y, hy_nonneg⟩ + exact hLUB.2 fun z hz => by + change (z : E) ≤ (y' : E) + exact hy ⟨z, hz, rfl⟩ + have hdircoe : DirectedOn (· ≤ ·) ((fun z : PosCone E => (z : E)) '' D) := by + rintro z ⟨z, hz, rfl⟩ w ⟨w, hw, rfl⟩ + obtain ⟨u, hu, hzu, hwu⟩ := hdir z hz w hw + exact ⟨u, ⟨u, hu, rfl⟩, hzu, hwu⟩ + have hsLUB := hs ((fun z : PosCone E => (z : E)) '' D) (x : E) (hD.image _) + hdircoe hLUBcoe + have hENN : IsLUB (ENNReal.ofReal '' (s '' ((fun z : PosCone E => (z : E)) '' D))) + (ENNReal.ofReal (s (x : E))) := by + constructor + · rintro r ⟨r, hr, rfl⟩ + exact ENNReal.ofReal_mono (hsLUB.1 hr) + · intro b hb + by_cases htop : b = ⊤ + · subst b + exact le_top + · rw [ENNReal.ofReal_le_iff_le_toReal htop] + apply hsLUB.2 + intro r hr + rw [← ENNReal.ofReal_le_iff_le_toReal htop] + exact hb ⟨r, hr, rfl⟩ + have himage : s.toWeight '' D = + ENNReal.ofReal '' (s '' ((fun z : PosCone E => (z : E)) '' D)) := by + ext r + constructor + · rintro ⟨z, hz, rfl⟩ + exact ⟨s (z : E), ⟨(z : E), ⟨z, hz, rfl⟩, rfl⟩, rfl⟩ + · rintro ⟨_, ⟨z, ⟨w, hw, rfl⟩, rfl⟩, rfl⟩ + exact ⟨w, hw, rfl⟩ + simpa only [himage, toWeight_apply] using hENN + +end UnitalPositiveLinearMap diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/Pure.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/Pure.lean new file mode 100644 index 0000000000..43c4279974 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/Pure.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.Convex + +/-! + +# Pure states + +## i. Overview + +Pure states are extreme points of the general convex state space. Equivalently, they cannot be +written as a genuine mixture of other states. + +## ii. Key definitions and results + +- `UnitalPositiveLinearMap.IsPure` +- `UnitalPositiveLinearMap.isPure_iff_binary_decompositions_trivial` +- `UnitalPositiveLinearMap.not_isPure_iff_nontrivial_binary_decomposition` + +## iii. Table of contents + +- A. Pure states +- B. Binary-decomposition characterizations + +-/ + +@[expose] public section + +open scoped ComplexOrder + +namespace UnitalPositiveLinearMap + +variable {𝕜 A : Type*} [RCLike 𝕜] [PosMulMono 𝕜] + [AddCommGroup A] [PartialOrder A] [IsOrderedAddMonoid A] [Module 𝕜 A] [One A] + +/-! ## A. Pure states -/ + +/-- A pure state is an extreme point of the general state space. -/ +def IsPure (ω : 𝓢[𝕜, A]) : Prop := + ω.toLinearMap ∈ (stateSpace (A := A)).extremePoints ℝ + +/-! ## B. Binary-decomposition characterizations -/ + +/-- A state is pure exactly when every genuine binary decomposition is trivial. -/ +lemma isPure_iff_binary_decompositions_trivial (ω : 𝓢[𝕜, A]) : + IsPure ω ↔ + ∀ (φ ψ : 𝓢[𝕜, A]) (t : unitInterval), t ≠ 0 → t ≠ 1 → + mix φ ψ t = ω → φ = ω ∧ ψ = ω := by + simp only [IsPure, mem_extremePoints] + constructor + · rintro ⟨-, hext⟩ φ ψ t ht₀ ht₁ hmix + have hseg := (mem_openSegment_iff_exists_mix ω φ ψ).2 ⟨t, ht₀, ht₁, hmix⟩ + obtain ⟨hφ, hψ⟩ := hext φ.toLinearMap ⟨φ, rfl⟩ ψ.toLinearMap ⟨ψ, rfl⟩ hseg + exact ⟨toLinearMap_injective hφ, toLinearMap_injective hψ⟩ + · intro h + refine ⟨⟨ω, rfl⟩, ?_⟩ + rintro _ ⟨φ, rfl⟩ _ ⟨ψ, rfl⟩ hseg + obtain ⟨t, ht₀, ht₁, hmix⟩ := (mem_openSegment_iff_exists_mix ω φ ψ).1 hseg + obtain ⟨rfl, rfl⟩ := h φ ψ t ht₀ ht₁ hmix + exact ⟨rfl, rfl⟩ + +/-- A genuine mixture equal to a pure state can only repeat that state at both endpoints. -/ +lemma IsPure.eq_of_mix {ω φ ψ : 𝓢[𝕜, A]} (hω : IsPure ω) (t : unitInterval) + (ht₀ : t ≠ 0) (ht₁ : t ≠ 1) (hmix : mix φ ψ t = ω) : + φ = ω ∧ ψ = ω := + (isPure_iff_binary_decompositions_trivial ω).mp hω φ ψ t ht₀ ht₁ hmix + +/-- A state is mixed exactly when it has a genuine nontrivial binary decomposition. -/ +lemma not_isPure_iff_nontrivial_binary_decomposition (ω : 𝓢[𝕜, A]) : + ¬ IsPure ω ↔ + ∃ (φ ψ : 𝓢[𝕜, A]) (t : unitInterval), t ≠ 0 ∧ t ≠ 1 ∧ + mix φ ψ t = ω ∧ (φ ≠ ω ∨ ψ ≠ ω) := by + rw [isPure_iff_binary_decompositions_trivial] + push Not + simp only [imp_iff_not_or] + +end UnitalPositiveLinearMap diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/Separation.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/Separation.lean new file mode 100644 index 0000000000..a3e2ce37b2 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/Separation.lean @@ -0,0 +1,236 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.Norm +public import Mathlib.Analysis.LocallyConvex.Separation +public import Mathlib.Analysis.LocallyConvex.WithSeminorms +public import Mathlib.Analysis.Normed.Operator.NormedSpace + +/-! + +# States separate the order + +## i. Overview + +The positive cone of an Archimedean order-unit space is closed in the order-unit norm. Geometric +Hahn--Banach separation therefore produces, for every point outside that cone, a continuous linear +functional that is nonnegative on the cone and negative at that point. The order unit forces this +functional to take a strictly positive value at `1`, so it can be normalized to a state. + +## ii. Key results + +- `UnitalPositiveLinearMap.exists_apply_neg_of_not_nonneg` +- `UnitalPositiveLinearMap.nonneg_iff_forall_state_nonneg` +- `UnitalPositiveLinearMap.state_nonempty` +- `UnitalPositiveLinearMap.sSup_abs_apply_eq_orderUnitNorm` + +-/ + +@[expose] public section + +open IsArchimedeanOrderUnit + +variable {E : Type*} [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] [Module ℝ E] + [PosSMulMono ℝ E] [One E] [IsArchimedeanOrderUnit E] + +namespace UnitalPositiveLinearMap + +/-- Every element outside the positive cone is detected by a state with strictly negative value. -/ +theorem exists_apply_neg_of_not_nonneg {x : E} (hx : ¬ 0 ≤ x) : + ∃ ω : 𝓢[ℝ, E], ω x < 0 := by + let _ : NormedAddCommGroup E := orderUnitNormedAddCommGroup (E := E) + let _ : NormedSpace ℝ E := orderUnitNormedSpace (E := E) + obtain ⟨f, u, hfx, hcone⟩ := geometric_hahn_banach_point_closed + (convex_Ici (0 : E)) isClosed_nonneg_orderUnitNorm hx + have hu : u < 0 := by simpa using hcone 0 le_rfl + have hf_nonneg : ∀ y : E, 0 ≤ y → 0 ≤ f y := by + intro y hy + by_contra hfy + have hfy' : f y < 0 := lt_of_not_ge hfy + let t : ℝ := (u - 1) / f y + have ht : 0 ≤ t := div_nonneg_of_nonpos (by linarith) hfy'.le + have hty : 0 ≤ t • y := smul_nonneg ht hy + have hsep := hcone (t • y) hty + rw [map_smul, smul_eq_mul] at hsep + have hcalc : t * f y = u - 1 := by + dsimp [t] + exact div_mul_cancel₀ (u - 1) hfy'.ne + linarith + let p : E →ₚ[ℝ] ℝ := PositiveLinearMap.mk₀ f.toLinearMap hf_nonneg + have hf_one_pos : 0 < f (1 : E) := by + have hf_one_nonneg : 0 ≤ f (1 : E) := hf_nonneg 1 IsOrderUnit.one_nonneg + refine lt_of_le_of_ne hf_one_nonneg ?_ + intro hf_one + have hf_one_zero : f (1 : E) = 0 := hf_one.symm + obtain ⟨n, hn⟩ := IsOrderUnit.exists_nsmul_one_le x + obtain ⟨m, hm⟩ := IsOrderUnit.exists_nsmul_one_le (-x) + have hupper : f x ≤ 0 := by + have := p.monotone' hn + change f x ≤ f (n • (1 : E)) at this + simpa [hf_one_zero] using this + have hlower : 0 ≤ f x := by + have := p.monotone' hm + change f (-x) ≤ f (m • (1 : E)) at this + simp [hf_one_zero] at this + linarith + linarith + let ω : 𝓢[ℝ, E] := ofLinearMap ((f (1 : E))⁻¹ • f.toLinearMap) + (fun y hy => mul_nonneg (inv_nonneg.mpr hf_one_pos.le) (hf_nonneg y hy)) + (by simp [hf_one_pos.ne']) + refine ⟨ω, ?_⟩ + change (f (1 : E))⁻¹ * f x < 0 + exact mul_neg_of_pos_of_neg (inv_pos.mpr hf_one_pos) (hfx.trans hu) + +/-- Positivity is completely detected by states. -/ +theorem nonneg_iff_forall_state_nonneg (x : E) : + 0 ≤ x ↔ ∀ ω : 𝓢[ℝ, E], 0 ≤ ω x := by + constructor + · exact fun hx ω => ω.map_nonneg hx + · contrapose! + exact exists_apply_neg_of_not_nonneg + +/-- Every nontrivial Archimedean order-unit space has a state. -/ +theorem state_nonempty [Nontrivial E] : Nonempty 𝓢[ℝ, E] := by + have hone_ne : (1 : E) ≠ 0 := by + intro hone + apply not_subsingleton E + constructor + intro a b + have hzero (y : E) : y = 0 := by + obtain ⟨n, hn⟩ := IsOrderUnit.exists_nsmul_one_le y + obtain ⟨m, hm⟩ := IsOrderUnit.exists_nsmul_one_le (-y) + have hy_nonpos : y ≤ 0 := by simpa [hone] using hn + have hy_nonneg : 0 ≤ y := neg_nonpos.mp (by simpa [hone] using hm) + exact le_antisymm hy_nonpos hy_nonneg + rw [hzero a, hzero b] + have hnot : ¬ 0 ≤ -(1 : E) := by + intro h + have hone : (1 : E) = 0 := le_antisymm (neg_nonneg.mp h) IsOrderUnit.one_nonneg + exact hone_ne hone + obtain ⟨ω, _⟩ := exists_apply_neg_of_not_nonneg hnot + exact ⟨ω⟩ + +/-- Every scalar strictly below the order-unit norm is exceeded by the absolute value of some +state evaluation. -/ +lemma exists_state_abs_apply_gt_of_lt_orderUnitNorm [Nontrivial E] (x : E) {r : ℝ} + (hr : r < orderUnitNorm x) : ∃ ω : 𝓢[ℝ, E], r < |ω x| := by + by_cases hr0 : r < 0 + · obtain ⟨ω⟩ := state_nonempty (E := E) + exact ⟨ω, hr0.trans_le (abs_nonneg _)⟩ + have hr_nonneg : 0 ≤ r := le_of_not_gt hr0 + have hnot : r ∉ orderUnitBounds x := by + rw [mem_orderUnitBounds_iff] + exact not_le.mpr hr + by_cases hu : x ≤ r • (1 : E) + · have hl : ¬ -(r • (1 : E)) ≤ x := fun hl => hnot ⟨hr_nonneg, hl, hu⟩ + have hnonneg : ¬ 0 ≤ r • (1 : E) + x := by + simpa [neg_le_iff_add_nonneg, add_comm] using hl + obtain ⟨ω, hω⟩ := exists_apply_neg_of_not_nonneg hnonneg + refine ⟨ω, ?_⟩ + rw [map_add, map_smul, smul_eq_mul, map_one, mul_one] at hω + exact lt_of_lt_of_le (by linarith) (neg_le_abs (ω x)) + · have hnonneg : ¬ 0 ≤ r • (1 : E) - x := by + simpa [sub_nonneg] using hu + obtain ⟨ω, hω⟩ := exists_apply_neg_of_not_nonneg hnonneg + refine ⟨ω, ?_⟩ + rw [map_sub, map_smul, smul_eq_mul, map_one, mul_one] at hω + exact lt_of_lt_of_le (by linarith) (le_abs_self (ω x)) + +/-- The order-unit norm is the supremum of the absolute values assigned by states. -/ +theorem sSup_abs_apply_eq_orderUnitNorm [Nontrivial E] (x : E) : + sSup (Set.range fun ω : 𝓢[ℝ, E] => |ω x|) = orderUnitNorm x := by + have hbdd : BddAbove (Set.range fun ω : 𝓢[ℝ, E] => |ω x|) := + ⟨orderUnitNorm x, by + rintro _ ⟨ω, rfl⟩ + exact ω.abs_apply_le_orderUnitNorm x⟩ + obtain ⟨ω₀⟩ := state_nonempty (E := E) + have hne : (Set.range fun ω : 𝓢[ℝ, E] => |ω x|).Nonempty := + ⟨|ω₀ x|, Set.mem_range_self ω₀⟩ + apply le_antisymm + · exact csSup_le hne fun _ h => by + obtain ⟨ω, rfl⟩ := h + exact ω.abs_apply_le_orderUnitNorm x + · apply le_of_forall_lt + intro r hr + obtain ⟨ω, hω⟩ := exists_state_abs_apply_gt_of_lt_orderUnitNorm x hr + exact hω.trans_le (le_csSup hbdd (Set.mem_range_self ω)) + +/-- On a positive element, the absolute values in the norm representation can be omitted. -/ +theorem sSup_apply_eq_orderUnitNorm [Nontrivial E] {x : E} (hx : 0 ≤ x) : + sSup (Set.range fun ω : 𝓢[ℝ, E] => ω x) = orderUnitNorm x := by + have hrange : (Set.range fun ω : 𝓢[ℝ, E] => ω x) = + Set.range fun ω : 𝓢[ℝ, E] => |ω x| := by + ext y + constructor <;> rintro ⟨ω, rfl⟩ + · exact ⟨ω, abs_of_nonneg (ω.map_nonneg hx)⟩ + · exact ⟨ω, (abs_of_nonneg (ω.map_nonneg hx)).symm⟩ + rw [hrange, sSup_abs_apply_eq_orderUnitNorm] + +/-- A state, regarded canonically as a continuous functional on the copy of `E` carrying the +order-unit norm. -/ +noncomputable def toOrderUnitContinuousLinearMap (ω : 𝓢[ℝ, E]) : + WithOrderUnitNorm E →L[ℝ] ℝ := + ω.toLinearMap.mkContinuous 1 fun x => by + rw [one_mul, Real.norm_eq_abs, WithOrderUnitNorm.norm_eq_orderUnitNorm] + exact ω.abs_apply_le_orderUnitNorm x + +@[simp] +lemma toOrderUnitContinuousLinearMap_apply (ω : 𝓢[ℝ, E]) (x : E) : + ω.toOrderUnitContinuousLinearMap x = ω x := rfl + +/-- The continuous-dual realization of states is injective. -/ +lemma toOrderUnitContinuousLinearMap_injective : + Function.Injective + (toOrderUnitContinuousLinearMap : 𝓢[ℝ, E] → WithOrderUnitNorm E →L[ℝ] ℝ) := by + intro ω φ h + ext x + have hx := DFunLike.congr_fun h (WithOrderUnitNorm.linearEquiv x) + change ω x = φ x at hx + exact hx + +/-- In every nontrivial Archimedean order-unit space, the distinguished order unit has norm +exactly one. -/ +@[simp] +theorem orderUnitNorm_one [Nontrivial E] : orderUnitNorm (1 : E) = 1 := by + rw [← sSup_abs_apply_eq_orderUnitNorm] + obtain ⟨ω₀⟩ := state_nonempty (E := E) + have hrange : (Set.range fun ω : 𝓢[ℝ, E] => |ω (1 : E)|) = {1} := by + ext y + constructor + · rintro ⟨ω, rfl⟩ + simp + · intro hy + rw [Set.mem_singleton_iff.mp hy] + exact ⟨ω₀, by simp⟩ + rw [hrange, csSup_singleton] + +/-- The operator norm used locally for the continuous dual of the order-unit-norm copy. -/ +noncomputable local instance : Norm (WithOrderUnitNorm E →L[ℝ] ℝ) := + ContinuousLinearMap.hasOpNorm + +/-- Every state has continuous-dual norm exactly one for the order-unit norm. -/ +@[simp] +theorem norm_toOrderUnitContinuousLinearMap [Nontrivial E] (ω : 𝓢[ℝ, E]) : + ‖ω.toOrderUnitContinuousLinearMap‖ = 1 := by + apply le_antisymm + · apply ContinuousLinearMap.opNorm_le_bound _ zero_le_one + intro x + rw [one_mul, Real.norm_eq_abs, WithOrderUnitNorm.norm_eq_orderUnitNorm] + exact ω.abs_apply_le_orderUnitNorm x + · calc + 1 = ‖ω.toOrderUnitContinuousLinearMap (WithOrderUnitNorm.linearEquiv (1 : E))‖ := by + change 1 = ‖ω (1 : E)‖ + rw [map_one] + norm_num + _ ≤ ‖ω.toOrderUnitContinuousLinearMap‖ * + ‖WithOrderUnitNorm.linearEquiv (1 : E)‖ := + ω.toOrderUnitContinuousLinearMap.le_opNorm _ + _ = ‖ω.toOrderUnitContinuousLinearMap‖ := by + rw [WithOrderUnitNorm.norm_eq_orderUnitNorm, WithOrderUnitNorm.linearEquiv_apply, + orderUnitNorm_one, mul_one] + +end UnitalPositiveLinearMap diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/WeightEquivalence.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/WeightEquivalence.lean new file mode 100644 index 0000000000..005ad01e7d --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/State/WeightEquivalence.lean @@ -0,0 +1,217 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Weight.Extension +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.Basic + +/-! + +# Equivalence between states and finite normalized weights + +## i. Overview + +A state is, on its own terms, a normalized positive linear functional — `𝓢[ℝ, E]`, already fully +built in `State/Basic.lean`. It is not *defined* as a weight; `Weight.stateEquiv` is the genuine +theorem connecting the two independent notions, replacing what would otherwise be an inheritance +chain forcing every state-level fact through weight machinery. + +## ii. Key definitions and results + +- `Weight.IsState.toUnitalPositiveLinearMap` : a state weight, as a state. +- `UnitalPositiveLinearMap.toWeight` : a state, as a (finite, normalized) weight. +- `Weight.stateEquiv` : the equivalence between the two. +- `Weight.finiteEquiv` : finite weights correspond to positive real linear functionals. +- `Weight.IsFinite.normalizedState` : the canonical state obtained from a finite nonzero weight. + +## iii. Table of contents + +- A. From state weights to states +- B. From states to weights +- C. The equivalence +- D. Normalizing a finite weight + +-/ + +@[expose] public section + +open scoped ENNReal + +variable {E : Type*} [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] + [Module ℝ E] [PosSMulMono ℝ E] [One E] [IsOrderUnit E] + +namespace Weight + +variable {w : Weight E} + +namespace IsState + +/-! ## A. From state weights to states -/ + +/-- The extension of a state weight is its finite-weight extension. -/ +noncomputable abbrev toFun (hw : w.IsState) : E → ℝ := hw.finite.toFun + +/-- The linear extension of a state weight is its finite-weight extension. -/ +noncomputable abbrev toLinearMap (hw : w.IsState) : E →ₗ[ℝ] ℝ := hw.finite.toLinearMap + +/-- A finite normalized weight extends to a state. -/ +noncomputable def toUnitalPositiveLinearMap (hw : w.IsState) : 𝓢[ℝ, E] := + UnitalPositiveLinearMap.ofLinearMap (toLinearMap hw) + (fun x hx => hw.finite.toPositiveLinearMap.map_nonneg hx) + (calc + toLinearMap hw (1 : E) = (w Weight.unit).toReal := by + simpa [toLinearMap, toFun, Weight.unit] using hw.finite.toFun_of_nonneg Weight.unit + _ = 1 := by rw [hw.normalized, ENNReal.toReal_one]) + +@[simp] +lemma toUnitalPositiveLinearMap_apply (hw : w.IsState) (x : E) : + hw.toUnitalPositiveLinearMap x = hw.toFun x := rfl + +end IsState + +end Weight + +namespace UnitalPositiveLinearMap + +/-! ## B. From states to weights -/ + +/-- The weight induced by a state: `ENNReal.ofReal` applied to the state's values on the positive +cone, where they are automatically nonnegative — so this loses no information about `s` there +(`toReal_toWeight_apply`), even though `s` itself carries strictly more data (its values off the +cone). -/ +noncomputable def toWeight (s : 𝓢[ℝ, E]) : Weight E where + toFun x := ENNReal.ofReal (s (x : E)) + map_add' x y := by + show ENNReal.ofReal (s ((x : E) + (y : E))) = + ENNReal.ofReal (s (x : E)) + ENNReal.ofReal (s (y : E)) + rw [map_add, ENNReal.ofReal_add (s.map_nonneg x.2) (s.map_nonneg y.2)] + map_smul' c x := by + show ENNReal.ofReal (s ((c : ℝ) • (x : E))) = c • ENNReal.ofReal (s (x : E)) + have hcx : s ((c : ℝ) • (x : E)) = (c : ℝ) * s (x : E) := by rw [map_smul, smul_eq_mul] + rw [hcx, ENNReal.ofReal_mul c.coe_nonneg, ENNReal.ofReal_coe_nnreal, ENNReal.smul_def, + smul_eq_mul] + +omit [IsOrderUnit E] in +@[simp] +lemma toWeight_apply (s : 𝓢[ℝ, E]) (x : PosCone E) : s.toWeight x = ENNReal.ofReal (s (x : E)) := + rfl + +omit [IsOrderUnit E] in +/-- The weight induced by a state agrees with the state itself on the positive cone: no +information about `s` there is lost by passing through `ENNReal.ofReal` and back. -/ +lemma toReal_toWeight_apply (s : 𝓢[ℝ, E]) (x : PosCone E) : (s.toWeight x).toReal = s (x : E) := by + rw [toWeight_apply, ENNReal.toReal_ofReal (s.map_nonneg x.2)] + +/-- The weight induced by a state is itself a state: finite (`ENNReal.ofReal` never reaches `⊤`) +and normalized (`s` sends the order unit to `1`). -/ +lemma toWeight_isState (s : 𝓢[ℝ, E]) : s.toWeight.IsState where + finite _ := ENNReal.ofReal_ne_top + normalized := by + have h1 : ((Weight.unit : PosCone E) : E) = 1 := rfl + show ENNReal.ofReal (s ((Weight.unit : PosCone E) : E)) = 1 + rw [h1, map_one, ENNReal.ofReal_one] + +end UnitalPositiveLinearMap + +namespace PositiveLinearMap + +/-! ## C. Positive functionals and finite weights -/ + +/-- The finite weight induced by a positive real linear functional. -/ +noncomputable def toWeight (f : E →ₚ[ℝ] ℝ) : Weight E where + toFun x := ENNReal.ofReal (f (x : E)) + map_add' x y := by + rw [show f ((x + y : PosCone E) : E) = f (x : E) + f (y : E) by simp, + ENNReal.ofReal_add (f.map_nonneg x.2) (f.map_nonneg y.2)] + map_smul' c x := by + show ENNReal.ofReal (f ((c : ℝ) • (x : E))) = c • ENNReal.ofReal (f (x : E)) + rw [map_smul, smul_eq_mul, ENNReal.ofReal_mul c.coe_nonneg, + ENNReal.ofReal_coe_nnreal, ENNReal.smul_def, smul_eq_mul] + +omit [One E] [IsOrderUnit E] in +@[simp] +lemma toWeight_apply (f : E →ₚ[ℝ] ℝ) (x : PosCone E) : + f.toWeight x = ENNReal.ofReal (f (x : E)) := rfl + +omit [One E] [IsOrderUnit E] in +/-- A positive functional's induced weight is finite. -/ +lemma toWeight_isFinite (f : E →ₚ[ℝ] ℝ) : f.toWeight.IsFinite := + fun _ => ENNReal.ofReal_ne_top + +omit [One E] [IsOrderUnit E] in +/-- Passing from a positive functional to a weight and back to real values loses no information +on the positive cone. -/ +lemma toReal_toWeight_apply (f : E →ₚ[ℝ] ℝ) (x : PosCone E) : + (f.toWeight x).toReal = f (x : E) := by + rw [toWeight_apply, ENNReal.toReal_ofReal (f.map_nonneg x.2)] + +end PositiveLinearMap + +namespace Weight + +/-! ## D. The equivalences -/ + +/-- Finite weights correspond exactly to positive real linear functionals. -/ +noncomputable def finiteEquiv : {w : Weight E // w.IsFinite} ≃ (E →ₚ[ℝ] ℝ) where + toFun w := w.2.toPositiveLinearMap + invFun f := ⟨f.toWeight, f.toWeight_isFinite⟩ + left_inv := by + rintro ⟨w, hw⟩ + refine Subtype.ext (Weight.ext fun x => ?_) + change ENNReal.ofReal (hw.toPositiveLinearMap (x : E)) = w x + rw [hw.toPositiveLinearMap_apply_of_nonneg] + exact ENNReal.ofReal_toReal (hw x) + right_inv := by + intro f + exact (f.toWeight_isFinite.toPositiveLinearMap_unique f fun x => + (f.toReal_toWeight_apply x).symm).symm + +/-- Finite normalized weights correspond exactly to states. This is the representation theorem +that replaces bundling a state as a subtype of `Weight`: `Weight` and `𝓢[ℝ, E]` are independent +notions — one general and possibly infinite, the other linear and finite by definition — and this +equivalence is the (nontrivial, but genuinely separate) fact connecting them. -/ +noncomputable def stateEquiv : {w : Weight E // w.IsState} ≃ 𝓢[ℝ, E] where + toFun w := w.2.toUnitalPositiveLinearMap + invFun s := ⟨s.toWeight, s.toWeight_isState⟩ + left_inv := by + rintro ⟨w, hw⟩ + refine Subtype.ext (Weight.ext fun x => ?_) + show ENNReal.ofReal (hw.toUnitalPositiveLinearMap (x : E)) = w x + simp [hw.toUnitalPositiveLinearMap_apply, ENNReal.ofReal_toReal (hw.finite x)] + right_inv := by + intro s + refine UnitalPositiveLinearMap.ext fun x => ?_ + obtain ⟨r, hr⟩ := exists_real_shift_nonneg x + set hw := s.toWeight_isState + show hw.finite.toFun x = s x + rw [hw.finite.toFun_eq x hr, IsFinite.rawValue] + simp only [UnitalPositiveLinearMap.toReal_toWeight_apply, + show ((Weight.unit : PosCone E) : E) = 1 from rfl, _root_.map_add, _root_.map_smul, + smul_eq_mul, _root_.map_one] + ring + +/-! ## E. Normalizing a finite weight -/ + +namespace IsFinite + +/-- The canonical state associated to a finite weight of nonzero mass: first divide the weight by +its value at the order unit, then use `stateEquiv`. All state statistics, including covariance, +are inherited through this map rather than redeclared for weights. -/ +noncomputable def normalizedState {w : Weight E} (hw : w.IsFinite) (hmass : w unit ≠ 0) : + 𝓢[ℝ, E] := + (hw.normalize_isState hmass).toUnitalPositiveLinearMap + +/-- Converting the normalized state back to a weight recovers normalization of the original +weight. -/ +theorem normalizedState_toWeight {w : Weight E} (hw : w.IsFinite) (hmass : w unit ≠ 0) : + (hw.normalizedState hmass).toWeight = normalize w := by + have h := (stateEquiv (E := E)).symm_apply_apply + ⟨normalize w, hw.normalize_isState hmass⟩ + exact congrArg Subtype.val h + +end IsFinite + +end Weight diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/Symmetry.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Symmetry.lean new file mode 100644 index 0000000000..f9c83e1498 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Symmetry.lean @@ -0,0 +1,261 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.Basic +public import Mathlib.Algebra.Group.Action.Hom + +/-! + +# Symmetry: order-automorphisms and their action on states + +## i. Overview + +Physically, a symmetry of a system is a *reversible* transformation: a change of description that +loses no information and can always be undone. In the order-unit picture (`Channel/Basic.lean`) a +transformation between effect algebras is a channel, a unital positive linear map; a symmetry is +exactly a channel `φ : E →ₚ₁[ℝ] E` that is invertible with an inverse `φ⁻¹` that is *also* a +channel. Both directions have to be physical: undoing a symmetry must again be positive and send +the certain event to the certain event, not just be some linear inverse. + +A group `G` acting on `E` "by symmetries" is then a homomorphism `ρ : G →* Symmetry E` into the +group of such automorphisms. Every symmetry, via `UnitalPositiveLinearMap.comp`, transports a +state: precomposing a state `ω : E →ₚ₁[ℝ] ℝ` with `φ⁻¹` gives the state that assigns to an +observable `x` whatever `ω` assigned to the pulled-back observable `φ⁻¹ x`. This needs no new +proof of positivity or normalization — `ω.comp φ⁻¹` is already a unital positive linear map +because `.comp` always is; all that is new +here is checking this assignment is a genuine group action, `(g*h) • ω = g • (h • ω)` and +`1 • ω = ω`, which reduces to associativity and identity laws for `.comp` already on hand. + +This is the state-level pushforward along a channel, specialized to a channel that happens to be +invertible (`Channel/Basic.lean`'s `Weight.comp` is the same idea one level down, on weights on +the positive cone; working with the state directly as a `UnitalPositiveLinearMap` avoids the extra +order-unit hypotheses `Weight.comp` needs and is the cleaner route here). + +## ii. Key definitions and results + +- `IsOrderAutomorphism φ`: `φ` is a channel with a two-sided inverse that is also a channel. +- `Symmetry E`: the bundled group of order-automorphisms of `E`, with `Group` instance + `mul := comp`. +- The `MulAction (Symmetry E) (𝓢[ℝ, E])` instance: pushing a state forward along the inverse + automorphism. +- `stateSMul`: the action of a general `G` on `𝓢[ℝ, E]` induced by a homomorphism + `ρ : G →* Symmetry E`, together with the group action laws it satisfies. +- `OneParameterAutomorphismGroup E`: a one-parameter (reversible dynamics) family + `α : ℝ → (E →ₚ₁[ℝ] E)` with `α 0 = id` and `α (s + t) = α s ∘ α t`, each `α t` an automorphism. + +## iii. Table of contents + +- A. Order automorphisms +- B. The symmetry group +- C. The induced action on states +- D. One-parameter automorphism groups + +-/ + +@[expose] public section + +variable {E : Type*} [AddCommGroup E] [PartialOrder E] [Module ℝ E] [One E] + +/-! ## A. Order automorphisms -/ + +/-- `φ` is an order-automorphism of `E`: a channel with a two-sided inverse that is itself a +channel. Equivalently, `φ` is bijective and both `φ` and `φ⁻¹` are positive and unital +(`IsOrderAutomorphism.bijective` records the "bijective" half of that equivalence). -/ +def IsOrderAutomorphism (φ : E →ₚ₁[ℝ] E) : Prop := + ∃ ψ : E →ₚ₁[ℝ] E, ψ.comp φ = .id ℝ E ∧ φ.comp ψ = .id ℝ E + +/-- The identity is trivially an order-automorphism. -/ +lemma isOrderAutomorphism_id : IsOrderAutomorphism (.id ℝ E : E →ₚ₁[ℝ] E) := + ⟨.id ℝ E, UnitalPositiveLinearMap.id_comp _, UnitalPositiveLinearMap.id_comp _⟩ + +namespace IsOrderAutomorphism + +variable {φ ψ : E →ₚ₁[ℝ] E} + +/-- A chosen inverse channel witnessing `φ` is an order-automorphism. -/ +noncomputable def inverse (h : IsOrderAutomorphism φ) : E →ₚ₁[ℝ] E := h.choose + +lemma inverse_comp (h : IsOrderAutomorphism φ) : h.inverse.comp φ = .id ℝ E := h.choose_spec.1 + +lemma comp_inverse (h : IsOrderAutomorphism φ) : φ.comp h.inverse = .id ℝ E := h.choose_spec.2 + +/-- Pointwise form of `inverse_comp`: applying `φ` then its chosen inverse is the identity. -/ +lemma inverse_apply_apply (h : IsOrderAutomorphism φ) (x : E) : h.inverse (φ x) = x := by + simpa using DFunLike.congr_fun h.inverse_comp x + +/-- Pointwise form of `comp_inverse`: applying the chosen inverse then `φ` is the identity. -/ +lemma apply_inverse_apply (h : IsOrderAutomorphism φ) (x : E) : φ (h.inverse x) = x := by + simpa using DFunLike.congr_fun h.comp_inverse x + +/-- The inverse of an order-automorphism is again an order-automorphism, witnessed by `φ` itself. +-/ +lemma inverse_isOrderAutomorphism (h : IsOrderAutomorphism φ) : + IsOrderAutomorphism h.inverse := + ⟨φ, h.comp_inverse, h.inverse_comp⟩ + +/-- The composite of two order-automorphisms is again one, witnessed by the composite of their +inverses in the opposite order. -/ +lemma comp (hφ : IsOrderAutomorphism φ) (hψ : IsOrderAutomorphism ψ) : + IsOrderAutomorphism (φ.comp ψ) := by + refine ⟨hψ.inverse.comp hφ.inverse, ?_, ?_⟩ + · ext x + simp [hφ.inverse_apply_apply, hψ.inverse_apply_apply] + · ext x + simp [hφ.apply_inverse_apply, hψ.apply_inverse_apply] + +/-- An order-automorphism is, in particular, a bijection of `E` — the "equivalently" half of the +definition's docstring. -/ +lemma bijective (h : IsOrderAutomorphism φ) : Function.Bijective φ := + Function.bijective_iff_has_inverse.mpr ⟨h.inverse, h.inverse_apply_apply, h.apply_inverse_apply⟩ + +end IsOrderAutomorphism + +/-! ## B. The symmetry group -/ + +/-- A symmetry of `E`: an order-automorphism, bundled with its defining property. Composition +makes these into a group, `Symmetry.instGroup` below. Reducible, so the underlying channel +coercion (`Subtype.val`) unifies transparently wherever a `E →ₚ₁[ℝ] E` is expected. -/ +abbrev Symmetry (E : Type*) [AddCommGroup E] [PartialOrder E] [Module ℝ E] [One E] := + {φ : E →ₚ₁[ℝ] E // IsOrderAutomorphism φ} + +namespace Symmetry + +@[ext] +lemma ext {φ ψ : Symmetry E} (h : ∀ x, (φ : E →ₚ₁[ℝ] E) x = (ψ : E →ₚ₁[ℝ] E) x) : φ = ψ := + Subtype.ext (UnitalPositiveLinearMap.ext h) + +instance instOne : One (Symmetry E) := ⟨⟨.id ℝ E, isOrderAutomorphism_id⟩⟩ + +instance instMul : Mul (Symmetry E) := ⟨fun φ ψ => ⟨φ.1.comp ψ.1, φ.2.comp ψ.2⟩⟩ + +noncomputable instance instInv : Inv (Symmetry E) := + ⟨fun φ => ⟨φ.2.inverse, φ.2.inverse_isOrderAutomorphism⟩⟩ + +@[simp] lemma val_one : (1 : Symmetry E).1 = .id ℝ E := rfl + +@[simp] lemma val_mul (φ ψ : Symmetry E) : (φ * ψ).1 = φ.1.comp ψ.1 := rfl + +@[simp] lemma val_inv (φ : Symmetry E) : (φ⁻¹ : Symmetry E).1 = φ.2.inverse := rfl + +/-- Order-automorphisms of `E` form a group under composition, with `1` the identity channel and +`φ⁻¹` the (chosen) inverse channel. -/ +noncomputable instance instGroup : Group (Symmetry E) where + mul_assoc φ ψ χ := Subtype.ext (UnitalPositiveLinearMap.comp_assoc φ.1 ψ.1 χ.1) + one_mul φ := Subtype.ext (UnitalPositiveLinearMap.id_comp φ.1) + mul_one φ := Subtype.ext (UnitalPositiveLinearMap.comp_id φ.1) + inv_mul_cancel φ := Subtype.ext φ.2.inverse_comp + +/-- The symmetry group is canonically equivalent to the group of units of the monoid of unital +positive endomorphisms. This identifies the explicit order-automorphism presentation with +Mathlib's general algebraic notion of an invertible element. -/ +noncomputable def unitsEquiv : Symmetry E ≃* (E →ₚ₁[ℝ] E)ˣ where + toFun φ := + { val := φ.1 + inv := φ.2.inverse + val_inv := φ.2.comp_inverse + inv_val := φ.2.inverse_comp } + invFun φ := ⟨φ.val, ⟨φ.inv, φ.inv_val, φ.val_inv⟩⟩ + left_inv _ := Symmetry.ext fun _ => rfl + right_inv _ := Units.ext rfl + map_mul' _ _ := Units.ext rfl + +/-! ## C. The induced action on states -/ + +/-- The canonical action of `Symmetry E` on the state space `𝓢[ℝ, E]`: a symmetry `φ` transports a +state `ω` by pulling it back along the inverse automorphism, `φ • ω = ω ∘ φ⁻¹`. This is exactly +the Schrödinger-picture pushforward of a state along the channel `φ⁻¹` (`Channel/Basic.lean`), so +it costs nothing beyond `UnitalPositiveLinearMap.comp` — positivity and normalization of `φ • ω` +are already built into `.comp`. -/ +noncomputable instance instMulActionState : MulAction (Symmetry E) (𝓢[ℝ, E]) where + smul φ ω := ω.comp φ⁻¹.1 + one_smul ω := by + show ω.comp (1 : Symmetry E)⁻¹.1 = ω + rw [inv_one, val_one, UnitalPositiveLinearMap.comp_id] + mul_smul φ ψ ω := by + show ω.comp (φ * ψ)⁻¹.1 = (ω.comp ψ⁻¹.1).comp φ⁻¹.1 + rw [mul_inv_rev, val_mul, ← UnitalPositiveLinearMap.comp_assoc] + +lemma smul_state_def (φ : Symmetry E) (ω : 𝓢[ℝ, E]) : φ • ω = ω.comp φ⁻¹.1 := rfl + +/-- A group `G` acting on `E` by order-automorphisms — a homomorphism `ρ : G →* Symmetry E` — acts +on the state space `𝓢[ℝ, E]` by transporting each state along `ρ g`. This is the induced action of +`instMulActionState` along `ρ`, so the group action laws below are inherited for free rather than +reproved: they are literally `mul_smul`/`one_smul` for `instMulActionState`, precomposed with the +homomorphism `ρ`. -/ +noncomputable def stateSMul {G : Type*} [Group G] (ρ : G →* Symmetry E) (g : G) (ω : 𝓢[ℝ, E]) : + 𝓢[ℝ, E] := + ρ g • ω + +@[simp] lemma stateSMul_one {G : Type*} [Group G] (ρ : G →* Symmetry E) (ω : 𝓢[ℝ, E]) : + stateSMul ρ 1 ω = ω := by + simp [stateSMul] + +lemma stateSMul_mul {G : Type*} [Group G] (ρ : G →* Symmetry E) (g h : G) (ω : 𝓢[ℝ, E]) : + stateSMul ρ (g * h) ω = stateSMul ρ g (stateSMul ρ h ω) := by + simp [stateSMul, map_mul, mul_smul] + +end Symmetry + +/-! ## D. One-parameter automorphism groups: reversible dynamics -/ + +/-- A one-parameter group of order-automorphisms of `E`, indexed by time: `α t` is the +automorphism of "let `t` units of time pass". This is exactly the "reversible dynamics" idea named +in `OVERVIEW.md` (§8's channels, §13's outlook) — the definition and group law only; generators +and Stone's theorem are future work. -/ +structure OneParameterAutomorphismGroup (E : Type*) [AddCommGroup E] [PartialOrder E] + [Module ℝ E] [One E] where + /-- The automorphism of `E` after time `t` has passed. -/ + toFun : ℝ → E →ₚ₁[ℝ] E + /-- Letting no time pass does nothing. -/ + map_zero' : toFun 0 = .id ℝ E + /-- Letting `s + t` units of time pass is the same as letting `t` pass, then `s`. -/ + map_add' : ∀ s t, toFun (s + t) = (toFun s).comp (toFun t) + +namespace OneParameterAutomorphismGroup + +instance : CoeFun (OneParameterAutomorphismGroup E) (fun _ => ℝ → E →ₚ₁[ℝ] E) := ⟨toFun⟩ + +@[simp] lemma coe_map_zero (α : OneParameterAutomorphismGroup E) : α 0 = .id ℝ E := α.map_zero' + +lemma coe_map_add (α : OneParameterAutomorphismGroup E) (s t : ℝ) : + α (s + t) = (α s).comp (α t) := α.map_add' s t + +/-- Every automorphism in a one-parameter group is genuinely an order-automorphism, with `α (-t)` +its inverse: running time backwards undoes running it forwards. -/ +lemma isOrderAutomorphism (α : OneParameterAutomorphismGroup E) (t : ℝ) : + IsOrderAutomorphism (α t) := by + refine ⟨α (-t), ?_, ?_⟩ + · rw [← α.coe_map_add, neg_add_cancel, α.coe_map_zero] + · rw [← α.coe_map_add, add_neg_cancel, α.coe_map_zero] + +/-- A one-parameter automorphism group organizes into a homomorphism from `Multiplicative ℝ` into +the automorphism group `Symmetry E` — reconnecting to the general group action of +`Symmetry.stateSMul` above, with `G = Multiplicative ℝ`. -/ +noncomputable def toSymmetryHom (α : OneParameterAutomorphismGroup E) : + Multiplicative ℝ →* Symmetry E where + toFun t := ⟨α (Multiplicative.toAdd t), α.isOrderAutomorphism _⟩ + map_one' := Symmetry.ext fun x => by simp + map_mul' s t := Symmetry.ext fun x => by + simp [Symmetry.val_mul, α.coe_map_add, UnitalPositiveLinearMap.comp_apply] + +/-- The state evolution induced by a one-parameter automorphism group: `α.stateEvolution t` moves +a state forward by time `t`, and composes correctly in `t` (`Symmetry.stateSMul_mul` specialized +along `toSymmetryHom`). -/ +noncomputable def stateEvolution (α : OneParameterAutomorphismGroup E) (t : ℝ) (ω : 𝓢[ℝ, E]) : + 𝓢[ℝ, E] := + Symmetry.stateSMul α.toSymmetryHom (Multiplicative.ofAdd t) ω + +@[simp] lemma stateEvolution_zero (α : OneParameterAutomorphismGroup E) (ω : 𝓢[ℝ, E]) : + α.stateEvolution 0 ω = ω := by + simp [stateEvolution, ofAdd_zero] + +lemma stateEvolution_add (α : OneParameterAutomorphismGroup E) (s t : ℝ) (ω : 𝓢[ℝ, E]) : + α.stateEvolution (s + t) ω = α.stateEvolution s (α.stateEvolution t ω) := by + simp only [stateEvolution, ofAdd_add] + exact Symmetry.stateSMul_mul α.toSymmetryHom (Multiplicative.ofAdd s) (Multiplicative.ofAdd t) ω + +end OneParameterAutomorphismGroup diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/Weight/Basic.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Weight/Basic.lean new file mode 100644 index 0000000000..b5309a45e5 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Weight/Basic.lean @@ -0,0 +1,216 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Mathlib.Data.ENNReal.Basic +public import Mathlib.Data.ENNReal.Action +public import Mathlib.Data.ENNReal.Inv +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Basic + +/-! + +# Weights + +## i. Overview + +A weight is a statistical weight: a number in `[0, ∞]` on each outcome saying how much of it +there is, with no requirement that the total be finite or normalized to 1 — hence the `∞` and +the fact that weights are compared, never subtracted. They live on `PosCone E`, the space of +possible outcomes from `OrderUnit/Basic.lean`. + +Being an honest linear map, `Weight E` is automatically an `ℝ≥0`-module in its own right: combining +two weights with nonnegative coefficients is again a weight, for free, with no boundedness proof to +give (contrast `Effect`, a bounded slice of `E` that needs `Effect.convex` to stay closed under +mixing). `Weight.IsState.mix` is the one thing that *does* need proving: that this combination +preserves normalization when the coefficients sum to `1`. + +## ii. Key definitions and results + +- `Weight E` +- `Weight.IsFaithful`, `Weight.IsFinite`, `Weight.IsSemifinite`, `Weight.IsNormal` : the standard + refinements. +- `Weight.IsState` : a finite weight normalized at the order unit — an actual state. +- `Weight.mix`, `Weight.IsState.mix` : mixing two (state) weights. +- `Weight.normalize` : normalization of a finite nonzero weight by its mass at the order unit. + +## iii. Table of contents + +- A. Weights on the positive cone +- B. Standard properties of weights +- C. Mixtures +- D. State weights +- E. Normalization + +-/ + +@[expose] public section + +open scoped ENNReal NNReal + +variable {E : Type*} [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] + [Module ℝ E] [PosSMulMono ℝ E] + +/-- The weight of each possible outcome, valued in `[0, ∞]`. -/ +abbrev Weight (E : Type*) [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] + [Module ℝ E] [PosSMulMono ℝ E] := PosCone E →ₗ[ℝ≥0] ℝ≥0∞ + +namespace Weight + +/-! ## A. Weights on the positive cone -/ + +@[ext] +lemma ext {w₁ w₂ : Weight E} (h : ∀ x, w₁ x = w₂ x) : w₁ = w₂ := + LinearMap.ext h + +@[simp] +lemma map_zero (w : Weight E) : w 0 = 0 := _root_.map_zero w + +@[simp] +lemma map_add (w : Weight E) (x y : PosCone E) : w (x + y) = w x + w y := _root_.map_add w x y + +/-- A bigger outcome never gets less weight. -/ +lemma mono (w : Weight E) : Monotone (w : PosCone E → ℝ≥0∞) := by + intro x y hxy + have hz : (0 : E) ≤ (y : E) - (x : E) := sub_nonneg.mpr hxy + set z : PosCone E := ⟨(y : E) - (x : E), hz⟩ + have hxz : x + z = y := by + ext + show (x : E) + ((y : E) - (x : E)) = (y : E) + abel + calc w x ≤ w x + w z := le_self_add + _ = w (x + z) := (map_add w x z).symm + _ = w y := by rw [hxz] + +/-! ## B. Standard properties of weights -/ + +/-- Only the impossible outcome carries no weight at all. -/ +def IsFaithful (w : Weight E) : Prop := ∀ x : PosCone E, w x = 0 → x = 0 + +/-- The weight never blows up to `∞`. -/ +def IsFinite (w : Weight E) : Prop := ∀ x : PosCone E, w x ≠ ⊤ + +/-- A weight is semifinite when its value on every positive element is the supremum of its values +on the finite-weight positive elements below it. -/ +def IsSemifinite (w : Weight E) : Prop := + ∀ x : PosCone E, + w x = ⨆ y : {y : PosCone E // y ≤ x ∧ w y ≠ ⊤}, w y + +/-- Every finite weight is semifinite: the element itself occurs among the finite elements below +it, while monotonicity bounds every other term by its value. -/ +lemma IsFinite.isSemifinite {w : Weight E} (hw : w.IsFinite) : w.IsSemifinite := by + intro x + apply le_antisymm + · exact le_iSup (fun y : {y : PosCone E // y ≤ x ∧ w y ≠ ⊤} => w y) + ⟨x, le_rfl, hw x⟩ + · apply iSup_le + intro y + exact w.mono y.2.1 + +/-- The weight of a limit of outcomes is the limit of their weights: it doesn't jump when you +take a supremum. -/ +def IsNormal (w : Weight E) : Prop := + ∀ (D : Set (PosCone E)) (x : PosCone E), D.Nonempty → DirectedOn (· ≤ ·) D → IsLUB D x → + IsLUB (w '' D) (w x) + +/-- A normal weight preserves the least upper bound of every increasing sequence. This is the +sequential form used for monotone approximation and countable measurement sums. -/ +lemma IsNormal.map_isLUB_of_monotone {w : Weight E} (hw : w.IsNormal) + (x : ℕ → PosCone E) (hx : Monotone x) {a : PosCone E} (ha : IsLUB (Set.range x) a) : + IsLUB (Set.range fun n => w (x n)) (w a) := by + have h := hw (Set.range x) a ⟨x 0, Set.mem_range_self 0⟩ + hx.directed_le.directedOn_range ha + have himage : w '' Set.range x = Set.range fun n => w (x n) := by + ext y + constructor + · rintro ⟨_, ⟨n, rfl⟩, rfl⟩ + exact ⟨n, rfl⟩ + · rintro ⟨n, rfl⟩ + exact ⟨x n, ⟨n, rfl⟩, rfl⟩ + rwa [himage] at h + +/-- A normal weight sends a monotone sequence with supremum `a` to an `ENNReal` sequence whose +supremum is exactly `w a`. -/ +lemma IsNormal.iSup_map_eq_of_monotone {w : Weight E} (hw : w.IsNormal) + (x : ℕ → PosCone E) (hx : Monotone x) {a : PosCone E} (ha : IsLUB (Set.range x) a) : + (⨆ n, w (x n)) = w a := + (hw.map_isLUB_of_monotone x hx ha).iSup_eq + +/-! ## C. Mixtures -/ + +/-- Mixing two weights with `ℝ≥0` coefficients: already a weight, for free, since `Weight E` is +itself an `ℝ≥0`-module. -/ +noncomputable def mix (w₁ w₂ : Weight E) (a b : ℝ≥0) : Weight E := a • w₁ + b • w₂ + +@[simp] +lemma mix_apply (w₁ w₂ : Weight E) (a b : ℝ≥0) (x : PosCone E) : + mix w₁ w₂ a b x = a • w₁ x + b • w₂ x := rfl + +variable [One E] [IsOrderUnit E] + +/-! ## D. State weights -/ + +/-- The certain outcome, as a point of the cone. -/ +def unit : PosCone E := ⟨1, IsOrderUnit.one_nonneg⟩ + +/-- A weight is finite everywhere exactly when it is finite at the order unit. The forward +implication is immediate; conversely, every positive element is bounded by a natural multiple of +the order unit, and monotonicity transfers finiteness down along that bound. -/ +lemma isFinite_iff_unit_ne_top (w : Weight E) : w.IsFinite ↔ w unit ≠ ⊤ := by + constructor + · exact fun hw => hw unit + · intro hw x + obtain ⟨n, hn⟩ := IsOrderUnit.exists_nsmul_one_le (x : E) + have hxle : x ≤ n • unit := hn + apply ne_top_of_le_ne_top _ (w.mono hxle) + rw [map_nsmul, nsmul_eq_mul] + exact ENNReal.mul_ne_top (by simp) hw + +/-- A weight that's finite everywhere and gives the certain outcome weight exactly `1`: an actual +(normalized) state. -/ +structure IsState (w : Weight E) : Prop where + /-- A state is finite everywhere. -/ + finite : w.IsFinite + /-- A state gives the certain outcome weight exactly `1`. -/ + normalized : w unit = 1 + +/-- Mixing two states with coefficients summing to `1` gives another state: the mixture stays +finite (a nonnegative combination of finite weights is finite) and stays normalized (the +coefficients summing to `1` exactly cancels the normalization of each). -/ +lemma IsState.mix {w₁ w₂ : Weight E} (hw₁ : w₁.IsState) (hw₂ : w₂.IsState) {a b : ℝ≥0} + (hab : a + b = 1) : (Weight.mix w₁ w₂ a b).IsState where + finite x := by + show a • w₁ x + b • w₂ x ≠ ⊤ + simp [ENNReal.smul_def, ENNReal.mul_eq_top, hw₁.finite x, hw₂.finite x] + normalized := by + show a • w₁ unit + b • w₂ unit = 1 + rw [hw₁.normalized, hw₂.normalized] + simp [ENNReal.smul_def, ← ENNReal.coe_add, hab] + +/-! ## E. Normalization -/ + +/-- Normalize a weight by its mass at the order unit. The construction is meaningful as a state +when that mass is finite and nonzero; keeping those hypotheses out of the definition makes the +underlying scaling operation available independently. -/ +noncomputable def normalize (w : Weight E) : Weight E := (w unit).toNNReal⁻¹ • w + +@[simp] +lemma normalize_apply (w : Weight E) (x : PosCone E) : + normalize w x = (w unit).toNNReal⁻¹ • w x := rfl + +/-- A finite weight with nonzero mass normalizes to a state weight. -/ +lemma IsFinite.normalize_isState {w : Weight E} (hw : w.IsFinite) (hmass : w unit ≠ 0) : + (normalize w).IsState where + finite x := by + simp only [normalize_apply, ENNReal.smul_def] + exact ENNReal.mul_ne_top (by simp) (hw x) + normalized := by + rw [normalize_apply, ENNReal.smul_def] + have hnn : (w unit).toNNReal ≠ 0 := + ENNReal.toNNReal_ne_zero.mpr ⟨hmass, hw unit⟩ + rw [ENNReal.coe_inv hnn, ENNReal.coe_toNNReal (hw unit)] + simpa only [smul_eq_mul] using ENNReal.inv_mul_cancel hmass (hw unit) + +end Weight diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/Weight/Continuous.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Weight/Continuous.lean new file mode 100644 index 0000000000..0396465cb8 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Weight/Continuous.lean @@ -0,0 +1,75 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Weight.Extension +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Norm +public import Mathlib.Analysis.Normed.Operator.ContinuousLinearMap + +/-! + +# Continuous dual realization of finite weights + +Positive functionals are automatically bounded for the order-unit norm. Combining this fact +with the unique extension of a finite weight realizes every finite weight as a continuous linear +functional on `WithOrderUnitNorm E`. + +-/ + +@[expose] public section + +open IsArchimedeanOrderUnit + +variable {E : Type*} [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] [Module ℝ E] + [PosSMulMono ℝ E] [One E] [IsArchimedeanOrderUnit E] + +namespace PositiveLinearMap + +/-- A positive functional is order-unit-norm bounded, with bound given by its value at the order +unit. For a normalized positive functional this specializes to the contractive state bound. -/ +lemma abs_apply_le_apply_one_mul_orderUnitNorm (f : E →ₚ[ℝ] ℝ) (x : E) : + |f x| ≤ f 1 * orderUnitNorm x := by + have hb := orderUnitNorm_mem_orderUnitBounds x + have hl := f.monotone' hb.2.1 + have hu := f.monotone' hb.2.2 + have hl' : -(orderUnitNorm x * f 1) ≤ f x := by + change f (-(orderUnitNorm x • (1 : E))) ≤ f x at hl + rw [_root_.map_neg, map_smul, smul_eq_mul] at hl + exact hl + have hu' : f x ≤ orderUnitNorm x * f 1 := by + change f x ≤ f (orderUnitNorm x • (1 : E)) at hu + rw [map_smul, smul_eq_mul] at hu + exact hu + rw [mul_comm] + exact abs_le.mpr ⟨hl', hu'⟩ + +/-- A positive functional as a continuous functional on the canonical order-unit-norm copy. -/ +noncomputable def toOrderUnitContinuousLinearMap (f : E →ₚ[ℝ] ℝ) : + WithOrderUnitNorm E →L[ℝ] ℝ := + f.toLinearMap.mkContinuous (f 1) fun x => by + rw [Real.norm_eq_abs, WithOrderUnitNorm.norm_eq_orderUnitNorm] + exact f.abs_apply_le_apply_one_mul_orderUnitNorm x + +@[simp] +lemma toOrderUnitContinuousLinearMap_apply (f : E →ₚ[ℝ] ℝ) (x : E) : + f.toOrderUnitContinuousLinearMap x = f x := rfl + +end PositiveLinearMap + +namespace Weight.IsFinite + +/-- The canonical continuous linear extension of a finite weight to the order-unit-norm copy. -/ +noncomputable def toOrderUnitContinuousLinearMap {w : Weight E} (hw : w.IsFinite) : + WithOrderUnitNorm E →L[ℝ] ℝ := hw.toPositiveLinearMap.toOrderUnitContinuousLinearMap + +@[simp] +lemma toOrderUnitContinuousLinearMap_apply_of_nonneg {w : Weight E} (hw : w.IsFinite) + (x : PosCone E) : + hw.toOrderUnitContinuousLinearMap (x : E) = (w x).toReal := by + rw [toOrderUnitContinuousLinearMap, PositiveLinearMap.toOrderUnitContinuousLinearMap_apply, + toPositiveLinearMap_apply_of_nonneg] + +end Weight.IsFinite diff --git a/PhyslibAlpha/AlgebraicFramework/OrderUnit/Weight/Extension.lean b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Weight/Extension.lean new file mode 100644 index 0000000000..ddffe8cd32 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/OrderUnit/Weight/Extension.lean @@ -0,0 +1,217 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Weight.Basic +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Channel.Basic +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Norm +public import Mathlib.Tactic.Module +public import Mathlib.Analysis.Normed.Operator.ContinuousLinearMap + +/-! + +# Extending finite weights + +## i. Overview + +A finite weight on the positive cone of an order-unit space extends uniquely to a positive linear +functional on the whole space. Normalized weights therefore give states as a specialization. + +The extension shifts and undoes: since `1` is an order unit, any `x : E` becomes nonnegative after +adding enough copies of `1` (`exists_real_shift_nonneg` gives `r` with `r • 1 + x ≥ 0`), so define +`toFun x := w (r • 1 + x) - r * w 1` — undo the shift after reading `w` on the cone +and check it's independent of the `r` chosen. + +## ii. Key definitions and results + +- `Weight.IsFinite.toFun` +- `Weight.IsFinite.toLinearMap` +- `Weight.IsFinite.toPositiveLinearMap` + +## iii. Table of contents + +- A. Shifting vectors into the positive cone +- B. Shift independence +- C. The additive extension +- D. The positive linear extension + +-/ + +@[expose] public section + +open scoped ENNReal NNReal + +variable {E : Type*} [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] + [Module ℝ E] [PosSMulMono ℝ E] [One E] [IsOrderUnit E] + +namespace Weight + +/-! ## A. Shifting vectors into the positive cone -/ + +omit [PosSMulMono ℝ E] in +/-- Every element of `E` becomes nonnegative after adding enough copies of the order unit. +Internal to the shift-and-back construction of `toFun` below; not meant to be used directly. -/ +lemma exists_real_shift_nonneg (x : E) : ∃ r : ℝ, 0 ≤ r • (1 : E) + x := by + obtain ⟨n, hn⟩ := IsOrderUnit.exists_nsmul_one_le (-x) + refine ⟨n, ?_⟩ + rw [← Nat.cast_smul_eq_nsmul ℝ n (1 : E)] at hn + rw [← sub_neg_eq_add] + exact sub_nonneg.mpr hn + +omit [One E] [IsOrderUnit E] in +/-- Once a weight is finite on the two cone elements involved, it turns cone addition into real +addition. This, and `toReal_map_nnreal_smul` below, are the only two facts about pushing `w` +through `ENNReal` arithmetic that the rest of this file needs; every additivity or homogeneity +proof below reduces to one of them plus a purely algebraic identity in `E`. -/ +lemma IsFinite.toReal_map_add {w : Weight E} (hw : w.IsFinite) (c d : PosCone E) : + (w (c + d)).toReal = (w c).toReal + (w d).toReal := by + rw [w.map_add, ENNReal.toReal_add (hw c) (hw d)] + +omit [One E] [IsOrderUnit E] in +/-- `w` turns `ℝ≥0`-scaling of the cone into real multiplication, unconditionally (no finiteness +needed: `ENNReal.toReal_mul` holds regardless). -/ +lemma toReal_map_nnreal_smul (w : Weight E) (k : ℝ≥0) (c : PosCone E) : + (w (k • c)).toReal = k * (w c).toReal := by + rw [w.map_smul, ENNReal.smul_def, smul_eq_mul, ENNReal.toReal_mul, ENNReal.coe_toReal] + +variable {w : Weight E} + +namespace IsFinite + +/-! ## B. Shift independence -/ + +/-- `x` shifted into the cone by `r` copies of the order unit, minus the corresponding multiple +of the weight of the order unit. -/ +noncomputable def rawValue (_hw : w.IsFinite) (x : E) (r : ℝ) (h : 0 ≤ r • (1 : E) + x) : ℝ := + (w ⟨r • (1 : E) + x, h⟩).toReal - r * (w Weight.unit).toReal + +lemma rawValue_of_le (hw : w.IsFinite) (x : E) {r s : ℝ} (hr : 0 ≤ r • (1 : E) + x) + (hs : 0 ≤ s • (1 : E) + x) (hrs : r ≤ s) : rawValue hw x s hs = rawValue hw x r hr := by + set t : ℝ≥0 := (s - r).toNNReal with ht_def + have ht : (t : ℝ) = s - r := Real.coe_toNNReal _ (by linarith) + have hcone : (⟨s • (1 : E) + x, hs⟩ : PosCone E) = ⟨r • (1 : E) + x, hr⟩ + t • Weight.unit := by + apply Subtype.ext + show s • (1 : E) + x = (r • (1 : E) + x) + (t : ℝ) • (1 : E) + rw [ht] + module + unfold rawValue + rw [hcone, hw.toReal_map_add, w.toReal_map_nnreal_smul, ht] + ring + +/-- The shifted value of a finite weight does not depend on the chosen shift. -/ +lemma rawValue_indep (hw : w.IsFinite) (x : E) {r s : ℝ} (hr : 0 ≤ r • (1 : E) + x) + (hs : 0 ≤ s • (1 : E) + x) : rawValue hw x r hr = rawValue hw x s hs := by + rcases le_total r s with hrs | hrs + · exact (rawValue_of_le hw x hr hs hrs).symm + · exact rawValue_of_le hw x hs hr hrs + +open Classical in +/-- The linear extension of a finite weight from the positive cone to all of `E`. -/ +noncomputable def toFun (hw : w.IsFinite) (x : E) : ℝ := + rawValue hw x (exists_real_shift_nonneg x).choose (exists_real_shift_nonneg x).choose_spec + +lemma toFun_eq (hw : w.IsFinite) (x : E) {r : ℝ} (h : 0 ≤ r • (1 : E) + x) : + toFun hw x = rawValue hw x r h := + rawValue_indep hw x _ h + +/-! ## C. The additive extension -/ + +@[simp] +lemma toFun_of_nonneg (hw : w.IsFinite) (x : PosCone E) : toFun hw (x : E) = (w x).toReal := by + have h0 : (0 : E) ≤ (0 : ℝ) • (1 : E) + (x : E) := by simpa using x.2 + rw [toFun_eq hw (x : E) h0, rawValue] + simp + +lemma toFun_zero (hw : w.IsFinite) : toFun hw (0 : E) = 0 := by + have h := toFun_of_nonneg hw (0 : PosCone E) + simpa using h + +lemma toFun_add (hw : w.IsFinite) (x y : E) : toFun hw (x + y) = toFun hw x + toFun hw y := by + obtain ⟨r, hr⟩ := exists_real_shift_nonneg x + obtain ⟨s, hs⟩ := exists_real_shift_nonneg y + have hrs : (0 : E) ≤ (r + s) • (1 : E) + (x + y) := by + have heq : (r + s) • (1 : E) + (x + y) = (r • (1 : E) + x) + (s • (1 : E) + y) := by module + rw [heq]; exact add_nonneg hr hs + rw [toFun_eq hw x hr, toFun_eq hw y hs, toFun_eq hw (x + y) hrs] + have hcone : (⟨(r + s) • (1 : E) + (x + y), hrs⟩ : PosCone E) = + ⟨r • (1 : E) + x, hr⟩ + ⟨s • (1 : E) + y, hs⟩ := by + apply Subtype.ext + show (r + s) • (1 : E) + (x + y) = (r • (1 : E) + x) + (s • (1 : E) + y) + module + unfold rawValue + rw [hcone, hw.toReal_map_add] + ring + +lemma toFun_neg (hw : w.IsFinite) (x : E) : toFun hw (-x) = -toFun hw x := by + have h := toFun_add hw x (-x) + rw [add_neg_cancel, toFun_zero] at h + linarith + +/-- Nonnegative real homogeneity of the finite-weight extension. -/ +lemma toFun_real_nonneg_smul (hw : w.IsFinite) {t : ℝ} (ht : 0 ≤ t) (x : E) : + toFun hw (t • x) = t * toFun hw x := by + obtain ⟨r, hr⟩ := exists_real_shift_nonneg x + have hcr : (0 : E) ≤ (t * r) • (1 : E) + t • x := by + have heq : (t * r) • (1 : E) + t • x = t • (r • (1 : E) + x) := by module + rw [heq]; exact smul_nonneg ht hr + rw [toFun_eq hw x hr, toFun_eq hw (t • x) hcr] + have hcone : (⟨(t * r) • (1 : E) + t • x, hcr⟩ : PosCone E) = + t.toNNReal • (⟨r • (1 : E) + x, hr⟩ : PosCone E) := by + apply Subtype.ext + show (t * r) • (1 : E) + t • x = (t.toNNReal : ℝ) • (r • (1 : E) + x) + rw [Real.coe_toNNReal t ht] + module + unfold rawValue + rw [hcone, w.toReal_map_nnreal_smul, Real.coe_toNNReal t ht] + ring + +/-- Full real homogeneity of the finite-weight extension. -/ +lemma toFun_smul (hw : w.IsFinite) (t : ℝ) (x : E) : toFun hw (t • x) = t * toFun hw x := by + rcases le_total (0 : ℝ) t with ht | ht + · exact toFun_real_nonneg_smul hw ht x + · have h1 : t • x = -((-t) • x) := by rw [neg_smul, neg_neg] + rw [h1, toFun_neg, toFun_real_nonneg_smul hw (neg_nonneg.mpr ht) x] + ring + +/-! ## D. The positive linear extension -/ + +/-- The `ℝ`-linear map extending a finite weight. -/ +noncomputable def toLinearMap (hw : w.IsFinite) : E →ₗ[ℝ] ℝ where + toFun := toFun hw + map_add' := toFun_add hw + map_smul' := toFun_smul hw + +@[simp] +lemma toLinearMap_apply (hw : w.IsFinite) (x : E) : toLinearMap hw x = toFun hw x := rfl + +/-- The positive linear functional extending a finite weight. -/ +noncomputable def toPositiveLinearMap (hw : w.IsFinite) : E →ₚ[ℝ] ℝ := + PositiveLinearMap.mk₀ (toLinearMap hw) fun x hx => by + rw [toLinearMap_apply, toFun_of_nonneg hw ⟨x, hx⟩] + exact ENNReal.toReal_nonneg + +@[simp] +lemma toPositiveLinearMap_apply_of_nonneg (hw : w.IsFinite) (x : PosCone E) : + hw.toPositiveLinearMap (x : E) = (w x).toReal := + hw.toFun_of_nonneg x + +/-- The positive linear extension of a finite weight is unique: any positive linear functional +agreeing with the weight on the positive cone agrees with its extension on all of `E`. -/ +lemma toPositiveLinearMap_unique (hw : w.IsFinite) (f : E →ₚ[ℝ] ℝ) + (h : ∀ x : PosCone E, f (x : E) = (w x).toReal) : + f = hw.toPositiveLinearMap := by + refine PositiveLinearMap.ext fun x => ?_ + obtain ⟨xp, xn, hxp, hxn, hx⟩ := IsOrderUnit.exists_eq_sub_nonneg x + rw [hx, map_sub, map_sub] + have hp : f xp = hw.toPositiveLinearMap xp := + (h ⟨xp, hxp⟩).trans (hw.toPositiveLinearMap_apply_of_nonneg ⟨xp, hxp⟩).symm + have hn : f xn = hw.toPositiveLinearMap xn := + (h ⟨xn, hxn⟩).trans (hw.toPositiveLinearMap_apply_of_nonneg ⟨xn, hxn⟩).symm + rw [hp, hn] + +end IsFinite + +end Weight diff --git a/PhyslibAlpha/AlgebraicFramework/Representation/Covariance/Basic.lean b/PhyslibAlpha/AlgebraicFramework/Representation/Covariance/Basic.lean new file mode 100644 index 0000000000..52327c7c19 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/Representation/Covariance/Basic.lean @@ -0,0 +1,139 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Symmetry +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Effect.EffectValuedMeasure +public import Mathlib.Algebra.Group.Pointwise.Set.Basic +public import Mathlib.MeasureTheory.MeasurableSpace.Basic + +/-! + +# Covariant measurements + +A measurement is *covariant* under a symmetry when transforming the outcome and transforming the +assigned effect agree — a rotated detector, pointed at a rotated direction, reads out the same +statistics a rotation of the original detector would have. This file lays the foundation: a +measurable action of a group on the outcome space, a symmetry's action on effects (extending +`Symmetry`'s existing action on states, `OrderUnit/Symmetry.lean`, to the dual side), and the +covariance predicate on a POVM itself. + +## Main definitions + +- `Symmetry.instSMulEffect` : a symmetry acts on effects through the general + `UnitalPositiveLinearMap.mapEffect` operation. +- `MeasurableAction G Ω` : `G` acts on `Ω` by measurable bijections. +- `EffectValuedMeasure.IsCovariant` : `μ (g • S) = ρ g • μ S`, the abstract form of + `E(gS) = α_g(E(S))`. + +-/ + +@[expose] public section + +open scoped Pointwise + +section EffectAction + +variable {E : Type*} [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] [Module ℝ E] + [PosSMulMono ℝ E] [One E] [IsOrderUnit E] + +/-- A symmetry acts on effects the way it acts on `E` itself, via the underlying channel — the +dual of `Symmetry`'s existing action on states (`OrderUnit/Symmetry.lean`). -/ +instance Symmetry.instSMulEffect : SMul (Symmetry E) (Effect E) := ⟨fun φ e => φ.1.mapEffect e⟩ + +omit [IsOrderedAddMonoid E] [PosSMulMono ℝ E] [IsOrderUnit E] in +@[simp] +lemma Symmetry.coe_smul_effect (φ : Symmetry E) (e : Effect E) : + ((φ • e : Effect E) : E) = φ.1 (e : E) := rfl + +instance Symmetry.instMulActionEffect : MulAction (Symmetry E) (Effect E) where + one_smul e := Subtype.ext (by simp) + mul_smul φ ψ e := Subtype.ext (by simp [UnitalPositiveLinearMap.comp_apply]) + +end EffectAction + +section MeasurableAction + +/-- `G` acts on the measurable space `Ω`, and every group element moves points measurably. Since +this holds for `g` and `g⁻¹` both, the action is by measurable *bijections*: `MeasurableSet.smul` +below shows it moves measurable sets to measurable sets, not merely points. -/ +class MeasurableAction (G Ω : Type*) [Group G] [MeasurableSpace Ω] [MulAction G Ω] : Prop where + /-- Every group element acts as a measurable map. -/ + measurable_smul : ∀ g : G, Measurable (fun x : Ω => g • x) + +variable {G Ω : Type*} [Group G] [MeasurableSpace Ω] [MulAction G Ω] [MeasurableAction G Ω] + +/-- The image of a measurable set under the action of a group element is again measurable: +`g • S` is the preimage of `S` under the (measurable) action of `g⁻¹`. -/ +lemma measurableSet_smul {S : Set Ω} (hS : MeasurableSet S) (g : G) : MeasurableSet (g • S) := by + have heq : g • S = (fun x => g⁻¹ • x) ⁻¹' S := by + ext x + simp only [Set.mem_smul_set, Set.mem_preimage] + constructor + · rintro ⟨s, hs, rfl⟩ + rwa [inv_smul_smul] + · intro hx + exact ⟨g⁻¹ • x, hx, by rw [smul_inv_smul]⟩ + rw [heq] + exact MeasurableSet.preimage hS (MeasurableAction.measurable_smul g⁻¹) + +end MeasurableAction + +section Covariant + +variable {G Ω E : Type*} [Group G] [MeasurableSpace Ω] [MulAction G Ω] [MeasurableAction G Ω] + [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] [Module ℝ E] [PosSMulMono ℝ E] + [One E] [IsOrderUnit E] + +/-- A measurement (POVM) `μ` is **covariant** under an action of `G` on the outcome space, +transported to the physical system via `ρ : G →* Symmetry E`, when transforming the outcome set +and transforming the assigned effect agree: `μ(g • S) = ρ(g) • μ(S)`. This is the abstract form of +`E(gS) = α_g(E(S))` — a rotated detector pointed at a rotated direction reads out what a rotation +of the original detector would have. -/ +def EffectValuedMeasure.IsCovariant (ρ : G →* Symmetry E) (μ : EffectValuedMeasure Ω E) : Prop := + ∀ (g : G) (S : Set Ω) (hS : MeasurableSet S), μ (g • S) (measurableSet_smul hS g) = ρ g • μ S hS + +end Covariant + +/-! ## Covariant channels: the general intertwiner picture + +Not every physical transformation has a measurable outcome space to be covariant "under" the way +a measurement is — a channel `φ : E₁ →ₚ₁[ℝ] E₂` between two systems is covariant simply when +transporting the input and transporting the output agree, with no measurable space in sight: +channels are also intertwiners. This is the general form; a covariant measurement (above) is the +special case where `E₂ = B_b(Ω,Σ)`'s dual role is replaced by `E₁` itself carrying the classical +outcome action. -/ + +section CovariantChannel + +variable {G E₁ E₂ E₃ : Type*} [Group G] + [AddCommGroup E₁] [PartialOrder E₁] [Module ℝ E₁] [One E₁] + [AddCommGroup E₂] [PartialOrder E₂] [Module ℝ E₂] [One E₂] + [AddCommGroup E₃] [PartialOrder E₃] [Module ℝ E₃] [One E₃] + +/-- A channel `φ : E₁ →ₚ₁[ℝ] E₂` is **covariant** under symmetry actions `ρ₁`, `ρ₂` of `G` on the +two systems when transporting the input along `ρ₁ g` then applying `φ`, or applying `φ` then +transporting the output along `ρ₂ g`, agree — the channel intertwines the two actions. -/ +def UnitalPositiveLinearMap.IsCovariant (ρ₁ : G →* Symmetry E₁) (ρ₂ : G →* Symmetry E₂) + (φ : E₁ →ₚ₁[ℝ] E₂) : Prop := + ∀ g : G, φ.comp (ρ₁ g).1 = (ρ₂ g).1.comp φ + +/-- The identity channel is covariant under any action of `G`, against itself: it trivially +intertwines an action with itself. -/ +lemma UnitalPositiveLinearMap.isCovariant_id (ρ : G →* Symmetry E₁) : + (UnitalPositiveLinearMap.id ℝ E₁).IsCovariant ρ ρ := fun g => by + rw [UnitalPositiveLinearMap.id_comp, UnitalPositiveLinearMap.comp_id] + +/-- Covariance is preserved by composition: a covariant channel followed by a covariant channel is +covariant for the actions at the two ends, with the middle system's action cancelling out. -/ +lemma UnitalPositiveLinearMap.IsCovariant.comp {ρ₁ : G →* Symmetry E₁} {ρ₂ : G →* Symmetry E₂} + {ρ₃ : G →* Symmetry E₃} {ψ : E₂ →ₚ₁[ℝ] E₃} {φ : E₁ →ₚ₁[ℝ] E₂} + (hψ : ψ.IsCovariant ρ₂ ρ₃) (hφ : φ.IsCovariant ρ₁ ρ₂) : + (ψ.comp φ).IsCovariant ρ₁ ρ₃ := fun g => by + rw [UnitalPositiveLinearMap.comp_assoc, hφ g, ← UnitalPositiveLinearMap.comp_assoc, hψ g, + UnitalPositiveLinearMap.comp_assoc] + +end CovariantChannel diff --git a/PhyslibAlpha/AlgebraicFramework/Representation/Covariance/Finite.lean b/PhyslibAlpha/AlgebraicFramework/Representation/Covariance/Finite.lean new file mode 100644 index 0000000000..72ab25c515 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/Representation/Covariance/Finite.lean @@ -0,0 +1,177 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.Representation.Covariance.Basic +public import PhyslibAlpha.AlgebraicFramework.Measurement.Postprocessing +public import Mathlib.Algebra.Group.Action.Prod + +/-! + +# Covariance for finite-outcome measurements + +`Covariance.lean` sets up covariance in full measure-theoretic generality: a measurable action of +`G` on an outcome space `Ω`, transported to a physical system via a homomorphism into `Symmetry E`. +For a *finite* outcome type `ι`, this specializes drastically: a group acting on a finite label set +needs no measurability machinery at all, since every subset of a finite type is automatically +"measurable" in the relevant sense — a permutation of a finite set permutes it, full stop. This +file builds the induced symmetry action `G →* Symmetry (ι → ℝ)` on the classical `ι`-outcome system +(`ClassicalSystem.lean`, `FiniteOutcome.lean`), and uses it to specialize two of `Covariance.lean`'s +general structural theorems — covariance preserved under composition, and under postprocessing — +to finite-outcome measurements presented as channels (`Measurement.channelEquiv`). + +The induced action is the standard "functions on a `G`-set" representation: `(σ • f) i = f (σ⁻¹ • +i)`. This is a genuine *left* action — `σ • (τ • f) = (σ * τ) • f` — precisely because of the +inverse: composing `f ↦ f ∘ (σ⁻¹ • ·)` then `f ↦ f ∘ (τ⁻¹ • ·)` composes the permutations as +`(στ)⁻¹ = τ⁻¹σ⁻¹` in the matching order (`inducedAction`'s `map_mul'` spells this out) — using `σ` +without inversion would instead give an *anti*-homomorphism. This matches the standard convention +for the classical system, `(β_g f)(x) = f(g⁻¹x)`. + +Since a finite-outcome measurement `M : (ι → ℝ) →ₚ₁[ℝ] E` is already a channel +(`FiniteOutcome.lean`), its covariance under this induced action, matched to a target symmetry +`ρ : G →* Symmetry E`, is *literally* `Covariance.lean`'s general channel notion, +`M.IsCovariant inducedAction ρ` — no new predicate is needed. The two theorems proved here, +`postprocess_isCovariant` and `marginal_isCovariant`, both fall out of +`UnitalPositiveLinearMap.IsCovariant.comp` plus the fact that postprocessing and marginalizing are +literal channel composition (`Postprocessing.lean`). + +## Main definitions + +- `inducedLinearMap`, `inducedChannel`, `inducedSymmetry`, `inducedAction` : the homomorphism + `G →* Symmetry (ι → ℝ)` induced by a `MulAction G ι` on a finite outcome-label type. +- `Measurement.postprocess_isCovariant` : post-processing by an equivariant classical channel + preserves covariance. +- `Measurement.classicalPullback_isCovariant`, `Measurement.marginal_isCovariant` : marginals of a + covariant joint measurement, for a diagonal product action on the joint outcome type, are + covariant. + +-/ + +@[expose] public section + +section InducedAction + +variable {G ι : Type*} [Group G] [MulAction G ι] + +/-- The linear map on the classical system `ι → ℝ` induced by `σ : G` permuting the outcome label +type `ι`: pulling a function of the outcome back along `σ⁻¹`'s action on `ι`, +`(inducedLinearMap σ f) i = f (σ⁻¹ • i)`. The standard "functions on a `G`-set" representation, +`(β_g f)(x) = f(g⁻¹x)`, built as `LinearMap.funLeft` along the point map `i ↦ σ⁻¹ • i` — the same +building block `Postprocessing.lean`'s `classicalPullback` uses. -/ +def inducedLinearMap (σ : G) : (ι → ℝ) →ₗ[ℝ] (ι → ℝ) := + LinearMap.funLeft ℝ ℝ (fun i => σ⁻¹ • i) + +@[simp] +lemma inducedLinearMap_apply (σ : G) (f : ι → ℝ) (i : ι) : + inducedLinearMap σ f i = f (σ⁻¹ • i) := rfl + +/-- `inducedLinearMap σ` promoted to a channel: positivity is pointwise (permuting nonnegative +coordinates stays nonnegative) and unitality is immediate (the certain event is constant). -/ +def inducedChannel (σ : G) : (ι → ℝ) →ₚ₁[ℝ] (ι → ℝ) := + UnitalPositiveLinearMap.ofLinearMap (inducedLinearMap σ) (fun _x hx i => hx (σ⁻¹ • i)) rfl + +@[simp] +lemma inducedChannel_apply (σ : G) (f : ι → ℝ) (i : ι) : + inducedChannel σ f i = f (σ⁻¹ • i) := rfl + +/-- `inducedChannel σ` is an order-automorphism, with inverse `inducedChannel σ⁻¹`: undoing a +permutation of the outcome labels undoes the induced channel. -/ +lemma isOrderAutomorphism_inducedChannel (σ : G) : + IsOrderAutomorphism (inducedChannel σ : (ι → ℝ) →ₚ₁[ℝ] (ι → ℝ)) := by + refine ⟨inducedChannel σ⁻¹, UnitalPositiveLinearMap.ext fun x => funext fun i => ?_, + UnitalPositiveLinearMap.ext fun x => funext fun i => ?_⟩ + · simp [UnitalPositiveLinearMap.comp_apply, inv_inv, inv_smul_smul] + · simp [UnitalPositiveLinearMap.comp_apply, inv_inv, smul_inv_smul] + +/-- `inducedChannel σ` bundled as a `Symmetry (ι → ℝ)`. -/ +def inducedSymmetry (σ : G) : Symmetry (ι → ℝ) := + ⟨inducedChannel σ, isOrderAutomorphism_inducedChannel σ⟩ + +@[simp] +lemma inducedSymmetry_val (σ : G) : (inducedSymmetry σ : Symmetry (ι → ℝ)).1 = inducedChannel σ := + rfl + +/-- The homomorphism `G →* Symmetry (ι → ℝ)` induced by a `G`-action on an outcome-label type `ι`: +`σ` acts on the classical system by pulling functions back along `σ⁻¹`'s action on the labels. +Group-homomorphism-hood is exactly the check that this is the direction composing as a genuine +*left* action, not its inverse-twisted (anti-homomorphism) variant. -/ +def inducedAction : G →* Symmetry (ι → ℝ) where + toFun := inducedSymmetry + map_one' := Symmetry.ext fun x => funext fun i => by + simp [inducedSymmetry_val, inducedChannel_apply] + map_mul' σ τ := Symmetry.ext fun x => funext fun i => by + simp [inducedSymmetry_val, Symmetry.val_mul, UnitalPositiveLinearMap.comp_apply, + inducedChannel_apply, mul_smul, mul_inv_rev] + +@[simp] +lemma inducedAction_val (σ : G) : + (inducedAction σ : Symmetry (ι → ℝ)).1 = inducedChannel σ := rfl + +end InducedAction + +namespace Measurement + +/-! ## Post-processing by an equivariant classical channel preserves covariance + +A finite-outcome measurement `M : (ι → ℝ) →ₚ₁[ℝ] E` is covariant under a `G`-action on its outcome +labels `ι`, matched to a target symmetry `ρ : G →* Symmetry E`, precisely when +`M.IsCovariant inducedAction ρ` — `Covariance.lean`'s general notion, instantiated with the +induced action from `inducedAction` above. No new predicate is needed: this *is* that notion. -/ + +/-- Post-processing by an equivariant classical channel preserves covariance: if `M` is covariant +and the relabeling channel `K` itself intertwines the induced actions on `κ → ℝ` and `ι → ℝ`, then +postprocessing `M` through `K` is covariant for the `κ`-side action. Postprocessing being literal +channel composition (`Postprocessing.lean`), this falls out of `Covariance.lean`'s +`IsCovariant.comp`. -/ +theorem postprocess_isCovariant + {G ι κ E : Type*} [Group G] + [MulAction G ι] [MulAction G κ] + [AddCommGroup E] [PartialOrder E] [Module ℝ E] [One E] + {ρ : G →* Symmetry E} {M : (ι → ℝ) →ₚ₁[ℝ] E} {K : (κ → ℝ) →ₚ₁[ℝ] (ι → ℝ)} + (hM : M.IsCovariant (inducedAction (G := G) (ι := ι)) ρ) + (hK : K.IsCovariant (inducedAction (G := G) (ι := κ)) (inducedAction (G := G) (ι := ι))) : + (postprocess M K).IsCovariant (inducedAction (G := G) (ι := κ)) ρ := + hM.comp hK + +/-! ## Marginals of a covariant joint measurement are covariant -/ + +/-- A deterministic relabeling `f : κ → ι` that intertwines two `G`-actions induces a classical +channel (`classicalPullback f`) that is itself covariant for the induced actions on `ι → ℝ` and +`κ → ℝ`. The equivariance hypothesis on `f` is the discrete, function-level form of +`Covariance.lean`'s `measurableSet_smul` — here trivial, since every map between finite `G`-sets is +automatically "measurable". -/ +lemma classicalPullback_isCovariant + {G ι κ : Type*} [Group G] + [MulAction G ι] [MulAction G κ] + (f : κ → ι) (hf : ∀ (g : G) (k : κ), f (g • k) = g • f k) : + (classicalPullback f).IsCovariant + (inducedAction (G := G) (ι := ι)) (inducedAction (G := G) (ι := κ)) := by + intro g + apply UnitalPositiveLinearMap.ext + intro x + funext k + simp only [UnitalPositiveLinearMap.comp_apply, inducedAction_val, inducedChannel_apply, + classicalPullback_apply] + rw [hf g⁻¹ k] + +/-- Marginals of a covariant joint measurement are covariant: if `J : (ι × κ → ℝ) →ₚ₁[ℝ] E` is +covariant for the diagonal product action of `G` on `ι × κ` (acting on both factors +simultaneously), then its marginal onto `ι`, +`postprocess J (classicalPullback Prod.fst)` (`Compatibility.lean`'s marginalization), is +covariant for the induced action on `ι` alone. This specializes `postprocess_isCovariant` to the +classical channel `classicalPullback Prod.fst`, using that `Prod.fst` intertwines the diagonal +action on `ι × κ` with the action on `ι` (`Prod.smul_fst`). -/ +theorem marginal_isCovariant + {G ι κ E : Type*} [Group G] + [MulAction G ι] [MulAction G κ] + [AddCommGroup E] [PartialOrder E] [Module ℝ E] [One E] + {ρ : G →* Symmetry E} {J : (ι × κ → ℝ) →ₚ₁[ℝ] E} + (hJ : J.IsCovariant (inducedAction (G := G) (ι := ι × κ)) ρ) : + (postprocess J (classicalPullback Prod.fst)).IsCovariant + (inducedAction (G := G) (ι := ι)) ρ := + hJ.comp (classicalPullback_isCovariant Prod.fst (fun g p => by simp)) + +end Measurement diff --git a/PhyslibAlpha/AlgebraicFramework/Representation/PVM.lean b/PhyslibAlpha/AlgebraicFramework/Representation/PVM.lean new file mode 100644 index 0000000000..76424d1212 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/Representation/PVM.lean @@ -0,0 +1,100 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Effect.EffectValuedMeasure +public import PhyslibAlpha.AlgebraicFramework.CStarAlgebra.SharpEffect + +/-! + +# POVMs and PVMs + +`EffectValuedMeasure Ω E` already *is* a positive-operator-valued measure, once `E` is the +self-adjoint part of an operator algebra: `POVM` is just the physics-literature name for it, kept +here for discoverability. + +A projection-valued measure is a POVM every one of whose effects is sharp (`Effect.IsSharp`): +the general (order-unit) notion of a projection. Both endpoints `∅` and the whole space are +automatically sharp for *every* POVM, since the impossible and certain effects `0` and `1` are +always sharp (`Effect.isSharp_zero`, `Effect.isSharp_one`) — `IsPVM` only has bite on the +measurable sets strictly between them. + +A genuine operator-algebraic projection-valued measure — every assigned effect an idempotent +self-adjoint operator — is a `PVM` in this abstract sense (`POVM.isPVM_of_forall_isIdempotentElem`), +via `IsIdempotentElem.isSharp`: this is the payoff of building the general framework on top of the +self-adjoint part of a C⋆-algebra (`StarAlgebra/OrderUnit.lean`). + +## Main definitions + +- `POVM` +- `POVM.IsPVM` +- `PVM` +- `POVM.isPVM_of_forall_isIdempotentElem` + +-/ + +@[expose] public section + +/-- A positive-operator-valued measure: the physics name for `EffectValuedMeasure`. -/ +abbrev POVM (Ω E : Type*) [MeasurableSpace Ω] [AddCommGroup E] [PartialOrder E] + [IsOrderedAddMonoid E] [One E] [IsOrderUnit E] := EffectValuedMeasure Ω E + +variable {Ω E : Type*} [MeasurableSpace Ω] [AddCommGroup E] [PartialOrder E] + [IsOrderedAddMonoid E] [Module ℝ E] [PosSMulMono ℝ E] [One E] [IsOrderUnit E] + +namespace POVM + +/-- A POVM is a PVM (projection-valued measure) when every effect it assigns is sharp. -/ +def IsPVM (μ : POVM Ω E) : Prop := ∀ s hs, Effect.IsSharp (μ s hs) + +/-- The impossible event is always sharp, in any POVM: it is assigned the effect `0`. -/ +lemma isSharp_apply_empty (μ : POVM Ω E) : Effect.IsSharp (μ ∅ MeasurableSet.empty) := + μ.map_empty ▸ Effect.isSharp_zero + +/-- The certain event is always sharp, in any POVM: it is assigned the effect `1`. -/ +lemma isSharp_apply_univ (μ : POVM Ω E) : Effect.IsSharp (μ Set.univ MeasurableSet.univ) := + μ.map_univ ▸ Effect.isSharp_one + +end POVM + +section CStarAlgebra + +variable {A : Type*} [CStarAlgebra A] [PartialOrder A] [StarOrderedRing A] + +/-- A POVM valued in the self-adjoint part of a C⋆-algebra, all of whose effects are genuine +(idempotent) projections, is a PVM: `IsIdempotentElem.isSharp` upgrades an operator-theoretic +projection to the abstract, order-unit-level notion of sharpness. -/ +theorem POVM.isPVM_of_forall_isIdempotentElem {Ω : Type*} [MeasurableSpace Ω] + {μ : POVM Ω (selfAdjoint A)} + (h : ∀ s hs, IsIdempotentElem (((μ s hs : Effect (selfAdjoint A)) : selfAdjoint A) : A)) : + μ.IsPVM := + fun s hs => (h s hs).isSharp + +end CStarAlgebra + +/-- A projection-valued measure: a POVM every one of whose effects is a genuine projection +(sharp effect). -/ +def PVM (Ω E : Type*) [MeasurableSpace Ω] [AddCommGroup E] [PartialOrder E] + [IsOrderedAddMonoid E] [Module ℝ E] [One E] [IsOrderUnit E] := + {μ : POVM Ω E // μ.IsPVM} + +namespace PVM + +/-- A PVM, viewed as a POVM, forgetting the sharpness of its effects. -/ +instance : CoeOut (PVM Ω E) (POVM Ω E) := ⟨Subtype.val⟩ + +omit [PosSMulMono ℝ E] in +@[ext] +lemma ext {π ρ : PVM Ω E} (h : ∀ s hs, (π : POVM Ω E) s hs = (ρ : POVM Ω E) s hs) : π = ρ := + Subtype.ext (EffectValuedMeasure.ext h) + +omit [PosSMulMono ℝ E] in +/-- Every effect of a PVM is sharp: unfolding what it means to be one. -/ +lemma isSharp_apply (π : PVM Ω E) (s : Set Ω) (hs : MeasurableSet s) : + Effect.IsSharp ((π : POVM Ω E) s hs) := + π.2 s hs + +end PVM diff --git a/PhyslibAlpha/AlgebraicFramework/Representation/Schur.lean b/PhyslibAlpha/AlgebraicFramework/Representation/Schur.lean new file mode 100644 index 0000000000..024f643943 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/Representation/Schur.lean @@ -0,0 +1,147 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.Representation.Covariance.Basic +public import Mathlib.Algebra.DirectSum.Module + +/-! + +# Schur's lemma and multiplicity-free covariant channels + +There is a recurring pattern in representation theory: once a `G`-invariant object (a +representation space, an operator space, a channel's domain) is decomposed into blocks +$E = \bigoplus_i W_i$ that are individually `G`-invariant and "Schur" (no non-scalar `G`-equivariant +self-map), *every* `G`-equivariant endomorphism of the whole space is pinned down block-by-block to +a single real scalar per block — instead of classifying arbitrary linear maps on a +high-dimensional space, one classifies a handful of numbers. For the qubit, this is exactly why +a rotationally covariant channel on the Hermitian $2\times2$ matrices reduces from "an arbitrary +linear self-map of a four-real-dimensional space" to "one real number $\lambda$": the space splits +as the scalar sector (spin $0$) plus the Pauli-vector sector (spin $1$), each Schur. + +This file formalizes the reusable core of that argument, deliberately *not* mathlib's +representation-theoretic Schur's lemma (see the note below on why): a bare `Prop`-valued Schur +hypothesis on a submodule, and the classification theorem for a finite direct sum of Schur blocks. + +## Why not mathlib's `Representation`/`FDRep` Schur's lemma + +`Mathlib.RepresentationTheory.Irreducible` has +`Representation.IsIrreducible.algebraMap_intertwiningMap_bijective_of_isAlgClosed`, the sharpest +form of Schur's lemma mathlib has (the endomorphism ring of an irreducible representation is +exactly the base field), and `Mathlib.CategoryTheory.Preadditive.Schur` / +`Mathlib.RepresentationTheory.FDRep` have the abstract Krull–Schmidt-flavoured Hom-space version. +Both require the base field to be algebraically closed (`IsAlgClosed k`) — true for `ℂ`, false for +`ℝ`. Over `ℝ` this hypothesis genuinely fails in general (a real irreducible representation can +have endomorphism ring `ℝ`, `ℂ`, or the quaternions `ℍ`, e.g. the standard real representation of +the circle group on `ℝ²` is irreducible with endomorphism ring `ℂ`, not `ℝ` — rotation-by-90° is a +non-scalar equivariant endomorphism). The qubit's Pauli-vector sector genuinely is a "real type" +representation (endomorphism ring `ℝ`), but this is *extra* representation-theoretic input beyond +generic Schur, not something `IsAlgClosed`-Schur gives for free over `ℝ`. Moreover this codebase's +`E`/`Symmetry E` (`OrderUnit/Symmetry.lean`) is a bare order-unit module with a group of +order-automorphisms, not mathlib's `Representation k G V` structure (a genuine `k[G]`-module) — +bridging the two would cost more than it buys. So the Schur hypothesis below is taken as an +explicit, minimal `Prop` on a `Submodule`, to be discharged per-block by whatever means are +available (cited from elsewhere or proved directly), rather than derived from a general +representation-theoretic classification result. + +## Main definitions + +- `IsSchurBlock smul W` : the Schur hypothesis for a submodule `W`, relative to an action + `smul : G → E → E` — every linear self-map of `E` that is equivariant on `W` and preserves `W` + acts as a single scalar on all of `W`. + +## Main results + +- `exists_scalar_of_isSchurBlock` : the multiplicity-free classification theorem — given a finite + family of Schur blocks decomposing `E` as an internal direct sum, each individually `G`-invariant, + every `G`-equivariant linear endomorphism of `E` that preserves every block acts on each block `W + i` as `c i • id` for some real scalar `c i`. +- `UnitalPositiveLinearMap.IsCovariant.exists_scalar_of_isSchurBlock` : the same theorem phrased for + a covariant channel `φ : E →ₚ₁[ℝ] E` (`Measurement/Covariance.lean`), the form that plugs directly + into this codebase's existing covariance notion. + +-/ + +@[expose] public section + +/-! ## The Schur hypothesis on a single block -/ + +section IsSchurBlock + +variable {G E : Type*} [AddCommGroup E] [Module ℝ E] + +/-- The **Schur hypothesis** for a submodule `W`, relative to an action `smul : G → E → E`: every +linear endomorphism of `E` that is `G`-equivariant on `W` (`f (smul g x) = smul g (f x)` for +`x ∈ W`) and maps `W` into itself acts on all of `W` as a single scalar `c`. This is the abstract +shape of "every `G`-equivariant self-map of an irreducible real representation is a scalar" — taken +here as a hypothesis to be supplied per block (cited or proved separately), not derived from a +general representation-theoretic classification (see the file docstring). -/ +def IsSchurBlock (smul : G → E → E) (W : Submodule ℝ E) : Prop := + ∀ f : E →ₗ[ℝ] E, (∀ g : G, ∀ x ∈ W, f (smul g x) = smul g (f x)) → + (∀ x ∈ W, f x ∈ W) → ∃ c : ℝ, ∀ x ∈ W, f x = c • x + +end IsSchurBlock + +/-! ## The multiplicity-free classification theorem -/ + +section MultiplicityFree + +variable {G E ι : Type*} [AddCommGroup E] [Module ℝ E] [DecidableEq ι] [Fintype ι] + +omit [Fintype ι] in +/-- **Multiplicity-free classification of covariant endomorphisms.** Suppose `E` decomposes as an +internal direct sum `E = ⨁ i, W i` (`hsum`) of finitely many submodules, each `G`-invariant +(`hW_inv`) and each satisfying the Schur hypothesis (`hSchur`). Then every `G`-equivariant linear +endomorphism `f` of `E` that preserves each block (`hf_block` — automatic when the blocks are +pairwise non-isomorphic as `G`-representations, e.g. the qubit's spin-$0$/spin-$1$ split, but not +derivable from the single-block Schur hypothesis alone, so it is taken as a hypothesis here; see the +file docstring) acts on each block `W i` as `c i • id` for some real scalar `c i` — the whole +endomorphism is pinned down by finitely many real numbers, one per block. + +The direct-sum and block-invariance hypotheses (`hsum`, `hW_inv`) record the intended setting — a +genuine decomposition of `E` into `G`-subrepresentations — even though the conclusion, stated only +on each block separately, does not need to unfold them further than `hf_block` already supplies. -/ +theorem exists_scalar_of_isSchurBlock (smul : G → E → E) (W : ι → Submodule ℝ E) + (_hsum : DirectSum.IsInternal W) (_hW_inv : ∀ i g, ∀ x ∈ W i, smul g x ∈ W i) + (hSchur : ∀ i, IsSchurBlock smul (W i)) (f : E →ₗ[ℝ] E) + (hf_equiv : ∀ g x, f (smul g x) = smul g (f x)) (hf_block : ∀ i, ∀ x ∈ W i, f x ∈ W i) : + ∃ c : ι → ℝ, ∀ i, ∀ x ∈ W i, f x = c i • x := by + choose c hc using fun i => hSchur i f (fun g x _ => hf_equiv g x) (hf_block i) + exact ⟨c, hc⟩ + +end MultiplicityFree + +/-! ## Connecting to covariant channels + +`Measurement/Covariance.lean` phrases covariance for a channel `φ : E →ₚ₁[ℝ] E` intertwining a +symmetry action `ρ : G →* Symmetry E` with itself, via `UnitalPositiveLinearMap.IsCovariant`. The +underlying linear map of such a channel is exactly a `G`-equivariant endomorphism of `E` for the +action `g • x := (ρ g).1 x`, so the classification theorem above applies directly. -/ + +section CovariantChannel + +variable {G E ι : Type*} [Group G] [AddCommGroup E] [PartialOrder E] [Module ℝ E] [One E] + [DecidableEq ι] [Fintype ι] + +omit [Fintype ι] in +/-- The multiplicity-free classification theorem, specialized to a **covariant channel** +`φ : E →ₚ₁[ℝ] E` (`UnitalPositiveLinearMap.IsCovariant`, `Measurement/Covariance.lean`) intertwining +a symmetry action `ρ : G →* Symmetry E` with itself. Given a finite internal direct sum +decomposition of `E` into `G`-invariant Schur blocks that `φ` preserves, `φ` acts on each block +`W i` as multiplication by a single real scalar `c i`. -/ +theorem UnitalPositiveLinearMap.IsCovariant.exists_scalar_of_isSchurBlock + {ρ : G →* Symmetry E} {φ : E →ₚ₁[ℝ] E} (hφ : φ.IsCovariant ρ ρ) (W : ι → Submodule ℝ E) + (hsum : DirectSum.IsInternal W) + (hW_inv : ∀ i g, ∀ x ∈ W i, (ρ g).1 x ∈ W i) + (hSchur : ∀ i, IsSchurBlock (fun g x => (ρ g).1 x) (W i)) + (hφ_block : ∀ i, ∀ x ∈ W i, φ x ∈ W i) : + ∃ c : ι → ℝ, ∀ i, ∀ x ∈ W i, φ x = c i • x := by + refine _root_.exists_scalar_of_isSchurBlock (fun g x => (ρ g).1 x) W hsum hW_inv hSchur + φ.toLinearMap (fun g x => ?_) hφ_block + have := DFunLike.congr_fun (hφ g) x + simpa [UnitalPositiveLinearMap.comp_apply] using this + +end CovariantChannel diff --git a/PhyslibAlpha/AlgebraicFramework/StarAlgebra/Jordan.lean b/PhyslibAlpha/AlgebraicFramework/StarAlgebra/Jordan.lean new file mode 100644 index 0000000000..fcf3f9db7c --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/StarAlgebra/Jordan.lean @@ -0,0 +1,247 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Mathlib.Algebra.Jordan.Basic +public import Mathlib.Tactic.NoncommRing +public import PhyslibAlpha.AlgebraicFramework.StarAlgebra.Observable + +/-! + +# Jordan algebra structure on self-adjoint elements + +Quantum observables live in `selfAdjoint A` for `A` the (typically non-commutative) algebra of +bounded operators, but the raw associative product `a * b` of two self-adjoint elements is +generally not self-adjoint itself — `star (a * b) = b * a`, which equals `a * b` only when `a` +and `b` commute. What survives is the *symmetrized* product +$$ a \circ b := \tfrac12(a * b + b * a), $$ +the normalized anticommutator. It is self-adjoint for any self-adjoint `a`, `b` (commuting or +not), it is +manifestly commutative, and — the substantive fact — it satisfies the Jordan identity, the weak +associativity law that lets one recover much of the algebraic structure of quantum mechanics +(spectral theory, order, the observable ladder in `OVERVIEW.md`) without ever multiplying two +non-commuting observables together. This is the historically earlier (Jordan–von Neumann–Wigner, +1934) route to the same territory that full associative multiplication reaches, and the more +minimal one: it only ever uses the symmetric product. + +Mathlib already has the abstract axioms for this in `Mathlib.Algebra.Jordan.Basic` +(`IsJordan`/`IsCommJordan`, stated for a bare `Mul` satisfying the Jordan axioms). We install the +standard normalized product directly on `selfAdjoint A`; the real-module hypotheses provide the +factor `1/2`. Consequently every stronger realization, including a C⋆-algebra, inherits one and +the same Jordan multiplication instead of rebuilding a second product in a bridge file. + +We do not give `selfAdjoint A` a plain top-level `Mul` instance for this product: when `A` is +commutative, mathlib already equips `selfAdjoint A` with the ordinary product. Instead the full +nonassociative-ring and Jordan structure below is scoped to `selfAdjoint`: `open scoped +selfAdjoint` opts in exactly where the Jordan product is wanted. + +## Main definitions + +- `selfAdjoint.jordanMul` : the normalized product `½(ab + ba)`, landing back in `selfAdjoint A`. +- `selfAdjoint.jordanMul_comm` : the Jordan product is commutative. +- `selfAdjoint.jordanMul_add_left`/`jordanMul_add_right` : the Jordan product distributes over `+`. +- `selfAdjoint.instMul`/`instCommMagma`/`instIsCommJordan` (all `scoped`) : the Jordan product + makes `selfAdjoint A` a commutative Jordan ring in mathlib's sense. +- `Observable.jordanMul` : the same product, spelled for `Observable A := selfAdjoint A`. + +-/ + +@[expose] public section + +namespace selfAdjoint + +variable {A : Type*} [Ring A] [StarRing A] [Module ℝ A] [StarModule ℝ A] + +/-- The unnormalized anticommutator, retained as a low-level formula while `jordanMul` is the +canonical normalized Jordan product. -/ +def anticommutator (a b : selfAdjoint A) : selfAdjoint A := + ⟨(a : A) * (b : A) + (b : A) * (a : A), by + rw [mem_iff, star_add, star_mul, star_mul, star_val_eq, star_val_eq, add_comm]⟩ + +omit [Module ℝ A] [StarModule ℝ A] in +@[simp] +theorem coe_anticommutator (a b : selfAdjoint A) : + ((anticommutator a b : selfAdjoint A) : A) = (a : A) * (b : A) + (b : A) * (a : A) := + rfl + +/-- The normalized Jordan product of two self-adjoint elements, +`a ∘ b := ½(ab + ba)`. It is self-adjoint regardless of whether `a` and `b` commute, since +`star (a * b + b * a) = star b * star a + star a * star b = b * a + a * b`. -/ +noncomputable def jordanMul (a b : selfAdjoint A) : selfAdjoint A := + (2 : ℝ)⁻¹ • anticommutator a b + +@[simp] +theorem val_jordanMul (a b : selfAdjoint A) : + ((jordanMul a b : selfAdjoint A) : A) = + (2 : ℝ)⁻¹ • ((a : A) * (b : A) + (b : A) * (a : A)) := + rfl + +/-- The Jordan product is commutative. -/ +theorem jordanMul_comm (a b : selfAdjoint A) : jordanMul a b = jordanMul b a := + Subtype.ext <| by simp only [val_jordanMul, add_comm] + +/-- The unit of the ambient algebra is a unit for the normalized Jordan product. -/ +@[simp] +theorem one_jordanMul (a : selfAdjoint A) : jordanMul 1 a = a := by + apply Subtype.ext + change (2 : ℝ)⁻¹ • ((1 : A) * (a : A) + (a : A) * (1 : A)) = (a : A) + rw [_root_.one_mul, _root_.mul_one, ← two_smul ℝ (a : A), smul_smul, + inv_mul_cancel₀ (two_ne_zero), one_smul] + +/-- The normalized Jordan product has the same unit in its right argument. -/ +@[simp] +theorem jordanMul_one (a : selfAdjoint A) : jordanMul a 1 = a := by + rw [jordanMul_comm, one_jordanMul] + +/-- The Jordan product distributes over addition in its right argument. -/ +theorem jordanMul_add_right (a b c : selfAdjoint A) : + jordanMul a (b + c) = jordanMul a b + jordanMul a c := by + apply Subtype.ext + simp only [val_jordanMul, AddSubgroup.coe_add, mul_add, add_mul, smul_add] + module + +/-- The Jordan product distributes over addition in its left argument. -/ +theorem jordanMul_add_left (a b c : selfAdjoint A) : + jordanMul (a + b) c = jordanMul a c + jordanMul b c := by + rw [jordanMul_comm (a + b) c, jordanMul_comm a c, jordanMul_comm b c] + exact jordanMul_add_right c a b + +private theorem anticommutator_smul_left [SMulCommClass ℝ A A] [IsScalarTower ℝ A A] + (c : ℝ) (a b : selfAdjoint A) : + anticommutator (c • a) b = c • anticommutator a b := by + apply Subtype.ext + simp only [coe_anticommutator, val_smul, mul_smul_comm, smul_mul_assoc, smul_add] + +private theorem anticommutator_smul_right [SMulCommClass ℝ A A] [IsScalarTower ℝ A A] + (a : selfAdjoint A) (c : ℝ) (b : selfAdjoint A) : + anticommutator a (c • b) = c • anticommutator a b := by + apply Subtype.ext + simp only [coe_anticommutator, val_smul, mul_smul_comm, smul_mul_assoc, smul_add] + +omit [Module ℝ A] [StarModule ℝ A] in +private theorem anticommutator_identity (a b : selfAdjoint A) : + anticommutator (anticommutator a b) (anticommutator a a) = + anticommutator a (anticommutator b (anticommutator a a)) := by + apply Subtype.ext + simp only [coe_anticommutator] + noncomm_ring + +/-- The Jordan identity: `∘`-multiplication by `a` and by `a ∘ a` commute, i.e. +`(a ∘ b) ∘ (a ∘ a) = a ∘ (b ∘ (a ∘ a))`. This is the "weak associativity" law that survives +symmetrization of a possibly non-commutative, associative product. -/ +theorem jordanMul_jordanMul_jordanMul_self [SMulCommClass ℝ A A] [IsScalarTower ℝ A A] + (a b : selfAdjoint A) : + jordanMul (jordanMul a b) (jordanMul a a) = jordanMul a (jordanMul b (jordanMul a a)) := by + simp only [jordanMul, anticommutator_smul_left, anticommutator_smul_right, smul_smul] + congr 1 + exact anticommutator_identity a b + +/-- The normalized Jordan product on `selfAdjoint A`, scoped to avoid clashing with the ordinary +product instance mathlib provides when `A` is commutative. -/ +noncomputable scoped instance instMul : Mul (selfAdjoint A) := ⟨jordanMul⟩ + +@[simp] +theorem mul_def (a b : selfAdjoint A) : a * b = jordanMul a b := rfl + +/-- Coercing the canonical Jordan product back to the ambient algebra gives the normalized +anticommutator. -/ +theorem coe_mul (a b : selfAdjoint A) : + ((a * b : selfAdjoint A) : A) = + (2 : ℝ)⁻¹ • ((a : A) * (b : A) + (b : A) * (a : A)) := + val_jordanMul a b + +/-- Real scalars pull out of the left argument of the normalized Jordan product. -/ +theorem jordanMul_smul_left [SMulCommClass ℝ A A] [IsScalarTower ℝ A A] + (c : ℝ) (a b : selfAdjoint A) : jordanMul (c • a) b = c • jordanMul a b := by + apply Subtype.ext + simp only [val_jordanMul, val_smul, mul_smul_comm, smul_mul_assoc, smul_add, smul_smul] + module + +/-- Real scalars pull out of the right argument of the normalized Jordan product. -/ +theorem jordanMul_smul_right [SMulCommClass ℝ A A] [IsScalarTower ℝ A A] + (a : selfAdjoint A) (c : ℝ) (b : selfAdjoint A) : + jordanMul a (c • b) = c • jordanMul a b := by + rw [jordanMul_comm, jordanMul_smul_left, jordanMul_comm] + +/-- Expanding one right-nested Jordan product produces a common factor `1 / 4` and a nested +unnormalized anticommutator. This is useful for associative calculations in concrete +realizations while keeping the normalized Jordan product canonical. -/ +theorem jordanMul_jordanMul_right [SMulCommClass ℝ A A] [IsScalarTower ℝ A A] + (a b x : selfAdjoint A) : + jordanMul a (jordanMul b x) = + ((2 : ℝ)⁻¹ * (2 : ℝ)⁻¹) • anticommutator a (anticommutator b x) := by + simp only [jordanMul, anticommutator_smul_right, smul_smul] + +section AlgebraStructure + +variable [SMulCommClass ℝ A A] [IsScalarTower ℝ A A] + +omit [SMulCommClass ℝ A A] [IsScalarTower ℝ A A] in +theorem jordanMul_zero (a : selfAdjoint A) : jordanMul a 0 = 0 := by + apply Subtype.ext + simp [val_jordanMul] + +/-- The normalized product gives the self-adjoint part its canonical commutative, +nonassociative ring structure. -/ +noncomputable scoped instance instNonUnitalNonAssocCommRing : + NonUnitalNonAssocCommRing (selfAdjoint A) where + __ := (inferInstance : AddCommGroup (selfAdjoint A)) + mul := jordanMul + left_distrib := jordanMul_add_right + right_distrib := jordanMul_add_left + zero_mul a := (jordanMul_comm 0 a).trans (jordanMul_zero a) + mul_zero := jordanMul_zero + mul_comm := jordanMul_comm + +/-- The canonical Jordan product is unital with the inherited self-adjoint unit. Bundling this as +`NonAssocCommRing` prevents stronger layers from carrying an unrelated `One` plus duplicated unit +laws. -/ +noncomputable scoped instance instNonAssocRing : NonAssocRing (selfAdjoint A) := + NonAssocRing.mk (toNatCast := ⟨fun n => n • (1 : selfAdjoint A)⟩) + (toIntCast := ⟨fun z => z • (1 : selfAdjoint A)⟩) + one_jordanMul jordanMul_one + (natCast_zero := by simp) + (natCast_succ := by intro n; simp [add_nsmul]) + (intCast_ofNat := by + intro n + change (n : ℤ) • (1 : selfAdjoint A) = n • (1 : selfAdjoint A) + simp) + (intCast_negSucc := by + intro n + change (Int.negSucc n) • (1 : selfAdjoint A) = -((n + 1) • (1 : selfAdjoint A)) + simp) + +/-- The coherent unital commutative nonassociative ring structure on the self-adjoint part. -/ +noncomputable scoped instance instNonAssocCommRing : NonAssocCommRing (selfAdjoint A) where + __ := instNonAssocRing + mul_comm := jordanMul_comm + +/-- Real scalar multiplication commutes with Jordan multiplication. -/ +scoped instance instSMulCommClass : SMulCommClass ℝ (selfAdjoint A) (selfAdjoint A) where + smul_comm c a b := (jordanMul_smul_right a c b).symm + +/-- Real scalar multiplication is a tower over Jordan multiplication. -/ +scoped instance instIsScalarTower : IsScalarTower ℝ (selfAdjoint A) (selfAdjoint A) where + smul_assoc c a b := jordanMul_smul_left c a b + +/-- The Jordan product makes `selfAdjoint A` a commutative Jordan ring, in the sense of mathlib's +`IsCommJordan`: this is the connection from the abstract axioms in `Mathlib.Algebra.Jordan.Basic` +to the self-adjoint elements of an associative `StarRing`. -/ +scoped instance instIsCommJordan : IsCommJordan (selfAdjoint A) where + lmul_comm_rmul_rmul := jordanMul_jordanMul_jordanMul_self + +end AlgebraStructure + +end selfAdjoint + +/-- The Jordan product is available on `Observable A` with no extra work: since +`Observable A := selfAdjoint A` is an `abbrev`, `selfAdjoint.jordanMul` applies to observables +verbatim, once the ambient `A` also carries the ring and star-ring structure this file assumes +(on top of the bare `AddGroup`/`StarAddMonoid` that `Observable` itself needs). -/ +noncomputable abbrev Observable.jordanMul {A : Type*} [Ring A] [StarRing A] [Module ℝ A] + [StarModule ℝ A] (a b : Observable A) : + Observable A := + selfAdjoint.jordanMul a b diff --git a/PhyslibAlpha/AlgebraicFramework/StarAlgebra/Lie.lean b/PhyslibAlpha/AlgebraicFramework/StarAlgebra/Lie.lean new file mode 100644 index 0000000000..46cb308565 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/StarAlgebra/Lie.lean @@ -0,0 +1,211 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Mathlib.Algebra.Lie.Basic +public import Mathlib.LinearAlgebra.Complex.Module +public import Mathlib.Tactic.NoncommRing +public import PhyslibAlpha.AlgebraicFramework.StarAlgebra.Jordan + +/-! + +# Lie structure on observables + +Dually to the normalized Jordan product `a ∘ b := ½(a * b + b * a)` of +`StarAlgebra/Jordan.lean`, which +symmetrizes the associative product of two self-adjoint elements, the *antisymmetric* part of the +same product is self-adjoint once corrected by a factor of `i`: +$$ \mathrm{star}(ab - ba) = b a - a b = -(ab - ba), $$ +so `ab - ba` is *skew*-adjoint, and multiplying a skew-adjoint element by `i` (or any purely +imaginary scalar) makes it self-adjoint. This gives the observable Lie bracket +$$ ⁅a, b⁆ := -(i / 2) (ab - ba), $$ +the (negative, half of the) imaginary part of `a * b`. Together, the Jordan product and the Lie +bracket are the symmetric and antisymmetric halves of the raw associative product: +`a * b = (a ∘ b) + i ⁅a, b⁆`, as recorded by `mul_decomposition` below. The bracket measures +noncommutativity of the two +observables and, as a real Lie algebra, governs infinitesimal unitary dynamics (Heisenberg's +equation of motion is literally `dȧ/dt = ⁅H, a⁆` for a suitably normalized Hamiltonian `H`). + +## Why these hypotheses (and no more) + +Unlike the Jordan product, the bracket cannot be stated over a bare `[Ring A] [StarRing A]`: it +genuinely needs to *scale* by the complex number `-i/2`, so `A` must at least carry a compatible +action of `ℂ` respecting the star operation, i.e. `[Module ℂ A] [StarModule ℂ A]`. This is far +below the old `OperatorAlgebra A` bundle (a complete, ordered, C⋆-normed algebra): no norm, +completeness, or order enters anywhere in this file. Only `leibniz_bracket` (and the `LieRing` +instance packaging it) and `bracket_smul` (and the `LieAlgebra` instance packaging it) need scalar +multiplication by `ℂ` to interact with the ring product of `A` itself — moving the constant scalar +`-i/2` across a product `a * (c • b) = c • (a * b) = (c • a) * b` — which is exactly the content of +`[SMulCommClass ℂ A A] [IsScalarTower ℂ A A]`. Every other lemma, including the definition of the +bracket itself, needs nothing beyond `[Module ℂ A] [StarModule ℂ A]`, so those two extra instances +are added only on the declarations that use them rather than on the whole file (mirroring this +codebase's `omit [...] in` idiom for the reverse situation, where a lemma needs *less* than the +ambient section: see `isSelfAdjoint_mul_iff_commute` below, which needs no `ℂ`-module structure at +all). + +As in `StarAlgebra/Jordan.lean`, the product-like structure (`Bracket`, `LieRing`, `LieAlgebra`) is +kept `scoped` to the `selfAdjoint` namespace rather than made a global instance, in case mathlib or +downstream code ever registers a competing Lie bracket on `selfAdjoint A` (e.g. via the ordinary +commutator when `A` itself is already a Lie ring). `open scoped selfAdjoint` opts in. + +## Main definitions + +- `selfAdjoint.lieMul` : the Lie bracket `-(i / 2) (ab - ba)`, landing back in `selfAdjoint A`. +- `selfAdjoint.isSelfAdjoint_mul_iff_commute` : `a * b` is self-adjoint iff `a` and `b` commute. +- `selfAdjoint.mul_decomposition` : `a * b` splits into its Jordan and Lie parts. +- `selfAdjoint.instBracket`/`instLieRing`/`instLieAlgebra` (all `scoped`) : `selfAdjoint A` is a + real Lie algebra under `lieMul`. +- `Observable.lieMul` : the same bracket, spelled for `Observable A := selfAdjoint A`. + +-/ + +@[expose] public section + +namespace selfAdjoint + +variable {A : Type*} [Ring A] [StarRing A] [Module ℂ A] [StarModule ℂ A] + +/-! ## The Lie bracket -/ + +/-- The Lie (antisymmetrized) product of two self-adjoint elements: `-(i / 2) (ab - ba)`, the +negative half of the imaginary part of `a * b`. Self-adjoint regardless of whether `a` and `b` +commute: `ab - ba` is skew-adjoint since `star (ab - ba) = star b * star a - star a * star b = +ba - ab = -(ab - ba)`, and scaling a skew-adjoint element by the purely imaginary `-i/2` restores +self-adjointness. -/ +noncomputable def lieMul (a b : selfAdjoint A) : selfAdjoint A := + ⟨(-(Complex.I / 2)) • ((a : A) * b - (b : A) * a), by + rw [mem_iff, star_smul, star_sub, star_mul, star_mul, a.property.star_eq, b.property.star_eq] + have hI : star (-(Complex.I / 2) : ℂ) = Complex.I / 2 := by + simp [Complex.ext_iff] + norm_num + rw [hI] + module⟩ + +@[simp] +theorem val_lieMul (a b : selfAdjoint A) : + ((lieMul a b : selfAdjoint A) : A) = (-(Complex.I / 2)) • ((a : A) * b - (b : A) * a) := + rfl + +omit [Module ℂ A] [StarModule ℂ A] in +/-- The product of two self-adjoint elements is self-adjoint exactly when they commute. This is a +fact about `A` alone; it does not involve the Lie bracket (or any complex scalar structure) at +all, unlike every other lemma in this file. -/ +theorem isSelfAdjoint_mul_iff_commute (a b : selfAdjoint A) : + IsSelfAdjoint ((a : A) * (b : A)) ↔ Commute (a : A) (b : A) := by + rw [isSelfAdjoint_iff, star_mul, a.property.star_eq, b.property.star_eq, commute_iff_eq, eq_comm] + +/-- The ambient product of two self-adjoint elements splits into its normalized Jordan and Lie +parts: `a * b = (a ∘ b) + i ⁅a, b⁆`. -/ +theorem mul_decomposition (a b : selfAdjoint A) : + (a : A) * b = + (jordanMul a b : A) + Complex.I • ((lieMul a b : selfAdjoint A) : A) := by + rw [val_jordanMul, val_lieMul, smul_smul] + have h2 : Complex.I * -(Complex.I / 2) = (2 : ℂ)⁻¹ := by + rw [mul_neg, ← mul_div_assoc, Complex.I_mul_I] + norm_num + rw [h2] + module + +/-! ## Antisymmetry and additivity -/ + +/-- The Lie bracket is antisymmetric. -/ +theorem lieMul_swap (a b : selfAdjoint A) : lieMul a b = -lieMul b a := by + apply Subtype.ext + simp only [val_lieMul, AddSubgroup.coe_neg] + module + +theorem lieMul_add_left (a b c : selfAdjoint A) : + lieMul (a + b) c = lieMul a c + lieMul b c := by + apply Subtype.ext + simp only [val_lieMul, AddSubgroup.coe_add] + rw [show ((a : A) + b) * c - (c : A) * ((a : A) + b) = + ((a : A) * c - (c : A) * a) + ((b : A) * c - (c : A) * b) by noncomm_ring, smul_add] + +theorem lieMul_add_right (a b c : selfAdjoint A) : + lieMul a (b + c) = lieMul a b + lieMul a c := by + apply Subtype.ext + simp only [val_lieMul, AddSubgroup.coe_add] + rw [show (a : A) * ((b : A) + c) - ((b : A) + c) * a = + ((a : A) * b - (b : A) * a) + ((a : A) * c - (c : A) * a) by noncomm_ring, smul_add] + +theorem lieMul_self (a : selfAdjoint A) : lieMul a a = 0 := by + apply Subtype.ext + simp [val_lieMul] + +/-- The Lie bracket on `selfAdjoint A`, scoped (like `selfAdjoint.instMul` in `Jordan.lean`) so it +never silently competes with some other bracket mathlib or downstream code might register on +`selfAdjoint A`. Bring this into scope with `open scoped selfAdjoint`. -/ +noncomputable scoped instance instBracket : Bracket (selfAdjoint A) (selfAdjoint A) := ⟨lieMul⟩ + +@[simp] +theorem bracket_def (a b : selfAdjoint A) : ⁅a, b⁆ = lieMul a b := rfl + +theorem coe_bracket (a b : selfAdjoint A) : + ((⁅a, b⁆ : selfAdjoint A) : A) = (-(Complex.I / 2)) • ((a : A) * b - (b : A) * a) := + val_lieMul a b + +/-! ## Lie ring -/ + +section LieRing + +variable [IsScalarTower ℂ A A] [SMulCommClass ℂ A A] + +theorem leibniz_bracket (a b c : selfAdjoint A) : + ⁅a, ⁅b, c⁆⁆ = ⁅⁅a, b⁆, c⁆ + ⁅b, ⁅a, c⁆⁆ := by + apply Subtype.ext + simp only [bracket_def, val_lieMul, AddSubgroup.coe_add] + rw [mul_smul_comm, smul_mul_assoc, mul_smul_comm, smul_mul_assoc, mul_smul_comm, smul_mul_assoc, + ← smul_sub, ← smul_sub, ← smul_sub, smul_smul, smul_smul, smul_smul, ← smul_add] + congr 1 + noncomm_ring + +/-- Together with the Lie ring axioms, `selfAdjoint A` becomes a Lie ring under `lieMul`: the +`ℂ`-scalar structure is only used to move the fixed scalar `-i/2` across products +(`SMulCommClass`/`IsScalarTower`), never to invoke a `LieAlgebra` instance on `A` itself, so this +does not need `A` to literally be a `ℂ`-algebra in mathlib's bundled sense. -/ +noncomputable scoped instance instLieRing : LieRing (selfAdjoint A) where + add_lie := lieMul_add_left + lie_add := lieMul_add_right + lie_self := lieMul_self + leibniz_lie := leibniz_bracket + +/-! ## Real Lie algebra -/ + +theorem bracket_smul (t : ℝ) (a b : selfAdjoint A) : + ⁅a, t • b⁆ = t • ⁅a, b⁆ := by + apply Subtype.ext + simp only [bracket_def, val_lieMul, selfAdjoint.val_smul, ← Complex.coe_smul] + rw [mul_smul_comm, smul_mul_assoc] + module + +/-- The Lie bracket is compatible with the real scalar structure. -/ +noncomputable scoped instance instLieAlgebra : LieAlgebra ℝ (selfAdjoint A) where + toModule := inferInstance + lie_smul := bracket_smul + +end LieRing + +/-! ## Elementary identities -/ + +theorem bracket_one_right (a : selfAdjoint A) : ⁅a, (1 : selfAdjoint A)⁆ = 0 := by + apply Subtype.ext + rw [coe_bracket] + simp + +theorem bracket_one_left (a : selfAdjoint A) : ⁅(1 : selfAdjoint A), a⁆ = 0 := by + apply Subtype.ext + rw [coe_bracket] + simp + +end selfAdjoint + +/-- The Lie bracket is available on `Observable A` with no extra work: since `Observable A := +selfAdjoint A` is an `abbrev`, `selfAdjoint.lieMul` applies to observables verbatim, once the +ambient `A` carries the ring, star-ring, and complex-module structure this file assumes (on top of +the bare `AddGroup`/`StarAddMonoid` that `Observable` itself needs). -/ +noncomputable abbrev Observable.lieMul {A : Type*} [Ring A] [StarRing A] [Module ℂ A] + [StarModule ℂ A] (a b : Observable A) : Observable A := + selfAdjoint.lieMul a b diff --git a/PhyslibAlpha/AlgebraicFramework/StarAlgebra/Observable.lean b/PhyslibAlpha/AlgebraicFramework/StarAlgebra/Observable.lean new file mode 100644 index 0000000000..d798e3031e --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/StarAlgebra/Observable.lean @@ -0,0 +1,92 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.StarAlgebra.SelfAdjoint +public import PhyslibAlpha.AlgebraicFramework.StarAlgebra.Restrict +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Basic +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.Basic + +/-! + +# Observables + +An observable is a self-adjoint element of a space with an additive involution. +This definition needs neither multiplication nor a norm. In particular, the +self-adjoint part of a complex operator algebra is already an observable space +before any C⋆-algebraic structure is used. + +A complex state on a starred space restricts to a real state on its observables. +Thus the expectation-value functional is itself an instance of the general +state notion `𝓢[ℝ, Observable A]`; it does not require a separate definition of +linearity, positivity, or normalization. + +## The abstract order-unit case + +When `E` already is a real ordered vector space (rather than the self-adjoint part of a complex +one), no restriction is needed at all: `Observable E ⊆ E` directly, and a state `s : 𝓢[ℝ, E]` is +already linear and positive on all of `E`, so it pairs with an observable `a : Observable E` by +simply evaluating `s (a : E)`. Linearity (`map_add`, `map_smul`), positivity of a positive +observable's expectation (`map_nonneg`), and the expectation of the unit observable (`map_one`) +are consequently not new facts about states meeting observables — they are the same generic +`UnitalPositiveLinearMap` lemmas already used everywhere else, applied at `a : E`. The examples +below witness this; no bespoke `expectation` definition is needed. + +## Main definitions + +- `Observable A`, `PositiveObservable A` +- `UnitalPositiveLinearMap.onObservables` : the real state on observables induced by a complex + state on the ambient starred space. + +-/ + +@[expose] public section + +/-- An observable in a space with an additive involution. -/ +abbrev Observable (A : Type*) [AddGroup A] [StarAddMonoid A] := selfAdjoint A + +/-- A positive observable in an ordered space with an additive involution. -/ +abbrev PositiveObservable (A : Type*) [AddGroup A] [StarAddMonoid A] [PartialOrder A] := + {a : Observable A // 0 ≤ (a : A)} + +open scoped ComplexOrder + +namespace UnitalPositiveLinearMap + +variable {A : Type*} [Ring A] [PartialOrder A] [StarRing A] + [SelfAdjointDecompose A] [Module ℂ A] [StarModule ℂ A] + +/-- The real state on observables induced by a complex state on the ambient starred space. -/ +noncomputable def onObservables (ω : 𝓢[A]) : 𝓢[ℝ, Observable A] := + ω.restrictSAC + +/-- Restricting a state to observables does not change its values, after regarding the real +expectation value as a complex number. -/ +@[simp, norm_cast] +lemma coe_onObservables_apply (ω : 𝓢[A]) (a : Observable A) : + ((ω.onObservables a : ℝ) : ℂ) = ω (a : A) := by + exact coe_restrictSAC_apply ω a + +end UnitalPositiveLinearMap + +section OrderUnit + +variable {E : Type*} [AddCommGroup E] [PartialOrder E] [IsOrderedAddMonoid E] + [Module ℝ E] [PosSMulMono ℝ E] [One E] [IsOrderUnit E] [StarAddMonoid E] [StarModule ℝ E] + +example (s : 𝓢[ℝ, E]) (a b : Observable E) : + s ((a : E) + (b : E)) = s (a : E) + s (b : E) := map_add s (a : E) (b : E) + +example (s : 𝓢[ℝ, E]) (c : ℝ) (a : Observable E) : + s (c • (a : E)) = c * s (a : E) := by + rw [map_smul]; rfl + +example (s : 𝓢[ℝ, E]) {a : Observable E} (ha : 0 ≤ (a : E)) : 0 ≤ s (a : E) := s.map_nonneg ha + +example (s : 𝓢[ℝ, E]) (h1 : IsSelfAdjoint (1 : E)) : s ((⟨1, h1⟩ : Observable E) : E) = 1 := + map_one s + +end OrderUnit diff --git a/PhyslibAlpha/AlgebraicFramework/StarAlgebra/Restrict.lean b/PhyslibAlpha/AlgebraicFramework/StarAlgebra/Restrict.lean new file mode 100644 index 0000000000..16e8e177bd --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/StarAlgebra/Restrict.lean @@ -0,0 +1,144 @@ +/- +Copyright (c) 2026 David Gross. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Gross +-/ +module + +public import Mathlib.Analysis.CStarAlgebra.ContinuousFunctionalCalculus.Basic +public import PhyslibAlpha.AlgebraicFramework.StarAlgebra.SelfAdjoint + +/-! + +# Restriction of unital positive linear maps to submodules + +We define restriction of positive and unital positive linear maps to +submodules, in particular to self-adjoint elements. + +-/ + +@[expose] public section + +section Restrict + +variable {R S E₁ E₂ : Type*} + [Semiring R] [Semiring S] + [AddCommMonoid E₁] [AddCommMonoid E₂] + [PartialOrder E₁] [PartialOrder E₂] + [Module R E₁] [Module R E₂] [Module S E₁] [Module S E₂] + [LinearMap.CompatibleSMul E₁ E₂ S R] + +/-- Restrict a positive linear map to submodules it preserves. -/ +@[simps!] +def PositiveLinearMap.restrict (f : E₁ →ₚ[R] E₂) {F₁ : Submodule S E₁} {F₂ : Submodule S E₂} + (h : ∀ ⦃x⦄, x ∈ F₁ → f x ∈ F₂) : F₁ →ₚ[S] F₂ where + toLinearMap := (f.toLinearMap.restrictScalars S).restrict (by simpa) + monotone' a b h := f.monotone (by simpa) + +variable [One E₁] [One E₂] + +/-- Restrict a unital positive linear map to submodules it preserves. -/ +@[simps! apply] +def UnitalPositiveLinearMap.restrict (f : E₁ →ₚ₁[R] E₂) {F₁ : Submodule S E₁} {F₂ : Submodule S E₂} + [One F₁] [One F₂] (h₁ : ↑(1 : F₁) = (1 : E₁)) (h₂ : ↑(1 : F₂) = (1 : E₂)) + (h : ∀ ⦃x⦄, x ∈ F₁ → f x ∈ F₂) : F₁ →ₚ₁[S] F₂ where + toPositiveLinearMap := f.toPositiveLinearMap.restrict h + map_one' := by + ext + simp [h₁, h₂] + +end Restrict + +section SelfAdjoint + +variable {A₁ A₂ : Type*} + +namespace PositiveLinearMap + +-- `IsSelfAdjoint.map` needs Mathlib's `StarHomClass` instance for positive linear maps. +variable + [AddCommGroup A₁] [PartialOrder A₁] [StarAddMonoid A₁] + [NonUnitalRing A₂] [PartialOrder A₂] [StarRing A₂] + [SelfAdjointDecompose A₁] + [Module ℂ A₁] [Module ℂ A₂] + [StarModule ℂ A₁] [StarModule ℂ A₂] + [StarOrderedRing A₂] + +open selfAdjoint + +/-- A positive linear map induces a positive real-linear map on self-adjoint elements. -/ +noncomputable def restrictSA (f : A₁ →ₚ[ℂ] A₂) : selfAdjoint A₁ →ₚ[ℝ] selfAdjoint A₂ := + submodulePLM.comp <| + (f.restrict (by simp_all [IsSelfAdjoint.map])).comp <| submodulePLMSymm ℝ + +@[simp, norm_cast] +lemma coe_restrictSA_apply (f : A₁ →ₚ[ℂ] A₂) (x : selfAdjoint A₁) : + ↑(f.restrictSA x) = f ↑x := by + simp [restrictSA] + +section Complex + +open Complex ComplexOrder ComplexConjugate + +/-- A positive complex-linear functional induces a positive real-linear functional on +self-adjoint elements. -/ +noncomputable def restrictSAC (f : A₁ →ₚ[ℂ] ℂ) : selfAdjoint A₁ →ₚ[ℝ] ℝ := + Complex.selfAdjointUPLM.toPositiveLinearMap.comp f.restrictSA + +@[simp, norm_cast] +lemma coe_restrictSAC_apply (f : A₁ →ₚ[ℂ] ℂ) (x : selfAdjoint A₁) : + (f.restrictSAC x : ℂ) = f (x : A₁) := by + have : conj (f x) = f x := by + rw [← star_def, ← isSelfAdjoint_iff] + exact IsSelfAdjoint.map isSelfAdjoint f + simpa [restrictSAC] using (conj_eq_iff_re.mp this) + +end Complex + +end PositiveLinearMap + +namespace UnitalPositiveLinearMap + +variable + [Ring A₁] [PartialOrder A₁] [StarRing A₁] + [Ring A₂] [PartialOrder A₂] [StarRing A₂] + [SelfAdjointDecompose A₁] + [Module ℂ A₁] [Module ℂ A₂] + [StarModule ℂ A₁] [StarModule ℂ A₂] + [StarOrderedRing A₂] + +open selfAdjoint + +variable (f : A₁ →ₚ₁[ℂ] A₂) + +/-- A unital positive linear map induces a unital positive real-linear map on +self-adjoint elements. -/ +noncomputable def restrictSA (f : A₁ →ₚ₁[ℂ] A₂) : selfAdjoint A₁ →ₚ₁[ℝ] selfAdjoint A₂ := + submoduleUPLM.comp <| + (f.restrict val_one val_one (by simp_all [IsSelfAdjoint.map])).comp + <| submoduleUPLMSymm ℝ + +@[simp, norm_cast] +lemma coe_restrictSA_apply (f : A₁ →ₚ₁[ℂ] A₂) (x : selfAdjoint A₁) : + ↑(f.restrictSA x) = f ↑x := by + change f ↑((submoduleEquiv (R := ℝ) (A := A₁)).symm x) = f ↑x + exact congrArg f (submoduleEquiv_symm_apply_coe x) + +open Complex ComplexOrder ComplexConjugate + +/-- A unital positive complex-linear functional induces a unital positive real-linear functional +on self-adjoint elements. -/ +noncomputable def restrictSAC (f : A₁ →ₚ₁[ℂ] ℂ) : selfAdjoint A₁ →ₚ₁[ℝ] ℝ := + Complex.selfAdjointUPLM.comp f.restrictSA + +@[simp, norm_cast] +lemma coe_restrictSAC_apply (f : A₁ →ₚ₁[ℂ] ℂ) (x : selfAdjoint A₁) : + (f.restrictSAC x : ℂ) = f (x : A₁) := by + have : conj (f x) = f x := by + rw [← star_def, ← isSelfAdjoint_iff] + exact IsSelfAdjoint.map isSelfAdjoint f + simpa [restrictSAC] using (conj_eq_iff_re.mp this) + +end UnitalPositiveLinearMap + +end SelfAdjoint diff --git a/PhyslibAlpha/AlgebraicFramework/StarAlgebra/SelfAdjoint.lean b/PhyslibAlpha/AlgebraicFramework/StarAlgebra/SelfAdjoint.lean new file mode 100644 index 0000000000..839e1f13b1 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/StarAlgebra/SelfAdjoint.lean @@ -0,0 +1,90 @@ +/- +Copyright (c) 2026 David Gross. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Gross +-/ +module + +public import Mathlib.Analysis.RCLike.Basic +public import Mathlib.Analysis.Complex.Basic +public import Mathlib.Algebra.Star.Module +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.Channel.Basic + +/-! + +# Basic results on self-adjoint elements + +Mathlib provides several formulations of self-adjointness. This module relates +`IsSelfAdjoint x`, `x ∈ selfAdjoint A`, and the two module structures on +self-adjoint elements. + +-/ + +@[expose] public section + +namespace selfAdjoint + +@[simp] +lemma mem_selfAdjoint_iff_isSelfAdjoint {R : Type*} [AddGroup R] [StarAddMonoid R] (x : R) : + x ∈ selfAdjoint R ↔ IsSelfAdjoint x := isSelfAdjoint_iff.trans selfAdjoint.mem_iff.symm + +variable {R A : Type*} [Semiring R] [StarMul R] [TrivialStar R] + [AddCommGroup A] [Module R A] [StarAddMonoid A] [StarModule R A] + +@[simp] +lemma submodule_mem_iff {x : A} : (x ∈ submodule R A) ↔ (x ∈ selfAdjoint A) := by + rfl + +/-- The linear equivalence that forgets the `Submodule` structure on self-adjoint elements. -/ +@[simps!] +def submoduleEquiv : selfAdjoint.submodule R A ≃ₗ[R] selfAdjoint A where + toFun x := ⟨x.val, submodule_mem_iff.mp x.prop⟩ + invFun x := ⟨x.val, submodule_mem_iff.mpr x.prop⟩ + map_add' _ _ := by simp + map_smul' _ _ := by ext; simp + +variable [PartialOrder A] + +/-- Forget the `Submodule` structure as a positive linear map. -/ +@[simps!] +def submodulePLM : submodule R A →ₚ[R] selfAdjoint A := + { selfAdjoint.submoduleEquiv.toLinearMap with monotone' a b hab := by simpa } + +variable (R) in +/-- Inverse of `submodulePLM`. (There is no `PositiveLinearEquivalence` type.) -/ +@[simps!] +def submodulePLMSymm : selfAdjoint A →ₚ[R] submodule R A := + { selfAdjoint.submoduleEquiv.symm.toLinearMap with monotone' a b hab := by simpa } + +variable {R A : Type*} [Semiring R] [StarMul R] [TrivialStar R] + [Ring A] [StarRing A] [Module R A] [StarModule R A] + +instance : One (submodule R A) := + ⟨⟨1, .one _⟩⟩ + +@[simp] lemma val_one_submodule : ↑(1 : submodule R A) = (1 : A) := rfl +@[simp] lemma submoduleEquiv_one : ↑(submoduleEquiv (R := R) (A := A) 1) = 1 := rfl +@[simp] lemma submoduleEquiv_symm_one : ↑(submoduleEquiv (R := R) (A := A).symm 1) = 1 := rfl + +variable [PartialOrder A] + +/-- Forget the `Submodule` structure as a unital positive linear map. -/ +@[simps! apply] +def submoduleUPLM : submodule R A →ₚ₁[R] selfAdjoint A := + { submoduleEquiv.toLinearMap with monotone' a b hab := by simpa, map_one' := by simp } + +variable (R) in +/-- Inverse of `submoduleUPLM`. (There is no `UnitalPositiveLinearEquivalence` type.) -/ +def submoduleUPLMSymm : selfAdjoint A →ₚ₁[R] submodule R A := + { submoduleEquiv.symm.toLinearMap with monotone' a b hab := by simpa, map_one' := by simp } + +end selfAdjoint + +open ComplexOrder + +/-- The map from self-adjoint complex numbers to real numbers as a unital positive linear map. -/ +@[simps!] +noncomputable def Complex.selfAdjointUPLM : selfAdjoint ℂ →ₚ₁[ℝ] ℝ where + toLinearMap := Complex.selfAdjointEquiv.toLinearMap + monotone' a b hab := by simp; gcongr + map_one' := by simp diff --git a/PhyslibAlpha/AlgebraicFramework/StarAlgebra/Statistics.lean b/PhyslibAlpha/AlgebraicFramework/StarAlgebra/Statistics.lean new file mode 100644 index 0000000000..85fb998fe0 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/StarAlgebra/Statistics.lean @@ -0,0 +1,222 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.Algebra.Statistics +public import PhyslibAlpha.AlgebraicFramework.StarAlgebra.Jordan + +/-! + +# State statistics + +A state assigns real expectation values to observables (`UnitalPositiveLinearMap.expectation`, +notation `ω⟨a⟩`, built directly from `UnitalPositiveLinearMap.onObservables`). Centering an +observable around its mean produces `covariance` and `variance`, the quantities the uncertainty +relations in `CStarAlgebra.Uncertainty` are stated in terms of. + +None of this needs a C⋆-norm or completeness: a state `ω : 𝓢[A]` already restricts to a real +state on `Observable A`, and positivity of `variance` is already positivity of a state applied to +`star x * x` for `x` self-adjoint. Consequently almost everything here is stated for a bare star +ring with a compatible order (`Ring`, `StarRing`, `PartialOrder`, plus `SelfAdjointDecompose`, +`Module ℂ`, `StarModule ℂ` for `𝓢[A]`/`onObservables` themselves to make sense) — exactly the +level `UnitalPositiveLinearMap.onObservables` needs. `StarOrderedRing` is added locally, only on +`variance_nonneg`, for the one positivity fact (`star_mul_self_nonneg`) that actually needs it; +symmetry of `covariance` needs no order at all, just `apply_mul_comm_eq_star`. + +## Main definitions + +- `UnitalPositiveLinearMap.expectation`, notation `ω⟨a⟩` : the real expectation value of an + observable `a` in state `ω`. +- `UnitalPositiveLinearMap.centered` : an observable with its mean subtracted off. +- `UnitalPositiveLinearMap.covariance`, `UnitalPositiveLinearMap.variance` : the correlation + between two observables' fluctuations, and the spread of one observable's own fluctuations. + +-/ + +@[expose] public section + +open scoped ComplexOrder +open scoped selfAdjoint + +variable {A : Type*} [Ring A] [PartialOrder A] [StarRing A] + [SelfAdjointDecompose A] [Module ℂ A] [StarModule ℂ A] + [SMulCommClass ℝ A A] [IsScalarTower ℝ A A] + +namespace UnitalPositiveLinearMap + +/-! ## Expectation -/ + +/-- The real state on observables induced by `ω`. Its value at `a` is the mean value a physicist +would call `⟨a⟩`, obtained by averaging repeated measurements of `a` on systems prepared in +state `ω`. This is exactly `onObservables`, under a name and notation that reads as expectation +rather than restriction. -/ +noncomputable def expectation (ω : 𝓢[A]) : 𝓢[ℝ, Observable A] := + ω.onObservables + +@[inherit_doc expectation] +scoped notation:max ω "⟨" a "⟩" => UnitalPositiveLinearMap.expectation ω a + +attribute [nolint docBlame] UnitalPositiveLinearMap.«term_⟨_⟩» + +omit [SMulCommClass ℝ A A] [IsScalarTower ℝ A A] in +/-- The complex-valued state functional agrees with the real expectation notation `ω⟨a⟩` on +observables: no information is lost, since self-adjoint elements have vanishing imaginary part. -/ +lemma apply_observable_eq_expectation (ω : 𝓢[A]) (a : Observable A) : + ω (a : A) = (ω⟨a⟩ : ℂ) := + (coe_onObservables_apply ω a).symm + +omit [SMulCommClass ℝ A A] [IsScalarTower ℝ A A] in +/-- The trivial "do-nothing" observable `1` is measured with certainty: probabilities sum to one. -/ +@[simp] +lemma expectation_one (ω : 𝓢[A]) : + ω⟨(1 : Observable A)⟩ = 1 := by + simp [expectation] + +omit [SMulCommClass ℝ A A] [IsScalarTower ℝ A A] in +/-- Positive observables have nonnegative expectation. -/ +lemma expectation_nonneg (ω : 𝓢[A]) {a : Observable A} (ha : 0 ≤ (a : A)) : + 0 ≤ ω⟨a⟩ := + (expectation ω).map_nonneg ha + +/-! ## Centering -/ + +/-- The fluctuation of an observable around its mean: `a` with `ω⟨a⟩` subtracted off. Its +statistics (`covariance`, `variance`) describe the spread of `a`'s outcomes. -/ +noncomputable def centered (ω : 𝓢[A]) (a : Observable A) : Observable A := + LinearMap.centered (expectation ω).toLinearMap a + +omit [SMulCommClass ℝ A A] [IsScalarTower ℝ A A] in +/-- A fluctuation has zero mean by construction: the average deviation from the average is zero. -/ +@[simp] +lemma expectation_centered (ω : 𝓢[A]) (a : Observable A) : + ω⟨centered ω a⟩ = 0 := by + exact LinearMap.apply_centered (expectation ω).toLinearMap (expectation_one ω) a + +omit [SMulCommClass ℝ A A] [IsScalarTower ℝ A A] in +/-- Shifting an observable by a deterministic constant `c` shifts its mean by `c` too, so the +fluctuation around the new mean is unchanged. -/ +@[simp] +lemma centered_add_smul_one (ω : 𝓢[A]) (a : Observable A) (c : ℝ) : + centered ω (a + c • 1) = centered ω a := by + simp only [centered, LinearMap.centered, map_add, map_smul] + rw [show (expectation ω).toLinearMap 1 = 1 from expectation_one ω] + module + +/-! ## Reversing a product -/ + +omit [SMulCommClass ℝ A A] [IsScalarTower ℝ A A] in +/-- Reversing the order of two self-adjoint elements in a product conjugates the state's value on +it. Purely algebraic — needs only `map_star` and self-adjointness, no positivity or completeness — +so it is what makes `covariance` symmetric below without any detour through a Jordan product. -/ +lemma apply_mul_comm_eq_star (ω : 𝓢[A]) (a b : Observable A) : + ω ((b : A) * a) = star (ω ((a : A) * b)) := by + rw [← map_star, star_mul, a.property.star_eq, b.property.star_eq] + +/-! ## Covariance and variance -/ + +/-- The correlation between two observables' fluctuations in state `ω`: the real part of the +expectation of the (uncentered) product of their fluctuations. `apply_mul_comm_eq_star` makes this +symmetric in `a`, `b` (`covariance_comm`) without needing a symmetrized product to define it. +Nonzero covariance means a measurement of `a` carries statistical information about `b`. -/ +noncomputable def covariance (ω : 𝓢[A]) (a b : Observable A) : ℝ := + LinearMap.covarianceForm (expectation ω).toLinearMap a b + +/-- The spread of `a`'s measurement outcomes about its mean — the quantum analogue of a random +variable's variance, whose square root is the uncertainty `Δa` in `CStarAlgebra.Uncertainty`. -/ +noncomputable def variance (ω : 𝓢[A]) (a : Observable A) : ℝ := + covariance ω a a + +/-- Unfolds `variance` as covariance of an observable with itself. -/ +@[simp] +lemma covariance_self (ω : 𝓢[A]) (a : Observable A) : + covariance ω a a = variance ω a := + rfl + +/-- The canonical covariance form on the Jordan algebra of observables is the real part of the +state applied to the ordinary associative product of the centered observables. This is a +specialization theorem, not a second definition of covariance. -/ +lemma covariance_eq_re_apply_centered_mul (ω : 𝓢[A]) (a b : Observable A) : + covariance ω a b = (ω ((centered ω a : A) * centered ω b)).re := by + rw [covariance] + rw [← LinearMap.apply_centered_mul_centered (expectation ω).toLinearMap (expectation_one ω) + selfAdjoint.one_jordanMul selfAdjoint.jordanMul_one] + set x := centered ω a + set y := centered ω b + have hstar : ω ((y : A) * x) = star (ω ((x : A) * y)) := + apply_mul_comm_eq_star ω x y + have hval := apply_observable_eq_expectation ω (x * y) + rw [selfAdjoint.coe_mul, UnitalPositiveLinearMap.map_smul_of_tower, map_add, hstar, + Complex.real_smul] at hval + have hsum : ω ((x : A) * y) + star (ω ((x : A) * y)) = + (2 : ℂ) * (ω ((x : A) * y)).re := by + rw [Complex.star_def, Complex.add_conj] + push_cast + ring + rw [hsum] at hval + have hval' : ((expectation ω (x * y) : ℝ) : ℂ) = ((ω ((x : A) * y)).re : ℝ) := by + calc + ((expectation ω (x * y) : ℝ) : ℂ) = (((2 : ℝ)⁻¹ : ℝ) : ℂ) * + (2 * ((ω ((x : A) * y)).re : ℂ)) := hval.symm + _ = ((ω ((x : A) * y)).re : ℂ) := by + apply Complex.ext <;> (norm_num <;> ring) + exact_mod_cast hval' + +/-- Variance is the expectation of the squared fluctuation about the mean: unfolds `variance` and +`covariance` together. Stated as its own lemma (even though now definitionally `rfl`) since +`CStarAlgebra.Uncertainty` uses it under this name. -/ +lemma variance_eq_re_apply_centered_mul_self (ω : 𝓢[A]) (a : Observable A) : + variance ω a = (ω ((centered ω a : A) * centered ω a)).re := by + rw [variance, covariance_eq_re_apply_centered_mul] + +/-- Covariance is symmetric: reversing a product of self-adjoint fluctuations conjugates the +state's value on it, and conjugation does not change the real part. -/ +lemma covariance_comm (ω : 𝓢[A]) (a b : Observable A) : + covariance ω a b = covariance ω b a := by + exact (LinearMap.covarianceForm_isSymm (expectation ω).toLinearMap + fun x y => mul_comm x y).eq a b + +/-- Covariance depends only on fluctuations: shifting the left observable by a constant `c` +leaves it unchanged. -/ +lemma covariance_add_smul_one_left (ω : 𝓢[A]) (a b : Observable A) (c : ℝ) : + covariance ω (a + c • 1) b = covariance ω a b := by + change LinearMap.covarianceForm (expectation ω).toLinearMap (a + c • 1) b = + LinearMap.covarianceForm (expectation ω).toLinearMap a b + rw [map_add, map_smul] + have hone : LinearMap.covarianceForm (expectation ω).toLinearMap (1 : Observable A) b = 0 := by + rw [LinearMap.covarianceForm_apply] + change expectation ω (selfAdjoint.jordanMul 1 b) - expectation ω 1 * expectation ω b = 0 + rw [selfAdjoint.one_jordanMul, expectation_one] + ring + simp only [LinearMap.add_apply, LinearMap.smul_apply, hone, smul_zero, add_zero] + +/-- Covariance depends only on fluctuations: shifting the right observable by a constant `c` +leaves it unchanged. -/ +lemma covariance_add_smul_one_right (ω : 𝓢[A]) (a b : Observable A) (c : ℝ) : + covariance ω a (b + c • 1) = covariance ω a b := by + change LinearMap.covarianceForm (expectation ω).toLinearMap a (b + c • 1) = + LinearMap.covarianceForm (expectation ω).toLinearMap a b + rw [map_add, map_smul] + have hone : LinearMap.covarianceForm (expectation ω).toLinearMap a (1 : Observable A) = 0 := by + rw [LinearMap.covarianceForm_apply] + change expectation ω (selfAdjoint.jordanMul a 1) - expectation ω a * expectation ω 1 = 0 + rw [selfAdjoint.jordanMul_one, expectation_one] + ring + rw [hone, smul_zero, add_zero] + +variable [StarOrderedRing A] in +/-- Repeated measurements of an observable can never have negative spread about their mean: the +physical content of variance being an honest measure of statistical uncertainty. Algebraically, +this is positivity of the state applied to `(centered a)† (centered a) = (centered a)^2`, which +already lands in the positive cone via `star_mul_self_nonneg` — no Jordan product needed. -/ +lemma variance_nonneg (ω : 𝓢[A]) (a : Observable A) : + 0 ≤ variance ω a := by + rw [variance_eq_re_apply_centered_mul_self] + have h : (0 : A) ≤ (centered ω a : A) * centered ω a := by + have hpos := star_mul_self_nonneg (centered ω a : A) + rwa [(centered ω a).property.star_eq] at hpos + exact (RCLike.nonneg_iff.mp (ω.map_nonneg h)).1 + +end UnitalPositiveLinearMap diff --git a/PhyslibAlpha/AlgebraicFramework/StarAlgebra/Traciality.lean b/PhyslibAlpha/AlgebraicFramework/StarAlgebra/Traciality.lean new file mode 100644 index 0000000000..2b21745d1b --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/StarAlgebra/Traciality.lean @@ -0,0 +1,115 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import Mathlib.Algebra.Order.Star.Basic +public import Mathlib.LinearAlgebra.Complex.Module +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.WeightEquivalence + +/-! + +# Traciality + +Traciality is a property of a weight on the positive cone (`Weight.IsTracial`), and independently +a property of a state (`UnitalPositiveLinearMap.IsTracial`) — the standard notion of a tracial +state, stated directly on `𝓢[ℝ, A]` rather than defined as a weight that happens to also be a +state. `Weight.IsState.isTracial` is the theorem connecting the two: a finite tracial weight's +extension to a state is itself a tracial state. + +## Main definitions + +- `Weight.IsTracial` +- `UnitalPositiveLinearMap.IsTracial` +- `LinearMap.IsTracial` + +-/ + +@[expose] public section + +namespace Weight + +variable {A : Type*} [NonUnitalRing A] [StarRing A] [PartialOrder A] [StarOrderedRing A] + [IsOrderedAddMonoid A] [Module ℝ A] [PosSMulMono ℝ A] [One A] [IsOrderUnit A] + +/-- A weight is tracial when it assigns equal values to `x† x` and `x x†`. -/ +def IsTracial (w : Weight A) : Prop := + ∀ x : A, w ⟨star x * x, star_mul_self_nonneg x⟩ = w ⟨x * star x, mul_star_self_nonneg x⟩ + +namespace IsTracial + +variable {w : Weight A} + +/-- A finite tracial weight's real positive-linear extension has equal values on `x† x` and +`x x†`. -/ +lemma toPositiveLinearMap_star_mul_self (ht : w.IsTracial) (hw : w.IsFinite) (x : A) : + hw.toPositiveLinearMap (star x * x) = hw.toPositiveLinearMap (x * star x) := by + change hw.toFun (star x * x) = hw.toFun (x * star x) + rw [hw.toFun_of_nonneg ⟨star x * x, star_mul_self_nonneg x⟩, + hw.toFun_of_nonneg ⟨x * star x, mul_star_self_nonneg x⟩] + exact congrArg ENNReal.toReal (ht x) + +end IsTracial + +end Weight + +namespace UnitalPositiveLinearMap + +variable {A : Type*} [NonUnitalRing A] [StarRing A] [PartialOrder A] [StarOrderedRing A] + [IsOrderedAddMonoid A] [Module ℝ A] [PosSMulMono ℝ A] [One A] [IsOrderUnit A] + +/-- A state is tracial when it assigns equal values to `x† x` and `x x†`: the standard notion of a +tracial state, independent of `Weight.IsTracial` — a state is already a genuine linear functional, +so this needs no detour through a weight. -/ +def IsTracial (s : 𝓢[ℝ, A]) : Prop := ∀ x : A, s (star x * x) = s (x * star x) + +end UnitalPositiveLinearMap + +namespace Weight.IsState + +variable {A : Type*} [NonUnitalRing A] [StarRing A] [PartialOrder A] [StarOrderedRing A] + [IsOrderedAddMonoid A] [Module ℝ A] [PosSMulMono ℝ A] [One A] [IsOrderUnit A] {w : Weight A} + +/-- A finite tracial weight's extension to a state is itself a tracial state: the representation +theorem connecting `Weight.IsTracial` to `UnitalPositiveLinearMap.IsTracial`, in the same spirit as +`Weight.stateEquiv` connects `Weight.IsState` to `𝓢[ℝ, A]` itself. -/ +lemma isTracial (hw : w.IsState) (ht : w.IsTracial) : hw.toUnitalPositiveLinearMap.IsTracial := + fun x => ht.toPositiveLinearMap_star_mul_self hw.finite x + +end Weight.IsState + +namespace LinearMap + +variable {A : Type*} [NonUnitalRing A] [StarRing A] [Module ℂ A] + [IsScalarTower ℂ A A] [SMulCommClass ℂ A A] [StarModule ℂ A] + +/-- A complex-linear functional is tracial when it is invariant under cyclic permutations. -/ +def IsTracial (f : A →ₗ[ℂ] ℂ) : Prop := + ∀ x y : A, f (x * y) = f (y * x) + +/-- Equality on `x†x` and `xx†` characterizes tracial complex-linear functionals. -/ +lemma isTracial_iff_star_mul_self_eq_mul_star_self (f : A →ₗ[ℂ] ℂ) : + f.IsTracial ↔ ∀ x : A, f (star x * x) = f (x * star x) := by + constructor + · intro ht x + exact ht (star x) x + · intro h x y + have hplus := h (x + star y) + have hI := h (x + Complex.I • star y) + have hx := h x + have hy := h (star y) + simp only [star_add, star_star, star_smul, Complex.star_def, Complex.conj_I, map_add, + map_smul, mul_add, add_mul, smul_mul_assoc, mul_smul_comm] at hplus hI + simp at hI + simp only [star_star] at hy + have hp : f (y * x) + f (star x * star y) = f (star y * star x) + f (x * y) := by + linear_combination hplus - hx - hy + have hq : -Complex.I • f (y * x) + Complex.I • f (star x * star y) = + Complex.I • f (star y * star x) - Complex.I • f (x * y) := by + linear_combination (norm := (ring_nf; simp [Complex.I_sq, hy])) hI - hx - hy + linear_combination (norm := (ring_nf; simp [Complex.I_sq]; try ring)) + (-Complex.I / 2) * hq - (1 / 2) * hp + +end LinearMap diff --git a/PhyslibAlpha/AlgebraicFramework/WStarAlgebra/Basic.lean b/PhyslibAlpha/AlgebraicFramework/WStarAlgebra/Basic.lean new file mode 100644 index 0000000000..8291f2f9c3 --- /dev/null +++ b/PhyslibAlpha/AlgebraicFramework/WStarAlgebra/Basic.lean @@ -0,0 +1,237 @@ +/- +Copyright (c) 2026 Tom Ole Diem. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Tom Ole Diem +-/ +module + +public import PhyslibAlpha.AlgebraicFramework.OrderUnit.State.Basic +public import Mathlib.Analysis.CStarAlgebra.ContinuousFunctionalCalculus.Order +public import Mathlib.Analysis.Normed.Module.WeakDual + +/-! + +# W⋆-algebras: predual and the weak-⋆ topology + +A W⋆-algebra is a C⋆-algebra that is additionally, isometrically, the Banach-space dual of some +other Banach space — Sakai's characterization of a von Neumann algebra, purely in Banach-space +terms. There is no need for any Hilbert-space representation, or even for `A` to be an algebra of +operators at all. + +Mathlib already has this notion, `WStarAlgebra` (`Mathlib.Analysis.VonNeumannAlgebra.Basic`), but +only asserts the *mere existence* of a predual (a `Prop`), by design — Mathlib's own docstring +flags picking one as a possible source of definitional-unification trouble down the line. That is +exactly the trouble this file needs to avoid: the weak-⋆ topology genuinely depends on *which* +predual is chosen (Sakai's theorem says any two are isometrically isomorphic, but not canonically +so), so a mere existence statement isn't enough to even state `weakStarTopology`, let alone work +with it. `WStarAlgebraStructure` is therefore data — a `class` packaging one chosen predual and +identification — built directly on `Basic/CStarAlgebra/`'s bare-hypothesis convention +(`[CStarAlgebra A] [PartialOrder A] [StarOrderedRing A]`) rather than on a reinvented wrapper +class. It is a different name for a related but genuinely different (data vs. `Prop`) notion than +Mathlib's `WStarAlgebra`, not a competing definition of the same one; connecting the two — every +`WStarAlgebraStructure A` gives a proof of `WStarAlgebra A` — needs converting our `≃ₗᵢ[ℂ]` +(linear) identification to Mathlib's `≃ₗᵢ⋆[ℂ]` (conjugate-linear) one, genuine linear-algebra work +not attempted here. + +Mathlib's own weak-⋆ topology machinery for the dual of a normed space +(`Mathlib.Analysis.Normed.Module.WeakDual`, `WeakDual`/`StrongDual`) does essentially all of the +topological work once the predual identification is in hand — genuinely no new topology needed, +only the identification and its transport back along it. + +## Definitions + +- `WStarAlgebraStructure A` : `A` together with a chosen predual `Predual A` and an isometric + linear identification `toDual : A ≃ₗᵢ[ℂ] StrongDual ℂ (Predual A)`. +- `WStarAlgebraStructure.weakStarTopology A` : the weak-⋆ topology on `A`, pulled back through + `toDual` from `WeakDual ℂ (Predual A)`. Deliberately *not* a `TopologicalSpace A` instance — `A` + already has its norm topology (from `CStarAlgebra`), and the entire point here is to compare the + two, so they must coexist rather than compete for instance resolution. +- `WStarAlgebraStructure.norm_le_weakStarTopology` : the weak-⋆ topology is coarser than the norm + topology — proved outright from Mathlib's `toDual`-is-an-isometry and + `StrongDual.toWeakDual`-is-continuous facts, no new hard analysis needed. +- `NormalState A` : a state (`𝓢[A]`, `Basic/OrderUnit/State/Basic.lean`) continuous for + `weakStarTopology` — the honest, Sakai-style definition of "normal state". + `NormalState.continuous` recovers norm-continuity as a corollary, for free, from + `norm_le_weakStarTopology`. + +## Concrete realization + +The genuinely concrete instance — `A := B(H)` with predual the trace-class operators `𝒮₁(H)` and +`toDual` the trace pairing `a ↦ (ρ ↦ Tr(aρ))` — needs a `TraceClass H` Banach space this repo does +not yet have. This file stays at the abstract weak-⋆ and normal-state layer. + +-/ + +@[expose] public section + +noncomputable section + +open scoped ComplexOrder Topology +open TopologicalSpace +open Filter + +/-! ## W⋆-algebras -/ + +/-- **A W⋆-algebra, as data**: a C⋆-algebra `A` together with one chosen identification with the +Banach-space dual of some other Banach space `Predual A` — Sakai's characterization of a von +Neumann algebra. See the module docstring for why this is a `class` carrying a chosen predual +rather than a `Prop` asserting one exists (Mathlib's `WStarAlgebra`), and for the name choice. -/ +class WStarAlgebraStructure (A : Type*) extends CStarAlgebra A, PartialOrder A, StarOrderedRing A + where + /-- The predual: a Banach space `E` with `A ≃ₗᵢ[ℂ] StrongDual ℂ E` isometrically. -/ + Predual : Type* + predualNormedAddCommGroup : NormedAddCommGroup Predual + predualNormedSpace : NormedSpace ℂ Predual + predualCompleteSpace : CompleteSpace Predual + /-- The defining isometric identification `A ≃ₗᵢ[ℂ] StrongDual ℂ (Predual A)`, `a ↦ (ξ ↦ + ⟨a, ξ⟩)` for the duality pairing `A` inherits from being `Predual A`'s dual. -/ + toDual : A ≃ₗᵢ[ℂ] StrongDual ℂ Predual + +attribute [instance_reducible] WStarAlgebraStructure.predualNormedAddCommGroup + WStarAlgebraStructure.predualNormedSpace + +attribute [instance] WStarAlgebraStructure.predualNormedAddCommGroup + WStarAlgebraStructure.predualNormedSpace WStarAlgebraStructure.predualCompleteSpace + +namespace WStarAlgebraStructure + +variable (A : Type*) [WStarAlgebraStructure A] + +/-- **The weak-⋆ topology on `A`**: pulled back, through the defining predual isometry `toDual`, +from the weak-⋆ topology on `WeakDual ℂ (Predual A)` (Mathlib's `WeakDual`, the coarsest topology +making every evaluation `f ↦ f ξ`, `ξ : Predual A`, continuous). This models the physically correct +notion of "converges weakly" for states/observables on `A` — e.g. it is exactly the topology in +which a sequence of density operators `ρₙ → ρ` weak-⋆ iff `Tr(ρₙ A) → Tr(ρA)` for every bounded +`A`, the usual sense of convergence of quantum states. + +Deliberately *not* registered as a `TopologicalSpace A` instance: see the module docstring. -/ +@[instance_reducible] +def weakStarTopology : TopologicalSpace A := + TopologicalSpace.induced (fun a => StrongDual.toWeakDual (toDual a)) inferInstance + +/-- **The weak-⋆ topology is coarser than the norm topology.** The basic sanity fact making +`weakStarTopology` a genuine weakening of the topology `A` already carries as a C⋆-algebra: the +identity map `A → A`, viewed as `(A, ‖·‖) → (A, \text{weak-⋆})`, is continuous. Proved from two +continuity facts already in Mathlib — `toDual` is a (linear) isometry, hence norm-continuous +(`LinearIsometryEquiv.continuous`), and `StrongDual.toWeakDual` is continuous +(`NormedSpace.Dual.toWeakDual_continuous`) — composing gives continuity of `weakStarTopology`'s +defining map for the *norm* topology on the domain, which is exactly what "coarser" means via +`continuous_iff_le_induced`. No genuinely new analysis: this is Mathlib's own comparison theorem +for the weak-⋆ topology on a dual space, transported along `toDual`. -/ +theorem norm_le_weakStarTopology : + (inferInstance : TopologicalSpace A) ≤ weakStarTopology A := + continuous_iff_le_induced.mp + (NormedSpace.Dual.toWeakDual_continuous.comp (toDual (A := A)).continuous) + +end WStarAlgebraStructure + +/-! ## The predual pairing -/ + +namespace WStarAlgebraStructure + +variable {A : Type*} [WStarAlgebraStructure A] + +/-- The canonical continuous functional on `A` associated with a predual vector. This is the +pairing that later concrete normality theorems use; spelling it out here avoids repeatedly +reconstructing the evaluation map through `toDual`. -/ +def predualPairing (ξ : WStarAlgebraStructure.Predual A) : A →L[ℂ] ℂ := + (ContinuousLinearMap.apply ℂ ℂ ξ).comp + ((toDual (A := A)).toLinearIsometry.toContinuousLinearMap) + +@[simp] +lemma predualPairing_apply (ξ : WStarAlgebraStructure.Predual A) (a : A) : + predualPairing ξ a = toDual a ξ := rfl + +lemma norm_predualPairing_apply (ξ : WStarAlgebraStructure.Predual A) (a : A) : + ‖predualPairing ξ a‖ ≤ ‖a‖ * ‖ξ‖ := by + have h := ContinuousLinearMap.le_opNorm (toDual a) ξ + simpa [predualPairing] using h + +/-- The predual pairing is continuous for the weak-* topology by construction. + +This is the basic normal-functional fact behind the von Neumann boundary: unlike a normal state, +which is a positive normalized functional, a predual vector gives an arbitrary (not necessarily +positive) weak-* continuous functional. Keeping this lemma explicit prevents later spectral +measure arguments from silently replacing additivity against all predual functionals by the weaker +statement for states alone. -/ +theorem predualPairing_weakStar_continuous (ξ : WStarAlgebraStructure.Predual A) : + Continuous[WStarAlgebraStructure.weakStarTopology A, inferInstance] + (predualPairing ξ) := by + change Continuous[TopologicalSpace.induced + (fun a => StrongDual.toWeakDual (toDual a)) inferInstance, inferInstance] + (fun a => (StrongDual.toWeakDual (toDual a)) ξ) + have hmap : Continuous[TopologicalSpace.induced + (fun a => StrongDual.toWeakDual (toDual a)) inferInstance, inferInstance] + (fun a => StrongDual.toWeakDual (toDual a)) := + (continuous_induced_dom (f := fun a : A => + StrongDual.toWeakDual (toDual a))) + have heval : Continuous[ + (inferInstance : TopologicalSpace (WeakDual ℂ (WStarAlgebraStructure.Predual A))), + inferInstance] + (fun z : WeakDual ℂ (WStarAlgebraStructure.Predual A) => z ξ) := + WeakBilin.eval_continuous _ _ + exact @Continuous.comp A (WeakDual ℂ (WStarAlgebraStructure.Predual A)) ℂ + (TopologicalSpace.induced (fun a => StrongDual.toWeakDual (toDual a)) inferInstance) + inferInstance inferInstance _ _ heval hmap + +/-- The predual pairings separate points of a W⋆-algebra. + +This is the algebraic half of the weak-* interface: equality can be checked against every +predual vector. It is useful when an operator-valued construction is first identified through +its normal matrix coefficients and only then packaged as an element of `A`. -/ +theorem ext_of_forall_predualPairing_eq {a b : A} + (h : ∀ ξ : WStarAlgebraStructure.Predual A, predualPairing ξ a = predualPairing ξ b) : + a = b := by + apply (toDual (A := A)).injective + ext ξ + exact h ξ + +/-! The topology is equivalently characterized by convergence of all canonical predual pairings. +This formulation is deliberately filter-based, so it applies to nets as well as sequences. -/ + +theorem tendsto_weakStar_iff_forall_predualPairing_tendsto + {α : Type*} {l : Filter α} {f : α → A} {a : A} : + Tendsto f l (@nhds A (WStarAlgebraStructure.weakStarTopology A) a) ↔ + ∀ ξ : WStarAlgebraStructure.Predual A, + Tendsto (fun i => predualPairing ξ (f i)) l + (𝓝 (predualPairing ξ a)) := by + change Tendsto f l (@nhds A + (TopologicalSpace.induced + (fun b => StrongDual.toWeakDual (toDual b)) inferInstance) a) ↔ _ + rw [nhds_induced, Filter.tendsto_comap_iff] + change Tendsto (fun i => StrongDual.toWeakDual (toDual (f i))) l + (𝓝 (StrongDual.toWeakDual (toDual a))) ↔ + ∀ ξ : WStarAlgebraStructure.Predual A, + Tendsto (fun i => (toDual (f i)) ξ) l (𝓝 ((toDual a) ξ)) + exact tendsto_iff_forall_eval_tendsto_topDualPairing + (𝕜 := ℂ) (E := WStarAlgebraStructure.Predual A) (l := l) + (f := fun i => StrongDual.toWeakDual (toDual (f i))) + (x := StrongDual.toWeakDual (toDual a)) + +end WStarAlgebraStructure + +/-! ## Normal states -/ + +/-- A state that is continuous for the weak-* topology of the chosen predual. -/ +structure NormalState (A : Type*) [WStarAlgebraStructure A] where + /-- The underlying state. -/ + toState : 𝓢[A] + /-- The state is continuous for the chosen weak-* topology. -/ + weakStar_continuous : + Continuous[WStarAlgebraStructure.weakStarTopology A, inferInstance] (⇑toState : A → ℂ) + +namespace NormalState + +variable {A : Type*} [WStarAlgebraStructure A] + +noncomputable instance : CoeFun (NormalState A) (fun _ => A → ℂ) where + coe ω := ω.toState + +@[simp, nolint synTaut] +lemma toState_apply (ω : NormalState A) (a : A) : ω.toState a = ω a := rfl + +/-- Weak-* continuity implies ordinary norm continuity because the weak-* topology is coarser. -/ +theorem continuous (ω : NormalState A) : Continuous (ω : A → ℂ) := + continuous_le_dom (WStarAlgebraStructure.norm_le_weakStarTopology A) ω.weakStar_continuous + +end NormalState diff --git a/PhyslibAlpha/ClassicalFieldTheory/Local/Action.lean b/PhyslibAlpha/ClassicalFieldTheory/Local/Action.lean index bcfc089076..e54fb3cd09 100644 --- a/PhyslibAlpha/ClassicalFieldTheory/Local/Action.lean +++ b/PhyslibAlpha/ClassicalFieldTheory/Local/Action.lean @@ -37,9 +37,8 @@ for its variations are kept explicit in the API. ## iv. References -- J. Cortés and A. Haupt, *Lecture Notes on Mathematical Methods of Classical Physics*, - Chapter 5. - +* J. Cortés and A. Haupt, Lecture Notes on Mathematical Methods of Classical Physics, Chapter 5. + [ref: cortes_haupt_2016] -/ @[expose] public section diff --git a/PhyslibAlpha/ClassicalFieldTheory/Local/EulerLagrange.lean b/PhyslibAlpha/ClassicalFieldTheory/Local/EulerLagrange.lean index a7c3d8a68f..cd204a7b22 100644 --- a/PhyslibAlpha/ClassicalFieldTheory/Local/EulerLagrange.lean +++ b/PhyslibAlpha/ClassicalFieldTheory/Local/EulerLagrange.lean @@ -32,9 +32,8 @@ close to the one in the book while avoiding a premature smooth structure on `Jet ## iv. References -- J. Cortés and A. Haupt, *Lecture Notes on Mathematical Methods of Classical Physics*, - Chapter 5. - +* J. Cortés and A. Haupt, Lecture Notes on Mathematical Methods of Classical Physics, Chapter 5. + [ref: cortes_haupt_2016] -/ @[expose] public section diff --git a/PhyslibAlpha/ClassicalFieldTheory/Local/EulerLagrangeEquation.lean b/PhyslibAlpha/ClassicalFieldTheory/Local/EulerLagrangeEquation.lean index 1347f4488e..36ee5712ee 100644 --- a/PhyslibAlpha/ClassicalFieldTheory/Local/EulerLagrangeEquation.lean +++ b/PhyslibAlpha/ClassicalFieldTheory/Local/EulerLagrangeEquation.lean @@ -36,9 +36,8 @@ Euler-Lagrange operator or any new analytic hypotheses. ## iv. References -- J. Cortés and A. Haupt, *Lecture Notes on Mathematical Methods of Classical Physics*, - arXiv:1612.03100v2, Chapter 5, Theorem 5.2. - +* J. Cortés and A. Haupt, Lecture Notes on Mathematical Methods of Classical Physics, + arXiv:1612.03100v2, Chapter 5, Theorem 5.2. [ref: cortes_haupt_2016] -/ @[expose] public section diff --git a/PhyslibAlpha/ClassicalFieldTheory/Local/FirstOrder.lean b/PhyslibAlpha/ClassicalFieldTheory/Local/FirstOrder.lean index 627f449569..468513212f 100644 --- a/PhyslibAlpha/ClassicalFieldTheory/Local/FirstOrder.lean +++ b/PhyslibAlpha/ClassicalFieldTheory/Local/FirstOrder.lean @@ -42,9 +42,8 @@ case easier to state in examples and later mechanics bridges. ## iv. References -- J. Cortés and A. Haupt, *Lecture Notes on Mathematical Methods of Classical Physics*, - arXiv:1612.03100v2, Chapter 5. - +* J. Cortés and A. Haupt, Lecture Notes on Mathematical Methods of Classical Physics, + arXiv:1612.03100v2, Chapter 5. [ref: cortes_haupt_2016] -/ @[expose] public section diff --git a/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation.lean b/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation.lean index 693fd3956e..04922bbeb0 100644 --- a/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation.lean +++ b/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation.lean @@ -31,9 +31,8 @@ surface-level statements of the local Euler-Lagrange criterion. ## iv. References -- J. Cortés and A. Haupt, *Lecture Notes on Mathematical Methods of Classical Physics*, - Chapter 5, Theorem 5.2. - +* J. Cortés and A. Haupt, Lecture Notes on Mathematical Methods of Classical Physics, Chapter 5, + Theorem 5.2. [ref: cortes_haupt_2016] -/ @[expose] public section diff --git a/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/Basic.lean b/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/Basic.lean index efce90c42b..e189575da3 100644 --- a/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/Basic.lean +++ b/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/Basic.lean @@ -27,9 +27,8 @@ the linearized density before integration by parts and its Euler-Lagrange pairin ## iv. References -- J. Cortés and A. Haupt, *Lecture Notes on Mathematical Methods of Classical Physics*, - Chapter 5, Theorem 5.2. - +* J. Cortés and A. Haupt, Lecture Notes on Mathematical Methods of Classical Physics, Chapter 5, + Theorem 5.2. [ref: cortes_haupt_2016] -/ @[expose] public section diff --git a/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/Criterion.lean b/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/Criterion.lean index 2e760f1f85..e43531825a 100644 --- a/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/Criterion.lean +++ b/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/Criterion.lean @@ -29,9 +29,8 @@ facade. ## iv. References -- J. Cortés and A. Haupt, *Lecture Notes on Mathematical Methods of Classical Physics*, - Chapter 5, Theorem 5.2. - +* J. Cortés and A. Haupt, Lecture Notes on Mathematical Methods of Classical Physics, Chapter 5, + Theorem 5.2. [ref: cortes_haupt_2016] -/ @[expose] public section diff --git a/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/Density.lean b/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/Density.lean index 6bb11bb125..a489f55176 100644 --- a/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/Density.lean +++ b/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/Density.lean @@ -28,9 +28,8 @@ and the corresponding packaged hypotheses. ## iv. References -- J. Cortés and A. Haupt, *Lecture Notes on Mathematical Methods of Classical Physics*, - Chapter 5, Theorem 5.2. - +* J. Cortés and A. Haupt, Lecture Notes on Mathematical Methods of Classical Physics, Chapter 5, + Theorem 5.2. [ref: cortes_haupt_2016] -/ @[expose] public section diff --git a/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/IntegrationByParts.lean b/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/IntegrationByParts.lean index 6624273501..8114b194a2 100644 --- a/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/IntegrationByParts.lean +++ b/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/IntegrationByParts.lean @@ -28,9 +28,8 @@ Euler-Lagrange criterion. ## iv. References -- J. Cortés and A. Haupt, *Lecture Notes on Mathematical Methods of Classical Physics*, - Chapter 5, Theorem 5.2. - +* J. Cortés and A. Haupt, Lecture Notes on Mathematical Methods of Classical Physics, Chapter 5, + Theorem 5.2. [ref: cortes_haupt_2016] -/ @[expose] public section diff --git a/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/Regularity.lean b/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/Regularity.lean index 690a720033..719dca2783 100644 --- a/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/Regularity.lean +++ b/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/Regularity.lean @@ -27,9 +27,8 @@ regularity of the local Lagrangian to the packaged smooth-regularity statement. ## iv. References -- J. Cortés and A. Haupt, *Lecture Notes on Mathematical Methods of Classical Physics*, - Chapter 5, Theorem 5.2. - +* J. Cortés and A. Haupt, Lecture Notes on Mathematical Methods of Classical Physics, Chapter 5, + Theorem 5.2. [ref: cortes_haupt_2016] -/ @[expose] public section diff --git a/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/Support.lean b/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/Support.lean index 875632bece..c46431aa76 100644 --- a/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/Support.lean +++ b/PhyslibAlpha/ClassicalFieldTheory/Local/FirstVariation/Support.lean @@ -28,9 +28,8 @@ test functions, and continuity of the varied local-jet coordinate map. ## iv. References -- J. Cortés and A. Haupt, *Lecture Notes on Mathematical Methods of Classical Physics*, - Chapter 5, Theorem 5.2. - +* J. Cortés and A. Haupt, Lecture Notes on Mathematical Methods of Classical Physics, Chapter 5, + Theorem 5.2. [ref: cortes_haupt_2016] -/ @[expose] public section diff --git a/PhyslibAlpha/ClassicalFieldTheory/Local/JetPoint.lean b/PhyslibAlpha/ClassicalFieldTheory/Local/JetPoint.lean index f83a59a518..0b90b81188 100644 --- a/PhyslibAlpha/ClassicalFieldTheory/Local/JetPoint.lean +++ b/PhyslibAlpha/ClassicalFieldTheory/Local/JetPoint.lean @@ -41,9 +41,8 @@ coordinate. ## iv. References -- J. Cortés and A. Haupt, *Lecture Notes on Mathematical Methods of Classical Physics*, - arXiv:1612.03100v2, Chapter 5, Section 5.1. - +* J. Cortés and A. Haupt, Lecture Notes on Mathematical Methods of Classical Physics, + arXiv:1612.03100v2, Chapter 5, Section 5.1. [ref: cortes_haupt_2016] -/ @[expose] public section diff --git a/PhyslibAlpha/ClassicalFieldTheory/Local/JetPointFiber.lean b/PhyslibAlpha/ClassicalFieldTheory/Local/JetPointFiber.lean index b914d32b56..1fe5e3360f 100644 --- a/PhyslibAlpha/ClassicalFieldTheory/Local/JetPointFiber.lean +++ b/PhyslibAlpha/ClassicalFieldTheory/Local/JetPointFiber.lean @@ -34,6 +34,7 @@ At this stage, it introduces: ## iv. References +* None. -/ @[expose] public section diff --git a/PhyslibAlpha/ClassicalFieldTheory/Local/JetPointRegularity.lean b/PhyslibAlpha/ClassicalFieldTheory/Local/JetPointRegularity.lean index 2b90a4a507..d924d7e105 100644 --- a/PhyslibAlpha/ClassicalFieldTheory/Local/JetPointRegularity.lean +++ b/PhyslibAlpha/ClassicalFieldTheory/Local/JetPointRegularity.lean @@ -34,6 +34,7 @@ At this stage, it provides: ## iv. References +* None. -/ @[expose] public section diff --git a/PhyslibAlpha/ClassicalFieldTheory/Local/Lagrangian.lean b/PhyslibAlpha/ClassicalFieldTheory/Local/Lagrangian.lean index a46335f1e5..6770ace9e2 100644 --- a/PhyslibAlpha/ClassicalFieldTheory/Local/Lagrangian.lean +++ b/PhyslibAlpha/ClassicalFieldTheory/Local/Lagrangian.lean @@ -38,9 +38,8 @@ structure on local jet-point data has been made explicit enough to support it na ## iv. References -- J. Cortés and A. Haupt, *Lecture Notes on Mathematical Methods of Classical Physics*, - Chapter 5. - +* J. Cortés and A. Haupt, Lecture Notes on Mathematical Methods of Classical Physics, Chapter 5. + [ref: cortes_haupt_2016] -/ @[expose] public section diff --git a/PhyslibAlpha/ClassicalFieldTheory/Local/TotalDerivative.lean b/PhyslibAlpha/ClassicalFieldTheory/Local/TotalDerivative.lean index 44b8b171e2..2dcdaf3fbf 100644 --- a/PhyslibAlpha/ClassicalFieldTheory/Local/TotalDerivative.lean +++ b/PhyslibAlpha/ClassicalFieldTheory/Local/TotalDerivative.lean @@ -31,6 +31,7 @@ formula, without yet introducing a separate coordinate-level derivative calculus ## iv. References +* None. -/ @[expose] public section diff --git a/PhyslibAlpha/ClassicalFieldTheory/Local/TotalDivergence.lean b/PhyslibAlpha/ClassicalFieldTheory/Local/TotalDivergence.lean index 1931e871b0..063cef37e6 100644 --- a/PhyslibAlpha/ClassicalFieldTheory/Local/TotalDivergence.lean +++ b/PhyslibAlpha/ClassicalFieldTheory/Local/TotalDivergence.lean @@ -42,9 +42,8 @@ symbolic calculus for coordinate derivatives of total derivatives. ## iv. References -- J. Cortés and A. Haupt, *Lecture Notes on Mathematical Methods of Classical Physics*, - arXiv:1612.03100v2, Chapter 5. - +* J. Cortés and A. Haupt, Lecture Notes on Mathematical Methods of Classical Physics, + arXiv:1612.03100v2, Chapter 5. [ref: cortes_haupt_2016] -/ @[expose] public section diff --git a/PhyslibAlpha/ClassicalFieldTheory/Local/TotalDivergenceEquivalence.lean b/PhyslibAlpha/ClassicalFieldTheory/Local/TotalDivergenceEquivalence.lean index 771dbe7298..802bc55205 100644 --- a/PhyslibAlpha/ClassicalFieldTheory/Local/TotalDivergenceEquivalence.lean +++ b/PhyslibAlpha/ClassicalFieldTheory/Local/TotalDivergenceEquivalence.lean @@ -42,9 +42,8 @@ which facts are data and which facts are proved. ## iv. References -- J. Cortés and A. Haupt, *Lecture Notes on Mathematical Methods of Classical Physics*, - arXiv:1612.03100v2, Chapter 5. - +* J. Cortés and A. Haupt, Lecture Notes on Mathematical Methods of Classical Physics, + arXiv:1612.03100v2, Chapter 5. [ref: cortes_haupt_2016] -/ @[expose] public section diff --git a/PhyslibAlpha/ClassicalMechanics/NortonDome/Basic.lean b/PhyslibAlpha/ClassicalMechanics/NortonDome/Basic.lean new file mode 100644 index 0000000000..90a0e5bfd2 --- /dev/null +++ b/PhyslibAlpha/ClassicalMechanics/NortonDome/Basic.lean @@ -0,0 +1,643 @@ +/- +Copyright (c) 2026 Zhi Kai Pong. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Zhi Kai Pong +-/ +module + +public import Physlib.ClassicalMechanics.EulerLagrange +public import Physlib.Mathematics.Calculus.Gradient +public import PhyslibAlpha.ClassicalMechanics.NortonDome.Sqrt +/-! + +# The Norton dome + +## i. Overview + +The Norton dome is a point mass `m` sliding without friction, under gravity `g`, on a +rotationally symmetric dome whose surface lies a depth `h(r) = (2/(3g)) r^{3/2}` below its +apex at arc length `r`. Its force is continuous, yet a mass at rest on the apex may stay there +forever or start sliding down at any later instant: the equation of motion has more than one +solution with given initial data. It is the standard example of the failure of determinism in +Newtonian mechanics and, mathematically, of the failure of uniqueness for an ODE whose +right-hand side is continuous but not Lipschitz. + +Newton's laws, as stated, do not determine the motion. A Newtonian system that is to be +deterministic must add something the laws do not state, a regularity condition on the force or +a restriction on the admissible motions; which addition belongs to Newtonian mechanics is +debated, and the folder does not decide it. It proves what each candidate condition buys and +that the dome fails each. Reading order: + +- `NortonDome.Basic` (this file): the dome, its energies, force, equation of motion `r̈ = √r`, + and the failure of the Lipschitz condition at the apex. +- `NortonDome.Solution`: rest at the apex and departure at any instant `T` are all solutions + from the same initial data, `exists_isSolution_ne`. +- `NortonDome.PhysicalSpace`: the arc-length chart as a point mass constrained to the surface. +- `NortonDome.NewtonianSystem`: the minimal `NewtonianSystem`; determinism, the first law and + the regularity conditions as predicates; a locally Lipschitz force gives determinism. +- `NortonDome.Determinism`: the dome is not deterministic, violates the first law, and fails + each regularity condition. +- `NortonDome.PeanoExistence`, `NortonDome.PosPartPow`, `NortonDome.Sqrt`: supporting + analysis. Peano's theorem is pending in Mathlib and marked `@[sorryful]`; all else is proved. + +The configuration is the arc length `r`, carried as for the pendulum on the Euclidean lift +`Time → EuclideanSpace ℝ (Fin 1)`. The physical dome is `r ≥ 0`; the chart is all of `ℝ`, and +for `r < 0` the truncated square root makes the force vanish. With `T = ½ m ṙ²` and +`V = -m g h(r) = -(2m/3) r^{3/2}` the equation of motion is `m r̈ = -dV/dr = m √r`, so +`r̈ = √r`: `m` and `g` cancel. Norton's profile presumes units in which the constant fixing the +size of the dome is `1`. + +The force `√r` is continuous but not Lipschitz at the apex, and the potential is `C¹` but not +`C²` there; see `NortonDome.Determinism`. So the Picard–Lindelöf hypothesis, which the pendulum +satisfies, fails for the dome. For the same reason the Euler–Lagrange theorem +`euler_lagrange_varGradient`, which needs a smooth Lagrangian, does not apply, and the equation +of motion is identified only with the vanishing of the pointwise Euler–Lagrange operator. + +## ii. Key results + +- `NortonDome` holds the input data, the mass `m` and the gravitational acceleration `g`. +- `NortonDome.height` is the depth `(2/(3g)) r^{3/2}` of the dome below its apex, with its + derivative `hasDerivAt_height` and `C¹` regularity `height_contDiff_one`. +- `NortonDome.kineticEnergy`, `NortonDome.potentialEnergy` and `NortonDome.energy` are the + energies, with the gradient `gradient_potentialEnergy` of the potential and the time + derivatives `kineticEnergy_deriv`, `potentialEnergy_deriv` and `energy_deriv` along twice + differentiable curves. +- `NortonDome.lagrangian` is the Lagrangian `T - V`, with its partial gradients + `gradient_lagrangian_position_eq` and `gradient_lagrangian_velocity_eq`. +- `NortonDome.force` is the generalized force `m √r` conjugate to the arc length. It is + continuous, `force_continuous`, but not Lipschitz on any closed ball about the apex, + `not_lipschitzOnWith_force`. +- `NortonDome.EquationOfMotion` is the equation of motion `m r̈ = F(r)`, with its scalar form + `equationOfMotion_iff_scalar`; `NortonDome.IsSolution` is a twice differentiable solution. +- `NortonDome.equationOfMotion_iff_eulerLagrangeOp_zero` identifies the equation of motion, + for curves with differentiable velocity, with the vanishing of the Euler–Lagrange operator. +- `NortonDome.IsSolution.energy_eq` is the conservation of energy along a solution. + +## iii. Table of contents + +- A. The input data +- B. The profile of the dome + - B.1. The height below the apex + - B.2. The derivative of the profile +- C. The energies + - C.1. The definitions of the energies + - C.2. Differentiability and the gradient of the potential + - C.3. Time derivatives of the energies +- D. The Lagrangian +- E. The force and the equation of motion + - E.1. The force + - E.2. Regularity of the force + - E.3. The equation of motion + - E.4. Solutions +- F. The Euler–Lagrange operator +- G. Energy conservation + +## iv. References + +- Norton, J. D., *The dome: an unexpectedly simple failure of determinism*, Philosophy of + Science 75 (2008), 786–798. +- Malament, D. B., *Norton's slippery slope*, Philosophy of Science 75 (2008), 799–816. + +-/ + +@[expose] public section + +namespace ClassicalMechanics +open Real InnerProductSpace + +/-! + +## A. The input data + +The dome is specified by the mass of the particle and the gravitational acceleration; its shape +is fixed by Norton's formula. + +-/ + +/-- The Norton dome is specified by the mass `m` of the particle sliding on it and the + gravitational acceleration `g`, both positive. The configuration of the particle is the arc + length from the apex. -/ +structure NortonDome where + /-- The mass of the particle. -/ + m : ℝ + /-- The gravitational acceleration. -/ + g : ℝ + m_pos : 0 < m + g_pos : 0 < g + +namespace NortonDome + +variable (S : NortonDome) + +/-- The mass of the particle is not equal to zero. -/ +@[simp] +lemma m_ne_zero : S.m ≠ 0 := S.m_pos.ne' + +/-- The gravitational acceleration is not equal to zero. -/ +@[simp] +lemma g_ne_zero : S.g ≠ 0 := S.g_pos.ne' + +/-! + +## B. The profile of the dome + +Norton's profile is the depth `h(r) = (2/(3g)) r^{3/2}` of the surface below the apex at arc +length `r`, written here as `(2/(3g)) √r ^ 3` so that it is defined, and vanishes, for `r ≤ 0`. + +-/ + +/-! + +### B.1. The height below the apex + +-/ + +/-- The depth of the surface of the dome below its apex at arc length `r` from the apex, + `(2/(3g)) r^{3/2}`. It vanishes at the apex and for negative arguments. -/ +noncomputable def height (r : ℝ) : ℝ := 2 / (3 * S.g) * √r ^ 3 + +/-- The depth of the dome below its apex, written out. -/ +lemma height_eq (r : ℝ) : S.height r = 2 / (3 * S.g) * √r ^ 3 := rfl + +/-- The depth of the dome below its apex is non-negative. -/ +lemma height_nonneg (r : ℝ) : 0 ≤ S.height r := by + rw [height_eq] + have hg := S.g_pos + positivity + +/-- The depth of the dome below its apex vanishes exactly at and before the apex. -/ +lemma height_eq_zero_iff (r : ℝ) : S.height r = 0 ↔ r ≤ 0 := by + rw [height_eq, mul_eq_zero, pow_eq_zero_iff three_ne_zero, Real.sqrt_eq_zero'] + simp + +/-! + +### B.2. The derivative of the profile + +The slope `√r / g` of the profile is continuous and vanishes at the apex, so the profile is +`C¹`. The slope itself is not differentiable at the apex, so the profile is not `C²`. + +-/ + +/-- The derivative of the depth of the dome with respect to the arc length is `√r / g`, at + every `r`, including the apex. -/ +lemma hasDerivAt_height (r : ℝ) : HasDerivAt S.height (√r / S.g) r := by + have h := (hasDerivAt_sqrt_pow_three r).const_mul (2 / (3 * S.g)) + refine h.congr_deriv ?_ + field_simp + +/-- The depth of the dome is a differentiable function of the arc length. -/ +@[fun_prop] +lemma height_differentiable : Differentiable ℝ S.height := + fun r => (S.hasDerivAt_height r).differentiableAt + +/-- The derivative of the depth of the dome with respect to the arc length is `√r / g`. -/ +lemma deriv_height : deriv S.height = fun r => √r / S.g := + funext fun r => (S.hasDerivAt_height r).deriv + +/-- The depth of the dome is a `C¹` function of the arc length. -/ +lemma height_contDiff_one : ContDiff ℝ 1 S.height := by + rw [contDiff_one_iff_deriv, deriv_height] + exact ⟨S.height_differentiable, by fun_prop⟩ + +open Time + +/-! + +## C. The energies + +The kinetic energy is `½ m ṙ²`, `r` being the arc length so that the speed is `|ṙ|`, and the +potential energy is `-m g h(r)`, normalized to vanish at the apex. + +-/ + +/-! + +### C.1. The definitions of the energies + +-/ + +/-- The kinetic energy of the particle on the dome along a curve `r` of the arc length is + `½ m ‖ṙ‖²`. -/ +noncomputable def kineticEnergy (r : Time → EuclideanSpace ℝ (Fin 1)) : Time → ℝ := fun t => + (1 / (2 : ℝ)) * S.m * ⟪∂ₜ r t, ∂ₜ r t⟫_ℝ + +/-- The potential energy of the particle on the dome at arc length `x` from the apex is + `-m g h(x 0)`, the gravitational potential at depth `h` below the apex, which vanishes at the + apex. -/ +noncomputable def potentialEnergy (x : EuclideanSpace ℝ (Fin 1)) : ℝ := + -(S.m * S.g * S.height (x 0)) + +/-- The energy of the particle on the dome is the kinetic energy plus the potential energy. -/ +noncomputable def energy (r : Time → EuclideanSpace ℝ (Fin 1)) : Time → ℝ := fun t => + S.kineticEnergy r t + S.potentialEnergy (r t) + +/-- The kinetic energy of the particle on the dome, written out. -/ +lemma kineticEnergy_eq (r : Time → EuclideanSpace ℝ (Fin 1)) : + S.kineticEnergy r = fun t => (1 / (2 : ℝ)) * S.m * ⟪∂ₜ r t, ∂ₜ r t⟫_ℝ := rfl + +/-- The potential energy of the particle on the dome is `-(2m/3) r^{3/2}`: the gravitational + acceleration cancels against the shape of the dome. -/ +lemma potentialEnergy_eq (x : EuclideanSpace ℝ (Fin 1)) : + S.potentialEnergy x = -(2 * S.m / 3) * √(x 0) ^ 3 := by + rw [potentialEnergy, height_eq] + field_simp + +/-- The energy of the particle on the dome, written out. -/ +lemma energy_eq (r : Time → EuclideanSpace ℝ (Fin 1)) : + S.energy r = fun t => S.kineticEnergy r t + S.potentialEnergy (r t) := rfl + +/-- The potential energy of the particle on the dome is non-positive, the apex being the + highest point of the dome. -/ +lemma potentialEnergy_nonpos (x : EuclideanSpace ℝ (Fin 1)) : S.potentialEnergy x ≤ 0 := by + rw [potentialEnergy, neg_nonpos] + exact mul_nonneg (mul_pos S.m_pos S.g_pos).le (S.height_nonneg _) + +/-- The potential energy of the particle on the dome vanishes exactly at the apex, that is for + arc length `≤ 0`. -/ +lemma potentialEnergy_eq_zero_iff (x : EuclideanSpace ℝ (Fin 1)) : + S.potentialEnergy x = 0 ↔ x 0 ≤ 0 := by + rw [potentialEnergy, neg_eq_zero, mul_eq_zero, or_iff_right (mul_pos S.m_pos S.g_pos).ne', + height_eq_zero_iff] + +/-! + +### C.2. Differentiability and the gradient of the potential + +The potential energy is differentiable, with gradient `-m √r` times the unit vector of the +arc-length coordinate. It is `C¹` but not `C²`, since `√r` is not differentiable at `0`. + +-/ + +/-- The cube of the square root of the arc-length coordinate is differentiable on the Euclidean + lift, at every point. -/ +lemma differentiableAt_sqrt_coord_pow_three (x : EuclideanSpace ℝ (Fin 1)) : + DifferentiableAt ℝ (fun y : EuclideanSpace ℝ (Fin 1) => √(y 0) ^ 3) x := by + have h : HasFDerivAt ((fun y : ℝ => √y ^ 3) ∘ ⇑(EuclideanSpace.proj (𝕜 := ℝ) (0 : Fin 1))) _ x := + (hasDerivAt_sqrt_pow_three (x 0)).comp_hasFDerivAt x + (EuclideanSpace.proj (𝕜 := ℝ) (0 : Fin 1)).hasFDerivAt + exact h.differentiableAt + +/-- The potential energy of the particle on the dome is a differentiable function of the arc + length. -/ +@[fun_prop] +lemma differentiable_potentialEnergy : Differentiable ℝ S.potentialEnergy := by + intro x + have h : S.potentialEnergy = fun y => -(2 * S.m / 3) * √(y 0) ^ 3 := + funext S.potentialEnergy_eq + rw [h] + exact (differentiableAt_sqrt_coord_pow_three x).const_mul _ + +/-- The gradient of the potential energy of the particle on the dome is `-m √r` times the unit + vector of the arc-length coordinate. -/ +lemma gradient_potentialEnergy (x : EuclideanSpace ℝ (Fin 1)) : + gradient S.potentialEnergy x = -(S.m * √(x 0)) • EuclideanSpace.single 0 1 := by + have h : S.potentialEnergy = fun y => -(2 * S.m / 3) * √(y 0) ^ 3 := + funext S.potentialEnergy_eq + rw [h, gradient_const_mul _ (differentiableAt_sqrt_coord_pow_three x), + gradient_comp_coord 0 x (hasDerivAt_sqrt_pow_three (x 0)), smul_smul] + congr 1 + ring + +/-- Along a curve of the arc length with differentiable velocity the kinetic energy is + differentiable in time. -/ +@[fun_prop] +lemma kineticEnergy_differentiable (r : Time → EuclideanSpace ℝ (Fin 1)) + (hr' : Differentiable ℝ (∂ₜ r)) : Differentiable ℝ (S.kineticEnergy r) := by + rw [kineticEnergy_eq] + fun_prop + +/-- Along a differentiable curve of the arc length the potential energy is a differentiable + function of the time. -/ +@[fun_prop] +lemma potentialEnergy_differentiable (r : Time → EuclideanSpace ℝ (Fin 1)) + (hr : Differentiable ℝ r) : Differentiable ℝ (fun t => S.potentialEnergy (r t)) := + S.differentiable_potentialEnergy.comp hr + +/-- Along a twice differentiable curve of the arc length the energy is differentiable in + time. -/ +@[fun_prop] +lemma energy_differentiable (r : Time → EuclideanSpace ℝ (Fin 1)) (hr : Differentiable ℝ r) + (hr' : Differentiable ℝ (∂ₜ r)) : Differentiable ℝ (S.energy r) := by + rw [energy_eq] + fun_prop + +/-! + +### C.3. Time derivatives of the energies + +Along a twice differentiable curve, solution or not, the time derivatives of the energies are +inner products against the velocity; the equation of motion makes the two contributions cancel. + +-/ + +/-- The rate of change of the kinetic energy is the velocity paired with `m r̈`. -/ +lemma kineticEnergy_deriv (r : Time → EuclideanSpace ℝ (Fin 1)) + (hr' : Differentiable ℝ (∂ₜ r)) : + ∂ₜ (S.kineticEnergy r) = fun t => ⟪∂ₜ r t, S.m • ∂ₜ (∂ₜ r) t⟫_ℝ := by + funext t + unfold kineticEnergy + have hd : DifferentiableAt ℝ (∂ₜ r) t := hr' t + rw [Time.deriv_eq, fderiv_const_mul (by fun_prop), _root_.smul_apply, + fderiv_inner_apply (𝕜 := ℝ) hd hd, ← Time.deriv_eq] + simp [inner_smul_right, real_inner_comm] + ring + +/-- The rate of change of the potential energy is the velocity paired with the gradient of the + potential. -/ +lemma potentialEnergy_deriv (r : Time → EuclideanSpace ℝ (Fin 1)) (hr : Differentiable ℝ r) : + ∂ₜ (fun t => S.potentialEnergy (r t)) = + fun t => ⟪∂ₜ r t, gradient S.potentialEnergy (r t)⟫_ℝ := by + funext t + have hf : HasFDerivAt (fun t => S.potentialEnergy (r t)) _ t := + (S.differentiable_potentialEnergy (r t)).hasFDerivAt.comp t (hr t).hasFDerivAt + rw [Time.deriv_eq, hf.fderiv] + simp [Time.deriv_eq] + +/-- The rate of change of the energy is the velocity paired with the sum of `m r̈` and the + gradient of the potential; the equation of motion is exactly the vanishing of that sum. -/ +lemma energy_deriv (r : Time → EuclideanSpace ℝ (Fin 1)) (hr : Differentiable ℝ r) + (hr' : Differentiable ℝ (∂ₜ r)) : + ∂ₜ (S.energy r) = + fun t => ⟪∂ₜ r t, S.m • ∂ₜ (∂ₜ r) t + gradient S.potentialEnergy (r t)⟫_ℝ := by + unfold energy + funext t + rw [Time.deriv_eq, fderiv_fun_add (S.kineticEnergy_differentiable r hr' t) + (S.potentialEnergy_differentiable r hr t)] + simp only [_root_.add_apply, ← Time.deriv_eq, S.kineticEnergy_deriv r hr', + S.potentialEnergy_deriv r hr, ← inner_add_right] + +/-! + +## D. The Lagrangian + +The Lagrangian `L = ½ m ṙ² + m g h(r)` is a function on phase space. Unlike those of the +harmonic oscillator and the pendulum it is only `C¹`; its partial gradients still exist, and +are the force of section E and the momentum `m ṙ`. + +-/ + +set_option linter.unusedVariables false in +/-- The Lagrangian of the particle on the dome, `L(t, r, ṙ) = ½ m ‖ṙ‖² - V(r)`, the kinetic + energy minus the potential energy as a function on phase space. It does not depend on the + time. -/ +@[nolint unusedArguments] +noncomputable def lagrangian (t : Time) (x v : EuclideanSpace ℝ (Fin 1)) : ℝ := + (1 / (2 : ℝ)) * S.m * ⟪v, v⟫_ℝ - S.potentialEnergy x + +/-- Along a curve of the arc length the Lagrangian of the particle on the dome is the kinetic + energy minus the potential energy. -/ +lemma lagrangian_eq_kineticEnergy_sub_potentialEnergy (t : Time) + (r : Time → EuclideanSpace ℝ (Fin 1)) : + S.lagrangian t (r t) (∂ₜ r t) = S.kineticEnergy r t - S.potentialEnergy (r t) := rfl + +/-- The gradient of the Lagrangian of the particle on the dome in the arc length is minus the + gradient of the potential energy, `m √r` times the unit vector of the arc-length + coordinate. -/ +lemma gradient_lagrangian_position_eq (t : Time) (x v : EuclideanSpace ℝ (Fin 1)) : + gradient (fun x => S.lagrangian t x v) x = (S.m * √(x 0)) • EuclideanSpace.single 0 1 := by + have h : (fun y : EuclideanSpace ℝ (Fin 1) => S.lagrangian t y v) = + fun y => (-1 : ℝ) * S.potentialEnergy y + (1 / (2 : ℝ)) * S.m * ⟪v, v⟫_ℝ := by + funext y + rw [lagrangian] + ring + rw [h, gradient_add_const, gradient_const_mul _ (S.differentiable_potentialEnergy x), + gradient_potentialEnergy] + module + +/-- The gradient of the Lagrangian of the particle on the dome in the velocity is the momentum + `m ṙ`. -/ +lemma gradient_lagrangian_velocity_eq (t : Time) (x v : EuclideanSpace ℝ (Fin 1)) : + gradient (S.lagrangian t x) v = S.m • v := by + have h : S.lagrangian t x = fun y : EuclideanSpace ℝ (Fin 1) => + ((1 / (2 : ℝ)) * S.m) * ⟪y, y⟫_ℝ + -S.potentialEnergy x := by + funext y + rw [lagrangian] + ring + rw [h, gradient_add_const, gradient_const_mul_inner_self] + module + +/-! + +## E. The force and the equation of motion + +Gravity exerts the generalized force `m √r` conjugate to the arc length, balanced against +`m r̈`. As for the pendulum this pointwise relation is the definition of the equation of +motion; the variational derivative of the action is not available, the Lagrangian not being +smooth. + +-/ + +/-! + +### E.1. The force + +-/ + +/-- The generalized force on the particle on the dome conjugate to the arc length, minus the + gradient of the potential energy, `F = -∂V/∂r`. -/ +noncomputable def force (x : EuclideanSpace ℝ (Fin 1)) : EuclideanSpace ℝ (Fin 1) := + -gradient S.potentialEnergy x + +/-- The force on the particle on the dome is `m √r` times the unit vector of the arc-length + coordinate: it points away from the apex, and vanishes there. -/ +lemma force_eq (x : EuclideanSpace ℝ (Fin 1)) : + S.force x = (S.m * √(x 0)) • EuclideanSpace.single 0 1 := by + rw [force, gradient_potentialEnergy, neg_smul, neg_neg] + +/-- The single component of the force on the particle on the dome is `m √r`. -/ +lemma force_apply (x : EuclideanSpace ℝ (Fin 1)) : S.force x 0 = S.m * √(x 0) := by + rw [force_eq] + simp + +/-- The force on the particle on the dome vanishes at the apex. -/ +lemma force_zero : S.force 0 = 0 := by + rw [force_eq] + simp + +/-! + +### E.2. Regularity of the force + +The force is continuous. It is not Lipschitz on any closed ball about the apex, since the square +root is not Lipschitz on any `[0, ε]`: the Picard–Lindelöf hypothesis fails, which is the +source of the non-uniqueness. + +-/ + +/-- The force on the particle on the dome is a continuous function of the arc length. -/ +@[fun_prop] +lemma force_continuous : Continuous S.force := by + have h : S.force = fun x => (S.m * √(x 0)) • EuclideanSpace.single 0 1 := funext S.force_eq + rw [h] + fun_prop + +/-- The distance between two multiples of the unit vector of the arc-length coordinate is the + distance between the coefficients. -/ +lemma dist_smul_single (a b : ℝ) : + dist (a • EuclideanSpace.single (0 : Fin 1) (1 : ℝ)) (b • EuclideanSpace.single 0 1) = + |a - b| := by + rw [dist_eq_norm, ← sub_smul, norm_smul, PiLp.norm_single, norm_one, mul_one, + Real.norm_eq_abs] + +/-- The force on the particle on the dome is not Lipschitz on any closed ball about the apex, + for any Lipschitz constant. -/ +lemma not_lipschitzOnWith_force (K : NNReal) {ε : ℝ} (hε : 0 < ε) : + ¬ LipschitzOnWith K S.force (Metric.closedBall 0 ε) := by + intro h + refine not_lipschitzOnWith_sqrt ⟨(K : ℝ) / S.m, div_nonneg K.2 S.m_pos.le⟩ hε ?_ + refine LipschitzOnWith.of_dist_le_mul fun y hy z hz => ?_ + have hmem : ∀ w ∈ Set.Icc (0 : ℝ) ε, + w • EuclideanSpace.single (0 : Fin 1) (1 : ℝ) ∈ Metric.closedBall 0 ε := by + intro w hw + rw [Metric.mem_closedBall, dist_zero_right, norm_smul, PiLp.norm_single, norm_one, + mul_one, Real.norm_eq_abs, abs_of_nonneg hw.1] + exact hw.2 + have := h.dist_le_mul _ (hmem y hy) _ (hmem z hz) + rw [force_eq, force_eq, dist_smul_single, dist_smul_single] at this + simp only [PiLp.smul_apply, PiLp.single_apply, if_true, smul_eq_mul, mul_one, + ← mul_sub, abs_mul, abs_of_pos S.m_pos] at this + show dist √y √z ≤ (K : ℝ) / S.m * dist y z + rw [Real.dist_eq, Real.dist_eq, div_mul_eq_mul_div, le_div_iff₀ S.m_pos, mul_comm] + exact this + +/-! + +### E.3. The equation of motion + +-/ + +/-- The equation of motion of the particle on the dome: at every instant `m r̈` equals the + generalized force `F(r) = m √r`. This pointwise relation is the definition; for curves with + differentiable velocity it is the vanishing of the Euler–Lagrange operator of the Lagrangian, + `equationOfMotion_iff_eulerLagrangeOp_zero`. -/ +def EquationOfMotion (r : Time → EuclideanSpace ℝ (Fin 1)) : Prop := + ∀ t, S.m • ∂ₜ (∂ₜ r) t = S.force (r t) + +/-- The equation of motion with all terms on one side: at every instant `m r̈` plus the + gradient of the potential energy vanishes. This is the combination `energy_deriv` pairs with + the velocity. -/ +lemma equationOfMotion_iff_newtons_2nd_law (r : Time → EuclideanSpace ℝ (Fin 1)) : + S.EquationOfMotion r ↔ + ∀ t, S.m • ∂ₜ (∂ₜ r) t + gradient S.potentialEnergy (r t) = 0 := by + simp only [EquationOfMotion, force, eq_neg_iff_add_eq_zero] + +/-- The equation of motion of the particle on the dome in scalar form, `r̈ = √r`. Both the mass + and the gravitational acceleration have cancelled. -/ +lemma equationOfMotion_iff_scalar (r : Time → EuclideanSpace ℝ (Fin 1)) : + S.EquationOfMotion r ↔ ∀ t, ∂ₜ (∂ₜ r) t 0 = √(r t 0) := by + simp only [EquationOfMotion] + refine forall_congr' fun t => ?_ + rw [force_eq] + constructor + · intro h + have := congrArg (fun y : EuclideanSpace ℝ (Fin 1) => y 0) h + simpa [S.m_ne_zero] using this + · intro h + ext i + fin_cases i + simp [h] + +/-! + +### E.4. Solutions + +A solution is a twice differentiable curve, position and velocity both differentiable, satisfying +the equation of motion: the regularity of `ClassicalMechanics.ReferenceFrame.Particle` and the +least under which the acceleration exists. Regularity is part of the definition because the bare +pointwise equation, whose derivatives are zero wherever they do not exist, admits rough accidental +solutions. Smoothness is not demanded: the motions leaving the apex are `C³` but not `C⁴`. + +-/ + +/-- A solution of the dome is a twice differentiable curve of the arc length, its position and + velocity both differentiable, satisfying the equation of motion. -/ +def IsSolution (r : Time → EuclideanSpace ℝ (Fin 1)) : Prop := + Differentiable ℝ r ∧ Differentiable ℝ (∂ₜ r) ∧ S.EquationOfMotion r + +/-- The position along a solution of the dome is differentiable. -/ +lemma IsSolution.differentiable {S : NortonDome} {r : Time → EuclideanSpace ℝ (Fin 1)} + (h : S.IsSolution r) : Differentiable ℝ r := h.1 + +/-- The velocity along a solution of the dome is differentiable. -/ +lemma IsSolution.deriv_differentiable {S : NortonDome} {r : Time → EuclideanSpace ℝ (Fin 1)} + (h : S.IsSolution r) : Differentiable ℝ (∂ₜ r) := h.2.1 + +/-- A solution of the dome satisfies the equation of motion. -/ +lemma IsSolution.equationOfMotion {S : NortonDome} {r : Time → EuclideanSpace ℝ (Fin 1)} + (h : S.IsSolution r) : S.EquationOfMotion r := h.2.2 + +/-! + +## F. The Euler–Lagrange operator + +With the gradients of section D, the pointwise Euler–Lagrange operator along any curve with +differentiable velocity is the force minus `m r̈`, so its vanishing is the equation of motion. +The identification of this operator with the variational derivative of the action, +`euler_lagrange_varGradient`, needs a smooth Lagrangian and so does not apply to the dome. + +-/ + +/-- Along a curve of the arc length with differentiable velocity the Euler–Lagrange operator of + the Lagrangian of the dome is the force minus `m r̈`. -/ +lemma eulerLagrangeOp_lagrangian (r : Time → EuclideanSpace ℝ (Fin 1)) + (hr' : Differentiable ℝ (∂ₜ r)) : + eulerLagrangeOp S.lagrangian r = fun t => S.force (r t) - S.m • ∂ₜ (∂ₜ r) t := by + funext t + rw [eulerLagrangeOp] + simp [S.gradient_lagrangian_position_eq, S.gradient_lagrangian_velocity_eq, S.force_eq, + Time.deriv_smul _ S.m hr'] + +/-- For a curve of the arc length with differentiable velocity the equation of motion of the + dome holds if and only if the Euler–Lagrange operator of its Lagrangian vanishes along it. -/ +lemma equationOfMotion_iff_eulerLagrangeOp_zero (r : Time → EuclideanSpace ℝ (Fin 1)) + (hr' : Differentiable ℝ (∂ₜ r)) : + S.EquationOfMotion r ↔ eulerLagrangeOp S.lagrangian r = 0 := by + rw [S.eulerLagrangeOp_lagrangian r hr', funext_iff] + simp only [EquationOfMotion, Pi.zero_apply, sub_eq_zero] + exact forall_congr' fun t => eq_comm + +/-! + +## G. Energy conservation + +Along any twice differentiable curve satisfying the equation of motion the energy is constant. +This follows from `energy_deriv`. Conservation of energy does not restore uniqueness: the motion +at rest at the apex and every motion leaving it all have zero energy, which is proved in +`NortonDome.Solution` as `energy_rest` and `energy_solution`. + +-/ + +/-- Along a twice differentiable curve of the arc length satisfying the equation of motion the + time derivative of the energy of the dome vanishes. -/ +lemma energy_conservation_of_equationOfMotion (r : Time → EuclideanSpace ℝ (Fin 1)) + (hr : Differentiable ℝ r) (hr' : Differentiable ℝ (∂ₜ r)) (h : S.EquationOfMotion r) : + ∂ₜ (S.energy r) = 0 := by + rw [S.equationOfMotion_iff_newtons_2nd_law r] at h + funext t + rw [S.energy_deriv r hr hr'] + simp [h t] + +/-- Along a twice differentiable curve of the arc length satisfying the equation of motion the + energy of the dome at any time is equal to its initial value. -/ +lemma energy_conservation_of_equationOfMotion' (r : Time → EuclideanSpace ℝ (Fin 1)) + (hr : Differentiable ℝ r) (hr' : Differentiable ℝ (∂ₜ r)) (h : S.EquationOfMotion r) + (t : Time) : S.energy r t = S.energy r 0 := by + apply is_const_of_fderiv_eq_zero (𝕜 := ℝ) (S.energy_differentiable r hr hr') + intro t + ext p + rw [p.eq_one_smul, map_smul, ← Time.deriv_eq, + S.energy_conservation_of_equationOfMotion r hr hr' h] + simp + +/-- The energy of the dome along a solution at any time is equal to its initial value. -/ +lemma IsSolution.energy_eq {S : NortonDome} {r : Time → EuclideanSpace ℝ (Fin 1)} + (h : S.IsSolution r) (t : Time) : S.energy r t = S.energy r 0 := + S.energy_conservation_of_equationOfMotion' r h.differentiable h.deriv_differentiable + h.equationOfMotion t + +end NortonDome + +end ClassicalMechanics + +end diff --git a/PhyslibAlpha/ClassicalMechanics/NortonDome/Determinism.lean b/PhyslibAlpha/ClassicalMechanics/NortonDome/Determinism.lean new file mode 100644 index 0000000000..d72095037e --- /dev/null +++ b/PhyslibAlpha/ClassicalMechanics/NortonDome/Determinism.lean @@ -0,0 +1,207 @@ +/- +Copyright (c) 2026 Zhi Kai Pong. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Zhi Kai Pong +-/ +module + +public import PhyslibAlpha.ClassicalMechanics.NortonDome.NewtonianSystem +public import PhyslibAlpha.ClassicalMechanics.NortonDome.Solution +/-! + +# The Norton dome and the determinism of Newtonian mechanics + +## i. Overview + +A particle at rest on the apex of the Norton dome may stay there forever or slide off at any +instant, in obedience to Newton's second law with a continuous force. This file states what +that does and does not show, in the terms of `NortonDome.NewtonianSystem`. + +The dome is such a system (`toNewtonianSystem`). It is not deterministic +(`not_isDeterministic`) and it violates the first law (`not_satisfiesFirstLaw`). Since a locally +Lipschitz force gives determinism, the dome must fail that hypothesis and everything implying +it, and it does (`not_hasLocallyLipschitzForce`, `not_hasLipschitzForce`, `not_hasC2Potential`). +Its force `m √r` is continuous but has infinite slope at the apex, and its potential is `C¹` +but not `C²`. + +Put together, this is `exists_continuous_force_not_isDeterministic`: a continuous force does +not make a Newtonian system deterministic, while a locally Lipschitz force, or a `C²` +potential, does. Newton's laws do not say which requirement, if any, belongs in the definition +of a Newtonian system. The theorems say what each requirement buys and that the dome is what +each excludes, and leave the choice open. Malament's proposal, a regularity condition on the +constraint surface in physical space rather than on the potential, is not formulated here. With +Peano's theorem, whose proof is pending in Mathlib, the dome has solutions from every initial +datum (`hasLocalSolutions`), so its failure is one of uniqueness alone. + +## ii. Key results + +- `NortonDome.not_isDeterministic`: the dome is not deterministic. +- `NortonDome.not_satisfiesFirstLaw`: the dome violates the first law. +- `NortonDome.exists_continuous_force_not_isDeterministic`: Norton's claim, a Newtonian + system with a continuous force that is not deterministic. +- `NortonDome.not_hasLocallyLipschitzForce`, `NortonDome.not_hasLipschitzForce` and + `NortonDome.not_hasC2Potential`: the dome satisfies none of the regularity conditions. +- `NortonDome.toNewtonianSystem` is the dome as a Newtonian system, with + `toNewtonianSystem_force`, `toNewtonianSystem_equationOfMotion_iff` and + `toNewtonianSystem_isSolution_iff` identifying its force, equation of motion and solutions + with those of `NortonDome.Basic`. +- `NortonDome.hasLocalSolutions` and `NortonDome.exists_hasLocalSolutions_not_isDeterministic`: + the dome has local solutions from every initial datum, by Peano's theorem, so its failure of + determinism is a failure of uniqueness alone (pending the upstream proof). + +## iii. Table of contents + +- A. The dome as a Newtonian system +- B. The properties the dome fails + - B.1. Determinism and the first law + - B.2. The regularity conditions +- C. Norton's claim +- D. Existence without uniqueness + +## iv. References + +- Norton, J. D., *The dome: an unexpectedly simple failure of determinism*, Philosophy of + Science 75 (2008), 786–798. +- Malament, D. B., *Norton's slippery slope*, Philosophy of Science 75 (2008), 799–816. + +-/ + +@[expose] public section + +namespace ClassicalMechanics.NortonDome +open Real InnerProductSpace Time + +variable (S : NortonDome) + +/-! + +## A. The dome as a Newtonian system + +The dome has a differentiable potential, so it is a Newtonian system whose force, equation of +motion and solutions are by definition those of `NortonDome.Basic`. + +-/ + +/-- The Norton dome as a conservative Newtonian system on the Euclidean lift of the arc + length. -/ +noncomputable def toNewtonianSystem : NewtonianSystem (EuclideanSpace ℝ (Fin 1)) where + m := S.m + potential := S.potentialEnergy + m_pos := S.m_pos + potential_differentiable := S.differentiable_potentialEnergy + +/-- The force of the dome as a Newtonian system is its force. -/ +lemma toNewtonianSystem_force : S.toNewtonianSystem.force = S.force := rfl + +/-- The equation of motion of the dome as a Newtonian system is its equation of motion. -/ +lemma toNewtonianSystem_equationOfMotion_iff (r : Time → EuclideanSpace ℝ (Fin 1)) : + S.toNewtonianSystem.EquationOfMotion r ↔ S.EquationOfMotion r := Iff.rfl + +/-- The solutions of the dome as a Newtonian system are its solutions. -/ +lemma toNewtonianSystem_isSolution_iff (r : Time → EuclideanSpace ℝ (Fin 1)) : + S.toNewtonianSystem.IsSolution r ↔ S.IsSolution r := Iff.rfl + +/-! + +## B. The properties the dome fails + +-/ + +/-! + +### B.1. Determinism and the first law + +Determinism fails by the non-uniqueness proved in `NortonDome.Solution`. The first law fails +along the motion leaving the apex at the instant `1`: at the instant `0` it is at rest at the +apex, where the force vanishes, and at the instant `2` it is off the apex. + +-/ + +/-- The Norton dome is not deterministic. -/ +lemma not_isDeterministic : ¬ S.toNewtonianSystem.IsDeterministic := by + intro h + obtain ⟨x, y, hx, hy, h0, hv, hne⟩ := S.exists_isSolution_ne + exact hne (h x y hx hy 0 h0 hv) + +/-- The Norton dome violates Newton's first law, read as a statement about intervals of time: + a particle at rest at the apex, where the force vanishes, need not stay there. -/ +lemma not_satisfiesFirstLaw : ¬ S.toNewtonianSystem.SatisfiesFirstLaw := by + intro h + have h2 := h (solution 1) (S.solution_isSolution 1) 0 + (by rw [toNewtonianSystem_force, solution_zero zero_le_one, force_zero]) + (deriv_solution_zero zero_le_one) ((2 : ℝ) : Time) + have hpos := solution_apply_pos 1 (t := ((2 : ℝ) : Time)) (by rw [Time.realCast_val]; norm_num) + rw [h2, solution_zero zero_le_one] at hpos + simp at hpos + +/-! + +### B.2. The regularity conditions + +The force is not Lipschitz on any closed ball about the apex, `not_lipschitzOnWith_force`, +hence not locally Lipschitz; the two stronger conditions imply a locally Lipschitz force, so +they fail too. + +-/ + +/-- The force of the Norton dome is not locally Lipschitz: it is not Lipschitz on any + neighbourhood of the apex. -/ +lemma not_hasLocallyLipschitzForce : ¬ S.toNewtonianSystem.HasLocallyLipschitzForce := by + intro h + obtain ⟨K, t, ht, hKt⟩ := h 0 + obtain ⟨ε, hε, hball⟩ := Metric.mem_nhds_iff.mp ht + exact S.not_lipschitzOnWith_force K (half_pos hε) + (hKt.mono ((Metric.closedBall_subset_ball (by linarith)).trans hball)) + +/-- The force of the Norton dome is not Lipschitz. -/ +lemma not_hasLipschitzForce : ¬ S.toNewtonianSystem.HasLipschitzForce := + fun h => S.not_hasLocallyLipschitzForce h.hasLocallyLipschitzForce + +/-- The potential of the Norton dome is not `C²`. -/ +lemma not_hasC2Potential : ¬ S.toNewtonianSystem.HasC2Potential := + fun h => S.not_hasLocallyLipschitzForce h.hasLocallyLipschitzForce + +/-! + +## C. Norton's claim + +-/ + +/-- Norton's claim: there is a conservative Newtonian system, with a continuous force, + which is not deterministic. The witness is the dome with unit mass and unit gravitational + acceleration. -/ +lemma exists_continuous_force_not_isDeterministic : + ∃ N : NewtonianSystem (EuclideanSpace ℝ (Fin 1)), Continuous N.force ∧ ¬ N.IsDeterministic := + ⟨(⟨1, 1, one_pos, one_pos⟩ : NortonDome).toNewtonianSystem, force_continuous _, + not_isDeterministic _⟩ + +/-! + +## D. Existence without uniqueness + +The force is continuous and the configuration space is finite-dimensional, so by Peano's +theorem, `NewtonianSystem.hasLocalSolutions_of_continuous_force`, every initial datum has a +local solution: the failure of determinism is purely one of uniqueness. Pending the proof of +Peano's theorem in Mathlib, these results are marked `@[sorryful]`. + +-/ + +/-- The Norton dome has local solutions from every initial position and velocity. Pending the + proof of Peano's theorem in Mathlib. -/ +@[sorryful] +lemma hasLocalSolutions : S.toNewtonianSystem.HasLocalSolutions := + NewtonianSystem.hasLocalSolutions_of_continuous_force _ S.force_continuous + +/-- Norton's claim, sharpened: there is a Newtonian system with a continuous force which has + local solutions from every initial datum and is not deterministic. Pending the proof of + Peano's theorem in Mathlib. -/ +@[sorryful] +lemma exists_hasLocalSolutions_not_isDeterministic : + ∃ N : NewtonianSystem (EuclideanSpace ℝ (Fin 1)), + Continuous N.force ∧ N.HasLocalSolutions ∧ ¬ N.IsDeterministic := + ⟨(⟨1, 1, one_pos, one_pos⟩ : NortonDome).toNewtonianSystem, force_continuous _, + hasLocalSolutions _, not_isDeterministic _⟩ + +end ClassicalMechanics.NortonDome + +end diff --git a/PhyslibAlpha/ClassicalMechanics/NortonDome/NewtonianSystem.lean b/PhyslibAlpha/ClassicalMechanics/NortonDome/NewtonianSystem.lean new file mode 100644 index 0000000000..3717f8d651 --- /dev/null +++ b/PhyslibAlpha/ClassicalMechanics/NortonDome/NewtonianSystem.lean @@ -0,0 +1,607 @@ +/- +Copyright (c) 2026 Zhi Kai Pong. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Zhi Kai Pong +-/ +module + +public import Mathlib.Analysis.ODE.ExistUnique +public import Physlib.Mathematics.Calculus.Gradient +public import PhyslibAlpha.ClassicalMechanics.NortonDome.PeanoExistence +public import Physlib.SpaceAndTime.Time.Derivatives +/-! + +# Conservative Newtonian systems and determinism + +## i. Overview + +A conservative Newtonian system is a point mass `m` in a configuration space `X` under a +potential `V`, with equation of motion `m r̈ = -∇V(r)`. Physics takes for granted that position +and velocity at one instant fix the motion at all instants. This file makes that a theorem and +states what it costs. + +The main result is `NewtonianSystem.isDeterministic_of_hasLocallyLipschitzForce`: if the force +is locally Lipschitz, two solutions with the same position and velocity at one instant coincide +at every instant; in the form usually quoted, +`NewtonianSystem.isDeterministic_of_hasC2Potential`, a `C²` potential suffices. Continuity of +the force is not enough: the Norton dome has a continuous force and a `C¹` potential, and a +particle at rest on its apex may stay or leave at any time (see `NortonDome.Determinism`). + +The `NewtonianSystem` defined here asks only for a differentiable potential, the least under +which the equation of motion makes sense. Newton's laws, as stated, are silent on how regular +the force must be, and the dome shows that without some regularity the equation does not +determine the motion. A definition that is to be deterministic must add something the laws do +not state, a regularity condition on the force or a restriction on the admissible motions; +whether that is part of the theory or a choice about it is debated. Each candidate condition is +a separate predicate, so that what it buys is a theorem, and the file takes no side. The +predicates are: + +- `IsDeterministic`: position and velocity at one instant fix the solution. +- `SatisfiesFirstLaw`: a body at rest where the force vanishes stays at rest. It follows from + determinism and is the form of the first law the dome violates. The interval reading follows + from the second law for every system (`IsSolution.deriv_eq_of_force_eq_zero_on`, section B.3). +- `HasLocallyLipschitzForce`: the hypothesis of the ODE uniqueness theorem. `HasLipschitzForce` + and `HasC2Potential` are the stronger conditions usually assumed; each implies it and neither + implies the other. +- `HasLocalSolutions`: existence, kept separate. For a continuous force on a finite-dimensional + configuration space it follows from Peano's theorem, whose proof is pending in Mathlib; + section E derives it from the statement in `NortonDome.PeanoExistence`, marked `@[sorryful]`. + +The proof of determinism turns the equation of motion into the first-order system +`(r, v)' = (v, F(r)/m)` on `X × X`, applies Mathlib's local uniqueness theorem for integral +curves, and extends to all time by connectedness of the real line. So continuity buys +existence and local Lipschitz continuity buys uniqueness; the file records what each condition +does, not which one is right. + +## ii. Key results + +- `NewtonianSystem.isDeterministic_of_hasLocallyLipschitzForce`: a locally Lipschitz force + gives determinism, hence `NewtonianSystem.satisfiesFirstLaw_of_hasLocallyLipschitzForce` + the first law. `NewtonianSystem.isDeterministic_of_hasC2Potential` and + `NewtonianSystem.isDeterministic_of_hasLipschitzForce` are the forms usually quoted; the + chain of implications is drawn in section D.3. +- `NewtonianSystem.ODE_solution_unique_of_locallyLipschitz`: integral curves of a locally + Lipschitz vector field through a common point coincide for all time. +- `NewtonianSystem`, `NewtonianSystem.force`, `NewtonianSystem.EquationOfMotion` and + `NewtonianSystem.IsSolution`: the system, the force `-∇V`, Newton's second law, and its + twice differentiable solutions; `NewtonianSystem.isSolution_const` is rest at an + equilibrium. +- `NewtonianSystem.IsSolution.deriv_eq_of_force_eq_zero_on`: the first law read on an + interval, a consequence of the second law for every system. +- `NewtonianSystem.IsDeterministic`, `NewtonianSystem.SatisfiesFirstLaw`, + `NewtonianSystem.HasLocallyLipschitzForce`, `NewtonianSystem.HasLipschitzForce` and + `NewtonianSystem.HasC2Potential`: the predicates, with + `NewtonianSystem.HasLipschitzForce.hasLocallyLipschitzForce` and + `NewtonianSystem.HasC2Potential.hasLocallyLipschitzForce`. +- `NewtonianSystem.HasLocalSolutions` and `NewtonianSystem.hasLocalSolutions_of_continuous_force`: + Peano's theorem for Newtonian systems, a continuous force on a finite-dimensional + configuration space gives local solutions (pending the upstream proof). + +## iii. Table of contents + +- A. Conservative Newtonian systems + - A.1. The structure + - A.2. The force and the equation of motion + - A.3. Solutions +- B. Determinism and the first law + - B.1. The properties + - B.2. Determinism implies the first law + - B.3. The interval reading of the first law +- C. Regularity conditions +- D. A locally Lipschitz force gives determinism + - D.1. The phase-space vector field + - D.2. The phase curve of a solution + - D.3. The uniqueness theorem +- E. A continuous force gives local solutions + - E.1. Local existence + - E.2. The hypotheses of Peano's theorem + - E.3. The existence theorem + +## iv. References + +- Earman, J., *A Primer on Determinism*, Reidel (1986). +- Laplace, P.-S., *Essai philosophique sur les probabilités* (1814). +- Montague, R., *Deterministic theories*, in *Formal Philosophy*, Yale University Press (1974). +- Norton, J. D., *The dome: an unexpectedly simple failure of determinism*, Philosophy of + Science 75 (2008), 786–798. +- `Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Solution` (the same uniqueness argument + for the pendulum). + +-/ + +@[expose] public section + +namespace ClassicalMechanics +open Time + +variable {X : Type} [NormedAddCommGroup X] [InnerProductSpace ℝ X] [CompleteSpace X] + +/-! + +## A. Conservative Newtonian systems + +-/ + +/-! + +### A.1. The structure + +The potential is asked to be differentiable and no more, so that the force `-∇V` exists and the +equation of motion can be written pointwise; further regularity is added in section C. Physlib's +general notion is `ClassicalMechanics.PointParticle.NewtonianSystem`, finitely many particles +with explicit forces in a reference frame. The structure here is a single mass in a potential, +which is all the dome needs; the two live in different namespaces and no file opens both. + +-/ + +/-- A conservative Newtonian system on the configuration space `X`: a point mass `m` in a + differentiable potential `V`. Its equation of motion is Newton's second law `m r̈ = -∇V(r)`. -/ +structure NewtonianSystem (X : Type) [NormedAddCommGroup X] [InnerProductSpace ℝ X] + [CompleteSpace X] where + /-- The mass. -/ + m : ℝ + /-- The potential. -/ + potential : X → ℝ + m_pos : 0 < m + potential_differentiable : Differentiable ℝ potential + +namespace NewtonianSystem + +variable (S : NewtonianSystem X) + +/-- The mass of a Newtonian system is not equal to zero. -/ +@[simp] +lemma m_ne_zero : S.m ≠ 0 := S.m_pos.ne' + +/-! + +### A.2. The force and the equation of motion + +-/ + +/-- The force of a Newtonian system, minus the gradient of the potential. -/ +noncomputable def force (x : X) : X := -gradient S.potential x + +/-- Newton's second law for a Newtonian system: at every instant `m r̈` equals the force at + the position. -/ +def EquationOfMotion (r : Time → X) : Prop := + ∀ t, S.m • ∂ₜ (∂ₜ r) t = S.force (r t) + +/-! + +### A.3. Solutions + +A solution is a twice differentiable curve, position and velocity both differentiable, satisfying +the equation of motion: the regularity of `ClassicalMechanics.ReferenceFrame.Particle` and the +least under which the acceleration exists. It is demanded because the pointwise equation, whose +derivatives are zero wherever they do not exist, admits rough accidental solutions. Continuity of +the acceleration is not demanded; for a continuous force it is automatic. + +-/ + +/-- A solution of a Newtonian system is a twice differentiable curve, its position and velocity + both differentiable, satisfying the equation of motion. -/ +def IsSolution (r : Time → X) : Prop := + Differentiable ℝ r ∧ Differentiable ℝ (∂ₜ r) ∧ S.EquationOfMotion r + +/-- The position along a solution is differentiable. -/ +lemma IsSolution.differentiable {S : NewtonianSystem X} {r : Time → X} (h : S.IsSolution r) : + Differentiable ℝ r := h.1 + +/-- The velocity along a solution is differentiable. -/ +lemma IsSolution.deriv_differentiable {S : NewtonianSystem X} {r : Time → X} + (h : S.IsSolution r) : Differentiable ℝ (∂ₜ r) := h.2.1 + +/-- A solution satisfies the equation of motion. -/ +lemma IsSolution.equationOfMotion {S : NewtonianSystem X} {r : Time → X} + (h : S.IsSolution r) : S.EquationOfMotion r := h.2.2 + +/-- The curve at rest at a point where the force vanishes is a solution. -/ +lemma isSolution_const {x : X} (hx : S.force x = 0) : S.IsSolution (fun _ => x) := by + have h : ∂ₜ (fun _ : Time => x) = fun _ => 0 := funext fun t => Time.deriv_const x + refine ⟨differentiable_const x, by rw [h]; exact differentiable_const 0, fun t => ?_⟩ + rw [h, Time.deriv_const, hx, smul_zero] + +/-! + +## B. Determinism and the first law + +-/ + +/-! + +### B.1. The properties + +Determinism is the statement that position and velocity at one instant fix the motion at all +instants. The first law, in the reading that says more than the second law, is the statement +that a body at rest where no force acts stays at rest; section B.3 compares the readings. Both +are properties of the system, not of a motion. + +The definition of determinism is the naive one. Laplace's formulation is about knowledge; the +notion used since Montague and Earman is about models, a theory being deterministic if any two +models agreeing at one instant agree at every instant. `IsDeterministic` is that notion, with +the models taken to be the twice differentiable solutions of one system, defined for all time, +and the state taken to be position and velocity. Four things follow. + +- It is a property of one system. That Newtonian mechanics is deterministic is a claim about + every system in some class, and which class is what this folder is about. +- It is uniqueness only. A system with no solution from some initial datum, or with solutions + not defined for all time, counts as deterministic here, whereas on Earman's account such + failures of existence count against determinism. Existence is kept separate, as + `HasLocalSolutions`. +- It is relative to the class of solutions. Demanding smooth or analytic solutions would + exclude the departing motions of the dome, which vanish on a half-line and are not `C⁴`, and + so restore uniqueness by fiat. +- It does not distinguish future from past. The time-reversed motions of the dome arrive at + rest on the apex and stay, so the state there fixes neither past nor future; Earman's + futuristic and historical determinism both fail. + +-/ + +/-- A Newtonian system is deterministic if any two solutions with the same position and + velocity at some instant coincide. This is uniqueness of twice differentiable solutions + defined for all time, in both directions of time and without existence; see section B.1. -/ +def IsDeterministic : Prop := + ∀ x y : Time → X, S.IsSolution x → S.IsSolution y → + ∀ t₀, x t₀ = y t₀ → ∂ₜ x t₀ = ∂ₜ y t₀ → x = y + +/-- A Newtonian system satisfies the first law if a solution at rest, at some instant, at a + point where the force vanishes stays at that point at all instants. -/ +def SatisfiesFirstLaw : Prop := + ∀ r : Time → X, S.IsSolution r → ∀ t₀, S.force (r t₀) = 0 → ∂ₜ r t₀ = 0 → ∀ t, r t = r t₀ + +/-! + +### B.2. Determinism implies the first law + +The curve staying at the equilibrium is a solution with the same position and velocity as the +given one at the given instant, so by determinism it is the given one. + +-/ + +/-- A deterministic Newtonian system satisfies the first law. -/ +lemma IsDeterministic.satisfiesFirstLaw {S : NewtonianSystem X} (h : S.IsDeterministic) : + S.SatisfiesFirstLaw := by + intro r hr t₀ hF hv t + have hc := S.isSolution_const hF + have heq := h r (fun _ => r t₀) hr hc t₀ rfl (by rw [hv, Time.deriv_const]) + exact congrFun heq t + +/-! + +### B.3. The interval reading of the first law + +The first law can be read instantaneously (no force at an instant, no acceleration then), with +an interval in the hypothesis (no force on an interval, constant velocity on it), or with an +interval in the conclusion (at rest at an instant where no force acts, at rest forever). The +first two follow from the second law for every system, the second being the lemma below, and +both hold for the dome. The third, `SatisfiesFirstLaw`, is determinism at an equilibrium; it is +what the dome violates and what Norton's argument is about, so it is the reading taken here. + +-/ + +/-- The first law read on an interval: if the force vanishes along a solution throughout the + interval `[a, b]`, the velocity is constant on it. This is a consequence of the second law + alone, and holds for every system. -/ +lemma IsSolution.deriv_eq_of_force_eq_zero_on {S : NewtonianSystem X} {r : Time → X} + (hr : S.IsSolution r) {a b : Time} (hF : ∀ t ∈ Set.Icc a b, S.force (r t) = 0) : + ∀ t ∈ Set.Icc a b, ∂ₜ r t = ∂ₜ r a := by + have hv : ∀ τ : ℝ, HasDerivAt (fun τ : ℝ => ∂ₜ r (toRealCLE.symm τ)) + (∂ₜ (∂ₜ r) (toRealCLE.symm τ)) τ := fun τ => + hasDerivAt_comp_toRealCLE_symm (∂ₜ r) τ (hr.deriv_differentiable _) + have hconst := constant_of_has_deriv_right_zero (a := toRealCLE a) (b := toRealCLE b) + (f := fun τ : ℝ => ∂ₜ r (toRealCLE.symm τ)) + (continuous_iff_continuousAt.mpr fun τ => (hv τ).continuousAt).continuousOn + (fun τ hτ => by + have hmem : toRealCLE.symm τ ∈ Set.Icc a b := ⟨hτ.1, hτ.2.le⟩ + have hacc : ∂ₜ (∂ₜ r) (toRealCLE.symm τ) = 0 := by + have h := hr.equationOfMotion (toRealCLE.symm τ) + rw [hF _ hmem] at h + exact (smul_eq_zero.mp h).resolve_left S.m_ne_zero + have h' := hv τ + rw [hacc] at h' + exact h'.hasDerivWithinAt) + intro t ht + simpa using hconst (toRealCLE t) ⟨ht.1, ht.2⟩ + +/-! + +## C. Regularity conditions + +The hypothesis of the ODE uniqueness theorem is a locally Lipschitz force, +`HasLocallyLipschitzForce`. The two stronger conditions usually stated are a globally Lipschitz +force, `HasLipschitzForce`, and a `C²` potential, `HasC2Potential`, whose force is `C¹`. +Neither implies the other: for example, `x ^ 4` has a `C¹` force of unbounded slope, and +`x * |x| / 2` has the Lipschitz force `-|x|` but is not `C²`. The structure `NewtonianSystem` +of section A assumes none of these conditions; they are separate predicates on it. + +-/ + +/-- A Newtonian system has a locally Lipschitz force if its force is Lipschitz on a + neighbourhood of every point. This is the hypothesis of the uniqueness theorem for ordinary + differential equations. -/ +def HasLocallyLipschitzForce : Prop := LocallyLipschitz S.force + +/-- A Newtonian system has a Lipschitz force if its force is globally Lipschitz. -/ +def HasLipschitzForce : Prop := ∃ K : NNReal, LipschitzWith K S.force + +/-- A Newtonian system has a `C²` potential if its potential is twice continuously + differentiable; two derivatives are what the uniqueness theory of ordinary differential + equations uses. -/ +def HasC2Potential : Prop := ContDiff ℝ 2 S.potential + +/-- A Lipschitz force is locally Lipschitz. -/ +lemma HasLipschitzForce.hasLocallyLipschitzForce (h : S.HasLipschitzForce) : + S.HasLocallyLipschitzForce := by + obtain ⟨K, hK⟩ := h + exact hK.locallyLipschitz + +/-- The gradient of a `C²` potential is `C¹`. -/ +lemma HasC2Potential.contDiff_gradient (h : S.HasC2Potential) : + ContDiff ℝ 1 (gradient S.potential) := + (InnerProductSpace.toDual ℝ X).symm.contDiff.comp + ((contDiff_succ_iff_fderiv (n := 1)).mp (by rw [one_add_one_eq_two]; exact h)).2.2 + +/-- The force of a system with a `C²` potential is locally Lipschitz. -/ +lemma HasC2Potential.hasLocallyLipschitzForce (h : S.HasC2Potential) : + S.HasLocallyLipschitzForce := + h.contDiff_gradient.locallyLipschitz.neg + +/-! + +## D. A locally Lipschitz force gives determinism + +The equation of motion becomes the first-order system `(r, v)' = (v, F(r)/m)` on `X × X`. If +the force is locally Lipschitz so is this vector field, and the local uniqueness theorem +`ODE_solution_unique_of_eventually` of Mathlib, with the connectedness of the real line, gives +determinism, as in `SimplePendulum.equationOfMotion_unique`. + +-/ + +/-! + +### D.1. The phase-space vector field + +-/ + +/-- The phase-space vector field of a Newtonian system, sending `(r, v)` to `(v, F(r)/m)`. -/ +noncomputable def phaseVectorField (p : X × X) : X × X := + (p.2, S.m⁻¹ • S.force p.1) + +/-- If the force of a Newtonian system is locally Lipschitz, so is its phase-space vector + field. -/ +lemma phaseVectorField_locallyLipschitz (h : LocallyLipschitz S.force) : + LocallyLipschitz S.phaseVectorField := by + unfold phaseVectorField + exact LipschitzWith.prod_snd.locallyLipschitz.prodMk + ((lipschitzWith_smul S.m⁻¹).locallyLipschitz.comp + (h.comp LipschitzWith.prod_fst.locallyLipschitz)) + +/-! + +### D.2. The phase curve of a solution + +-/ + +/-- The phase curve `τ ↦ (r t, ṙ t)` (with `t = toRealCLE.symm τ`) of a solution is an + integral curve of the phase-space vector field. -/ +lemma phaseCurve_hasDerivAt {r : Time → X} (hr : Differentiable ℝ r) + (hr' : Differentiable ℝ (∂ₜ r)) (h : S.EquationOfMotion r) (τ : ℝ) : + HasDerivAt (fun τ : ℝ => (r (toRealCLE.symm τ), ∂ₜ r (toRealCLE.symm τ))) + (S.phaseVectorField (r (toRealCLE.symm τ), ∂ₜ r (toRealCLE.symm τ))) τ := by + have hacc : ∂ₜ (∂ₜ r) (toRealCLE.symm τ) = S.m⁻¹ • S.force (r (toRealCLE.symm τ)) := by + rw [← h, smul_smul, inv_mul_cancel₀ S.m_ne_zero, one_smul] + rw [phaseVectorField, ← hacc] + exact (hasDerivAt_comp_toRealCLE_symm r τ (hr _)).prodMk + (hasDerivAt_comp_toRealCLE_symm (∂ₜ r) τ (hr' _)) + +/-! + +### D.3. The uniqueness theorem + +Local uniqueness makes the set of instants at which two integral curves through a common point +agree open, continuity makes it closed, and the real line is connected. Applied to the +phase-space vector field this gives the theorem of the file, and sections B, C and D form one +chain, each arrow a theorem: + +``` +HasC2Potential ────┐ + ├──▶ HasLocallyLipschitzForce ──▶ IsDeterministic ──▶ SatisfiesFirstLaw +HasLipschitzForce ─┘ +``` + +Naming follows Mathlib: `isDeterministic_of_hasC2Potential` is the arrow from +`HasC2Potential` to `IsDeterministic`. + +-/ + +/-- Integral curves of a locally Lipschitz vector field, defined at all times, which pass + through the same point at the same instant coincide. -/ +lemma ODE_solution_unique_of_locallyLipschitz {E : Type} [NormedAddCommGroup E] + [NormedSpace ℝ E] {v : E → E} (hv : LocallyLipschitz v) {f g : ℝ → E} + (hf : ∀ τ, HasDerivAt f (v (f τ)) τ) (hg : ∀ τ, HasDerivAt g (v (g τ)) τ) + {τ₀ : ℝ} (h0 : f τ₀ = g τ₀) : f = g := by + have hclosed : IsClosed {τ | f τ = g τ} := + isClosed_eq (continuous_iff_continuousAt.mpr fun τ => (hf τ).continuousAt) + (continuous_iff_continuousAt.mpr fun τ => (hg τ).continuousAt) + have hopen : IsOpen {τ | f τ = g τ} := by + rw [isOpen_iff_mem_nhds] + intro τ₁ hτ₁ + obtain ⟨K, s, hs, hKs⟩ := hv (f τ₁) + have hs' : s ∈ nhds (g τ₁) := by + rw [← show f τ₁ = g τ₁ from hτ₁] + exact hs + refine ODE_solution_unique_of_eventually (v := fun _ => v) (s := fun _ => s) + (Filter.Eventually.of_forall fun _ => hKs) ?_ ?_ hτ₁ + · filter_upwards [(hf τ₁).continuousAt.preimage_mem_nhds hs] with τ hτ + exact ⟨hf τ, hτ⟩ + · filter_upwards [(hg τ₁).continuousAt.preimage_mem_nhds hs'] with τ hτ + exact ⟨hg τ, hτ⟩ + have huniv : {τ | f τ = g τ} = Set.univ := + (isClopen_iff.mp ⟨hclosed, hopen⟩).resolve_left (Set.nonempty_iff_ne_empty.mp ⟨τ₀, h0⟩) + funext τ + exact Set.eq_univ_iff_forall.mp huniv τ + +/-- The uniqueness theorem for Newtonian systems: a Newtonian system with a locally Lipschitz + force is deterministic. -/ +lemma isDeterministic_of_hasLocallyLipschitzForce (h : S.HasLocallyLipschitzForce) : + S.IsDeterministic := by + intro x y hx hy t₀ h0 hv0 + have hEq := ODE_solution_unique_of_locallyLipschitz (S.phaseVectorField_locallyLipschitz h) + (f := fun τ : ℝ => (x (toRealCLE.symm τ), ∂ₜ x (toRealCLE.symm τ))) + (g := fun τ : ℝ => (y (toRealCLE.symm τ), ∂ₜ y (toRealCLE.symm τ))) + (S.phaseCurve_hasDerivAt hx.differentiable hx.deriv_differentiable hx.equationOfMotion) + (S.phaseCurve_hasDerivAt hy.differentiable hy.deriv_differentiable hy.equationOfMotion) + (τ₀ := toRealCLE t₀) + (by simp [h0, hv0]) + funext t + exact (Prod.ext_iff.mp (congrFun hEq (toRealCLE t))).1 + +/-- Picard–Lindelöf for Newtonian systems: a Newtonian system with a Lipschitz force is + deterministic. -/ +lemma isDeterministic_of_hasLipschitzForce (h : S.HasLipschitzForce) : S.IsDeterministic := + S.isDeterministic_of_hasLocallyLipschitzForce h.hasLocallyLipschitzForce + +/-- A Newtonian system with a `C²` potential is deterministic. -/ +lemma isDeterministic_of_hasC2Potential (h : S.HasC2Potential) : S.IsDeterministic := + S.isDeterministic_of_hasLocallyLipschitzForce h.hasLocallyLipschitzForce + +/-- A Newtonian system with a locally Lipschitz force satisfies the first law. -/ +lemma satisfiesFirstLaw_of_hasLocallyLipschitzForce (h : S.HasLocallyLipschitzForce) : + S.SatisfiesFirstLaw := + (S.isDeterministic_of_hasLocallyLipschitzForce h).satisfiesFirstLaw + +/-! + +## E. A continuous force gives local solutions + +Determinism is uniqueness; the complementary existence property is that every initial position +and velocity is the initial datum of some solution for a short time. For a continuous force on +a finite-dimensional configuration space this is Peano's theorem applied to the phase-space +vector field, as Picard–Lindelöf gives it for the pendulum in +`SimplePendulum.exists_local_solution`. The statement of Peano's theorem is that of +`NortonDome.PeanoExistence`, pending in Mathlib, so the results here are marked `@[sorryful]`. + +-/ + +/-! + +### E.1. Local existence + +-/ + +/-- A Newtonian system has local solutions if for every initial position `x₀` and velocity + `v₀` there are `ε > 0` and a curve `r` with `r 0 = x₀` and `ṙ 0 = v₀` which, at every time + within `ε` of the initial instant, is differentiable together with its velocity and satisfies + the equation of motion. -/ +def HasLocalSolutions : Prop := + ∀ x₀ v₀ : X, ∃ ε > (0 : ℝ), ∃ r : Time → X, r 0 = x₀ ∧ ∂ₜ r 0 = v₀ ∧ + ∀ t : Time, |t.val| ≤ ε → DifferentiableAt ℝ r t ∧ DifferentiableAt ℝ (∂ₜ r) t ∧ + S.m • ∂ₜ (∂ₜ r) t = S.force (r t) + +/-! + +### E.2. The hypotheses of Peano's theorem + +The phase-space vector field is continuous if the force is, and is bounded on the closed unit +ball about the initial datum by compactness; a short enough time interval then gives the +hypotheses of Peano's theorem. + +-/ + +/-- If the force of a Newtonian system is continuous, so is its phase-space vector field. -/ +@[fun_prop] +lemma phaseVectorField_continuous (hF : Continuous S.force) : + Continuous S.phaseVectorField := by + unfold phaseVectorField + fun_prop + +/-- For a continuous force on a finite-dimensional configuration space, the time-independent + phase-space vector field satisfies the hypotheses of Peano's theorem about any initial datum, + on a short enough symmetric time interval and the closed unit ball. -/ +lemma exists_isPeano_phaseVectorField [FiniteDimensional ℝ X] (hF : Continuous S.force) + (p₀ : X × X) : + ∃ δ > (0 : ℝ), ∃ L : NNReal, + IsPeano (fun q : ℝ × (X × X) => S.phaseVectorField q.2) (-δ) δ 0 p₀ 1 L := by + obtain ⟨C, hC⟩ := (ProperSpace.isCompact_closedBall p₀ 1).exists_bound_of_continuousOn + (S.phaseVectorField_continuous hF).continuousOn + have hL : (0 : ℝ) ≤ Real.toNNReal C := NNReal.coe_nonneg _ + have hδ : (0 : ℝ) < 1 / (Real.toNNReal C + 1) := by positivity + refine ⟨1 / (Real.toNNReal C + 1), hδ, Real.toNNReal C, ⟨⟨by linarith, hδ.le⟩, ?_, ?_, ?_⟩⟩ + · exact ((S.phaseVectorField_continuous hF).comp continuous_snd).continuousOn + · intro t _ x hx + exact (hC x hx).trans (Real.le_coe_toNNReal C) + · rw [NNReal.coe_one, sub_zero, zero_sub, neg_neg, max_self, mul_one_div] + exact div_le_one_of_le₀ (by linarith) (by positivity) + +/-! + +### E.3. The existence theorem + +Peano's theorem gives an integral curve through the initial datum, differentiable in the sense +of `HasDerivWithinAt` on the closed interval, hence with an honest derivative on the open one. +Its first component, pulled back to `Time` through `Time.toRealCLE`, is the required curve; its +derivatives are read off with `Time.deriv_comp_toRealCLE_of_hasDerivAt`. + +-/ + +/-- Peano's theorem for Newtonian systems: a Newtonian system with a continuous force on a + finite-dimensional configuration space has local solutions. Pending the proof of Peano's + theorem in Mathlib. -/ +@[sorryful] +lemma hasLocalSolutions_of_continuous_force [FiniteDimensional ℝ X] + (hF : Continuous S.force) : S.HasLocalSolutions := by + intro x₀ v₀ + obtain ⟨δ, hδ, L, hP⟩ := S.exists_isPeano_phaseVectorField hF (x₀, v₀) + obtain ⟨α, hα0, hα'⟩ := hP.exists_eq_forall_mem_Icc_hasDerivWithinAt₀ + have hα : ∀ τ ∈ Set.Ioo (-δ) δ, HasDerivAt α (S.phaseVectorField (α τ)) τ := fun τ hτ => + (hα' τ (Set.Ioo_subset_Icc_self hτ)).hasDerivAt (Icc_mem_nhds hτ.1 hτ.2) + have hmem : ∀ t : Time, |t.val| ≤ δ / 2 → Time.toRealCLE t ∈ Set.Ioo (-δ) δ := by + intro t ht + have := abs_le.mp ht + change t.val ∈ Set.Ioo (-δ) δ + constructor <;> linarith + have hd1 : ∀ t : Time, Time.toRealCLE t ∈ Set.Ioo (-δ) δ → + ∂ₜ (fun s => (α (Time.toRealCLE s)).1) t = (α (Time.toRealCLE t)).2 := by + intro t ht + have hfst := (ContinuousLinearMap.fst ℝ X X).hasFDerivAt.comp_hasDerivAt + (Time.toRealCLE t) (hα _ ht) + apply Time.deriv_comp_toRealCLE_of_hasDerivAt (fun τ => (α τ).1) t + simpa [Function.comp_def, phaseVectorField] using hfst + have hev : ∀ t : Time, Time.toRealCLE t ∈ Set.Ioo (-δ) δ → + ∂ₜ (fun s => (α (Time.toRealCLE s)).1) =ᶠ[nhds t] fun s => (α (Time.toRealCLE s)).2 := by + intro t ht + have hU : IsOpen {s : Time | Time.toRealCLE s ∈ Set.Ioo (-δ) δ} := + isOpen_Ioo.preimage Time.toRealCLE.continuous + exact Filter.eventuallyEq_of_mem (hU.mem_nhds ht) fun s hs => hd1 s hs + have hd2 : ∀ t : Time, Time.toRealCLE t ∈ Set.Ioo (-δ) δ → + ∂ₜ (∂ₜ (fun s => (α (Time.toRealCLE s)).1)) t = + (S.phaseVectorField (α (Time.toRealCLE t))).2 := by + intro t ht + have hsnd := (ContinuousLinearMap.snd ℝ X X).hasFDerivAt.comp_hasDerivAt + (Time.toRealCLE t) (hα _ ht) + have h2 : ∂ₜ (fun s => (α (Time.toRealCLE s)).2) t = + (S.phaseVectorField (α (Time.toRealCLE t))).2 := by + apply Time.deriv_comp_toRealCLE_of_hasDerivAt (fun τ => (α τ).2) t + simpa [Function.comp_def] using hsnd + rw [Time.deriv_eq, (hev t ht).fderiv_eq, ← Time.deriv_eq, h2] + have h0 : Time.toRealCLE (0 : Time) ∈ Set.Ioo (-δ) δ := by + rw [map_zero] + constructor <;> linarith + refine ⟨δ / 2, half_pos hδ, fun t => (α (Time.toRealCLE t)).1, ?_, ?_, fun t ht => ?_⟩ + · show (α (Time.toRealCLE 0)).1 = x₀ + rw [map_zero, hα0] + · rw [hd1 0 h0, map_zero, hα0] + · have hαt := (hα _ (hmem t ht)).differentiableAt + refine ⟨hαt.fst.comp t Time.toRealCLE.differentiableAt, ?_, ?_⟩ + · exact (hev t (hmem t ht)).differentiableAt_iff.mpr + (hαt.snd.comp t Time.toRealCLE.differentiableAt) + · rw [hd2 t (hmem t ht)] + show S.m • (S.m⁻¹ • S.force _) = _ + rw [smul_smul, mul_inv_cancel₀ S.m_ne_zero, one_smul] + +end NewtonianSystem + +end ClassicalMechanics + +end diff --git a/PhyslibAlpha/ClassicalMechanics/NortonDome/PeanoExistence.lean b/PhyslibAlpha/ClassicalMechanics/NortonDome/PeanoExistence.lean new file mode 100644 index 0000000000..f25c1d529d --- /dev/null +++ b/PhyslibAlpha/ClassicalMechanics/NortonDome/PeanoExistence.lean @@ -0,0 +1,107 @@ +/- +Copyright (c) 2026 Zhi Kai Pong. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Zhi Kai Pong +-/ +module + +public import Mathlib.Analysis.SpecialFunctions.Integrals.Basic +public import Physlib.Meta.Linters.Sorry +/-! + +# Peano's existence theorem (statements) + +## i. Overview + +Peano's existence theorem: the initial value problem `x' = f (t, x)`, `x t₀ = x₀` has a +solution on a closed time interval whenever `f` is continuous on the product of that interval +with a closed ball about `x₀` and the interval is short enough for the solution to stay in the +ball. No Lipschitz condition is asked, and only existence is guaranteed. + +The theorem is not yet in Mathlib. This file records the hypotheses and the two forms of the +conclusion as stated in the Mathlib pull request +[#42148](https://github.com/leanprover-community/mathlib4/pull/42148), by Julian Rolfes, +Luke Schleef, Philipp Svinger, Paul Niessner and Florian Grube, with the proofs replaced by +`sorry` and the results marked `@[sorryful]`. Names and namespace are those of the pull +request, so that once it is merged this file can be deleted and its uses redirected to +Mathlib's `IsPeano` by a change of imports. `NortonDome.NewtonianSystem` uses the theorem to +show that a Newtonian system with a continuous force has local solutions. + +## ii. Key results + +- `IsPeano` collects the hypotheses: the initial time lies in the interval, the vector field is + continuous on the cylinder, bounded by `L` there, and `L` times the length of the interval on + either side of `t₀` is at most the radius `r` of the ball. +- `IsPeano.exists_eq_forall_mem_Icc_eq_integral` is the theorem in integral form. +- `IsPeano.exists_eq_forall_mem_Icc_hasDerivWithinAt₀` is the theorem in differential form. + +## iii. Table of contents + +- A. The hypotheses +- B. The theorem + +## iv. References + +- Mathlib pull request [#42148](https://github.com/leanprover-community/mathlib4/pull/42148), + `Mathlib/Analysis/ODE/Peano.lean`. +- Hartman, P., *Ordinary Differential Equations*, 2nd ed., SIAM (2002), Theorem II.2.1. + +-/ + +@[expose] public section + +open Metric Set +open scoped NNReal + +/-! + +## A. The hypotheses + +-/ + +/-- The hypotheses for Peano's existence theorem on a closed time interval and a closed ball. -/ +structure IsPeano {E : Type*} [NormedAddCommGroup E] + (f : ℝ × E → E) (tmin tmax t₀ : ℝ) (x₀ : E) (r L : ℝ≥0) : Prop where + /-- The initial time belongs to the time interval. -/ + t₀_mem : t₀ ∈ Icc tmin tmax + /-- The vector field is continuous on the set product of a time interval and a closed ball. -/ + continuousOn : ContinuousOn f (Icc tmin tmax ×ˢ closedBall x₀ r) + /-- `L` is an upper bound of the norm of the vector field. -/ + norm_le : ∀ t ∈ Icc tmin tmax, ∀ x ∈ closedBall x₀ r, ‖f (t, x)‖ ≤ L + /-- The time interval of validity. -/ + mul_max_le : L * max (tmax - t₀) (t₀ - tmin) ≤ r + +namespace IsPeano + +variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E] + {f : ℝ × E → E} {tmin tmax t₀ : ℝ} {x₀ : E} {r L : ℝ≥0} + +/-! + +## B. The theorem + +-/ + +/-- Peano existence theorem, integral form. A solution exists on the full time interval and + remains in `closedBall x₀ r`. Statement copied from Mathlib pull request #42148; the proof is + pending upstream. -/ +@[sorryful] +lemma exists_eq_forall_mem_Icc_eq_integral + (hf : IsPeano f tmin tmax t₀ x₀ r L) : + ∃ α : ℝ → E, ContinuousOn α (Icc tmin tmax) ∧ MapsTo α (Icc tmin tmax) (closedBall x₀ r) ∧ + ∀ t ∈ Icc tmin tmax, α t = x₀ + ∫ s in t₀..t, f (s, α s) := by + sorry + +/-- Peano existence theorem, differential form. A solution to the initial value problem exists + on the full time interval. Statement copied from Mathlib pull request #42148; the proof is + pending upstream. -/ +@[sorryful] +lemma exists_eq_forall_mem_Icc_hasDerivWithinAt₀ + (hf : IsPeano f tmin tmax t₀ x₀ r L) : + ∃ α : ℝ → E, α t₀ = x₀ ∧ + ∀ t ∈ Icc tmin tmax, HasDerivWithinAt α (f (t, α t)) (Icc tmin tmax) t := by + sorry + +end IsPeano + +end diff --git a/PhyslibAlpha/ClassicalMechanics/NortonDome/PhysicalSpace.lean b/PhyslibAlpha/ClassicalMechanics/NortonDome/PhysicalSpace.lean new file mode 100644 index 0000000000..e79bdf5d51 --- /dev/null +++ b/PhyslibAlpha/ClassicalMechanics/NortonDome/PhysicalSpace.lean @@ -0,0 +1,276 @@ +/- +Copyright (c) 2026 Zhi Kai Pong. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Zhi Kai Pong +-/ +module + +public import PhyslibAlpha.ClassicalMechanics.NortonDome.Basic +public import Physlib.SpaceAndTime.Space.Module +/-! + +# The Norton dome in physical space + +## i. Overview + +`NortonDome.Basic` writes the dynamics on the arc length `r`, with kinetic energy `½ m ṙ²` and +potential energy `-m g h(r)`. This module identifies that chart dynamics with a point mass +constrained to the surface of the dome, as `SimplePendulum.Geometric.PhysicalSpace` does for +the pendulum. + +The motion is radial, so it suffices to work in the vertical plane through the apex, with the +apex at the origin and the vertical coordinate measured upwards. The profile is the arc-length +parametrised curve `s ↦ (x(s), -h(s))`, where `x'(s)² + h'(s)² = 1` and `h'(s) = √s / g` give +`x'(s) = √(1 - s/g²)` and `x(s) = (2g²/3) (1 - (1 - s/g²)^{3/2})`. The profile exists for +`0 ≤ s ≤ g²`; at `s = g²` it is vertical and Norton's model stops. While the arc length is in +that range the chart kinetic energy is `½ m ‖v‖²` by unit speed, and the chart potential energy +is the gravitational potential `m g y` at height `y`, so the chart Lagrangian is the +constrained Lagrangian. + +## ii. Key results + +- `NortonDome.horizontal` is the horizontal distance `x(s)` of the profile from the apex, with + its derivative `hasDerivAt_horizontal`; `NortonDome.unit_speed` is the identity + `x'(s)² + h'(s)² = 1`. +- `NortonDome.profile` is the profile curve `s ↦ (x(s), -h(s))` in the vertical plane, and + `NortonDome.dome` its image on `0 ≤ s ≤ g²`. +- `NortonDome.spaceTrajectory` is the position of the particle in the plane along a chart + trajectory; it lies on the dome, `spaceTrajectory_mem_dome`, while the arc length is in range. +- `NortonDome.deriv_spaceTrajectory` is the velocity of the particle in the plane, with the + square of its speed `norm_sq_deriv_spaceTrajectory`. +- `NortonDome.kineticEnergy_eq_space`, `NortonDome.potentialEnergy_eq_height`, + `NortonDome.lagrangian_eq_space` and `NortonDome.energy_eq_space` identify the chart + energies and Lagrangian with those of the point mass in physical space. + +## iii. Table of contents + +- A. The profile of the dome in the plane + - A.1. The horizontal coordinate and the unit-speed property + - A.2. The profile curve and the dome +- B. The particle's position along a trajectory +- C. The particle's velocity and speed +- D. The energies and the Lagrangian in physical space + +## iv. References + +- Norton, J. D., *The dome: an unexpectedly simple failure of determinism*, Philosophy of + Science 75 (2008), 786–798. +- `Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Geometric.PhysicalSpace` (the same + identification for the pendulum). + +-/ + +@[expose] public section + +namespace ClassicalMechanics.NortonDome +open Real InnerProductSpace Time + +variable (S : NortonDome) + +/-! + +## A. The profile of the dome in the plane + +-/ + +/-! + +### A.1. The horizontal coordinate and the unit-speed property + +The horizontal distance from the apex has derivative `√(1 - s/g²)`; with the slope `√s / g` of +the depth this gives unit speed. + +-/ + +/-- The horizontal distance `x(s) = (2g²/3) (1 - (1 - s/g²)^{3/2})` of the profile of the dome + from the apex at arc length `s`. -/ +noncomputable def horizontal (s : ℝ) : ℝ := 2 * S.g ^ 2 / 3 * (1 - √(1 - s / S.g ^ 2) ^ 3) + +/-- The horizontal distance of the profile from the apex, written out. -/ +lemma horizontal_eq (s : ℝ) : + S.horizontal s = 2 * S.g ^ 2 / 3 * (1 - √(1 - s / S.g ^ 2) ^ 3) := rfl + +/-- The profile of the dome starts at the apex. -/ +lemma horizontal_zero : S.horizontal 0 = 0 := by + simp [horizontal_eq] + +/-- The derivative of the horizontal distance with respect to the arc length is `√(1 - s/g²)`, + at every `s`. -/ +lemma hasDerivAt_horizontal (s : ℝ) : HasDerivAt S.horizontal (√(1 - s / S.g ^ 2)) s := by + have h1 : HasDerivAt (fun y : ℝ => 1 - y / S.g ^ 2) (-(1 / S.g ^ 2)) s := by + simpa using ((hasDerivAt_id s).div_const (S.g ^ 2)).const_sub (1 : ℝ) + have h2 := (hasDerivAt_sqrt_pow_three (1 - s / S.g ^ 2)).comp s h1 + refine ((h2.const_sub (1 : ℝ)).const_mul (2 * S.g ^ 2 / 3)).congr_deriv ?_ + field_simp + +/-- The horizontal distance of the profile from the apex is a differentiable function of the + arc length. -/ +@[fun_prop] +lemma horizontal_differentiable : Differentiable ℝ S.horizontal := + fun s => (S.hasDerivAt_horizontal s).differentiableAt + +/-- Unit speed: for arc length `0 ≤ s ≤ g²` the derivatives of the horizontal distance and + of the depth satisfy `x'(s)² + h'(s)² = 1`, so that `s` is indeed the arc length along the + profile. -/ +lemma unit_speed {s : ℝ} (h0 : 0 ≤ s) (h1 : s ≤ S.g ^ 2) : + √(1 - s / S.g ^ 2) ^ 2 + (√s / S.g) ^ 2 = 1 := by + have hg := S.g_pos + have hs : 0 ≤ 1 - s / S.g ^ 2 := sub_nonneg.mpr ((div_le_one (by positivity)).mpr h1) + rw [Real.sq_sqrt hs, div_pow, Real.sq_sqrt h0] + field_simp + ring + +/-! + +### A.2. The profile curve and the dome + +-/ + +/-- The profile of the dome in the vertical plane through the apex: the point at arc length + `s` is at horizontal distance `x(s)` from the apex and at height `-h(s)`. -/ +noncomputable def profile (s : ℝ) : Space 2 := ⟨![S.horizontal s, -S.height s]⟩ + +/-- The horizontal coordinate of the profile of the dome. -/ +lemma profile_apply_zero (s : ℝ) : S.profile s 0 = S.horizontal s := by + simp [profile] + +/-- The vertical coordinate of the profile of the dome is minus its depth below the apex. -/ +lemma profile_apply_one (s : ℝ) : S.profile s 1 = -S.height s := by + simp [profile] + +/-- The apex of the dome is the origin. -/ +lemma profile_zero : S.profile 0 = 0 := by + ext i + fin_cases i <;> simp [profile, horizontal_zero, height_eq] + +/-- The dome, in the vertical plane through its apex: the image of the profile on the range + `0 ≤ s ≤ g²` of arc lengths on which the profile exists. -/ +noncomputable def dome : Set (Space 2) := S.profile '' Set.Icc 0 (S.g ^ 2) + +/-- The point of the profile at arc length `0 ≤ s ≤ g²` lies on the dome. -/ +lemma profile_mem_dome {s : ℝ} (h0 : 0 ≤ s) (h1 : s ≤ S.g ^ 2) : S.profile s ∈ S.dome := + ⟨s, ⟨h0, h1⟩, rfl⟩ + +/-! + +## B. The particle's position along a trajectory + +Along a chart trajectory `r` the particle is at the point of the profile at arc length +`r t 0`, on the dome while that is in range. + +-/ + +/-- The position of the particle in the plane along the chart trajectory `r` of the arc + length. -/ +noncomputable def spaceTrajectory (r : Time → EuclideanSpace ℝ (Fin 1)) : Time → Space 2 := + fun t => S.profile (r t 0) + +/-- The horizontal position of the particle along a chart trajectory. -/ +lemma spaceTrajectory_apply_zero (r : Time → EuclideanSpace ℝ (Fin 1)) (t : Time) : + S.spaceTrajectory r t 0 = S.horizontal (r t 0) := + S.profile_apply_zero _ + +/-- The height of the particle along a chart trajectory is minus the depth of the dome at its + arc length. -/ +lemma spaceTrajectory_apply_one (r : Time → EuclideanSpace ℝ (Fin 1)) (t : Time) : + S.spaceTrajectory r t 1 = -S.height (r t 0) := + S.profile_apply_one _ + +/-- While its arc length is in the range `0 ≤ r ≤ g²` the particle is on the dome. -/ +lemma spaceTrajectory_mem_dome (r : Time → EuclideanSpace ℝ (Fin 1)) {t : Time} + (h0 : 0 ≤ r t 0) (h1 : r t 0 ≤ S.g ^ 2) : S.spaceTrajectory r t ∈ S.dome := + S.profile_mem_dome h0 h1 + +/-! + +## C. The particle's velocity and speed + +The velocity in the plane is the unit tangent `(x'(r), -h'(r))` times `ṙ`, so by unit speed the +square of the speed is `ṙ²` while the arc length is in range. + +-/ + +/-- Along a differentiable chart trajectory the position of the particle is differentiable in + time. -/ +@[fun_prop] +lemma differentiable_spaceTrajectory (r : Time → EuclideanSpace ℝ (Fin 1)) + (hr : Differentiable ℝ r) : Differentiable ℝ (S.spaceTrajectory r) := by + unfold spaceTrajectory profile + apply Space.mk_differentiable.comp + rw [differentiable_pi] + intro i + fin_cases i <;> (simp; fun_prop) + +/-- The velocity of the particle in the plane along a differentiable chart trajectory `r` is + `(√(1 - r/g²), -√r / g)` times the rate of change `ṙ` of the arc length: the unit tangent + vector to the profile times `ṙ`. -/ +lemma deriv_spaceTrajectory (r : Time → EuclideanSpace ℝ (Fin 1)) (hr : Differentiable ℝ r) + (t : Time) : + ∂ₜᵥ (S.spaceTrajectory r) t = + !₂[√(1 - r t 0 / S.g ^ 2) * (∂ₜ r t) 0, -(√(r t 0) / S.g) * (∂ₜ r t) 0] := by + refine PiLp.ext fun i ↦ ?_ + fin_cases i <;> apply (Time.derivVec_space (by fun_prop) t _).trans + · simp only [S.spaceTrajectory_apply_zero, Fin.zero_eta, Matrix.cons_val_zero] + exact Time.deriv_comp_coord 0 (hr t) (S.hasDerivAt_horizontal (r t 0)) + · simp only [Fin.mk_one, S.spaceTrajectory_apply_one, Matrix.cons_val_one, Matrix.cons_val_zero] + rw [Time.deriv_comp_coord (f := fun x => -S.height x) 0 (hr t) + ((S.hasDerivAt_height (r t 0)).neg)] + +/-- While the arc length is in range, the square of the speed of the particle along a + differentiable chart trajectory is `ṙ²`. -/ +lemma norm_sq_deriv_spaceTrajectory (r : Time → EuclideanSpace ℝ (Fin 1)) + (hr : Differentiable ℝ r) {t : Time} (h0 : 0 ≤ r t 0) (h1 : r t 0 ≤ S.g ^ 2) : + ‖∂ₜᵥ (S.spaceTrajectory r) t‖ ^ 2 = ((∂ₜ r t) 0) ^ 2 := by + rw [S.deriv_spaceTrajectory r hr t, EuclideanSpace.real_norm_sq_eq, Fin.sum_univ_two] + show (√(1 - r t 0 / S.g ^ 2) * (∂ₜ r t) 0) ^ 2 + (-(√(r t 0) / S.g) * (∂ₜ r t) 0) ^ 2 = _ + linear_combination ((∂ₜ r t) 0) ^ 2 * S.unit_speed h0 h1 + +/-! + +## D. The energies and the Lagrangian in physical space + +The chart kinetic energy is that of the particle in the plane while the arc length is in range, +and the chart potential energy is `m g y` at its height `y` at all times; the chart Lagrangian +is the constrained Lagrangian `T - V`. + +-/ + +/-- The chart kinetic energy of the dome along a differentiable chart trajectory is the kinetic + energy of the particle in physical space, while the arc length is in range. -/ +lemma kineticEnergy_eq_space (r : Time → EuclideanSpace ℝ (Fin 1)) (hr : Differentiable ℝ r) + {t : Time} (h0 : 0 ≤ r t 0) (h1 : r t 0 ≤ S.g ^ 2) : + S.kineticEnergy r t = (1 / (2 : ℝ)) * S.m * ‖∂ₜᵥ (S.spaceTrajectory r) t‖ ^ 2 := by + rw [S.norm_sq_deriv_spaceTrajectory r hr h0 h1, kineticEnergy_eq] + simp only [PiLp.inner_apply, Fin.sum_univ_one, RCLike.inner_apply, conj_trivial] + ring + +/-- The chart potential energy of the dome is the gravitational potential `m g y` of the + particle at its height `y` in physical space. -/ +lemma potentialEnergy_eq_height (r : Time → EuclideanSpace ℝ (Fin 1)) (t : Time) : + S.potentialEnergy (r t) = S.m * S.g * S.spaceTrajectory r t 1 := by + rw [potentialEnergy, S.spaceTrajectory_apply_one r t] + ring + +/-- The chart Lagrangian of the dome along a differentiable chart trajectory is the constrained + Lagrangian of the particle in physical space, while the arc length is in range. -/ +lemma lagrangian_eq_space (r : Time → EuclideanSpace ℝ (Fin 1)) (hr : Differentiable ℝ r) + {t : Time} (h0 : 0 ≤ r t 0) (h1 : r t 0 ≤ S.g ^ 2) : + S.lagrangian t (r t) (∂ₜ r t) = + (1 / (2 : ℝ)) * S.m * ‖∂ₜᵥ (S.spaceTrajectory r) t‖ ^ 2 + - S.m * S.g * S.spaceTrajectory r t 1 := by + rw [S.lagrangian_eq_kineticEnergy_sub_potentialEnergy t r, S.kineticEnergy_eq_space r hr h0 h1, + S.potentialEnergy_eq_height r t] + +/-- The chart energy of the dome along a differentiable chart trajectory is the total energy of + the particle in physical space, while the arc length is in range. -/ +lemma energy_eq_space (r : Time → EuclideanSpace ℝ (Fin 1)) (hr : Differentiable ℝ r) + {t : Time} (h0 : 0 ≤ r t 0) (h1 : r t 0 ≤ S.g ^ 2) : + S.energy r t = + (1 / (2 : ℝ)) * S.m * ‖∂ₜᵥ (S.spaceTrajectory r) t‖ ^ 2 + + S.m * S.g * S.spaceTrajectory r t 1 := by + rw [← S.kineticEnergy_eq_space r hr h0 h1, ← S.potentialEnergy_eq_height r t] + rfl + +end ClassicalMechanics.NortonDome + +end diff --git a/PhyslibAlpha/ClassicalMechanics/NortonDome/PosPartPow.lean b/PhyslibAlpha/ClassicalMechanics/NortonDome/PosPartPow.lean new file mode 100644 index 0000000000..2c93b49fe1 --- /dev/null +++ b/PhyslibAlpha/ClassicalMechanics/NortonDome/PosPartPow.lean @@ -0,0 +1,122 @@ +/- +Copyright (c) 2026 Zhi Kai Pong. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Zhi Kai Pong +-/ +module + +public import Mathlib.Analysis.Calculus.ContDiff.Deriv +public import Mathlib.Analysis.Calculus.ContDiff.Operations +public import Mathlib.Analysis.Calculus.Deriv.Pow +public import Mathlib.Analysis.Calculus.Deriv.Slope +/-! + +# Powers of the positive part + +## i. Overview + +The function `y ↦ max (y - c) 0 ^ (n + 2)` vanishes to the left of `c` and is a polynomial to +its right. It is differentiable everywhere, including at `c`, and is `C^(n+1)`. Functions of +this shape are the standard witnesses for the failure of uniqueness of ODEs with a +non-Lipschitz right-hand side, of which the Norton dome is the physical instance. + +## ii. Key results + +- `hasDerivAt_max_sub_pow` is the derivative `(n + 2) max (y - c) 0 ^ (n + 1)`, at every point. +- `contDiff_max_sub_pow` is the `C^(n+1)` regularity. + +## iii. Table of contents + +- A. The derivative +- B. Regularity + +## iv. References + +- Norton, J. D., *The dome: an unexpectedly simple failure of determinism*, Philosophy of + Science 75 (2008), 786–798. + +-/ + +@[expose] public section + +open Filter Topology + +/-! + +## A. The derivative + +By cases: to the left of `c` the function vanishes near the point, to the right it agrees near +the point with `(y - c) ^ (n + 2)`, and at `c` the difference quotient is `max t 0 ^ (n + 1)`, +which tends to zero. + +-/ + +/-- The power `max (y - c) 0 ^ (n + 2)` of the positive part of `y - c` has derivative + `(n + 2) max (x - c) 0 ^ (n + 1)` at every `x`, including the junction `x = c`. -/ +lemma hasDerivAt_max_sub_pow (c : ℝ) (n : ℕ) (x : ℝ) : + HasDerivAt (fun y : ℝ => max (y - c) 0 ^ (n + 2)) + (((n : ℝ) + 2) * max (x - c) 0 ^ (n + 1)) x := by + rcases lt_trichotomy x c with hx | rfl | hx + · have hev : (fun y : ℝ => max (y - c) 0 ^ (n + 2)) =ᶠ[𝓝 x] fun _ => 0 := by + filter_upwards [Iio_mem_nhds hx] with y hy + simp [max_eq_right (sub_nonpos.mpr (Set.mem_Iio.mp hy).le)] + rw [max_eq_right (sub_nonpos.mpr hx.le), zero_pow (Nat.succ_ne_zero _), mul_zero] + exact (hasDerivAt_const x (0 : ℝ)).congr_of_eventuallyEq hev + · rw [sub_self, max_self, zero_pow (Nat.succ_ne_zero _), mul_zero, + hasDerivAt_iff_tendsto_slope_zero] + have h : ∀ t : ℝ, t ≠ 0 → + max t 0 ^ (n + 1) = t⁻¹ • (max (x + t - x) 0 ^ (n + 2) - max (x - x) 0 ^ (n + 2)) := by + intro t ht + rw [add_sub_cancel_left, sub_self, max_self, zero_pow (Nat.succ_ne_zero _), sub_zero, + smul_eq_mul] + rcases le_or_gt t 0 with h | h + · simp [max_eq_right h] + · rw [max_eq_left h.le] + field_simp + ring + have hcont : Continuous (fun t : ℝ => max t 0 ^ (n + 1)) := by fun_prop + have hc : Tendsto (fun t : ℝ => max t 0 ^ (n + 1)) (𝓝[≠] 0) (𝓝 0) := by + simpa using (hcont.tendsto 0).mono_left nhdsWithin_le_nhds + exact hc.congr' (eventually_nhdsWithin_of_forall fun t ht => h t ht) + · have hev : (fun y : ℝ => max (y - c) 0 ^ (n + 2)) =ᶠ[𝓝 x] fun y => (y - c) ^ (n + 2) := by + filter_upwards [Ioi_mem_nhds hx] with y hy + rw [max_eq_left (sub_nonneg.mpr (Set.mem_Ioi.mp hy).le)] + rw [max_eq_left (sub_nonneg.mpr hx.le)] + have h1 : HasDerivAt (fun y : ℝ => y - c) 1 x := (hasDerivAt_id x).sub_const c + refine ((HasDerivAt.pow h1 (n + 2)).congr_of_eventuallyEq hev).congr_deriv ?_ + show ((n + 2 : ℕ) : ℝ) * (x - c) ^ (n + 1) * 1 = _ + push_cast + ring + +/-! + +## B. Regularity + +By induction on `n`: the derivative of the `(n + 3)`-rd power is a constant multiple of the +`(n + 2)`-nd, which is `C^(n+1)` by the induction hypothesis. + +-/ + +/-- The power `max (y - c) 0 ^ (n + 2)` of the positive part of `y - c` is `C^(n+1)`. -/ +lemma contDiff_max_sub_pow (c : ℝ) (n : ℕ) : + ContDiff ℝ (n + 1) (fun y : ℝ => max (y - c) 0 ^ (n + 2)) := by + induction n with + | zero => + have h : ((0 : ℕ) : WithTop ℕ∞) + 1 = 1 := by simp + rw [h, contDiff_one_iff_deriv] + refine ⟨fun y => (hasDerivAt_max_sub_pow c 0 y).differentiableAt, ?_⟩ + have hd : deriv (fun y : ℝ => max (y - c) 0 ^ (0 + 2)) = + fun y => (((0 : ℕ) : ℝ) + 2) * max (y - c) 0 ^ (0 + 1) := + funext fun y => (hasDerivAt_max_sub_pow c 0 y).deriv + rw [hd] + fun_prop + | succ n ih => + rw [Nat.cast_succ, contDiff_succ_iff_deriv] + refine ⟨fun y => (hasDerivAt_max_sub_pow c (n + 1) y).differentiableAt, by simp, ?_⟩ + have hd : deriv (fun y : ℝ => max (y - c) 0 ^ (n + 1 + 2)) = + fun y => (((n + 1 : ℕ) : ℝ) + 2) * max (y - c) 0 ^ (n + 2) := + funext fun y => (hasDerivAt_max_sub_pow c (n + 1) y).deriv + rw [hd] + exact ContDiff.mul contDiff_const ih + +end diff --git a/PhyslibAlpha/ClassicalMechanics/NortonDome/Solution.lean b/PhyslibAlpha/ClassicalMechanics/NortonDome/Solution.lean new file mode 100644 index 0000000000..c8218ee7c8 --- /dev/null +++ b/PhyslibAlpha/ClassicalMechanics/NortonDome/Solution.lean @@ -0,0 +1,418 @@ +/- +Copyright (c) 2026 Zhi Kai Pong. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Zhi Kai Pong +-/ +module + +public import PhyslibAlpha.ClassicalMechanics.NortonDome.Basic +public import PhyslibAlpha.ClassicalMechanics.NortonDome.PosPartPow +/-! + +# The motions of the Norton dome and the failure of uniqueness + +## i. Overview + +A particle at rest on the apex of the Norton dome satisfies `r̈ = √r` by staying there forever, +and also by staying until an arbitrary instant `T ≥ 0` and then sliding off along +`r(t) = (t - T)⁴ / 144`: that curve is `C²`, vanishes with its derivative at `T`, and its +second derivative `(t - T)² / 12` is `√r`. All these motions have the same initial position and +velocity, so the initial data do not determine the motion. This is Norton's observation. + +For contrast, the pendulum's phase-space vector field is Lipschitz and Mathlib's +`ODE_solution_unique_univ` gives `SimplePendulum.equationOfMotion_unique`; the force of the +dome is not Lipschitz at the apex, `NortonDome.not_lipschitzOnWith_force`. Energy conservation +does not help either, since every motion in the family has zero energy (`energy_solution`). +Read backwards in time, in section E, a particle sliding up the dome may arrive at the apex at +rest in finite time and stay there. + +## ii. Key results + +- `NortonDome.delayedQuartic` is the real function `τ ↦ max (τ - T) 0 ⁴ / 144`, with its + derivatives `hasDerivAt_delayedQuartic` and `hasDerivAt_deriv_delayedQuartic`, its `C²` + regularity `contDiff_delayedQuartic`, and the identity `sqrt_delayedQuartic`. +- `NortonDome.solution T` is the motion leaving the apex at the instant `T`. It is a solution, + `solution_isSolution`, starts from rest at the apex when `0 ≤ T`, `solution_zero` and + `deriv_solution_zero`, and is injective in `T`, `solution_injective`. +- `NortonDome.rest_isSolution` is the motion staying at the apex. +- `NortonDome.exists_isSolution_ne` is the failure of uniqueness: two distinct solutions with + the same initial position and velocity; `NortonDome.not_isSolution_unique` restates it as + the negation of the uniqueness property of the pendulum. All these motions have zero energy, + `NortonDome.energy_rest` and `NortonDome.energy_solution`. +- `NortonDome.IsSolution.comp_neg` is the time-reversal symmetry of the dome, and + `NortonDome.arrival T` the time-reversed motion, off the apex before the instant `-T`, + `arrival_apply_pos`, and at rest on it from then on, `arrival_of_le`. + +## iii. Table of contents + +- A. The delayed quartic + - A.1. Definition and sign + - A.2. Derivatives and regularity +- B. The motions leaving the apex + - B.1. The definition and its values + - B.2. Derivatives and regularity + - B.3. The equation of motion + - B.4. Distinct instants give distinct motions +- C. The motion staying at the apex +- D. The failure of uniqueness +- E. Time reversal and arrival at the apex + +## iv. References + +- Norton, J. D., *The dome: an unexpectedly simple failure of determinism*, Philosophy of + Science 75 (2008), 786–798. +- `Physlib.ClassicalMechanics.Pendulum.SimplePendulum.Solution` (uniqueness for a Lipschitz + force, for contrast). + +-/ + +@[expose] public section + +namespace ClassicalMechanics.NortonDome +open Real InnerProductSpace Time + +variable (S : NortonDome) + +/-! + +## A. The delayed quartic + +As a function of the real time `τ`, the motion leaving the apex at the instant `T` is +`max (τ - T) 0 ⁴ / 144`; its calculus is that of the positive-part powers of +`NortonDome.PosPartPow`. + +-/ + +/-! + +### A.1. Definition and sign + +-/ + +/-- The delayed quartic `τ ↦ max (τ - T) 0 ⁴ / 144`: zero up to the instant `T`, and + `(τ - T)⁴ / 144` afterwards. -/ +noncomputable def delayedQuartic (T τ : ℝ) : ℝ := max (τ - T) 0 ^ 4 / 144 + +/-- The delayed quartic, written out. -/ +lemma delayedQuartic_eq (T τ : ℝ) : delayedQuartic T τ = max (τ - T) 0 ^ 4 / 144 := rfl + +/-- The delayed quartic is non-negative. -/ +lemma delayedQuartic_nonneg (T τ : ℝ) : 0 ≤ delayedQuartic T τ := by + rw [delayedQuartic_eq] + positivity + +/-- The delayed quartic vanishes up to the instant `T`. -/ +lemma delayedQuartic_of_le (T : ℝ) {τ : ℝ} (h : τ ≤ T) : delayedQuartic T τ = 0 := by + rw [delayedQuartic_eq, max_eq_right (sub_nonpos.mpr h)] + simp + +/-- The delayed quartic is positive after the instant `T`. -/ +lemma delayedQuartic_pos (T : ℝ) {τ : ℝ} (h : T < τ) : 0 < delayedQuartic T τ := by + rw [delayedQuartic_eq, max_eq_left (sub_nonneg.mpr h.le)] + have := sub_pos.mpr h + positivity + +/-- The square root of the delayed quartic is `max (τ - T) 0 ² / 12`, which is its second + derivative: this is the equation of motion `r̈ = √r` of the dome along it. -/ +lemma sqrt_delayedQuartic (T τ : ℝ) : √(delayedQuartic T τ) = max (τ - T) 0 ^ 2 / 12 := by + rw [delayedQuartic_eq, show max (τ - T) 0 ^ 4 / 144 = (max (τ - T) 0 ^ 2 / 12) ^ 2 by ring, + Real.sqrt_sq (by positivity)] + +/-! + +### A.2. Derivatives and regularity + +-/ + +/-- The derivative of the delayed quartic is `max (τ - T) 0 ³ / 36`. -/ +lemma hasDerivAt_delayedQuartic (T τ : ℝ) : + HasDerivAt (delayedQuartic T) (max (τ - T) 0 ^ 3 / 36) τ := by + refine ((hasDerivAt_max_sub_pow T 2 τ).div_const 144).congr_deriv ?_ + push_cast + ring + +/-- The derivative of the delayed quartic, as a function. -/ +lemma deriv_delayedQuartic (T : ℝ) : + deriv (delayedQuartic T) = fun τ => max (τ - T) 0 ^ 3 / 36 := + funext fun τ => (hasDerivAt_delayedQuartic T τ).deriv + +/-- The second derivative of the delayed quartic is `max (τ - T) 0 ² / 12`. -/ +lemma hasDerivAt_deriv_delayedQuartic (T τ : ℝ) : + HasDerivAt (deriv (delayedQuartic T)) (max (τ - T) 0 ^ 2 / 12) τ := by + rw [deriv_delayedQuartic] + refine ((hasDerivAt_max_sub_pow T 1 τ).div_const 36).congr_deriv ?_ + push_cast + ring + +/-- The delayed quartic is `C²`. It is in fact `C³` and not `C⁴`, which is not needed here. -/ +@[fun_prop] +lemma contDiff_delayedQuartic (T : ℝ) : ContDiff ℝ 2 (delayedQuartic T) := + ((contDiff_max_sub_pow T 2).div_const 144).of_le (by exact_mod_cast Nat.le_succ 2) + +/-! + +## B. The motions leaving the apex + +The motion leaving the apex at the instant `T` is the delayed quartic read on `Time`, times the +unit vector of the arc-length coordinate. + +-/ + +/-! + +### B.1. The definition and its values + +-/ + +/-- The motion of the particle on the dome leaving the apex at the instant `T`: at rest at the + apex up to `T`, and at arc length `(t - T)⁴ / 144` from the apex afterwards. -/ +noncomputable def solution (T : ℝ) : Time → EuclideanSpace ℝ (Fin 1) := fun t => + delayedQuartic T t.val • EuclideanSpace.single 0 1 + +/-- The arc length along the motion leaving the apex at the instant `T` is the delayed + quartic. -/ +lemma solution_apply (T : ℝ) (t : Time) : solution T t 0 = delayedQuartic T t.val := by + simp [solution] + +/-- The motion leaving the apex at the instant `T` is at the apex up to `T`. -/ +lemma solution_of_le (T : ℝ) {t : Time} (h : t.val ≤ T) : solution T t = 0 := by + simp [solution, delayedQuartic_of_le T h] + +/-- The motion leaving the apex at the instant `T ≥ 0` starts at the apex. -/ +lemma solution_zero {T : ℝ} (hT : 0 ≤ T) : solution T 0 = 0 := + solution_of_le T (by rw [Time.zero_val]; exact hT) + +/-- The motion leaving the apex at the instant `T` is off the apex after `T`. -/ +lemma solution_apply_pos (T : ℝ) {t : Time} (h : T < t.val) : 0 < solution T t 0 := by + rw [solution_apply] + exact delayedQuartic_pos T h + +/-! + +### B.2. Derivatives and regularity + +-/ + +/-- The motion leaving the apex at the instant `T` is `C²`. -/ +@[fun_prop] +lemma solution_contDiff (T : ℝ) : ContDiff ℝ 2 (solution T) := by + unfold solution + fun_prop + +/-- The velocity along the motion leaving the apex at the instant `T` is + `max (t - T) 0 ³ / 36`. -/ +lemma deriv_solution (T : ℝ) : + ∂ₜ (solution T) = fun t => (max (t.val - T) 0 ^ 3 / 36) • EuclideanSpace.single 0 1 := by + funext t + unfold solution + exact Time.deriv_comp_toRealCLE_of_hasDerivAt + (fun τ : ℝ => delayedQuartic T τ • EuclideanSpace.single (0 : Fin 1) (1 : ℝ)) t _ + ((hasDerivAt_delayedQuartic T t.val).smul_const _) + +/-- The acceleration along the motion leaving the apex at the instant `T` is + `max (t - T) 0 ² / 12`. -/ +lemma deriv_deriv_solution (T : ℝ) : + ∂ₜ (∂ₜ (solution T)) = + fun t => (max (t.val - T) 0 ^ 2 / 12) • EuclideanSpace.single 0 1 := by + funext t + rw [deriv_solution] + have h := hasDerivAt_deriv_delayedQuartic T t.val + rw [deriv_delayedQuartic] at h + exact Time.deriv_comp_toRealCLE_of_hasDerivAt + (fun τ : ℝ => (max (τ - T) 0 ^ 3 / 36) • EuclideanSpace.single (0 : Fin 1) (1 : ℝ)) t _ + (h.smul_const _) + +/-- The motion leaving the apex at the instant `T ≥ 0` starts from rest. -/ +lemma deriv_solution_zero {T : ℝ} (hT : 0 ≤ T) : ∂ₜ (solution T) 0 = 0 := by + rw [deriv_solution] + simp [hT] + +/-! + +### B.3. The equation of motion + +-/ + +/-- The motion leaving the apex at the instant `T` satisfies the equation of motion of the + dome: its acceleration `max (t - T) 0 ² / 12` is the square root of its arc length. -/ +lemma solution_equationOfMotion (T : ℝ) : S.EquationOfMotion (solution T) := by + rw [equationOfMotion_iff_scalar] + intro t + rw [deriv_deriv_solution, solution_apply, sqrt_delayedQuartic] + simp + +/-- The motion leaving the apex at the instant `T` is a solution of the dome. -/ +lemma solution_isSolution (T : ℝ) : S.IsSolution (solution T) := + ⟨(solution_contDiff T).differentiable (by simp), + Time.deriv_differentiable_of_contDiff_two _ (solution_contDiff T), + S.solution_equationOfMotion T⟩ + +/-! + +### B.4. Distinct instants give distinct motions + +-/ + +/-- Motions leaving the apex at distinct instants are distinct: at the later instant one is + still at the apex and the other is not. -/ +lemma solution_ne_of_lt {T T' : ℝ} (h : T < T') : solution T ≠ solution T' := by + intro heq + have h1 := solution_apply_pos T (t := (T' : Time)) (by rw [Time.realCast_val]; exact h) + rw [heq, solution_apply, delayedQuartic_of_le T' (by rw [Time.realCast_val])] at h1 + exact lt_irrefl _ h1 + +/-- The family of motions leaving the apex is injective in the instant of departure. -/ +lemma solution_injective : Function.Injective solution := by + intro T T' h + by_contra hne + rcases lt_or_gt_of_ne hne with hlt | hlt + · exact solution_ne_of_lt hlt h + · exact solution_ne_of_lt hlt h.symm + +/-- No motion leaving the apex is the motion staying at it. -/ +lemma solution_ne_zero (T : ℝ) : solution T ≠ 0 := by + intro h + have := solution_apply_pos T (t := ((T + 1 : ℝ) : Time)) (by rw [Time.realCast_val]; linarith) + rw [h] at this + simp at this + +/-! + +## C. The motion staying at the apex + +The force vanishes at the apex, so the constant curve there satisfies the equation of motion. + +-/ + +/-- The motion staying at rest at the apex is a solution of the dome. -/ +lemma rest_isSolution : S.IsSolution 0 := by + have h : ∂ₜ (0 : Time → EuclideanSpace ℝ (Fin 1)) = 0 := funext fun _ => Time.deriv_const 0 + refine ⟨differentiable_const 0, by rw [h]; exact differentiable_const 0, fun t => ?_⟩ + simp [h, force_zero] + +/-- The motion staying at the apex has zero energy. -/ +lemma energy_rest (t : Time) : S.energy 0 t = 0 := by + have h : ∂ₜ (0 : Time → EuclideanSpace ℝ (Fin 1)) = 0 := funext fun _ => Time.deriv_const 0 + simp [energy_eq, kineticEnergy_eq, potentialEnergy_eq, h] + +/-! + +## D. The failure of uniqueness + +Rest at the apex and departure at any instant `T ≥ 0` are distinct solutions with the same +initial data. So the uniqueness property `SimplePendulum.IsSolution.eq_of_initial` of the +pendulum fails for the dome, whose force violates the Picard–Lindelöf hypothesis +(`not_lipschitzOnWith_force`). + +-/ + +/-- Failure of uniqueness for the Norton dome: there are two distinct solutions of the + dome with the same initial position and the same initial velocity. The witnesses are the + motion staying at the apex and the motion leaving it at the instant `0`. -/ +lemma exists_isSolution_ne : + ∃ x y : Time → EuclideanSpace ℝ (Fin 1), S.IsSolution x ∧ S.IsSolution y ∧ + x 0 = y 0 ∧ ∂ₜ x 0 = ∂ₜ y 0 ∧ x ≠ y := + ⟨0, solution 0, S.rest_isSolution, S.solution_isSolution 0, by simp [solution_zero le_rfl], + by rw [deriv_solution_zero le_rfl]; exact Time.deriv_const 0, + (solution_ne_zero 0).symm⟩ + +/-- The solutions of the Norton dome are not determined by their initial position and + velocity: the uniqueness property that the simple pendulum has, + `SimplePendulum.IsSolution.eq_of_initial`, fails for the dome. -/ +lemma not_isSolution_unique : + ¬ ∀ x y : Time → EuclideanSpace ℝ (Fin 1), S.IsSolution x → S.IsSolution y → + x 0 = y 0 → ∂ₜ x 0 = ∂ₜ y 0 → x = y := by + intro h + obtain ⟨x, y, hx, hy, h0, hv, hne⟩ := S.exists_isSolution_ne + exact hne (h x y hx hy h0 hv) + +/-- For every instant `T ≥ 0` there is a solution of the dome starting from rest at the apex + which is at the apex up to `T` and off it afterwards: the motions from rest at the apex form + a one-parameter family. -/ +lemma exists_isSolution_of_nonneg {T : ℝ} (hT : 0 ≤ T) : + ∃ r : Time → EuclideanSpace ℝ (Fin 1), S.IsSolution r ∧ r 0 = 0 ∧ ∂ₜ r 0 = 0 ∧ + (∀ t : Time, t.val ≤ T → r t = 0) ∧ (∀ t : Time, T < t.val → 0 < r t 0) := + ⟨solution T, S.solution_isSolution T, solution_zero hT, deriv_solution_zero hT, + fun _ ht => solution_of_le T ht, fun _ ht => solution_apply_pos T ht⟩ + +/-- Every motion leaving the apex has zero energy: before the instant `T` it is at rest at the + apex, and the energy is conserved. Energy conservation therefore does not single out the + motion staying at the apex. -/ +lemma energy_solution (T : ℝ) (t : Time) : S.energy (solution T) t = 0 := by + have hs : ((T - 1 : ℝ) : Time).val ≤ T := by rw [Time.realCast_val]; linarith + rw [(S.solution_isSolution T).energy_eq t, + ← (S.solution_isSolution T).energy_eq ((T - 1 : ℝ) : Time)] + simp [energy_eq, kineticEnergy_eq, potentialEnergy_eq, deriv_solution, solution_of_le T hs] + +/-! + +## E. Time reversal and arrival at the apex + +The equation of motion has no velocity term, so time reversal maps solutions to solutions. +Reversing the departure at the instant `T` gives a motion sliding up the dome, arriving at the +apex at the instant `-T` with zero velocity, and staying there. For a locally Lipschitz force +this is impossible; for the dome it is the non-uniqueness read backwards. + +-/ + +/-- The second derivative is unchanged by the reversal of time, for a curve whose position and + velocity are differentiable. This is `Time.deriv_deriv_comp_neg` with its `C²` hypothesis + weakened to the regularity of a solution. -/ +lemma deriv_deriv_comp_neg_of_differentiable {M : Type} [NormedAddCommGroup M] + [NormedSpace ℝ M] (f : Time → M) (hf : Differentiable ℝ f) (hf' : Differentiable ℝ (∂ₜ f)) + (t : Time) : ∂ₜ (∂ₜ (fun s => f (-s))) t = ∂ₜ (∂ₜ f) (-t) := by + rw [← neg_neg (∂ₜ (∂ₜ f) (-t)), ← Time.deriv_comp_neg _ _ (hf' _), ← Time.deriv_neg] + congr + ext + exact Time.deriv_comp_neg f _ (hf _) + +/-- The time reversal of a twice differentiable curve satisfying the equation of motion of the + dome satisfies it too: the equation has no velocity term. -/ +lemma equationOfMotion_comp_neg {r : Time → EuclideanSpace ℝ (Fin 1)} (hr : Differentiable ℝ r) + (hr' : Differentiable ℝ (∂ₜ r)) (h : S.EquationOfMotion r) : + S.EquationOfMotion (fun t => r (-t)) := by + intro t + rw [deriv_deriv_comp_neg_of_differentiable r hr hr' t] + exact h (-t) + +/-- The time reversal of a solution of the dome is a solution. -/ +lemma IsSolution.comp_neg {S : NortonDome} {r : Time → EuclideanSpace ℝ (Fin 1)} + (h : S.IsSolution r) : S.IsSolution (fun t => r (-t)) := by + have hneg : Differentiable ℝ (fun t : Time => -t) := by fun_prop + refine ⟨h.differentiable.comp hneg, ?_, + S.equationOfMotion_comp_neg h.differentiable h.deriv_differentiable h.equationOfMotion⟩ + have hv : ∂ₜ (fun t => r (-t)) = fun t => -∂ₜ r (-t) := + funext fun t => Time.deriv_comp_neg r t (h.differentiable _) + rw [hv] + exact (h.deriv_differentiable.comp hneg).neg + +/-- The motion of the particle on the dome arriving at the apex at the instant `-T`: the time + reversal of the motion leaving the apex at the instant `T`. -/ +noncomputable def arrival (T : ℝ) : Time → EuclideanSpace ℝ (Fin 1) := fun t => solution T (-t) + +/-- The motion arriving at the apex at the instant `-T` is a solution of the dome. -/ +lemma arrival_isSolution (T : ℝ) : S.IsSolution (arrival T) := + (S.solution_isSolution T).comp_neg + +/-- The motion arriving at the apex at the instant `-T` is off the apex before that + instant. -/ +lemma arrival_apply_pos (T : ℝ) {t : Time} (h : t.val < -T) : 0 < arrival T t 0 := + solution_apply_pos T (by rw [Time.neg_val]; linarith) + +/-- The motion arriving at the apex at the instant `-T` is at the apex from that instant on: + it reaches the apex in finite time and stays there. -/ +lemma arrival_of_le (T : ℝ) {t : Time} (h : -T ≤ t.val) : arrival T t = 0 := + solution_of_le T (by rw [Time.neg_val]; linarith) + +/-- The motion arriving at the apex at the instant `-T` arrives with zero velocity. -/ +lemma deriv_arrival_of_le (T : ℝ) {t : Time} (h : -T ≤ t.val) : ∂ₜ (arrival T) t = 0 := by + unfold arrival + rw [Time.deriv_comp_neg _ _ ((solution_contDiff T).differentiable (by simp) _), + deriv_solution] + have h' : max ((-t).val - T) 0 = 0 := max_eq_right (by rw [Time.neg_val]; linarith) + simp only [h'] + simp + +end ClassicalMechanics.NortonDome + +end diff --git a/PhyslibAlpha/ClassicalMechanics/NortonDome/Sqrt.lean b/PhyslibAlpha/ClassicalMechanics/NortonDome/Sqrt.lean new file mode 100644 index 0000000000..69dd817e0f --- /dev/null +++ b/PhyslibAlpha/ClassicalMechanics/NortonDome/Sqrt.lean @@ -0,0 +1,108 @@ +/- +Copyright (c) 2026 Zhi Kai Pong. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Zhi Kai Pong +-/ +module + +public import Mathlib.Analysis.Calculus.Deriv.Slope +public import Mathlib.Analysis.SpecialFunctions.Sqrt +/-! + +# Calculus of the real square root near zero + +## i. Overview + +Two facts about the real square root at zero, where Mathlib's calculus does not reach: the +cube `√y ^ 3` is differentiable everywhere, with derivative `(3/2) √x`, and `√` is not +Lipschitz on any interval `[0, ε]`. The first gives the derivative of the potential of the +Norton dome, the second the failure of the Picard–Lindelöf hypothesis for its force. + +## ii. Key results + +- `hasDerivAt_sqrt_pow_three` is the derivative of `√y ^ 3` at every real number. +- `not_lipschitzOnWith_sqrt` is the failure of the Lipschitz property of `√` on `[0, ε]`. + +## iii. Table of contents + +- A. The derivative of the cube of the square root +- B. The square root is not Lipschitz at zero + +## iv. References + +- Norton, J. D., *The dome: an unexpectedly simple failure of determinism*, Philosophy of + Science 75 (2008), 786–798. + +-/ + +@[expose] public section + +open Filter Topology + +/-! + +## A. The derivative of the cube of the square root + +To the left of zero the square root vanishes, to the right the chain rule applies, and at zero +the difference quotient of `√t ^ 3 = t √t` is `√t`, which tends to zero. + +-/ + +/-- The cube of the real square root, `√y ^ 3`, has derivative `(3/2) √x` at every real `x`. It + is differentiable at `0`, with derivative `0`, even though `√` is not. -/ +lemma hasDerivAt_sqrt_pow_three (x : ℝ) : + HasDerivAt (fun y : ℝ => √y ^ 3) (3 / 2 * √x) x := by + rcases lt_trichotomy x 0 with hx | rfl | hx + · have hev : (fun y : ℝ => √y ^ 3) =ᶠ[𝓝 x] fun _ => 0 := by + filter_upwards [Iio_mem_nhds hx] with y hy + simp [Real.sqrt_eq_zero'.mpr (Set.mem_Iio.mp hy).le] + rw [Real.sqrt_eq_zero'.mpr hx.le, mul_zero] + exact (hasDerivAt_const x (0 : ℝ)).congr_of_eventuallyEq hev + · rw [Real.sqrt_zero, mul_zero, hasDerivAt_iff_tendsto_slope_zero] + have h : ∀ t : ℝ, t ≠ 0 → √t = t⁻¹ • (√(0 + t) ^ 3 - √0 ^ 3) := by + intro t ht + rw [zero_add, Real.sqrt_zero, zero_pow three_ne_zero, sub_zero, smul_eq_mul] + rcases le_or_gt t 0 with h | h + · simp [Real.sqrt_eq_zero'.mpr h] + · rw [pow_succ, Real.sq_sqrt h.le, ← mul_assoc, inv_mul_cancel₀ ht, one_mul] + have hc : Tendsto (fun t : ℝ => √t) (𝓝[≠] 0) (𝓝 0) := by + simpa using (Real.continuous_sqrt.tendsto (0 : ℝ)).mono_left nhdsWithin_le_nhds + exact hc.congr' (eventually_nhdsWithin_of_forall fun t ht => h t ht) + · have hs : √x ≠ 0 := (Real.sqrt_pos.mpr hx).ne' + refine ((Real.hasDerivAt_sqrt hx.ne').pow 3).congr_deriv ?_ + rw [show (3 : ℕ) - 1 = 2 from rfl, Nat.cast_ofNat] + field_simp + +/-! + +## B. The square root is not Lipschitz at zero + +A bound `√y ≤ K y` on `[0, ε]` gives `1 ≤ K √y` for every positive `y ≤ ε`, which fails at +`y = min ε (1 / (2K + 1)²)`. + +-/ + +/-- The real square root is not Lipschitz on any interval `[0, ε]` with `ε > 0`, for any + Lipschitz constant. -/ +lemma not_lipschitzOnWith_sqrt (K : NNReal) {ε : ℝ} (hε : 0 < ε) : + ¬ LipschitzOnWith K (fun y : ℝ => √y) (Set.Icc 0 ε) := by + intro h + have hK : (0 : ℝ) ≤ K := K.2 + obtain ⟨y, hy0, hyε, hy⟩ : ∃ y : ℝ, 0 < y ∧ y ≤ ε ∧ (K : ℝ) * √y < 1 := by + refine ⟨min ε ((1 / (2 * (K : ℝ) + 1)) ^ 2), ?_, min_le_left _ _, ?_⟩ + · exact lt_min hε (by positivity : (0 : ℝ) < (1 / (2 * (K : ℝ) + 1)) ^ 2) + have h1 : √(min ε ((1 / (2 * (K : ℝ) + 1)) ^ 2)) ≤ 1 / (2 * K + 1) := by + rw [Real.sqrt_le_left (by positivity)] + exact min_le_right _ _ + calc (K : ℝ) * √(min ε ((1 / (2 * (K : ℝ) + 1)) ^ 2)) ≤ K * (1 / (2 * K + 1)) := by gcongr + _ < 1 := by + rw [mul_one_div, div_lt_one (by positivity)] + linarith + have := h.dist_le_mul y ⟨hy0.le, hyε⟩ 0 ⟨le_rfl, hε.le⟩ + simp only [Real.sqrt_zero, dist_zero_right, Real.norm_eq_abs, + abs_of_nonneg (Real.sqrt_nonneg _), abs_of_pos hy0] at this + have hsq : √y * √y = y := Real.mul_self_sqrt hy0.le + have hs : 0 < √y := Real.sqrt_pos.mpr hy0 + nlinarith + +end diff --git a/PhyslibAlpha/Mathematics/LadderSystem/Basic.lean b/PhyslibAlpha/Mathematics/LadderSystem/Basic.lean index 7cfd2cf75e..41c74dd770 100644 --- a/PhyslibAlpha/Mathematics/LadderSystem/Basic.lean +++ b/PhyslibAlpha/Mathematics/LadderSystem/Basic.lean @@ -60,6 +60,7 @@ Theorems: ## iv. References +* None. -/ @[expose] public section diff --git a/PhyslibAlpha/Mathematics/LadderSystem/Irreducibility.lean b/PhyslibAlpha/Mathematics/LadderSystem/Irreducibility.lean index c863442692..9908d89c90 100644 --- a/PhyslibAlpha/Mathematics/LadderSystem/Irreducibility.lean +++ b/PhyslibAlpha/Mathematics/LadderSystem/Irreducibility.lean @@ -31,6 +31,7 @@ characteristic zero. ## iv. References +* None. -/ @[expose] public section diff --git a/PhyslibAlpha/Mathematics/LadderSystem/OccupationBasis.lean b/PhyslibAlpha/Mathematics/LadderSystem/OccupationBasis.lean index ce92e90271..e7eb9d36b3 100644 --- a/PhyslibAlpha/Mathematics/LadderSystem/OccupationBasis.lean +++ b/PhyslibAlpha/Mathematics/LadderSystem/OccupationBasis.lean @@ -49,6 +49,7 @@ Theorems: ## iv. References +* None. -/ @[expose] public section diff --git a/PhyslibAlpha/Mathematics/LadderSystem/SymmetricPower.lean b/PhyslibAlpha/Mathematics/LadderSystem/SymmetricPower.lean index 752f7e57d6..0407e4b4b1 100644 --- a/PhyslibAlpha/Mathematics/LadderSystem/SymmetricPower.lean +++ b/PhyslibAlpha/Mathematics/LadderSystem/SymmetricPower.lean @@ -26,6 +26,7 @@ isomorphism sends this basis to the occupation-number states, i.e. it is exactly ## iii. References +* None. -/ @[expose] public section diff --git a/PhyslibAlpha/Mathematics/LadderSystem/Vacuum.lean b/PhyslibAlpha/Mathematics/LadderSystem/Vacuum.lean index 469c2c4302..73321c6fc7 100644 --- a/PhyslibAlpha/Mathematics/LadderSystem/Vacuum.lean +++ b/PhyslibAlpha/Mathematics/LadderSystem/Vacuum.lean @@ -45,6 +45,7 @@ Theorems: ## iv. References +* None. -/ @[expose] public section diff --git a/PhyslibAlpha/Mathematics/PartialDerivativeTest.lean b/PhyslibAlpha/Mathematics/PartialDerivativeTest.lean index 5660362250..f657ed151e 100644 --- a/PhyslibAlpha/Mathematics/PartialDerivativeTest.lean +++ b/PhyslibAlpha/Mathematics/PartialDerivativeTest.lean @@ -55,20 +55,20 @@ noncomputable def hessianBilinearCompanion {V : Type*} [NormedAddCommGroup V] simp_rw [Matrix.vecCons, succ_eq_add_one, reduceAdd, ← curryLeft_apply, map_add] simp only [curryLeft_apply, succ_eq_add_one, reduceAdd, - ContinuousMultilinearMap.add_apply] + add_apply] abel) (by simp_rw [Matrix.vecCons, ← curryLeft_apply] simp only [map_smul, curryLeft_apply, succ_eq_add_one, reduceAdd, - ContinuousMultilinearMap.smul_apply, smul_eq_mul] + smul_eq_mul] ring_nf simp) (fun _ _ _ ↦ by simp_rw [Matrix.vecCons, succ_eq_add_one, reduceAdd, ← curryLeft_apply, map_add] - simp only [ContinuousMultilinearMap.add_apply, curryLeft_apply, succ_eq_add_one, reduceAdd, + simp only [add_apply, curryLeft_apply, succ_eq_add_one, reduceAdd, Matrix.Fin.cons_vecEmpty, Matrix.Fin.cons_vecCons] abel) (by simp_rw [Matrix.vecCons, ← curryLeft_apply] - simp only [map_smul, ContinuousMultilinearMap.smul_apply, curryLeft_apply, succ_eq_add_one, + simp only [map_smul, smul_apply, curryLeft_apply, succ_eq_add_one, reduceAdd, smul_eq_mul] simp_rw [← mul_add] simp) @@ -295,7 +295,7 @@ lemma coercive_of_posdefHalf {V : Type*} [NormedAddCommGroup V] [NormedSpace ℝ F.toContinuousMultilinearMapHalfPolarBilin) := by obtain hsub | hnt := subsingleton_or_nontrivial V · exact ⟨1, one_pos, fun u => by rw [Subsingleton.elim u 0]; simp⟩ - haveI := hnt + have := hnt have h₀ : ∃ x : ↑(Metric.sphere 0 1), ∀ (y : ↑(Metric.sphere 0 1)), (fun y ↦ F.toContinuousMultilinearMapHalfPolarBilin ![y, y]) x.1 ≤ (fun y ↦ F.toContinuousMultilinearMapHalfPolarBilin ![y, y]) @@ -424,7 +424,7 @@ lemma coercive_of_posdef {V : Type*} [NormedAddCommGroup V] [NormedSpace ℝ V] (iteratedFDeriv ℝ 2 f x₀)) := by obtain hsub | hnt := subsingleton_or_nontrivial V · exact ⟨1, one_pos, fun u => by rw [Subsingleton.elim u 0]; simp⟩ - haveI := hnt + have := hnt have h₀ : ∃ x : ↑(Metric.sphere 0 1), ∀ (y : ↑(Metric.sphere 0 1)), (fun y ↦ (iteratedFDeriv ℝ 2 f x₀) ![y, y]) x.1 ≤ (fun y ↦ (iteratedFDeriv ℝ 2 f x₀) ![y, y]) y.1 := by diff --git a/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/Invariants.lean b/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/Invariants.lean index cd736e10d3..4ff8121f03 100644 --- a/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/Invariants.lean +++ b/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/Invariants.lean @@ -20,9 +20,10 @@ public import Mathlib.Analysis.Real.Pi.Irrational ## i. Overview -In the *bilinear formalism* of the two Higgs doublet model (hep-ph/0605184) the four -gauge-invariant bilinears — the Gram vector `gramVector` — describe the gauge orbits of the -configuration space. This file proves the corresponding statement for the potential: every +In the *bilinear formalism* of the two Higgs doublet model (hep-ph/0605184 +[ref: arxiv_hep_ph_0605184]) the four gauge-invariant bilinears — the Gram vector `gramVector` +— describe the gauge orbits of the configuration space. This file proves the corresponding +statement for the potential: every gauge-invariant polynomial effective potential is a polynomial in these four gauge-invariant bilinears. @@ -61,11 +62,10 @@ and runs the following physical pipeline: ## iv. References -* The bilinear formalism: https://arxiv.org/abs/hep-ph/0605184. - -Mathematically the result is the first fundamental theorem of invariant theory for `SU(2)` acting on -two doublets in `ℂ²`. +* The bilinear formalism: https://arxiv.org/abs/hep-ph/0605184. [ref: arxiv_hep_ph_0605184] +Mathematically the result is the first fundamental theorem of invariant theory for `SU(2)` +acting on two doublets in `ℂ²`. -/ @[expose] public section diff --git a/PhyslibAlpha/QuantumMechanics/HarmonicOscillator/Basic.lean b/PhyslibAlpha/QuantumMechanics/HarmonicOscillator/Basic.lean index d8ec279b9b..d081d6f546 100644 --- a/PhyslibAlpha/QuantumMechanics/HarmonicOscillator/Basic.lean +++ b/PhyslibAlpha/QuantumMechanics/HarmonicOscillator/Basic.lean @@ -15,7 +15,7 @@ public import Physlib.QuantumMechanics.QuantumSystem.Basic ## i. Overview -The harmonic oscillator is one of the most public important examples in non-relativistic quantum mechanics. +The harmonic oscillator is one of the most important examples in non-relativistic quantum mechanics. It describes a particle of mass `m` subject to a positive-definite quadratic potential in `d` dimensions. @@ -49,6 +49,7 @@ in `d` dimensions. ## iv. References +* None. -/ @[expose] public section diff --git a/PhyslibAlpha/QuantumMechanics/HarmonicOscillator/LadderOperators.lean b/PhyslibAlpha/QuantumMechanics/HarmonicOscillator/LadderOperators.lean index 4e6c97aa4c..1c0a69a040 100644 --- a/PhyslibAlpha/QuantumMechanics/HarmonicOscillator/LadderOperators.lean +++ b/PhyslibAlpha/QuantumMechanics/HarmonicOscillator/LadderOperators.lean @@ -54,6 +54,7 @@ Theorems: ## iv. References +* None. -/ @[expose] public section diff --git a/PhyslibAlpha/QuantumMechanics/HarmonicOscillator/Vacuum.lean b/PhyslibAlpha/QuantumMechanics/HarmonicOscillator/Vacuum.lean index 27dea1c4c5..b3094a4185 100644 --- a/PhyslibAlpha/QuantumMechanics/HarmonicOscillator/Vacuum.lean +++ b/PhyslibAlpha/QuantumMechanics/HarmonicOscillator/Vacuum.lean @@ -37,6 +37,7 @@ mode, so it is proved separately. ## iii. References +* None. -/ @[expose] public section diff --git a/PhyslibAlpha/QuantumMechanics/QuantumHarmonicOscillator.lean b/PhyslibAlpha/QuantumMechanics/QuantumHarmonicOscillator.lean index 5eded540cb..c79cb8fb2b 100644 --- a/PhyslibAlpha/QuantumMechanics/QuantumHarmonicOscillator.lean +++ b/PhyslibAlpha/QuantumMechanics/QuantumHarmonicOscillator.lean @@ -193,7 +193,7 @@ lemma probabilityOf_eq_poisson_C (n : ℕ) (α : ℂ) : · apply div_nonneg · apply mul_nonneg · apply Real.exp_nonneg - · simp + · exact pow_nonneg (NNReal.coe_nonneg _) n · simp @@ -380,18 +380,23 @@ def coherentState_ℓ2 (α : ℂ) : lp (fun _ : ℕ => ℂ) 2 := { val := coherentState α property := by simp only [lp, Memℓp, OfNat.ofNat_ne_zero, ↓reduceIte, ENNReal.ofNat_ne_top, Summable, - ENNReal.toReal_ofNat, Real.rpow_ofNat, AddSubgroup.mem_mk, AddSubmonoid.mem_mk, - AddSubsemigroup.mem_mk, Set.mem_setOf_eq, coherentState, Complex.ofReal_exp, - Complex.ofReal_div, Complex.ofReal_neg, Complex.ofReal_pow, Complex.ofReal_ofNat, - Complex.norm_div, Complex.norm_mul, norm_pow, Complex.norm_real, Real.norm_eq_abs] + ENNReal.toReal_ofNat, Real.rpow_ofNat] use (‖Complex.exp (-↑‖α‖ ^ 2 / 2)^2 * Complex.exp (‖α‖^2)‖) suffices HasSum (fun i : ℕ ↦ ( ‖α‖ ^ i / |√↑i.factorial|) ^ 2) ‖Complex.exp (↑‖α‖ ^ 2)‖ by - simp_rw [div_pow] at * - simp_rw [mul_pow, ← mul_div] - simp only [sq_abs, Nat.cast_nonneg, Real.sq_sqrt, Complex.norm_mul, norm_pow] at * - exact HasSum.const_smul (γ := ℝ) _ this + simp_rw [div_pow] at this + have h := this.mul_left (Real.exp (-‖α‖ ^ 2 / 2) ^ 2) + convert h using 2 with i + · rfl + · unfold coherentState + rw [norm_div, norm_mul, norm_pow, Complex.norm_real, Complex.norm_real, + Real.norm_eq_abs, Real.norm_eq_abs, Real.abs_exp, div_pow, mul_pow] + ring + · have hc : (-(↑‖α‖ : ℂ) ^ 2 / 2) = ((-‖α‖ ^ 2 / 2 : ℝ) : ℂ) := by + push_cast + ring + rw [norm_mul, norm_pow, hc, Complex.norm_exp_ofReal] have (r : ℝ) : |√r| = √r := by rw [abs_eq_self] simp diff --git a/PhyslibAlpha/QuantumMechanics/StinespringDilation.lean b/PhyslibAlpha/QuantumMechanics/StinespringDilation.lean index 2f58d0150c..bb467a4c32 100644 --- a/PhyslibAlpha/QuantumMechanics/StinespringDilation.lean +++ b/PhyslibAlpha/QuantumMechanics/StinespringDilation.lean @@ -76,6 +76,13 @@ def stinespringOp {R : Type*} [Ring R] ∑ i, K i ⊗ₖ single i (0 : Fin 1) (1 : R) fun x y => V₀ x (y,0) +/-- Entrywise formula for the Stinespring isometry: its `((x₁, x₂), y)` entry is `K x₂ x₁ y`. -/ +theorem stinespringOp_apply {R : Type*} [Ring R] {m r : Type*} [Fintype r] [DecidableEq r] + (K : r → Matrix m m R) (x : m × r) (y : m) : + stinespringOp K x y = K x.2 x.1 y := by + unfold stinespringOp + simp [Matrix.sum_apply, Matrix.kroneckerMap_apply, Matrix.single_apply] + /-- The Stinespring dilation. -/ def stinespringDilation {R : Type*} [Ring R] [StarRing R] {m r : Type*} [Fintype r] [DecidableEq r] [Fintype m] @@ -96,12 +103,12 @@ lemma stinespringOp_adjoint_mul_self {R : Type*} [Ring R] [StarRing R] (K : r → Matrix m m R) : ∑ i, star K i * K i = (stinespringOp K)ᴴ * stinespringOp K := by ext i j - unfold stinespringOp rw [Matrix.mul_apply] rw [Matrix.sum_apply] - simp only [Pi.star_apply, Matrix.mul_apply, star_apply, single, Fin.isValue, Matrix.sum_apply, - kroneckerMap_apply, of_apply, and_true, mul_ite, mul_one, mul_zero, Finset.sum_ite_eq', - Finset.mem_univ, ↓reduceIte, conjTranspose_apply]; + simp only [conjTranspose_apply] + simp only [stinespringOp, Pi.star_apply, Matrix.mul_apply, star_apply, single, Fin.isValue, + Matrix.sum_apply, kroneckerMap_apply, of_apply, and_true, mul_ite, mul_one, mul_zero, + Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte]; erw [ Finset.sum_product, Finset.sum_comm ] /-- A useful identity for completely positive, trace non-increasing maps. -/ @@ -541,17 +548,14 @@ theorem tracefree_version {R : Type*} [RCLike R] (ρ : Matrix m m R) : let K' := fun i x y => star <| K i y x; let U := (stinespringOp K'); Uᴴ * (ρ ⊗ₖ (1 : Matrix r r R)) * U = stinespringForm K ρ := by - -- Since my proof broke in 4.27 -> 4.31, here's Aristotle's proof. - simp only [stinespringOp, star_def, Fin.isValue, stinespringForm, stinespringDilation]; + show (stinespringOp fun i => (K i)ᴴ)ᴴ * (ρ ⊗ₖ (1 : Matrix r r R)) * + (stinespringOp fun i => (K i)ᴴ) = stinespringForm K ρ ext x y - simp only [Fin.isValue, Matrix.mul_apply, conjTranspose_apply, star_def, kroneckerMap_apply, - Matrix.one_apply, mul_ite, mul_one, mul_zero, tr₂] - ring_nf; - simp only [Fin.isValue, Matrix.sum_apply, kroneckerMap_apply, map_sum, map_mul, - RingHomCompTriple.comp_apply, RingHom.id_apply, Fintype.sum_prod_type, Finset.sum_ite_eq', - Finset.mem_univ, ↓reduceIte]; - simp only [single, Fin.isValue, of_apply, and_true, MonoidWithZeroHom.map_ite_one_zero, mul_ite, - mul_one, mul_zero, Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte]; + simp only [stinespringForm, stinespringDilation, tr₂, Matrix.mul_apply] + simp only [conjTranspose_apply] + simp only [stinespringOp_apply, conjTranspose_apply, star_star, kroneckerMap_apply, + Matrix.one_apply, mul_ite, mul_one, mul_zero, Fintype.sum_prod_type, + Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte] exact Finset.sum_comm /-- A Heisberg picture / Schrödinger picture view of the Stinespring dilation. -/ @@ -605,32 +609,12 @@ theorem unitaryForm_of_general {R : Type*} [RCLike R] {m r : ℕ} (hK : ∑ i, (K i)ᴴ * K i = 1) (z : Fin r) : stinespringGeneralForm K z (Ud hK z) = stinespringUnitaryForm hK z := by - unfold - stinespringUnitaryForm tr₂ Ud - stinespringGeneralForm dilation generalDilation tr₂ - ext a b - congr - ext c - repeat rw [mul_apply] - repeat rw [Fintype.sum_prod_type] - congr - ext d - congr - ext e - repeat rw [mul_apply] - simp only [kroneckerMap_apply, ite_mul, dite_mul, - conjTranspose_apply, star_def] - repeat rw [Fintype.sum_prod_type] - congr - · ext f - congr - ext g - simp only [ite_eq_right_iff, left_eq_dite_iff, mul_eq_mul_right_iff, mul_eq_zero] - intro hg - subst g - intro h - simp at h ⊢ - · split_ifs with g₀ <;> rfl + have h : dilation K z (Ud hK z) = Ud hK z := by + ext x y + by_cases hy : y.2 = z <;> simp [dilation, generalDilation, Ud, hy] + funext ρ + simp only [stinespringGeneralForm, stinespringUnitaryForm] + rw [h] /-- The Stinespring unitary form as a general form applied to the unitary dilation. -/ theorem unitaryForm_of_general_e {R : Type*} [RCLike R] {m r : ℕ} @@ -638,32 +622,12 @@ theorem unitaryForm_of_general_e {R : Type*} [RCLike R] {m r : ℕ} (hK : ∑ i, (K i)ᴴ * K i = 1) (z : Fin r) (e : Matrix (Fin r) (Fin r) R) : stinespringGeneralFormE K z e (Ud hK z) = stinespringUnitaryFormE hK z e := by - unfold - stinespringUnitaryFormE tr₂ Ud - stinespringGeneralFormE dilation generalDilation tr₂ - ext a b - congr - ext c - repeat rw [mul_apply] - repeat rw [Fintype.sum_prod_type] - congr - ext d - congr - ext e - repeat rw [mul_apply] - simp only [kroneckerMap_apply, ite_mul, dite_mul, - conjTranspose_apply, star_def] - repeat rw [Fintype.sum_prod_type] - congr - · ext f - congr - ext g - simp only [ite_eq_right_iff, left_eq_dite_iff, mul_eq_mul_right_iff, mul_eq_zero] - intro hg - subst g - intro h - simp at h ⊢ - · split_ifs with g₀ <;> rfl + have h : dilation K z (Ud hK z) = Ud hK z := by + ext x y + by_cases hy : y.2 = z <;> simp [dilation, generalDilation, Ud, hy] + funext ρ + simp only [stinespringGeneralFormE, stinespringUnitaryFormE] + rw [h] /-- @@ -677,25 +641,20 @@ lemma stinespringGeneralForm_works {R : Type*} [RCLike R] {m r : ℕ} (K : Fin r → Matrix (Fin m) (Fin m) R) (z : Fin r) (M : Matrix (Fin m × Fin r) (Fin m × Fin r) R) : stinespringGeneralForm K z M = krausApply K := by - -- my 4.27 proof failed in 4.31 so this is Aristotle: - unfold stinespringGeneralForm krausApply dilation generalDilation stinespringOp tr₂; - ext ρ i j; - simp only [Fin.isValue, Matrix.sum_apply, kroneckerMap_apply, Matrix.mul_apply, ite_mul, - conjTranspose_apply, star_def]; - simp only [single, Fin.isValue, of_apply, and_true, mul_ite, mul_one, mul_zero, - Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte, Finset.sum_ite, not_and, - Finset.sum_const_zero, add_zero]; - refine Finset.sum_congr rfl fun x _ => ?_ - rw [ ← Finset.sum_subset - (Finset.subset_univ (Finset.image (fun y : Fin m => ( y, z ) ) Finset.univ))] - · rw [ Finset.sum_image ] - · simp only [and_true, Finset.sum_filter, ite_not, ↓reduceIte]; - refine Finset.sum_congr rfl fun y _ => ?_ - erw [ Finset.sum_product, Finset.sum_product ] - simp [ Finset.sum_ite, Finset.filter_eq', Finset.filter_ne' ]; - · simp only [Finset.coe_univ, Set.injOn_univ]; - exact fun a b h => by injection h; - · aesop + funext ρ + ext i j + simp only [stinespringGeneralForm, krausApply, tr₂, Matrix.sum_apply, Matrix.mul_apply, + conjTranspose_apply, Finset.sum_mul] + simp [dilation, generalDilation, stinespringOp_apply, kroneckerMap_apply, + Matrix.single_apply, apply_ite star, ite_and, Fintype.sum_prod_type, mul_ite, ite_mul, + Finset.sum_ite_eq] + simp only [@eq_comm _ z] + have hite : ∀ (c : Prop) [Decidable c] (A B C : R), + (if c then (if c then A else B) else (if c then C else 0)) = if c then A else 0 := by + intro c _ A B C + split_ifs <;> rfl + simp_rw [hite] + simp [Finset.sum_ite_eq'] /-- @@ -720,13 +679,6 @@ def krausCompletion {R : Type*} [RCLike R] {m r : ℕ} (fun H => stinespringOp K ⟨x.1, ⟨x.2, H⟩⟩) fun _ => (CFC.sqrt (1 - (stinespringOp K)ᴴ * (stinespringOp K)) : Matrix _ _ _) x.1 -/-- Entrywise formula for the Stinespring isometry: its `((x₁, x₂), y)` entry is `K x₂ x₁ y`. -/ -theorem stinespringOp_apply {R : Type*} [Ring R] {m r : Type*} [Fintype r] [DecidableEq r] - (K : r → Matrix m m R) (x : m × r) (y : m) : - stinespringOp K x y = K x.2 x.1 y := by - unfold stinespringOp - simp [Matrix.sum_apply, Matrix.kroneckerMap_apply, Matrix.single_apply] - /-- The Gram matrix of the Stinespring isometry is `∑ i, (K i)ᴴ * K i`. -/ theorem stinespringOp_gram {R : Type*} [RCLike R] {m r : ℕ} (K : Fin r → Matrix (Fin m) (Fin m) R) : @@ -893,8 +845,6 @@ theorem stinespringForm_eq {R : Type*} [RCLike R] {m r : ℕ} (K : Fin r → Matrix (Fin m) (Fin m) R) (ρ : Matrix (Fin m) (Fin m) R) : tr₂ (stinespringDilation K ρ) = krausApply K ρ := by - unfold tr₂ stinespringDilation krausApply ext i j - simp only [stinespringOp, Fin.isValue, Matrix.mul_apply, conjTranspose_apply, star_def] - simp [Matrix.mul_apply, Finset.sum_mul, Matrix.sum_apply, kroneckerMap_apply, - Matrix.single] + simp only [tr₂, stinespringDilation, krausApply, Matrix.sum_apply, Matrix.mul_apply, + conjTranspose_apply, stinespringOp_apply, Finset.sum_mul] diff --git a/PhyslibAlpha/SpaceAndTime/Space/Surfaces/HalfPlane.lean b/PhyslibAlpha/SpaceAndTime/Space/Surfaces/HalfPlane.lean index d7cbaf5bac..6f6c91d9ef 100644 --- a/PhyslibAlpha/SpaceAndTime/Space/Surfaces/HalfPlane.lean +++ b/PhyslibAlpha/SpaceAndTime/Space/Surfaces/HalfPlane.lean @@ -115,10 +115,10 @@ def halfPlaneSubmodule : Submodule ℝ (Space 3) where carrier := {x | x (2 : Fin 3) = 0} zero_mem' := by simp add_mem' hx hy := by - rw [Set.mem_setOf_eq] at hx hy ⊢ + rw [Set.mem_ofPred_eq] at hx hy ⊢ rw [Space.add_apply, hx, hy, add_zero] smul_mem' c x hx := by - rw [Set.mem_setOf_eq] at hx ⊢ + rw [Set.mem_ofPred_eq] at hx ⊢ rw [Space.smul_apply, hx, mul_zero] lemma halfPlane_mem_halfPlaneSubmodule (x : Space 2) : halfPlane x ∈ halfPlaneSubmodule := by diff --git a/QuantumInfo/Capacity/Capacity.lean b/QuantumInfo/Capacity/Capacity.lean index d35e563d87..1a3298941d 100644 --- a/QuantumInfo/Capacity/Capacity.lean +++ b/QuantumInfo/Capacity/Capacity.lean @@ -95,8 +95,7 @@ And other important theorems like superdense coding, nonadditivity, superactivat ## iv. References - * [Watrous's notes](https://cs.uwaterloo.ca/~watrous/TQI/TQI.8.pdf), Chapter 8 of - *The Theory of Quantum Information*. +* Watrous's notes, Chapter 8 of The Theory of Quantum Information. [ref: watrous_tqi_ch8] -/ @[expose] public section diff --git a/QuantumInfo/Channels/Bundled.lean b/QuantumInfo/Channels/Bundled.lean index 63676a449c..220ac9a17a 100644 --- a/QuantumInfo/Channels/Bundled.lean +++ b/QuantumInfo/Channels/Bundled.lean @@ -156,6 +156,7 @@ noncomputable instance instFunLike : FunLike (HPMap dIn dOut ℂ) (HermitianMat lemma apply_hermitianMat_eq (Λ : HPMap dIn dOut ℂ) (ρ : HermitianMat dIn ℂ) : Λ ρ = ⟨Λ.map ρ.1, Λ.HP ρ.2⟩ := rfl +set_option backward.isDefEq.respectTransparency false in instance [Fintype dIn] : ContinuousLinearMapClass (HPMap dIn dOut ℂ) ℝ (HermitianMat dIn ℂ) (HermitianMat dOut ℂ) where map_add f x y := HermitianMat.ext <| LinearMap.map_add f.toLinearMap x y @@ -191,6 +192,7 @@ noncomputable instance instFunLike : FunLike (PMap dIn dOut ℂ) (HermitianMat d lemma apply_hermitianMat_eq (Λ : PMap dIn dOut ℂ) (ρ : HermitianMat dIn ℂ) : Λ ρ = ⟨Λ.map ρ.1, Λ.HP ρ.2⟩ := rfl +set_option backward.isDefEq.respectTransparency false in set_option synthInstance.maxHeartbeats 40000 in instance instLinearMapClass : LinearMapClass (PMap dIn dOut ℂ) ℝ (HermitianMat dIn ℂ) (HermitianMat dOut ℂ) where map_add f x y := HermitianMat.ext <| LinearMap.map_add f.toLinearMap x y diff --git a/QuantumInfo/Channels/CPTP.lean b/QuantumInfo/Channels/CPTP.lean index 33f6b3d08e..27578e118b 100644 --- a/QuantumInfo/Channels/CPTP.lean +++ b/QuantumInfo/Channels/CPTP.lean @@ -297,6 +297,7 @@ def replacement [Nonempty dIn] [DecidableEq dOut] (ρ : MState dOut) : CPTPMap d TP := by intro; simp [Matrix.trace_kronecker] } +set_option backward.isDefEq.respectTransparency false in /-- The output of `replacement ρ` is always that `ρ`. -/ @[simp] theorem replacement_apply [Nonempty dIn] [DecidableEq dOut] (ρ : MState dOut) (ρ₀ : MState dIn) : @@ -381,6 +382,7 @@ def piProd (Λi : (i:ι) → CPTPMap (dI i) (dO i)) : CPTPMap ((i:ι) → dI i) cp := MatrixMap.IsCompletelyPositive.piProd (fun i ↦ (Λi i).cp) TP := MatrixMap.IsTracePreserving.piProd (fun i ↦ (Λi i).TP) +set_option backward.isDefEq.respectTransparency false in theorem fin_1_piProd {dI : Fin 1 → Type v} [Fintype (dI 0)] [DecidableEq (dI 0)] {dO : Fin 1 → Type w} [Fintype (dO 0)] [DecidableEq (dO 0)] @@ -447,6 +449,7 @@ def IsUnitary (Λ : CPTPMap dIn dIn) : Prop := theorem IsUnitary_iff_uConj (Λ : CPTPMap dIn dIn) : IsUnitary Λ ↔ ∃ U, ∀ ρ, Λ ρ = ρ.uConj U := by simp_rw [IsUnitary, ← ofUnitary_eq_conj, CPTPMap.funext_iff] +set_option backward.isDefEq.respectTransparency false in theorem IsUnitary_equiv (σ : dIn ≃ dIn) : IsUnitary (ofEquiv σ) := by have h_unitary : ∃ U : Matrix dIn dIn ℂ, U * U.conjTranspose = 1 ∧ U.conjTranspose * U = 1 ∧ ∀ x : dIn, (∀ y : dIn, (U y x = 1) ↔ (y = σ x)) ∧ ∀ y : dIn, (U y x = 0) ↔ (y ≠ σ x) := by simp only [Matrix.conjTranspose, RCLike.star_def]; @@ -556,7 +559,7 @@ private lemma exists_unitary_extending_isometry contrapose! this · refine ⟨fun i => if hi : i ∈ Set.range emb then u (Classical.choose hi) else 0, Set.range emb, ?_, ?_ ⟩ · simp +contextual only [Orthonormal, h_orthonormal.1, implies_true, true_and, - Set.mem_range, Set.restrict_apply, Subtype.forall, ↓reduceDIte] + Set.mem_range, Set.domRestrict_apply, Subtype.forall, ↓reduceDIte] intro i j hij split_ifs with h₁ h₂ · apply h_orthonormal.2 @@ -576,6 +579,7 @@ private lemma exists_unitary_extending_isometry exact this · simp [hb, u] +set_option backward.isDefEq.respectTransparency false in omit [DecidableEq dOut] [Inhabited dOut] in /-- Given Kraus operators K indexed by (dOut × dIn), define the isometry matrix @@ -712,6 +716,7 @@ private lemma purify_of_kraus_entry (K : (dOut × dIn) → Matrix dOut dIn ℂ) refine Finset.sum_congr rfl fun _ _ ↦ ?_ rw [Finset.sum_comm] +set_option backward.isDefEq.respectTransparency false in theorem exists_purify (Λ : CPTPMap dIn dOut) : ∃ (Λ' : CPTPMap (dIn × dOut × dOut) (dIn × dOut × dOut)), Λ'.IsUnitary ∧ diff --git a/QuantumInfo/Channels/Dual.lean b/QuantumInfo/Channels/Dual.lean index b9e38a470b..456d815672 100644 --- a/QuantumInfo/Channels/Dual.lean +++ b/QuantumInfo/Channels/Dual.lean @@ -67,6 +67,7 @@ theorem Dual.trace_eq (M : MatrixMap dIn dOut R) (A : Matrix dIn dIn R) (B : Mat --all properties below should provable just from `inner_eq`, since the definition of `dual` itself -- is pretty hairy (and maybe could be improved...) +set_option backward.isDefEq.respectTransparency false in /-- The dual of a `IsHermitianPreserving` map also `IsHermitianPreserving`. -/ theorem IsHermitianPreserving.dual {M : MatrixMap dIn dOut ℂ} (h : M.IsHermitianPreserving) : M.dual.IsHermitianPreserving := by @@ -407,10 +408,8 @@ omit [Fintype dOut] in theorem HPMap.ofHermitianMat_linearMap (f : HPMap dIn dOut ℂ) : ofHermitianMat (LinearMapClass.linearMap f) = f := by ext : 3 - simp only [map, ofHermitianMat, instFunLike, LinearMap.coe_coe, HermitianMat.val_eq_coe, - HermitianMat.mat_mk, LinearMap.coe_mk, AddHom.coe_mk, - ← map_smul, ← map_add] - simp only [map_add, map_smul, realPart, imaginaryPart, LinearMap.coe_comp, Function.comp_apply] + simp only [map, ofHermitianMat, instFunLike, LinearMap.coe_coe, LinearMap.coe_mk, AddHom.coe_mk] + simp only [realPart, imaginaryPart, LinearMap.coe_comp, Function.comp_apply] simp only [selfAdjointPart, LinearMap.coe_mk, AddHom.coe_mk, HermitianMat.mat_mk,LinearMap.map_smul_of_tower, skewAdjoint.negISMul] simp only [Matrix.add_apply, Matrix.smul_apply, smul_eq_mul] diff --git a/QuantumInfo/Channels/MatrixMap.lean b/QuantumInfo/Channels/MatrixMap.lean index 0ef65f9fd5..3b25b8564d 100644 --- a/QuantumInfo/Channels/MatrixMap.lean +++ b/QuantumInfo/Channels/MatrixMap.lean @@ -64,6 +64,7 @@ def id : MatrixMap A A R := LinearMap.id def choi_matrix (M : MatrixMap A B R) : Matrix (B × A) (B × A) R := fun (j₁,i₁) (j₂,i₂) ↦ M (Matrix.single i₁ i₂ 1) j₁ j₂ +set_option backward.isDefEq.respectTransparency false in /-- Given the Choi matrix, generate the corresponding R-linear map between matrices as a MatrixMap. This is the inverse of `MatrixMap.choi_matrix`. -/ def of_choi_matrix (M : Matrix (B × A) (B × A) R) : MatrixMap A B R where @@ -73,12 +74,14 @@ def of_choi_matrix (M : Matrix (B × A) (B × A) R) : MatrixMap A B R where funext b₁ b₂ simp only [Matrix.smul_apply, smul_eq_mul, RingHom.id_apply, Finset.mul_sum, mul_assoc] +set_option backward.isDefEq.respectTransparency false in /-- Proves that `MatrixMap.of_choi_matrix` and `MatrixMap.choi_matrix` inverses. -/ @[simp] theorem map_choi_inv (M : Matrix (B × A) (B × A) R) : choi_matrix (of_choi_matrix M) = M := by ext ⟨i₁,i₂⟩ ⟨j₁,j₂⟩ simp [of_choi_matrix, choi_matrix, Matrix.single, ite_and] +set_option backward.isDefEq.respectTransparency false in /-- Proves that `MatrixMap.choi_matrix` and `MatrixMap.of_choi_matrix` inverses. -/ @[simp] theorem choi_map_inv (M : MatrixMap A B R) : of_choi_matrix (choi_matrix M) = M := by diff --git a/QuantumInfo/Channels/Pinching.lean b/QuantumInfo/Channels/Pinching.lean index d734407a7c..094d5f1232 100644 --- a/QuantumInfo/Channels/Pinching.lean +++ b/QuantumInfo/Channels/Pinching.lean @@ -78,6 +78,7 @@ theorem pinching_kraus_ortho (ρ : MState d) (i j : spectrum ℝ ρ.m) : · grind [sq, HermitianMat.mat_pow, pinching_sq_eq_self] · exact pinching_kraus_orthogonal ρ hij +set_option backward.isDefEq.respectTransparency false in theorem pinching_sum (ρ : MState d) : ∑ k, pinching_kraus ρ k = 1 := by ext i j simp only [pinching_kraus, HermitianMat.cfc] @@ -252,6 +253,7 @@ theorem pinching_idempotent (ρ σ : MState d) : ext1 grind [pinching_eq_sum_conj] +set_option backward.isDefEq.respectTransparency false in theorem inner_cfc_pinching (ρ σ : MState d) (f : ℝ → ℝ) : ⟪ρ.M, (pinching_map σ ρ).M.cfc f⟫ = ⟪(pinching_map σ ρ).M, (pinching_map σ ρ).M.cfc f⟫ := by nth_rw 2 [pinchingMap_apply_M] diff --git a/QuantumInfo/Channels/Unbundled.lean b/QuantumInfo/Channels/Unbundled.lean index 8cf0b84eff..b12dce9eb5 100644 --- a/QuantumInfo/Channels/Unbundled.lean +++ b/QuantumInfo/Channels/Unbundled.lean @@ -37,6 +37,7 @@ variable {M : MatrixMap A B R} {M₂ : MatrixMap B C R} def IsTracePreserving (M : MatrixMap A B R) : Prop := ∀ (x : Matrix A A R), (M x).trace = x.trace +set_option backward.isDefEq.respectTransparency false in /-- A map is trace preserving iff the partial trace of the Choi matrix is the identity. -/ theorem IsTracePreserving_iff_trace_choi [DecidableEq A] (M : MatrixMap A B R) : M.IsTracePreserving ↔ M.choi_matrix.traceLeft = 1 := by @@ -562,6 +563,7 @@ theorem of_kraus_CP (K : κ → Matrix B A 𝕜) : (of_kraus K K).IsCompletelyPo apply Classical.decEq); exact h_sum_congruence.symm ▸ IsCompletelyPositive.finset_sum h_congruence_CP +set_option backward.isDefEq.respectTransparency false in theorem exists_kraus_of_choi_PSD (C : Matrix (B × A) (B × A) 𝕜) (hC : C.PosSemidef) : ∃ (K : (B × A) → Matrix B A 𝕜), C = (MatrixMap.of_kraus K K).choi_matrix := by @@ -797,7 +799,7 @@ theorem cp_subunital_kadison_schwarz {M : MatrixMap A B ℂ} [DecidableEq B] ext i j cases i <;> cases j <;> simp [Matrix.fromBlocks, sub_eq_add_neg, add_left_comm, add_comm] - letI : Invertible (1 : Matrix B B ℂ) := invertibleOne + let : Invertible (1 : Matrix B B ℂ) := invertibleOne have h1 := (Matrix.PosDef.fromBlocks₁₁ (B := M X) (D := M (Xᴴ * X)) (hA := (Matrix.PosDef.one : (1 : Matrix B B ℂ).PosDef))).mp hsum diff --git a/QuantumInfo/ClassicalInfo/Distribution.lean b/QuantumInfo/ClassicalInfo/Distribution.lean index 9f81677cbf..8d395c1edf 100644 --- a/QuantumInfo/ClassicalInfo/Distribution.lean +++ b/QuantumInfo/ClassicalInfo/Distribution.lean @@ -149,6 +149,7 @@ def extend_right (d : ProbDistribution α) : ProbDistribution (α ⊕ β) := def extend_left (d : ProbDistribution α) : ProbDistribution (β ⊕ α) := ⟨fun x ↦ Sum.casesOn x (Function.const _ 0) d.val, by simp⟩ +set_option backward.isDefEq.respectTransparency false in /-- Make a convex mixture of two distributions on the same set. -/ instance instMixable : Mixable (α → ℝ) (ProbDistribution α) := Mixable.instSubtype (inferInstance) (fun _ _ hab hx hy ↦ by @@ -164,6 +165,7 @@ def relabel (d : ProbDistribution α) (σ : β ≃ α) : ProbDistribution β := -- The two properties below (and congrRandVar) follow from the fact that Distribution is a -- contravariant functor. -- However, mathlib does not seem to support that outside of the CategoryTheory namespace +set_option backward.isDefEq.respectTransparency false in /-- ProbDistribution on α and β are equivalent for equivalent types α ≃ β. -/ def congr (σ : α ≃ β) : ProbDistribution α ≃ ProbDistribution β := by constructor @@ -252,6 +254,7 @@ def expect_val (X : RandVar α T) : T := by exact Set.mem_range.mp (inst.convex.sum_mem h₀ h₁ hz) exact (inst.mkT ht).1 +set_option backward.isDefEq.respectTransparency false in /-- The expectation value of a random variable over `α = Fin 2` is the same as `Mixable.mix` with probabiliy weight `X.distr 0` -/ theorem expect_val_eq_mixable_mix (d : ProbDistribution (Fin 2)) (x₁ x₂ : T) : @@ -269,6 +272,7 @@ theorem expect_val_eq_mixable_mix (d : ProbDistribution (Fin 2)) (x₁ x₂ : T) simpa only [Subtype.ext_iff, Prob.coe_one_minus, eq_sub_iff_add_eq, add_comm, fun_eq_val, Fin.sum_univ_two] using d.property +set_option backward.isDefEq.respectTransparency false in /-- The expectation value of a random variable with constant probability distribution `constant x` is its value at `x` -/ theorem expect_val_constant (x : α) (f : α → T) : expect_val ⟨f, (constant x)⟩ = f x := by @@ -309,6 +313,7 @@ omit inst in lemma map_congr_eq_congr_map {S : Type _} [Mixable U S] (f : T → S) (σ : α ≃ β) (X : RandVar α T) : f <$> congrRandVar σ X = congrRandVar σ (f <$> X) := by rfl +set_option backward.isDefEq.respectTransparency false in /-- The expectation value is invariant under equivalence of random variables -/ @[simp] theorem expect_val_congr_eq_expect_val (σ : α ≃ β) (X : RandVar α T) : diff --git a/QuantumInfo/ClassicalInfo/Entropy.lean b/QuantumInfo/ClassicalInfo/Entropy.lean index 95d18bf391..94da94351c 100644 --- a/QuantumInfo/ClassicalInfo/Entropy.lean +++ b/QuantumInfo/ClassicalInfo/Entropy.lean @@ -58,6 +58,7 @@ theorem H₁_le_1 (p : Prob) : H₁ p < 1 := by theorem H₁_le_exp_m1 (p : Prob) : H₁ p ≤ Real.exp (-1) := Real.negMulLog_le_rexp_neg_one p.zero_le_coe +set_option backward.isDefEq.respectTransparency false in theorem H₁_concave : ∀ (x y : Prob), ∀ (p : Prob), p[H₁ x ↔ H₁ y] ≤ H₁ (p[x ↔ y]) := by intros x y p simp only [H₁, smul_eq_mul, Prob.coe_one_minus, Mixable.mix, Mixable.mix_ab, Mixable.mkT_instUniv, diff --git a/QuantumInfo/ClassicalInfo/Prob.lean b/QuantumInfo/ClassicalInfo/Prob.lean index cb1fe1c596..b07249c0ec 100644 --- a/QuantumInfo/ClassicalInfo/Prob.lean +++ b/QuantumInfo/ClassicalInfo/Prob.lean @@ -275,11 +275,13 @@ notation p "[" x₁:80 "↔" x₂ "]" => mix p x₁ x₂ notation p "[" x₁:80 "↔" x₂ ":" M "]" => mix (inst := M) p x₁ x₂ +set_option backward.isDefEq.respectTransparency false in @[simp] theorem mix_zero [inst : Mixable U T] (x₁ x₂ : T) : (0 : Prob) [ x₁ ↔ x₂ : inst] = x₂ := by apply inst.to_U_inj simp [mix, mix_ab] +set_option backward.isDefEq.respectTransparency false in @[simp] theorem mix_one [inst : Mixable U T] (x₁ x₂ : T) : (1 : Prob) [ x₁ ↔ x₂ : inst] = x₁ := by apply inst.to_U_inj @@ -313,6 +315,7 @@ theorem instPi.lem_1 {D : Type*} {T U : D → Type*} [∀i, AddCommMonoid (U i)] use t d exact congrFun h d +set_option backward.isDefEq.respectTransparency false in variable {D : Type*} {T U : D → Type*} [∀i, AddCommMonoid (U i)] [∀ i, Module ℝ (U i)] [inst : ∀i, Mixable (U i) (T i)] in /-- Mixable instance on Pi types. -/ @@ -340,6 +343,7 @@ theorem to_U_instPi (D : Type*) [inst : Mixable U T] {t : D → T} : end pi +set_option backward.isDefEq.respectTransparency false in /-- Mixable instances on subtypes (of other mixable types), assuming that they have the correct closure properties. -/ @[reducible] @@ -411,6 +415,7 @@ noncomputable def negLog : Prob → ENNReal := scoped notation "—log " => negLog --TODO: Upgrade to `StrictAnti`. Even better: bundle negLog as `Prob ≃o ENNRealᵒᵈ`. +set_option backward.isDefEq.respectTransparency false in theorem negLog_Antitone : Antitone negLog := by intro x y h dsimp [negLog] @@ -435,6 +440,7 @@ theorem negLog_zero : —log (0 : Prob) = ⊤ := by theorem negLog_one : —log 1 = 0 := by simp [negLog]; rfl +set_option backward.isDefEq.respectTransparency false in @[simp] theorem negLog_eq_top_iff {p : Prob} : —log p = ⊤ ↔ p = 0 := by simp [negLog] @@ -443,6 +449,7 @@ theorem negLog_pos_ENNReal {p : Prob} (hp : p ≠ 0) : —log p = .ofNNReal ⟨- Left.nonneg_neg_iff.mpr (Real.log_nonpos p.2.1 p.2.2)⟩ := by simp [negLog, hp] +set_option backward.isDefEq.respectTransparency false in @[simp] theorem negLog_pos_Real {p : Prob} : (—log p).toReal = -Real.log p := by rw [negLog] @@ -450,6 +457,7 @@ theorem negLog_pos_Real {p : Prob} : (—log p).toReal = -Real.log p := by · simp [hp] · simp; rfl +set_option backward.isDefEq.respectTransparency false in theorem le_negLog_of_le_exp {p : Prob} {x : ℝ} (h : p ≤ Real.exp (-x)) : ENNReal.ofReal x ≤ —log p := by by_cases hx : 0 ≤ x · rw [negLog] @@ -473,12 +481,14 @@ theorem le_negLog_of_le_exp {p : Prob} {x : ℝ} (h : p ≤ Real.exp (-x)) : ENN · simp only [nonpos_iff_eq_zero, ofReal_eq_zero, le_of_not_ge hx] · exact _root_.zero_le +set_option backward.isDefEq.respectTransparency false in @[aesop (rule_sets := [finiteness]) safe apply] theorem negLog_ne_top {p : Prob} (hp : 0 < p.val) : —log p ≠ ∞ := by have h1 := ne_of_gt hp simp_all only [unitInterval.coe_pos, ne_eq, Set.Icc.coe_eq_zero, negLog_eq_top_iff] - exact h1 + exact not_false +set_option backward.isDefEq.respectTransparency false in theorem negLog_eq_neg_ENNReal_log (p : Prob) : —log p = -ENNReal.log p := by rw [negLog] split_ifs with hp diff --git a/QuantumInfo/Entropy/Axiomatized/Defs.lean b/QuantumInfo/Entropy/Axiomatized/Defs.lean index 6677c9ef54..d312f8afe9 100644 --- a/QuantumInfo/Entropy/Axiomatized/Defs.lean +++ b/QuantumInfo/Entropy/Axiomatized/Defs.lean @@ -35,13 +35,12 @@ function, and then derive much of `Entropy` from it. ## References: - - [Khinchin’s Fourth Axiom of Entropy Revisited](https://www.mdpi.com/2571-905X/6/3/49) - - [α-z Relative Entropies](https://warwick.ac.uk/fac/sci/maths/research/events/2013-2014/statmech/su/Nilanjana-slides.pdf) - - Watrous's notes, [Max-relative entropy and conditional min-entropy](https://cs.uwaterloo.ca/~watrous/QIT-notes/QIT-notes.02.pdf) - - [Quantum Relative Entropy - An Axiomatic Approach](https://www.marcotom.info/files/entropy-masterclass2022.pdf) -by Marco Tomamichel - - [StackExchange](https://quantumcomputing.stackexchange.com/a/12953/10115) - +* Khinchin’s Fourth Axiom of Entropy Revisited. [ref: mdpi_khinchin_fourth_axiom] +* α-z Relative Entropies. [ref: warwick_alpha_z_relative_entropies] +* Watrous's notes, Max-relative entropy and conditional min-entropy. [ref: watrous_qit_notes_02] +* Quantum Relative Entropy - An Axiomatic Approach by Marco Tomamichel. + [ref: tomamichel_relative_entropy_masterclass] +* StackExchange. [ref: stackexchange_qc_12953] -/ @[expose] public section diff --git a/QuantumInfo/Entropy/DPI.lean b/QuantumInfo/Entropy/DPI.lean index 7eb95967d6..252e9eede5 100644 --- a/QuantumInfo/Entropy/DPI.lean +++ b/QuantumInfo/Entropy/DPI.lean @@ -120,6 +120,7 @@ The trace functional is invariant under joint unitary conjugation: This corresponds to equation (2.3) in the paper. Proved using `rpow_conj_unitary` (f(UXU†) = U f(X) U†) and `conj_conj`. -/ +set_option backward.isDefEq.respectTransparency false in theorem sandwichedTraceFunctional_conj_unitary_hermitian (U : Matrix.unitaryGroup d ℂ) (A B : HermitianMat d ℂ) : let γ := (1 - α) / (2 * α) @@ -1085,8 +1086,8 @@ theorem sandwichedTraceFunctional_mono_traceRight [Nonempty dB] Q̃_ α(ρ.traceRight‖σ.traceRight) ≤ Q̃_ α(ρ‖σ) := by -- Obtain the twirling unitaries obtain ⟨κ, hκ_fin, hκ_ne, V, hV⟩ := exists_twirling_unitaries (dB := dB) - letI : Fintype κ := hκ_fin - letI : Nonempty κ := hκ_ne + let : Fintype κ := hκ_fin + let : Nonempty κ := hκ_ne -- By unitary invariance, Q̃_α(ρ‖σ) = Q̃_α(V_i ρ V_i†‖V_i σ V_i†) for each i have h_inv (i) : Q̃_ α(ρ.conjTensorUnitary (V i)‖σ.conjTensorUnitary (V i)) = Q̃_ α(ρ‖σ) := sandwichedTraceFunctional_conj_tensorUnitary ρ σ (V i) @@ -1226,6 +1227,7 @@ theorem sandwichedRenyiEntropy_mono_traceRight [Nonempty dB] /- The sandwiched Rényi divergence is invariant under unitary conjugation. -/ +set_option backward.isDefEq.respectTransparency false in set_option maxHeartbeats 400000 in theorem sandwichedRenyiEntropy_conj_unitary (hα : 0 < α) (ρ σ : MState d) (U : Matrix.unitaryGroup d ℂ) : @@ -1349,7 +1351,7 @@ theorem sandwichedRenyiEntropy_DPI_gt_one (hα : 1 < α) (ρ σ : MState d₁) ( D̃_ α(Φ ρ‖Φ σ) ≤ D̃_ α(ρ‖σ) := by have _ : Nonempty d₁ := ρ.nonempty have _ : Nonempty d₂ := (Φ ρ).nonempty - haveI : Inhabited d₂ := Classical.inhabited_of_nonempty ‹_› + have : Inhabited d₂ := Classical.inhabited_of_nonempty ‹_› let ψ₀ : Ket (d₂ × d₂) := Ket.basis default let τ := MState.pure ψ₀ obtain ⟨U, hU⟩ := Φ.purify_IsUnitary diff --git a/QuantumInfo/Entropy/Relative.lean b/QuantumInfo/Entropy/Relative.lean index 8a2c1ae9c0..681f7b4934 100644 --- a/QuantumInfo/Entropy/Relative.lean +++ b/QuantumInfo/Entropy/Relative.lean @@ -775,6 +775,7 @@ private lemma scalar_rpow_cross_term_of_continuous_zero {b : ℝ → ℝ} rw [ Asymptotics.isLittleO_iff ]; intro ε hε; rcases h_eps ε hε with ⟨ δ, hδ, H ⟩ ; filter_upwards [ Metric.ball_mem_nhds _ hδ ] with x hx using by simpa [ hc ] using H ( 1 + x ) ( by simpa using hx ) ; +set_option backward.isDefEq.respectTransparency false in /-- If ker A ≤ ker ρM, then conjugating ρM by the support projection of A gives back ρM. This is because ρM is supported entirely on the support (= range) of A. -/ private lemma conj_supportProj_eq_of_ker_le (A ρM : HermitianMat d ℂ) (hker : A.ker ≤ ρM.ker) : @@ -1101,6 +1102,7 @@ private lemma hasDerivAt_trace_rpow_sub_trace_variable_base ring_nf ext; norm_num; ring +set_option backward.isDefEq.respectTransparency false in /-- The cross term in the derivative decomposition vanishes: the function α ↦ Tr[B(α)^α] - Tr[B(α)] - Tr[ρ^α] + 1 has derivative 0 at α = 1. This is because at α=1, B^1 = B, so ∂/∂B Tr[B^α] = Tr[·] (the trace is linear), @@ -1171,7 +1173,7 @@ theorem inner_log_sub_log_nonneg (h : σ.M.ker ≤ ρ.M.ker) : apply nhdsWithin_mono intro x hx exact ⟨Set.mem_Ioi.mpr (lt_trans zero_lt_one hx), ne_of_gt hx⟩ - haveI : (nhdsWithin (1 : ℝ) (Set.Ioi 1)).NeBot := inferInstance + have : (nhdsWithin (1 : ℝ) (Set.Ioi 1)).NeBot := inferInstance apply ge_of_tendsto (h_limit.mono_left h_mono) filter_upwards [self_mem_nhdsWithin] with α hα exact sandwichedRelRentropy_nonneg_α_gt_1 h hα @@ -1499,6 +1501,7 @@ def qRelativeEnt (ρ σ : MState d) : ENNReal := notation "𝐃(" ρ "‖" σ ")" => qRelativeEnt ρ σ +set_option backward.isDefEq.respectTransparency false in /-- The Sandwiched Renyi Relative entropy is additive for α=1 (standard relative entropy). -/ @@ -1575,6 +1578,7 @@ theorem qRelativeEnt_additive (ρ₁ σ₁ : MState d₁) (ρ₂ σ₂ : MState --or `simp [SandwichedRelRentropy]`. exact sandwichedRelRentropy_additive_alpha_one ρ₁ σ₁ ρ₂ σ₂ +set_option backward.isDefEq.respectTransparency false in @[simp] theorem sandwichedRelRentropy_relabel (ρ σ : MState d) (e : d₂ ≃ d) : D̃_ α(ρ.relabel e‖σ.relabel e) = D̃_ α(ρ‖σ) := by @@ -1582,6 +1586,7 @@ theorem sandwichedRelRentropy_relabel (ρ σ : MState d) (e : d₂ ≃ d) : split_ifs <;> simp_all [HermitianMat.conj_submatrix] <;> exact (HermitianMat.ker_reindex_le_iff σ.M ρ.M e.symm).mp ‹_› +set_option backward.isDefEq.respectTransparency false in @[simp] theorem sandwichedRelRentropy_self (hα : 0 < α) (ρ : MState d) : --Technically this holds for all α except for `-1` and `0`. But those are stupid. @@ -1609,6 +1614,7 @@ theorem sandwichedRelRentropy_self (hα : 0 < α) (ρ : MState d) : · field_simp; ring_nf; positivity simp +set_option backward.isDefEq.respectTransparency false in @[aesop (rule_sets := [finiteness]) unsafe apply] theorem sandwichedRelEntropy_ne_top {ρ σ : MState d} [σ.M.NonSingular] : D̃_ α(ρ‖σ) ≠ ⊤ := by by_cases 0 < α @@ -1737,6 +1743,7 @@ private theorem sandwichedRelRentropy.continuousOn_Ioo_0_1 (ρ σ : MState d) : dsimp only simp [hx.1] +set_option backward.isDefEq.respectTransparency false in /-- Continuity at 1: the sandwich relative Rényi entropy is continuous at α = 1. -/ private theorem sandwichedRelRentropy.continuousAt_1 (ρ σ : MState d) : ContinuousWithinAt (fun α => D̃_ α(ρ‖σ)) (Set.Ioi 0) 1 := by @@ -1781,9 +1788,10 @@ theorem sandwichedRelRentropy.continuousOn (ρ σ : MState d) : /-- Quantum relative entropy as `Tr[ρ (log ρ - log σ)]` when supports are contained. -/ theorem qRelativeEnt_ker {ρ σ : MState d} (h : σ.M.ker ≤ ρ.M.ker) : 𝐃(ρ‖σ).toEReal = ⟪ρ.M, ρ.M.log - σ.M.log⟫ := by - simp [qRelativeEnt, SandwichedRelRentropy, h, EReal.coe_nnreal_eq_coe_real] + simp [qRelativeEnt, SandwichedRelRentropy, h] norm_cast +set_option backward.isDefEq.respectTransparency false in /-- The quantum relative entropy is finite exactly when the support condition `σ.M.ker ≤ ρ.M.ker` holds. -/ theorem qRelativeEnt_ne_top_iff {ρ σ : MState d} : 𝐃(ρ‖σ) ≠ ⊤ ↔ σ.M.ker ≤ ρ.M.ker := by @@ -2086,6 +2094,7 @@ Relative entropy is lower semicontinuous (in each argument, actually, but we onl latter here). Will need the fact that all the cfc / eigenvalue stuff is continuous, plus carefully handling what happens with the kernel subspace, which will make this a pain. -/ +set_option backward.isDefEq.respectTransparency false in @[fun_prop] theorem qRelativeEnt.lowerSemicontinuous (ρ : MState d) : LowerSemicontinuous fun σ => 𝐃(ρ‖σ) := by simp_rw [qRelativeEnt, SandwichedRelRentropy, if_true, lowerSemicontinuous_iff] diff --git a/QuantumInfo/Entropy/SSA.lean b/QuantumInfo/Entropy/SSA.lean index 7b169c0c87..a1fc3e2c3a 100644 --- a/QuantumInfo/Entropy/SSA.lean +++ b/QuantumInfo/Entropy/SSA.lean @@ -134,6 +134,7 @@ lemma V_rho_conj_mul_self_eq (ρAB : HermitianMat (dA × dB) ℂ) (hρ : ρAB.ma simp_all [ mul_assoc, Matrix.mul_assoc ]; simp [ ← Matrix.mul_assoc, ← map_to_tensor_MES_prop ] +set_option backward.isDefEq.respectTransparency false in /-- The partial trace (left) of a positive definite matrix is positive definite. -/ @@ -899,6 +900,7 @@ private lemma PosDef_assoc'_traceRight apply PosDef_traceRight convert! hρ.reindex (Equiv.prodAssoc d₁ d₂ d₃).symm +set_option backward.isDefEq.respectTransparency false in private lemma wm_inner_lhs [Nonempty d₁] [Nonempty d₂] [Nonempty d₃] (ρ : MState (d₁ × d₂ × d₃)) : ⟪(-ρ.assoc'.traceRight.M.traceRight.log) ⊗ₖ (1 : HermitianMat (d₂ × d₃) ℂ) + @@ -915,6 +917,7 @@ private lemma wm_inner_lhs [Nonempty d₁] [Nonempty d₂] [Nonempty d₃] · rw [ Sᵥₙ_eq_neg_trace_log ]; simp [ inner_one_kron_eq_inner_traceLeft ] +set_option backward.isDefEq.respectTransparency false in private lemma wm_inner_rhs [Nonempty d₁] [Nonempty d₂] [Nonempty d₃] (ρ : MState (d₁ × d₂ × d₃)) : ⟪((-ρ.assoc'.traceRight.M.log) ⊗ₖ (1 : HermitianMat d₃ ℂ) + @@ -937,11 +940,11 @@ private lemma Sᵥₙ_wm_pd [Nonempty d₁] [Nonempty d₂] [Nonempty d₃] -- Set up marginals and their PD properties have h₁₂ := PosDef_assoc'_traceRight ρ hρ have h₂₃ := PosDef_traceLeft ρ.M hρ - haveI : ρ.assoc'.traceRight.M.NonSingular := nonSingular_of_posDef h₁₂ - haveI : ρ.traceLeft.M.NonSingular := nonSingular_of_posDef h₂₃ - haveI : ρ.assoc'.traceRight.M.traceRight.NonSingular := + have : ρ.assoc'.traceRight.M.NonSingular := nonSingular_of_posDef h₁₂ + have : ρ.traceLeft.M.NonSingular := nonSingular_of_posDef h₂₃ + have : ρ.assoc'.traceRight.M.traceRight.NonSingular := nonSingular_of_posDef (PosDef_traceRight _ h₁₂) - haveI : ρ.traceLeft.M.traceLeft.NonSingular := + have : ρ.traceLeft.M.traceLeft.NonSingular := nonSingular_of_posDef (PosDef_traceLeft _ h₂₃) -- Step 1: Operator inequality have h_op := operator_ineq_SSA ρ.assoc'.traceRight.M ρ.traceLeft.M h₁₂ h₂₃ @@ -1012,6 +1015,7 @@ private lemma MState.traceLeft_continuous : · fun_prop; exact continuous_induced_rng.mpr ( by continuity ) +set_option backward.isDefEq.respectTransparency false in @[fun_prop] private lemma MState.traceRight_continuous : Continuous (MState.traceRight : MState (d₁ × d₂) → MState d₁) := by @@ -1077,6 +1081,7 @@ private def perm_A_BCR' (dA dB dC : Type*) : private def ρBCR (ρ : MState (dA × dB × dC)) : MState (dB × dC × (dA × dB × dC)) := ((MState.pure ρ.purify).relabel (perm_A_BCR' dA dB dC).symm).traceLeft +set_option backward.isDefEq.respectTransparency false in private lemma S_BC_of_BCR_eq (ρ : MState (dA × dB × dC)) : Sᵥₙ (ρBCR ρ).assoc'.traceRight = Sᵥₙ ρ.traceLeft := by -- By definition of ρBCR, we know that its BC-marginal is equal to the BC-marginal of ρ. @@ -1144,6 +1149,7 @@ private lemma S_CR_of_BCR_eq (ρ : MState (dA × dB × dC)) : rw [Sᵥₙ_pure_complement ρ.purify (perm_AB_CR' dA dB dC).symm] exact purify_AB_traceRight_eq ρ +set_option backward.isDefEq.respectTransparency false in private lemma S_B_of_BCR_eq (ρ : MState (dA × dB × dC)) : Sᵥₙ (ρBCR ρ).traceRight = Sᵥₙ ρ.traceLeft.traceRight := by unfold ρBCR; diff --git a/QuantumInfo/ForMathlib/ComplexLaplaceTransform.lean b/QuantumInfo/ForMathlib/ComplexLaplaceTransform.lean index 1b239ca223..1d34f92f3b 100644 --- a/QuantumInfo/ForMathlib/ComplexLaplaceTransform.lean +++ b/QuantumInfo/ForMathlib/ComplexLaplaceTransform.lean @@ -204,7 +204,7 @@ private theorem integrable_uncurry_complexLaplaceIntegrand_horizontal ComplexLaplaceIntegrand E (t + a.im * Complex.I) x) ((MeasureTheory.volume.restrict (Set.uIoc a.re b.re)).prod MeasureTheory.volume) := by let μI := MeasureTheory.volume.restrict (Set.uIoc a.re b.re) - haveI : MeasureTheory.IsFiniteMeasure μI := ⟨by + have : MeasureTheory.IsFiniteMeasure μI := ⟨by rw [MeasureTheory.Measure.restrict_apply_univ] simp [Set.uIoc]⟩ have hsm : MeasureTheory.StronglyMeasurable (Function.uncurry fun t : ℝ => fun x : α => @@ -245,7 +245,7 @@ private theorem integrable_uncurry_complexLaplaceIntegrand_vertical ComplexLaplaceIntegrand E (b.re + t * Complex.I) x) ((MeasureTheory.volume.restrict (Set.uIoc a.im b.im)).prod MeasureTheory.volume) := by let μI := MeasureTheory.volume.restrict (Set.uIoc a.im b.im) - haveI : MeasureTheory.IsFiniteMeasure μI := ⟨by + have : MeasureTheory.IsFiniteMeasure μI := ⟨by rw [MeasureTheory.Measure.restrict_apply_univ] simp [Set.uIoc]⟩ have hsm : MeasureTheory.StronglyMeasurable (Function.uncurry fun t : ℝ => fun x : α => diff --git a/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/HilbertSchmidtOperatorSpace.lean b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/HilbertSchmidtOperatorSpace.lean index 212343dbc5..be2222b91a 100644 --- a/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/HilbertSchmidtOperatorSpace.lean +++ b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/HilbertSchmidtOperatorSpace.lean @@ -143,6 +143,7 @@ omit [CompleteSpace ℋ] in ((hsLinearMapEquiv (ℋ := ℋ)) T) p.1 p.2 have h : hsCoordsLinearEquiv (toHSCoordsLinearEquiv (ℋ := ℋ) T) = f := by simp [toHSCoordsLinearEquiv, matrixToCoords, matrixToFun, f] + rfl have hEval := congrArg (fun g : HSCoordFun ℋ => g (i, j)) h simpa [f] using hEval @@ -234,12 +235,14 @@ omit [CompleteSpace ℋ] in @[simp] lemma rightMulHS_apply (B : L ℋ) (T : HSOp ℋ) : toOp (rightMulHS (ℋ := ℋ) B T) = toOp T * B := rfl +set_option backward.isDefEq.respectTransparency false in omit [CompleteSpace ℋ] in @[simp] lemma leftMulHS_mul (A B : L ℋ) : leftMulHS (ℋ := ℋ) (A * B) = leftMulHS (ℋ := ℋ) A * leftMulHS (ℋ := ℋ) B := by ext T simp [mul_assoc] +set_option backward.isDefEq.respectTransparency false in omit [CompleteSpace ℋ] in @[simp] lemma rightMulHS_mul (A B : L ℋ) : rightMulHS (ℋ := ℋ) (A * B) = rightMulHS (ℋ := ℋ) B * rightMulHS (ℋ := ℋ) A := by @@ -258,6 +261,7 @@ omit [CompleteSpace ℋ] in ext T simp +set_option backward.isDefEq.respectTransparency false in omit [CompleteSpace ℋ] in lemma leftMulHS_rightMulHS_commute (A B : L ℋ) : Commute (leftMulHS (ℋ := ℋ) A) (rightMulHS (ℋ := ℋ) B) := by @@ -446,10 +450,10 @@ lemma leftMulHS_pdSet [ContinuousFunctionalCalculus ℝ (L ℋ) IsSelfAdjoint] [ have hleft_sa : IsSelfAdjoint (leftMulHS (ℋ := ℋ) A) := by change star (leftMulHS (ℋ := ℋ) A) = leftMulHS (ℋ := ℋ) A simp [hA_sa.star_eq, leftMulHS_star (ℋ := ℋ) A] - letI : Nontrivial (HSOp ℋ) := by + let : Nontrivial (HSOp ℋ) := by delta HSOp infer_instance - letI : Nontrivial (L (HSOp ℋ)) := inferInstance + let : Nontrivial (L (HSOp ℋ)) := inferInstance refine ⟨?_, ?_⟩ · exact hleft_sa · rcases (CFC.exists_pos_algebraMap_le_iff (A := L ℋ) (a := A) (ha := hA_sa)).2 hA_spec @@ -495,7 +499,7 @@ noncomputable def leftMulHSStarAlgHom : L ℋ →⋆ₐ[ℝ] L (HSOp ℋ) where noncomputable def rightMulHSStarAlgHom : (L ℋ)ᵐᵒᵖ →⋆ₐ[ℝ] L (HSOp ℋ) where toFun := fun A => rightMulHS (ℋ := ℋ) (MulOpposite.unop A) map_one' := by simp [rightMulHS_one (ℋ := ℋ)] - map_mul' := by intro A B; ext T; simp [rightMulHS_apply, mul_assoc] + map_mul' := by intro A B; ext T; simp [rightMulHS_apply] map_zero' := by ext T change ofOp (toOp T * MulOpposite.unop (0 : (L ℋ)ᵐᵒᵖ)) = ofOp (0 : L ℋ) diff --git a/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/JensenOperatorInequality.lean b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/JensenOperatorInequality.lean index edd08ffd75..09d181d545 100644 --- a/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/JensenOperatorInequality.lean +++ b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/JensenOperatorInequality.lean @@ -51,12 +51,12 @@ omit [CompleteSpace ℋ] in private theorem nontrivial_hsumL_wrap [Nontrivial ℋ] : Nontrivial (L (HSum ℋ)) := by have h_not_sub : ¬ Subsingleton ℋ := by intro hsub - letI : Subsingleton ℋ := hsub - letI : Subsingleton (L ℋ) := by infer_instance + let : Subsingleton ℋ := hsub + let : Subsingleton (L ℋ) := by infer_instance exact (not_nontrivial_iff_subsingleton.mpr (by infer_instance)) (inferInstance : Nontrivial (L ℋ)) have hH_nontriv : Nontrivial ℋ := (not_subsingleton_iff_nontrivial.mp h_not_sub) - letI : Nontrivial ℋ := hH_nontriv + let : Nontrivial ℋ := hH_nontriv rcases exists_pair_ne ℋ with ⟨x, y, hxy⟩ let w : ℋ := x - y have hw : w ≠ 0 := sub_ne_zero.mpr hxy @@ -208,7 +208,7 @@ theorem theorem_2_5_2_iv_imp_v {f : ℝ → ℝ} (hiv : CondIVAll.{u} f) simpa [Set.Ici] using hBs hx let Atilde : L (HSum ℋ) := blockDiagonal (ℋ := ℋ) A B let Xtilde : L (HSum ℋ) := blockOp (ℋ := ℋ) X 0 Y 0 - letI : Nontrivial (L (HSum ℋ)) := nontrivial_hsumL_wrap (ℋ := ℋ) + let : Nontrivial (L (HSum ℋ)) := nontrivial_hsumL_wrap (ℋ := ℋ) have hAtilde_sa : IsSelfAdjoint Atilde := by simpa [Atilde] using blockDiagonal_selfAdjoint_wrap (ℋ := ℋ) hA hB have hAtilde0 : (0 : L (HSum ℋ)) ≤ Atilde := by @@ -323,7 +323,7 @@ theorem theorem_2_5_2_i_ici_all_imp_v {f : ℝ → ℝ} simpa [Set.Ici] using hBs hx let Atilde : L (HSum ℋ) := blockDiagonal (ℋ := ℋ) A B let Xtilde : L (HSum ℋ) := blockOp (ℋ := ℋ) X 0 Y 0 - letI : Nontrivial (L (HSum ℋ)) := nontrivial_hsumL_wrap (ℋ := ℋ) + let : Nontrivial (L (HSum ℋ)) := nontrivial_hsumL_wrap (ℋ := ℋ) have hAtilde_sa : IsSelfAdjoint Atilde := by simpa [Atilde] using blockDiagonal_selfAdjoint_wrap (ℋ := ℋ) hA hB have hAtilde0 : (0 : L (HSum ℋ)) ≤ Atilde := by diff --git a/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/JensenOperatorInequalityIImpIV.lean b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/JensenOperatorInequalityIImpIV.lean index c495d77231..894f03e6bd 100644 --- a/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/JensenOperatorInequalityIImpIV.lean +++ b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/JensenOperatorInequalityIImpIV.lean @@ -276,12 +276,12 @@ omit [CompleteSpace ℋ] in private theorem nontrivial_hsumL [Nontrivial ℋ] : Nontrivial (L (HSum ℋ)) := by have h_not_sub : ¬ Subsingleton ℋ := by intro hsub - letI : Subsingleton ℋ := hsub - letI : Subsingleton (L ℋ) := by infer_instance + let : Subsingleton ℋ := hsub + let : Subsingleton (L ℋ) := by infer_instance exact (not_nontrivial_iff_subsingleton.mpr (by infer_instance)) (inferInstance : Nontrivial (L ℋ)) have hH_nontriv : Nontrivial ℋ := (not_subsingleton_iff_nontrivial.mp h_not_sub) - letI : Nontrivial ℋ := hH_nontriv + let : Nontrivial ℋ := hH_nontriv rcases exists_pair_ne ℋ with ⟨x, y, hxy⟩ let w : ℋ := x - y have hw : w ≠ 0 := sub_ne_zero.mpr hxy @@ -306,8 +306,8 @@ private lemma sqrt_blockDiagonal_of_nonneg (hA_nonneg : (0 : L ℋ) ≤ A) (hB_nonneg : (0 : L ℋ) ≤ B) : CFC.sqrt (blockDiagonal (ℋ := ℋ) A B) = blockDiagonal (ℋ := ℋ) (CFC.sqrt A) (CFC.sqrt B) := by - letI : Algebra ℝ (L (HSum ℋ)) := by infer_instance - letI : Nontrivial (L (HSum ℋ)) := nontrivial_hsumL (ℋ := ℋ) + let : Algebra ℝ (L (HSum ℋ)) := by infer_instance + let : Nontrivial (L (HSum ℋ)) := nontrivial_hsumL (ℋ := ℋ) have hdiag_nonneg : (0 : L (HSum ℋ)) ≤ blockDiagonal (ℋ := ℋ) A B := blockDiagonal_nonneg (ℋ := ℋ) hA_nonneg hB_nonneg rw [← cfcR_real_sqrt_eq_sqrt (ℋ := HSum ℋ) hdiag_nonneg] @@ -557,7 +557,7 @@ theorem theorem_2_5_2_i_ici_all_imp_iv {f : ℝ → ℝ} (hf : CondIciAll.{u} f) simpa [S] using blockSwap_star (ℋ := ℋ) X have hSnorm : ‖S‖ ≤ 1 := by simpa [S] using blockSwap_norm_le_one (ℋ := ℋ) X hX - letI : Algebra ℝ (L (HSum ℋ)) := by + let : Algebra ℝ (L (HSum ℋ)) := by infer_instance have hU_mem : S + Complex.I • CFC.sqrt (1 - S ^ 2) ∈ unitary (L (HSum ℋ)) := by exact IsSelfAdjoint.self_add_I_smul_cfcSqrt_sub_sq_mem_unitary S hSsa hSnorm @@ -565,7 +565,7 @@ theorem theorem_2_5_2_i_ici_all_imp_iv {f : ℝ → ℝ} (hf : CondIciAll.{u} f) ⟨S + Complex.I • CFC.sqrt (1 - S ^ 2), hU_mem⟩ let V : unitary (L (HSum ℋ)) := star U let Atilde : L (HSum ℋ) := blockDiagonal (ℋ := ℋ) 0 A - letI : Nontrivial (L (HSum ℋ)) := nontrivial_hsumL (ℋ := ℋ) + let : Nontrivial (L (HSum ℋ)) := nontrivial_hsumL (ℋ := ℋ) have hconv₂ : OperatorConvexOn (ℋ := HSum ℋ) (Set.Ici (0 : ℝ)) f := hconvAll (K := HSum ℋ) have hR0nonneg : (0 : L ℋ) ≤ 1 - star X * X := sub_nonneg.mpr (star_mul_le_one (ℋ := ℋ) X hX) @@ -811,7 +811,7 @@ theorem theorem_2_5_2_i_all_imp_iv {f : ℝ → ℝ} (hf : CondIAll.{u} f) : simpa [S] using blockSwap_star (ℋ := ℋ) X have hSnorm : ‖S‖ ≤ 1 := by simpa [S] using blockSwap_norm_le_one (ℋ := ℋ) X hX - letI : Algebra ℝ (L (HSum ℋ)) := by + let : Algebra ℝ (L (HSum ℋ)) := by infer_instance have hU_mem : S + Complex.I • CFC.sqrt (1 - S ^ 2) ∈ unitary (L (HSum ℋ)) := by exact IsSelfAdjoint.self_add_I_smul_cfcSqrt_sub_sq_mem_unitary S hSsa hSnorm @@ -819,7 +819,7 @@ theorem theorem_2_5_2_i_all_imp_iv {f : ℝ → ℝ} (hf : CondIAll.{u} f) : ⟨S + Complex.I • CFC.sqrt (1 - S ^ 2), hU_mem⟩ let V : unitary (L (HSum ℋ)) := star U let Atilde : L (HSum ℋ) := blockDiagonal (ℋ := ℋ) 0 A - letI : Nontrivial (L (HSum ℋ)) := nontrivial_hsumL (ℋ := ℋ) + let : Nontrivial (L (HSum ℋ)) := nontrivial_hsumL (ℋ := ℋ) have hconv₂ : OperatorConvex (ℋ := HSum ℋ) f := hconvAll (K := HSum ℋ) have hcont₂ : ContinuousOn f Set.univ := operatorConvex_continuousOn_univ (ℋ := HSum ℋ) hconv₂ diff --git a/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/LiebAndoTrace.lean b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/LiebAndoTrace.lean index d508058492..f87313c3e8 100644 --- a/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/LiebAndoTrace.lean +++ b/QuantumInfo/ForMathlib/HayataGroup/TraceInequality/LiebAndoTrace.lean @@ -126,10 +126,10 @@ private lemma rightMulHS_pdSet {A : L ℋ} (hA : A ∈ pdSet (ℋ := ℋ)) : have hright_sa : IsSelfAdjoint (rightMulHS (ℋ := ℋ) A) := by change star (rightMulHS (ℋ := ℋ) A) = rightMulHS (ℋ := ℋ) A simp [hA_sa.star_eq] - letI : Nontrivial (HSOp ℋ) := by + let : Nontrivial (HSOp ℋ) := by delta HSOp infer_instance - letI : Nontrivial (L (HSOp ℋ)) := inferInstance + let : Nontrivial (L (HSOp ℋ)) := inferInstance refine ⟨hright_sa, ?_⟩ rcases (CFC.exists_pos_algebraMap_le_iff (A := L ℋ) (a := A) (ha := hA_sa)).2 hA_spec with ⟨r, hr, hrA⟩ @@ -248,7 +248,7 @@ private lemma cfcR_apply_of_mem_eigenspace_real (f : ℝ → ℝ) {T : L 𝓚} (hT : IsSelfAdjoint T) {r : ℝ} {x : 𝓚} (hx : x ∈ eigenspace T.toLinearMap (r : ℂ)) : cfcR (ℋ := 𝓚) f T x = (f r : ℂ) • x := by - haveI : IsScalarTower ℝ ℂ (L 𝓚) := RestrictScalars.isScalarTower ℝ ℂ (L 𝓚) + have : IsScalarTower ℝ ℂ (L 𝓚) := RestrictScalars.isScalarTower ℝ ℂ (L 𝓚) classical by_cases hx0 : x = 0 · simp [hx0] @@ -550,6 +550,7 @@ private lemma hmiddle_leftMul_rightMul simpa [lhs, rhs] using hlhs_eq_rhs -- The bridge lemma expands a large `HSOp`-valued generalized perspective term. +set_option backward.isDefEq.respectTransparency false in set_option maxHeartbeats 800000 in private lemma phiK_operatorPowerMean_eq_liebTraceMap {s : ℝ} (K A B : L ℋ) (hA : A ∈ pdSet (ℋ := ℋ)) (hB : B ∈ pdSet (ℋ := ℋ)) : @@ -799,6 +800,7 @@ lemma pdSet_convexCombo {A B : L ℋ} {t : ℝ} simpa [C] using (CFC.exists_pos_algebraMap_le_iff (A := L ℋ) (a := C) (ha := hC)).1 ⟨rC, hrC, hrC_le⟩ x hx +set_option backward.isDefEq.respectTransparency false in omit [Nontrivial ℋ] in private lemma phiK_leftMul_rightMul_eq_traceRe (K C D : L ℋ) : phiK (ℋ := ℋ) K @@ -1073,10 +1075,10 @@ theorem liebTrace_jointlyConcaveOn_pdSet have hB_combo : ((1 - θ) • B₁ + θ • B₂) ∈ pdSet (ℋ := ℋ) := by exact pdSet_convexCombo (ℋ := ℋ) hB₁ hB₂ hθ0 hθ1 - letI : Nontrivial (HSOp ℋ) := by + let : Nontrivial (HSOp ℋ) := by delta HSOp infer_instance - letI : Nontrivial (L (HSOp ℋ)) := inferInstance + let : Nontrivial (L (HSOp ℋ)) := inferInstance have hconc_hs := operatorPowerMean_jointlyConcaveOn_pdSet (ℋ := HSOp ℋ) (α := s) (β := 1) @@ -1138,10 +1140,10 @@ theorem liebTrace_jointlyConvexOn_pdSet have hB_combo : ((1 - θ) • B₁ + θ • B₂) ∈ pdSet (ℋ := ℋ) := by exact pdSet_convexCombo (ℋ := ℋ) hB₁ hB₂ hθ0 hθ1 - letI : Nontrivial (HSOp ℋ) := by + let : Nontrivial (HSOp ℋ) := by delta HSOp infer_instance - letI : Nontrivial (L (HSOp ℋ)) := inferInstance + let : Nontrivial (L (HSOp ℋ)) := inferInstance have hconv_hs := operatorPowerMean_jointlyConvexOn_pdSet (ℋ := HSOp ℋ) (α := s) (β := 1) diff --git a/QuantumInfo/ForMathlib/HermitianMat/Basic.lean b/QuantumInfo/ForMathlib/HermitianMat/Basic.lean index 361c2ff8ce..185a3b15b5 100644 --- a/QuantumInfo/ForMathlib/HermitianMat/Basic.lean +++ b/QuantumInfo/ForMathlib/HermitianMat/Basic.lean @@ -139,7 +139,7 @@ lemma continuousOn_iff_coe {X : Type*} [TopologicalSpace X] {s : Set X} constructor · intro; fun_prop · intro h - rw [continuousOn_iff_continuous_restrict] at * + rw [continuousOn_iff_continuous_domRestrict] at * apply Continuous.subtype_mk h variable [IsTopologicalAddGroup α] @@ -354,6 +354,7 @@ section conj variable [CommRing α] [StarRing α] [Fintype n] variable (A : HermitianMat n α) +set_option backward.isDefEq.respectTransparency false in /-- The Hermitian matrix given by conjugating by a (possibly rectangular) Matrix. If we required `B` to be square, this would apply to any `Semigroup`+`StarMul` (as proved by `IsSelfAdjoint.conjugate`). But this lets us conjugate to other sizes too, as is done in e.g. Kraus operators. That is, it's a _heterogeneous_ conjguation. @@ -386,10 +387,12 @@ theorem conj_conj {m l} [Fintype m] (B : Matrix m n α) (C : Matrix l m α) : variable (B : HermitianMat n α) +set_option backward.isDefEq.respectTransparency false in @[simp] theorem conj_zero [DecidableEq n] : A.conj (0 : Matrix m n α) = 0 := by simp [conj_apply] +set_option backward.isDefEq.respectTransparency false in @[simp] theorem conj_one [DecidableEq n] : A.conj 1 = A := by simp [conj_apply] @@ -414,6 +417,7 @@ def conjLinear {m} (B : Matrix m n α) : HermitianMat n α →ₗ[R] HermitianMa theorem conjLinear_apply (B : Matrix m n α) : conjLinear R B A = conj B A := by rfl +set_option backward.isDefEq.respectTransparency false in @[fun_prop] lemma continuous_conj (ρ : HermitianMat n 𝕜) : Continuous (ρ.conj (m := m) ·) := by simp only [HermitianMat.conj, AddMonoidHom.coe_mk, ZeroHom.coe_mk] @@ -540,6 +544,7 @@ lemma diagonal_sub : diagonal 𝕜 (f - g) = diagonal 𝕜 f - diagonal 𝕜 g : theorem diagonal_mul (c : ℝ) : diagonal 𝕜 (fun x ↦ c * f x) = c • diagonal 𝕜 f := by ext1; simp [← Matrix.diagonal_smul] +set_option backward.isDefEq.respectTransparency false in theorem diagonal_conj_diagonal [Fintype n] : (diagonal 𝕜 f).conj (diagonal 𝕜 g) = diagonal 𝕜 (fun i ↦ f i * (g i)^2) := by ext1 diff --git a/QuantumInfo/ForMathlib/HermitianMat/CFC.lean b/QuantumInfo/ForMathlib/HermitianMat/CFC.lean index ea6750ad11..4731063851 100644 --- a/QuantumInfo/ForMathlib/HermitianMat/CFC.lean +++ b/QuantumInfo/ForMathlib/HermitianMat/CFC.lean @@ -36,7 +36,7 @@ theorem isSelfAdjoint : IsSelfAdjoint A.mat := by @[fun_prop] theorem continuousOn_finite {α β : Type*} (f : α → β) (S : Set α) [TopologicalSpace α] [TopologicalSpace β] [T1Space α] [Finite S] : ContinuousOn f S := by - rw [continuousOn_iff_continuous_restrict] + rw [continuousOn_iff_continuous_domRestrict] exact continuous_of_discreteTopology @[simp] @@ -272,6 +272,7 @@ theorem cfc_nonSingular (hf : ∀ i, f (A.H.eigenvalues i) ≠ 0) : NonSingular simpa [he] using fun i ↦ hf (e i) +set_option backward.isDefEq.respectTransparency false in theorem trace_mul_cfc (A : HermitianMat d 𝕜) (f : ℝ → ℝ) : (A.mat * (A.cfc f).mat).trace = ∑ i, A.H.eigenvalues i * f (A.H.eigenvalues i) := by conv_lhs => rw [A.eq_conj_diagonal] @@ -406,10 +407,10 @@ ContinuousOn variant for when all the matrices (A x) have a spectrum in a set T, theorem continuousOn_cfc_fun {T : Set ℝ} (hf : ∀ i ∈ T, ContinuousOn (f · i) S) (hA : spectrum ℝ A.mat ⊆ T) : ContinuousOn (fun x ↦ A.cfc (f x)) S := by - simp_rw [continuousOn_iff_continuous_restrict] at hf ⊢ + simp_rw [continuousOn_iff_continuous_domRestrict] at hf ⊢ apply Continuous.subtype_mk conv => enter [1, x]; apply A.cfc_toMat_eq_sum_smul_proj (f x) - unfold Set.restrict at hf + unfold Set.domRestrict at hf apply continuous_finsetSum _ rw [A.H.spectrum_real_eq_range_eigenvalues] at hA refine fun i _ ↦ Continuous.smul (hf _ (by grind)) (by fun_prop) @@ -508,6 +509,7 @@ lemma dist_lt_of_continuous' {X : Type*} [TopologicalSpace X] have := hUV t' ( ht_fin.1 t' ht'_fin ) x₀ ⟨ mem_of_mem_nhds ( hU t' ( ht_fin.1 t' ht'_fin ) ), hx₀ ⟩ t ⟨ ht'_t, ht ⟩; exact abs_lt.mpr ⟨ by linarith [ abs_lt.mp ‹‖f x t - f x₀ t'‖ < ε / 2›, abs_lt.mp ‹‖f x₀ t - f x₀ t'‖ < ε / 2› ], by linarith [ abs_lt.mp ‹‖f x t - f x₀ t'‖ < ε / 2›, abs_lt.mp ‹‖f x₀ t - f x₀ t'‖ < ε / 2› ] ⟩ +set_option backward.isDefEq.respectTransparency false in /-- The functional calculus is continuous on matrices with spectrum in a compact set. -/ @@ -523,7 +525,7 @@ lemma continuousOn_cfc_of_compact {K : Set ℝ} {g : ℝ → ℝ} (hK : IsCompac -- Extend $g$ to a continuous function on $[a, b]$. obtain ⟨f, hf⟩ : ∃ f : ℝ → ℝ, ContinuousOn f (Set.Icc a b) ∧ ∀ x ∈ K, f x = g x := by have := @ContinuousMap.exists_restrict_eq; - specialize this ( show IsClosed K from hK.isClosed ) ( ContinuousMap.mk ( fun x => g x ) <| by exact continuousOn_iff_continuous_restrict.mp hg ); + specialize this ( show IsClosed K from hK.isClosed ) ( ContinuousMap.mk ( fun x => g x ) <| by exact continuousOn_iff_continuous_domRestrict.mp hg ); exact ⟨ _, this.choose.continuous.continuousOn, fun x hx => by simpa using congr_arg ( fun f => f ⟨ x, hx ⟩ ) this.choose_spec ⟩; exact fun ε εpos => by rcases this a b f hf.1 ε εpos with ⟨ p, hp ⟩ ; exact ⟨ p, fun x hx => by simpa only [ hf.2 x hx ] using hp x ( hab hx ) ⟩ ; exact ⟨ fun n => Classical.choose ( h_stone_weierstrass ( 1 / ( n + 1 ) ) ( by positivity ) ), fun n x hx => le_of_lt ( Classical.choose_spec ( h_stone_weierstrass ( 1 / ( n + 1 ) ) ( by positivity ) ) x hx ) ⟩; @@ -633,6 +635,7 @@ The proof uses the resolvent approach and compactness. Note: we need to connect spectrum ℝ B.mat (the real spectrum) to IsUnit in the complex matrix ring. Use that for self-adjoint elements, t ∈ spectrum ℝ A.mat iff algebraMap ℝ (Matrix d d ℂ) t ∈ spectrum ℂ A.mat, and the resolvent set is open. We can use spectrum.isOpen_resolventSet or the characterization via IsUnit. -/ set_option maxHeartbeats 400000 in +set_option backward.isDefEq.respectTransparency false in lemma spectrum_subset_of_isOpen (A₀ : HermitianMat d ℂ) (U : Set ℝ) (hU : IsOpen U) (hAU : spectrum ℝ A₀.mat ⊆ U) : ∀ᶠ B in nhds A₀, spectrum ℝ B.mat ⊆ U := by @@ -743,7 +746,7 @@ lemma continuousWithinAt_cfc_of_continuousOn {T : Set ℝ} {g : ℝ → ℝ} exact hg.mono hA₀ generalize_proofs at *; ( have := @ContinuousMap.exists_restrict_eq ℝ; - specialize this ( show IsClosed ( spectrum ℝ A₀.val ) from h_finite.isClosed ) ( ContinuousMap.mk ( fun x => g x ) <| by exact continuousOn_iff_continuous_restrict.mp h_cont ) ; rcases this with ⟨ h, hh ⟩ ; exact ⟨ h, h.continuous, fun x hx => by simpa using congr_arg ( fun f => f ⟨ x, hx ⟩ ) hh ⟩ ;)); + specialize this ( show IsClosed ( spectrum ℝ A₀.val ) from h_finite.isClosed ) ( ContinuousMap.mk ( fun x => g x ) <| by exact continuousOn_iff_continuous_domRestrict.mp h_cont ) ; rcases this with ⟨ h, hh ⟩ ; exact ⟨ h, h.continuous, fun x hx => by simpa using congr_arg ( fun f => f ⟨ x, hx ⟩ ) hh ⟩ ;)); obtain ⟨h, hh_cont, hh_eq⟩ := h_ext; have h_cfc_cont : ContinuousWithinAt (fun B => B.cfc h) {B : HermitianMat d ℂ | spectrum ℝ B.mat ⊆ T} A₀ := by exact Continuous.continuousWithinAt (HermitianMat.cfc_continuous hh_cont) @@ -1160,6 +1163,7 @@ theorem cfc_pos_of_pos {A : HermitianMat d 𝕜} {f : ℝ → ℝ} (hA : 0 < A) simp [h_f_pos, spectrum.mem_iff, Matrix.isUnit_iff_isUnit_det, Algebra.algebraMap_eq_smul_one] exact lt_of_le_of_ne h_f_nonneg h_f_nonzero.symm +set_option backward.isDefEq.respectTransparency false in /-- If two matrices A and B commute, then they is a common matrix with which they are both CFCs of. This is a variant of the common theorem that "commuting matrices can be simultaneously diagonalized." -/ theorem _root_.Commute.exists_HermitianMat_cfc (hAB : Commute A.mat B.mat) : diff --git a/QuantumInfo/ForMathlib/HermitianMat/CompoundMatrix.lean b/QuantumInfo/ForMathlib/HermitianMat/CompoundMatrix.lean index 2bcdc65c3e..3573652c44 100644 --- a/QuantumInfo/ForMathlib/HermitianMat/CompoundMatrix.lean +++ b/QuantumInfo/ForMathlib/HermitianMat/CompoundMatrix.lean @@ -31,6 +31,7 @@ noncomputable def compoundHermitian (A : HermitianMat d ℂ) (k : ℕ) : ⟨compoundMatrix A.mat k, (compoundMatrix_conjTranspose A.mat k).symm.trans <| congrArg (compoundMatrix · k) A.H⟩ +set_option backward.isDefEq.respectTransparency false in /-- The eigenvalues of `compoundHermitian A k` are the products of eigenvalues of `A` over `k`-subsets, up to an index permutation. -/ lemma compoundHermitian_eigenvalues (A : HermitianMat d ℂ) (k : ℕ) : @@ -54,6 +55,7 @@ lemma compoundHermitian_nonneg (A : HermitianMat d ℂ) (hA : 0 ≤ A) (k : ℕ) simpa [Function.comp_def] using congrFun hσ (σ.symm S)] exact Finset.prod_nonneg fun _ _ => A.eigenvalues_nonneg hA _ +set_option backward.isDefEq.respectTransparency false in /-- `compoundHermitian` distributes over `HermitianMat.conj`: the compound of `A.conj B` equals the conjugation of `compoundHermitian A k` by `compoundMatrix B k`. -/ lemma compoundHermitian_conj (A : HermitianMat d ℂ) (B : Matrix d d ℂ) (k : ℕ) : diff --git a/QuantumInfo/ForMathlib/HermitianMat/Inner.lean b/QuantumInfo/ForMathlib/HermitianMat/Inner.lean index 8320138c74..913c71be2e 100644 --- a/QuantumInfo/ForMathlib/HermitianMat/Inner.lean +++ b/QuantumInfo/ForMathlib/HermitianMat/Inner.lean @@ -381,7 +381,7 @@ open ComplexOrder in lemma _root_.RCLike.instOrderClosed : OrderClosedTopology 𝕜 where isClosed_le' := by conv => enter [1, 1, p]; rw [RCLike.le_iff_re_im] - simp_rw [Set.setOf_and] + simp_rw [Set.ofPred_and] refine IsClosed.inter (isClosed_le ?_ ?_) (isClosed_eq ?_ ?_) <;> continuity scoped[ComplexOrder] attribute [instance] RCLike.instOrderClosed @@ -413,7 +413,7 @@ theorem Matrix.PosSemiDef_isClosed : IsClosed { A : Matrix n n 𝕜 | A.PosSemid ext A; simp [Matrix.posSemidef_iff_dotProduct_mulVec]] refine IsHermitian_isClosed.inter ?_ suffices IsClosed (⋂ x : n → 𝕜, { A : Matrix n n 𝕜 | 0 ≤ star x ⬝ᵥ A.mulVec x }) by - rwa [← Set.setOf_forall] at this + rwa [← Set.ofPred_forall] at this exact isClosed_iInter fun _ ↦ (isClosed_Ici (a := 0)).preimage (by fun_prop) theorem isClosed_nonneg : IsClosed { A : HermitianMat n 𝕜 | 0 ≤ A } := by @@ -428,7 +428,7 @@ instance : OrderClosedTopology (HermitianMat d 𝕜) where convert IsClosed.preimage (X := (HermitianMat d 𝕜 × HermitianMat d 𝕜)) (f := fun xy ↦ (xy.2 - xy.1)) (by fun_prop) isClosed_nonneg ext ⟨x, y⟩ - simp only [Set.mem_setOf_eq, Set.mem_preimage, ← sub_nonneg (b := x)] + simp only [Set.mem_ofPred_eq, Set.mem_preimage, ← sub_nonneg (b := x)] set_option backward.isDefEq.respectTransparency false in /-- Equivalently: the matrices `X` such that `X - A` is PSD and `B - X` is PSD, form a compact set. -/ diff --git a/QuantumInfo/ForMathlib/HermitianMat/Jordan.lean b/QuantumInfo/ForMathlib/HermitianMat/Jordan.lean index cf43f296d9..f4848e7906 100644 --- a/QuantumInfo/ForMathlib/HermitianMat/Jordan.lean +++ b/QuantumInfo/ForMathlib/HermitianMat/Jordan.lean @@ -36,10 +36,12 @@ set_option backward.isDefEq.respectTransparency false in theorem symmMul_comm : A.symmMul B = B.symmMul A := by rw [symmMul, symmMul, Subtype.mk.injEq, add_comm] +set_option backward.isDefEq.respectTransparency false in @[simp] theorem symmMul_zero : A.symmMul 0 = 0:= by simp [symmMul] +set_option backward.isDefEq.respectTransparency false in @[simp] theorem zero_symmMul : symmMul 0 A = 0 := by simp [symmMul] diff --git a/QuantumInfo/ForMathlib/HermitianMat/LiebConcavity.lean b/QuantumInfo/ForMathlib/HermitianMat/LiebConcavity.lean index db26cb40ec..9fb765b01d 100644 --- a/QuantumInfo/ForMathlib/HermitianMat/LiebConcavity.lean +++ b/QuantumInfo/ForMathlib/HermitianMat/LiebConcavity.lean @@ -133,7 +133,7 @@ omit [Fintype d] in /-- The PSD cone is convex. -/ private lemma psd_convex : Convex ℝ {σ : HermitianMat d ℂ | 0 ≤ σ} := by intro σ₁ hσ₁ σ₂ hσ₂ a b ha hb _ - simp only [Set.mem_setOf_eq] at * + simp only [Set.mem_ofPred_eq] at * exact add_nonneg (smul_nonneg ha hσ₁) (smul_nonneg hb hσ₂) /-- The trace of rpow applied to a congruence is continuous in the base matrix. -/ @@ -329,6 +329,7 @@ private lemma liebExtension_bridge [Nonempty d] /- **AB/BA rewrite**: `Tr[(H.conj (σ^s))^p] = Tr[((σ^{2s}).conj (H^{1/2}))^p]` for PSD σ, H. -/ +set_option backward.isDefEq.respectTransparency false in private lemma trace_conj_rpow_eq_conj_sqrt [Nonempty d] (σ H : HermitianMat d ℂ) (hσ : 0 ≤ σ) (hH : 0 ≤ H) (s p : ℝ) (hs : 0 < s) : ((H.conj (σ ^ s).mat) ^ p).trace = @@ -497,7 +498,7 @@ theorem trace_conj_rpow_concave {α : ℝ} (hα : 1 < α) (fun σ ↦ ((H.conj (σ ^ ((α - 1) / (2 * α))).mat) ^ (α / (α - 1))).trace) := by refine' ⟨psd_convex, fun σ₁ hσ₁ σ₂ hσ₂ a b ha hb hab => _⟩ by_cases hd : Nonempty d - · simp only [Set.mem_setOf_eq, smul_eq_mul] at * + · simp only [Set.mem_ofPred_eq, smul_eq_mul] at * open scoped Topology in refine' le_of_tendsto_of_tendsto (b := 𝓝[>] (0 : ℝ)) (f := fun ε ↦ a * ((H.conj ((σ₁ + ε • 1) ^ ((α - 1) / (2 * α))).mat) ^ (α / (α - 1))).trace + diff --git a/QuantumInfo/ForMathlib/HermitianMat/LogExp.lean b/QuantumInfo/ForMathlib/HermitianMat/LogExp.lean index 951da65642..10916a389a 100644 --- a/QuantumInfo/ForMathlib/HermitianMat/LogExp.lean +++ b/QuantumInfo/ForMathlib/HermitianMat/LogExp.lean @@ -235,7 +235,7 @@ theorem logApprox_mono {x y : HermitianMat d 𝕜} (hx : x.mat.PosDef) (hy : y.m exact h_inv_cont.comp ( continuous_subtype_val.tendsto _ ); · fun_prop; · intro t ht; - simp only [Set.mem_setOf_eq, mat_add, mat_smul, mat_one] + simp only [Set.mem_ofPred_eq, mat_add, mat_smul, mat_one] rw [Matrix.posDef_iff_dotProduct_mulVec] at hx ⊢ refine' ⟨ _, _ ⟩; · exact H ((fun t => x + t • 1) t); @@ -274,7 +274,7 @@ theorem logApprox_mono {x y : HermitianMat d 𝕜} (hx : x.mat.PosDef) (hy : y.m simp_all [ Matrix.inv_def ]; exact ContinuousOn.smul ( h_cont_det.inv₀ fun t ht => h_inv t ht.1 ht.2 ) h_cont_adj; convert h_cont_inv using 1; - rw [ continuousOn_iff_continuous_restrict ] at *; + rw [ continuousOn_iff_continuous_domRestrict ] at *; exact continuous_induced_rng.mpr h_cont rw [ intervalIntegral.integral_of_le hT.le, intervalIntegral.integral_of_le hT.le ]; apply_rules [ MeasureTheory.integral_mono_ae ]; @@ -434,7 +434,7 @@ theorem le_of_exp_commute (hAB₂ : A.exp ≤ B.exp) : · exact hAB₂ set_option maxHeartbeats 10000000 in -open ComplexOrder Matrix in +open ComplexOrder _root_.HermitianMat.Matrix in /-- The inverse function is operator convex on positive definite matrices. -/ @@ -540,7 +540,8 @@ lemma inv_shift_convex {x y : HermitianMat d 𝕜} (hx : x.mat.PosDef) (hy : y.m ext simp [add_assoc, add_left_comm, hab, ← add_smul] -open MeasureTheory intervalIntegral ComplexOrder Matrix in +open MeasureTheory intervalIntegral ComplexOrder in +open _root_.HermitianMat.Matrix in open scoped Matrix.Norms.Frobenius in set_option backward.isDefEq.respectTransparency false in /-- @@ -628,6 +629,7 @@ theorem log_concave {x y : HermitianMat d 𝕜} (hx : x.mat.PosDef) (hy : y.mat. /- The logarithm of the Kronecker product of two diagonal Hermitian matrices is the sum of the Kronecker products of their logarithms with the identity matrix. -/ +set_option backward.isDefEq.respectTransparency false in lemma log_kron_diagonal {m n 𝕜 : Type*} [Fintype m] [DecidableEq m] [Fintype n] [DecidableEq n] [RCLike 𝕜] {d₁ : m → ℝ} {d₂ : n → ℝ} (h₁ : ∀ i, 0 < d₁ i) (h₂ : ∀ j, 0 < d₂ j) : (diagonal 𝕜 d₁ ⊗ₖ diagonal 𝕜 d₂).log = diff --git a/QuantumInfo/ForMathlib/HermitianMat/Order.lean b/QuantumInfo/ForMathlib/HermitianMat/Order.lean index b4de4348a9..543d126d02 100644 --- a/QuantumInfo/ForMathlib/HermitianMat/Order.lean +++ b/QuantumInfo/ForMathlib/HermitianMat/Order.lean @@ -420,6 +420,7 @@ lemma conj_posDef [DecidableEq n] (hA : A.mat.PosDef) (hN : IsUnit N) : simp only [conj_apply_mat, mulVec_mulVec, Matrix.mul_assoc] simp [dotProduct_mulVec, mulVec_conjTranspose] +set_option backward.isDefEq.respectTransparency false in lemma inv_conj [DecidableEq n] {M : Matrix n n 𝕜} (hM : IsUnit M) : (A.conj M)⁻¹ = A⁻¹.conj (M⁻¹)ᴴ := by have h_inv : (M⁻¹)ᴴ * Mᴴ = 1 := by @@ -485,6 +486,7 @@ theorem ker_sum [DecidableEq n] (f : ι → HermitianMat n 𝕜) (hf : ∀ i, 0 · intro h simp [Matrix.sum_mulVec, h] +set_option backward.isDefEq.respectTransparency false in theorem ker_conj [DecidableEq n] (hA : 0 ≤ A) (B : Matrix n n 𝕜) : (A.conj B).ker = Submodule.comap (Matrix.toEuclideanLin B.conjTranspose) A.ker := by @@ -680,11 +682,13 @@ example (M : Matrix m n ℂ) : 0 ≤ M.conjTranspose * M := by positivity example (M : Matrix n m ℂ) : 0 ≤ M * M.conjTranspose := by positivity -- Test: ⟨Mᴴ * M, _⟩ nonneg as HermitianMat +set_option backward.isDefEq.respectTransparency false in example (M : Matrix m n ℂ) : (0 : HermitianMat n ℂ) ≤ ⟨M.conjTranspose * M, Matrix.isHermitian_conjTranspose_mul_self M⟩ := by positivity -- Test: ⟨M * Mᴴ, _⟩ nonneg as HermitianMat +set_option backward.isDefEq.respectTransparency false in example (M : Matrix n m ℝ) : (0 : HermitianMat n ℝ) ≤ ⟨M * M.conjTranspose, Matrix.isHermitian_mul_conjTranspose_self M⟩ := by positivity diff --git a/QuantumInfo/ForMathlib/HermitianMat/Peierls.lean b/QuantumInfo/ForMathlib/HermitianMat/Peierls.lean index 5db4fab2ee..08d48b5c17 100644 --- a/QuantumInfo/ForMathlib/HermitianMat/Peierls.lean +++ b/QuantumInfo/ForMathlib/HermitianMat/Peierls.lean @@ -105,6 +105,7 @@ theorem peierls_inequality_ici (A : HermitianMat d ℂ) (g : ℝ → ℝ) (hg : exact fun j => Matrix.unitaryGroup_row_norm (H A).eigenvectorUnitary j simp_all [trace_cfc_eq] +set_option backward.isDefEq.respectTransparency false in /-- Joint convexity of the trace functional: for a convex function g, the map A ↦ tr(g(A)) is convex on the space of Hermitian matrices. @@ -163,6 +164,7 @@ theorem trace_function_convex_univ (g : ℝ → ℝ) (hg : ConvexOn ℝ Set.univ simp_all only exact h1 +set_option backward.isDefEq.respectTransparency false in open ComplexOrder in /-- Convexity of trace functions: if `g` is convex on `ℝ₊`, then `A ↦ Tr[g(A)]` is diff --git a/QuantumInfo/ForMathlib/HermitianMat/Proj.lean b/QuantumInfo/ForMathlib/HermitianMat/Proj.lean index 46c32c3e03..f3969253ff 100644 --- a/QuantumInfo/ForMathlib/HermitianMat/Proj.lean +++ b/QuantumInfo/ForMathlib/HermitianMat/Proj.lean @@ -78,6 +78,7 @@ theorem projector_ker : (projector S).ker = Sᗮ := by Matrix.toLpLin_eq_toLin, Matrix.toLin_toMatrix] exact Submodule.starProjection_apply_eq_zero_iff (K := S) +set_option backward.isDefEq.respectTransparency false in @[simp] theorem trace_projector : (projector S).trace = (Module.finrank 𝕜 S : ℝ) := by suffices h_trace : ((S.subtype ∘ₗ S.orthogonalProjectionOnto).toMatrix (EuclideanSpace.basisFun n 𝕜).toBasis (EuclideanSpace.basisFun n 𝕜).toBasis).trace = Module.finrank 𝕜 S by @@ -140,7 +141,6 @@ theorem projector_eq_sum_rankOne (b : OrthonormalBasis ι 𝕜 S) : convert! congr_arg ( fun x : EuclideanSpace ( _ ) n => x i ) ( h_proj j ) using 1 simp [ Matrix.sum_apply, mul_comm ] -set_option backward.isDefEq.respectTransparency false in /-- The projector onto the support of A is the sum of the projections onto the eigenvectors with non-zero eigenvalues. -/ diff --git a/QuantumInfo/ForMathlib/HermitianMat/Reindex.lean b/QuantumInfo/ForMathlib/HermitianMat/Reindex.lean index 92db1ff074..87709dde3e 100644 --- a/QuantumInfo/ForMathlib/HermitianMat/Reindex.lean +++ b/QuantumInfo/ForMathlib/HermitianMat/Reindex.lean @@ -83,18 +83,22 @@ theorem reindex_conj [Fintype d₂] [Fintype d] (B : Matrix d₃ d₂ 𝕜) : variable [Fintype d] +set_option backward.isDefEq.respectTransparency false in theorem conj_submatrix (B : Matrix d₂ d₄ 𝕜) (e : d₃ ≃ d₂) (f : d → d₄) : A.conj (B.submatrix e f) = (A.conj (B.submatrix id f)).reindex e.symm := by ext1 simp [conj_apply, ← Matrix.submatrix_mul_equiv (e₂ := .refl d)] -theorem reindex_eq_conj [DecidableEq d] (e : d ≃ d₂) : A.reindex e = A.conj (Matrix.reindex e (.refl d) 1) := by +set_option backward.isDefEq.respectTransparency false in +theorem reindex_eq_conj [DecidableEq d] (e : d ≃ d₂) : + A.reindex e = A.conj (Matrix.reindex e (.refl d) 1) := by ext : 3 simp [-mat_apply, reindex, conj_apply, Matrix.submatrix, Matrix.mul_apply, Matrix.one_apply] variable [Fintype d₂] [DecidableEq d] [DecidableEq d₂] +set_option backward.isDefEq.respectTransparency false in theorem ker_reindex : (A.reindex e).ker = A.ker.comap (LinearEquiv.euclideanOfRelabel 𝕜 e).toLinearMap := by dsimp only [reindex, ker, lin] diff --git a/QuantumInfo/ForMathlib/HermitianMat/Rpow.lean b/QuantumInfo/ForMathlib/HermitianMat/Rpow.lean index e6aeef8671..3d2c413a8d 100644 --- a/QuantumInfo/ForMathlib/HermitianMat/Rpow.lean +++ b/QuantumInfo/ForMathlib/HermitianMat/Rpow.lean @@ -269,6 +269,7 @@ private lemma rpow_kron_diagonal congr! 2 with x apply Real.mul_rpow (ha x.1) (hb x.2) +set_option backward.isDefEq.respectTransparency false in open scoped Kronecker in omit [DecidableEq d] [DecidableEq d₂] in lemma conj_kron @@ -766,7 +767,7 @@ private lemma top_singular_le_of_self_mul_le_smul_one {α : ℝ} (_ : 0 ≤ α) (hX : X.conjTranspose * X ≤ α • (1 : Matrix e e ℂ)) (hcard : 0 < Fintype.card e) : singularValuesSorted X ⟨0, hcard⟩ ≤ Real.sqrt α := by - letI : Nonempty e := Fintype.card_pos_iff.mp hcard + let : Nonempty e := Fintype.card_pos_iff.mp hcard let hne : (Finset.univ : Finset e).Nonempty := by simp rw [singularValuesSorted_zero_eq_sup X hcard] @@ -951,6 +952,7 @@ private lemma trace_conj_rpow_eq_sum_singularValuesSorted push_cast congr 1 simp [H, Matrix.conjTranspose_conjTranspose] + rfl private lemma lieb_thirring_le_one_posDef {A B : HermitianMat d ℂ} (hA : 0 ≤ A) (hB : B.mat.PosDef) diff --git a/QuantumInfo/ForMathlib/HermitianMat/Trace.lean b/QuantumInfo/ForMathlib/HermitianMat/Trace.lean index 3df4fc0591..19e22b46d2 100644 --- a/QuantumInfo/ForMathlib/HermitianMat/Trace.lean +++ b/QuantumInfo/ForMathlib/HermitianMat/Trace.lean @@ -151,6 +151,7 @@ theorem trace_eq_one_iff (A : HermitianMat n 𝕜) : A.trace = 1 ↔ A.mat.trace rw [← trace_eq_trace_rc] exact ⟨mod_cast id, mod_cast id⟩ +set_option backward.isDefEq.respectTransparency false in @[simp] theorem trace_reindex (A : HermitianMat n ℂ) (e : n ≃ m) : (A.reindex e).trace = A.trace := by diff --git a/QuantumInfo/ForMathlib/HermitianMat/Unitary.lean b/QuantumInfo/ForMathlib/HermitianMat/Unitary.lean index feab498530..c5ede42237 100644 --- a/QuantumInfo/ForMathlib/HermitianMat/Unitary.lean +++ b/QuantumInfo/ForMathlib/HermitianMat/Unitary.lean @@ -81,6 +81,7 @@ namespace HermitianMat variable {𝕜 : Type*} [RCLike 𝕜] {n : Type*} [Fintype n] [DecidableEq n] variable (A B : HermitianMat n 𝕜) (U : Matrix.unitaryGroup n 𝕜) +set_option backward.isDefEq.respectTransparency false in @[simp] theorem trace_conj_unitary : (conj U.val A).trace = A.trace := by simp [Matrix.trace_mul_cycle, conj, ← Matrix.star_eq_conjTranspose, trace] @@ -93,6 +94,7 @@ theorem le_conj_unitary : A.conj U.val ≤ B.conj U ↔ A ≤ B := by simpa [HermitianMat.conj_conj] using conj_nonneg (star U).val h · exact fun h ↦ conj_nonneg U.val h +set_option backward.isDefEq.respectTransparency false in open RealInnerProductSpace in @[simp] theorem inner_conj_unitary : ⟪A.conj U.val, B.conj U.val⟫ = ⟪A, B⟫ := by diff --git a/QuantumInfo/ForMathlib/Isometry.lean b/QuantumInfo/ForMathlib/Isometry.lean index 133acee530..b45bb8581e 100644 --- a/QuantumInfo/ForMathlib/Isometry.lean +++ b/QuantumInfo/ForMathlib/Isometry.lean @@ -350,6 +350,7 @@ noncomputable def Commute.isSymmetric_directSumDecomposition {𝕜 E : Type*} [ · replace h₁ : eigenspace A fst = ⊥ := by simpa [Module.End.HasUnifEigenvalue] using h₁ simp [h₁] +set_option backward.isDefEq.respectTransparency false in /-- Similar to `LinearMap.IsSymmetric.directSum_isInternal_of_commute`, but here the direct sum is indexed by only the pairs of eigenvalues, as opposed to all pairs of `𝕜` values, giving a finite decomposition. -/ diff --git a/QuantumInfo/ForMathlib/LimSupInf.lean b/QuantumInfo/ForMathlib/LimSupInf.lean index fdc408a497..7de745f571 100644 --- a/QuantumInfo/ForMathlib/LimSupInf.lean +++ b/QuantumInfo/ForMathlib/LimSupInf.lean @@ -39,7 +39,7 @@ lemma exists_strictMono_seq_le (y : ℝ≥0) (f : ℝ≥0 → ℕ → ℝ≥0∞ have h_freq (k n : ℕ) : ∃ m > n, f ((k + 1 : ℝ≥0)⁻¹) m ≤ y + (k + 1 : ℝ≥0)⁻¹ := by specialize hf ((k + 1 : ℝ≥0)⁻¹) (by positivity) rw [Filter.liminf_eq] at hf - simp only [Filter.eventually_atTop, sSup_le_iff, Set.mem_setOf_eq, forall_exists_index] at hf + simp only [Filter.eventually_atTop, sSup_le_iff, Set.mem_ofPred_eq, forall_exists_index] at hf contrapose! hf refine ⟨_, n + 1, fun m hm ↦ (hf m hm).le, ENNReal.lt_add_right (by norm_num) (by norm_num)⟩ refine ⟨fun k ↦ k.recOn (Classical.choose (h_freq 0 0)) @@ -60,7 +60,7 @@ lemma exists_seq_bound (y : ℝ≥0) (f : ℝ≥0 → ℕ → ℝ≥0∞) (hf : · exact y + (k + 1 : ℝ≥0∞)⁻¹ · exact ENNReal.lt_add_right (by norm_num) (by norm_num) · intro b hb - simp only [Filter.eventually_map, Filter.eventually_atTop, Set.mem_setOf_eq] at hb + simp only [Filter.eventually_map, Filter.eventually_atTop, Set.mem_ofPred_eq] at hb obtain ⟨w, h⟩ := hb obtain ⟨_, hw_left, hw_right⟩ := hf w grw [hw_right] @@ -313,7 +313,7 @@ lemma liminf_le_of_block_sequence_witnesses {α : Type*} (y : ℝ≥0) (f : α rw [ Filter.liminf_eq ]; simp_all only [Set.mem_Ico, and_imp, ne_eq, add_eq_zero, Nat.cast_eq_zero, one_ne_zero, and_false, not_false_eq_true, ENNReal.coe_inv, ENNReal.coe_add, ENNReal.coe_natCast, ENNReal.coe_one, - Filter.eventually_atTop, sSup_le_iff, Set.mem_setOf_eq, forall_exists_index] + Filter.eventually_atTop, sSup_le_iff, Set.mem_ofPred_eq, forall_exists_index] intro b x_1 h -- Fix an arbitrary $k \geq x_1$. suffices h_suff : ∀ k ≥ x_1, ∃ n ≥ k, f (g n) n ≤ y + 1 / (k + 1) by @@ -345,7 +345,7 @@ lemma limsup_le_of_block_sequence_bound {α : Type*} (y : ℝ≥0) (f : α → · aesop simp_all only [Set.mem_Ico, and_imp, ne_eq, add_eq_zero, Nat.cast_eq_zero, one_ne_zero, and_false, not_false_eq_true, ENNReal.coe_inv, ENNReal.coe_add, ENNReal.coe_natCast, ENNReal.coe_one, - Filter.eventually_map, Filter.eventually_atTop, Set.mem_setOf_eq] + Filter.eventually_map, Filter.eventually_atTop, Set.mem_ofPred_eq] -- Choose $K$ such that for all $k \ge K$, we have $1/(k+1) \le \epsilon$. obtain ⟨K, hK⟩ : ∃ K : ℕ, ∀ k ≥ K, (k + 1 : ℝ≥0)⁻¹ ≤ ε := by rcases ENNReal.lt_iff_exists_nnreal_btwn.mp hε with ⟨ δ, hδ, hδε ⟩ @@ -407,7 +407,7 @@ lemma exists_liminf_zero_of_forall_liminf_limsup_le_with_UB (y₁ y₂ : ℝ≥0 rw [ Filter.limsup_eq ] at h_limsup_le; have := exists_lt_of_csInf_lt ( show { a : ℝ≥0∞ | ∀ᶠ n in Filter.atTop, f₂ ( x k ) n ≤ a }.Nonempty from ⟨ _, Filter.Eventually.of_forall fun n => le_top ⟩ ) ( show InfSet.sInf { a : ℝ≥0∞ | ∀ᶠ n in Filter.atTop, f₂ ( x k ) n ≤ a } < ( y₂ : ℝ≥0∞ ) + ε from lt_of_le_of_lt h_limsup_le <| ENNReal.lt_add_right ( by aesop ) <| by aesop ) simp_all only [gt_iff_lt, one_div, ne_eq, add_eq_zero, Nat.cast_eq_zero, one_ne_zero, and_false, - not_false_eq_true, NNReal.le_inv_iff_mul_le, implies_true, Filter.eventually_atTop, ge_iff_le, Set.mem_setOf_eq] + not_false_eq_true, NNReal.le_inv_iff_mul_le, implies_true, Filter.eventually_atTop, ge_iff_le, Set.mem_ofPred_eq] obtain ⟨left, right⟩ := hx obtain ⟨w, h⟩ := this obtain ⟨left_1, right⟩ := right @@ -485,7 +485,7 @@ lemma exists_liminf_zero_of_forall_liminf_limsup_le_with_UB (y₁ y₂ : ℝ≥0 theorem extracted_limsup_inequality (z : ℝ≥0∞) (hz : z ≠ ⊤) (y x : ℕ → ℝ≥0∞) (h_lem5 : ∀ (n : ℕ), x n ≤ y n + z) : Filter.atTop.limsup (fun n ↦ x n / n) ≤ Filter.atTop.limsup (fun n ↦ y n / n) := by --Thanks Aristotle! - simp only [Filter.limsup_eq, Filter.eventually_atTop, le_sInf_iff, Set.mem_setOf_eq, + simp only [Filter.limsup_eq, Filter.eventually_atTop, le_sInf_iff, Set.mem_ofPred_eq, forall_exists_index] -- Taking the limit superior of both sides of the inequality x n / n ≤ y_n / n + z / n, we -- get limsup x n / n ≤ limsup (y n / n + z / n). diff --git a/QuantumInfo/ForMathlib/LinearEquiv.lean b/QuantumInfo/ForMathlib/LinearEquiv.lean index 2626a07acf..af8a976c29 100644 --- a/QuantumInfo/ForMathlib/LinearEquiv.lean +++ b/QuantumInfo/ForMathlib/LinearEquiv.lean @@ -31,6 +31,7 @@ together with lemmas relating them to `Matrix.reindex`. ## iv. References +* None. -/ @[expose] public section diff --git a/QuantumInfo/ForMathlib/Majorization.lean b/QuantumInfo/ForMathlib/Majorization.lean index 5c8324e328..9bb257922c 100644 --- a/QuantumInfo/ForMathlib/Majorization.lean +++ b/QuantumInfo/ForMathlib/Majorization.lean @@ -238,6 +238,7 @@ lemma compoundMatrix_mul (M N : Matrix d d ℂ) (k : ℕ) : ext1 apply cauchyBinet +set_option backward.isDefEq.respectTransparency false in /-- `compoundMatrix` commutes with `conjTranspose`. -/ lemma compoundMatrix_conjTranspose (M : Matrix d d ℂ) (k : ℕ) : compoundMatrix M.conjTranspose k = (compoundMatrix M k).conjTranspose := by @@ -246,6 +247,7 @@ lemma compoundMatrix_conjTranspose (M : Matrix d d ℂ) (k : ℕ) : rw [Matrix.conjTranspose_apply, ← Matrix.det_conjTranspose] simp +set_option backward.isDefEq.respectTransparency false in /-- The compound matrix of a diagonal matrix is diagonal, with entries being products of eigenvalues over k-subsets. -/ @@ -254,7 +256,7 @@ lemma compoundMatrix_diagonal (f : d → ℂ) (k : ℕ) : Matrix.diagonal (fun S : {S : Finset d // S.card = k} => ∏ i : Fin k, f (S.1.orderEmbOfFin S.2 i)) := by ext S T; by_cases h : S = T <;> simp_all [Matrix.diagonal] - · refine' Matrix.det_of_upperTriangular _ |> fun h => h.trans _ + · refine' Matrix.det_of_isUpperTriangular _ |> fun h => h.trans _ · intro i j hij; aesop · aesop · -- Since $S \neq T$, there exists some $i \in S$ such that $i \notin T$. @@ -461,6 +463,7 @@ lemma singularValues_compoundMatrix_rev (M : Matrix d d ℂ) (k : ℕ) obtain ⟨σ, hσ⟩ := singularValues_compoundMatrix_perm M k exact ⟨σ.symm j, by rw [← hσ]; simp⟩ +set_option backward.isDefEq.respectTransparency false in /-- There exists a bijection `σ : Fin (card d) ≃ d` such that `singularValues M (σ i) = singularValuesSorted M i` for all `i`. -/ lemma exists_sorting_equiv (M : Matrix d d ℂ) : @@ -535,6 +538,7 @@ lemma prod_singularValues_subset_le_sorted_prod (M : Matrix d d ℂ) (k : ℕ) simpa [g] using congr_arg σ hij set_option maxHeartbeats 800000 in +set_option backward.isDefEq.respectTransparency false in lemma exists_subset_prod_eq_sorted_prod (M : Matrix d d ℂ) (k : ℕ) (hk : k ≤ Fintype.card d) : ∃ S : {S : Finset d // S.card = k}, @@ -841,7 +845,6 @@ For the direct induction approach on n: Hmm, this doesn't work cleanly because log(y_i/x_i) can be negative for some i. Better approach: prove it directly using the Abel summation identity and nonnegativity of each term. -/ -set_option backward.isDefEq.respectTransparency false in lemma sum_mul_log_nonneg_of_weak_log_maj {n : ℕ} {x y : Fin n → ℝ} (hx_pos : ∀ i, 0 < x i) (hy_pos : ∀ i, 0 < y i) diff --git a/QuantumInfo/ForMathlib/Matrix.lean b/QuantumInfo/ForMathlib/Matrix.lean index a2aee46caa..9e3d16ede2 100644 --- a/QuantumInfo/ForMathlib/Matrix.lean +++ b/QuantumInfo/ForMathlib/Matrix.lean @@ -43,6 +43,7 @@ theorem fromBlocks_gram_posSemidef {m n k : Type*} [Fintype m] [Fintype n] [Fint rw [fromBlocks_conjTranspose, fromBlocks_multiply] simp +set_option backward.isDefEq.respectTransparency false in theorem zero_rank_eq_zero {A : Matrix n n 𝕜} [Fintype n] (hA : A.rank = 0) : A = 0 := by have h : ∀ v, A.mulVecLin v = 0 := by intro v @@ -76,10 +77,10 @@ theorem smul_real (c : ℝ) : (c • A).IsHermitian := by def HermitianSubspace (n 𝕜 : Type*) [Fintype n] [RCLike 𝕜] : Subspace ℝ (Matrix n n 𝕜) where carrier := { A : Matrix n n 𝕜 | A.IsHermitian } - add_mem' _ _ := by simp_all only [Set.mem_setOf_eq, IsHermitian.add] - zero_mem' := by simp only [Set.mem_setOf_eq, isHermitian_zero] + add_mem' _ _ := by simp_all only [Set.mem_ofPred_eq, IsHermitian.add] + zero_mem' := by simp only [Set.mem_ofPred_eq, isHermitian_zero] smul_mem' c A := by - simp only [Set.mem_setOf_eq] + simp only [Set.mem_ofPred_eq] intro hA exact IsHermitian.smul_real hA c @@ -863,7 +864,7 @@ theorem cfc_diagonal (g : d → ℝ) (f : ℝ → ℝ) : change Matrix.conjTranspose _ = _ simp [Matrix.conjTranspose] --TODO cfc_cont_tac - rw [cfc, dif_pos ⟨h_self_adjoint, continuousOn_iff_continuous_restrict.mpr <| by fun_prop⟩] + rw [cfc, dif_pos ⟨h_self_adjoint, continuousOn_iff_continuous_domRestrict.mpr <| by fun_prop⟩] rw [cfcHom_eq_of_continuous_of_map_id] rotate_left · refine' { .. } diff --git a/QuantumInfo/ForMathlib/MatrixNorm/TraceNorm.lean b/QuantumInfo/ForMathlib/MatrixNorm/TraceNorm.lean index 7bffe61cab..ec2ec3f494 100644 --- a/QuantumInfo/ForMathlib/MatrixNorm/TraceNorm.lean +++ b/QuantumInfo/ForMathlib/MatrixNorm/TraceNorm.lean @@ -195,10 +195,10 @@ theorem exists_svd_sqrt_eigenvalues (A : Matrix n n ℂ) : if hi : hH.eigenvalues i ≠ 0 then ((s i)⁻¹ • WithLp.toLp 2 (A.mulVec (hH.eigenvectorBasis i).ofLp)) else 0 - have hu : Orthonormal ℂ ({i | hH.eigenvalues i ≠ 0}.restrict u) := by + have hu : Orthonormal ℂ ({i | hH.eigenvalues i ≠ 0}.domRestrict u) := by rw [orthonormal_iff_ite] intro i j - dsimp [u, s] + dsimp [u, s, Set.domRestrict] have hi' : hH.eigenvalues i.1 ≠ 0 := i.2 have hj' : hH.eigenvalues j.1 ≠ 0 := j.2 simp only [hi', hj', not_false_eq_true, if_true] @@ -282,7 +282,7 @@ omit [DecidableEq n] in /-- Every singular value is bounded by the operator norm. -/ theorem singularValues_le_opNorm [DecidableEq n] (A : Matrix n n ℂ) (i : n) : singularValues A i ≤ ‖A‖ := by - letI : Nonempty n := ⟨i⟩ + let : Nonempty n := ⟨i⟩ let hH : (Aᴴ * A).IsHermitian := by simpa using (Matrix.isHermitian_mul_conjTranspose_self A.conjTranspose) have hmem : hH.eigenvalues i ∈ spectrum ℝ (Aᴴ * A) := by @@ -307,9 +307,9 @@ theorem traceNorm_mul_le_opNorm_traceNorm [DecidableEq n] (A B : Matrix n n ℂ) (A * B).traceNorm ≤ ‖A‖ * B.traceNorm := by classical by_cases h : IsEmpty n - · letI := h + · let := h simp [Subsingleton.elim A 0, Subsingleton.elim B 0] - · letI : Nonempty n := not_isEmpty_iff.mp h + · let : Nonempty n := not_isEmpty_iff.mp h have hcard : 0 < Fintype.card n := Fintype.card_pos_iff.mpr ‹Nonempty n› have htop : singularValuesSorted A ⟨0, hcard⟩ ≤ ‖A‖ := by rw [singularValuesSorted_zero_eq_sup A hcard] @@ -337,7 +337,7 @@ omit [DecidableEq n] in theorem traceNorm_conjTranspose (A : Matrix n n ℂ) : Aᴴ.traceNorm = A.traceNorm := by classical - letI : DecidableEq n := Classical.decEq n + let : DecidableEq n := Classical.decEq n have hH : (Aᴴ * A).IsHermitian := Matrix.isHermitian_conjTranspose_mul_self A obtain ⟨V, W, hA⟩ := Matrix.exists_svd_sqrt_eigenvalues A set D : Matrix n n ℂ := @@ -462,7 +462,7 @@ theorem traceNorm_add_le (A B : Matrix n n ℂ) : (A + B).traceNorm ≤ A.traceN rw [Matrix.mul_add, Matrix.trace_add, Complex.add_re] at h₁ obtain h₂ := (traceNorm_eq_max_re_tr_U A).right obtain h₃ := (traceNorm_eq_max_re_tr_U B).right - simp only [upperBounds, Set.mem_setOf_eq] at h₂ h₃ + simp only [upperBounds, Set.mem_ofPred_eq] at h₂ h₃ calc _ _ = RCLike.re ((Uab.1 * A).trace) + RCLike.re ((Uab.1 * B).trace) := h₁.symm _ ≤ traceNorm A + RCLike.re ((Uab.1 * B).trace) := by diff --git a/QuantumInfo/ForMathlib/SionMinimax.lean b/QuantumInfo/ForMathlib/SionMinimax.lean index e2aaaeed5a..dc87b21d75 100644 --- a/QuantumInfo/ForMathlib/SionMinimax.lean +++ b/QuantumInfo/ForMathlib/SionMinimax.lean @@ -212,10 +212,10 @@ theorem ciInf_le_ciInf_of_subset {α β : Type*} [ConditionallyCompleteLattice theorem LowerSemicontinuousOn.dite_top {α β : Type*} [TopologicalSpace α] [Preorder β] [OrderTop β] {s : Set α} (p : α → Prop) [DecidablePred p] {f : (a : α) → p a → β} (hf : LowerSemicontinuousOn (fun x : Subtype p ↦ f x.val x.prop) {x | x.val ∈ s}) - (h_relatively_closed : ∃ U : Set α, IsClosed U ∧ s ∩ U = s ∩ setOf p) : + (h_relatively_closed : ∃ U : Set α, IsClosed U ∧ s ∩ U = s ∩ Set.ofPred p) : LowerSemicontinuousOn (fun x ↦ dite (p x) (f x) (fun _ ↦ ⊤)) s := by rcases h_relatively_closed with ⟨u, ⟨hu, hsu⟩⟩ - simp only [Set.ext_iff, Set.mem_inter_iff, Set.mem_setOf_eq, and_congr_right_iff] at hsu + simp only [Set.ext_iff, Set.mem_inter_iff, Set.mem_ofPred_eq, and_congr_right_iff] at hsu intro x hx y hy dsimp at hy split_ifs at hy with h @@ -225,9 +225,12 @@ theorem LowerSemicontinuousOn.dite_top {α β : Type*} [TopologicalSpace α] [Pr filter_upwards [hf] simp only [Subtype.forall] grind [lt_top_of_lt] - · filter_upwards [self_mem_nhdsWithin, mem_nhdsWithin_of_mem_nhds (hu.isOpen_compl.mem_nhds (show x ∉ u by grind))] - intros - simp_all only [Set.mem_compl_iff, ↓reduceDIte] + · have hxu : x ∉ u := fun hxu ↦ h ((hsu x hx).mp hxu) + filter_upwards [self_mem_nhdsWithin, + mem_nhdsWithin_of_mem_nhds (hu.isOpen_compl.mem_nhds hxu)] + intro z hzs hzu + rw [dif_neg (show ¬p z from fun hpz ↦ hzu ((hsu z hzs).mpr hpz))] + exact hy theorem LowerSemicontinuousOn.comp_continuousOn {α β γ : Type*} [TopologicalSpace α] [TopologicalSpace β] [Preorder γ] {f : α → β} {s : Set α} {g : β → γ} {t : Set β} @@ -251,10 +254,10 @@ theorem UpperSemicontinuousOn.comp_continuousOn {α β γ : Type*} LowerSemicontinuousOn.comp_continuousOn (γ := γᵒᵈ) hg hf h theorem LowerSemicontinuousOn.ite_top {α β : Type*} [TopologicalSpace α] [Preorder β] [OrderTop β] - {s : Set α} (p : α → Prop) [DecidablePred p] {f : (a : α) → β} (hf : LowerSemicontinuousOn f (s ∩ setOf p)) - (h_relatively_closed : ∃ U : Set α, IsClosed U ∧ s ∩ U = s ∩ setOf p) : + {s : Set α} (p : α → Prop) [DecidablePred p] {f : (a : α) → β} (hf : LowerSemicontinuousOn f (s ∩ Set.ofPred p)) + (h_relatively_closed : ∃ U : Set α, IsClosed U ∧ s ∩ U = s ∩ Set.ofPred p) : LowerSemicontinuousOn (fun x ↦ ite (p x) (f x) ⊤) s := - dite_top p (hf.comp_continuousOn (by fun_prop) (by intro; simp)) h_relatively_closed + dite_top p (hf.comp_continuousOn (by fun_prop) (fun z hz ↦ ⟨hz, z.2⟩)) h_relatively_closed theorem LeftOrdContinuous.comp_lowerSemicontinuousOn_strong_assumptions {α γ δ : Type*} [TopologicalSpace α] [LinearOrder γ] [LinearOrder δ] [TopologicalSpace δ] [OrderTopology δ] @@ -402,7 +405,7 @@ private lemma sion_exists_min_2 (y₁ y₂ : N) (hy₁ : y₁ ∈ T) (hy₂ : y have hC_subset_C' (z) : C z ⊆ C' z := fun x hx ↦ ⟨hx.1, hx.2.trans hβ₁.le⟩ have hC_nonempty (z) (hz : z ∈ segment ℝ y₁ y₂) : (C z).Nonempty := by - simp only [Set.Nonempty, Set.mem_setOf_eq, C] + simp only [Set.Nonempty, Set.mem_ofPred_eq, C] exact sion_exists_min_lowerSemi hfc₂ hS₁ hS₃ a hc z (hT₂.segment_subset hy₁ hy₂ hz) have hC_closed (z) (hz : z ∈ segment ℝ y₁ y₂) : IsClosed (C z) := by specialize hfc₂ z (hT₂.segment_subset hy₁ hy₂ hz) @@ -475,7 +478,7 @@ private lemma sion_exists_min_2 (y₁ y₂ : N) (hy₁ : y₁ ∈ T) (hy₂ : y have hI : IsClosed I := by apply IsSeqClosed.isClosed intro zs z hzI hzs - simp only [Set.mem_setOf_eq, I, C] at hzI + simp only [Set.mem_ofPred_eq, I, C] at hzI replace ⟨hzI, hzI2⟩ := And.intro (hzI · |>.left) (hzI · |>.right) have hz_mem : z ∈ segment ℝ y₁ y₂ := have cloL : IsClosed (segment ℝ y₁ y₂) := by @@ -503,7 +506,7 @@ private lemma sion_exists_min_2 (y₁ y₂ : N) (hy₁ : y₁ ∈ T) (hy₂ : y suffices hn : ∃ n, f x (zs n) < β by refine hn.imp fun n ↦ ?_ simp +contextual [C', le_of_lt, hx.left] - simp only [Set.mem_setOf_eq, C] at hx + simp only [Set.mem_ofPred_eq, C] at hx rcases hx with ⟨hx₁, hx₂⟩ specialize hfc₁ x hx₁ replace hx₂ := hx₂.trans_lt hβ₁ @@ -513,7 +516,7 @@ private lemma sion_exists_min_2 (y₁ y₂ : N) (hy₁ : y₁ ∈ T) (hy₂ : y have hJ : IsClosed J := by apply IsSeqClosed.isClosed intro zs z hzI hzs - simp only [Set.mem_setOf_eq, J, C] at hzI + simp only [Set.mem_ofPred_eq, J, C] at hzI replace ⟨hzI, hzI2⟩ := And.intro (hzI · |>.left) (hzI · |>.right) have hz_mem : z ∈ segment ℝ y₁ y₂ := have cloL : IsClosed (segment ℝ y₁ y₂) := by @@ -541,7 +544,7 @@ private lemma sion_exists_min_2 (y₁ y₂ : N) (hy₁ : y₁ ∈ T) (hy₂ : y suffices hn : ∃ n, f x (zs n) < β by refine hn.imp fun n ↦ ?_ simp +contextual [C', le_of_lt, hx.left] - simp only [Set.mem_setOf_eq, C] at hx + simp only [Set.mem_ofPred_eq, C] at hx rcases hx with ⟨hx₁, hx₂⟩ specialize hfc₁ x hx₁ replace hx₂ := hx₂.trans_lt hβ₁ @@ -694,7 +697,7 @@ theorem sion_minimax convert (hfc₂ i i.2).bddBelow hS₁ ext; simp have h_bdd_1 (j : S) : BddAbove (Set.range fun (x : T) => f j x) := - h_bddA.mono (T.range_restrict (f j) ▸ Set.image_subset_image2_right j.coe_prop) + h_bddA.mono (T.range_domRestrict (f j) ▸ Set.image_subset_image2_right j.coe_prop) have h_bdd_2 : BddAbove (Set.range fun y : T ↦ ⨅ x : S, f x y) := h_bddA.range_inf_of_image2 h_bddB have h_bdd_3 : BddBelow (Set.range fun x : S ↦ ⨆ y : T, f x y) := @@ -713,7 +716,7 @@ theorem sion_minimax Set.inter_univ, Set.not_nonempty_empty] have hau : a < ⨅ x : S, ⨆ yi : u.map ⟨_, Subtype.val_injective⟩, f ↑x ↑yi := by simp +contextual only [Set.iInter_coe_set, Set.ext_iff, Set.mem_inter_iff, Set.mem_iInter, - Set.mem_setOf_eq, Set.mem_empty_iff_false, iff_false, not_and, true_and, not_forall, + Set.mem_ofPred_eq, Set.mem_empty_iff_false, iff_false, not_and, true_and, not_forall, not_le] at hu rw [lt_ciInf_iff]; swap · --BddBelow (Set.range fun x => ⨆ yi : Finset.map ⋯, f ↑x ↑yi) @@ -736,7 +739,7 @@ theorem sion_minimax exact hfc₂ b · convert Set.inter_empty _ by_contra hu - simp only [Set.iInter_coe_set, Set.iInter_eq_empty_iff, Set.mem_iInter, Set.mem_setOf_eq, + simp only [Set.iInter_coe_set, Set.iInter_eq_empty_iff, Set.mem_iInter, Set.mem_ofPred_eq, Classical.not_imp, not_and, not_le, not_forall, not_exists, not_lt] at hu obtain ⟨x, hx⟩ := hu apply hb₂.not_ge diff --git a/QuantumInfo/Measurements/POVM.lean b/QuantumInfo/Measurements/POVM.lean index 781d0e9abf..19ef5695cc 100644 --- a/QuantumInfo/Measurements/POVM.lean +++ b/QuantumInfo/Measurements/POVM.lean @@ -107,6 +107,7 @@ theorem measurementMap_apply_matrix (Λ : POVM X d) (m : Matrix d d ℂ) : rw [LinearMap.sum_apply] rfl +set_option backward.isDefEq.respectTransparency false in open HermitianMat in theorem measurementMap_apply_hermitianMat (Λ : POVM X d) (m : HermitianMat d ℂ) : Λ.measurementMap.toHPMap m = ∑ x : X, diff --git a/QuantumInfo/ResourceTheory/FreeState.lean b/QuantumInfo/ResourceTheory/FreeState.lean index 1140fb1841..45c83fee00 100644 --- a/QuantumInfo/ResourceTheory/FreeState.lean +++ b/QuantumInfo/ResourceTheory/FreeState.lean @@ -440,6 +440,7 @@ noncomputable def RelativeEntResource : MState (H i) → ℝ≥0 := scoped notation "𝑅ᵣ" => RelativeEntResource +set_option backward.isDefEq.respectTransparency false in theorem exists_isFree_relativeEntResource (ρ : MState (H i)) : ∃ σ ∈ IsFree, 𝐃(ρ‖σ) = 𝑅ᵣ ρ := by obtain ⟨σ, hσ₁, hσ₂⟩ := IsCompact_IsFree.exists_isMinOn_lowerSemicontinuousOn diff --git a/QuantumInfo/ResourceTheory/HypothesisTesting.lean b/QuantumInfo/ResourceTheory/HypothesisTesting.lean index 9a9dbec0f0..1be06a322b 100644 --- a/QuantumInfo/ResourceTheory/HypothesisTesting.lean +++ b/QuantumInfo/ResourceTheory/HypothesisTesting.lean @@ -552,7 +552,7 @@ theorem rate_Continuous_singleton {ε : Prob} {d : Type*} [Fintype d] [Decidable Continuous fun σ ↦ β_ ε(ρ‖{σ}) := by have h := HermitianMat.innerₗ.flip.continuous_iInf_fst (S := { m | ρ.exp_val (1 - m) ≤ ↑ε ∧ 0 ≤ m ∧ m ≤ 1 }) - ((Metric.isBounded_Icc 0 1).subset (Set.setOf_subset_setOf_of_imp fun _ ↦ And.right)) + ((Metric.isBounded_Icc 0 1).subset (Set.ofPred_subset_ofPred_of_imp fun _ ↦ And.right)) simp only [of_singleton] conv => enter [1, σ]; rw [subtype_val_iInf'] exact Continuous.subtype_mk (h.comp MState.Continuous_HermitianMat) _ diff --git a/QuantumInfo/ResourceTheory/SteinsLemma.lean b/QuantumInfo/ResourceTheory/SteinsLemma.lean index 6db4c8b622..fea696edef 100644 --- a/QuantumInfo/ResourceTheory/SteinsLemma.lean +++ b/QuantumInfo/ResourceTheory/SteinsLemma.lean @@ -37,6 +37,7 @@ theorem Lemma6_σn_IsFree {σ₁ : MState (H i)} {σₘ : (m : ℕ) → MState ( · exact hσ₁_free.npow (n % m) · rw [← pow_mul, ← spacePow_add, Nat.div_add_mod n m] +set_option backward.isDefEq.respectTransparency false in /-- Lemma 6 from the paper. We _did_ end up doing the version that "works also in the case of ε = 0", which is nice. -/ @@ -245,7 +246,7 @@ theorem LemmaS2liminf {ε3 : Prob} {ε4 : ℝ≥0} (hε4 : 0 < ε4) · replace hf := le_trans hf hRinf replace hf := tsub_eq_zero_iff_le.mpr hf simp_all - apply Filter.IsCobounded.of_frequently_le (u := ⊤) + apply Filter.IsCobounded.of_frequently_le (l := ⊤) simp [Filter.frequently_atTop] intro n; use n apply Filter.isBoundedUnder_of diff --git a/QuantumInfo/States/Ensemble.lean b/QuantumInfo/States/Ensemble.lean index 621e1fe4aa..8a16b6c3e4 100644 --- a/QuantumInfo/States/Ensemble.lean +++ b/QuantumInfo/States/Ensemble.lean @@ -221,6 +221,7 @@ theorem mix_mEnsemble_pure_iff_pure {e : MEnsemble d α} : · intro i apply (e.states i).exp_val_le_one (MState.le_one _) +set_option backward.isDefEq.respectTransparency false in /-- The average of `f : MState d → T` on an ensemble that mixes to a pure state `ψ` is `f (pure ψ)` -/ theorem mix_mEnsemble_pure_average {e : MEnsemble d α} {T : Type _} {U : Type*} [AddCommGroup U] [Module ℝ U] [inst : Mixable U T] (f : MState d → T) (hmix : mix e = pure ψ) : average f e = f (pure ψ) := by @@ -247,7 +248,7 @@ theorem mix_mEnsemble_pure_average {e : MEnsemble d α} {T : Type _} {U : Type*} apply hpure i simp_all only [ne_eq, Finset.mem_univ, smul_eq_zero, Set.Icc.coe_eq_zero, not_or, and_imp, forall_const] - exact hne0 + exact not_false classical rw [← Finset.sum_smul, ← Finset.sum_filter, Finset.sum_filter_of_ne hpure', ProbDistribution.normalized, one_smul] /-- The trivial mixed-state ensemble of `ρ` consists of copies of `rho`, with the `i`-th one having @@ -261,6 +262,7 @@ theorem trivial_mEnsemble_mix (ρ : MState d) : ∀ i : α, mix (trivial_mEnsemb Prob.coe_one, Prob.coe_zero, ite_smul, one_smul, zero_smul, Finset.sum_ite_eq, Finset.mem_univ, ↓reduceIte] +set_option backward.isDefEq.respectTransparency false in /-- The average of `f : MState d → T` on a trivial ensemble of `ρ` is `f ρ`-/ theorem trivial_mEnsemble_average {T : Type _} {U : Type*} [AddCommGroup U] [Module ℝ U] [inst : Mixable U T] (f : MState d → T) (ρ : MState d): ∀ i : α, average f (trivial_mEnsemble ρ i) = f ρ := fun i ↦ by @@ -277,6 +279,7 @@ def trivial_pEnsemble (ψ : Ket d) (i : α) : PEnsemble d α := ⟨fun _ ↦ ψ, variable (ψ : Ket d) +set_option backward.isDefEq.respectTransparency false in /-- The trivial pure-state ensemble of `ψ` mixes to `ψ` -/ theorem trivial_pEnsemble_mix : ∀ i : α, mix (toMEnsemble (trivial_pEnsemble ψ i)) = MState.pure ψ := fun i ↦ by apply MState.ext_m @@ -284,6 +287,7 @@ theorem trivial_pEnsemble_mix : ∀ i : α, mix (toMEnsemble (trivial_pEnsemble apply_ite, Prob.coe_one, Prob.coe_zero, MEnsemble.states, Function.comp_apply, ite_smul, one_smul, zero_smul, Finset.sum_ite_eq, Finset.mem_univ, ↓reduceIte] +set_option backward.isDefEq.respectTransparency false in omit [DecidableEq d] in /-- The average of `f : Ket d → T` on a trivial ensemble of `ψ` is `f ψ`-/ theorem trivial_pEnsemble_average {T : Type _} {U : Type*} [AddCommGroup U] [Module ℝ U] [inst : Mixable U T] (f : Ket d → T) : diff --git a/QuantumInfo/States/Entanglement.lean b/QuantumInfo/States/Entanglement.lean index 7ada04aba7..b670441d5a 100644 --- a/QuantumInfo/States/Entanglement.lean +++ b/QuantumInfo/States/Entanglement.lean @@ -172,6 +172,7 @@ theorem mixed_convex_roof_le_convex_roof : mixed_convex_roof f ≤ convex_roof_o apply And.intro hmix exact le_of_eq <| NNReal.coe_inj.mp <| average_of_pure_ensemble (toReal ∘ f) e +set_option backward.isDefEq.respectTransparency false in /-- The convex roof extension of `g : KetUpToPhase d → ℝ≥0` applied to a pure state `ψ` is `g (KetUpToPhase.mk ψ)`. -/ theorem convex_roof_of_pure (ψ : Ket d) : convex_roof g (pure ψ) = g (KetUpToPhase.mk ψ) := by rw [le_antisymm_iff] @@ -198,6 +199,7 @@ theorem convex_roof_of_pure (ψ : Ket d) : convex_roof g (pure ψ) = g (KetUpToP simp [mix_pEnsemble_pure_average (NNReal.toReal ∘ g ∘ KetUpToPhase.mk) hphase_inv hmix] rfl +set_option backward.isDefEq.respectTransparency false in omit [Nonempty d] in /-- The mixed convex roof extension of `f : MState d → ℝ≥0` applied to a pure state `ψ` is `f (pure ψ)`. -/ theorem mixed_convex_roof_of_pure (ψ : Ket d) : mixed_convex_roof f (pure ψ) = f (pure ψ) := by @@ -294,6 +296,7 @@ theorem Sᵥₙ_ofClassical {d : Type*} [Fintype d] [DecidableEq d] (dist : Prob exact rfl; rw [ h_diag, HermitianMat.cfc_diagonal, HermitianMat.trace_diagonal ] ; aesop +set_option backward.isDefEq.respectTransparency false in /-- The entanglement of formation of the maximally entangled state with on-site dimension 𝕕 is log(𝕕). -/ theorem EoF_of_MES : EoF (pure <| Ket.MES d) = Real.log (Finset.card Finset.univ (α := d)) := by simp only [EoF, convex_roof_of_pure, Finset.card_univ] diff --git a/QuantumInfo/States/Mixed/MState.lean b/QuantumInfo/States/Mixed/MState.lean index 2d9b5e7a41..2b32fe4b85 100644 --- a/QuantumInfo/States/Mixed/MState.lean +++ b/QuantumInfo/States/Mixed/MState.lean @@ -264,6 +264,7 @@ end exp_val section pure +set_option backward.isDefEq.respectTransparency false in /-- A mixed state can be constructed as a pure state arising from a ket. -/ def pure (ψ : Ket d) : MState d where M := { @@ -277,6 +278,7 @@ def pure (ψ : Ket d) : MState d where simp [HermitianMat.trace_eq_re_trace, Matrix.trace, Matrix.vecMulVec_apply, Bra.eq_conj, h₁] exact ψ.normalized +set_option backward.isDefEq.respectTransparency false in theorem pure_inner : ⟪pure ψ, pure φ⟫_Prob = ‖Braket.dot ψ φ‖^2 := by simp [MState.inner_def, HermitianMat.inner_def, pure, Matrix.vecMulVec_mul_vecMulVec, Braket.dot_eq_dotProduct, Matrix.trace_smul] @@ -294,6 +296,7 @@ theorem pure_inner : ⟪pure ψ, pure φ⟫_Prob = ‖Braket.dot ψ φ‖^2 := b theorem pure_apply {i j : d} : (pure ψ).m i j = (ψ i) * conj (ψ j) := by rfl +set_option backward.isDefEq.respectTransparency false in theorem pure_mul_self : (pure ψ).m * (pure ψ).m = (pure ψ : Matrix d d ℂ) := by dsimp [pure, MState.m] simp [Matrix.vecMulVec_mul_vecMulVec, ← Braket.dot_eq_dotProduct] @@ -522,6 +525,7 @@ theorem pure_prod_pure (ψ₁ : Ket d₁) (ψ₂ : Ket d₂) : pure (ψ₁ ⊗ end prod +set_option backward.isDefEq.respectTransparency false in /-- A representation of a classical distribution as a quantum state, diagonal in the given basis. -/ def ofClassical (dist : ProbDistribution d) : MState d where M := diagonal ℂ (fun x ↦ dist x) @@ -784,6 +788,7 @@ theorem pureQ_injective {d : Type*} [Fintype d] [DecidableEq d] : Function.Injec simp [pureQ] at h exact Quotient.sound ((PhaseEquiv_iff_pure_eq _ _).mpr h) +set_option backward.isDefEq.respectTransparency false in theorem pure_separable_imp_IsProd {d₁ d₂ : Type*} [Fintype d₁] [Fintype d₂] [DecidableEq d₁] [DecidableEq d₂] (ψ : Ket (d₁ × d₂)) (h : IsSeparable (pure ψ)) : ψ.IsProd := by obtain ⟨ ρLRs, ps, hps ⟩ := h; @@ -1311,6 +1316,7 @@ section finprod variable {ι : Type u} [DecidableEq ι] [fι : Fintype ι] variable {dI : ι → Type v} [∀(i :ι), Fintype (dI i)] [∀(i :ι), DecidableEq (dI i)] +set_option backward.isDefEq.respectTransparency false in def piProd (ρi : (i:ι) → MState (dI i)) : MState ((i:ι) → dI i) where M := { val := Matrix.piProd (fun i ↦ (ρi i).m) diff --git a/QuantumInfo/States/Pure/BargmannInvariant.lean b/QuantumInfo/States/Pure/BargmannInvariant.lean index ed04a8852a..3e8d73375e 100644 --- a/QuantumInfo/States/Pure/BargmannInvariant.lean +++ b/QuantumInfo/States/Pure/BargmannInvariant.lean @@ -29,10 +29,11 @@ geodesic triangle in projective Hilbert space. * `norm_bargmannInvariantThree_le_one`: `‖Δ₃‖ ≤ 1` (via `Braket.norm_dot_le_one`) ## References - * [V. Bargmann, *Note on Wigner's theorem on symmetry operations*, - J. Math. Phys. 5, 862–868 (1964)][bargmann1964] - * [S. Pancharatnam, *Generalized theory of interference, and its - applications*, Proc. Indian Acad. Sci. A 44, 247–262 (1956)][pancharatnam1956] + +* V. Bargmann, Note on Wigner's theorem on symmetry operations, J. Math. Phys. 5, 862–868 (1964). + [ref: bargmann1964] +* S. Pancharatnam, Generalized theory of interference, and its applications, Proc. Indian Acad. + Sci. A 44, 247–262 (1956). [ref: pancharatnam1956] -/ open Braket Complex diff --git a/QuantumInfo/States/Pure/BlochSphere.lean b/QuantumInfo/States/Pure/BlochSphere.lean index f07ef13312..c4ca228ea2 100644 --- a/QuantumInfo/States/Pure/BlochSphere.lean +++ b/QuantumInfo/States/Pure/BlochSphere.lean @@ -28,10 +28,11 @@ then builds the solid angle and dot product API on sphere points. * `dot_blochPoint`: dot product of Bloch vectors in terms of angle differences ## References - * [S. Pancharatnam, *Generalized theory of interference, and its - applications*, Proc. Indian Acad. Sci. A 44, 247–262 (1956)][pancharatnam1956] - * [M. V. Berry, *Quantal phase factors accompanying adiabatic changes*, - Proc. R. Soc. London A 392, 45–57 (1984)][berry1984] + +* S. Pancharatnam, Generalized theory of interference, and its applications, Proc. Indian Acad. + Sci. A 44, 247–262 (1956). [ref: pancharatnam1956] +* M. V. Berry, Quantal phase factors accompanying adiabatic changes, Proc. R. Soc. London A 392, + 45–57 (1984). [ref: berry1984] -/ open Complex Matrix diff --git a/README.md b/README.md index e30ae564c8..b096cfcfbc 100644 --- a/README.md +++ b/README.md @@ -18,18 +18,67 @@ [![](https://img.shields.io/badge/View_The-Stats-blue)](https://physlib.io/Stats) -[![](https://img.shields.io/badge/Lean-v4.32.0-blue)](https://github.com/leanprover/lean4/releases/tag/v4.32.0) +[![](https://img.shields.io/badge/Lean-v4.33.0-blue)](https://github.com/leanprover/lean4/releases/tag/v4.33.0) [![Gitpod Ready-to-Code](https://img.shields.io/badge/Gitpod-ready--to--code-blue?logo=gitpod)](https://gitpod.io/#https://github.com/leanprover-community/physlib) [![Ask DeepWiki](https://deepwiki.com/badge.svg)](https://deepwiki.com/leanprover-community/physlib) [![api_docs](https://img.shields.io/badge/doc-API_docs-blue)](https://physlib.io/docs/) + + + + + + + + + + + + + + + + +
+ +UPSTREAM · [**Mathlib**](https://github.com/leanprover-community/mathlib4) ↑ + +
+ +THIS REPOSITORY + +
+ +### [**Physlib**](./Physlib) + +The core library — physics digitalizations reviewed and curated to a high standard, built for long-term reuse, readability, trust, and maintenance. + + + +### [**PhyslibAlpha**](./PhyslibAlpha) +### [**PhyslibAlpha**](./PhyslibAlpha) + +PhyslibAlpha exists for the rapid development of physics digitalizations, enabled by a lighter review process built to handle large-scale, human- or AI-generated contributions. + + + +### [**QuantumInfo**](./QuantumInfo) + +Quantum information theory. Currently a distinct codebase with its own conventions and review norms; work is underway to bring it closer to Physlib. + +
+ +ADJACENT · [**CSLib**](https://github.com/leanprover/cslib) → + +
## Requirements of the project 🎯 The project shall contain results (definitions, theorems, lemmas and calculations) from **physics**, including quantum information, formalized (or **digitalized**) into the interactive theorem prover **Lean 4**. +including quantum information, formalized (or **digitalized**) into the interactive theorem prover **Lean 4**. 🎯 The project shall be **organized** by **physics**. @@ -40,6 +89,7 @@ 🎯 The project shall contain Physics Lean **tactics**, **notation** and **syntax** for physicists. 🎯 The project shall *not* be tied to physics axiomizations (e.g. axiomatic QFT), but rather flexiable enough to accommodate different approaches and starting points. +🎯 The project shall _not_ be tied to physics axiomizations (e.g. axiomatic QFT), but rather flexiable enough to accommodate different approaches and starting points. 🎯 The content of the project shall be carefully **reviewed** and curated, to ensure reusability, readability and fit. @@ -61,7 +111,8 @@ Because of the lower-review bar for PhyslibAlpha we cannot promise to maintain c Physlib is open-source and community run, and we welcome contributions from anyone. All you need to do is open a pull-request with your changes and our team of maintainers will review it and iterate with you on feedback until it -can be merged. +can be merged. Please add references to the `## References` section at the top of the file +and add them to the .bib file. If you unsure where you would like to contribute, you may find ideas on: - our [open issues](https://github.com/leanprover-community/physlib/issues). @@ -85,10 +136,13 @@ or - Clone this repository (or download the repository as a Zip file) - Open a terminal at the top-level in the corresponding directory. -- Run `lake exe cache get`. The command `lake` should have been installed when you installed Lean. +- Run `lake exe get_cache` to download the cached artifacts from the internet. This will speed up the next step drastically. Do not worry if it fails, you can still run `lake build`, it will just be much slower. - Run `lake build`. - Open the directory (not a single file) in Visual Studio Code (or another Lean compatible code editor). +Once set up, `lake build` only recompiles files you have actually changed, plus +anything importing them. + At the moment Physlib is divided into two essentially disjoint halves, `Physlib` and `QuantumInfo`. These were two repositories that merged in an effort to create a more cohesive ecosystem for physics in Lean. There is ongoing effort to integrate them more deeply and share code, but at the moment diff --git a/docs/ReviewGuidelines.md b/docs/ReviewGuidelines.md index e1941f0ce9..469f25773c 100644 --- a/docs/ReviewGuidelines.md +++ b/docs/ReviewGuidelines.md @@ -84,3 +84,20 @@ understand where in the process PRs are. post [here](https://leanprover.zulipchat.com/#narrow/channel/479953-Physlib/topic/PR.20reviews/with/577663418). - Once a PR is marked with a `ready-to-merge` the author does not need to do anything else, the maintainers will make sure it gets merged into the project. + +## Claiming a PR for review + +To keep track of PRs, reviewers can "claim" PRs and promise to review them within a certain timeframe. Failing to submit a review in that time will trigger a workflow which removes them and a Zulip bot notifies the community. + +1. **Claim it.** Comment `claim` on the PR. The bot requests a review from you, assigns + you, applies the `review-claimed` label and leaves a status comment recording the + deadline. For a custom window, comment `claim 5 days` (hours, days and weeks all work) + or `claim 2026-08-01`; `claim` uses the default of 2 days. +2. **You are reminded.** The bot @-mentions you 48 hours and then 24 hours before the + deadline. +3. **It expires.** Claims carry a time to live (2 days by default, 14 days max) and are + released automatically if they go stale, so nothing stays blocked forever. Comment + `claim` again to extend, or `disclaim` to release early. Submitting a review completes + the claim and clears the label. +4. **A missed claim is announced.** If the deadline passes with no review, you are removed + as reviewer and assignee, and a message goes to the `PR reviews` topic on Zulip. diff --git a/docs/cache-setup.md b/docs/cache-setup.md new file mode 100644 index 0000000000..7c3e2cfb4a --- /dev/null +++ b/docs/cache-setup.md @@ -0,0 +1,58 @@ +# Setting up the Physlib build cache bucket + +Physlib publishes its compiled artifacts so contributors do not have to build +the library from source. This uses Lean's `lake cache`, which is used within get_cache.lean +to fetch the artifacts from a Cloudfare R2 bucket. R2 is the best choice for a small amount of +storage, with lots of people downloading it. + +## 1. Create the bucket + +Call it `physlib-cache`. Add its S3 API endpoint into `lake-cache.toml` as the write path. + +## 2. Allow anonymous reads — done + +Contributors fetch without credentials, so the bucket needs a public URL. You can use the public +development URL for testing, but it is better to deploy with a custom domain. We set up +`lake-cache.physlib.io` for this purpose. + +Note the resulting hostname; it goes into `lake-cache.toml` at step 5. + +Only reads become public. Writes stay behind the key from step 3. + +## 3. Create an API token for CI + +Create a token with write access, limited to +`physlib-cache`. Keep the Access Key ID and Secret Access Key. + +Lake expects them as a single SigV4 credential, colon-separated: + +``` +: +``` + +## 4. Add the GitHub secret + +Add the keys as a GitHub secret called `LAKE_CACHE_KEY`, set to the colon-joined pair above. + +## 5. Fill in the read endpoint — done + +Both endpoints in `lake-cache.toml` are set. To move to a custom domain, edit +the `physlib-r2` service — hostname only, no scheme, no trailing slash. `physlib-r2` is the name +of the anonymous read service in cloudflare. + +## 6. Verify + +Test these commands work within the Physlib repo: + +```bash +lake exe get_cache +lake build +``` + +## Notes + +- Costs to watch as the project grows: storage past 10GB, and Class A + (write) operations. Egress, the usual scaling problem, is free on R2. +- Each half publishes under its own scope, `physlib-master//physlib` + and `.../alpha`, so the two CI jobs do not overwrite each other's mappings. + The workflow and `scripts/get_cache.lean` must build the same strings. diff --git a/docs/references.bib b/docs/references.bib index f5063b818a..dee4808c24 100644 --- a/docs/references.bib +++ b/docs/references.bib @@ -1,124 +1,803 @@ - # To normalize: # bibtool --preserve.key.case=on --preserve.keys=on --pass.comments=on --print.use.tab=off -s -i docs/references.bib -o docs/references.bib # When possible, please use the reference obtained from InspireHep. -# To link to an entry in `references.bib`, use the following formats: -# [Author, *Title* (optional location)][bibkey] -@Article{ Allanach:2021yjy, - author = "Allanach, B. C. and Madigan, Maeve and Tooby-Smith, - Joseph", - title = "{A nu supersymmetric anomaly-free atlas}", - eprint = "2107.07926", - archiveprefix = "arXiv", - primaryclass = "hep-ph", - doi = "10.1007/JHEP02(2022)144", - journal = "JHEP", - volume = "02", - pages = "144", - year = "2022" -} - -@Article{ Dreiner:2008tw, - author = "Dreiner, Herbi K. and Haber, Howard E. and Martin, Stephen - P.", - title = "{Two-component spinor techniques and Feynman rules for - quantum field theory and supersymmetry}", - eprint = "0812.1594", - archiveprefix = "arXiv", - primaryclass = "hep-ph", - reportnumber = "BN-TH-2008-12, SCIPP-08-08, FERMILAB-PUB-09-855-T, - BN-TH-2008-12 and SCIPP-08/08", - doi = "10.1016/j.physrep.2010.05.002", - journal = "Phys. Rept.", - volume = "494", - pages = "1--196", - year = "2010" -} - -@Book{ hall2013quantum, - author = "Hall, Brian C.", - title = "{Quantum Theory for Mathematicians}", - publisher = "Springer", - year = "2013" -} - -@Article{ robertson1929uncertainty, - author = "Robertson, H. P.", - title = "{The Uncertainty Principle}", - doi = "10.1103/PhysRev.34.163", - journal = "Phys. Rev.", - volume = "34", - pages = "163--164", - year = "1929" -} - -@Article{ schrodinger1930heisenberg, - author = "Schr{\"o}dinger, Erwin", - title = "{Zum Heisenbergschen Unscharfeprinzip}", - journal = "Sitzungsberichte der Preussischen Akademie der Wissenschaften, - Physikalisch-mathematische Klasse", - pages = "296--303", - year = "1930" -} - -@Article{ Lohitsiri:2019fuu, - author = "Lohitsiri, Nakarin and Tong, David", - title = "{Hypercharge Quantisation and Fermat's Last Theorem}", - eprint = "1907.00514", - archiveprefix = "arXiv", - primaryclass = "hep-th", - doi = "10.21468/SciPostPhys.8.1.009", - journal = "SciPost Phys.", - volume = "8", - number = "1", - pages = "009", - year = "2020" -} - -@Article{ ParticleDataGroup:2018ovx, - author = "Tanabashi, M. and others", - collaboration = "Particle Data Group", - title = "{Review of Particle Physics}", - doi = "10.1103/PhysRevD.98.030001", - journal = "Phys. Rev. D", - volume = "98", - number = "3", - pages = "030001", - year = "2018" -} - -@Article{ raynor2021graphical, - title = {Graphical combinatorics and a distributive law for modular - operads}, - author = {Raynor, Sophie}, - journal = {Advances in Mathematics}, - volume = {392}, - pages = {108011}, - year = {2021}, - publisher = {Elsevier} -} - -@Book{ Reed1972, +# To cite an entry in `references.bib` from a module's docstring, append +# "[ref: ]" to the end of the bullet describing it, e.g.: +# * Landau & Lifshitz, Mechanics, 3rd ed., section 25. [ref: landau_mechanics] + +# Do not add Zulip links to the .bib file, keep them as plain URLs within the Lean files + + +@article{Allanach:2021yjy, + author = {Allanach, B. C. and Madigan, Maeve and Tooby-Smith, Joseph}, + title = {A nu supersymmetric anomaly-free atlas}, + volume = {02}, + eprint = {2107.07926}, + archiveprefix = {arXiv}, + primaryclass = {hep-ph}, + doi = {10.1007/JHEP02(2022)144}, + journal = {JHEP}, + pages = {144}, + year = {2022} +} + +@article{Dreiner:2008tw, + author = {Dreiner, Herbi K. and Haber, Howard E. and Martin, Stephen P.}, + title = {Two-component spinor techniques and Feynman rules for quantum field theory and supersymmetry}, + volume = {494}, + eprint = {0812.1594}, + archiveprefix = {arXiv}, + primaryclass = {hep-ph}, + doi = {10.1016/j.physrep.2010.05.002}, + journal = {Phys. Rept.}, + pages = {1-196}, + year = {2010}, + note = {not currently cited by any module; kept for future use} +} + +@article{Lohitsiri:2019fuu, + author = {Lohitsiri, Nakarin and Tong, David}, + title = {Hypercharge Quantisation and Fermat's Last Theorem}, + volume = {8}, + number = {1}, + eprint = {1907.00514}, + archiveprefix = {arXiv}, + primaryclass = {hep-th}, + doi = {10.21468/SciPostPhys.8.1.009}, + journal = {SciPost Phys.}, + pages = {009}, + year = {2020} +} + +@article{ParticleDataGroup:2018ovx, + author = {Tanabashi, M. and others}, + collaboration = {Particle Data Group}, + title = {Review of Particle Physics}, + volume = {98}, + number = {3}, + doi = {10.1103/PhysRevD.98.030001}, + journal = {Phys. Rev. D}, + pages = {030001}, + year = {2018} +} + +@book{Reed1972, author = {Reed, Michael and Simon, Barry}, title = {Functional Analysis}, series = {Methods of Modern Mathematical Physics}, volume = {1}, - year = {1972}, + doi = {10.1016/B978-0-12-585001-8.X5001-6}, publisher = {Academic Press}, - isbn = {978-0-12-585001-8}, - doi = {10.1016/B978-0-12-585001-8.X5001-6} + year = {1972}, + isbn = {978-0-12-585001-8} } -@Book{ Schmudgen2012, - author = {Konrad Schm{\"u}dgen}, +@book{Schmudgen2012, + author = {Schmudgen, Konrad}, title = {Unbounded Self-Adjoint Operators on Hilbert Space}, series = {Graduate Texts in Mathematics}, volume = {265}, - year = {2012}, + doi = {10.1007/978-94-007-4753-1}, publisher = {Springer}, address = {Dordrecht}, - isbn = {978-94-007-4753-1}, - doi = {10.1007/978-94-007-4753-1} + year = {2012}, + isbn = {978-94-007-4753-1} +} + +@book{abramowitz_stegun_1964, + author = {Abramowitz, Milton and Stegun, Irene A.}, + title = {Handbook of Mathematical Functions}, + publisher = {National Bureau of Standards}, + year = {1964} +} + +@article{alvarez_gaume_ginsparg_1985, + author = {Alvarez-Gaume, L. and Ginsparg, P. H.}, + title = {The structure of gauge and gravitational anomalies}, + doi = {10.1016/0003-4916(85)90087-9}, + journal = {Annals of Physics}, + volume = {161}, + number = {2}, + pages = {423-490}, + year = {1985} +} + +@book{arnold_mechanics, + author = {Arnold, V. I.}, + title = {Mathematical Methods of Classical Mechanics}, + series = {Graduate Texts in Mathematics}, + volume = {60}, + edition = {2nd}, + publisher = {Springer}, + year = {1989} +} + +@book{arnold_ode, + author = {Arnold, V. I.}, + title = {Ordinary Differential Equations}, + publisher = {MIT Press}, + year = {1973}, + note = {translated from the Russian by Richard A. Silverman; this + translation's Chapter 4, "Proofs of the Main Theorems," matches + the citing module's chapter title and content (Picard iteration) + -- confirmed against the table of contents, which distinguishes + it from the differently-organized Springer 1992 translation} +} + +@article{arxiv_0912_0853, + author = {Dudas, Emilian and Palti, Eran}, + title = {Froggatt-Nielsen models from E8 in F-theory GUTs}, + eprint = {0912.0853}, + archiveprefix = {arXiv}, + primaryclass = {hep-th}, + doi = {10.1007/JHEP01(2010)127}, + journal = {JHEP}, + volume = {01}, + pages = {127}, + year = {2010} +} + +@article{arxiv_1401_5084, + author = {Krippendorf, Sven and Mayorga Pena, Damian Kaloni and Oehlmann, + Paul-Konstantin and Ruehle, Fabian}, + title = {Rational F-Theory GUTs without exotics}, + eprint = {1401.5084}, + archiveprefix = {arXiv}, + primaryclass = {hep-th}, + doi = {10.1007/JHEP07(2014)013}, + journal = {JHEP}, + volume = {07}, + pages = {013}, + year = {2014} +} + +@article{arxiv_1507_05961, + author = {Krippendorf, Sven and Schafer-Nameki, Sakura and Wong, Jin-Mann}, + title = {Froggatt-Nielsen meets Mordell-Weil: A Phenomenological Survey of Global + F-theory GUTs with U(1)s}, + eprint = {1507.05961}, + archiveprefix = {arXiv}, + primaryclass = {hep-th}, + year = {2015} +} + +@article{arxiv_1605_03237, + author = {Draper, Patrick and Haber, Howard E. and Ruderman, Joshua T.}, + title = {Partially Natural Two Higgs Doublet Models}, + eprint = {1605.03237}, + archiveprefix = {arXiv}, + primaryclass = {hep-ph}, + doi = {10.1007/JHEP06(2016)124}, + journal = {JHEP}, + volume = {06}, + pages = {124}, + year = {2016} +} + +@article{arxiv_1912_04804, + author = {Allanach, B. C. and Gripaios, Ben and Tooby-Smith, Joseph}, + title = {Geometric General Solution to the U(1) Anomaly Equations}, + eprint = {1912.04804}, + archiveprefix = {arXiv}, + primaryclass = {hep-th}, + doi = {10.1007/JHEP05(2020)065}, + journal = {JHEP}, + volume = {05}, + pages = {065}, + year = {2020} +} + +@article{arxiv_2006_03588, + author = {Allanach, B. C. and Gripaios, Ben and Tooby-Smith, Joseph}, + title = {Anomaly cancellation with an extra gauge boson}, + eprint = {2006.03588}, + archiveprefix = {arXiv}, + primaryclass = {hep-th}, + doi = {10.1103/PhysRevLett.125.161601}, + journal = {Phys. Rev. Lett.}, + volume = {125}, + pages = {161601}, + year = {2020} +} + +@article{arxiv_2201_07245, + author = {Davighi, Joe and Tooby-Smith, Joseph}, + title = {Electroweak flavour unification}, + eprint = {2201.07245}, + archiveprefix = {arXiv}, + primaryclass = {hep-ph}, + doi = {10.1007/JHEP09(2022)193}, + journal = {JHEP}, + volume = {09}, + pages = {193}, + year = {2022} +} + +@article{arxiv_2411_14941, + author = {Erman, F. and Turgut, O. T.}, + title = {Completeness of Energy Eigenfunctions for the Reflectionless Potential in + Quantum Mechanics}, + eprint = {2411.14941}, + archiveprefix = {arXiv}, + primaryclass = {quant-ph}, + doi = {10.1119/5.0228452}, + journal = {American Journal of Physics}, + volume = {92}, + pages = {950-956}, + year = {2024} +} + +@article{arxiv_hep_ph_0605184, + author = {Maniatis, M. and von Manteuffel, A. and Nachtmann, O. and Nagel, F.}, + title = {Stability and Symmetry Breaking in the General Two-Higgs-Doublet Model}, + eprint = {hep-ph/0605184}, + archiveprefix = {arXiv}, + primaryclass = {hep-ph}, + doi = {10.1140/epjc/s10052-006-0016-6}, + journal = {Eur. Phys. J. C}, + volume = {48}, + pages = {805-823}, + year = {2006}, + note = {one citing module notes that a step of this paper's argument is not valid} +} + +@article{baez_guts_notes, + author = {Baez, John C. and Huerta, John}, + title = {The Algebra of Grand Unified Theories}, + eprint = {0904.1556}, + archiveprefix = {arXiv}, + primaryclass = {hep-th}, + journal = {Bull. Amer. Math. Soc.}, + volume = {47}, + pages = {483-552}, + year = {2010}, + url = {https://math.ucr.edu/home/baez/guts.pdf} +} + +@book{barenblatt_1996_scaling, + author = {Barenblatt, G. I.}, + title = {Scaling, Self-similarity, and Intermediate Asymptotics}, + publisher = {Cambridge University Press}, + year = {1996} +} + +@article{bargmann1964, + author = {Bargmann, V.}, + title = {Note on Wigner's theorem on symmetry operations}, + doi = {10.1063/1.1704188}, + volume = {5}, + journal = {J. Math. Phys.}, + pages = {862-868}, + year = {1964} +} + +@article{berry1984, + author = {Berry, M. V.}, + title = {Quantal phase factors accompanying adiabatic changes}, + doi = {10.1098/rspa.1984.0023}, + volume = {392}, + number = {1802}, + journal = {Proc. R. Soc. London A}, + pages = {45-57}, + year = {1984} +} + +@article{bilal_2008_anomalies, + author = {Bilal, A.}, + title = {Lectures on Anomalies}, + eprint = {0802.0634}, + archiveprefix = {arXiv}, + primaryclass = {hep-th}, + year = {2008} +} + +@misc{bipm_si_brochure_2019, + title = {International Bureau of Weights and Measures (BIPM), The International System of Units (SI Brochure)}, + edition = {9th}, + year = {2019}, + howpublished = {}, + url = {https://www.bipm.org/documents/d/guest/si-brochure-9-en-pdf} +} + +@article{caldirola_1941, + author = {Caldirola, P.}, + title = {Forze non conservative nella meccanica quantistica}, + volume = {18}, + journal = {Nuovo Cimento}, + pages = {393-400}, + year = {1941}, + note = {title translates to "Non-conservative forces in quantum mechanics"} +} + +@misc{cobos_2015_lorentz_group, + author = {Cobos, Guillem}, + title = {The Lorentz Group}, + year = {2015}, + howpublished = {}, + url = {https://diposit.ub.edu/dspace/bitstream/2445/68763/2/memoria.pdf} +} + +@article{cortes_haupt_2016, + author = {Cortes, Vicente and Haupt, Alexander S.}, + title = {Lecture Notes on Mathematical Methods of Classical Physics}, + eprint = {1612.03100}, + archiveprefix = {arXiv}, + year = {2016} +} + +@article{doi_1063_1_3290740, + author = {Hall, Richard L. and Saad, Nasser and Sen, K. D.}, + title = {Soft-core Coulomb potentials and Heun's differential equation}, + doi = {10.1063/1.3290740}, + journal = {J. Math. Phys.}, + volume = {51}, + pages = {022107}, + year = {2010} +} + +@article{doi_physreva_80_032507, + author = {Hall, Richard L. and Saad, Nasser and Sen, K. D. and Ciftci, Hakan}, + title = {Energies and wave functions for a soft-core Coulomb potential}, + doi = {10.1103/PhysRevA.80.032507}, + journal = {Phys. Rev. A}, + volume = {80}, + pages = {032507}, + year = {2009} +} + +@misc{github_leandojo_extractdata, + howpublished = {}, + url = {https://github.com/lean-dojo/LeanDojo/blob/main/src/lean_dojo/data_extraction/ExtractData.lean} +} + +@misc{github_tryateachstep, + howpublished = {}, + url = {https://github.com/dwrensha/tryAtEachStep/blob/main/tryAtEachStep.lean} +} + +@book{goldstein_classicalmechanics, + author = {Goldstein, Herbert and Poole, Charles P. and Safko, John L.}, + title = {Classical Mechanics}, + edition = {3rd}, + publisher = {Addison-Wesley}, + year = {2002} +} + +@book{hall2013quantum, + author = {Hall, Brian C.}, + title = {Quantum Theory for Mathematicians}, + publisher = {Springer}, + year = {2013} +} + +@book{huygens_1673, + author = {Huygens, Christiaan}, + title = {Horologium Oscillatorium}, + year = {1673} +} + +@misc{iau_2012_resolution_b2, + title = {IAU 2012 Resolution B2 (the astronomical unit)}, + howpublished = {}, + url = {https://iauarchive.eso.org/static/resolutions/IAU2012_English.pdf} +} + +@misc{iau_2015_resolution_b2, + title = {IAU 2015 Resolution B2 (the exact parsec convention)}, + howpublished = {}, + url = {https://iauarchive.eso.org/static/resolutions/IAU2015_English.pdf} +} + +@misc{iau_style_manual_units, + author = {Wilkins, G. A.}, + title = {Recommendations concerning Units (SI Units)}, + howpublished = {}, + url = {https://iauarchive.eso.org/publications/proceedings_rules/units/}, + note = {reprinted from the IAU Style Manual (1989); the Julian year + convention used in the light-year is cited in the citing module} +} + +@book{ioffe_1957, + author = {Ioffe, A. F.}, + title = {Semiconductor Thermoelements and Thermoelectric Cooling}, + publisher = {Infosearch}, + year = {1957} +} + +@misc{iso_80000_1_2009, + title = {ISO/IEC 80000-1:2009, Quantities and units - Part 1: General} +} + +@misc{jaffe_lorentz_notes, + author = {Jaffe, Arthur}, + title = {Lorentz Transformations, Rotations, and Boosts}, + howpublished = {}, + url = {https://cdn.ku.edu.tr/cdn/files/amostafazadeh/phys517_518/phys517_2016f/Handouts/A_Jaffi_Lorentz_Group.pdf}, + note = {course handout by Arthur Jaffe (Harvard); mirrored as course + material at Koc University, which is the copy cited} +} + +@misc{jcgm_200_2012, + title = {JCGM 200:2012, International vocabulary of metrology - Basic and general concepts and associated terms (VIM, 3rd edition)} +} + +@article{kanai_1948, + author = {Kanai, E.}, + title = {On the Quantization of the Dissipative Systems}, + doi = {10.1143/ptp/3.4.440}, + volume = {3}, + number = {4}, + journal = {Progress of Theoretical Physics}, + pages = {440-442}, + year = {1948} +} + +@article{koor_et_al_2023_wirtinger, + author = {Koor, B. and Qiu, Y. and Kwek, L. and Rebentrost, P.}, + title = {A short tutorial on Wirtinger Calculus with applications in quantum information}, + eprint = {2312.04858}, + archiveprefix = {arXiv} +} + +@article{kreutz_delgado_cr_calculus, + author = {Kreutz-Delgado, K.}, + title = {The Complex Gradient Operator and the CR-Calculus}, + eprint = {0906.4835}, + archiveprefix = {arXiv} +} + +@book{landau_fluidmechanics, + author = {Landau, L. D. and Lifshitz, E. M.}, + title = {Fluid Mechanics}, + series = {Course of Theoretical Physics}, + volume = {6}, + edition = {2nd}, + publisher = {Pergamon Press}, + year = {1987} +} + +@book{landau_mechanics, + author = {Landau, L. D. and Lifshitz, E. M.}, + title = {Mechanics}, + series = {Course of Theoretical Physics}, + volume = {1}, + edition = {3rd}, + publisher = {Butterworth-Heinemann}, + year = {1976} +} + +@book{landau_statphys1, + author = {Landau, L. D. and Lifshitz, E. M.}, + title = {Statistical Physics, Part 1}, + series = {Course of Theoretical Physics}, + volume = {5}, + edition = {3rd}, + publisher = {Butterworth-Heinemann}, + year = {1980} +} + +@article{lawrie_schafer_nameki_wong_2015, + author = {Lawrie, Craig and Schafer-Nameki, Sakura and Wong, Jin-Mann}, + title = {F-theory and All Things Rational: Surveying U(1) Symmetries with Rational Sections}, + eprint = {1504.05593}, + archiveprefix = {arXiv}, + primaryclass = {hep-th}, + doi = {10.1007/JHEP09(2015)144}, + journal = {JHEP}, + volume = {09}, + pages = {144}, + year = {2015}, + note = {page 6 is cited in the citing module} +} + +@article{mdpi_khinchin_fourth_axiom, + author = {Zhang, Zhiyi and Huang, Hongwei and Xu, Hao}, + title = {Khinchin's Fourth Axiom of Entropy Revisited}, + doi = {10.3390/stats6030049}, + journal = {Stats}, + volume = {6}, + number = {3}, + pages = {763-772}, + year = {2023} +} + +@article{mortini_rupp_2022, + author = {Mortini, R. and Rupp, R.}, + title = {The Clairaut-Schwarz Theorem for Mixed Wirtinger Derivatives}, + doi = {10.1007/s41980-021-00660-1}, + volume = {48}, + number = {5}, + journal = {Bull. Iranian Math. Soc.}, + pages = {2643-2647}, + year = {2022} +} + +@techreport{nasa_ntrs_20140002333, + author = {Simpson, James C. and Lane, John E. and Immer, Christopher D. and + Youngquist, Robert C.}, + title = {Simple Analytic Expressions for the Magnetic Field of a Circular + Current Loop}, + institution = {NASA Kennedy Space Center}, + number = {NASA/TM-2013-217919}, + year = {2001}, + howpublished = {}, + url = {https://ntrs.nasa.gov/api/citations/20140002333/downloads/20140002333.pdf} +} + +@book{nash_1991_dtqft, + author = {Nash, C.}, + title = {Differential topology and quantum field theory}, + publisher = {Elsevier}, + year = {1991} +} + +@book{nielsen_chuang_qci, + author = {Nielsen, M. A. and Chuang, I. L.}, + title = {Quantum Computation and Quantum Information}, + edition = {10th Anniversary}, + publisher = {Cambridge University Press}, + year = {2010} +} + +@misc{nist_dlmf, + title = {NIST Digital Library of Mathematical Functions}, + howpublished = {}, + url = {https://dlmf.nist.gov/}, + note = {section 19.7(ii) is cited in the citing module} +} + +@misc{nist_hb44_2023, + title = {NIST Handbook 44, Appendix C (international foot-based units and the international nautical mile)}, + doi = {10.6028/NIST.HB.44-2023} +} + +@article{nominal_solar_mass_article, + author = {Prsa, Andrej and others}, + title = {Nominal values for selected solar and planetary quantities: IAU 2015 + Resolution B3}, + doi = {10.3847/0004-6256/152/2/41}, + journal = {Astron. J.}, + volume = {152}, + number = {2}, + pages = {41}, + year = {2016} +} + +@book{oneill_1983_semi_riemannian, + author = {O'Neill, Barrett}, + title = {Semi-Riemannian Geometry With Applications to Relativity}, + publisher = {Academic Press}, + year = {1983} +} + +@article{pancharatnam1956, + author = {Pancharatnam, S.}, + title = {Generalized theory of interference, and its applications}, + doi = {10.1007/bf03046050}, + volume = {44}, + number = {5}, + journal = {Proc. Indian Acad. Sci. A}, + pages = {247-262}, + year = {1956} +} + +@book{peskin_schroeder_qft, + author = {Peskin, Michael E. and Schroeder, Daniel V.}, + title = {An Introduction to Quantum Field Theory}, + publisher = {Westview Press}, + year = {1995} +} + +@misc{qmul_emt10_notes, + title = {MSci 4261 Electromagnetism: Lecture Notes X.10.1, The Energy-Momentum Tensor}, + howpublished = {}, + url = {https://ph.qmul.ac.uk/sites/default/files/EMT10new.pdf}, + note = {Queen Mary University of London course notes} +} + +@article{raynor2021graphical, + author = {Raynor, Sophie}, + title = {Graphical combinatorics and a distributive law for modular operads}, + volume = {392}, + journal = {Advances in Mathematics}, + pages = {108011}, + publisher = {Elsevier}, + year = {2021}, + note = {not currently cited by any module; kept for future use} +} + +@article{robertson1929uncertainty, + author = {Robertson, H. P.}, + title = {The Uncertainty Principle}, + volume = {34}, + doi = {10.1103/PhysRev.34.163}, + journal = {Phys. Rev.}, + pages = {163-164}, + year = {1929} +} + +@article{schrodinger1930heisenberg, + author = {Schrodinger, Erwin}, + title = {Zum Heisenbergschen Unscharfeprinzip}, + journal = {Sitzungsberichte der Preussischen Akademie der Wissenschaften, Physikalisch-mathematische Klasse}, + pages = {296-303}, + year = {1930} +} + +@article{snyder_toberer_2008, + author = {Snyder, G. J. and Toberer, E. S.}, + title = {Complex thermoelectric materials}, + volume = {7}, + journal = {Nature Materials}, + pages = {105-114}, + year = {2008} +} + +@misc{stackexchange_qc_12953, + title = {Quantum Computing Stack Exchange answer 12953}, + howpublished = {}, + url = {https://quantumcomputing.stackexchange.com/a/12953/10115} +} + +@article{stone_1930, + author = {Stone, M. H.}, + title = {Linear Transformations in Hilbert Space III. Operational Methods and Group Theory}, + doi = {10.1073/pnas.16.2.172}, + volume = {16}, + journal = {Proc. Natl. Acad. Sci.}, + pages = {172-175}, + year = {1930}, + note = {the citing module originally gave "18 (1932)"; corrected against + the DOI record to volume 16, 1930} +} + +@book{sussman_wisdom_sicm, + author = {Sussman, Gerald Jay and Wisdom, Jack}, + title = {Structure and Interpretation of Classical Mechanics}, + edition = {1st}, + publisher = {MIT Press}, + year = {2001}, + url = {https://groups.csail.mit.edu/mac/users/gjs/6946/sicm-html/book-Z-H-36.html#%_sec_3.1.2}, + note = {edition inferred from the free online HTML edition cited (matches the 1st ed.)} +} + +@misc{terek_variational_manifolds, + author = {Terek, Ivo}, + title = {Introductory Variational Calculus on Manifolds}, + howpublished = {}, + url = {https://web.williams.edu/Mathematics/it3/texts/var_noether.pdf}, + note = {lecture notes; no publication year given in the document} +} + +@misc{tomamichel_relative_entropy_masterclass, + title = {Tomamichel, Quantum Relative Entropy - An Axiomatic Approach}, + howpublished = {}, + url = {https://www.marcotom.info/files/entropy-masterclass2022.pdf} +} + +@article{tong_line_operators_sm, + author = {Tong, D.}, + title = {Line Operators in the Standard Model}, + volume = {07}, + eprint = {1705.01853}, + archiveprefix = {arXiv}, + journal = {JHEP}, + pages = {104}, + year = {2017} +} + +@misc{tong_statistical_physics, + author = {Tong, David}, + title = {Lectures on Statistical Physics}, + howpublished = {}, + url = {https://www.damtp.cam.ac.uk/user/tong/aqm/aqmtwo.pdf} +} + +@misc{tong_statphys_notes_one, + author = {Tong, David}, + title = {Cambridge Lecture Notes on Statistical Physics, part one}, + howpublished = {}, + url = {https://www.damtp.cam.ac.uk/user/tong/statphys/one.pdf} +} + +@misc{tong_statphys_notes_two, + author = {Tong, David}, + title = {Cambridge Lecture Notes on Statistical Physics, part two}, + howpublished = {}, + url = {https://www.damtp.cam.ac.uk/user/tong/statphys/two.pdf} +} + +@article{tooby_smith_2024_index_notation, + author = {Tooby-Smith, Joseph}, + title = {Formalization of physics index notation in Lean 4}, + eprint = {2411.07667}, + archiveprefix = {arXiv}, + primaryclass = {cs.LO}, + year = {2024} +} + +@misc{ucdavis_spinorfeynrules, + author = {Terning, John}, + title = {Modern Supersymmetry: Slides -- Spinor Feynman Rules}, + howpublished = {}, + url = {https://particle.physics.ucdavis.edu/modernsusy/slides/slideimages/spinorfeynrules.pdf}, + note = {companion teaching material to Terning, Modern Supersymmetry: + Dynamics and Duality, Oxford University Press (2006); a + different spinor index convention is used there than in Physlib} +} + +@misc{ucsd_ph130a_node452, + author = {Branson, James}, + title = {Quantum Physics (UCSD Physics 130) -- Course Notes}, + howpublished = {}, + url = {https://quantummechanics.ucsd.edu/ph130a/130_notes/node452.html} +} + +@misc{warwick_alpha_z_relative_entropies, + title = {alpha-z Relative Entropies}, + howpublished = {}, + url = {https://warwick.ac.uk/fac/sci/maths/research/events/2013-2014/statmech/su/Nilanjana-slides.pdf} +} + +@misc{watrous_qit_notes_02, + title = {Watrous, Max-relative entropy and conditional min-entropy}, + howpublished = {}, + url = {https://cs.uwaterloo.ca/~watrous/QIT-notes/QIT-notes.02.pdf}, + note = {lecture notes} +} + +@book{watrous_tqi_ch8, + author = {Watrous, John}, + title = {The Theory of Quantum Information}, + publisher = {Cambridge University Press}, + year = {2018}, + isbn = {978-1-107-18056-7}, + url = {https://cs.uwaterloo.ca/~watrous/TQI/TQI.8.pdf}, + note = {Chapter 8 is cited in the citing module; url is the author's own + freely available copy of that chapter} +} + +@book{weinberg_qft1, + author = {Weinberg, Steven}, + title = {The Quantum Theory of Fields, Volume 1: Foundations}, + publisher = {Cambridge University Press}, + year = {1995} +} + +@misc{wiki_classical_em_and_sr, + title = {Classical electromagnetism and special relativity}, + howpublished = {}, + url = {https://en.wikipedia.org/wiki/Classical_electromagnetism_and_special_relativity} +} + +@misc{wiki_complex_differential_form, + title = {Complex differential form (Dolbeault operators)}, + howpublished = {}, + url = {https://en.wikipedia.org/wiki/Complex_differential_form} +} + +@misc{wiki_em_field_gauge_freedom, + title = {Mathematical descriptions of the electromagnetic field (gauge freedom)}, + howpublished = {}, + url = {https://en.wikipedia.org/wiki/Mathematical_descriptions_of_the_electromagnetic_field#Gauge_freedom} +} + +@misc{wiki_levi_civita_symbol, + title = {Levi-Civita symbol}, + howpublished = {}, + url = {https://en.wikipedia.org/wiki/Levi-Civita_symbol} +} + +@misc{wiki_lorentz_transformation, + title = {Lorentz transformation}, + howpublished = {}, + url = {https://en.wikipedia.org/wiki/Lorentz_transformation} +} + +@misc{wiki_rigged_hilbert_space, + title = {Rigged Hilbert space}, + howpublished = {}, + url = {https://en.wikipedia.org/wiki/Rigged_Hilbert_space} } diff --git a/lake-cache.toml b/lake-cache.toml new file mode 100644 index 0000000000..2c27a4f991 --- /dev/null +++ b/lake-cache.toml @@ -0,0 +1,44 @@ +# Lake cache configuration for Physlib. +# +# Point Lake at this file with LAKE_CONFIG, e.g. +# +# LAKE_CONFIG=$PWD/lake-cache.toml lake cache get +# +# `lake exe get_cache` (scripts/get_cache.lean) does that for you. Bucket +# endpoints are public information, which is why this file is committed; the +# credential that authorises uploads is NOT here. It is supplied via the +# LAKE_CACHE_KEY environment variable, held as an encrypted GitHub Actions +# secret. +# +# Two services are defined because reads and writes need different access: +# +# physlib-r2 anonymous, public read endpoint. What contributors and +# `lake cache get` use. No credential required. The contents +# of the bucket are public info +# physlib-r2-upload authenticated S3 endpoint, used only by CI to publish. +# Requires LAKE_CACHE_KEY. +# +# Keeping them separate means a contributor can never accidentally write to +# the cache, and mirrors how Mathlib separates its read and write paths. +# +# --------------------------------------------------------------------------- +# Both endpoints point at the physlib-cache bucket. Reads go through its +# Public Development URL. + + +cache.defaultService = "physlib-r2" +cache.defaultUploadService = "physlib-r2-upload" + +# Anonymous read path used by contributors. +[[cache.service]] +name = "physlib-r2" +kind = "s3" +artifactEndpoint = "https://lake-cache.physlib.io/artifacts" +revisionEndpoint = "https://lake-cache.physlib.io/revisions" + +# Authenticated write path used by CI only. Same bucket, S3 API endpoint. +[[cache.service]] +name = "physlib-r2-upload" +kind = "s3" +artifactEndpoint = "https://305f4708d1749d8e1873f7a629768540.r2.cloudflarestorage.com/physlib-cache/artifacts" +revisionEndpoint = "https://305f4708d1749d8e1873f7a629768540.r2.cloudflarestorage.com/physlib-cache/revisions" diff --git a/lake-manifest.json b/lake-manifest.json index de4da18378..0fa0ece1fa 100644 --- a/lake-manifest.json +++ b/lake-manifest.json @@ -5,27 +5,27 @@ "type": "git", "subDir": null, "scope": "", - "rev": "81a5d257c8e410db227a6665ed08f64fea08e997", + "rev": "db584cd6d46c92f209a44c0f1c829460d327499d", "name": "mathlib", "manifestFile": "lake-manifest.json", - "inputRev": "v4.32.0", + "inputRev": "v4.33.0", "inherited": false, "configFile": "lakefile.lean"}, {"url": "https://github.com/leanprover/doc-gen4", "type": "git", "subDir": null, "scope": "", - "rev": "092d6318789e7bb9160ade1e85bdbcc0abfd7f6e", + "rev": "aceca4eeb5a79092eabefaa75fcb72b701d02205", "name": "«doc-gen4»", "manifestFile": "lake-manifest.json", - "inputRev": "v4.32.0", + "inputRev": "v4.33.0", "inherited": false, "configFile": "lakefile.lean"}, {"url": "https://github.com/leanprover-community/plausible", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "e12c1910fe855cbfc38803cd4e55543906d5fa62", + "rev": "b7eb3304aeae834b12dda98993a37f6a41f6f0bb", "name": "plausible", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -35,7 +35,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "c5d5b8fe6e5158def25cd28eb94e4141ad97c843", + "rev": "5f4d51b81cbd3f6b32b156bfad9056621a040404", "name": "LeanSearchClient", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -45,7 +45,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "7e9612bf0b9ee66db3cb5b9988a35afc706f5a12", + "rev": "16f02aa7642864af59f1ff0e384a015994db9118", "name": "importGraph", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -55,7 +55,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "6e311e2a844da9b2cc3971187df2fe0066947b93", + "rev": "4be2e3d5087eeb272cf5a8853b8f9dd025ef5957", "name": "proofwidgets", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -65,7 +65,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "a7dbf0c63b694e47f425f3dcddbc0e178bb432d3", + "rev": "3448c0bcc5ce01b2d1546e483ec3620e32df3d0e", "name": "aesop", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -75,7 +75,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "38d591e778f100aec9762bb582f9c7f55f50e9dc", + "rev": "92c15be17b7caf78c2ad767ec40f89052d908d81", "name": "Qq", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -85,7 +85,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "023ce7d62a0531e22a5331e20b587817a80d49ff", + "rev": "4488d40d070b9700d4d5a6aa342f0d40c31b2a2d", "name": "batteries", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -95,7 +95,7 @@ "type": "git", "subDir": null, "scope": "", - "rev": "b2e8105c3507d81adaa531fda5990d14b631528f", + "rev": "6168b7549738a19bc837a1625c60c5d1e5dd8aeb", "name": "leansqlite", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -105,17 +105,17 @@ "type": "git", "subDir": null, "scope": "leanprover", - "rev": "88679d088c9720c27ebdf2ba4dafe17341747f94", + "rev": "6130a47896ce867c6a4a55373441e59e565bad0f", "name": "Cli", "manifestFile": "lake-manifest.json", - "inputRev": "v4.32.0", + "inputRev": "v4.33.0", "inherited": true, "configFile": "lakefile.toml"}, {"url": "https://github.com/fgdorais/lean4-unicode-basic", "type": "git", "subDir": null, "scope": "", - "rev": "947120c17904da8fc89abe3616d57e1c3e13aa9c", + "rev": "37e7d8cb7316a88cd3e91208385c9ec6ae780019", "name": "UnicodeBasic", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -125,7 +125,7 @@ "type": "git", "subDir": null, "scope": "", - "rev": "b648facb6be09a29be636bbc02d28ddee77565c7", + "rev": "852edafa268eb038a7158551fd580ee8433847b0", "name": "BibtexQuery", "manifestFile": "lake-manifest.json", "inputRev": "master", diff --git a/lakefile.toml b/lakefile.toml index 2f19bff4bf..b2fdf60c95 100644 --- a/lakefile.toml +++ b/lakefile.toml @@ -1,15 +1,22 @@ name = "Physlib" + +# These settings allow `lake cache` to work +# `enableArtifactCache` allows the workflow to update the cache +# `restoreAllArtifacts` allows the cached artifacts to be used in `lake build` +enableArtifactCache = true +restoreAllArtifacts = true + defaultTargets = ["Physlib", "QuantumInfo"] [[require]] name = "«doc-gen4»" git = "https://github.com/leanprover/doc-gen4" -rev = "v4.32.0" +rev = "v4.33.0" [[require]] name = "mathlib" git = "https://github.com/leanprover-community/mathlib4.git" -rev = "v4.32.0" +rev = "v4.33.0" [[lean_lib]] name = "Physlib" @@ -23,6 +30,10 @@ moreLeanArgs = ["-Dwarn.sorry=false", "-Dweak.says.verify=true"] name = "QuantumInfo" moreLeanArgs = ["-Dwarn.sorry=false", "-Dweak.says.verify=true"] +[[lean_exe]] +name = "get_cache" +srcDir = "scripts" + [[lean_exe]] name = "check_file_imports" srcDir = "scripts" @@ -64,6 +75,21 @@ name = "runPhyslibAlphaLinters" srcDir = "scripts/PhyslibAlpha" supportInterpreter = true +[[lean_exe]] +name = "noAlphaImports" +srcDir = "scripts/PhyslibAlpha" +supportInterpreter = true + +[[lean_exe]] +name = "alphaFileImports" +srcDir = "scripts/PhyslibAlpha" +supportInterpreter = true + +[[lean_exe]] +name = "testImportScripts" +srcDir = "Meta/test" +supportInterpreter = true + [[lean_exe]] name = "free_simps" srcDir = "scripts/MetaPrograms" diff --git a/lean-toolchain b/lean-toolchain index 2544c30c52..025e59548e 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:v4.32.0 \ No newline at end of file +leanprover/lean4:v4.33.0 diff --git a/scripts/MetaPrograms/check_rfl.lean b/scripts/MetaPrograms/check_rfl.lean index 1a51f18aa6..ab7f0285bd 100644 --- a/scripts/MetaPrograms/check_rfl.lean +++ b/scripts/MetaPrograms/check_rfl.lean @@ -13,15 +13,15 @@ import Physlib.Meta.TransverseTactics This file produces a list of places where `rfl` will complete the goal. ## References -The content of this file is based on the following sources (released under the Apache 2.0 license). -- https://github.com/dwrensha/tryAtEachStep/blob/main/tryAtEachStep.lean -- https://github.com/lean-dojo/LeanDojo/blob/main/src/lean_dojo/data_extraction/ExtractData.lean +The content of this file is based on the following sources (released under the Apache 2.0 +license), with modifications made to the original content here. -Modifications have been made to the original content of these files here. - -See also: -- https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/Memory.20increase.20in.20loops.2E +* https://github.com/dwrensha/tryAtEachStep/blob/main/tryAtEachStep.lean. + [ref: github_tryateachstep] +* https://github.com/lean-dojo/LeanDojo/blob/main/src/lean_dojo/data_extraction/ExtractData.lean. + [ref: github_leandojo_extractdata] +* See also: https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/Memory.20increase.20in.20loops.2E. -/ open Lean Elab System diff --git a/scripts/MetaPrograms/free_simps.lean b/scripts/MetaPrograms/free_simps.lean index 7f61d54669..8edbe1623f 100644 --- a/scripts/MetaPrograms/free_simps.lean +++ b/scripts/MetaPrograms/free_simps.lean @@ -12,16 +12,15 @@ import Physlib.Meta.TransverseTactics This file checks for non-terminating `simp` tactics which do not appear as `simp only`. ## References -The content of this file is based on the following sources (released under the Apache 2.0 license). -- https://github.com/dwrensha/tryAtEachStep/blob/main/tryAtEachStep.lean -- https://github.com/lean-dojo/LeanDojo/blob/main/src/lean_dojo/data_extraction/ExtractData.lean - -Modifications have been made to the original content of these files here. - -See also: -- https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/Memory.20increase.20in.20loops.2E +The content of this file is based on the following sources (released under the Apache 2.0 +license), with modifications made to the original content here. +* https://github.com/dwrensha/tryAtEachStep/blob/main/tryAtEachStep.lean. + [ref: github_tryateachstep] +* https://github.com/lean-dojo/LeanDojo/blob/main/src/lean_dojo/data_extraction/ExtractData.lean. + [ref: github_leandojo_extractdata] +* See also: https://leanprover.zulipchat.com/#narrow/stream/270676-lean4/topic/Memory.20increase.20in.20loops.2E. -/ open Lean Elab System diff --git a/scripts/MetaPrograms/spellingWords.txt b/scripts/MetaPrograms/spellingWords.txt index 3500be8da9..4fef277358 100644 --- a/scripts/MetaPrograms/spellingWords.txt +++ b/scripts/MetaPrograms/spellingWords.txt @@ -1213,6 +1213,7 @@ guillem gut h ha +hax haar ham hamilton @@ -1272,6 +1273,9 @@ hours hovering how however +hsa +hsi +hte html htmlnote https @@ -2187,6 +2191,7 @@ raising range rank rapidly +rapidity rather ratio rational diff --git a/scripts/PhyslibAlpha/alphaFileImports.lean b/scripts/PhyslibAlpha/alphaFileImports.lean new file mode 100644 index 0000000000..28e97b7410 --- /dev/null +++ b/scripts/PhyslibAlpha/alphaFileImports.lean @@ -0,0 +1,49 @@ +import Lean +import Physlib.Meta.AllFilePaths +import Std.Data.HashSet + + +/-! +Copyright (c) 2026 Fergus Munro. All rights reserved. +Released under Apache 2.0 license. +Authors: Fergus Munro +-/ + +open Lean +open Std +open System + +def extractModuleNameFromFilePath (path : FilePath) : String := + ".".intercalate ((path.withExtension "").components.drop 1) + +def extractModuleNameFromImport (importString : String) : String := + let rec findAfterImport : List String → String + | "import" :: x :: _ => x + | _ :: xs => findAfterImport xs + | [] => "" + + findAfterImport ((importString.split Char.isWhitespace).toList.map toString) + +def checkAllFilesImported (directory : String) (mainFilePath : String) : (IO Bool) := do + let modules : HashSet String := HashSet.ofArray $ (← getFilePaths directory).map extractModuleNameFromFilePath + let importedModules := HashSet.ofArray $ ((← IO.FS.lines mainFilePath).filter + (·.contains "import")).map extractModuleNameFromImport + let diff := modules \ importedModules + if diff.size > 0 + then do + IO.println s!"Error: The following .lean files are not imported in {mainFilePath}:" + for module_name in diff do + IO.println s!" - public import {module_name}" + return False + else do + IO.println s!"✓ All {modules.size} .lean files in {directory} are imported in {mainFilePath}" + return True + +unsafe def main (args : List String) : IO Unit := do + let (dir, file) := match args with + | d :: f :: [] => (d, f) + | _ => ("./PhyslibAlpha", "./PhyslibAlpha.lean") + let success ← checkAllFilesImported dir file + if !success then + IO.Process.exit 1 + diff --git a/scripts/PhyslibAlpha/alphaPythonLinters.sh b/scripts/PhyslibAlpha/alphaPythonLinters.sh index c22ed1b178..bb033050ce 100755 --- a/scripts/PhyslibAlpha/alphaPythonLinters.sh +++ b/scripts/PhyslibAlpha/alphaPythonLinters.sh @@ -10,7 +10,11 @@ set -exo pipefail touch scripts/style-exceptions.txt -git ls-files 'PhyslibAlpha/*.lean' | xargs ./scripts/lint-style.py "$@" +# `git ls-files` includes paths scheduled for deletion until the change is committed. Remove +# those paths so a rename/removal is linted by its replacement rather than failing on a vanished +# file. +comm -23 <(git ls-files 'PhyslibAlpha/*.lean' | sort) \ + <(git ls-files -d -- 'PhyslibAlpha/*.lean' | sort) | xargs ./scripts/lint-style.py "$@" # 2. Global checks on the PhyslibAlpha repository diff --git a/scripts/PhyslibAlpha/noAlphaImports.lean b/scripts/PhyslibAlpha/noAlphaImports.lean new file mode 100644 index 0000000000..bb54c98fb5 --- /dev/null +++ b/scripts/PhyslibAlpha/noAlphaImports.lean @@ -0,0 +1,63 @@ +import Lean +import Physlib.Meta.AllFilePaths + +/-! +Copyright (c) 2026 Fergus Munro. All rights reserved. +Released under Apache 2.0 license. +Authors: Fergus Munro + +This module validates that no files in the Physlib and QuantumInfo directories +contain import statements that reference PhyslibAlpha. It walks through all .lean +files in these directories and reports any violations found, returning an exit code +indicating success or failure of the validation check. +-/ + +open Lean +open System + +/-- + Returns True if not files in Physlib or QuantumInfo import import any + PhyslibAlpha files, and False otherwise, printing the offending files and + imports to the standard output. + -/ +def areNoAlphaImports (modules : List String) : IO Bool := do + let mut violations : Array (FilePath × Name) := #[] + + for module in modules do + + let filePaths ← getFilePaths module + for filePath in filePaths do + + let contents ← IO.FS.readFile filePath + let (imports, _pos, _messages) ← Elab.parseImports contents filePath.toString + + for imp in imports do + if imp.module.toString.contains "PhyslibAlpha" then + violations := violations.push ( + filePath, imp.module + ) + + if violations.size > 0 then + IO.println "Found Violations:" + for violation in violations do + IO.println s!" {violation.fst} : {violation.snd}" + + return False + else + IO.println "No violations found. All files passed the check." + return True + +unsafe def main (args : List String) : IO Unit := do + let dirs := match args with + | [] => ["./Physlib", "./QuantumInfo"] + | _ => args + + let success ← areNoAlphaImports dirs + + if !success then + IO.Process.exit 1 + + + + + diff --git a/scripts/check_references.py b/scripts/check_references.py new file mode 100755 index 0000000000..4547e7e6b8 --- /dev/null +++ b/scripts/check_references.py @@ -0,0 +1,90 @@ +#!/usr/bin/env python3 +"""Validates the '## References' sections of Physlib/QuantumInfo/PhyslibAlpha modules. + +Checks, for every module docstring References section: + * the body is not empty + * every "[ref: ]" tag resolves to an entry in docs/references.bib + * docs/references.bib contains no Zulip entries (Zulip links clutter the + bibliography and aren't useful indexed as formal references -- they should + be left as plain, untagged URLs in the docstring instead) + +Usage: ./scripts/check_references.py +Exits non-zero (and prints one message per problem) if any check fails. +""" +import pathlib +import re +import sys + +ROOT = pathlib.Path(__file__).resolve().parent.parent +HEAD_RE = re.compile(r'^#{1,4}\s*(?:(?:i{1,3}v?|\d+)\.\s*)?References?:?\s*$') +REF_TAG_RE = re.compile(r'\[ref:\s*([^\]]+?)\]') +BIB_ENTRY_RE = re.compile(r'^@(\w+)\{\s*([^,\s]+)\s*,(.*?)^\}', re.MULTILINE | re.DOTALL) + + +def load_registry(): + text = (ROOT / 'docs' / 'references.bib').read_text(encoding='utf-8') + entries = {} + for m in BIB_ENTRY_RE.finditer(text): + entries[m.group(2)] = m.group(3) + return entries + + +def find_blocks(lines): + blocks = [] + i = 0 + while i < len(lines): + if HEAD_RE.match(lines[i].strip()): + j = i + 1 + while j < len(lines): + s = lines[j].strip() + if s.startswith('#') and 'References' not in s: + break + if s == '-/' or s.startswith('-/'): + break + j += 1 + blocks.append((i, j)) + i = j + else: + i += 1 + return blocks + + +def main(): + registry = load_registry() + keys = set(registry) + problems = [] + + for key, fields in registry.items(): + if 'zulip' in key.lower() or 'zulipchat.com' in fields: + problems.append(f"docs/references.bib: entry '{key}' is a Zulip link " + f"-- Zulip links should not be added to the bibliography") + + for path in sorted(ROOT.rglob('*.lean')): + if '.lake' in path.parts: + continue + lines = path.read_text(encoding='utf-8', errors='replace').split('\n') + for head_idx, end_idx in find_blocks(lines): + body_lines = lines[head_idx + 1:end_idx] + body = '\n'.join(body_lines).strip() + rel = path.relative_to(ROOT) + if not body: + problems.append(f"{rel}:{head_idx + 1}: empty References section " + f"(use '* None.' if there is genuinely no reference)") + continue + for line_no, line in enumerate(body_lines, start=head_idx + 2): + for m in REF_TAG_RE.finditer(line): + key = m.group(1).strip() + if key not in keys: + problems.append(f"{rel}:{line_no}: unknown reference key " + f"'{key}' (not in docs/references.bib)") + + if problems: + for p in problems: + print(p) + print(f"\n{len(problems)} problem(s) found") + sys.exit(1) + print("References sections OK") + + +if __name__ == '__main__': + main() diff --git a/scripts/get_cache.lean b/scripts/get_cache.lean new file mode 100644 index 0000000000..93cfab0070 --- /dev/null +++ b/scripts/get_cache.lean @@ -0,0 +1,119 @@ +/- +Copyright (c) 2026 Alex Zughaid. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Alex Zughaid +-/ + +import Lean + +/-! +# Get cache + +Downloads everything needed before a first build, so that `lake build` does +not have to compile from source. + +Fetches both halves: Mathlib's prebuilt files (via Mathlib's own +`lake exe cache get`) and Physlib's own (via Lake's built-in `lake cache`, +backed by the project's R2 bucket -- see `lake-cache.toml` and +`docs/cache-setup.md`). Pass `--no-mathlib` to skip getting Mathlib's cache, +and `--no-alpha` to skip PhyslibAlpha's. + +It can be run from the terminal using `lake exe get_cache`. + +If you have no internet, `lake build` is just fine but will take much longer without this step +first. +-/ + +def helpText : String := +"Download everything needed before a first build, so that `lake build` does \ +not have to compile from source. + +Usage: + lake exe get_cache fetch everything needed + lake exe get_cache --no-mathlib skip Mathlib, fetch only Physlib's + lake exe get_cache --no-alpha skip PhyslibAlpha's cache +" + +/-- `println`, then flush stdout immediately. Without this, messages printed +before spawning a subprocess can sit in a buffer and appear out of order (or +not at all until the child exits) whenever stdout is piped rather than a +terminal -- e.g. `lake exe get_cache | tee log.txt`. -/ +def say (s : String) : IO Unit := do + IO.println s + (← IO.getStdout).flush + +/-- Run a subprocess, inheriting stdout/stderr, with optional extra +environment variables. Returns whether it exited successfully. -/ +def runStreamed (cmd : String) (args : Array String) + (env : Array (String × Option String) := #[]) : IO Bool := do + let child ← IO.Process.spawn { cmd, args, env } + return (← child.wait) == 0 + +/-- The options this program understands. Anything else is rejected up +front, rather than silently ignored and treated as "no flags given". -/ +def knownFlags : List String := ["--help", "-h", "--no-mathlib", "--no-alpha"] + +/-- The current toolchain as a cache-scope path component: `/` and `:` become +`-`, whitespace is dropped (matching the workflow's `tr -d '[:space:]'`). -/ +def toolchainTag : IO String := do + let raw ← IO.FS.readFile "lean-toolchain" + return raw.foldl (init := "") fun acc c => + if c.isWhitespace then acc + else if c == '/' || c == ':' then acc.push '-' + else acc.push c + +/-- The cache scope for one half of the project. Each half gets its own so the +two CI jobs do not overwrite each other's mappings; the toolchain is a path +component because Lake ignores `--toolchain` for verbatim scopes. +`.github/workflows/publish-cache.yml` builds the same strings. -/ +def scopeFor (tc : String) (half : String) : String := + s!"physlib-master/{tc}/{half}" + +def main (args : List String) : IO UInt32 := do + if let some bad := args.find? (!knownFlags.contains ·) then + say s!"Unknown option: {bad} (try --help)" + return 0 + + if args.contains "--help" || args.contains "-h" then + say helpText + return 0 + + unless ← System.FilePath.pathExists "lakefile.toml" do + say "Run this from the root of the Physlib repository." + return 0 + + let skipMathlib := args.contains "--no-mathlib" + let skipAlpha := args.contains "--no-alpha" + + if !skipMathlib then + say "Fetching Mathlib's prebuilt files ..." + unless ← runStreamed "lake" #["exe", "cache", "get"] do + say " could not fetch Mathlib's cache -- continuing anyway." + say " ('lake build' may then have to compile Mathlib, which is slow.)" + say "" + + let cwd ← IO.currentDir + let configPath := (cwd / "lake-cache.toml").toString + let tc ← toolchainTag + + say "Fetching Physlib's prebuilt files ..." + let ok ← runStreamed "lake" #["cache", "get", s!"--scope={scopeFor tc "physlib"}"] + #[("LAKE_CONFIG", some configPath)] + + -- Published under its own scope, so it needs its own fetch. + unless skipAlpha do + say "" + say "Fetching PhyslibAlpha's prebuilt files ..." + unless ← runStreamed "lake" #["cache", "get", s!"--scope={scopeFor tc "alpha"}"] + #[("LAKE_CONFIG", some configPath)] do + say " could not fetch PhyslibAlpha's cache -- continuing anyway." + say " ('lake build PhyslibAlpha' would then compile it from source.)" + + if ok then + say "" + say "Done. Now run: lake build" + else + say "" + say "Could not fetch Physlib's cache. This is not a fatal error -- run 'lake build'" + say "as usual, it will just take longer, compiling the whole project from source." + return 0 diff --git a/scripts/lint_all.lean b/scripts/lint_all.lean index 47ec83fbde..2ab1d4879d 100644 --- a/scripts/lint_all.lean +++ b/scripts/lint_all.lean @@ -24,6 +24,14 @@ def main (args : List String) : IO UInt32 := do let importCheck ← IO.Process.output {cmd := "lake", args := #["exe", "check_file_imports"]} println! importCheck.stdout + println! "\x1b[36m(3/7) Illegal Imports\x1b[0m" + let noAlphaImports ← IO.Process.output {cmd := "lake", args := #["exe", "noAlphaImports"]} + println! noAlphaImports.stdout + + println! "\x1b[36m(3/7) Ensuring all PhyslibAlpha modules imported\x1b[0m" + let alphaFileImports ← IO.Process.output {cmd := "lake", args := #["exe", "alphaFileImports"]} + println! alphaFileImports.stdout + println! "\x1b[36m(4/7) TODO tag duplicates \x1b[0m" let todoCheck ← IO.Process.output {cmd := "lake", args := #["exe", "check_dup_tags"]} println! todoCheck.stdout diff --git a/scripts/review_claim.py b/scripts/review_claim.py new file mode 100644 index 0000000000..a470d90287 --- /dev/null +++ b/scripts/review_claim.py @@ -0,0 +1,633 @@ +#!/usr/bin/env python3 +""" +Review claims for pull requests. + +To avoid two reviewers (human or AI) reviewing the same PR, a reviewer says what +they intend to review and claims it, by commenting on the PR: + + claim claim this PR for review, for the default window + claim 5 days ... for a specific window (hours / days / weeks) + claim 2026-08-01 ... until a specific date + disclaim release the claim early + +The bot requests a review from the claimant, assigns them, applies the +`review-claimed` label and keeps a single status comment recording the deadline. +Claiming again extends the window; submitting a review completes the claim. +A claim that runs out without a review is released -- the claimant comes off the +PR as reviewer and assignee -- and announced on Zulip, so that somebody else +picks the PR up. + +The whole state of a claim lives in that one status comment, in a hidden marker +holding a JSON record. The comment is edited in place rather than reposted, so a +PR accumulates at most one of them however often the claim is extended, and there +is nothing to keep in sync anywhere else. + +Sample usage, from the workflows in .github/workflows/review_claim*.yml: + + $ python scripts/review_claim.py comment # handle an issue_comment event + $ python scripts/review_claim.py review # handle a pull_request_review event + $ python scripts/review_claim.py expire # remind about, and expire, claims + +The first two read the event from GITHUB_EVENT_PATH. All three need GITHUB_TOKEN +and GITHUB_REPOSITORY; the Zulip announcement additionally needs ZULIP_SITE, +ZULIP_BOT_EMAIL, ZULIP_BOT_API_KEY and ZULIP_STREAM, and is skipped with a +warning when they are not set. +""" + +import base64 +import json +import os +import re +import sys +import urllib.error +import urllib.parse +import urllib.request +from datetime import datetime, timedelta, timezone + +CLAIM_LABEL = 'review-claimed' +MARKER_PREFIX = '' +CLAIM_FIELDS = ('state', 'claimant', 'claimed_at', 'until') +REMINDER_MARKER = '' + +# A review claim is a short promise, so the windows are much tighter than the +# roadmap intentions this is modelled on. +DEFAULT_WINDOW = timedelta(days=2) +MAX_WINDOW = timedelta(days=14) +MIN_WINDOW = timedelta(hours=1) + +# Reminders are @-mentions sent this many hours before the deadline. A reminder +# is skipped when it is not shorter than the window itself, so a one day claim is +# never warned about a day in advance. Ascending, so that the smallest +# applicable reminder wins if a scheduled run is skipped. +REMINDERS_HOURS = (24, 48) + +UNITS = { + 'hour': timedelta(hours=1), 'hours': timedelta(hours=1), + 'day': timedelta(days=1), 'days': timedelta(days=1), + 'week': timedelta(weeks=1), 'weeks': timedelta(weeks=1), +} + +API_ROOT = 'https://api.github.com' + + +class ClaimError(Exception): + """A command we understood the shape of but cannot carry out.""" + + +def warn(message): + """Emit a GitHub Actions warning annotation.""" + print(f'::warning::{message}') + + +def now(): + return datetime.now(timezone.utc) + + +def to_iso(when): + return when.astimezone(timezone.utc).strftime('%Y-%m-%dT%H:%M:%SZ') + + +def parse_iso(text): + """Parse an ISO 8601 timestamp, tolerating the trailing `Z` GitHub sends.""" + return datetime.fromisoformat(text.replace('Z', '+00:00')) + + +def format_utc(when): + """Format a timestamp the way the bot's comments always spell one out.""" + return when.astimezone(timezone.utc).strftime('%Y-%m-%d %H:%M UTC') + + +def describe_window(window): + """Spell a duration back to the claimant, so they can check what we understood.""" + seconds = window.total_seconds() + + def trim(value): + return str(int(value)) if value == int(value) else str(round(value, 1)) + + if seconds % 86400 == 0 and seconds >= 86400: + days = seconds / 86400 + if days % 7 == 0: + weeks = days / 7 + return f'{trim(weeks)} week' + ('' if weeks == 1 else 's') + return f'{trim(days)} day' + ('' if days == 1 else 's') + hours = seconds / 3600 + return f'{trim(hours)} hour' + ('' if hours == 1 else 's') + + +def parse_window(argument, at): + """ + Parse the argument of a `claim` command into a deadline. + + Accepts an empty argument (the default window), ` hours|days|weeks`, or an + absolute `YYYY-MM-DD` date, read as the end of that day UTC. Over-long + windows are clamped rather than rejected; the caller is told via `clamped`. + Returns a `(until, clamped)` pair, or raises `ClaimError` with a message + meant for the claimant. + """ + trimmed = (argument or '').strip().lower() + + if trimmed == '': + until = at + DEFAULT_WINDOW + elif re.fullmatch(r'\d{4}-\d{2}-\d{2}', trimmed): + try: + until = parse_iso(f'{trimmed}T23:59:59Z') + except ValueError: + raise ClaimError(f'`{trimmed}` is not a real date.') + else: + match = re.fullmatch(r'(\d+)\s*(hour|hours|day|days|week|weeks)', trimmed) + if not match: + raise ClaimError( + f'I could not read `{trimmed}` as a window. Use `claim`, ' + '`claim 5 days` (or hours/weeks), or `claim 2026-08-01`.') + until = at + int(match.group(1)) * UNITS[match.group(2)] + + if until - at < MIN_WINDOW: + raise ClaimError('That window is already over. Pick a deadline in the future.') + clamped = until - at > MAX_WINDOW + if clamped: + until = at + MAX_WINDOW + return until, clamped + + +def parse_command(body): + """ + Read a command out of a comment body. + + As elsewhere in this repository, a command is a whole line: we react to a line + whose entire content, up to whitespace, is the command, so that a comment + merely discussing claims does not trigger one. The last command in a comment + wins. Returns a `(name, argument)` pair, or None. + """ + command = None + for line in (body or '').replace('\r', '').split('\n'): + trimmed = line.strip() + match = re.match(r'claim\b(.*)$', trimmed, re.IGNORECASE) + if match: + command = ('claim', match.group(1)) + elif re.fullmatch(r'disclaim', trimmed, re.IGNORECASE): + command = ('disclaim', None) + return command + + +def read_claim(body): + """ + The claim record carried by a comment body, or None if there is none. + + A marker that is unreadable or missing a field is treated as no claim at all, + rather than trusted and crashed on: anyone can paste one of these into a + comment, and the expiry run then clears the stale label as it would for any + other PR labelled without a live claim. + """ + if not body or MARKER_PREFIX not in body: + return None + start = body.index(MARKER_PREFIX) + len(MARKER_PREFIX) + end = body.find(MARKER_SUFFIX, start) + if end == -1: + return None + try: + record = json.loads(body[start:end]) + except json.JSONDecodeError: + return None + if not isinstance(record, dict) or not all( + isinstance(record.get(field), str) for field in CLAIM_FIELDS): + return None + return record + + +def pick_status_comment(comments): + """The status comment among an already-fetched list, or None if there is none.""" + for comment in reversed(comments): + if MARKER_PREFIX in (comment.get('body') or ''): + return comment + return None + + +def render_status(claim): + """Render the status comment body for a claim record.""" + marker = MARKER_PREFIX + json.dumps(claim) + MARKER_SUFFIX + claimant = claim['claimant'] + + if claim['state'] == 'released': + return f'{marker}\nReview claim by @{claimant} released. This PR is back in the review queue.' + if claim['state'] == 'completed': + return f'{marker}\nReview claim by @{claimant} completed — thanks for the review.' + if claim['state'] == 'expired': + return '\n'.join([ + marker, + f'Review claim by @{claimant} expired on {format_utc(parse_iso(claim["until"]))} ' + 'without a review.', + 'This PR is back in the review queue.', + ]) + + until = parse_iso(claim['until']) + window = until - parse_iso(claim['claimed_at']) + reminders = [hours for hours in REMINDERS_HOURS if timedelta(hours=hours) < window] + reminders.sort(reverse=True) + if reminders: + promise = ('I will remind them here ' + + ' and '.join(f'{hours}h' for hours in reminders) + + ' before that runs out.') + else: + promise = 'That window is too short for a reminder, so there will not be one.' + + return '\n'.join([ + marker, + f'**@{claimant} has claimed this PR for review** until {format_utc(until)} ' + f'({describe_window(window)}).', + '', + promise, + 'If no review lands in time the claim is released automatically and this PR returns to', + 'the review queue.', + '', + 'Comment `claim` to extend, `claim 5 days` / `claim 2026-08-01` for a specific window, or', + '`disclaim` to release it early. A claim is cooperative, not a lock: it signals intent so', + 'that others can steer around it, and anyone is still free to review this PR.', + ]) + + +class GitHub: + """The slice of the GitHub REST API these workflows need.""" + + def __init__(self, token, repo): + self.token = token + self.repo = repo + + def request(self, method, path, data=None): + url = path if path.startswith('http') else f'{API_ROOT}/repos/{self.repo}{path}' + body = json.dumps(data).encode() if data is not None else None + request = urllib.request.Request(url, data=body, method=method) + request.add_header('Authorization', f'Bearer {self.token}') + request.add_header('Accept', 'application/vnd.github+json') + request.add_header('X-GitHub-Api-Version', '2022-11-28') + if body is not None: + request.add_header('Content-Type', 'application/json') + with urllib.request.urlopen(request) as response: + payload = response.read() + link = response.headers.get('Link', '') + return (json.loads(payload) if payload else None), link + + def get(self, path): + return self.request('GET', path)[0] + + def post(self, path, data): + return self.request('POST', path, data)[0] + + def patch(self, path, data): + return self.request('PATCH', path, data)[0] + + def delete(self, path, data=None): + return self.request('DELETE', path, data)[0] + + def paginate(self, path): + """Follow `Link: rel="next"` until the collection is exhausted.""" + separator = '&' if '?' in path else '?' + url = f'{path}{separator}per_page=100' + items = [] + while url: + page, link = self.request('GET', url) + items.extend(page or []) + match = re.search(r'<([^>]+)>;\s*rel="next"', link or '') + url = match.group(1) if match else None + return items + + def tolerate(self, description, method, path, data=None): + """ + Make a call whose failure must not stop the workflow. + + Labels, assignees and review requests are all things GitHub may refuse -- + the label may be gone already, the claimant may not be a collaborator -- + and none of those are worth failing a run over. + """ + try: + self.request(method, path, data) + return True + except urllib.error.HTTPError as error: + warn(f'{description}: {error.code} {error.reason}') + except urllib.error.URLError as error: + warn(f'{description}: {error.reason}') + return False + + +def take_claim(github, number, claimant): + """ + Put the claimant on the PR as both assignee and requested reviewer. + + Requesting a review is the half that shows up in everyone's review queue, but + GitHub refuses it for a non-collaborator and for the PR's own author, and + claiming deliberately needs no permissions -- so that half is best-effort. + """ + github.tolerate(f'#{number}: could not label', 'POST', + f'/issues/{number}/labels', {'labels': [CLAIM_LABEL]}) + github.tolerate(f'#{number}: could not assign {claimant}', 'POST', + f'/issues/{number}/assignees', {'assignees': [claimant]}) + github.tolerate(f'#{number}: could not request review from {claimant}', 'POST', + f'/pulls/{number}/requested_reviewers', {'reviewers': [claimant]}) + + +def release_claim(github, number, claimant=None): + """ + Drop the claim label and, when a claimant is given, take them back off the PR + as reviewer and assignee. Every step tolerates its target being gone already. + """ + github.tolerate(f'#{number}: could not remove {CLAIM_LABEL}', 'DELETE', + f'/issues/{number}/labels/{CLAIM_LABEL}') + if not claimant: + return + github.tolerate(f'#{number}: could not unassign {claimant}', 'DELETE', + f'/issues/{number}/assignees', {'assignees': [claimant]}) + github.tolerate(f'#{number}: could not drop the review request for {claimant}', 'DELETE', + f'/pulls/{number}/requested_reviewers', {'reviewers': [claimant]}) + + +def has_reviewed_since(github, number, claimant, since): + """ + Has the claimant looked at the PR since claiming it? A submitted review or an + inline review comment both count; a plain issue comment deliberately does not. + """ + for review in github.paginate(f'/pulls/{number}/reviews'): + if review['user']['login'] == claimant and parse_iso(review['submitted_at']) >= since: + return True + for comment in github.paginate(f'/pulls/{number}/comments'): + if comment['user']['login'] == claimant and parse_iso(comment['created_at']) >= since: + return True + return False + + +def write_status(github, number, claim, existing): + """Create or edit the single status comment carrying the claim record.""" + body = {'body': render_status(claim)} + if existing: + return github.patch(f'/issues/comments/{existing["id"]}', body) + return github.post(f'/issues/{number}/comments', body) + + +def notify_zulip(content): + """ + Announce something on Zulip, using the same bot credentials and message API as + the Physlib Zulip bots. + + A missing or broken Zulip setup must never take a workflow down with it: the + GitHub side of an expiry has already happened by the time this is called, so a + failure here is warned about and swallowed. + """ + site = os.environ.get('ZULIP_SITE') + email = os.environ.get('ZULIP_BOT_EMAIL') + key = os.environ.get('ZULIP_BOT_API_KEY') + stream = os.environ.get('ZULIP_STREAM') + if not (site and email and key and stream): + warn('Zulip is not configured (ZULIP_SITE / ZULIP_BOT_EMAIL / ZULIP_BOT_API_KEY / ' + 'ZULIP_STREAM), skipping the announcement.') + return False + + # `to` takes a stream name or a stream id, so ZULIP_STREAM can be either. + body = urllib.parse.urlencode({ + 'type': 'stream', + 'to': stream, + 'topic': os.environ.get('ZULIP_TOPIC') or 'PR reviews', + 'content': content, + }).encode() + credentials = base64.b64encode(f'{email}:{key}'.encode()).decode() + + request = urllib.request.Request(f'{site.rstrip("/")}/api/v1/messages', data=body, + method='POST') + request.add_header('Authorization', f'Basic {credentials}') + request.add_header('Content-Type', 'application/x-www-form-urlencoded') + try: + with urllib.request.urlopen(request): + return True + except urllib.error.HTTPError as error: + warn(f'Zulip API error: {error.code} {error.read().decode(errors="replace")}') + except urllib.error.URLError as error: + warn(f'Could not reach Zulip: {error.reason}') + return False + + +def may_release(github, actor, claimant): + """ + The claimant can always let go; a maintainer can release someone else's claim + without waiting for it to time out. + """ + if actor == claimant: + return True + try: + access = github.get(f'/collaborators/{actor}/permission') + except (urllib.error.HTTPError, urllib.error.URLError): + return False + return access.get('permission') in ('admin', 'maintain', 'write') + + +def handle_comment(github, event): + """Handle an `issue_comment` event: the `claim` and `disclaim` commands.""" + command = parse_command(event['comment']['body']) + if not command: + print('No claim command in this comment.') + return + name, argument = command + + number = event['issue']['number'] + actor = event['comment']['user']['login'] + comment_id = event['comment']['id'] + at = now() + + def react(content): + github.tolerate('Could not react', 'POST', + f'/issues/comments/{comment_id}/reactions', {'content': content}) + + def reject(message): + react('confused') + github.post(f'/issues/{number}/comments', {'body': f'@{actor} {message}'}) + + comments = github.paginate(f'/issues/{number}/comments') + status_comment = pick_status_comment(comments) + current = read_claim(status_comment.get('body') if status_comment else None) + active = current if current and current['state'] == 'active' else None + + if name == 'disclaim': + if not active: + print(f'#{number}: nothing to disclaim.') + react('confused') + return + if not may_release(github, actor, active['claimant']): + reject(f'this PR is claimed by @{active["claimant"]} until ' + f'{format_utc(parse_iso(active["until"]))}, and only they (or a maintainer) ' + 'can release it. It will be released automatically if no review arrives ' + 'by then.') + return + + print(f'#{number}: {actor} released the claim held by {active["claimant"]}.') + release_claim(github, number, active['claimant']) + write_status(github, number, + dict(active, state='released', released_by=actor), status_comment) + react('+1') + return + + # Someone else's live claim is not silently overwritten: the point of the whole + # mechanism is that a second reviewer finds out before duplicating the work. + if active and active['claimant'] != actor: + reject(f'this PR is already claimed by @{active["claimant"]} until ' + f'{format_utc(parse_iso(active["until"]))}. It will be released automatically ' + 'if no review arrives by then, and you are still free to review it in the ' + 'meantime — a claim signals intent rather than locking anyone out.') + return + + try: + until, clamped = parse_window(argument, at) + except ClaimError as error: + reject(str(error)) + return + + # Extending records a fresh claim time, so the status comment keeps describing + # the window the claimant actually asked for. + claim = { + 'state': 'active', + 'claimant': actor, + 'claimed_at': to_iso(at), + 'until': to_iso(until), + } + take_claim(github, number, actor) + write_status(github, number, claim, status_comment) + react('+1') + + if clamped: + github.post(f'/issues/{number}/comments', {'body': + f'@{actor} that window was longer than the {describe_window(MAX_WINDOW)} ' + f'maximum, so I shortened it to {format_utc(until)}. Comment `claim` again ' + 'to extend it later.'}) + print(f'#{number}: {actor} claimed until {to_iso(until)}.') + + +def handle_review(github, event): + """Handle a `pull_request_review` event: a review completes its claim.""" + number = event['pull_request']['number'] + reviewer = event['review']['user']['login'] + + comments = github.paginate(f'/issues/{number}/comments') + status_comment = pick_status_comment(comments) + current = read_claim(status_comment.get('body') if status_comment else None) + if not current or current['state'] != 'active' or current['claimant'] != reviewer: + print(f'#{number}: review by {reviewer} does not close an active claim.') + return + + print(f'#{number}: {reviewer} reviewed, completing their claim.') + # The label goes, but the assignee stays: they are engaged with this PR now, + # which is the opposite of the case the expiry run handles. + release_claim(github, number) + write_status(github, number, dict(current, state='completed'), status_comment) + + +def expire(github): + """Remind about, and release, claims on every open PR carrying the label.""" + issues = github.paginate(f'/issues?state=open&labels={CLAIM_LABEL}') + at = now() + + for issue in issues: + # The issues endpoint returns issues and PRs alike; we only want PRs. + if 'pull_request' not in issue: + continue + number = issue['number'] + + # One fetch serves both the claim record and the reminder markers. + comments = github.paginate(f'/issues/{number}/comments') + status_comment = pick_status_comment(comments) + claim = read_claim(status_comment.get('body') if status_comment else None) + if not claim or claim['state'] != 'active': + warn(f'#{number}: labelled {CLAIM_LABEL} with no active claim; clearing the label.') + release_claim(github, number) + continue + + claimant = claim['claimant'] + claimed_at = parse_iso(claim['claimed_at']) + until = parse_iso(claim['until']) + hours_left = (until - at).total_seconds() / 3600 + + if at < until: + # Smallest reminder that is both due and shorter than the window: if a + # scheduled run is skipped and we come back with 20h left, that sends + # the 24h reminder rather than a stale 48h one. + due = next((hours for hours in REMINDERS_HOURS + if timedelta(hours=hours) < until - claimed_at and hours_left <= hours), + None) + if due is None: + print(f'#{number}: {claimant} has {hours_left:.1f}h left, no reminder due.') + continue + if has_reviewed_since(github, number, claimant, claimed_at): + print(f'#{number}: {claimant} has already reviewed, ' + f'skipping the {due}h reminder.') + continue + + # Keyed to the deadline, so the hourly runs in between do not repeat a + # reminder and an extension earns a fresh set. + marker = REMINDER_MARKER.format(until=claim['until'], hours=due) + if any(marker in (comment.get('body') or '') for comment in comments): + print(f'#{number}: {due}h reminder for {claimant} already posted.') + continue + + print(f'#{number}: posting the {due}h reminder for {claimant}.') + github.post(f'/issues/{number}/comments', {'body': '\n'.join([ + marker, + f'@{claimant} about {due} hours are left on your review claim for this PR, ' + f'which runs out at {format_utc(until)}.', + '', + 'Reviewing it before then completes the claim. Comment `claim` to give yourself', + 'more time, or `disclaim` to hand it back to the review queue.', + ])}) + continue + + reviewed = has_reviewed_since(github, number, claimant, claimed_at) + print(f'#{number}: claim by {claimant} ran out; reviewed={reviewed}.') + + if reviewed: + # The label goes, but the assignee stays: they did the work. + release_claim(github, number) + write_status(github, number, dict(claim, state='completed'), status_comment) + continue + + release_claim(github, number, claimant) + write_status(github, number, dict(claim, state='expired'), status_comment) + # The status comment is edited rather than reposted, which notifies nobody, + # so the release itself gets its own @-mention. + github.post(f'/issues/{number}/comments', {'body': '\n'.join([ + f'@{claimant} your review claim on this PR ran out at {format_utc(until)} ' + 'without a review, so I have removed you as a reviewer and assignee.', + '', + 'This PR is back in the general review queue. Comment `claim` if you would still', + 'like to take it.', + ])}) + + # Zulip only hears about the failures: a claim that was honoured is not + # news, and the point of announcing this one is that the PR now needs + # somebody else. GitHub logins are not Zulip names, so the claimant is + # named rather than @-mentioned. + repo_name = github.repo.split('/')[-1] + notify_zulip('\n'.join([ + f'**Review claim expired** on [{repo_name}#{number}]({issue["html_url"]}): ' + f'{issue["title"]}', + '', + f'`{claimant}` claimed this review until {format_utc(until)}, but no review ' + 'arrived, so they have been removed as a reviewer and the PR is back in the', + 'review queue. It is open for anyone to `claim`.', + ])) + + +def main(argv): + if len(argv) != 2 or argv[1] not in ('comment', 'review', 'expire'): + print(f'usage: {argv[0]} comment|review|expire', file=sys.stderr) + return 2 + + github = GitHub(os.environ['GITHUB_TOKEN'], os.environ['GITHUB_REPOSITORY']) + if argv[1] == 'expire': + expire(github) + return 0 + + with open(os.environ['GITHUB_EVENT_PATH'], encoding='utf-8') as handle: + event = json.load(handle) + if argv[1] == 'comment': + handle_comment(github, event) + else: + handle_review(github, event) + return 0 + + +if __name__ == '__main__': + sys.exit(main(sys.argv)) diff --git a/scripts/style-exceptions.txt b/scripts/style-exceptions.txt index e69de29bb2..bdbff627ba 100644 --- a/scripts/style-exceptions.txt +++ b/scripts/style-exceptions.txt @@ -0,0 +1,4 @@ +PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/Effect.lean : line 8 : ERR_LIN : Line has more than 100 characters +PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/Spectrum.lean : line 10 : ERR_LIN : Line has more than 100 characters +PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/GeneratedByOne/SquareRootUniqueness.lean : line 8 : ERR_LIN : Line has more than 100 characters +PhyslibAlpha/AlgebraicFramework/JordanOrderUnit/JB/Order.lean : line 8 : ERR_LIN : Line has more than 100 characters